made more changes. still broken

colonnade/src/Colonnade.hs

@@ -1,4 +1,4 @@
-
+{-# LANGUAGE DataKinds #-}
 
 -- | Build backend-agnostic columnar encodings that can be 
 --   used to visualize tabular data.
@@ -6,25 +6,26 @@ module Colonnade
   ( -- * Example
     -- $setup
     -- * Types
-    -- ** Colonnade
     Colonnade
   , Headed
   , Headless
-    -- ** Cornice
-  , Cornice
-  , Pillar(..)
-  , Fascia(..)
     -- * Create
   , headed
   , headless
   , singleton
     -- * Transform
+  , mapHeaderContent
   , fromMaybe
   , columns
   , bool
   , replaceWhen
   , modifyWhen
     -- * Cornice
+    -- ** Types
+  , Cornice
+  , Pillar(..)
+  , Fascia(..)
+    -- ** Create
   , cap
   , recap
     -- * Ascii Table
@@ -84,15 +85,15 @@ import qualified Data.Vector as Vector
 --
 -- >>> let showDollar = (('$':) . show) :: Int -> String
 -- >>> :{
--- let encodingHouse :: Colonnade Headed House String
---     encodingHouse = mconcat
+-- let colHouse :: Colonnade Headed House String
+--     colHouse = mconcat
 --       [ headed "Color" (show . color)
 --       , headed "Price" (showDollar . price)
 --       ]
 -- :}
 --
 -- >>> let houses = [House Green 170000, House Blue 115000, House Green 150000]
--- >>> putStr (ascii encodingHouse houses)
+-- >>> putStr (ascii colHouse houses)
 -- +-------+---------+
 -- | Color | Price   |
 -- +-------+---------+
@@ -111,9 +112,15 @@ 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 a c
+singleton :: h c -> (a -> c) -> Colonnade h a c
 singleton h = Colonnade . Vector.singleton . OneColonnade h
 
+-- | Map over the content in the header. This is similar performing 'fmap'
+--   on a 'Colonnade' except that the body content is unaffected.
+mapHeaderContent :: Functor h => (c -> c) -> Colonnade h a c -> Colonnade h a c
+mapHeaderContent f (Colonnade v) = 
+  Colonnade (Vector.map (\(OneColonnade h e) -> OneColonnade (fmap f h) e) v)
+
 -- | 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:
@@ -134,7 +141,7 @@ singleton h = Colonnade . Vector.singleton . OneColonnade h
 -- let colOwners :: Colonnade Headed (Person,Maybe House) String
 --     colOwners = mconcat
 --       [ lmap fst colPerson
---       , lmap snd (fromMaybe "" encodingHouse)
+--       , lmap snd (fromMaybe "" colHouse)
 --       ]
 -- :}
 --
@@ -219,21 +226,65 @@ replaceWhen newContent p (Colonnade v) = Colonnade
     ) v
   )
 
-toCornice :: Colonnade Headed a c -> Cornice Base a c
-toCornice = CorniceBase
+-- | 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)
+--   foo
+--   
+cap :: c -> Colonnade Headed a c -> Cornice (Cap Base) a c
+cap h = CorniceCap . Vector.singleton . OneCornice h . CorniceBase
 
-cap :: c -> Cornice p a c -> Cornice (Cap p) a c
-cap h cor = CorniceCap (V.singleton (OneCornice h cor))
+recap :: c -> Cornice p a c -> Cornice (Cap p) a c
+recap h cor = CorniceCap (Vector.singleton (OneCornice h cor))
 
-
-asciiMulti :: Foldable f
+asciiCapped :: Foldable f
   => Cornice p a String -- ^ columnar encoding
   -> f a -- ^ rows
   -> String
-asciiMulti cor xs =
+asciiCapped cor xs =
   let annCor = CE.annotateFinely (\x y -> x + y + 3) id 
         List.length xs cor
-   in CE.headersMonoidal (Right (\s -> s ++ "\n")) (\sz c -> rightPad sz ' ' c) annCor
+   in CE.headersMonoidal "|"
+        (Right (\s -> "|" ++ s ++ "\n")) 
+        (\sz c -> " " ++ rightPad sz ' ' c ++ " |") annCor
       
 
 -- | Render a collection of rows as an ascii table. The table\'s columns are

colonnade/src/Colonnade/Cornice/Encode.hs

@@ -38,7 +38,10 @@ endow f x = case x of
 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) = AnnotatedCorniceBase (mapHeadedness (Sized 1) 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 
@@ -98,11 +101,21 @@ freezeMutableSizedCornice :: forall s 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) = 
-    fmap AnnotatedCorniceBase (E.freezeMutableSizedColonnade msc)
+  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
+    let sz = 
+          ( mapJustInt finish 
+          . V.foldl' (combineJustInt step) Nothing 
+          . V.map (size . oneCorniceBody)
+          ) v2
     return $ AnnotatedCorniceCap sz v2
 
 newMutableSizedCornice :: forall s p a c.
