haskell/colonnade-old
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix a bunch of stuff

Browse Source
This commit is contained in:
Andrew Martin 2017-02-22 21:13:54 -05:00
parent 47a89ea3d3
commit dccacf0d75
11 changed files with 524 additions and 899 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
blaze-colonnade/blaze-colonnade.cabal
View File

@ -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

149
blaze-colonnade/src/Text/Blaze/Colonnade.hs
View File

@ -11,7 +11,9 @@
-- >>> let rows = [("90-100",'A'),("80-89",'B'),("70-79",'C')]
-- >>> printVeryCompactHtml (encodeHeadedHtmlTable mempty col rows)
-- <table>
-- <thead><th>Grade</th><th>Letter</th></thead>
-- <thead>
-- <tr><th>Grade</th><th>Letter</th></tr>
-- </thead>
-- <tbody>
-- <tr><td>90-100</td><td>A</td></tr>
-- <tr><td>80-89</td><td>B</td></tr>
@ -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 @\<strong\>@ 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)
-- <table class="stylish-table" id="main-table">
-- <thead>
-- <th>Name</th>
-- <th>Age</th>
-- <tr>
-- <th>Name</th>
-- <th>Age</th>
-- </tr>
-- </thead>
-- <tbody>
-- <tr>
@ -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)
-- <table class="stylish-table" id="main-table">
-- <thead>
-- <th>Dept.</th>
-- <tr><th>Dept.</th></tr>
-- </thead>
-- <tbody>
-- <tr>
-- <td class="sales">Sales</td>
-- </tr>
-- <tr>
-- <td class="management">Management</td>
-- </tr>
-- <tr><td class="sales">Sales</td></tr>
-- <tr><td class="management">Management</td></tr>
-- </tbody>
-- </table>
--
-- The attributes on the @\<td\>@ 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)
-- <table class="stylish-table" id="main-table">
-- <thead>
-- <th>Dept.</th>
-- <tr><th>Dept.</th></tr>
-- </thead>
-- <tbody>
-- <tr>
-- <td class="sales">Sales</td>
-- </tr>
-- <tr>
-- <td class="engineering">Engineering</td>
-- </tr>
-- <tr>
-- <td class="management">Management</td>
-- </tr>
-- <tr><td class="sales">Sales</td></tr>
-- <tr><td class="engineering">Engineering</td></tr>
-- <tr><td class="management">Management</td></tr>
-- </tbody>
-- </table>
--
@ -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)
-- <table class="stylish-table" id="main-table">
-- <thead>
-- <th>Name</th>
-- <th>Age</th>
-- <th>Dept.</th>
-- <tr>
-- <th>Name</th>
-- <th>Age</th>
-- <th>Dept.</th>
-- </tr>
-- </thead>
-- <tbody>
-- <tr>
@ -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])
-- <table>
-- <thead>
-- <tr class="category">
-- <th colspan="2">Personal</th>
-- <th colspan="1">Work</th>
-- </tr>
-- <tr class="subcategory">
-- <th colspan="1">Name</th>
-- <th colspan="1">Age</th>
-- <th colspan="1">Dept.</th>
-- </tr>
-- </thead>
-- <tbody>
-- <tr>
-- <td>Thaddeus</td>
-- <td>34</td>
-- <td class="sales">Sales</td>
-- </tr>
-- </tbody>
-- </table>
encodeCappedCellTable :: Foldable f
=> Attribute -- ^ Attributes of @\<table\>@ element
-> Fascia p Attribute -- ^ Attributes for @\<tr\>@ elements in the @\<thead\>@
-> 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 @\<thead\>@
-> Attribute -- ^ Attributes of @\<tbody\>@ element
-> (a -> Attribute) -- ^ Attributes of each @\<tr\>@ element in the @\<tbody\>@
@ -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 @\<tr\>@ 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 @\<table\>@ 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 @\<table\>@ 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

6
colonnade/colonnade.cabal
View File

@ -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:
.
* <https://hackage.haskell.org/package/blaze-colonnade blaze-colonnade> for `blaze` html tables
.
* <https://hackage.haskell.org/package/reflex-dom-colonnade reflex-dom-colonnade> for reactive `reflex-dom` tables
.
* <https://hackage.haskell.org/package/yesod-colonnade yesod-colonnade> 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

63
colonnade/examples/ex1.hs
View File

@ -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 ""

68
colonnade/src/Colonnade.hs
View File

@ -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"
]

213
colonnade/src/Colonnade/Cornice/Encode.hs
View File

@ -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

174
colonnade/src/Colonnade/Decoding.hs
View File

@ -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)

397
colonnade/src/Colonnade/Encode.hs
View File

@ -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

0
colonnade/src/Colonnade/Encoding.hs
View File

197
colonnade/src/Colonnade/Internal.hs
View File

@ -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

152
colonnade/src/Colonnade/Types.hs
View File

@ -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)