export flattenAnnotated

colonnade/src/Colonnade.hs

@@ -272,7 +272,7 @@ replaceWhen = modifyWhen . const
 --   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]
+--   >>> let cor = mconcat [cap (Headed "Person") colPersonFst, cap (Headed "House") colHouseSnd]
 --   >>> :t cor
 --   cor :: Cornice Headed ('Cap 'Base) (Person, House) [Char]
 --   >>> putStr (asciiCapped cor personHomePairs)
@@ -286,7 +286,7 @@ replaceWhen = modifyWhen . const
 --   | Sonia | 12  | Green | $150000 |
 --   +-------+-----+-------+---------+
 --   
-cap :: c -> Colonnade h a c -> Cornice h (Cap Base) a c
+cap :: h c -> Colonnade h a c -> Cornice h (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
@@ -301,12 +301,12 @@ cap h = E.CorniceCap . Vector.singleton . E.OneCornice h . E.CorniceBase
 --       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 (Headed "Standard") colStandard
---         , cap "Special" colSpecial
+--         , cap (Headed "Special") colSpecial
 --         ] 
 --       corShowtime = mconcat
---         [ recap "" (cap "" (headed "Day" show))
+--         [ recap (Headed "") (cap (Headed "") (headed "Day" show))
---         , foldMap (\c -> recap c corStatus) ["Matinee","Evening"]
+--         , foldMap (\c -> recap (Headed c) corStatus) ["Matinee","Evening"]
 --         ]
 --   :}
 --
@@ -321,7 +321,7 @@ cap h = E.CorniceCap . Vector.singleton . E.OneCornice h . E.CorniceBase
 --   | 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 h p a c -> Cornice h (Cap p) a c
+recap :: h c -> Cornice h p a c -> Cornice h (Cap p) a c
 recap h cor = E.CorniceCap (Vector.singleton (E.OneCornice h cor))
 
 asciiCapped :: Foldable f
@@ -334,13 +334,13 @@ asciiCapped cor xs =
       sizedCol = E.uncapAnnotated annCor
    in E.headersMonoidal
         Nothing 