@@ -120,25 +133,11 @@ 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)
 
--- annotate :: 
---      Int -- ^ initial
---   -> (Int -> Int -> Int) -- ^ fold function
---   -> (Int -> Int) -- ^ finalize
---   -> Cornice p a c 
---   -> AnnotatedCornice p a c
--- annotate i0 g finish = go where
---   go :: forall p a c. Cornice p a c -> AnnotatedCornice p a c
---   go (CorniceBase c) = AnnotatedCorniceBase c
---   go (CorniceCap children) =
---     let annChildren = fmap (mapOneCorniceBody go) children
---      in AnnotatedCorniceCap ((finish . V.foldl' g i0 . V.map (size . oneCorniceBody)) annChildren) annChildren
 
 -- | This is an O(1) operation, sort of
 size :: AnnotatedCornice p a c -> Maybe Int
 size x = case x of
-  AnnotatedCorniceBase (Colonnade v) -> if V.length v > 0
-    then Just ((V.sum . V.map (sizedSize . oneColonnadeHead)) v)
-    else Nothing
+  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
@@ -150,29 +149,30 @@ mapOneColonnadeHeader f (OneColonnade h b) = OneColonnade (fmap f h) b
 headersMonoidal :: forall r m c p a.
      Monoid m
   => Either (Fascia p r, r -> m -> m) (m -> m) -- ^ Apply the Fascia header row content
-  -> (Int -> c -> m) -- ^ Build content from cell content and size
+  -> [Int -> c -> m] -- ^ Build content from cell content and size
   -> AnnotatedCornice p a c
   -> m
-headersMonoidal wrapRow fromContent = go wrapRow
+headersMonoidal wrapRow fromContentList = go wrapRow
   where
   go :: forall p'. Either (Fascia p' r, r -> m -> m) (m -> m) -> AnnotatedCornice p' a c -> m
-  go ef (AnnotatedCorniceBase (Colonnade v)) = 
+  go ef (AnnotatedCorniceBase _ (Colonnade v)) = 
     let g :: m -> m
         g m = case ef of
           Right f -> f m
           Left (FasciaBase r, f) -> f r m
-     in foldMap (\(OneColonnade (Sized sz (Headed h)) _) -> 
-          g (fromContent sz h)) v
+     in foldMap (\fromContent -> g 
+          (foldMap (\(OneColonnade (Sized sz (Headed h)) _) -> 
+            (fromContent sz h)) v)) fromContentList
   go ef (AnnotatedCorniceCap _ v) = 
     let g :: m -> m
         g m = case ef of
           Right f -> f m
           Left (FasciaCap r _, f) -> f r m
-     in foldMap (\(OneCornice h b) -> 
+     in g (foldMap (\(OneCornice h b) -> 
           (case size b of
             Nothing -> mempty
-            Just sz -> g (fromContent sz h))
-          ) v
+            Just sz -> fromContent sz h)
+          ) v)
           <> case ef of
                Right f -> case flattenAnnotated v of
                  Nothing -> mempty
@@ -185,14 +185,14 @@ flattenAnnotated :: Vector (OneCornice AnnotatedCornice p a c) -> Maybe (Annotat
 flattenAnnotated v = case v V.!? 0 of 
   Nothing -> Nothing
   Just (OneCornice _ x) -> Just $ case x of
-    AnnotatedCorniceBase _ -> flattenAnnotatedBase v
+    AnnotatedCorniceBase m _ -> flattenAnnotatedBase m v
     AnnotatedCorniceCap m _ -> flattenAnnotatedCap m v
 
-flattenAnnotatedBase :: Vector (OneCornice AnnotatedCornice Base a c) -> AnnotatedCornice Base a c
-flattenAnnotatedBase = AnnotatedCorniceBase 
+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)
+    (\(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

colonnade/src/Colonnade/Internal.hs

@@ -174,7 +174,7 @@ getCorniceCap :: Cornice (Cap p) a c -> Vector (OneCornice Cornice p a c)
 getCorniceCap (CorniceCap c) = c
 
 data AnnotatedCornice (p :: Pillar) a c where
-  AnnotatedCorniceBase :: !(Colonnade (Sized Headed) a c) -> AnnotatedCornice Base a c
+  AnnotatedCorniceBase :: !(Maybe Int) -> !(Colonnade (Sized Headed) a c) -> AnnotatedCornice Base a c
   AnnotatedCorniceCap :: 
        !(Maybe Int)
     -> {-# UNPACK #-} !(Vector (OneCornice AnnotatedCornice p a c))