colonnade 1.0.0 → 1.1.0

raw patch · 4 files changed

+694/−217 lines, 4 filesdep +profunctorsPVP ok

version bump matches the API change (PVP)

Dependencies added: profunctors

API changes (from Hackage documentation)

Files

• colonnade.cabal +4/−2
• src/Colonnade.hs +207/−93
• src/Colonnade/Encode.hs +483/−24
• src/Colonnade/Internal.hs +0/−98

@@ -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 @@   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,13 +32,13 @@   exposed-modules:     Colonnade     Colonnade.Encode-    Colonnade.Internal   build-depends:       base >= 4.7 && < 5     , contravariant >= 1.2 && < 1.5     , vector >= 0.10 && < 0.13     , text >= 1.0 && < 1.3     , bytestring >= 0.10 && < 0.11+    , profunctors >= 4.0 && < 5.3   default-language:    Haskell2010   ghc-options: -Wall 

@@ -1,3 +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@@ -5,32 +9,39 @@     -- $setup     -- * Types     Colonnade-  , Headed-  , Headless+  , Headed(..)+  , Headless(..)     -- * Create   , headed   , headless   , singleton     -- * Transform+  , mapHeaderContent   , fromMaybe   , columns   , bool   , replaceWhen   , modifyWhen-  , mapContent+    -- * Cornice+    -- ** Types+  , Cornice+  , Pillar(..)+  , Fascia(..)+    -- ** Create+  , cap+  , recap     -- * Ascii Table   , ascii+  , asciiCapped   ) where -import Colonnade.Internal-import qualified Colonnade.Encode as Encode-import Data.Vector (Vector)+import Colonnade.Encode (Colonnade,Cornice,+  Pillar(..),Fascia(..),Headed(..),Headless(..)) import Data.Foldable-import Data.Monoid (Endo(..)) import Control.Monad-import Data.Functor.Contravariant 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 @@ -40,7 +51,7 @@ -- used for the remainder of the examples in the docs: -- -- >>> import Data.Monoid (mconcat,(<>))--- >>> import Data.Functor.Contravariant (contramap)+-- >>> import Data.Profunctor (lmap) -- -- The data types we wish to encode are: --@@ -51,7 +62,7 @@ -- One potential columnar encoding of a @Person@ would be: -- -- >>> :{--- let colPerson :: Colonnade Headed String Person+-- let colPerson :: Colonnade Headed Person String --     colPerson = mconcat --       [ headed "Name" name --       , headed "Age" (show . age)@@ -75,16 +86,11 @@ -- Similarly, we can build a table of houses with: -- -- >>> let showDollar = (('$':) . show) :: Int -> String--- >>> :{--- let encodingHouse :: Colonnade Headed String House---     encodingHouse = mconcat---       [ headed "Color" (show . color)---       , headed "Price" (showDollar . price)---       ]--- :}---+-- >>> colHouse = mconcat [headed "Color" (show . color), headed "Price" (showDollar . price)]+-- >>> :t colHouse+-- colHouse :: Colonnade Headed House [Char] -- >>> let houses = [House Green 170000, House Blue 115000, House Green 150000]--- >>> putStr (ascii encodingHouse houses)+-- >>> putStr (ascii colHouse houses) -- +-------+---------+ -- | Color | Price   | -- +-------+---------+@@ -95,17 +101,23 @@   -- | A single column with a header.-headed :: c -> (a -> c) -> Colonnade Headed c a+headed :: c -> (a -> c) -> Colonnade Headed a c headed h = singleton (Headed h)  -- | A single column without a header.-headless :: (a -> c) -> Colonnade Headless c a+headless :: (a -> c) -> Colonnade Headless a c headless = singleton Headless  -- | A single column with any kind of header. This is not typically needed.-singleton :: f c -> (a -> c) -> Colonnade f c a-singleton h = Colonnade . Vector.singleton . OneColonnade h+singleton :: h c -> (a -> c) -> Colonnade h a c+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 (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 --   could be represented as:@@ -123,10 +135,10 @@ -- the help of 'fromMaybe': -- -- >>> :{--- let colOwners :: Colonnade Headed String (Person,Maybe House)+-- let colOwners :: Colonnade Headed (Person,Maybe House) String --     colOwners = mconcat---       [ contramap fst colPerson---       , contramap snd (fromMaybe "" encodingHouse)+--       [ lmap fst colPerson+--       , lmap snd (fromMaybe "" colHouse) --       ] -- :} --@@ -138,9 +150,9 @@ -- | Ruth   | 25  | Red   | $125000 | -- | Sonia  | 12  | Green | $145000 | -- +--------+-----+-------+---------+-fromMaybe :: c -> Colonnade f c a -> Colonnade f c (Maybe a)-fromMaybe c (Colonnade v) = Colonnade $ flip Vector.map v $-  \(OneColonnade h encode) -> OneColonnade h (maybe c encode)+fromMaybe :: c -> Colonnade f a c -> Colonnade f (Maybe a) c+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@@ -150,10 +162,10 @@ -- >>> let allColors = [Red,Green,Blue] -- >>> let encColor = columns (\c1 c2 -> if c1 == c2 then "✓" else "") (Headed . show) allColors -- >>> :t encColor--- encColor :: Colonnade Headed [Char] Color--- >>> let encHouse = headed "Price" (showDollar . price) <> contramap color encColor+-- encColor :: Colonnade Headed Color [Char]+-- >>> let encHouse = headed "Price" (showDollar . price) <> lmap color encColor -- >>> :t encHouse--- encHouse :: Colonnade Headed [Char] House+-- encHouse :: Colonnade Headed House [Char] -- >>> putStr (ascii encHouse houses) -- +---------+-----+-------+------+ -- | Price   | Red | Green | Blue |@@ -166,10 +178,10 @@   => (b -> a -> c) -- ^ Cell content function   -> (b -> f c) -- ^ Header content function   -> g b -- ^ Basis for column encodings-  -> Colonnade f c a+  -> 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 @@ -178,7 +190,7 @@   -> (a -> Bool) -- ^ Predicate   -> (a -> c) -- ^ Contents when predicate is false   -> (a -> c) -- ^ Contents when predicate is true-  -> Colonnade f c a+  -> Colonnade f a c bool h p onTrue onFalse = singleton h (Data.Bool.bool <$> onFalse <*> onTrue <*> p)  -- | Modify the contents of cells in rows whose values satisfy the@@ -188,11 +200,11 @@ modifyWhen ::      (c -> c) -- ^ Content change   -> (a -> Bool) -- ^ Row predicate-  -> Colonnade f c a -- ^ Original 'Colonnade'-  -> Colonnade f c a-modifyWhen changeContent p (Colonnade v) = Colonnade+  -> Colonnade f a c -- ^ Original 'Colonnade'+  -> Colonnade f a c+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   )@@ -202,77 +214,179 @@ replaceWhen ::      c -- ^ New content   -> (a -> Bool) -- ^ Row predicate-  -> Colonnade f c a -- ^ Original 'Colonnade'-  -> Colonnade f c a-replaceWhen newContent p (Colonnade v) = Colonnade+  -> Colonnade f a c -- ^ Original 'Colonnade'+  -> Colonnade f a c+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   ) --- | 'Colonnade' is covariant in its content type. Consequently, it can be---   mapped over. There is no standard typeclass for types that are covariant---   in their second-to-last argument, so this function is provided for---   situations that require this.-mapContent :: Functor f => (c1 -> c2) -> Colonnade f c1 a -> Colonnade f c2 a-mapContent f (Colonnade v) = Colonnade-  $ Vector.map (\(OneColonnade h c) -> (OneColonnade (fmap f h) (f . c))) v+-- | Augment a 'Colonnade' with a header spans over all of the+--   existing headers. This is best demonstrated by example. +--   Let\'s consider how we might encode a pairing of the people +--   and houses from the initial example:+--   +--   >>> let personHomePairs = zip people houses+--   >>> let colPersonFst = lmap fst colPerson+--   >>> let colHouseSnd = lmap snd colHouse+--   >>> putStr (ascii (colPersonFst <> colHouseSnd) personHomePairs)+--   +-------+-----+-------+---------++--   | Name  | Age | Color | Price   |+--   +-------+-----+-------+---------++--   | David | 63  | Green | $170000 |+--   | Ava   | 34  | Blue  | $115000 |+--   | Sonia | 12  | Green | $150000 |+--   +-------+-----+-------+---------++--   +--   This tabular encoding leaves something to be desired. The heading+--   not indicate that the name and age refer to a person and that+--   the color and price refer to a house. Without reaching for 'Cornice',+--   we can still improve this situation with 'mapHeaderContent':+--+--   >>> let colPersonFst' = mapHeaderContent ("Person " ++) colPersonFst+--   >>> let colHouseSnd' = mapHeaderContent ("House " ++) colHouseSnd+--   >>> putStr (ascii (colPersonFst' <> colHouseSnd') personHomePairs)+--   +-------------+------------+-------------+-------------++--   | Person Name | Person Age | House Color | House Price |+--   +-------------+------------+-------------+-------------++--   | David       | 63         | Green       | $170000     |+--   | Ava         | 34         | Blue        | $115000     |+--   | Sonia       | 12         | Green       | $150000     |+--   +-------------+------------+-------------+-------------++--+--   This is much better, but for longer tables, the redundancy+--   of prefixing many column headers can become annoying. The solution+--   that a 'Cornice' offers is to nest headers:+--   +--   >>> let cor = mconcat [cap "Person" colPersonFst, cap "House" colHouseSnd]+--   >>> :t cor+--   cor :: Cornice ('Cap 'Base) (Person, House) [Char]+--   >>> putStr (asciiCapped cor personHomePairs)+--   +-------------+-----------------++--   | Person      | House           |+--   +-------+-----+-------+---------++--   | Name  | Age | Color | Price   |+--   +-------+-----+-------+---------++--   | David | 63  | Green | $170000 |+--   | Ava   | 34  | Blue  | $115000 |+--   | Sonia | 12  | Green | $150000 |+--   +-------+-----+-------+---------++--   +cap :: c -> Colonnade Headed a c -> Cornice (Cap Base) a c+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:+--   +--   >>> data Day = Weekday | Weekend deriving (Show)+--   >>> :{+--   let cost :: Int -> Day -> String+--       cost base w = case w of+--         Weekday -> showDollar base+--         Weekend -> showDollar (base + 1)+--       colStandard = foldMap (\c -> headed c (cost 8)) ["Yt","Ad","Sr"]+--       colSpecial = mconcat [headed "Stud" (cost 6), headed "Mltry" (cost 7)]+--       corStatus = mconcat+--         [ cap "Standard" colStandard+--         , cap "Special" colSpecial+--         ] +--       corShowtime = mconcat+--         [ recap "" (cap "" (headed "Day" show))+--         , foldMap (\c -> recap c corStatus) ["Matinee","Evening"]+--         ]+--   :}+--+--   >>> putStr (asciiCapped corShowtime [Weekday,Weekend])+--   +---------+-----------------------------+-----------------------------++--   |         | Matinee                     | Evening                     |+--   +---------+--------------+--------------+--------------+--------------++--   |         | Standard     | Special      | Standard     | Special      |+--   +---------+----+----+----+------+-------+----+----+----+------+-------++--   | Day     | Yt | Ad | Sr | Stud | Mltry | Yt | Ad | Sr | Stud | Mltry |+--   +---------+----+----+----+------+-------+----+----+----+------+-------++--   | Weekday | $8 | $8 | $8 | $6   | $7    | $8 | $8 | $8 | $6   | $7    |+--   | 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 = 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 = E.annotateFinely (\x y -> x + y + 3) id +        List.length xs cor+      sizedCol = E.uncapAnnotated annCor+   in E.headersMonoidal+        Nothing +        [ (\sz _ -> hyphens (sz + 2) ++ "+", \s -> "+" ++ s ++ "\n")+        , (\sz c -> " " ++ rightPad sz ' ' c ++ " |", \s -> "|" ++ s ++ "\n")+        ] annCor ++ asciiBody sizedCol xs+      + -- | Render a collection of rows as an ascii table. The table\'s columns are -- specified by the given 'Colonnade'. This implementation is inefficient and -- does not provide any wrapping behavior. It is provided so that users can--- try out @colonnade@ in ghci and so that @doctest@ can verify examples+-- try out @colonnade@ in ghci and so that @doctest@ can verify example -- code in the haddocks. ascii :: Foldable f-  => Colonnade Headed String a -- ^ columnar encoding+  => Colonnade Headed a String -- ^ columnar encoding   -> f a -- ^ rows   -> String-ascii enc xs =-  let theHeader :: [(Int,String)]-      theHeader = (zip (enumFrom 0) . map (\s -> " " ++ s ++ " ")) (toList (Encode.header id enc))-      theBody :: [[(Int,String)]]-      theBody = map (zip (enumFrom 0) . map (\s -> " " ++ s ++ " ") . toList . Encode.row id enc) (toList xs)-      sizes :: [Int]-      sizes = ($ replicate (length theHeader) 1) $ appEndo $ mconcat-        [ foldMap (\(i,str) -> Endo (replaceAt i (length str))) theHeader-        , (foldMap . foldMap) (\(i,str) -> Endo (replaceAt i (length str))) theBody+ascii col xs = +  let sizedCol = E.sizeColumns List.length xs col+      divider = concat+        [ "+" +        , E.headerMonoidalFull sizedCol +             (\(E.Sized sz _) -> hyphens (sz + 2) ++ "+")+        , "\n"         ]-      paddedHeader :: [String]-      paddedHeader = map (\(i,str) -> rightPad (atDef 1 sizes i) ' ' str) theHeader-      paddedBody :: [[String]]-      paddedBody = (map . map) (\(i,str) -> rightPad (atDef 1 sizes i) ' ' str) theBody-      divider :: String-      divider = "+" ++ join (List.intersperse "+" (map (\i -> replicate i '-') sizes)) ++ "+"-      headerStr :: String-      headerStr = "|" ++ join (List.intersperse "|" paddedHeader) ++ "|"-      bodyStr :: String-      bodyStr = List.unlines (map ((\s -> "|" ++ s ++ "|") . join . List.intersperse "|") paddedBody)-   in divider ++ "\n" ++ headerStr-              ++ "\n" ++ divider-              ++ "\n" ++ bodyStr ++ divider ++ "\n"-+   in List.concat+      [ divider+      , concat+         [ "|"+         , E.headerMonoidalFull sizedCol+             (\(E.Sized s (Headed h)) -> " " ++ rightPad s ' ' h ++ " |")+         , "\n"+         ]+      , asciiBody sizedCol xs+      ] --- this has no effect if the index is out of bounds-replaceAt :: Ord a => Int -> a -> [a] -> [a]-replaceAt _ _ [] = []-replaceAt n v (a:as) = if n > 0-  then a : replaceAt (n - 1) v as-  else (max v a) : as+asciiBody :: Foldable f+  => Colonnade (E.Sized Headed) a String+  -> f a+  -> String+asciiBody sizedCol xs =+  let divider = concat+        [ "+" +        , E.headerMonoidalFull sizedCol +             (\(E.Sized sz _) -> hyphens (sz + 2) ++ "+")+        , "\n"+        ]+      rowContents = foldMap+        (\x -> concat+           [ "|"+           , E.rowMonoidalHeader +               sizedCol+               (\(E.Sized sz _) c -> " " ++ rightPad sz ' ' c ++ " |")+               x+           , "\n"+           ]+        ) xs+   in List.concat+      [ divider+      , rowContents+      , divider+      ]+      +hyphens :: Int -> String+hyphens n = List.replicate n '-'  rightPad :: Int -> a -> [a] -> [a] rightPad m a xs = take m $ xs ++ repeat a--atDef :: a -> [a] -> Int -> a-atDef def = Data.Maybe.fromMaybe def .^ atMay where-  (.^) f g x1 x2 = f (g x1 x2)-  atMay = eitherToMaybe .^ at_-  eitherToMaybe = either (const Nothing) Just-  at_ xs o | o < 0 = Left $ "index must not be negative, index=" ++ show o-           | otherwise = f o xs-      where f 0 (z:_) = Right z-            f i (_:zs) = f (i-1) zs-            f i [] = Left $ "index too large, index=" ++ show o ++ ", length=" ++ show (o-i)  -- data Company = Company String String Int -- 

@@ -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,35 +37,77 @@ --   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_   , headerMonadicGeneral   , headerMonadicGeneral_   , headerMonoidalGeneral+  , headerMonoidalFull+    -- ** Other   , bothMonadic_+  , 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 -- instead. It may allow more things to get inlined -- in to a loop.-row :: (c1 -> c2) -> Colonnade f c1 a -> a -> Vector c2+row :: (c1 -> c2) -> Colonnade f a c1 -> a -> Vector c2 row g (Colonnade v) a = flip Vector.map v $   \(OneColonnade _ encode) -> g (encode a)  bothMonadic_ :: Monad m-  => Colonnade Headed content a-  -> (content -> content -> m b)+  => Colonnade Headed a c+  -> (c -> c -> m b)   -> a   -> m () bothMonadic_ (Colonnade v) g a =@@ -61,8 +115,8 @@  rowMonadic ::    (Monad m, Monoid b)-  => Colonnade f content a-  -> (content -> m b)+  => Colonnade f a c+  -> (c -> m b)   -> a   -> m b rowMonadic (Colonnade v) g a =@@ -71,8 +125,8 @@  rowMonadic_ ::       Monad m-  => Colonnade f content a-  -> (content -> m b)+  => Colonnade f a c+  -> (c -> m b)   -> a   -> m () rowMonadic_ (Colonnade v) g a =@@ -80,19 +134,75 @@  rowMonoidal ::      Monoid m-  => Colonnade h c a+  => Colonnade h a c   -> (c -> m)   -> a   -> m rowMonoidal (Colonnade v) g a =-  foldMap (\e -> g (oneColonnadeEncode e a)) v+  foldMap (\(OneColonnade _ encode) -> g (encode a)) v +rowMonoidalHeader ::+     Monoid m+  => Colonnade h a c+  -> (h c -> c -> m)+  -> a+  -> m+rowMonoidalHeader (Colonnade v) g a =+  foldMap (\(OneColonnade h encode) -> g h (encode a)) v++rowUpdateSize ::+     (c -> Int) -- ^ Get size from content+  -> MutableSizedColonnade s h a c+  -> a+  -> ST s ()+rowUpdateSize toSize (MutableSizedColonnade v mv) a = if MVU.length mv /= V.length v+  then error "rowMonoidalSize: vector sizes mismatched"+  else V.imapM_ (\ix (OneColonnade _ encode) ->+      MVU.modify mv (\oldSize -> max oldSize (toSize (encode a))) ix+    ) v++headerUpdateSize :: Foldable h+  => (c -> Int) -- ^ Get size from content+  -> MutableSizedColonnade s h a c+  -> ST s ()+headerUpdateSize toSize (MutableSizedColonnade v mv) = if MVU.length mv /= V.length v+  then error "rowMonoidalSize: vector sizes mismatched"+  else V.imapM_ (\ix (OneColonnade h _) -> +      MVU.modify mv (\oldSize -> max oldSize (foldl' (\sz c -> max sz (toSize c)) 0 h)) ix+    ) v++sizeColumns :: (Foldable f, Foldable h)+  => (c -> Int) -- ^ Get size from content+  -> f a+  -> Colonnade h a c+  -> Colonnade (Sized h) a c+sizeColumns toSize rows colonnade = runST $ do+  mcol <- newMutableSizedColonnade colonnade+  headerUpdateSize toSize mcol +  mapM_ (rowUpdateSize toSize mcol) rows+  freezeMutableSizedColonnade mcol++newMutableSizedColonnade :: Colonnade h a c -> ST s (MutableSizedColonnade s h a c)+newMutableSizedColonnade (Colonnade v) = do+  mv <- MVU.replicate (V.length v) 0+  return (MutableSizedColonnade v mv)++freezeMutableSizedColonnade :: MutableSizedColonnade s h a c -> ST s (Colonnade (Sized h) a c)+freezeMutableSizedColonnade (MutableSizedColonnade v mv) =+  if MVU.length mv /= V.length v+    then error "rowMonoidalSize: vector sizes mismatched"+    else do+      sizeVec <- VU.freeze mv+      return $ Colonnade+        $ V.map (\(OneColonnade h enc,sz) -> OneColonnade (Sized sz h) enc)+        $ V.zip v (GV.convert sizeVec)+ rowMonadicWith ::    (Monad m)   => b   -> (b -> b -> b)-  -> Colonnade f content a-  -> (content -> m b)+  -> Colonnade f a c+  -> (c -> m b)   -> a   -> m b rowMonadicWith bempty bappend (Colonnade v) g a =@@ -101,15 +211,15 @@     return (bappend bl br)   ) bempty v -header :: (c1 -> c2) -> Colonnade Headed c1 a -> Vector c2+header :: (c1 -> c2) -> Colonnade Headed a c1 -> Vector c2 header g (Colonnade v) =   Vector.map (g . getHeaded . oneColonnadeHead) v  -- | This function is a helper for abusing 'Foldable' to optionally --   render a header. Its future is uncertain. headerMonadicGeneral :: (Monad m, Monoid b, Foldable h)-  => Colonnade h content a-  -> (content -> m b)+  => Colonnade h a c+  -> (c -> m b)   -> m b headerMonadicGeneral (Colonnade v) g = id   $ fmap (mconcat . Vector.toList)@@ -117,36 +227,385 @@  headerMonadic ::       (Monad m, Monoid b)-  => Colonnade Headed content a-  -> (content -> m b)+  => Colonnade Headed a c+  -> (c -> m b)   -> m b headerMonadic (Colonnade v) g =   fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneColonnadeHead) v  headerMonadicGeneral_ ::       (Monad m, Foldable h)-  => Colonnade h content a-  -> (content -> m b)+  => Colonnade h a c+  -> (c -> m b)   -> m () headerMonadicGeneral_ (Colonnade v) g =   Vector.mapM_ (mapM_ g . oneColonnadeHead) v  headerMonoidalGeneral ::      (Monoid m, Foldable h)-  => Colonnade h c a+  => Colonnade h a c   -> (c -> m)   -> m headerMonoidalGeneral (Colonnade v) g =   foldMap (foldMap g . oneColonnadeHead) v-   +headerMonoidalFull ::+     Monoid m+  => Colonnade h a c+  -> (h c -> m)+  -> m+headerMonoidalFull (Colonnade v) g = foldMap (g . oneColonnadeHead) v+ headerMonadic_ ::      (Monad m)-  => Colonnade Headed content a-  -> (content -> m b)+  => Colonnade Headed a c+  -> (c -> m b)   -> m () headerMonadic_ (Colonnade v) g = Vector.mapM_ (g . getHeaded . oneColonnadeHead) v  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 

@@ -1,98 +0,0 @@-{-# LANGUAGE DeriveFunctor              #-}-{-# LANGUAGE DeriveFoldable             #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--{-# OPTIONS_HADDOCK not-home #-}--module Colonnade.Internal-  ( Colonnade(..)-  , OneColonnade(..)-  , Headed(..)-  , Headless(..)-  ) 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---- | 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 Text Foo------   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 Text Foo------   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)--instance Contravariant Headless where-  contramap _ Headless = Headless---- | Encodes a header and a cell.-data OneColonnade h content a = OneColonnade-  { oneColonnadeHead   :: !(h content)-  , oneColonnadeEncode :: !(a -> content)-  }--instance Contravariant (OneColonnade h content) where-  contramap 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:------ >             +---- Content (Text, ByteString, Html, etc.)--- >             |--- >             v--- > Colonnade h c a--- >           ^   ^--- >           |   |--- >           |   +-- Value consumed to build a row--- >           |--- >           +------ 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 c a = Colonnade-  { getColonnade :: Vector (OneColonnade h c a)-  } deriving (Monoid)--instance Contravariant (Colonnade h content) where-  contramap f (Colonnade v) = Colonnade-    (Vector.map (contramap f) v)--instance Divisible (Colonnade h 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)-