lucid-colonnade 1.0.1 → 1.0.2

raw patch · 4 files changed

+291/−124 lines, 4 filesdep +vectordep ~basedep ~colonnadedep ~lucidsetup-changednew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: vector

Dependency ranges changed: base, colonnade, lucid, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• Setup.hs +0/−2
• lucid-colonnade.cabal +30/−22
• src/Lucid/Colonnade.hs +255/−100

@@ -0,0 +1,6 @@+# Revision history for lucid-colonnade++## 1.0.2 -- 2024-03-06++* Update package metadata.+* Export `charCell`.

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,28 +1,36 @@-name: lucid-colonnade-version: 1.0.1-synopsis: Helper functions for using lucid with colonnade-description: Lucid 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+cabal-version:   3.0+name:            lucid-colonnade+version:         1.0.2+synopsis:        Helper functions for using lucid with colonnade+description:     Helper functions for using lucid with colonnade.+homepage:        https://github.com/byteverse/lucid-colonnade+bug-reports:     https://github.com/byteverse/lucid-colonnade/issues+license:         BSD-3-Clause+license-file:    LICENSE+author:          Andrew Martin+maintainer:      amartin@layer3com.com+copyright:       2017 Andrew Martin+category:        web+build-type:      Simple+extra-doc-files: CHANGELOG.md+tested-with:     GHC ==9.4.8 || ==9.6.3 || ==9.8.1 +common build-settings+  default-language: Haskell2010+  ghc-options:      -Wall -Wunused-packages+  build-depends:    base >=4.8 && <5+ library-  hs-source-dirs: src-  exposed-modules:-    Lucid.Colonnade+  import:          build-settings+  ghc-options:     -O2+  hs-source-dirs:  src+  exposed-modules: Lucid.Colonnade   build-depends:-      base >= 4.9 && < 5-    , colonnade >= 1.1.1 && < 1.3-    , lucid >= 2.9 && < 3.0-    , text >= 1.2 && < 1.3-  default-language: Haskell2010+    , colonnade  >=1.1.1+    , lucid      >=2.9+    , text       >=1.2+    , vector     >=0.10  source-repository head   type:     git-  location: https://github.com/andrewthad/colonnade+  location: git://github.com/byteverse/lucid-colonnade.git