-        [ ( \msz _ -> case msz of
+        [ ( \(E.Sized msz _) -> case msz of
               Just sz -> "+" ++ hyphens (sz + 2)
               Nothing -> ""
           , \s -> s ++ "+\n"
           )
-        , ( \msz c -> case msz of
+        , ( \(E.Sized msz c) -> case msz of
-              Just sz -> "| " ++ rightPad sz ' ' c ++ " "
+              Just sz -> "| " ++ rightPad sz ' ' (getHeaded c) ++ " "
               Nothing -> ""
           , \s -> s ++ "|\n"
           )

colonnade/src/Colonnade/Encode.hs

@@ -80,6 +80,7 @@ module Colonnade.Encode
   , endow
   , discard
   , headersMonoidal
+  , flattenAnnotated
   , uncapAnnotated
   ) where
 
@@ -276,12 +277,12 @@ discard = go where
   go (CorniceBase c) = c
   go (CorniceCap children) = Colonnade (getColonnade . go . oneCorniceBody =<< children)
 
-endow :: forall p a c. (c -> c -> c) -> Cornice Headed p a c -> Colonnade Headed a c
+endow :: forall h p a c. (h c -> h c -> h c) -> Cornice h p a c -> Colonnade h 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 Headed p' a c -> Vector (OneColonnade Headed a c)
+  go :: forall p'. h c -> Cornice h p' a c -> Vector (OneColonnade h 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
 
@@ -298,9 +299,9 @@ uncapAnnotated x = case x of
   go (AnnotatedCorniceBase _ (Colonnade v)) = v
   go (AnnotatedCorniceCap _ v) = V.concatMap (\(OneCornice _ b) -> go b) v
 
-annotate :: Cornice Headed p a c -> AnnotatedCornice (Maybe Int) Headed p a c
+annotate :: Cornice h p a c -> AnnotatedCornice (Maybe Int) h p a c
 annotate = go where
-  go :: forall p a c. Cornice Headed p a c -> AnnotatedCornice (Maybe Int) Headed p a c
+  go :: forall h p a c. Cornice h p a c -> AnnotatedCornice (Maybe Int) h p a c
   go (CorniceBase c) = let len = V.length (getColonnade c) in
     AnnotatedCorniceBase
       (if len > 0 then (Just len) else Nothing)
@@ -339,33 +340,33 @@ annotateFinely g finish toSize xs cornice = runST $ do
   sizeColonnades toSize xs m
   freezeMutableSizedCornice g finish m
 
-sizeColonnades :: forall f s p a c.
+sizeColonnades :: forall f s h p a c.
-     Foldable f
+     ( Foldable f, Foldable h )
   => (c -> Int) -- ^ Get size from content
   -> f a
-  -> MutableSizedCornice s p a c 
+  -> MutableSizedCornice s h 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 :: forall h' p'. Foldable h' => MutableSizedCornice s h' 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 :: forall h' p'. Foldable h' => MutableSizedCornice s h' p' a c -> ST s ()
   goHeader (MutableSizedCorniceBase c) = headerUpdateSize toSize c
   goHeader (MutableSizedCorniceCap children) = mapM_ (goHeader . oneCorniceBody) children
   
-freezeMutableSizedCornice :: forall s p a c.
+freezeMutableSizedCornice :: forall s h p a c.
      (Int -> Int -> Int) -- ^ fold function
   -> (Int -> Int) -- ^ finalize
-  -> MutableSizedCornice s p a c 
+  -> MutableSizedCornice s h p a c 
-  -> ST s (AnnotatedCornice (Maybe Int) Headed p a c)
+  -> ST s (AnnotatedCornice (Maybe Int) h p a c)
 freezeMutableSizedCornice step finish = go
   where
-  go :: forall p' a' c'.
+  go :: forall h' p' a' c'.
-       MutableSizedCornice s p' a' c' 
+       MutableSizedCornice s h' p' a' c' 
-    -> ST s (AnnotatedCornice (Maybe Int) Headed p' a' c')
+    -> ST s (AnnotatedCornice (Maybe Int) h' p' a' c')
   go (MutableSizedCorniceBase msc) = do
     szCol <- freezeMutableSizedColonnade msc
     let sz = 
@@ -383,15 +384,15 @@ freezeMutableSizedCornice step finish = go
           ) v2
     return $ AnnotatedCorniceCap sz v2
 
-newMutableSizedCornice :: forall s p a c.
+newMutableSizedCornice :: forall s h p a c.
-     Cornice Headed p a c 
+     Cornice h p a c 
-  -> ST s (MutableSizedCornice s p a c)
+  -> ST s (MutableSizedCornice s h p a c)
 newMutableSizedCornice = go where
-  go :: forall p'. Cornice Headed p' a c -> ST s (MutableSizedCornice s p' a c)
+  go :: forall h' p'. Cornice h' p' a c -> ST s (MutableSizedCornice s h' 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 :: Monad m => (k h p a c -> m (j h p a c)) -> OneCornice k h p a c -> m (OneCornice j h 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
@@ -405,16 +406,16 @@ 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 :: (forall h' p' a' c'. k h' p' a' c' -> j h' p' a' c') -> OneCornice k h p a c -> OneCornice j h 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 :: (h c -> h c) -> OneColonnade h a c -> OneColonnade h a c
-mapOneColonnadeHeader f (OneColonnade h b) = OneColonnade (fmap f h) b
+mapOneColonnadeHeader f (OneColonnade h b) = OneColonnade (f h) b
 
 headersMonoidal :: forall sz r m c p a h.
-     (Monoid m, Headedness h)
+     Monoid m
   => Maybe (Fascia p r, r -> m -> m) -- ^ Apply the Fascia header row content
-  -> [(sz -> c -> m, m -> m)] -- ^ Build content from cell content and size
+  -> [(Sized sz h c -> m, m -> m)] -- ^ Build content from cell content and size
   -> AnnotatedCornice sz h p a c
   -> m
 headersMonoidal wrapRow fromContentList = go wrapRow
@@ -425,18 +426,16 @@ headersMonoidal wrapRow fromContentList = go wrapRow
         g m = case ef of
           Nothing -> m
           Just (FasciaBase r, f) -> f r m
-     in case headednessExtract of
+     in g $ foldMap (\(fromContent,wrap) -> wrap 
-          Just unhead -> g $ foldMap (\(fromContent,wrap) -> wrap 
+          (foldMap (\(OneColonnade h _) -> 
-            (foldMap (\(OneColonnade (Sized sz h) _) -> 
+            (fromContent h)) v)) fromContentList
-              (fromContent sz (unhead h))) v)) fromContentList
-          Nothing -> mempty
   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) -> 
-          (fromContent (size b) h)) v)) fromContentList)
+          (fromContent $ Sized (size b) h)) v)) fromContentList)
           <> case ef of
                Nothing -> case flattenAnnotated v of
                  Nothing -> mempty
@@ -446,7 +445,7 @@ headersMonoidal wrapRow fromContentList = go wrapRow
                  Just annCoreNext -> go (Just (fn,f)) annCoreNext
 
 flattenAnnotated ::
-     Vector (OneCornice (AnnotatedCornice sz h) p a c)
+     Vector (OneCornice (AnnotatedCornice sz) h p a c)
   -> Maybe (AnnotatedCornice sz h p a c)
 flattenAnnotated v = case v V.!? 0 of 
   Nothing -> Nothing
@@ -456,7 +455,7 @@ flattenAnnotated v = case v V.!? 0 of
 
 flattenAnnotatedBase ::
      sz
-  -> Vector (OneCornice (AnnotatedCornice sz h) Base a c)
+  -> Vector (OneCornice (AnnotatedCornice sz) h Base a c)
   -> AnnotatedCornice sz h Base a c
 flattenAnnotatedBase msz = AnnotatedCorniceBase msz
   . Colonnade 
@@ -465,22 +464,22 @@ flattenAnnotatedBase msz = AnnotatedCorniceBase msz
 
 flattenAnnotatedCap ::
      sz
