Cornice completed. compiling and passing tests.

colonnade/src/Colonnade.hs

@@ -84,14 +84,9 @@ import qualified Data.Vector as Vector
 -- Similarly, we can build a table of houses with:
 --
 -- >>> let showDollar = (('$':) . show) :: Int -> String
--- >>> :{
+-- >>> colHouse = mconcat [headed "Color" (show . color), headed "Price" (showDollar . price)]
--- let colHouse :: Colonnade Headed House String
+-- >>> :t colHouse
---     colHouse = mconcat
+-- colHouse :: Colonnade Headed House [Char]
---       [ headed "Color" (show . color)
---       , headed "Price" (showDollar . price)
---       ]
--- :}
---
 -- >>> let houses = [House Green 170000, House Blue 115000, House Green 150000]
 -- >>> putStr (ascii colHouse houses)
 -- +-------+---------+
@@ -267,11 +262,51 @@ replaceWhen newContent p (Colonnade v) = Colonnade
 --   >>> :t cor
 --   cor :: Cornice ('Cap 'Base) (Person, House) [Char]
 --   >>> putStr (asciiCapped cor personHomePairs)
---   foo
+--   +-------------+-----------------+
+--   | 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 = CorniceCap . Vector.singleton . OneCornice h . 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 = CorniceCap (Vector.singleton (OneCornice h cor))
 
@@ -282,9 +317,12 @@ asciiCapped :: Foldable f
 asciiCapped cor xs =
   let annCor = CE.annotateFinely (\x y -> x + y + 3) id 
         List.length xs cor
-   in CE.headersMonoidal "|"
+      sizedCol = CE.uncapAnnotated annCor
-        (Right (\s -> "|" ++ s ++ "\n")) 
+   in CE.headersMonoidal
-        (\sz c -> " " ++ rightPad sz ' ' c ++ " |") annCor
+        Nothing 
+        [ (\sz c -> 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
@@ -304,6 +342,28 @@ ascii col xs =
              (\(Sized sz _) -> hyphens (sz + 2) ++ "+")
         , "\n"
         ]
+   in List.concat
+      [ divider
+      , concat
+         [ "|"
+         , Encode.headerMonoidalFull sizedCol
+             (\(Sized s (Headed h)) -> " " ++ rightPad s ' ' h ++ " |")
+         , "\n"
+         ]
+      , asciiBody sizedCol xs
+      ]
+
+asciiBody :: Foldable f
+  => Colonnade (Sized Headed) a String
+  -> f a
+  -> String
+asciiBody sizedCol xs =
+  let divider = concat
+        [ "+" 
+        , Encode.headerMonoidalFull sizedCol 
+             (\(Sized sz _) -> hyphens (sz + 2) ++ "+")
+        , "\n"
+        ]
       rowContents = foldMap
         (\x -> concat
            [ "|"
@@ -316,13 +376,6 @@ ascii col xs =
         ) xs
    in List.concat
       [ divider
-      , concat
-         [ "|"
-         , Encode.headerMonoidalFull sizedCol
-             (\(Sized s (Headed h)) -> " " ++ rightPad s ' ' h ++ " |")
-         , "\n"
-         ]
-      , divider
       , rowContents
       , divider
       ]

colonnade/src/Colonnade/Cornice/Encode.hs

@@ -11,6 +11,7 @@ module Colonnade.Cornice.Encode
   , endow
   , discard
   , headersMonoidal
+  , uncapAnnotated
   ) where
 
 import Colonnade.Internal
@@ -35,6 +36,15 @@ endow f x = case x of
   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
@@ -148,38 +158,38 @@ 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
+  => Maybe (Fascia p r, r -> m -> m) -- ^ Apply the Fascia header row content
-  -> [Int -> c -> m] -- ^ Build content from cell content and size
+  -> [(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'. Either (Fascia p' r, r -> m -> m) (m -> m) -> AnnotatedCornice p' a c -> m
+  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
-          Right f -> f m
+          Nothing -> m
-          Left (FasciaBase r, f) -> f r m
+          Just (FasciaBase r, f) -> f r m
-     in foldMap (\fromContent -> g 
+     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
-          Right f -> f m
+          Nothing -> m
-          Left (FasciaCap r _, f) -> f r m
+          Just (FasciaCap r _, f) -> f r m
-     in g (foldMap (\(OneCornice h b) -> 
+     in g (foldMap (\(fromContent,wrap) -> wrap (foldMap (\(OneCornice h b) -> 
           (case size b of
             Nothing -> mempty
             Just sz -> fromContent sz h)
-          ) v)
+          ) v)) fromContentList)
           <> case ef of
-               Right f -> case flattenAnnotated v of
+               Nothing -> case flattenAnnotated v of
                  Nothing -> mempty
-                 Just annCoreNext -> go (Right f) annCoreNext
+                 Just annCoreNext -> go Nothing annCoreNext
-               Left (FasciaCap _ fn, f) -> case flattenAnnotated v of
+               Just (FasciaCap _ fn, f) -> case flattenAnnotated v of
                  Nothing -> mempty
-                 Just annCoreNext -> go (Left (fn,f)) annCoreNext
+                 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