@@ -1,60 +1,73 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} --- | Build HTML tables using @lucid@ and @colonnade@. It is---   recommended that users read the documentation for @colonnade@ first,---   since this library builds on the abstractions introduced there.---   Also, look at the docs for @blaze-colonnade@. These two---   libraries are similar, but blaze offers an HTML pretty printer---   which makes it possible to doctest examples. Since lucid---   does not offer such facilities, examples are omitted here.+{- | Build HTML tables using @lucid@ and @colonnade@. It is+  recommended that users read the documentation for @colonnade@ first,+  since this library builds on the abstractions introduced there.+  Also, look at the docs for @blaze-colonnade@. These two+  libraries are similar, but blaze offers an HTML pretty printer+  which makes it possible to doctest examples. Since lucid+  does not offer such facilities, examples are omitted here.+-} module Lucid.Colonnade   ( -- * Apply     encodeHtmlTable   , encodeCellTable+  , encodeCellTableSized   , encodeTable+     -- * Cell     -- $build-  , Cell(..)+  , Cell (..)+  , charCell   , htmlCell   , stringCell   , textCell   , lazyTextCell   , builderCell   , htmlFromCell+  , encodeBodySized+  , sectioned+     -- * Discussion     -- $discussion   ) where -import Colonnade (Colonnade,Headed,Headless,Fascia,Cornice)-import Data.Text (Text)+#if MIN_VERSION_base(4,18,0)+#else+import Control.Applicative (liftA2)+#endif+import Colonnade (Colonnade) import Control.Monad-import Data.Semigroup-import Data.Monoid hiding ((<>)) import Data.Foldable-import Data.String (IsString(..))-import Data.Maybe (listToMaybe)-import Data.Char (isSpace)-import Control.Applicative (liftA2)-import Lucid-import qualified Data.List as List+import Data.String (IsString (..))+import Data.Text (Text)+import Lucid hiding (for_)+ import qualified Colonnade.Encode as E+import qualified Data.Text as T import qualified Data.Text as Text import qualified Data.Text.Lazy as LText import qualified Data.Text.Lazy.Builder as TBuilder+import qualified Data.Vector as V --- $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 @\<td\>@ or @\<th\>@ elements--- that wrap this HTML content.+{- $build --- | The attributes that will be applied to a @\<td\>@ and---   the HTML content that will go inside it. When using---   this type, remember that 'Attribute', defined in @blaze-markup@,---   is actually a collection of attributes, not a single attribute.+The 'Cell' type is used to build a 'Colonnade' that+has 'Html' content inside table cells and may optionally+have attributes added to the @\<td\>@ or @\<th\>@ elements+that wrap this HTML content.+-}++{- | The attributes that will be applied to a @\<td\>@ and+  the HTML content that will go inside it. When using+  this type, remember that 'Attribute', defined in @blaze-markup@,+  is actually a collection of attributes, not a single attribute.+-} data Cell d = Cell   { cellAttribute :: ![Attribute]   , cellHtml :: !(Html d)@@ -63,12 +76,12 @@ instance (d ~ ()) => IsString (Cell d) where   fromString = stringCell -instance Semigroup d => Semigroup (Cell d) where+instance (Semigroup d) => Semigroup (Cell d) where   Cell a1 c1 <> Cell a2 c2 = Cell (mappend a1 a2) (liftA2 (<>) c1 c2) -instance Monoid d => Monoid (Cell d) where+instance (Monoid d) => Monoid (Cell d) where   mempty = Cell mempty (return mempty)-  mappend (Cell a1 c1) (Cell a2 c2) = Cell (mappend a1 a2) (liftA2 mappend c1 c2)+  mappend = (<>)  -- | Create a 'Cell' from a 'Widget' htmlCell :: Html d -> Cell d@@ -94,104 +107,246 @@ builderCell :: TBuilder.Builder -> Cell () builderCell = lazyTextCell . TBuilder.toLazyText --- | Encode a table. Table cell element do not have ---   any attributes applied to them.-encodeHtmlTable :: -     (E.Headedness h, Foldable f, Monoid d)-  => [Attribute] -- ^ Attributes of @\<table\>@ element-  -> Colonnade h a (Html d) -- ^ How to encode data as columns-  -> f a -- ^ Collection of data-  -> Html d-encodeHtmlTable = encodeTable-  (E.headednessPure ([],[])) mempty (const mempty) (\el -> el [])+{- | Encode a table. Table cell element do not have+  any attributes applied to them.+-}+encodeHtmlTable ::+  (E.Headedness h, Foldable f, Monoid d) =>+  -- | Attributes of @\<table\>@ element+  [Attribute] ->+  -- | How to encode data as columns+  Colonnade h a (Html d) ->+  -- | Collection of data+  f a ->+  Html d+encodeHtmlTable =+  encodeTable+    (E.headednessPure ([], []))+    mempty+    (const mempty)+    (\el -> el []) --- | Encode a table. Table cells may have attributes applied---   to them-encodeCellTable :: -     (E.Headedness h, Foldable f, Monoid d)-  => [Attribute] -- ^ Attributes of @\<table\>@ element-  -> Colonnade h a (Cell d) -- ^ How to encode data as columns-  -> f a -- ^ Collection of data-  -> Html d-encodeCellTable = encodeTable-  (E.headednessPure ([],[])) mempty (const mempty) htmlFromCell+{- | Encode a table. Table cells may have attributes applied+  to them+-}+encodeCellTable ::+  (E.Headedness h, Foldable f, Monoid d) =>+  -- | Attributes of @\<table\>@ element+  [Attribute] ->+  -- | How to encode data as columns+  Colonnade h a (Cell d) ->+  -- | Collection of data+  f a ->+  Html d+encodeCellTable =+  encodeTable+    (E.headednessPure ([], []))+    mempty+    (const mempty)+    htmlFromCell --- | 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 @\<tr\>@ elements.---   The elements of type @d@ produced by generating html are---   strictly combined with their monoidal append function.---   However, this type is nearly always @()@.-encodeTable :: forall f h a d c.-     (Foldable f, E.Headedness h, Monoid d)-  => h ([Attribute],[Attribute]) -- ^ Attributes of @\<thead\>@ and its @\<tr\>@-  -> [Attribute] -- ^ Attributes of @\<tbody\>@ element-  -> (a -> [Attribute]) -- ^ Attributes of each @\<tr\>@ element-  -> (([Attribute] -> Html d -> Html d) -> c -> Html d) -- ^ Wrap content and convert to 'Html'-  -> [Attribute] -- ^ Attributes of @\<table\>@ element-  -> Colonnade h a c -- ^ How to encode data as a row-  -> f a -- ^ Collection of data-  -> Html d+encodeCellTableSized ::+  (E.Headedness h, Foldable f, Monoid d) =>+  -- | Attributes of @\<table\>@ element+  [Attribute] ->+  -- | How to encode data as columns+  Colonnade (E.Sized Int h) a (Cell d) ->+  -- | Collection of data+  f a ->+  Html ()+encodeCellTableSized =+  encodeTableSized+    (E.headednessPure ([], []))+    mempty+    (const mempty)+    htmlFromCell++{- | 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 @\<tr\>@ elements.+  The elements of type @d@ produced by generating html are+  strictly combined with their monoidal append function.+  However, this type is nearly always @()@.+-}+encodeTable ::+  forall f h a d c.+  (Foldable f, E.Headedness h, Monoid d) =>+  -- | Attributes of @\<thead\>@ and its @\<tr\>@+  h ([Attribute], [Attribute]) ->+  -- | Attributes of @\<tbody\>@ element+  [Attribute] ->+  -- | Attributes of each @\<tr\>@ element+  (a -> [Attribute]) ->+  -- | Wrap content and convert to 'Html'+  (([Attribute] -> Html d -> Html d) -> c -> Html d) ->+  -- | Attributes of @\<table\>@ element+  [Attribute] ->+  -- | How to encode data as a row+  Colonnade h a c ->+  -- | Collection of data+  f a ->+  Html d encodeTable mtheadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs =   table_ tableAttrs $ do     d1 <- case E.headednessExtractForall of       Nothing -> return mempty       Just extractForall -> do-        let (theadAttrs,theadTrAttrs) = extract mtheadAttrs+        let (theadAttrs, theadTrAttrs) = extract mtheadAttrs         thead_ theadAttrs $ tr_ theadTrAttrs $ do           foldlMapM' (wrapContent th_ . extract . E.oneColonnadeHead) (E.getColonnade colonnade)-        where+       where         extract :: forall y. h y -> y         extract = E.runExtractForall extractForall     d2 <- encodeBody trAttrs wrapContent tbodyAttrs colonnade xs     return (mappend d1 d2) -encodeBody :: (Foldable f, Monoid d)-  => (a -> [Attribute]) -- ^ Attributes of each @\<tr\>@ element-  -> (([Attribute] -> Html d -> Html d) -> c -> Html d) -- ^ Wrap content and convert to 'Html'-  -> [Attribute] -- ^ Attributes of @\<tbody\>@ element-  -> Colonnade h a c -- ^ How to encode data as a row-  -> f a -- ^ Collection of data-  -> Html d+encodeBody ::+  (Foldable f, Monoid d) =>+  -- | Attributes of each @\<tr\>@ element+  (a -> [Attribute]) ->+  -- | Wrap content and convert to 'Html'+  (([Attribute] -> Html d -> Html d) -> c -> Html d) ->+  -- | Attributes of @\<tbody\>@ element+  [Attribute] ->+  -- | How to encode data as a row+  Colonnade h a c ->+  -- | Collection of data+  f a ->+  Html d encodeBody trAttrs wrapContent tbodyAttrs colonnade xs = do   tbody_ tbodyAttrs $ do     flip foldlMapM' xs $ \x -> do       tr_ (trAttrs x) $ E.rowMonadic colonnade (wrapContent td_) x +encodeBodySized ::+  (Foldable f, Monoid d) =>+  (a -> [Attribute]) ->+  [Attribute] ->+  Colonnade (E.Sized Int h) a (Cell d) ->+  f a ->+  Html ()+encodeBodySized trAttrs tbodyAttrs colonnade collection = tbody_ tbodyAttrs $ do+  for_ collection $ \a -> tr_ (trAttrs a) $ do+    E.rowMonoidalHeader+      colonnade+      ( \(E.Sized sz _) (Cell cattr content) ->+          void $ td_ (setColspanOrHide sz cattr) content+      )+      a++encodeTableSized ::+  forall f h a d.+  (Foldable f, E.Headedness h, Monoid d) =>+  -- | Attributes of @\<thead\>@ and its @\<tr\>@+  h ([Attribute], [Attribute]) ->+  -- | Attributes of @\<tbody\>@ element+  [Attribute] ->+  -- | Attributes of each @\<tr\>@ element+  (a -> [Attribute]) ->+  -- | Wrap content and convert to 'Html'+  (([Attribute] -> Html d -> Html d) -> (Cell d) -> Html d) ->+  -- | Attributes of @\<table\>@ element+  [Attribute] ->+  -- | How to encode data as a row+  Colonnade (E.Sized Int h) a (Cell d) ->+  -- | Collection of data+  f a ->+  Html ()+encodeTableSized mtheadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs =+  table_ tableAttrs $ do+    _ <- case E.headednessExtractForall of+      Nothing -> pure mempty+      Just extractForall -> do+        let (theadAttrs, theadTrAttrs) = extract mtheadAttrs+        thead_ theadAttrs $ tr_ theadTrAttrs $ do+          traverse_+            ( wrapContent th_+                . extract+                . ( \(E.Sized i h) -> case E.headednessExtract of+                      Just f ->+                        let (Cell attrs content) = f h+                         in E.headednessPure $ Cell (setColspanOrHide i attrs) content+                      Nothing -> E.headednessPure mempty+                      -- (E.Headed (Cell attrs content)) -> E.Headed $ Cell (setColspanOrHide i attrs) content+                      -- E.Headless -> E.Headless+                  )+                . E.oneColonnadeHead+            )+            (E.getColonnade colonnade)+       where+        extract :: forall y. h y -> y+        extract = E.runExtractForall extractForall+    encodeBodySized trAttrs tbodyAttrs colonnade xs++setColspanOrHide :: Int -> [Attribute] -> [Attribute]+setColspanOrHide i attrs+  | i < 1 = style_ "display:none;" : attrs+  | otherwise = colspan_ (Text.pack (show i)) : attrs+ 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+ where   f' :: a -> (b -> m b) -> b -> m b   f' x k bl = do     br <- f x     let !b = mappend bl br     k b --- | Convert a 'Cell' to 'Html' by wrapping the content with a tag--- and applying the 'Cell' attributes to that tag.+{- | Convert a 'Cell' to 'Html' by wrapping the content with a tag+and applying the 'Cell' attributes to that tag.+-} htmlFromCell :: ([Attribute] -> Html d -> Html d) -> Cell d -> Html d 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 a (Cell d) -> f a -> Html d------ The 'Colonnade' content type is 'Cell', but the content--- type of the result is 'Html'. It may not be immidiately clear why--- this is 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 a (Html d) -> f a -> Html d------ When the 'Colonnade' content type is 'Html', then the header--- content is rendered as the child of a @\<th\>@ and the row--- content the child of a @\<td\>@. 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.+{- $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 a (Cell d) -> f a -> Html d++The 'Colonnade' content type is 'Cell', but the content+type of the result is 'Html'. It may not be immidiately clear why+this is 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 a (Html d) -> f a -> Html d++When the 'Colonnade' content type is 'Html', then the header+content is rendered as the child of a @\<th\>@ and the row+content the child of a @\<td\>@. 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.+-}++sectioned ::+  (Foldable f, E.Headedness h, Foldable g, Monoid c) =>+  -- | @\<table\>@ tag attributes+  [Attribute] ->+  -- | Attributes of @\<thead\>@ and its @\<tr\>@, pass 'Nothing' to omit @\<thead\>@+  Maybe ([Attribute], [Attribute]) ->+  -- | @\<tbody\>@ tag attributes+  [Attribute] ->+  -- | @\<tr\>@ tag attributes for data rows+  (a -> [Attribute]) ->+  -- | Section divider encoding strategy+  (b -> Cell c) ->+  -- | Data encoding strategy+  Colonnade h a (Cell c) ->+  -- | Collection of data+  f (b, g a) ->+  Html ()+sectioned tableAttrs mheadAttrs bodyAttrs trAttrs dividerContent colonnade@(E.Colonnade v) collection = do+  let vlen = V.length v+  table_ tableAttrs $ do+    for_ mheadAttrs $ \(headAttrs, headTrAttrs) ->+      thead_ headAttrs . tr_ headTrAttrs $+        E.headerMonadicGeneral_ colonnade (htmlFromCell th_)+    tbody_ bodyAttrs $ for_ collection $ \(b, as) -> do+      let Cell attrs contents = dividerContent b+      _ <- tr_ [] $ do+        td_ ((colspan_ $ T.pack (show vlen)) : attrs) contents+      flip traverse_ as $ \a -> do+        tr_ (trAttrs a) $ E.rowMonadic colonnade (htmlFromCell td_) a