From e80f7cdd8323bcb7616e36c79e73d568e87fb329 Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Thu, 1 Feb 2018 07:36:01 -0500 Subject: [PATCH] update blaze-colonnade to work agree with how everything else uses Headedness --- blaze-colonnade/blaze-colonnade.cabal | 2 +- blaze-colonnade/src/Text/Blaze/Colonnade.hs | 104 +++++++++----------- stack.yaml | 2 +- yesod-colonnade/src/Yesod/Colonnade.hs | 44 +++------ 4 files changed, 65 insertions(+), 87 deletions(-) diff --git a/blaze-colonnade/blaze-colonnade.cabal b/blaze-colonnade/blaze-colonnade.cabal index 2602abf..e6d96cb 100644 --- a/blaze-colonnade/blaze-colonnade.cabal +++ b/blaze-colonnade/blaze-colonnade.cabal @@ -1,5 +1,5 @@ name: blaze-colonnade -version: 1.1.1 +version: 1.2.0 synopsis: Helper functions for using blaze-html with colonnade description: Blaze HTML and colonnade homepage: https://github.com/andrewthad/colonnade#readme diff --git a/blaze-colonnade/src/Text/Blaze/Colonnade.hs b/blaze-colonnade/src/Text/Blaze/Colonnade.hs index 9398f43..fa70e3b 100644 --- a/blaze-colonnade/src/Text/Blaze/Colonnade.hs +++ b/blaze-colonnade/src/Text/Blaze/Colonnade.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + -- | Build HTML tables using @blaze-html@ and @colonnade@. The bottom -- of this page has a tutorial that walks through a full example, -- illustrating how to meet typical needs with this library. It is @@ -9,7 +12,7 @@ -- >>> :module + Colonnade Text.Blaze.Html Text.Blaze.Colonnade -- >>> let col = headed "Grade" (toHtml . fst) <> headed "Letter" (toHtml . snd) -- >>> let rows = [("90-100",'A'),("80-89",'B'),("70-79",'C')] --- >>> printVeryCompactHtml (encodeHeadedHtmlTable mempty col rows) +-- >>> printVeryCompactHtml (encodeHtmlTable mempty col rows) -- -- -- @@ -22,10 +25,8 @@ --
GradeLetter
module Text.Blaze.Colonnade ( -- * Apply - encodeHeadedHtmlTable - , encodeHeadlessHtmlTable - , encodeHeadedCellTable - , encodeHeadlessCellTable + encodeHtmlTable + , encodeCellTable , encodeTable , encodeCappedTable -- * Cell @@ -62,7 +63,7 @@ import qualified Text.Blaze.Html.Renderer.Pretty as Pretty 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 Colonnade.Encode as E import qualified Data.Text as Text import qualified Data.Text.Lazy as LText import qualified Data.Text.Lazy.Builder as TBuilder @@ -113,7 +114,7 @@ import qualified Data.Text.Lazy.Builder as TBuilder -- Let\'s continue: -- -- >>> let customAttrs = HA.class_ "stylish-table" <> HA.id "main-table" --- >>> printCompactHtml (encodeHeadedHtmlTable customAttrs tableEmpA employees) +-- >>> printCompactHtml (encodeHtmlTable customAttrs tableEmpA employees) -- -- -- @@ -163,10 +164,10 @@ import qualified Data.Text.Lazy.Builder as TBuilder -- literal @"Dept."@ to be accepted as a value of type 'Cell'. To avoid -- this extension, 'stringCell' could be used to upcast the 'String'. -- To try out our 'Colonnade' on a list of departments, we need to use --- 'encodeHeadedCellTable' instead of 'encodeHeadedHtmlTable': +-- 'encodeCellTable' instead of 'encodeHtmlTable': -- -- >>> let twoDepts = [Sales,Management] --- >>> printVeryCompactHtml (encodeHeadedCellTable customAttrs tableDept twoDepts) +-- >>> printVeryCompactHtml (encodeCellTable customAttrs tableDept twoDepts) --
-- -- @@ -186,7 +187,7 @@ import qualified Data.Text.Lazy.Builder as TBuilder -- >>> let tableEmpB = lmap department tableDept -- >>> :t tableEmpB -- tableEmpB :: Colonnade Headed Employee Cell --- >>> printVeryCompactHtml (encodeHeadedCellTable customAttrs tableEmpB employees) +-- >>> printVeryCompactHtml (encodeCellTable customAttrs tableEmpB employees) --
Dept.
-- -- @@ -218,7 +219,7 @@ import qualified Data.Text.Lazy.Builder as TBuilder -- >>> let tableEmpC = fmap htmlCell tableEmpA <> tableEmpB -- >>> :t tableEmpC -- tableEmpC :: Colonnade Headed Employee Cell --- >>> printCompactHtml (encodeHeadedCellTable customAttrs tableEmpC employees) +-- >>> printCompactHtml (encodeCellTable customAttrs tableEmpC employees) --
Dept.
-- -- @@ -296,9 +297,8 @@ builderCell = lazyTextCell . TBuilder.toLazyText -- | Encode a table. This handles a very general case and -- is seldom needed by users. One of the arguments provided is -- used to add attributes to the generated @\@ elements. -encodeTable :: - (Foldable f, Foldable h) - => Maybe (Attribute,Attribute) -- ^ Attributes of @\@ and its @\@, pass 'Nothing' to omit @\@ +encodeTable :: forall h f a c. (Foldable f, E.Headedness h) + => h (Attribute,Attribute) -- ^ Attributes of @\@ and its @\@, pass 'Nothing' to omit @\@ -> Attribute -- ^ Attributes of @\@ element -> (a -> Attribute) -- ^ Attributes of each @\@ element -> ((Html -> Html) -> c -> Html) -- ^ Wrap content and convert to 'Html' @@ -308,11 +308,27 @@ encodeTable :: -> Html encodeTable mtheadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs = H.table ! tableAttrs $ do - for_ mtheadAttrs $ \(theadAttrs,theadTrAttrs) -> do - H.thead ! theadAttrs $ H.tr ! theadTrAttrs $ do - Encode.headerMonoidalGeneral colonnade (wrapContent H.th) + case E.headednessExtractForall of + Nothing -> return mempty + Just extractForall -> do + let (theadAttrs,theadTrAttrs) = extract mtheadAttrs + H.thead ! theadAttrs $ H.tr ! theadTrAttrs $ do + -- E.headerMonoidalGeneral colonnade (wrapContent H.th) + foldlMapM' (wrapContent H.th . extract . E.oneColonnadeHead) (E.getColonnade colonnade) + where + extract :: forall y. h y -> y + extract = E.runExtractForall extractForall encodeBody trAttrs wrapContent tbodyAttrs colonnade xs +foldlMapM' :: forall g b a m. (Foldable g, Monoid b, Monad m) => (a -> m b) -> g a -> m b +foldlMapM' f xs = foldr f' pure xs mempty + where + f' :: a -> (b -> m b) -> b -> m b + f' x k bl = do + br <- f x + let !b = mappend bl br + k b + -- | Encode a table with tiered header rows. -- >>> let cor = mconcat [cap "Personal" (fmap htmlCell tableEmpA), cap "Work" tableEmpB] -- >>> let fascia = FasciaCap (HA.class_ "category") (FasciaBase (HA.class_ "subcategory")) @@ -360,11 +376,11 @@ encodeCappedTable :: Foldable f -> f a -- ^ Collection of data -> Html encodeCappedTable theadAttrs tbodyAttrs trAttrs wrapContent tableAttrs fascia cornice xs = do - let colonnade = Encode.discard cornice - annCornice = Encode.annotate cornice + let colonnade = E.discard cornice + annCornice = E.annotate cornice H.table ! tableAttrs $ do H.thead ! theadAttrs $ do - Encode.headersMonoidal + E.headersMonoidal (Just (fascia, \attrs theHtml -> H.tr ! attrs $ theHtml)) [ ( \msz c -> case msz of Just sz -> wrapContent H.th c ! HA.colspan (H.toValue (show sz)) @@ -374,10 +390,10 @@ encodeCappedTable theadAttrs tbodyAttrs trAttrs wrapContent tableAttrs fascia co ] annCornice -- H.tr ! trAttrs $ do - -- Encode.headerMonoidalGeneral colonnade (wrapContent H.th) + -- E.headerMonoidalGeneral colonnade (wrapContent H.th) encodeBody trAttrs wrapContent tbodyAttrs colonnade xs -encodeBody :: (Foldable h, Foldable f) +encodeBody :: Foldable f => (a -> Attribute) -- ^ Attributes of each @\@ element -> ((Html -> Html) -> c -> Html) -- ^ Wrap content and convert to 'Html' -> Attribute -- ^ Attributes of @\@ element @@ -387,52 +403,30 @@ encodeBody :: (Foldable h, Foldable f) encodeBody trAttrs wrapContent tbodyAttrs colonnade xs = do H.tbody ! tbodyAttrs $ do forM_ xs $ \x -> do - H.tr ! trAttrs x $ Encode.rowMonoidal colonnade (wrapContent H.td) x + H.tr ! trAttrs x $ E.rowMonoidal colonnade (wrapContent H.td) x --- | Encode a table with a header. Table cells may have attributes +-- | Encode a table. Table cells may have attributes -- applied to them. -encodeHeadedCellTable :: +encodeCellTable :: Foldable f => Attribute -- ^ Attributes of @\@ element -> Colonnade Headed a Cell -- ^ How to encode data as columns -> f a -- ^ Collection of data -> Html -encodeHeadedCellTable = encodeTable - (Just (mempty,mempty)) mempty (const mempty) htmlFromCell +encodeCellTable = encodeTable + (E.headednessPure (mempty,mempty)) mempty (const mempty) htmlFromCell --- | Encode a table without a header. Table cells may have attributes --- applied to them. -encodeHeadlessCellTable :: - Foldable f - => Attribute -- ^ Attributes of @\@ element - -> Colonnade Headless a Cell -- ^ How to encode data as columns - -> f a -- ^ Collection of data - -> Html -encodeHeadlessCellTable = encodeTable - Nothing mempty (const mempty) htmlFromCell - --- | Encode a table with a header. Table cell element do not have +-- | Encode a table. Table cell element do not have -- any attributes applied to them. -encodeHeadedHtmlTable :: - Foldable f +encodeHtmlTable :: + (Foldable f, E.Headedness h) => Attribute -- ^ Attributes of @\@ element - -> Colonnade Headed a Html -- ^ How to encode data as columns + -> Colonnade h a Html -- ^ How to encode data as columns -> f a -- ^ Collection of data -> Html -encodeHeadedHtmlTable = encodeTable - (Just (mempty,mempty)) mempty (const mempty) ($) - --- | Encode a table without a header. Table cells do not have --- any attributes applied to them. -encodeHeadlessHtmlTable :: - Foldable f - => Attribute -- ^ Attributes of @\@ element - -> Colonnade Headless a Html -- ^ How to encode data as columns - -> f a -- ^ Collection of data - -> Html -encodeHeadlessHtmlTable = encodeTable - Nothing mempty (const mempty) ($) +encodeHtmlTable = encodeTable + (E.headednessPure (mempty,mempty)) mempty (const mempty) ($) -- | Convert a 'Cell' to 'Html' by wrapping the content with a tag -- and applying the 'Cell' attributes to that tag. diff --git a/stack.yaml b/stack.yaml index e9b0485..05765d9 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-8.0 +resolver: lts-10.4 packages: - 'colonnade' - 'yesod-colonnade' diff --git a/yesod-colonnade/src/Yesod/Colonnade.hs b/yesod-colonnade/src/Yesod/Colonnade.hs index 845bb22..4b7ea4e 100644 --- a/yesod-colonnade/src/Yesod/Colonnade.hs +++ b/yesod-colonnade/src/Yesod/Colonnade.hs @@ -15,10 +15,8 @@ module Yesod.Colonnade , anchorCell , anchorWidget -- * Apply - , encodeHeadedWidgetTable - , encodeHeadlessWidgetTable - , encodeHeadedCellTable - , encodeHeadlessCellTable + , encodeWidgetTable + , encodeCellTable , encodeDefinitionTable , encodeListItems ) where @@ -126,41 +124,27 @@ encodeDefinitionTable attrs enc a = table_ attrs $ tbody_ mempty $ widgetFromCell td_ theValue ) a --- | If you are using the bootstrap css framework, then you may want +-- | Encode an html table with attributes on the table cells. +-- If you are using the bootstrap css framework, then you may want -- to call this with the first argument as: -- --- > encodeHeadedCellTable (HA.class_ "table table-striped") ... -encodeHeadedCellTable :: Foldable f +-- > encodeCellTable (HA.class_ "table table-striped") ... +encodeCellTable :: (Foldable f, E.Headedness h) => Attribute -- ^ Attributes of @table@ element - -> Colonnade Headed a (Cell site) -- ^ How to encode data as a row + -> Colonnade h a (Cell site) -- ^ How to encode data as a row -> f a -- ^ Rows of data -> WidgetT site IO () -encodeHeadedCellTable = encodeTable - (E.Headed mempty) mempty (const mempty) widgetFromCell +encodeCellTable = encodeTable + (E.headednessPure mempty) mempty (const mempty) widgetFromCell -encodeHeadlessCellTable :: Foldable f - => Attribute -- ^ Attributes of @table@ element - -> Colonnade Headless a (Cell site) -- ^ How to encode data as columns - -> f a -- ^ Rows of data - -> WidgetT site IO () -encodeHeadlessCellTable = encodeTable - E.Headless mempty (const mempty) widgetFromCell - -encodeHeadedWidgetTable :: Foldable f - => Attribute -- ^ Attributes of @table@ element - -> Colonnade Headed a (WidgetT site IO ()) -- ^ How to encode data as columns - -> f a -- ^ Rows of data - -> WidgetT site IO () -encodeHeadedWidgetTable = encodeTable - (E.Headed mempty) mempty (const mempty) ($ mempty) - -encodeHeadlessWidgetTable :: Foldable f +-- | Encode an html table. +encodeWidgetTable :: (Foldable f, E.Headedness h) => Attribute -- ^ Attributes of @\@ element - -> Colonnade Headless a (WidgetT site IO ()) -- ^ How to encode data as columns + -> Colonnade h a (WidgetT site IO ()) -- ^ How to encode data as columns -> f a -- ^ Rows of data -> WidgetT site IO () -encodeHeadlessWidgetTable = encodeTable - E.Headless mempty (const mempty) ($ mempty) +encodeWidgetTable = encodeTable + (E.headednessPure mempty) mempty (const mempty) ($ mempty) -- | Encode a table. This handles a very general case and -- is seldom needed by users. One of the arguments provided is