diff --git a/blaze-colonnade/blaze-colonnade.cabal b/blaze-colonnade/blaze-colonnade.cabal index 45dd3b6..d1844c4 100644 --- a/blaze-colonnade/blaze-colonnade.cabal +++ b/blaze-colonnade/blaze-colonnade.cabal @@ -1,5 +1,5 @@ name: blaze-colonnade -version: 0.1 +version: 1.1.0 synopsis: Helper functions for using blaze-html with colonnade description: Blaze HTML and colonnade homepage: https://github.com/andrewthad/colonnade#readme @@ -18,7 +18,7 @@ library Text.Blaze.Colonnade build-depends: base >= 4.7 && < 5 - , colonnade >= 1.0 && < 1.1 + , colonnade >= 1.1 && < 1.2 , blaze-markup >= 0.7 && < 0.9 , blaze-html >= 0.8 && < 0.10 , text >= 1.0 && < 1.3 diff --git a/blaze-colonnade/src/Text/Blaze/Colonnade.hs b/blaze-colonnade/src/Text/Blaze/Colonnade.hs index 197aedb..79554cd 100644 --- a/blaze-colonnade/src/Text/Blaze/Colonnade.hs +++ b/blaze-colonnade/src/Text/Blaze/Colonnade.hs @@ -11,7 +11,9 @@ -- >>> let rows = [("90-100",'A'),("80-89",'B'),("70-79",'C')] -- >>> printVeryCompactHtml (encodeHeadedHtmlTable mempty col rows) -- --- +-- +-- +-- -- -- -- @@ -25,6 +27,7 @@ module Text.Blaze.Colonnade , encodeHeadedCellTable , encodeHeadlessCellTable , encodeTable + , encodeCappedTable -- * Cell -- $build , Cell(..) @@ -33,11 +36,12 @@ module Text.Blaze.Colonnade , textCell , lazyTextCell , builderCell + , htmlFromCell -- * Interactive , printCompactHtml , printVeryCompactHtml -- * Tutorial - -- $example + -- $setup -- * Discussion -- $discussion @@ -45,7 +49,7 @@ module Text.Blaze.Colonnade import Text.Blaze (Attribute,(!)) import Text.Blaze.Html (Html, toHtml) -import Colonnade (Colonnade,Headed,Headless) +import Colonnade (Colonnade,Headed,Headless,Fascia,Cornice) import Data.Text (Text) import Control.Monad import Data.Monoid @@ -63,17 +67,16 @@ import qualified Data.Text as Text import qualified Data.Text.Lazy as LText import qualified Data.Text.Lazy.Builder as TBuilder --- $example +-- $setup -- We start with a few necessary imports and some example data -- types: -- -- >>> :set -XOverloadedStrings -- >>> import Data.Monoid (mconcat,(<>)) -- >>> import Data.Char (toLower) --- >>> import Data.Functor.Contravariant (Contravariant(contramap)) --- >>> import Colonnade (Colonnade,Headed,Headless,headed) +-- >>> import Data.Profunctor (Profunctor(lmap)) +-- >>> import Colonnade (Colonnade,Headed,Headless,headed,cap,Fascia(..)) -- >>> import Text.Blaze.Html (Html, toHtml, toValue) --- >>> import qualified Colonnade as C -- >>> import qualified Text.Blaze.Html5 as H -- >>> data Department = Management | Sales | Engineering deriving (Show,Eq) -- >>> data Employee = Employee { name :: String, department :: Department, age :: Int } @@ -93,7 +96,7 @@ import qualified Data.Text.Lazy.Builder as TBuilder -- engineers using a @\@ tag. -- -- >>> :{ --- let tableEmpA :: Colonnade Headed Html Employee +-- let tableEmpA :: Colonnade Headed Employee Html -- tableEmpA = mconcat -- [ headed "Name" $ \emp -> case department emp of -- Engineering -> H.strong (toHtml (name emp)) @@ -113,8 +116,10 @@ import qualified Data.Text.Lazy.Builder as TBuilder -- >>> printCompactHtml (encodeHeadedHtmlTable customAttrs tableEmpA employees) --
GradeLetter
GradeLetter
90-100A
80-89B
-- --- --- +-- +-- +-- +-- -- -- -- @@ -146,7 +151,7 @@ import qualified Data.Text.Lazy.Builder as TBuilder -- let\'s build a table that encodes departments: -- -- >>> :{ --- let tableDept :: Colonnade Headed Cell Department +-- let tableDept :: Colonnade Headed Department Cell -- tableDept = mconcat -- [ headed "Dept." $ \d -> Cell -- (HA.class_ (toValue (map toLower (show d)))) @@ -161,45 +166,35 @@ import qualified Data.Text.Lazy.Builder as TBuilder -- 'encodeHeadedCellTable' instead of 'encodeHeadedHtmlTable': -- -- >>> let twoDepts = [Sales,Management] --- >>> printCompactHtml (encodeHeadedCellTable customAttrs tableDept twoDepts) +-- >>> printVeryCompactHtml (encodeHeadedCellTable customAttrs tableDept twoDepts) --
NameAge
NameAge
-- --- +-- -- -- --- --- --- --- --- --- +-- +-- -- --
Dept.
Dept.
Sales
Management
Sales
Management
-- -- The attributes on the @\@ elements show up as they are expected to. --- Now, we take advantage of the @Contravariant@ instance of 'Colonnade' to allow +-- Now, we take advantage of the @Profunctor@ instance of 'Colonnade' to allow -- this to work on @Employee@\'s instead: -- --- >>> :t contramap --- contramap :: Contravariant f => (a -> b) -> f b -> f a --- >>> let tableEmpB = contramap department tableDept +-- >>> :t lmap +-- lmap :: Profunctor p => (a -> b) -> p b c -> p a c +-- >>> let tableEmpB = lmap department tableDept -- >>> :t tableEmpB --- tableEmpB :: Colonnade Headed Cell Employee --- >>> printCompactHtml (encodeHeadedCellTable customAttrs tableEmpB employees) +-- tableEmpB :: Colonnade Headed Employee Cell +-- >>> printVeryCompactHtml (encodeHeadedCellTable customAttrs tableEmpB employees) -- -- --- +-- -- -- --- --- --- --- --- --- --- --- --- +-- +-- +-- -- --
Dept.
Dept.
Sales
Engineering
Management
Sales
Engineering
Management
-- @@ -212,23 +207,25 @@ import qualified Data.Text.Lazy.Builder as TBuilder -- prevents a straightforward monoidal append: -- -- >>> :t tableEmpA --- tableEmpA :: Colonnade Headed Html Employee +-- tableEmpA :: Colonnade Headed Employee Html -- >>> :t tableEmpB --- tableEmpB :: Colonnade Headed Cell Employee +-- tableEmpB :: Colonnade Headed Employee Cell -- --- We can upcast the content type with 'Colonnade.mapContent'. +-- We can upcast the content type with 'fmap'. -- Monoidal append is then well-typed, and the resulting 'Colonnade' -- can be applied to the employees: -- --- >>> let tableEmpC = C.mapContent htmlCell tableEmpA <> tableEmpB +-- >>> let tableEmpC = fmap htmlCell tableEmpA <> tableEmpB -- >>> :t tableEmpC --- tableEmpC :: Colonnade Headed Cell Employee +-- tableEmpC :: Colonnade Headed Employee Cell -- >>> printCompactHtml (encodeHeadedCellTable customAttrs tableEmpC employees) -- -- --- --- --- +-- +-- +-- +-- +-- -- -- -- @@ -316,7 +313,43 @@ encodeTable mtheadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs = Encode.headerMonoidalGeneral colonnade (wrapContent H.th) encodeBody trAttrs wrapContent tbodyAttrs colonnade xs -encodeTieredHeaderTable :: Foldable f +-- | 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")) +-- >>> printCompactHtml (encodeCappedCellTable mempty fascia cor [head employees]) +--
NameAgeDept.
NameAgeDept.
+-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +--
PersonalWork
NameAgeDept.
Thaddeus34Sales
+ +encodeCappedCellTable :: Foldable f + => Attribute -- ^ Attributes of @\@ element + -> Fascia p Attribute -- ^ Attributes for @\@ elements in the @\@ + -> Cornice p a Cell + -> f a -- ^ Collection of data + -> Html +encodeCappedCellTable = encodeCappedTable mempty mempty (const mempty) htmlFromCell + +-- | Encode a table with tiered header rows. This is the most general function +-- in this library for encoding a 'Cornice'. +-- +encodeCappedTable :: Foldable f => Attribute -- ^ Attributes of @\@ -> Attribute -- ^ Attributes of @\@ element -> (a -> Attribute) -- ^ Attributes of each @\@ element in the @\@ @@ -326,13 +359,18 @@ encodeTieredHeaderTable :: Foldable f -> Cornice p a c -> f a -- ^ Collection of data -> Html -encodeTieredHeaderTable theadAttrs tbodyAttrs trAttrs wrapContent tableAttrs cornice xs = do - let colonnade = CE.discard cornice - annCornice = annotate cornice +encodeCappedTable theadAttrs tbodyAttrs trAttrs wrapContent tableAttrs fascia cornice xs = do + let colonnade = Encode.discard cornice + annCornice = Encode.annotate cornice H.table ! tableAttrs $ do - H.thead ! theadAttrs $ H.tr ! trAttrs $ do - Encode.headerMonoidalGeneral colonnade (wrapContent H.th) - encodeBody trAttrs wrapContent tbodyAttrs colonnade xs + H.thead ! theadAttrs $ do + Encode.headersMonoidal + (Just (fascia, \attrs theHtml -> H.tr ! attrs $ theHtml)) + [(\sz c -> wrapContent H.th c ! HA.colspan (H.toValue (show sz)),id)] + annCornice + -- H.tr ! trAttrs $ do + -- Encode.headerMonoidalGeneral colonnade (wrapContent H.th) + encodeBody trAttrs wrapContent tbodyAttrs colonnade xs encodeBody :: (Foldable h, Foldable f) => (a -> Attribute) -- ^ Attributes of each @\@ element @@ -369,8 +407,8 @@ encodeHeadlessCellTable :: encodeHeadlessCellTable = encodeTable Nothing mempty (const mempty) htmlFromCell --- | Encode a table with a header. Table cells cannot have attributes --- applied to them. +-- | Encode a table with a header. Table cell element do not have +-- any attributes applied to them. encodeHeadedHtmlTable :: Foldable f => Attribute -- ^ Attributes of @\@ element @@ -380,8 +418,8 @@ encodeHeadedHtmlTable :: encodeHeadedHtmlTable = encodeTable (Just (mempty,mempty)) mempty (const mempty) ($) --- | Encode a table without a header. Table cells cannot have attributes --- applied to them. +-- | Encode a table without a header. Table cells do not have +-- any attributes applied to them. encodeHeadlessHtmlTable :: Foldable f => Attribute -- ^ Attributes of @\@ element @@ -391,6 +429,8 @@ encodeHeadlessHtmlTable :: encodeHeadlessHtmlTable = encodeTable Nothing mempty (const mempty) ($) +-- | Convert a 'Cell' to 'Html' by wrapping the content with a tag +-- and applying the 'Cell' attributes to that tag. htmlFromCell :: (Html -> Html) -> Cell -> Html htmlFromCell f (Cell attr content) = f ! attr $ content @@ -477,7 +517,6 @@ printVeryCompactHtml = putStrLn . removeWhitespaceAfterTag "span" . removeWhitespaceAfterTag "em" . removeWhitespaceAfterTag "tr" - . removeWhitespaceAfterTag "thead" . Pretty.renderHtml diff --git a/colonnade/colonnade.cabal b/colonnade/colonnade.cabal index 323467a..26bebef 100644 --- a/colonnade/colonnade.cabal +++ b/colonnade/colonnade.cabal @@ -1,5 +1,5 @@ name: colonnade -version: 1.0.0 +version: 1.1.0 synopsis: Generic types and functions for columnar encoding and decoding description: The `colonnade` package provides a way to to talk about @@ -10,6 +10,8 @@ description: that provides (1) a content type and (2) functions for feeding data into a columnar encoding: . + * for `blaze` html tables + . * for reactive `reflex-dom` tables . * for `yesod` widgets @@ -30,8 +32,6 @@ library exposed-modules: Colonnade Colonnade.Encode - Colonnade.Internal - Colonnade.Cornice.Encode build-depends: base >= 4.7 && < 5 , contravariant >= 1.2 && < 1.5 diff --git a/colonnade/examples/ex1.hs b/colonnade/examples/ex1.hs deleted file mode 100644 index 9b375e5..0000000 --- a/colonnade/examples/ex1.hs +++ /dev/null @@ -1,63 +0,0 @@ -import Colonnade.Encoding -import Colonnade.Types -import Data.Functor.Contravariant - -data Color = Red | Green | Blue deriving (Show) -data Person = Person { personName :: String, personAge :: Int } -data House = House { houseColor :: Color, housePrice :: Int } - -encodingPerson :: Encoding Headed String Person -encodingPerson = mconcat - [ headed "Name" personName - , headed "Age" (show . personAge) - ] - -encodingHouse :: Encoding Headed String House -encodingHouse = mconcat - [ headed "Color" (show . houseColor) - , headed "Price" (('$':) . show . housePrice) - ] - -encodingPerson2 :: Encoding Headless String Person -encodingPerson2 = mconcat - [ headless personName - , headless (show . personAge) - ] - -people :: [Person] -people = [Person "David" 63, Person "Ava" 34, Person "Sonia" 12] - -houses :: [House] -houses = [House Green 170000, House Blue 115000] - -peopleInHouses :: [(Person,House)] -peopleInHouses = (,) <$> people <*> houses - -encodingPersonHouse :: Encoding Headed String (Person,House) -encodingPersonHouse = mconcat - [ contramap fst encodingPerson - , contramap snd encodingHouse - ] - -owners :: [(Person,Maybe House)] -owners = - [ (Person "Jordan" 18, Nothing) - , (Person "Ruth" 25, Just (House Red 125000)) - , (Person "Sonia" 12, Just (House Green 145000)) - ] - -encodingOwners :: Encoding Headed String (Person,Maybe House) -encodingOwners = mconcat - [ contramap fst encodingPerson - , contramap snd (fromMaybe "(none)" encodingHouse) - ] - -main :: IO () -main = do - putStr $ ascii encodingPerson people - putStrLn "" - putStr $ ascii encodingHouse houses - putStrLn "" - putStr $ ascii encodingOwners owners - putStrLn "" - diff --git a/colonnade/src/Colonnade.hs b/colonnade/src/Colonnade.hs index 2a6b72f..4a3bd13 100644 --- a/colonnade/src/Colonnade.hs +++ b/colonnade/src/Colonnade.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DataKinds #-} +{-# OPTIONS_GHC -Wall -fno-warn-unused-imports -fno-warn-unticked-promoted-constructors -Werror #-} + -- | Build backend-agnostic columnar encodings that can be -- used to visualize tabular data. module Colonnade @@ -7,8 +9,8 @@ module Colonnade -- $setup -- * Types Colonnade - , Headed - , Headless + , Headed(..) + , Headless(..) -- * Create , headed , headless @@ -30,16 +32,16 @@ module Colonnade , recap -- * Ascii Table , ascii + , asciiCapped ) where -import Colonnade.Internal +import Colonnade.Encode (Colonnade,Cornice, + Pillar(..),Fascia(..),Headed(..),Headless(..)) import Data.Foldable -import Data.Monoid (Endo(..)) import Control.Monad -import qualified Colonnade.Encode as Encode -import qualified Colonnade.Cornice.Encode as CE import qualified Data.Bool import qualified Data.Maybe +import qualified Colonnade.Encode as E import qualified Data.List as List import qualified Data.Vector as Vector @@ -108,13 +110,13 @@ headless = singleton Headless -- | A single column with any kind of header. This is not typically needed. singleton :: h c -> (a -> c) -> Colonnade h a c -singleton h = Colonnade . Vector.singleton . OneColonnade h +singleton h = E.Colonnade . Vector.singleton . E.OneColonnade h -- | Map over the content in the header. This is similar performing 'fmap' -- on a 'Colonnade' except that the body content is unaffected. mapHeaderContent :: Functor h => (c -> c) -> Colonnade h a c -> Colonnade h a c -mapHeaderContent f (Colonnade v) = - Colonnade (Vector.map (\(OneColonnade h e) -> OneColonnade (fmap f h) e) v) +mapHeaderContent f (E.Colonnade v) = + E.Colonnade (Vector.map (\(E.OneColonnade h e) -> E.OneColonnade (fmap f h) e) v) -- | Lift a column over a 'Maybe'. For example, if some people -- have houses and some do not, the data that pairs them together @@ -149,8 +151,8 @@ mapHeaderContent f (Colonnade v) = -- | Sonia | 12 | Green | $145000 | -- +--------+-----+-------+---------+ fromMaybe :: c -> Colonnade f a c -> Colonnade f (Maybe a) c -fromMaybe c (Colonnade v) = Colonnade $ flip Vector.map v $ - \(OneColonnade h encode) -> OneColonnade h (maybe c encode) +fromMaybe c (E.Colonnade v) = E.Colonnade $ flip Vector.map v $ + \(E.OneColonnade h encode) -> E.OneColonnade h (maybe c encode) -- | Convert a collection of @b@ values into a columnar encoding of -- the same size. Suppose we decide to show a house\'s color @@ -178,8 +180,8 @@ columns :: Foldable g -> g b -- ^ Basis for column encodings -> Colonnade f a c columns getCell getHeader = id - . Colonnade - . Vector.map (\b -> OneColonnade (getHeader b) (getCell b)) + . E.Colonnade + . Vector.map (\b -> E.OneColonnade (getHeader b) (getCell b)) . Vector.fromList . toList @@ -200,9 +202,9 @@ modifyWhen :: -> (a -> Bool) -- ^ Row predicate -> Colonnade f a c -- ^ Original 'Colonnade' -> Colonnade f a c -modifyWhen changeContent p (Colonnade v) = Colonnade +modifyWhen changeContent p (E.Colonnade v) = E.Colonnade ( Vector.map - (\(OneColonnade h encode) -> OneColonnade h $ \a -> + (\(E.OneColonnade h encode) -> E.OneColonnade h $ \a -> if p a then changeContent (encode a) else encode a ) v ) @@ -214,9 +216,9 @@ replaceWhen :: -> (a -> Bool) -- ^ Row predicate -> Colonnade f a c -- ^ Original 'Colonnade' -> Colonnade f a c -replaceWhen newContent p (Colonnade v) = Colonnade +replaceWhen newContent p (E.Colonnade v) = E.Colonnade ( Vector.map - (\(OneColonnade h encode) -> OneColonnade h $ \a -> + (\(E.OneColonnade h encode) -> E.OneColonnade h $ \a -> if p a then newContent else encode a ) v ) @@ -273,7 +275,7 @@ replaceWhen newContent p (Colonnade v) = Colonnade -- +-------+-----+-------+---------+ -- cap :: c -> Colonnade Headed a c -> Cornice (Cap Base) a c -cap h = CorniceCap . Vector.singleton . OneCornice h . CorniceBase +cap h = E.CorniceCap . Vector.singleton . E.OneCornice h . E.CorniceBase -- | Add another cap to a cornice. There is no limit to how many times -- this can be applied: @@ -308,19 +310,19 @@ cap h = CorniceCap . Vector.singleton . OneCornice h . CorniceBase -- | Weekend | $9 | $9 | $9 | $7 | $8 | $9 | $9 | $9 | $7 | $8 | -- +---------+----+----+----+------+-------+----+----+----+------+-------+ recap :: c -> Cornice p a c -> Cornice (Cap p) a c -recap h cor = CorniceCap (Vector.singleton (OneCornice h cor)) +recap h cor = E.CorniceCap (Vector.singleton (E.OneCornice h cor)) asciiCapped :: Foldable f => Cornice p a String -- ^ columnar encoding -> f a -- ^ rows -> String asciiCapped cor xs = - let annCor = CE.annotateFinely (\x y -> x + y + 3) id + let annCor = E.annotateFinely (\x y -> x + y + 3) id List.length xs cor - sizedCol = CE.uncapAnnotated annCor - in CE.headersMonoidal + sizedCol = E.uncapAnnotated annCor + in E.headersMonoidal Nothing - [ (\sz c -> hyphens (sz + 2) ++ "+", \s -> "+" ++ s ++ "\n") + [ (\sz _ -> hyphens (sz + 2) ++ "+", \s -> "+" ++ s ++ "\n") , (\sz c -> " " ++ rightPad sz ' ' c ++ " |", \s -> "|" ++ s ++ "\n") ] annCor ++ asciiBody sizedCol xs @@ -335,41 +337,41 @@ ascii :: Foldable f -> f a -- ^ rows -> String ascii col xs = - let sizedCol = Encode.sizeColumns List.length xs col + let sizedCol = E.sizeColumns List.length xs col divider = concat [ "+" - , Encode.headerMonoidalFull sizedCol - (\(Sized sz _) -> hyphens (sz + 2) ++ "+") + , E.headerMonoidalFull sizedCol + (\(E.Sized sz _) -> hyphens (sz + 2) ++ "+") , "\n" ] in List.concat [ divider , concat [ "|" - , Encode.headerMonoidalFull sizedCol - (\(Sized s (Headed h)) -> " " ++ rightPad s ' ' h ++ " |") + , E.headerMonoidalFull sizedCol + (\(E.Sized s (Headed h)) -> " " ++ rightPad s ' ' h ++ " |") , "\n" ] , asciiBody sizedCol xs ] asciiBody :: Foldable f - => Colonnade (Sized Headed) a String + => Colonnade (E.Sized Headed) a String -> f a -> String asciiBody sizedCol xs = let divider = concat [ "+" - , Encode.headerMonoidalFull sizedCol - (\(Sized sz _) -> hyphens (sz + 2) ++ "+") + , E.headerMonoidalFull sizedCol + (\(E.Sized sz _) -> hyphens (sz + 2) ++ "+") , "\n" ] rowContents = foldMap (\x -> concat [ "|" - , Encode.rowMonoidalHeader + , E.rowMonoidalHeader sizedCol - (\(Sized sz _) c -> " " ++ rightPad sz ' ' c ++ " |") + (\(E.Sized sz _) c -> " " ++ rightPad sz ' ' c ++ " |") x , "\n" ] diff --git a/colonnade/src/Colonnade/Cornice/Encode.hs b/colonnade/src/Colonnade/Cornice/Encode.hs deleted file mode 100644 index 52d6391..0000000 --- a/colonnade/src/Colonnade/Cornice/Encode.hs +++ /dev/null @@ -1,213 +0,0 @@ -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE DataKinds #-} - -{-# OPTIONS_GHC -Wall -fno-warn-unused-imports -fno-warn-unticked-promoted-constructors -Werror #-} -module Colonnade.Cornice.Encode - ( annotate - , annotateFinely - , size - , endow - , discard - , headersMonoidal - , uncapAnnotated - ) where - -import Colonnade.Internal -import Data.Vector (Vector) -import Control.Monad.ST (ST,runST) -import Data.Monoid -import qualified Data.Vector as V -import qualified Colonnade.Encode as E - -discard :: Cornice p a c -> Colonnade Headed a c -discard = go where - go :: forall p a c. Cornice p a c -> Colonnade Headed a c - go (CorniceBase c) = c - go (CorniceCap children) = Colonnade (getColonnade . go . oneCorniceBody =<< children) - -endow :: forall p a c. (c -> c -> c) -> Cornice p a c -> Colonnade Headed a c -endow f x = case x of - CorniceBase colonnade -> colonnade - CorniceCap v -> Colonnade (V.concatMap (\(OneCornice h b) -> go h b) v) - where - go :: forall p'. c -> Cornice p' a c -> Vector (OneColonnade Headed a c) - go c (CorniceBase (Colonnade v)) = V.map (mapOneColonnadeHeader (f c)) v - go c (CorniceCap v) = V.concatMap (\(OneCornice h b) -> go (f c h) b) v - -uncapAnnotated :: forall p a c. AnnotatedCornice p a c -> Colonnade (Sized Headed) a c -uncapAnnotated x = case x of - AnnotatedCorniceBase _ colonnade -> colonnade - AnnotatedCorniceCap _ v -> Colonnade (V.concatMap (\(OneCornice _ b) -> go b) v) - where - go :: forall p'. AnnotatedCornice p' a c -> Vector (OneColonnade (Sized Headed) a c) - go (AnnotatedCorniceBase _ (Colonnade v)) = v - go (AnnotatedCorniceCap _ v) = V.concatMap (\(OneCornice _ b) -> go b) v - -annotate :: Cornice p a c -> AnnotatedCornice p a c -annotate = go where - go :: forall p a c. Cornice p a c -> AnnotatedCornice p a c - go (CorniceBase c) = let len = V.length (getColonnade c) in - AnnotatedCorniceBase - (if len > 0 then (Just len) else Nothing) - (mapHeadedness (Sized 1) c) - go (CorniceCap children) = - let annChildren = fmap (mapOneCorniceBody go) children - in AnnotatedCorniceCap - ( ( ( V.foldl' (combineJustInt (+)) - ) Nothing . V.map (size . oneCorniceBody) - ) annChildren - ) - annChildren - -combineJustInt :: (Int -> Int -> Int) -> Maybe Int -> Maybe Int -> Maybe Int -combineJustInt f acc el = case acc of - Nothing -> case el of - Nothing -> Nothing - Just i -> Just i - Just i -> case el of - Nothing -> Just i - Just j -> Just (f i j) - -mapJustInt :: (Int -> Int) -> Maybe Int -> Maybe Int -mapJustInt _ Nothing = Nothing -mapJustInt f (Just i) = Just (f i) - -annotateFinely :: Foldable f - => (Int -> Int -> Int) -- ^ fold function - -> (Int -> Int) -- ^ finalize - -> (c -> Int) -- ^ Get size from content - -> f a - -> Cornice p a c - -> AnnotatedCornice p a c -annotateFinely g finish toSize xs cornice = runST $ do - m <- newMutableSizedCornice cornice - sizeColonnades toSize xs m - freezeMutableSizedCornice g finish m - -sizeColonnades :: forall f s p a c. - Foldable f - => (c -> Int) -- ^ Get size from content - -> f a - -> MutableSizedCornice s p a c - -> ST s () -sizeColonnades toSize xs cornice = do - goHeader cornice - mapM_ (goRow cornice) xs - where - goRow :: forall p'. MutableSizedCornice s p' a c -> a -> ST s () - goRow (MutableSizedCorniceBase c) a = E.rowUpdateSize toSize c a - goRow (MutableSizedCorniceCap children) a = mapM_ (flip goRow a . oneCorniceBody) children - goHeader :: forall p'. MutableSizedCornice s p' a c -> ST s () - goHeader (MutableSizedCorniceBase c) = E.headerUpdateSize toSize c - goHeader (MutableSizedCorniceCap children) = mapM_ (goHeader . oneCorniceBody) children - -freezeMutableSizedCornice :: forall s p a c. - (Int -> Int -> Int) -- ^ fold function - -> (Int -> Int) -- ^ finalize - -> MutableSizedCornice s p a c - -> ST s (AnnotatedCornice p a c) -freezeMutableSizedCornice step finish = go - where - go :: forall p' a' c'. MutableSizedCornice s p' a' c' -> ST s (AnnotatedCornice p' a' c') - go (MutableSizedCorniceBase msc) = do - szCol <- E.freezeMutableSizedColonnade msc - let sz = - ( mapJustInt finish - . V.foldl' (combineJustInt step) Nothing - . V.map (Just . sizedSize . oneColonnadeHead) - ) (getColonnade szCol) - return (AnnotatedCorniceBase sz szCol) - go (MutableSizedCorniceCap v1) = do - v2 <- V.mapM (traverseOneCorniceBody go) v1 - let sz = - ( mapJustInt finish - . V.foldl' (combineJustInt step) Nothing - . V.map (size . oneCorniceBody) - ) v2 - return $ AnnotatedCorniceCap sz v2 - -newMutableSizedCornice :: forall s p a c. - Cornice p a c - -> ST s (MutableSizedCornice s p a c) -newMutableSizedCornice = go where - go :: forall p'. Cornice p' a c -> ST s (MutableSizedCornice s p' a c) - go (CorniceBase c) = fmap MutableSizedCorniceBase (E.newMutableSizedColonnade c) - go (CorniceCap v) = fmap MutableSizedCorniceCap (V.mapM (traverseOneCorniceBody go) v) - -traverseOneCorniceBody :: Monad m => (k p a c -> m (j p a c)) -> OneCornice k p a c -> m (OneCornice j p a c) -traverseOneCorniceBody f (OneCornice h b) = fmap (OneCornice h) (f b) - -mapHeadedness :: (forall x. h x -> h' x) -> Colonnade h a c -> Colonnade h' a c -mapHeadedness f (Colonnade v) = - Colonnade (V.map (\(OneColonnade h c) -> OneColonnade (f h) c) v) - - --- | This is an O(1) operation, sort of -size :: AnnotatedCornice p a c -> Maybe Int -size x = case x of - AnnotatedCorniceBase m _ -> m - AnnotatedCorniceCap sz _ -> sz - -mapOneCorniceBody :: (forall p' a' c'. k p' a' c' -> j p' a' c') -> OneCornice k p a c -> OneCornice j p a c -mapOneCorniceBody f (OneCornice h b) = OneCornice h (f b) - -mapOneColonnadeHeader :: Functor h => (c -> c) -> OneColonnade h a c -> OneColonnade h a c -mapOneColonnadeHeader f (OneColonnade h b) = OneColonnade (fmap f h) b - -headersMonoidal :: forall r m c p a. - Monoid m - => Maybe (Fascia p r, r -> m -> m) -- ^ Apply the Fascia header row content - -> [(Int -> c -> m, m -> m)] -- ^ Build content from cell content and size - -> AnnotatedCornice p a c - -> m -headersMonoidal wrapRow fromContentList = go wrapRow - where - go :: forall p'. Maybe (Fascia p' r, r -> m -> m) -> AnnotatedCornice p' a c -> m - go ef (AnnotatedCorniceBase _ (Colonnade v)) = - let g :: m -> m - g m = case ef of - Nothing -> m - Just (FasciaBase r, f) -> f r m - in g $ foldMap (\(fromContent,wrap) -> wrap - (foldMap (\(OneColonnade (Sized sz (Headed h)) _) -> - (fromContent sz h)) v)) fromContentList - go ef (AnnotatedCorniceCap _ v) = - let g :: m -> m - g m = case ef of - Nothing -> m - Just (FasciaCap r _, f) -> f r m - in g (foldMap (\(fromContent,wrap) -> wrap (foldMap (\(OneCornice h b) -> - (case size b of - Nothing -> mempty - Just sz -> fromContent sz h) - ) v)) fromContentList) - <> case ef of - Nothing -> case flattenAnnotated v of - Nothing -> mempty - Just annCoreNext -> go Nothing annCoreNext - Just (FasciaCap _ fn, f) -> case flattenAnnotated v of - Nothing -> mempty - Just annCoreNext -> go (Just (fn,f)) annCoreNext - -flattenAnnotated :: Vector (OneCornice AnnotatedCornice p a c) -> Maybe (AnnotatedCornice p a c) -flattenAnnotated v = case v V.!? 0 of - Nothing -> Nothing - Just (OneCornice _ x) -> Just $ case x of - AnnotatedCorniceBase m _ -> flattenAnnotatedBase m v - AnnotatedCorniceCap m _ -> flattenAnnotatedCap m v - -flattenAnnotatedBase :: Maybe Int -> Vector (OneCornice AnnotatedCornice Base a c) -> AnnotatedCornice Base a c -flattenAnnotatedBase msz = AnnotatedCorniceBase msz - . Colonnade - . V.concatMap - (\(OneCornice _ (AnnotatedCorniceBase _ (Colonnade v))) -> v) - -flattenAnnotatedCap :: Maybe Int -> Vector (OneCornice AnnotatedCornice (Cap p) a c) -> AnnotatedCornice (Cap p) a c -flattenAnnotatedCap m = AnnotatedCorniceCap m . V.concatMap getTheVector - -getTheVector :: OneCornice AnnotatedCornice (Cap p) a c -> Vector (OneCornice AnnotatedCornice p a c) -getTheVector (OneCornice _ (AnnotatedCorniceCap _ v)) = v - - diff --git a/colonnade/src/Colonnade/Decoding.hs b/colonnade/src/Colonnade/Decoding.hs deleted file mode 100644 index ae913d5..0000000 --- a/colonnade/src/Colonnade/Decoding.hs +++ /dev/null @@ -1,174 +0,0 @@ -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveFunctor #-} -module Colonnade.Decoding where - -import Colonnade.Types -import Data.Functor.Contravariant -import Data.Vector (Vector) -import qualified Data.Vector as Vector -import Data.Char (chr) - --- | Converts the content type of a 'Decolonnade'. The @'Contravariant' f@ --- constraint means that @f@ can be 'Headless' but not 'Headed'. -contramapContent :: forall c1 c2 f a. Contravariant f => (c2 -> c1) -> Decolonnade f c1 a -> Decolonnade f c2 a -contramapContent f = go - where - go :: forall b. Decolonnade f c1 b -> Decolonnade f c2 b - go (DecolonnadePure x) = DecolonnadePure x - go (DecolonnadeAp h decode apNext) = - DecolonnadeAp (contramap f h) (decode . f) (go apNext) - -headless :: (content -> Either String a) -> Decolonnade Headless content a -headless f = DecolonnadeAp Headless f (DecolonnadePure id) - -headed :: content -> (content -> Either String a) -> Decolonnade Headed content a -headed h f = DecolonnadeAp (Headed h) f (DecolonnadePure id) - -indexed :: Int -> (content -> Either String a) -> Decolonnade (Indexed Headless) content a -indexed ix f = DecolonnadeAp (Indexed ix Headless) f (DecolonnadePure id) - -maxIndex :: forall f c a. Decolonnade (Indexed f) c a -> Int -maxIndex = go 0 where - go :: forall b. Int -> Decolonnade (Indexed f) c b -> Int - go !ix (DecolonnadePure _) = ix - go !ix1 (DecolonnadeAp (Indexed ix2 _) decode apNext) = - go (max ix1 ix2) apNext - --- | This function uses 'unsafeIndex' to access --- elements of the 'Vector'. -uncheckedRunWithRow :: - Int - -> Decolonnade (Indexed f) content a - -> Vector content - -> Either (DecolonnadeRowError f content) a -uncheckedRunWithRow i d v = mapLeft (DecolonnadeRowError i . RowErrorDecode) (uncheckedRun d v) - --- | This function does not check to make sure that the indicies in --- the 'Decolonnade' are in the 'Vector'. -uncheckedRun :: forall content a f. - Decolonnade (Indexed f) content a - -> Vector content - -> Either (DecolonnadeCellErrors f content) a -uncheckedRun dc v = getEitherWrap (go dc) - where - go :: forall b. - Decolonnade (Indexed f) content b - -> EitherWrap (DecolonnadeCellErrors f content) b - go (DecolonnadePure b) = EitherWrap (Right b) - go (DecolonnadeAp ixed@(Indexed ix h) decode apNext) = - let rnext = go apNext - content = Vector.unsafeIndex v ix - rcurrent = mapLeft (DecolonnadeCellErrors . Vector.singleton . DecolonnadeCellError content ixed) (decode content) - in rnext <*> (EitherWrap rcurrent) - -headlessToIndexed :: forall c a. - Decolonnade Headless c a -> Decolonnade (Indexed Headless) c a -headlessToIndexed = go 0 where - go :: forall b. Int -> Decolonnade Headless c b -> Decolonnade (Indexed Headless) c b - go !ix (DecolonnadePure a) = DecolonnadePure a - go !ix (DecolonnadeAp Headless decode apNext) = - DecolonnadeAp (Indexed ix Headless) decode (go (ix + 1) apNext) - -length :: forall f c a. Decolonnade f c a -> Int -length = go 0 where - go :: forall b. Int -> Decolonnade f c b -> Int - go !a (DecolonnadePure _) = a - go !a (DecolonnadeAp _ _ apNext) = go (a + 1) apNext - --- | Maps over a 'Decolonnade' that expects headers, converting these --- expected headers into the indices of the columns that they --- correspond to. -headedToIndexed :: forall content a. Eq content - => Vector content -- ^ Headers in the source document - -> Decolonnade Headed content a -- ^ Decolonnade that contains expected headers - -> Either (HeadingErrors content) (Decolonnade (Indexed Headed) content a) -headedToIndexed v = getEitherWrap . go - where - go :: forall b. Eq content - => Decolonnade Headed content b - -> EitherWrap (HeadingErrors content) (Decolonnade (Indexed Headed) content b) - go (DecolonnadePure b) = EitherWrap (Right (DecolonnadePure b)) - go (DecolonnadeAp hd@(Headed h) decode apNext) = - let rnext = go apNext - ixs = Vector.elemIndices h v - ixsLen = Vector.length ixs - rcurrent - | ixsLen == 1 = Right (Vector.unsafeIndex ixs 0) - | ixsLen == 0 = Left (HeadingErrors (Vector.singleton h) Vector.empty) - | otherwise = Left (HeadingErrors Vector.empty (Vector.singleton (h,ixsLen))) - in (\ix ap -> DecolonnadeAp (Indexed ix hd) decode ap) - <$> EitherWrap rcurrent - <*> rnext - --- | This adds one to the index because text editors consider --- line number to be one-based, not zero-based. -prettyError :: (c -> String) -> DecolonnadeRowError f c -> String -prettyError toStr (DecolonnadeRowError ix e) = unlines - $ ("Decolonnade error on line " ++ show (ix + 1) ++ " of file.") - : ("Error Category: " ++ descr) - : map (" " ++) errDescrs - where (descr,errDescrs) = prettyRowError toStr e - -prettyRowError :: (content -> String) -> RowError f content -> (String, [String]) -prettyRowError toStr x = case x of - RowErrorParse err -> (,) "CSV Parsing" - [ "The line could not be parsed into cells correctly." - , "Original parser error: " ++ err - ] - RowErrorSize reqLen actualLen -> (,) "Row Length" - [ "Expected the row to have exactly " ++ show reqLen ++ " cells." - , "The row only has " ++ show actualLen ++ " cells." - ] - RowErrorMinSize reqLen actualLen -> (,) "Row Min Length" - [ "Expected the row to have at least " ++ show reqLen ++ " cells." - , "The row only has " ++ show actualLen ++ " cells." - ] - RowErrorMalformed enc -> (,) "Text Decolonnade" - [ "Tried to decode the input as " ++ enc ++ " text" - , "There is a mistake in the encoding of the text." - ] - RowErrorHeading errs -> (,) "Header" (prettyHeadingErrors toStr errs) - RowErrorDecode errs -> (,) "Cell Decolonnade" (prettyCellErrors toStr errs) - -prettyCellErrors :: (c -> String) -> DecolonnadeCellErrors f c -> [String] -prettyCellErrors toStr (DecolonnadeCellErrors errs) = drop 1 $ - flip concatMap errs $ \(DecolonnadeCellError content (Indexed ix _) msg) -> - let str = toStr content in - [ "-----------" - , "Column " ++ columnNumToLetters ix - , "Original parse error: " ++ msg - , "Cell Content Length: " ++ show (Prelude.length str) - , "Cell Content: " ++ if null str - then "[empty cell]" - else str - ] - -prettyHeadingErrors :: (c -> String) -> HeadingErrors c -> [String] -prettyHeadingErrors conv (HeadingErrors missing duplicates) = concat - [ concatMap (\h -> ["The header " ++ conv h ++ " was missing."]) missing - , concatMap (\(h,n) -> ["The header " ++ conv h ++ " occurred " ++ show n ++ " times."]) duplicates - ] - -columnNumToLetters :: Int -> String -columnNumToLetters i - | i >= 0 && i < 25 = [chr (i + 65)] - | otherwise = "Beyond Z. Fix this." - - -newtype EitherWrap a b = EitherWrap - { getEitherWrap :: Either a b - } deriving (Functor) - -instance Monoid a => Applicative (EitherWrap a) where - pure = EitherWrap . Right - EitherWrap (Left a1) <*> EitherWrap (Left a2) = EitherWrap (Left (mappend a1 a2)) - EitherWrap (Left a1) <*> EitherWrap (Right _) = EitherWrap (Left a1) - EitherWrap (Right _) <*> EitherWrap (Left a2) = EitherWrap (Left a2) - EitherWrap (Right f) <*> EitherWrap (Right b) = EitherWrap (Right (f b)) - -mapLeft :: (a -> b) -> Either a c -> Either b c -mapLeft _ (Right a) = Right a -mapLeft f (Left a) = Left (f a) - diff --git a/colonnade/src/Colonnade/Encode.hs b/colonnade/src/Colonnade/Encode.hs index 07085f9..5bc75db 100644 --- a/colonnade/src/Colonnade/Encode.hs +++ b/colonnade/src/Colonnade/Encode.hs @@ -1,3 +1,15 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{-# OPTIONS_HADDOCK not-home #-} +{-# OPTIONS_GHC -Wall -fno-warn-unused-imports -fno-warn-unticked-promoted-constructors -Werror #-} + -- | 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, @@ -25,12 +37,21 @@ -- an @a@ value since a value is not needed to build a header. -- module Colonnade.Encode - ( row + ( -- * Colonnade + -- ** Types + Colonnade(..) + , OneColonnade(..) + , Headed(..) + , Headless(..) + , Sized(..) + -- ** Row + , row , rowMonadic , rowMonadic_ , rowMonadicWith , rowMonoidal , rowMonoidalHeader + -- ** Header , header , headerMonadic , headerMonadic_ @@ -38,23 +59,43 @@ module Colonnade.Encode , headerMonadicGeneral_ , headerMonoidalGeneral , headerMonoidalFull + -- ** Other , bothMonadic_ - , freezeMutableSizedColonnade - , newMutableSizedColonnade - , rowUpdateSize - , headerUpdateSize , sizeColumns + -- * Cornice + -- ** Types + , Cornice(..) + , AnnotatedCornice(..) + , OneCornice(..) + , Pillar(..) + , ToEmptyCornice(..) + , Fascia(..) + -- ** Encoding + , annotate + , annotateFinely + , size + , endow + , discard + , headersMonoidal + , uncapAnnotated ) where -import Colonnade.Internal import Data.Vector (Vector) import Data.Foldable import Control.Monad.ST (ST,runST) import Data.Monoid +import Data.Functor.Contravariant (Contravariant(..)) +import Data.Profunctor (Profunctor(..)) +import Data.Semigroup (Semigroup) +import Data.List.NonEmpty (NonEmpty((:|))) +import Data.Foldable (toList) +import qualified Data.Semigroup as Semigroup import qualified Data.Vector as Vector +import qualified Data.Vector as V import qualified Data.Vector.Unboxed.Mutable as MVU import qualified Data.Vector.Unboxed as VU import qualified Data.Vector as V +import qualified Data.Vector as Vector import qualified Data.Vector.Generic as GV -- | Consider providing a variant the produces a list @@ -98,7 +139,7 @@ rowMonoidal :: -> a -> m rowMonoidal (Colonnade v) g a = - foldMap (\(OneColonnade h encode) -> g (encode a)) v + foldMap (\(OneColonnade _ encode) -> g (encode a)) v rowMonoidalHeader :: Monoid m @@ -225,4 +266,346 @@ headerMonadic_ (Colonnade v) g = Vector.mapM_ (g . getHeaded . oneColonnadeHead) 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 +discard :: Cornice p a c -> Colonnade Headed a c +discard = go where + go :: forall p a c. Cornice p a c -> Colonnade Headed a c + go (CorniceBase c) = c + go (CorniceCap children) = Colonnade (getColonnade . go . oneCorniceBody =<< children) + +endow :: forall p a c. (c -> c -> c) -> Cornice p a c -> Colonnade Headed a c +endow f x = case x of + CorniceBase colonnade -> colonnade + CorniceCap v -> Colonnade (V.concatMap (\(OneCornice h b) -> go h b) v) + where + go :: forall p'. c -> Cornice p' a c -> Vector (OneColonnade Headed a c) + go c (CorniceBase (Colonnade v)) = V.map (mapOneColonnadeHeader (f c)) v + go c (CorniceCap v) = V.concatMap (\(OneCornice h b) -> go (f c h) b) v + +uncapAnnotated :: forall p a c. AnnotatedCornice p a c -> Colonnade (Sized Headed) a c +uncapAnnotated x = case x of + AnnotatedCorniceBase _ colonnade -> colonnade + AnnotatedCorniceCap _ v -> Colonnade (V.concatMap (\(OneCornice _ b) -> go b) v) + where + go :: forall p'. AnnotatedCornice p' a c -> Vector (OneColonnade (Sized Headed) a c) + go (AnnotatedCorniceBase _ (Colonnade v)) = v + go (AnnotatedCorniceCap _ v) = V.concatMap (\(OneCornice _ b) -> go b) v + +annotate :: Cornice p a c -> AnnotatedCornice p a c +annotate = go where + go :: forall p a c. Cornice p a c -> AnnotatedCornice p a c + go (CorniceBase c) = let len = V.length (getColonnade c) in + AnnotatedCorniceBase + (if len > 0 then (Just len) else Nothing) + (mapHeadedness (Sized 1) c) + go (CorniceCap children) = + let annChildren = fmap (mapOneCorniceBody go) children + in AnnotatedCorniceCap + ( ( ( V.foldl' (combineJustInt (+)) + ) Nothing . V.map (size . oneCorniceBody) + ) annChildren + ) + annChildren + +combineJustInt :: (Int -> Int -> Int) -> Maybe Int -> Maybe Int -> Maybe Int +combineJustInt f acc el = case acc of + Nothing -> case el of + Nothing -> Nothing + Just i -> Just i + Just i -> case el of + Nothing -> Just i + Just j -> Just (f i j) + +mapJustInt :: (Int -> Int) -> Maybe Int -> Maybe Int +mapJustInt _ Nothing = Nothing +mapJustInt f (Just i) = Just (f i) + +annotateFinely :: Foldable f + => (Int -> Int -> Int) -- ^ fold function + -> (Int -> Int) -- ^ finalize + -> (c -> Int) -- ^ Get size from content + -> f a + -> Cornice p a c + -> AnnotatedCornice p a c +annotateFinely g finish toSize xs cornice = runST $ do + m <- newMutableSizedCornice cornice + sizeColonnades toSize xs m + freezeMutableSizedCornice g finish m + +sizeColonnades :: forall f s p a c. + Foldable f + => (c -> Int) -- ^ Get size from content + -> f a + -> MutableSizedCornice s p a c + -> ST s () +sizeColonnades toSize xs cornice = do + goHeader cornice + mapM_ (goRow cornice) xs + where + goRow :: forall p'. MutableSizedCornice s p' a c -> a -> ST s () + goRow (MutableSizedCorniceBase c) a = rowUpdateSize toSize c a + goRow (MutableSizedCorniceCap children) a = mapM_ (flip goRow a . oneCorniceBody) children + goHeader :: forall p'. MutableSizedCornice s p' a c -> ST s () + goHeader (MutableSizedCorniceBase c) = headerUpdateSize toSize c + goHeader (MutableSizedCorniceCap children) = mapM_ (goHeader . oneCorniceBody) children + +freezeMutableSizedCornice :: forall s p a c. + (Int -> Int -> Int) -- ^ fold function + -> (Int -> Int) -- ^ finalize + -> MutableSizedCornice s p a c + -> ST s (AnnotatedCornice p a c) +freezeMutableSizedCornice step finish = go + where + go :: forall p' a' c'. MutableSizedCornice s p' a' c' -> ST s (AnnotatedCornice p' a' c') + go (MutableSizedCorniceBase msc) = do + szCol <- freezeMutableSizedColonnade msc + let sz = + ( mapJustInt finish + . V.foldl' (combineJustInt step) Nothing + . V.map (Just . sizedSize . oneColonnadeHead) + ) (getColonnade szCol) + return (AnnotatedCorniceBase sz szCol) + go (MutableSizedCorniceCap v1) = do + v2 <- V.mapM (traverseOneCorniceBody go) v1 + let sz = + ( mapJustInt finish + . V.foldl' (combineJustInt step) Nothing + . V.map (size . oneCorniceBody) + ) v2 + return $ AnnotatedCorniceCap sz v2 + +newMutableSizedCornice :: forall s p a c. + Cornice p a c + -> ST s (MutableSizedCornice s p a c) +newMutableSizedCornice = go where + go :: forall p'. Cornice p' a c -> ST s (MutableSizedCornice s p' a c) + go (CorniceBase c) = fmap MutableSizedCorniceBase (newMutableSizedColonnade c) + go (CorniceCap v) = fmap MutableSizedCorniceCap (V.mapM (traverseOneCorniceBody go) v) + +traverseOneCorniceBody :: Monad m => (k p a c -> m (j p a c)) -> OneCornice k p a c -> m (OneCornice j p a c) +traverseOneCorniceBody f (OneCornice h b) = fmap (OneCornice h) (f b) + +mapHeadedness :: (forall x. h x -> h' x) -> Colonnade h a c -> Colonnade h' a c +mapHeadedness f (Colonnade v) = + Colonnade (V.map (\(OneColonnade h c) -> OneColonnade (f h) c) v) + + +-- | This is an O(1) operation, sort of +size :: AnnotatedCornice p a c -> Maybe Int +size x = case x of + AnnotatedCorniceBase m _ -> m + AnnotatedCorniceCap sz _ -> sz + +mapOneCorniceBody :: (forall p' a' c'. k p' a' c' -> j p' a' c') -> OneCornice k p a c -> OneCornice j p a c +mapOneCorniceBody f (OneCornice h b) = OneCornice h (f b) + +mapOneColonnadeHeader :: Functor h => (c -> c) -> OneColonnade h a c -> OneColonnade h a c +mapOneColonnadeHeader f (OneColonnade h b) = OneColonnade (fmap f h) b + +headersMonoidal :: forall r m c p a. + Monoid m + => Maybe (Fascia p r, r -> m -> m) -- ^ Apply the Fascia header row content + -> [(Int -> c -> m, m -> m)] -- ^ Build content from cell content and size + -> AnnotatedCornice p a c + -> m +headersMonoidal wrapRow fromContentList = go wrapRow + where + go :: forall p'. Maybe (Fascia p' r, r -> m -> m) -> AnnotatedCornice p' a c -> m + go ef (AnnotatedCorniceBase _ (Colonnade v)) = + let g :: m -> m + g m = case ef of + Nothing -> m + Just (FasciaBase r, f) -> f r m + in g $ foldMap (\(fromContent,wrap) -> wrap + (foldMap (\(OneColonnade (Sized sz (Headed h)) _) -> + (fromContent sz h)) v)) fromContentList + go ef (AnnotatedCorniceCap _ v) = + let g :: m -> m + g m = case ef of + Nothing -> m + Just (FasciaCap r _, f) -> f r m + in g (foldMap (\(fromContent,wrap) -> wrap (foldMap (\(OneCornice h b) -> + (case size b of + Nothing -> mempty + Just sz -> fromContent sz h) + ) v)) fromContentList) + <> case ef of + Nothing -> case flattenAnnotated v of + Nothing -> mempty + Just annCoreNext -> go Nothing annCoreNext + Just (FasciaCap _ fn, f) -> case flattenAnnotated v of + Nothing -> mempty + Just annCoreNext -> go (Just (fn,f)) annCoreNext + +flattenAnnotated :: Vector (OneCornice AnnotatedCornice p a c) -> Maybe (AnnotatedCornice p a c) +flattenAnnotated v = case v V.!? 0 of + Nothing -> Nothing + Just (OneCornice _ x) -> Just $ case x of + AnnotatedCorniceBase m _ -> flattenAnnotatedBase m v + AnnotatedCorniceCap m _ -> flattenAnnotatedCap m v + +flattenAnnotatedBase :: Maybe Int -> Vector (OneCornice AnnotatedCornice Base a c) -> AnnotatedCornice Base a c +flattenAnnotatedBase msz = AnnotatedCorniceBase msz + . Colonnade + . V.concatMap + (\(OneCornice _ (AnnotatedCorniceBase _ (Colonnade v))) -> v) + +flattenAnnotatedCap :: Maybe Int -> Vector (OneCornice AnnotatedCornice (Cap p) a c) -> AnnotatedCornice (Cap p) a c +flattenAnnotatedCap m = AnnotatedCorniceCap m . V.concatMap getTheVector + +getTheVector :: OneCornice AnnotatedCornice (Cap p) a c -> Vector (OneCornice AnnotatedCornice p a c) +getTheVector (OneCornice _ (AnnotatedCorniceCap _ v)) = v + +data MutableSizedCornice s (p :: Pillar) a c where + MutableSizedCorniceBase :: + {-# UNPACK #-} !(MutableSizedColonnade s Headed a c) + -> MutableSizedCornice s Base a c + MutableSizedCorniceCap :: + {-# UNPACK #-} !(Vector (OneCornice (MutableSizedCornice s) p a c)) + -> MutableSizedCornice s (Cap p) a c + +data MutableSizedColonnade s h a c = MutableSizedColonnade + { _mutableSizedColonnadeColumns :: {-# UNPACK #-} !(Vector (OneColonnade h a c)) + , _mutableSizedColonnadeSizes :: {-# UNPACK #-} !(MVU.STVector s Int) + } + +-- | As the first argument to the 'Colonnade' type +-- constructor, this indictates that the columnar encoding has +-- a header. This type is isomorphic to 'Identity' but is +-- given a new name to clarify its intent: +-- +-- > example :: Colonnade Headed Foo Text +-- +-- The term @example@ represents a columnar encoding of @Foo@ +-- in which the columns have headings. +newtype Headed a = Headed { getHeaded :: a } + deriving (Eq,Ord,Functor,Show,Read,Foldable) + +-- | As the first argument to the 'Colonnade' type +-- constructor, this indictates that the columnar encoding does not have +-- a header. This type is isomorphic to 'Proxy' but is +-- given a new name to clarify its intent: +-- +-- > example :: Colonnade Headless Foo Text +-- +-- The term @example@ represents a columnar encoding of @Foo@ +-- in which the columns do not have headings. +data Headless a = Headless + deriving (Eq,Ord,Functor,Show,Read,Foldable) + +data Sized f a = Sized + { sizedSize :: {-# UNPACK #-} !Int + , sizedContent :: !(f a) + } deriving (Functor, Foldable) + +instance Contravariant Headless where + contramap _ Headless = Headless + +-- | Encodes a header and a cell. +data OneColonnade h a c = OneColonnade + { oneColonnadeHead :: !(h c) + , oneColonnadeEncode :: !(a -> c) + } deriving (Functor) + +instance Functor h => Profunctor (OneColonnade h) where + rmap = fmap + lmap f (OneColonnade h e) = OneColonnade h (e . f) + +-- | 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 +-- of use cases. The type variable @c@ is the content type. This can +-- 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. Presented more visually: +-- +-- > +---- Value consumed to build a row +-- > | +-- > v +-- > Colonnade h a c +-- > ^ ^ +-- > | | +-- > | +-- Content (Text, ByteString, Html, etc.) +-- > | +-- > +------ 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 +-- 'Alternative' and 'Foldable' instances. However, 'Vector' was chosen to +-- optimize the data structure for the use case of building the structure +-- 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 h a c = Colonnade + { getColonnade :: Vector (OneColonnade h a c) + } deriving (Monoid,Functor) + +instance Functor h => Profunctor (Colonnade h) where + rmap = fmap + lmap f (Colonnade v) = Colonnade (Vector.map (lmap f) v) + +instance Semigroup (Colonnade h a c) where + Colonnade a <> Colonnade b = Colonnade (a Vector.++ b) + sconcat xs = Colonnade (vectorConcatNE (fmap getColonnade xs)) + +-- | Isomorphic to the natural numbers. Only the promoted version of +-- this type is used. +data Pillar = Cap !Pillar | Base + +class ToEmptyCornice (p :: Pillar) where + toEmptyCornice :: Cornice p a c + +instance ToEmptyCornice Base where + toEmptyCornice = CorniceBase mempty + +instance ToEmptyCornice (Cap p) where + toEmptyCornice = CorniceCap Vector.empty + +data Fascia (p :: Pillar) r where + FasciaBase :: !r -> Fascia Base r + FasciaCap :: !r -> Fascia p r -> Fascia (Cap p) r + +data OneCornice k (p :: Pillar) a c = OneCornice + { oneCorniceHead :: !c + , oneCorniceBody :: !(k p a c) + } + +data Cornice (p :: Pillar) a c where + CorniceBase :: !(Colonnade Headed a c) -> Cornice Base a c + CorniceCap :: {-# UNPACK #-} !(Vector (OneCornice Cornice p a c)) -> Cornice (Cap p) a c + +instance Semigroup (Cornice p a c) where + CorniceBase a <> CorniceBase b = CorniceBase (mappend a b) + CorniceCap a <> CorniceCap b = CorniceCap (a Vector.++ b) + sconcat xs@(x :| _) = case x of + CorniceBase _ -> CorniceBase (Colonnade (vectorConcatNE (fmap (getColonnade . getCorniceBase) xs))) + CorniceCap _ -> CorniceCap (vectorConcatNE (fmap getCorniceCap xs)) + +instance ToEmptyCornice p => Monoid (Cornice p a c) where + mempty = toEmptyCornice + mappend = (Semigroup.<>) + mconcat xs1 = case xs1 of + [] -> toEmptyCornice + x : xs2 -> Semigroup.sconcat (x :| xs2) + +getCorniceBase :: Cornice Base a c -> Colonnade Headed a c +getCorniceBase (CorniceBase c) = c + +getCorniceCap :: Cornice (Cap p) a c -> Vector (OneCornice Cornice p a c) +getCorniceCap (CorniceCap c) = c + +data AnnotatedCornice (p :: Pillar) a c where + AnnotatedCorniceBase :: !(Maybe Int) -> !(Colonnade (Sized Headed) a c) -> AnnotatedCornice Base a c + AnnotatedCorniceCap :: + !(Maybe Int) + -> {-# UNPACK #-} !(Vector (OneCornice AnnotatedCornice p a c)) + -> AnnotatedCornice (Cap p) a c + +-- data MaybeInt = JustInt {-# UNPACK #-} !Int | NothingInt + +-- | This is provided with vector-0.12, but we include a copy here +-- for compatibility. +vectorConcatNE :: NonEmpty (Vector a) -> Vector a +vectorConcatNE = Vector.concat . toList diff --git a/colonnade/src/Colonnade/Encoding.hs b/colonnade/src/Colonnade/Encoding.hs deleted file mode 100644 index e69de29..0000000 diff --git a/colonnade/src/Colonnade/Internal.hs b/colonnade/src/Colonnade/Internal.hs deleted file mode 100644 index c04ec5b..0000000 --- a/colonnade/src/Colonnade/Internal.hs +++ /dev/null @@ -1,197 +0,0 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} - -{-# OPTIONS_HADDOCK not-home #-} -{-# OPTIONS_GHC -Wall -fno-warn-unused-imports -fno-warn-unticked-promoted-constructors -Werror #-} - -module Colonnade.Internal - ( -- * Colonnade - Colonnade(..) - , OneColonnade(..) - , Headed(..) - , Headless(..) - -- * Cornice - , Cornice(..) - , AnnotatedCornice(..) - , OneCornice(..) - , Pillar(..) - , ToEmptyCornice(..) - , Fascia(..) - -- * Sizing - , Sized(..) - , MutableSizedColonnade(..) - , MutableSizedCornice(..) - ) where - -import Data.Vector (Vector) -import Data.Functor.Contravariant (Contravariant(..)) -import Data.Functor.Contravariant.Divisible (Divisible(..)) -import Control.Exception (Exception) -import Data.Typeable (Typeable) -import Data.Profunctor (Profunctor(..)) -import Data.Semigroup (Semigroup) -import Data.List.NonEmpty (NonEmpty((:|))) -import Data.Foldable (toList) -import qualified Data.Vector.Unboxed.Mutable as MVU -import qualified Data.Semigroup as Semigroup -import qualified Data.Vector as Vector -import qualified Data.Vector.Generic as VG - --- | As the first argument to the 'Colonnade' type --- constructor, this indictates that the columnar encoding has --- a header. This type is isomorphic to 'Identity' but is --- given a new name to clarify its intent: --- --- > example :: Colonnade Headed Foo Text --- --- The term @example@ represents a columnar encoding of @Foo@ --- in which the columns have headings. -newtype Headed a = Headed { getHeaded :: a } - deriving (Eq,Ord,Functor,Show,Read,Foldable) - --- | As the first argument to the 'Colonnade' type --- constructor, this indictates that the columnar encoding does not have --- a header. This type is isomorphic to 'Proxy' but is --- given a new name to clarify its intent: --- --- > example :: Colonnade Headless Foo Text --- --- The term @example@ represents a columnar encoding of @Foo@ --- in which the columns do not have headings. -data Headless a = Headless - deriving (Eq,Ord,Functor,Show,Read,Foldable) - -data Sized f a = Sized - { sizedSize :: {-# UNPACK #-} !Int - , sizedContent :: !(f a) - } deriving (Functor, Foldable) - -instance Contravariant Headless where - contramap _ Headless = Headless - --- | Encodes a header and a cell. -data OneColonnade h a c = OneColonnade - { oneColonnadeHead :: !(h c) - , oneColonnadeEncode :: !(a -> c) - } deriving (Functor) - -instance Functor h => Profunctor (OneColonnade h) where - rmap = fmap - lmap f (OneColonnade h e) = OneColonnade h (e . f) - --- | 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 --- of use cases. The type variable @c@ is the content type. This can --- 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. Presented more visually: --- --- > +---- Value consumed to build a row --- > | --- > v --- > Colonnade h a c --- > ^ ^ --- > | | --- > | +-- Content (Text, ByteString, Html, etc.) --- > | --- > +------ 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 --- 'Alternative' and 'Foldable' instances. However, 'Vector' was chosen to --- optimize the data structure for the use case of building the structure --- 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 h a c = Colonnade - { getColonnade :: Vector (OneColonnade h a c) - } deriving (Monoid,Functor) - -instance Functor h => Profunctor (Colonnade h) where - rmap = fmap - lmap f (Colonnade v) = Colonnade (Vector.map (lmap f) v) - -instance Semigroup (Colonnade h a c) where - Colonnade a <> Colonnade b = Colonnade (a Vector.++ b) - sconcat xs = Colonnade (vectorConcatNE (fmap getColonnade xs)) - -data MutableSizedColonnade s h a c = MutableSizedColonnade - { mutableSizedColonnadeColumns :: {-# UNPACK #-} !(Vector (OneColonnade h a c)) - , mutableSizedColonnadeSizes :: {-# UNPACK #-} !(MVU.STVector s Int) - } - --- | Isomorphic to the natural numbers. Only the promoted version of --- this type is used. -data Pillar = Cap !Pillar | Base - -class ToEmptyCornice (p :: Pillar) where - toEmptyCornice :: Cornice p a c - -instance ToEmptyCornice Base where - toEmptyCornice = CorniceBase mempty - -instance ToEmptyCornice (Cap p) where - toEmptyCornice = CorniceCap Vector.empty - -data Fascia (p :: Pillar) r where - FasciaBase :: !r -> Fascia Base r - FasciaCap :: !r -> Fascia p r -> Fascia (Cap p) r - -data OneCornice k (p :: Pillar) a c = OneCornice - { oneCorniceHead :: !c - , oneCorniceBody :: !(k p a c) - } - -data Cornice (p :: Pillar) a c where - CorniceBase :: !(Colonnade Headed a c) -> Cornice Base a c - CorniceCap :: {-# UNPACK #-} !(Vector (OneCornice Cornice p a c)) -> Cornice (Cap p) a c - -instance Semigroup (Cornice p a c) where - CorniceBase a <> CorniceBase b = CorniceBase (mappend a b) - CorniceCap a <> CorniceCap b = CorniceCap (a Vector.++ b) - sconcat xs@(x :| _) = case x of - CorniceBase _ -> CorniceBase (Colonnade (vectorConcatNE (fmap (getColonnade . getCorniceBase) xs))) - CorniceCap _ -> CorniceCap (vectorConcatNE (fmap getCorniceCap xs)) - -instance ToEmptyCornice p => Monoid (Cornice p a c) where - mempty = toEmptyCornice - mappend = (Semigroup.<>) - mconcat xs1 = case xs1 of - [] -> toEmptyCornice - x : xs2 -> Semigroup.sconcat (x :| xs2) - -getCorniceBase :: Cornice Base a c -> Colonnade Headed a c -getCorniceBase (CorniceBase c) = c - -getCorniceCap :: Cornice (Cap p) a c -> Vector (OneCornice Cornice p a c) -getCorniceCap (CorniceCap c) = c - -data AnnotatedCornice (p :: Pillar) a c where - AnnotatedCorniceBase :: !(Maybe Int) -> !(Colonnade (Sized Headed) a c) -> AnnotatedCornice Base a c - AnnotatedCorniceCap :: - !(Maybe Int) - -> {-# UNPACK #-} !(Vector (OneCornice AnnotatedCornice p a c)) - -> AnnotatedCornice (Cap p) a c - -data MutableSizedCornice s (p :: Pillar) a c where - MutableSizedCorniceBase :: - {-# UNPACK #-} !(MutableSizedColonnade s Headed a c) - -> MutableSizedCornice s Base a c - MutableSizedCorniceCap :: - {-# UNPACK #-} !(Vector (OneCornice (MutableSizedCornice s) p a c)) - -> MutableSizedCornice s (Cap p) a c - --- data MaybeInt = JustInt {-# UNPACK #-} !Int | NothingInt - --- | This is provided with vector-0.12, but we include a copy here --- for compatibility. -vectorConcatNE :: NonEmpty (Vector a) -> Vector a -vectorConcatNE = Vector.concat . toList - diff --git a/colonnade/src/Colonnade/Types.hs b/colonnade/src/Colonnade/Types.hs deleted file mode 100644 index 984018e..0000000 --- a/colonnade/src/Colonnade/Types.hs +++ /dev/null @@ -1,152 +0,0 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE GADTs #-} -module Colonnade.Types - ( Colonnade(..) - , Decolonnade(..) - , OneColonnade(..) - , Headed(..) - , Headless(..) - , Indexed(..) - , HeadingErrors(..) - , DecolonnadeCellError(..) - , DecolonnadeRowError(..) - , DecolonnadeCellErrors(..) - , RowError(..) - ) where - -import Data.Vector (Vector) -import Data.Functor.Contravariant (Contravariant(..)) -import Data.Functor.Contravariant.Divisible (Divisible(..)) -import Control.Exception (Exception) -import Data.Typeable (Typeable) -import qualified Data.Vector as Vector - --- | This type is isomorphic to 'Identity'. -newtype Headed a = Headed { getHeaded :: a } - deriving (Eq,Ord,Functor,Show,Read,Foldable) - --- | This type is isomorphic to 'Proxy' -data Headless a = Headless - deriving (Eq,Ord,Functor,Show,Read,Foldable) - -data Indexed f a = Indexed - { indexedIndex :: !Int - , indexedHeading :: !(f a) - } deriving (Eq,Ord,Functor,Show,Read) - -data HeadingErrors content = HeadingErrors - { headingErrorsMissing :: Vector content -- ^ headers that were missing - , headingErrorsDuplicate :: Vector (content,Int) -- ^ headers that occurred more than once - } deriving (Show,Read,Eq) - -instance (Show content, Typeable content) => Exception (HeadingErrors content) - -instance Monoid (HeadingErrors content) where - mempty = HeadingErrors Vector.empty Vector.empty - mappend (HeadingErrors a1 b1) (HeadingErrors a2 b2) = HeadingErrors - (a1 Vector.++ a2) (b1 Vector.++ b2) - -data DecolonnadeCellError f content = DecolonnadeCellError - { decodingCellErrorContent :: !content - , decodingCellErrorHeader :: !(Indexed f content) - , decodingCellErrorMessage :: !String - } deriving (Show,Read,Eq) - --- instance (Show (f content), Typeable content) => Exception (DecolonnadeError f content) - -newtype DecolonnadeCellErrors f content = DecolonnadeCellErrors - { getDecolonnadeCellErrors :: Vector (DecolonnadeCellError f content) - } deriving (Monoid,Show,Read,Eq) - --- newtype ParseRowError = ParseRowError String - --- TODO: rewrite the instances for this by hand. They --- currently use FlexibleContexts. -data DecolonnadeRowError f content = DecolonnadeRowError - { decodingRowErrorRow :: !Int - , decodingRowErrorError :: !(RowError f content) - } deriving (Show,Read,Eq) - --- TODO: rewrite the instances for this by hand. They --- currently use FlexibleContexts. -data RowError f content - = RowErrorParse !String -- ^ Error occurred parsing the document into cells - | RowErrorDecode !(DecolonnadeCellErrors f content) -- ^ Error decoding the content - | RowErrorSize !Int !Int -- ^ Wrong number of cells in the row - | RowErrorHeading !(HeadingErrors content) - | RowErrorMinSize !Int !Int - | RowErrorMalformed !String -- ^ Error decoding unicode content - deriving (Show,Read,Eq) - --- instance (Show (f content), Typeable content) => Exception (DecolonnadeErrors f content) - -instance Contravariant Headless where - contramap _ Headless = Headless - --- | This just actually a specialization of the free applicative. --- Check out @Control.Applicative.Free@ in the @free@ library to --- learn more about this. The meanings of the fields are documented --- slightly more in the source code. Unfortunately, haddock does not --- play nicely with GADTs. -data Decolonnade f content a where - DecolonnadePure :: !a -- function - -> Decolonnade f content a - DecolonnadeAp :: !(f content) -- header - -> !(content -> Either String a) -- decoding function - -> !(Decolonnade f content (a -> b)) -- next decoding - -> Decolonnade f content b - -instance Functor (Decolonnade f content) where - fmap f (DecolonnadePure a) = DecolonnadePure (f a) - fmap f (DecolonnadeAp h c apNext) = DecolonnadeAp h c ((f .) <$> apNext) - -instance Applicative (Decolonnade f content) where - pure = DecolonnadePure - DecolonnadePure f <*> y = fmap f y - DecolonnadeAp h c y <*> z = DecolonnadeAp h c (flip <$> y <*> z) - --- | Encodes a header and a cell. -data OneColonnade f content a = OneColonnade - { oneColonnadeHead :: !(f content) - , oneColonnadeEncode :: !(a -> content) - } - -instance Contravariant (OneColonnade f content) where - contramap f (OneColonnade h e) = OneColonnade h (e . f) - --- | An columnar encoding of @a@. The type variable @f@ 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 --- of use cases. The type variable @c@ is the content type. This can --- 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. --- --- Internally, a 'Colonnade' is represented as a 'Vector' of individual --- column encodings. It is possible to use any collection type with --- 'Alternative' and 'Foldable' instances. However, 'Vector' was chosen to --- optimize the data structure for the use case of building the structure --- once and then folding over it many times. It is recommended that --- 'Colonnade's are defined at the top-level so that GHC avoid reconstructing --- them every time they are used. -newtype Colonnade f c a = Colonnade - { getColonnade :: Vector (OneColonnade f c a) - } deriving (Monoid) - -instance Contravariant (Colonnade f content) where - contramap f (Colonnade v) = Colonnade - (Vector.map (contramap f) v) - -instance Divisible (Colonnade f 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) -