From eb29b10c395495ea62fd4494d066f20e6ba6069d Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Mon, 6 Feb 2017 09:03:10 -0500 Subject: [PATCH] add blaze support --- .gitignore | 1 + blaze-colonnade/LICENSE | 30 ++++ blaze-colonnade/Setup.hs | 2 + blaze-colonnade/blaze-colonnade.cabal | 29 ++++ blaze-colonnade/hackage-docs.sh | 48 ++++++ blaze-colonnade/src/Text/Blaze/Colonnade.hs | 168 ++++++++++++++++++++ colonnade/colonnade.cabal | 3 +- colonnade/src/Colonnade.hs | 124 +++------------ colonnade/src/Colonnade/Encode.hs | 132 +++++++++++++++ colonnade/src/Colonnade/Internal.hs | 30 ++-- stack.yaml | 6 +- yesod-colonnade/src/Yesod/Colonnade.hs | 20 +-- yesod-colonnade/yesod-colonnade.cabal | 8 +- 13 files changed, 467 insertions(+), 134 deletions(-) create mode 100644 blaze-colonnade/LICENSE create mode 100644 blaze-colonnade/Setup.hs create mode 100644 blaze-colonnade/blaze-colonnade.cabal create mode 100755 blaze-colonnade/hackage-docs.sh create mode 100644 blaze-colonnade/src/Text/Blaze/Colonnade.hs create mode 100644 colonnade/src/Colonnade/Encode.hs diff --git a/.gitignore b/.gitignore index 14ac059..393ba29 100644 --- a/.gitignore +++ b/.gitignore @@ -35,6 +35,7 @@ tags TAGS docs/db/unthreat +ex1.hs geolite-csv/data/large geolite-lmdb/data/large diff --git a/blaze-colonnade/LICENSE b/blaze-colonnade/LICENSE new file mode 100644 index 0000000..9beb3f9 --- /dev/null +++ b/blaze-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/blaze-colonnade/Setup.hs b/blaze-colonnade/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/blaze-colonnade/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/blaze-colonnade/blaze-colonnade.cabal b/blaze-colonnade/blaze-colonnade.cabal new file mode 100644 index 0000000..58811c8 --- /dev/null +++ b/blaze-colonnade/blaze-colonnade.cabal @@ -0,0 +1,29 @@ +name: blaze-colonnade +version: 0.1 +synopsis: Helper functions for using blaze-html with colonnade +description: Blaze HTML and colonnade +homepage: https://github.com/andrewthad/colonnade#readme +license: BSD3 +license-file: LICENSE +author: Andrew Martin +maintainer: andrew.thaddeus@gmail.com +copyright: 2017 Andrew Martin +category: web +build-type: Simple +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: + Text.Blaze.Colonnade + build-depends: + base >= 4.7 && < 5 + , colonnade >= 1.0 && < 1.1 + , blaze-markup >= 0.7 && < 0.9 + , blaze-html >= 0.8 && < 0.10 + , text >= 1.0 && < 1.3 + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/andrewthad/colonnade diff --git a/blaze-colonnade/hackage-docs.sh b/blaze-colonnade/hackage-docs.sh new file mode 100755 index 0000000..0ddbc20 --- /dev/null +++ b/blaze-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/blaze-colonnade/src/Text/Blaze/Colonnade.hs b/blaze-colonnade/src/Text/Blaze/Colonnade.hs new file mode 100644 index 0000000..25de99f --- /dev/null +++ b/blaze-colonnade/src/Text/Blaze/Colonnade.hs @@ -0,0 +1,168 @@ +-- | Build HTML tables using @blaze-html@ and @colonnade@. +-- +module Text.Blaze.Colonnade + ( -- * Apply + -- $build + encodeHeadedHtmlTable + , encodeHeadlessHtmlTable + , encodeHeadedCellTable + , encodeHeadlessCellTable + , encodeTable + -- * Cell + -- $build + , Cell(..) + , htmlCell + , stringCell + , textCell + , lazyTextCell + , builderCell + -- * Discussion + -- $discussion + ) where + +import Text.Blaze (Attribute,(!)) +import Text.Blaze.Html (Html, toHtml) +import Colonnade (Colonnade,Headed,Headless) +import Data.Text (Text) +import Control.Monad +import Data.Monoid +import Data.Foldable +import Data.String (IsString(..)) +import qualified Text.Blaze as Blaze +import qualified Text.Blaze.Html5 as H +import qualified Text.Blaze.Html5.Attributes as HA +import qualified Colonnade.Encode as Encode +import qualified Data.Text as Text +import qualified Data.Text.Lazy as LText +import qualified Data.Text.Lazy.Builder as TBuilder + +-- $build +-- +-- The 'Cell' type is used to build a 'Colonnade' that +-- has 'Html' content inside table cells and may optionally +-- have attributes added to the @@ or @@ elements +-- that wrap this HTML content. + +-- | The attributes that will be applied to a @@ and +-- the HTML content that will go inside it. +data Cell = Cell + { cellAttributes :: !Attribute + , cellHtml :: !Html + } + +instance IsString Cell where + fromString = stringCell + +instance Monoid Cell where + mempty = Cell mempty mempty + mappend (Cell a1 c1) (Cell a2 c2) = Cell (mappend a1 a2) (mappend c1 c2) + +-- | Create a 'Cell' from a 'Widget' +htmlCell :: Html -> Cell +htmlCell = Cell mempty + +-- | Create a 'Cell' from a 'String' +stringCell :: String -> Cell +stringCell = htmlCell . fromString + +-- | Create a 'Cell' from a 'Text' +textCell :: Text -> Cell +textCell = htmlCell . toHtml + +-- | Create a 'Cell' from a lazy text +lazyTextCell :: LText.Text -> Cell +lazyTextCell = textCell . LText.toStrict + +-- | Create a 'Cell' from a text builder +builderCell :: TBuilder.Builder -> Cell +builderCell = lazyTextCell . TBuilder.toLazyText + +encodeTable :: + (Foldable f, Foldable h) + => Maybe Attribute -- ^ Attributes of @@, pass 'Nothing' to omit @@ + -> Attribute -- ^ Attributes of @@ element + -> (a -> Attribute) -- ^ Attributes of each @@ element + -> ((Html -> Html) -> c -> Html) -- ^ Wrap content and convert to 'Html' + -> Attribute -- ^ Attributes of @@ element + -> Colonnade h c a -- ^ How to encode data as a row + -> f a -- ^ Collection of data + -> Html +encodeTable mtheadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs = + H.table ! tableAttrs $ do + for_ mtheadAttrs $ \theadAttrs -> do + H.thead ! theadAttrs $ do + Encode.headerMonadicGeneral_ colonnade (wrapContent H.th) + H.tbody ! tbodyAttrs $ do + forM_ xs $ \x -> do + H.tr ! trAttrs x $ Encode.rowMonadic_ colonnade (wrapContent H.td) x + +encodeHeadedCellTable :: + Foldable f + => Attribute -- ^ Attributes of @
@ element + -> Colonnade Headed Cell a -- ^ How to encode data as columns + -> f a -- ^ Collection of data + -> Html +encodeHeadedCellTable = encodeTable + (Just mempty) mempty (const mempty) htmlFromCell + +encodeHeadlessCellTable :: + Foldable f + => Attribute -- ^ Attributes of @
@ element + -> Colonnade Headless Cell a -- ^ How to encode data as columns + -> f a -- ^ Collection of data + -> Html +encodeHeadlessCellTable = encodeTable + Nothing mempty (const mempty) htmlFromCell + +encodeHeadedHtmlTable :: + Foldable f + => Attribute -- ^ Attributes of @
@ element + -> Colonnade Headed Html a -- ^ How to encode data as columns + -> f a -- ^ Collection of data + -> Html +encodeHeadedHtmlTable = encodeTable + (Just mempty) mempty (const mempty) ($) + +encodeHeadlessHtmlTable :: + Foldable f + => Attribute -- ^ Attributes of @
@ element + -> Colonnade Headless Html a -- ^ How to encode data as columns + -> f a -- ^ Collection of data + -> Html +encodeHeadlessHtmlTable = encodeTable + Nothing mempty (const mempty) ($) + +tableBody :: Foldable f + => Colonnade h Cell a -- ^ How to encode data as a row + -> f a -- ^ Rows of data + -> Html +tableBody enc xs = H.tbody $ do + forM_ xs $ \x -> do + H.tr $ Encode.rowMonadic enc (htmlFromCell H.td) x + +htmlFromCell :: (Html -> Html) -> Cell -> Html +htmlFromCell f (Cell attr content) = f ! attr $ content + +-- $discussion +-- +-- In this module, some of the functions for applying a 'Colonnade' to +-- some values to build a table have roughly this type signature: +-- +-- > Foldable a => Colonnade Headedness Cell a -> f a -> Html +-- +-- The 'Colonnade'\'s content type is 'Cell', but the content +-- type of the result is 'Html'. It may not be immidiately clear why +-- this is useful done. Another strategy, which this library also +-- uses, is to write +-- these functions to take a 'Colonnade' whose content is 'Html': +-- +-- > Foldable a => Colonnade Headedness Html a -> f a -> Html +-- +-- When the 'Colonnade'\'s content type is 'Html', then the header +-- content is rendered as the child of a @
@ and the row +-- content the child of a @@. However, it is not possible +-- to add attributes to these parent elements. To accomodate this +-- situation, it is necessary to introduce 'Cell', which includes +-- the possibility of attributes on the parent node. + + diff --git a/colonnade/colonnade.cabal b/colonnade/colonnade.cabal index 7f4d4cb..6f07682 100644 --- a/colonnade/colonnade.cabal +++ b/colonnade/colonnade.cabal @@ -1,5 +1,5 @@ name: colonnade -version: 0.5 +version: 1.0.0 synopsis: Generic types and functions for columnar encoding and decoding description: The `colonnade` package provides a way to to talk about @@ -29,6 +29,7 @@ library hs-source-dirs: src exposed-modules: Colonnade + Colonnade.Encode Colonnade.Internal build-depends: base >= 4.7 && < 5 diff --git a/colonnade/src/Colonnade.hs b/colonnade/src/Colonnade.hs index 049c851..96a72e9 100644 --- a/colonnade/src/Colonnade.hs +++ b/colonnade/src/Colonnade.hs @@ -17,23 +17,12 @@ module Colonnade , bool , replaceWhen , mapContent - -- * Render - -- $render - , runRow - , runRowMonadic - , runRowMonadic_ - , runRowMonadicWith - , runHeader - , runHeaderMonadic - , runHeaderMonadic_ - , runHeaderMonadicGeneral - , runHeaderMonadicGeneral_ - , runBothMonadic_ -- * Ascii Table , ascii ) where import Colonnade.Internal +import qualified Colonnade.Encode as Encode import Data.Vector (Vector) import Data.Foldable import Data.Monoid (Endo(..)) @@ -211,94 +200,6 @@ mapContent :: Functor f => (c1 -> c2) -> Colonnade f c1 a -> Colonnade f c2 a mapContent f (Colonnade v) = Colonnade $ Vector.map (\(OneColonnade h c) -> (OneColonnade (fmap f h) (f . c))) v --- $render --- --- The rendering functions, which by convention begin with --- the word @run@, are provided as a convenience for for --- apply a columnar encoding. - - - --- | Consider providing a variant the produces a list --- instead. It may allow more things to get inlined --- in to a loop. -runRow :: (c1 -> c2) -> Colonnade f c1 a -> a -> Vector c2 -runRow g (Colonnade v) a = flip Vector.map v $ - \(OneColonnade _ encode) -> g (encode a) - -runBothMonadic_ :: Monad m - => Colonnade Headed content a - -> (content -> content -> m b) - -> a - -> m () -runBothMonadic_ (Colonnade v) g a = - forM_ v $ \(OneColonnade (Headed h) encode) -> g h (encode a) - -runRowMonadic :: (Monad m, Monoid b) - => Colonnade f content a - -> (content -> m b) - -> a - -> m b -runRowMonadic (Colonnade v) g a = - flip foldlMapM v - $ \e -> g (oneColonnadeEncode e a) - -runRowMonadic_ :: Monad m - => Colonnade f content a - -> (content -> m b) - -> a - -> m () -runRowMonadic_ (Colonnade v) g a = - forM_ v $ \e -> g (oneColonnadeEncode e a) - -runRowMonadicWith :: (Monad m) - => b - -> (b -> b -> b) - -> Colonnade f content a - -> (content -> m b) - -> a - -> m b -runRowMonadicWith bempty bappend (Colonnade v) g a = - foldlM (\bl e -> do - br <- g (oneColonnadeEncode e a) - return (bappend bl br) - ) bempty v - -runHeader :: (c1 -> c2) -> Colonnade Headed c1 a -> Vector c2 -runHeader g (Colonnade v) = - Vector.map (g . getHeaded . oneColonnadeHead) 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) - => Colonnade h content a - -> (content -> m b) - -> m b -runHeaderMonadicGeneral (Colonnade v) g = id - $ fmap (mconcat . Vector.toList) - $ Vector.mapM (foldlMapM g . oneColonnadeHead) v - -runHeaderMonadic :: (Monad m, Monoid b) - => Colonnade Headed content a - -> (content -> m b) - -> m b -runHeaderMonadic (Colonnade v) g = - fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneColonnadeHead) v - -runHeaderMonadicGeneral_ :: (Monad m, Monoid b, Foldable h) - => Colonnade h content a - -> (content -> m b) - -> m () -runHeaderMonadicGeneral_ (Colonnade v) g = - Vector.mapM_ (foldlMapM g . oneColonnadeHead) v - -runHeaderMonadic_ :: - (Monad m) - => Colonnade Headed content a - -> (content -> m b) - -> m () -runHeaderMonadic_ (Colonnade v) g = Vector.mapM_ (g . getHeaded . oneColonnadeHead) v - -- | Render a collection of rows as an ascii table. The table\'s columns are -- specified by the given 'Colonnade'. This implementation is inefficient and -- does not provide any wrapping behavior. It is provided so that users can @@ -310,9 +211,9 @@ ascii :: Foldable f -> String ascii enc xs = let theHeader :: [(Int,String)] - theHeader = (zip (enumFrom 0) . map (\s -> " " ++ s ++ " ")) (toList (runHeader id enc)) + theHeader = (zip (enumFrom 0) . map (\s -> " " ++ s ++ " ")) (toList (Encode.header id enc)) theBody :: [[(Int,String)]] - theBody = map (zip (enumFrom 0) . map (\s -> " " ++ s ++ " ") . toList . runRow id enc) (toList xs) + theBody = map (zip (enumFrom 0) . map (\s -> " " ++ s ++ " ") . toList . Encode.row id enc) (toList xs) sizes :: [Int] sizes = ($ replicate (length theHeader) 1) $ appEndo $ mconcat [ foldMap (\(i,str) -> Endo (replaceAt i (length str))) theHeader @@ -354,8 +255,23 @@ atDef def = Data.Maybe.fromMaybe def .^ atMay where f i (_:zs) = f (i-1) zs f i [] = Left $ "index too large, index=" ++ show o ++ ", length=" ++ show (o-i) -foldlMapM :: (Foldable t, Monoid b, Monad m) => (a -> m b) -> t a -> m b -foldlMapM f = foldlM (\b a -> fmap (mappend b) (f a)) mempty +-- data Company = Company String String Int +-- +-- data Company = Company +-- { companyName :: String +-- , companyCountry :: String +-- , companyValue :: Int +-- } deriving (Show) +-- +-- myCompanies :: [Company] +-- myCompanies = +-- [ Company "eCommHub" "United States" 50 +-- , Company "Layer 3 Communications" "United States" 10000000 +-- , Company "Microsoft" "England" 500000000 +-- ] + + + diff --git a/colonnade/src/Colonnade/Encode.hs b/colonnade/src/Colonnade/Encode.hs new file mode 100644 index 0000000..7db967a --- /dev/null +++ b/colonnade/src/Colonnade/Encode.hs @@ -0,0 +1,132 @@ +-- | Most users of this library do not need this module. The functions +-- here are used to build functions that apply a 'Colonnade' +-- to a collection of values, building a table from them. Ultimately, +-- a function that applies a @Colonnade Headed MyCell a@ +-- to data will have roughly the following type: +-- +-- > myTableRenderer :: Foldable g => Colonnade Headed MyCell a -> g a -> MyContent +-- +-- In the companion packages @yesod-colonnade@ and +-- @reflex-dom-colonnade@, functions with +-- similar type signatures are readily available. +-- These packages use the functions provided here +-- in the implementations of their rendering functions. +-- It is recommended that users who believe they may need +-- this module look at the source of the companion packages +-- to see an example of how this module\'s functions are used. +-- Other backends are encouraged to use these functions +-- to build monadic or monoidal content from a 'Colonnade'. +-- +-- The functions exported here take a 'Colonnade' and +-- convert it to a fragment of content. The functions whose +-- names start with @row@ take at least a @Colonnade f c a@ and an @a@ +-- value to generate a row of content. The functions whose names +-- start with @header@ need the @Colonnade f c a@ but not +-- an @a@ value since a value is not needed to build a header. +-- +module Colonnade.Encode + ( row + , rowMonadic + , rowMonadic_ + , rowMonadicWith + , header + , headerMonadic + , headerMonadic_ + , headerMonadicGeneral + , headerMonadicGeneral_ + , bothMonadic_ + ) where + +import Colonnade.Internal +import Data.Vector (Vector) +import Data.Foldable +import qualified Data.Vector as Vector + +-- | Consider providing a variant the produces a list +-- instead. It may allow more things to get inlined +-- in to a loop. +row :: (c1 -> c2) -> Colonnade f c1 a -> a -> Vector c2 +row g (Colonnade v) a = flip Vector.map v $ + \(OneColonnade _ encode) -> g (encode a) + +bothMonadic_ :: Monad m + => Colonnade Headed content a + -> (content -> content -> m b) + -> a + -> m () +bothMonadic_ (Colonnade v) g a = + forM_ v $ \(OneColonnade (Headed h) encode) -> g h (encode a) + +rowMonadic :: + (Monad m, Monoid b) + => Colonnade f content a + -> (content -> m b) + -> a + -> m b +rowMonadic (Colonnade v) g a = + flip foldlMapM v + $ \e -> g (oneColonnadeEncode e a) + +rowMonadic_ :: + Monad m + => Colonnade f content a + -> (content -> m b) + -> a + -> m () +rowMonadic_ (Colonnade v) g a = + forM_ v $ \e -> g (oneColonnadeEncode e a) + +rowMonadicWith :: + (Monad m) + => b + -> (b -> b -> b) + -> Colonnade f content a + -> (content -> m b) + -> a + -> m b +rowMonadicWith bempty bappend (Colonnade v) g a = + foldlM (\bl e -> do + br <- g (oneColonnadeEncode e a) + return (bappend bl br) + ) bempty v + +header :: (c1 -> c2) -> Colonnade Headed c1 a -> Vector c2 +header g (Colonnade v) = + Vector.map (g . getHeaded . oneColonnadeHead) v + +-- | This function is a helper for abusing 'Foldable' to optionally +-- render a header. Its future is uncertain. +headerMonadicGeneral :: (Monad m, Monoid b, Foldable h) + => Colonnade h content a + -> (content -> m b) + -> m b +headerMonadicGeneral (Colonnade v) g = id + $ fmap (mconcat . Vector.toList) + $ Vector.mapM (foldlMapM g . oneColonnadeHead) v + +headerMonadic :: + (Monad m, Monoid b) + => Colonnade Headed content a + -> (content -> m b) + -> m b +headerMonadic (Colonnade v) g = + fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneColonnadeHead) v + +headerMonadicGeneral_ :: + (Monad m, Foldable h) + => Colonnade h content a + -> (content -> m b) + -> m () +headerMonadicGeneral_ (Colonnade v) g = + Vector.mapM_ (mapM_ g . oneColonnadeHead) v + +headerMonadic_ :: + (Monad m) + => Colonnade Headed content a + -> (content -> m b) + -> m () +headerMonadic_ (Colonnade v) g = Vector.mapM_ (g . getHeaded . oneColonnadeHead) v + +foldlMapM :: (Foldable t, Monoid b, Monad m) => (a -> m b) -> t a -> m b +foldlMapM f = foldlM (\b a -> fmap (mappend b) (f a)) mempty + diff --git a/colonnade/src/Colonnade/Internal.hs b/colonnade/src/Colonnade/Internal.hs index 4500b86..de0f3ad 100644 --- a/colonnade/src/Colonnade/Internal.hs +++ b/colonnade/src/Colonnade/Internal.hs @@ -46,15 +46,15 @@ instance Contravariant Headless where contramap _ Headless = Headless -- | Encodes a header and a cell. -data OneColonnade f content a = OneColonnade - { oneColonnadeHead :: !(f content) +data OneColonnade h content a = OneColonnade + { oneColonnadeHead :: !(h content) , oneColonnadeEncode :: !(a -> content) } -instance Contravariant (OneColonnade f content) where +instance Contravariant (OneColonnade h content) where contramap f (OneColonnade h e) = OneColonnade h (e . f) --- | An columnar encoding of @a@. The type variable @f@ determines what +-- | An columnar encoding of @a@. The type variable @h@ determines what -- is present in each column in the header row. It is typically instantiated -- to 'Headed' and occasionally to 'Headless'. There is nothing that -- restricts it to these two types, although they satisfy the majority @@ -62,7 +62,17 @@ instance Contravariant (OneColonnade f content) where -- be @Text@, @String@, or @ByteString@. In the companion libraries -- @reflex-dom-colonnade@ and @yesod-colonnade@, additional types -- that represent HTML with element attributes are provided that serve --- as the content type. +-- as the content type. Presented more visually: +-- +-- > +---- Content (Text, ByteString, Html, etc.) +-- > | +-- > v +-- > Colonnade h c a +-- > ^ ^ +-- > | | +-- > | +-- Value consumed to build a row +-- > | +-- > +------ Headedness (Headed or Headless) -- -- Internally, a 'Colonnade' is represented as a 'Vector' of individual -- column encodings. It is possible to use any collection type with @@ -71,20 +81,18 @@ instance Contravariant (OneColonnade f content) where -- once and then folding over it many times. It is recommended that -- 'Colonnade's are defined at the top-level so that GHC avoids reconstructing -- them every time they are used. -newtype Colonnade f c a = Colonnade - { getColonnade :: Vector (OneColonnade f c a) +newtype Colonnade h c a = Colonnade + { getColonnade :: Vector (OneColonnade h c a) } deriving (Monoid) -instance Contravariant (Colonnade f content) where +instance Contravariant (Colonnade h content) where contramap f (Colonnade v) = Colonnade (Vector.map (contramap f) v) -instance Divisible (Colonnade f content) where +instance Divisible (Colonnade h content) where conquer = Colonnade Vector.empty divide f (Colonnade a) (Colonnade b) = Colonnade $ (Vector.++) (Vector.map (contramap (fst . f)) a) (Vector.map (contramap (snd . f)) b) - -- (Vector.map (\(OneEncoding h c) -> (h,c . fst . f)) a) - -- (Vector.map (\(OneEncoding h c) -> (h,c . snd . f)) b) diff --git a/stack.yaml b/stack.yaml index 6a662bd..f4b02b9 100644 --- a/stack.yaml +++ b/stack.yaml @@ -15,7 +15,7 @@ # resolver: # name: custom-snapshot # location: "./custom-snapshot.yaml" -resolver: lts-6.5 +resolver: lts-7.18 # User packages to be built. # Various formats can be used as shown in the example below. @@ -39,6 +39,7 @@ packages: - 'colonnade' - 'yesod-colonnade' - 'reflex-dom-colonnade' +- 'blaze-colonnade' - 'siphon' - 'geolite-csv' # Dependency packages to be pulled from upstream that are not in the resolver @@ -47,12 +48,9 @@ extra-deps: - 'reflex-dom-0.3' - 'ref-tf-0.4' - 'reflex-0.4.0' -- 'aeson-0.9.0.1' - '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 flags: {} diff --git a/yesod-colonnade/src/Yesod/Colonnade.hs b/yesod-colonnade/src/Yesod/Colonnade.hs index 7cb3fda..99facbe 100644 --- a/yesod-colonnade/src/Yesod/Colonnade.hs +++ b/yesod-colonnade/src/Yesod/Colonnade.hs @@ -2,14 +2,14 @@ {-# LANGUAGE QuasiQuotes #-} module Yesod.Colonnade - ( -- * Build Encoding + ( -- * Build Cell(..) , cell , stringCell , textCell , builderCell , anchorCell - -- * Apply Encoding + -- * Apply , table , tableHeadless , definitionTable @@ -17,12 +17,12 @@ module Yesod.Colonnade ) where import Yesod.Core -import Colonnade.Types (Colonnade,Headed,Headless) +import Colonnade (Colonnade,Headed,Headless) import Data.Text (Text) import Control.Monad import Data.Monoid import Data.String (IsString(..)) -import qualified Colonnade.Encoding as Encoding +import qualified Colonnade.Encode as Encode import qualified Data.Text as Text import qualified Data.Text.Lazy as LText import qualified Data.Text.Lazy.Builder as TBuilder @@ -60,8 +60,8 @@ builderCell = cell . toWidget . toHtml . LText.toStrict . TBuilder.toLazyText -- | Creata a 'Cell' whose content is hyperlinked by wrapping -- it in an @@. anchorCell :: - (a -> Route site) -- ^ Route that will go in @href@ - -> (a -> WidgetT site IO ()) -- ^ Content wrapped by @@ + (a -> Route site) -- ^ Route that will go in @href@ attribute + -> (a -> WidgetT site IO ()) -- ^ Content wrapped by @@ tag -> a -- ^ Value -> Cell site anchorCell getRoute getContent a = cell $ do @@ -82,7 +82,7 @@ listItems :: -- ^ The value to display -> WidgetT site IO () listItems ulWrap combine enc = - ulWrap . Encoding.runBothMonadic_ enc + ulWrap . Encode.bothMonadic_ enc (\(Cell ha hc) (Cell ba bc) -> li (ha ++ ba) (combine hc bc) ) @@ -99,7 +99,7 @@ definitionTable :: -- ^ The value to display -> WidgetT site IO () definitionTable attrs enc a = tableEl attrs $ tbody [] $ - Encoding.runBothMonadic_ enc + Encode.bothMonadic_ enc (\theKey theValue -> tr [] $ do widgetFromCell td theKey widgetFromCell td theValue @@ -115,7 +115,7 @@ table :: Foldable f -> f a -- ^ Rows of data -> WidgetT site IO () table attrs enc xs = tableEl attrs $ do - thead [] $ Encoding.runHeaderMonadic enc (widgetFromCell th) + thead [] $ Encode.headerMonadic enc (widgetFromCell th) tableBody enc xs tableHeadless :: Foldable f @@ -131,7 +131,7 @@ tableBody :: Foldable f -> WidgetT site IO () tableBody enc xs = tbody [] $ do forM_ xs $ \x -> do - tr [] $ Encoding.runRowMonadic enc (widgetFromCell td) x + tr [] $ Encode.rowMonadic enc (widgetFromCell td) x widgetFromCell :: ([(Text,Text)] -> WidgetT site IO () -> WidgetT site IO ()) diff --git a/yesod-colonnade/yesod-colonnade.cabal b/yesod-colonnade/yesod-colonnade.cabal index 5786d2b..4236a64 100644 --- a/yesod-colonnade/yesod-colonnade.cabal +++ b/yesod-colonnade/yesod-colonnade.cabal @@ -1,5 +1,5 @@ name: yesod-colonnade -version: 0.2 +version: 0.3 synopsis: Helper functions for using yesod with colonnade description: Yesod and colonnade homepage: https://github.com/andrewthad/colonnade#readme @@ -13,15 +13,15 @@ build-type: Simple cabal-version: >=1.10 library - hs-source-dirs: src + hs-source-dirs: src exposed-modules: Yesod.Colonnade build-depends: base >= 4.7 && < 5 - , colonnade >= 0.5 && < 0.6 + , colonnade >= 1.0 && < 1.1 , yesod-core >= 1.4.0 && < 1.5 , text >= 1.0 && < 1.3 - default-language: Haskell2010 + default-language: Haskell2010 source-repository head type: git