-  -> Vector (OneCornice (AnnotatedCornice sz h) (Cap p) a c)
+  -> Vector (OneCornice (AnnotatedCornice sz) h (Cap p) a c)
   -> AnnotatedCornice sz h (Cap p) a c
 flattenAnnotatedCap m = AnnotatedCorniceCap m . V.concatMap getTheVector
 
 getTheVector :: 
-     OneCornice (AnnotatedCornice sz h) (Cap p) a c 
+     OneCornice (AnnotatedCornice sz) h (Cap p) a c 
-  -> Vector (OneCornice (AnnotatedCornice sz h) p a c)
+  -> Vector (OneCornice (AnnotatedCornice sz) h p a c)
 getTheVector (OneCornice _ (AnnotatedCorniceCap _ v)) = v
 
-data MutableSizedCornice s (p :: Pillar) a c where
+data MutableSizedCornice s h (p :: Pillar) a c where
   MutableSizedCorniceBase :: 
-       {-# UNPACK #-} !(MutableSizedColonnade s Headed a c) 
+       {-# UNPACK #-} !(MutableSizedColonnade s h a c) 
-    -> MutableSizedCornice s Base a c
+    -> MutableSizedCornice s h Base a c
   MutableSizedCorniceCap :: 
-       {-# UNPACK #-} !(Vector (OneCornice (MutableSizedCornice s) p a c))
+       {-# UNPACK #-} !(Vector (OneCornice (MutableSizedCornice s) h p a c))
-    -> MutableSizedCornice s (Cap p) a c
+    -> MutableSizedCornice s h (Cap p) a c
 
 data MutableSizedColonnade s h a c = MutableSizedColonnade
   { _mutableSizedColonnadeColumns :: {-# UNPACK #-} !(Vector (OneColonnade h a c))
@@ -593,14 +592,14 @@ 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
+data OneCornice k h (p :: Pillar) a c = OneCornice
-  { oneCorniceHead :: !c
+  { oneCorniceHead :: !(h c)
-  , oneCorniceBody :: !(k p a c)
+  , oneCorniceBody :: !(k h p a c)
   } deriving (Functor)
 
 data Cornice h (p :: Pillar) a c where
   CorniceBase :: !(Colonnade h a c) -> Cornice h Base a c
-  CorniceCap :: {-# UNPACK #-} !(Vector (OneCornice (Cornice h) p a c)) -> Cornice h (Cap p) a c
+  CorniceCap :: {-# UNPACK #-} !(Vector (OneCornice Cornice h p a c)) -> Cornice h (Cap p) a c
 
 instance Functor h => Functor (Cornice h p a) where
   fmap f x = case x of
@@ -627,19 +626,19 @@ instance ToEmptyCornice p => Monoid (Cornice h p a c) where
     [] -> toEmptyCornice
     x : xs2 -> Semigroup.sconcat (x :| xs2)
 
-mapVectorCornice :: Functor h => (c -> d) -> Vector (OneCornice (Cornice h) p a c) -> Vector (OneCornice (Cornice h) p a d)
+mapVectorCornice :: Functor h => (c -> d) -> Vector (OneCornice Cornice h p a c) -> Vector (OneCornice Cornice h p a d)
 mapVectorCornice f = V.map (fmap f)
 
-contramapVectorCornice :: Functor h => (b -> a) -> Vector (OneCornice (Cornice h) p a c) -> Vector (OneCornice (Cornice h) p b c)
+contramapVectorCornice :: Functor h => (b -> a) -> Vector (OneCornice Cornice h p a c) -> Vector (OneCornice Cornice h p b c)
 contramapVectorCornice f = V.map (lmapOneCornice f)
 
-lmapOneCornice :: Functor h => (b -> a) -> OneCornice (Cornice h) p a c -> OneCornice (Cornice h) p b c
+lmapOneCornice :: Functor h => (b -> a) -> OneCornice Cornice h p a c -> OneCornice Cornice h p b c
 lmapOneCornice f (OneCornice theHead theBody) = OneCornice theHead (lmap f theBody) 
 
 getCorniceBase :: Cornice h Base a c -> Colonnade h a c
 getCorniceBase (CorniceBase c) = c
 
-getCorniceCap :: Cornice h (Cap p) a c -> Vector (OneCornice (Cornice h) p a c)
+getCorniceCap :: Cornice h (Cap p) a c -> Vector (OneCornice Cornice h p a c)
 getCorniceCap (CorniceCap c) = c
 
 data AnnotatedCornice sz h (p :: Pillar) a c where
@@ -649,7 +648,7 @@ data AnnotatedCornice sz h (p :: Pillar) a c where
     -> AnnotatedCornice sz h Base a c
   AnnotatedCorniceCap :: 
        !sz
-    -> {-# UNPACK #-} !(Vector (OneCornice (AnnotatedCornice sz h) p a c))
+    -> {-# UNPACK #-} !(Vector (OneCornice (AnnotatedCornice sz) h p a c))
     -> AnnotatedCornice sz h (Cap p) a c
 
 -- data MaybeInt = JustInt {-# UNPACK #-} !Int | NothingInt