diff --git a/.gitignore b/.gitignore index d25e37f..14ac059 100644 --- a/.gitignore +++ b/.gitignore @@ -37,3 +37,4 @@ TAGS docs/db/unthreat geolite-csv/data/large +geolite-lmdb/data/large diff --git a/colonnade/src/Colonnade/Encoding.hs b/colonnade/src/Colonnade/Encoding.hs index 86cfc6c..3042755 100644 --- a/colonnade/src/Colonnade/Encoding.hs +++ b/colonnade/src/Colonnade/Encoding.hs @@ -43,8 +43,8 @@ runRowMonadicWith :: (Monad m) -> a -> m b runRowMonadicWith bempty bappend (Encoding v) g a = - foldlM (\br e -> do - bl <- g (oneEncodingEncode e a) + foldlM (\bl e -> do + br <- g (oneEncodingEncode e a) return (bappend bl br) ) bempty v @@ -52,6 +52,16 @@ runHeader :: (c1 -> c2) -> Encoding Headed c1 a -> Vector c2 runHeader g (Encoding v) = Vector.map (g . getHeaded . oneEncodingHead) v +-- | This function is a helper for abusing 'Foldable' to optionally +-- render a header. Its future is uncertain. +runHeaderMonadicGeneral :: (Monad m, Monoid b, Foldable h) + => Encoding h content a + -> (content -> m b) + -> m b +runHeaderMonadicGeneral (Encoding v) g = id + $ fmap (mconcat . Vector.toList) + $ Vector.mapM (Internal.foldlMapM g . oneEncodingHead) v + runHeaderMonadic :: (Monad m, Monoid b) => Encoding Headed content a -> (content -> m b) @@ -59,6 +69,13 @@ runHeaderMonadic :: (Monad m, Monoid b) runHeaderMonadic (Encoding v) g = fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneEncodingHead) v +runHeaderMonadicGeneral_ :: (Monad m, Monoid b, Foldable h) + => Encoding h content a + -> (content -> m b) + -> m () +runHeaderMonadicGeneral_ (Encoding v) g = + Vector.mapM_ (Internal.foldlMapM g . oneEncodingHead) v + runHeaderMonadic_ :: (Monad m) => Encoding Headed content a diff --git a/reflex-dom-colonnade/reflex-dom-colonnade.cabal b/reflex-dom-colonnade/reflex-dom-colonnade.cabal index 3bf08d8..2724887 100644 --- a/reflex-dom-colonnade/reflex-dom-colonnade.cabal +++ b/reflex-dom-colonnade/reflex-dom-colonnade.cabal @@ -1,5 +1,5 @@ name: reflex-dom-colonnade -version: 0.4.4 +version: 0.4.5 synopsis: Use colonnade with reflex-dom description: Please see README.md homepage: https://github.com/andrewthad/colonnade#readme diff --git a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs index f7076f8..0bbdf36 100644 --- a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs +++ b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs @@ -68,8 +68,9 @@ expandable tableClass tdExtraClass as encoding@(Encoding v) = do _ <- theadBuild_ encoding el "tbody" $ forM_ as $ \a -> do e' <- el "tr" $ do - e <- Encoding.runRowMonadicWith never const encoding (elFromCell "td") a - let e' = flip fmap e $ \mwidg -> case mwidg of + elist <- Encoding.runRowMonadicWith [] (++) encoding (fmap (\a -> [a]) . elFromCell "td") a + let e = leftmost elist + e' = flip fmap e $ \mwidg -> case mwidg of Nothing -> return () Just widg -> el "tr" $ do elAttr "td" ( Map.fromList diff --git a/stack.yaml b/stack.yaml index ad9afff..d4193b3 100644 --- a/stack.yaml +++ b/stack.yaml @@ -37,6 +37,7 @@ resolver: lts-6.4 # will not be run. This is useful for tweaking upstream packages. packages: - 'colonnade' +- 'yesod-colonnade' - 'reflex-dom-colonnade' - 'siphon' - 'geolite-csv' @@ -50,7 +51,7 @@ extra-deps: - 'haskell-src-exts-1.16.0.1' - 'syb-0.5.1' - 'ip-0.8.4' - +- 'lmdb-0.2.5' # Override default flag values for local packages and extra-deps diff --git a/yesod-colonnade/LICENSE b/yesod-colonnade/LICENSE new file mode 100644 index 0000000..9beb3f9 --- /dev/null +++ b/yesod-colonnade/LICENSE @@ -0,0 +1,30 @@ +Copyright Andrew Martin (c) 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Andrew Martin nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/yesod-colonnade/Setup.hs b/yesod-colonnade/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/yesod-colonnade/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/yesod-colonnade/hackage-docs.sh b/yesod-colonnade/hackage-docs.sh new file mode 100755 index 0000000..0ddbc20 --- /dev/null +++ b/yesod-colonnade/hackage-docs.sh @@ -0,0 +1,48 @@ +#!/bin/bash +set -e + +if [ "$#" -ne 1 ]; then + echo "Usage: scripts/hackage-docs.sh HACKAGE_USER" + exit 1 +fi + +user=$1 + +cabal_file=$(find . -maxdepth 1 -name "*.cabal" -print -quit) +if [ ! -f "$cabal_file" ]; then + echo "Run this script in the top-level package directory" + exit 1 +fi + +pkg=$(awk -F ":[[:space:]]*" 'tolower($1)=="name" { print $2 }' < "$cabal_file") +ver=$(awk -F ":[[:space:]]*" 'tolower($1)=="version" { print $2 }' < "$cabal_file") + +if [ -z "$pkg" ]; then + echo "Unable to determine package name" + exit 1 +fi + +if [ -z "$ver" ]; then + echo "Unable to determine package version" + exit 1 +fi + +echo "Detected package: $pkg-$ver" + +dir=$(mktemp -d build-docs.XXXXXX) +trap 'rm -r "$dir"' EXIT + +# cabal haddock --hoogle --hyperlink-source --html-location='/package/$pkg-$version/docs' --contents-location='/package/$pkg-$version' +stack haddock + +cp -R .stack-work/dist/x86_64-linux/Cabal-1.22.5.0/doc/html/$pkg/ $dir/$pkg-$ver-docs +# /home/andrew/.stack/snapshots/x86_64-linux/lts-5.17/7.10.3/doc/index.html + +tar cvz -C $dir --format=ustar -f $dir/$pkg-$ver-docs.tar.gz $pkg-$ver-docs + +curl -X PUT \ + -H 'Content-Type: application/x-tar' \ + -H 'Content-Encoding: gzip' \ + -u "$user" \ + --data-binary "@$dir/$pkg-$ver-docs.tar.gz" \ + "https://hackage.haskell.org/package/$pkg-$ver/docs" diff --git a/yesod-colonnade/src/Yesod/Colonnade.hs b/yesod-colonnade/src/Yesod/Colonnade.hs new file mode 100644 index 0000000..5e2a207 --- /dev/null +++ b/yesod-colonnade/src/Yesod/Colonnade.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE QuasiQuotes #-} + +module Yesod.Colonnade + ( table + ) where + +import Yesod.Core +import Colonnade.Types +import Data.Text (Text) +import Control.Monad +import qualified Colonnade.Encoding as Encoding + +data Cell site = Cell + { cellAttrs :: ![(Text,Text)] + , cellContents :: !(WidgetT site IO ()) + } + +cell :: WidgetT site IO () -> Cell site +cell = Cell [] + +textCell :: Text -> Cell site +textCell = cell . toWidget . toHtml + +table :: Foldable f + => [(Text,Text)] -- ^ Attributes of @table@ element + -> Encoding Headed (Cell site) a -- ^ How to encode data as a row + -> f a -- ^ Rows of data + -> WidgetT site IO () +table attrs enc xs = tableEl attrs $ do + thead [] $ Encoding.runHeaderMonadic enc (widgetFromCell th) + tableBody enc xs + +tableHeadless :: Foldable f + => [(Text,Text)] -- ^ Attributes of @table@ element + -> Encoding Headless (Cell site) a -- ^ How to encode data as a row + -> f a -- ^ Rows of data + -> WidgetT site IO () +tableHeadless attrs enc xs = tableEl attrs $ tableBody enc xs + +tableBody :: Foldable f + => Encoding h (Cell site) a -- ^ How to encode data as a row + -> f a -- ^ Rows of data + -> WidgetT site IO () +tableBody enc xs = tbody [] $ do + forM_ xs $ \x -> do + tr [] $ Encoding.runRowMonadic enc (widgetFromCell td) x + +widgetFromCell :: + ([(Text,Text)] -> WidgetT site IO () -> WidgetT site IO ()) + -> Cell site + -> WidgetT site IO () +widgetFromCell f (Cell attrs contents) = + f attrs contents + +tr,tbody,thead,tableEl,td,th :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO () +tableEl str b = [whamlet| + ^{b} +|] +thead str b = [whamlet| + ^{b} +|] +tbody str b = [whamlet| + ^{b} +|] +tr str b = [whamlet| + ^{b} +|] +th str b = [whamlet| +
^{b} +|] +td str b = [whamlet| + ^{b} +|] + diff --git a/yesod-colonnade/yesod-colonnade.cabal b/yesod-colonnade/yesod-colonnade.cabal new file mode 100644 index 0000000..30ec5ca --- /dev/null +++ b/yesod-colonnade/yesod-colonnade.cabal @@ -0,0 +1,28 @@ +name: yesod-colonnade +version: 0.1 +synopsis: Helper functions for using yesod with colonnade +description: Yesod and colonnade +homepage: https://github.com/andrewthad/colonnade#readme +license: BSD3 +license-file: LICENSE +author: Andrew Martin +maintainer: andrew.thaddeus@gmail.com +copyright: 2016 Andrew Martin +category: web +build-type: Simple +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: + Yesod.Colonnade + build-depends: + base >= 4.7 && < 5 + , colonnade + , yesod-core + , text + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/andrewthad/colonnade