fix a bunch of stuff

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

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)
 -- <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 Data.Profunctor (Profunctor(lmap))
--- >>> import Colonnade (Colonnade,Headed,Headless,headed)
+-- >>> 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>
+--         <tr>
---         <th>Age</th>
+--             <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>
+--         <tr><td class="sales">Sales</td></tr>
---             <td class="sales">Sales</td>
+--         <tr><td class="management">Management</td></tr>
---         </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
+-- >>> :t lmap
--- contramap :: Contravariant f => (a -> b) -> f b -> f a
+-- lmap :: Profunctor p => (a -> b) -> p b c -> p a c
--- >>> let tableEmpB = contramap department tableDept
+-- >>> let tableEmpB = lmap department tableDept
 -- >>> :t tableEmpB
--- tableEmpB :: Colonnade Headed Cell Employee
+-- tableEmpB :: Colonnade Headed Employee Cell
--- >>> printCompactHtml (encodeHeadedCellTable customAttrs tableEmpB employees)
+-- >>> printVeryCompactHtml (encodeHeadedCellTable customAttrs tableEmpB employees)
 -- <table class="stylish-table" id="main-table">
 --     <thead>
---         <th>Dept.</th>
+--         <tr><th>Dept.</th></tr>
 --     </thead>
 --     <tbody>
---         <tr>
+--         <tr><td class="sales">Sales</td></tr>
---             <td class="sales">Sales</td>
+--         <tr><td class="engineering">Engineering</td></tr>
---         </tr>
+--         <tr><td class="management">Management</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>
+--         <tr>
---         <th>Age</th>
+--             <th>Name</th>
---         <th>Dept.</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
+encodeCappedTable theadAttrs tbodyAttrs trAttrs wrapContent tableAttrs fascia cornice xs = do
-  let colonnade = CE.discard cornice
+  let colonnade = Encode.discard cornice
-      annCornice = annotate cornice
+      annCornice = Encode.annotate cornice
   H.table ! tableAttrs $ do
-    H.thead ! theadAttrs $ H.tr ! trAttrs $ do
+    H.thead ! theadAttrs $ do
-      Encode.headerMonoidalGeneral colonnade (wrapContent H.th)
+      Encode.headersMonoidal 
-  encodeBody trAttrs wrapContent tbodyAttrs colonnade xs
+        (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
+-- | Encode a table with a header. Table cell element do not have 
---   applied to them.
+--   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
+-- | Encode a table without a header. Table cells do not have
---   applied to them.
+--   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
 
 

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:
   .
+  * <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

colonnade/examples/ex1.hs

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

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
+  , Headed(..)
-  , Headless
+  , 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) = 
+mapHeaderContent f (E.Colonnade v) = 
-  Colonnade (Vector.map (\(OneColonnade h e) -> OneColonnade (fmap f h) e) 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 $
+fromMaybe c (E.Colonnade v) = E.Colonnade $ flip Vector.map v $
-  \(OneColonnade h encode) -> OneColonnade h (maybe c encode)
+  \(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
+  . E.Colonnade
-  . Vector.map (\b -> OneColonnade (getHeader b) (getCell b))
+  . 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
+      sizedCol = E.uncapAnnotated annCor
-   in CE.headersMonoidal
+   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 
+        , E.headerMonoidalFull sizedCol 
-             (\(Sized sz _) -> hyphens (sz + 2) ++ "+")
+             (\(E.Sized sz _) -> hyphens (sz + 2) ++ "+")
         , "\n"
         ]
    in List.concat
       [ divider
       , concat
          [ "|"
-         , Encode.headerMonoidalFull sizedCol
+         , E.headerMonoidalFull sizedCol
-             (\(Sized s (Headed h)) -> " " ++ rightPad s ' ' h ++ " |")
+             (\(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 
+        , E.headerMonoidalFull sizedCol 
-             (\(Sized sz _) -> hyphens (sz + 2) ++ "+")
+             (\(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"
            ]

colonnade/src/Colonnade/Cornice/Encode.hs

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

colonnade/src/Colonnade/Decoding.hs

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

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
 

colonnade/src/Colonnade/Internal.hs

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

colonnade/src/Colonnade/Types.hs

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