From a353b05802fb045d43159f145f0fa2acad41393b Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Tue, 16 Sep 2025 15:43:54 +0200 Subject: [PATCH] allow cornices to be more polymorphic in headedness --- colonnade/src/Colonnade.hs | 20 +++---- colonnade/src/Colonnade/Encode.hs | 96 +++++++++++++++---------------- 2 files changed, 57 insertions(+), 59 deletions(-) diff --git a/colonnade/src/Colonnade.hs b/colonnade/src/Colonnade.hs index bc54acb..4bc483e 100644 --- a/colonnade/src/Colonnade.hs +++ b/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) String -- >>> 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 "Special" colSpecial +-- [ cap (Headed "Standard") colStandard +-- , cap (Headed "Special") colSpecial -- ] -- corShowtime = mconcat --- [ recap "" (cap "" (headed "Day" show)) --- , foldMap (\c -> recap c corStatus) ["Matinee","Evening"] +-- [ recap (Headed "") (cap (Headed "") (headed "Day" show)) +-- , 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 - Just sz -> "| " ++ rightPad sz ' ' c ++ " " + , ( \(E.Sized msz c) -> case msz of + Just sz -> "| " ++ rightPad sz ' ' (getHeaded c) ++ " " Nothing -> "" , \s -> s ++ "|\n" ) diff --git a/colonnade/src/Colonnade/Encode.hs b/colonnade/src/Colonnade/Encode.hs index c1b2e66..a8280ae 100644 --- a/colonnade/src/Colonnade/Encode.hs +++ b/colonnade/src/Colonnade/Encode.hs @@ -277,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 @@ -299,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) @@ -340,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. - Foldable f +sizeColonnades :: forall f s h p a c. + ( 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 - -> ST s (AnnotatedCornice (Maybe Int) Headed p a c) + -> MutableSizedCornice s h p a c + -> ST s (AnnotatedCornice (Maybe Int) h p a c) freezeMutableSizedCornice step finish = go where - go :: forall p' a' c'. - MutableSizedCornice s p' a' c' - -> ST s (AnnotatedCornice (Maybe Int) Headed p' a' c') + go :: forall h' p' a' c'. + MutableSizedCornice s h' p' a' c' + -> ST s (AnnotatedCornice (Maybe Int) h' p' a' c') go (MutableSizedCorniceBase msc) = do szCol <- freezeMutableSizedColonnade msc let sz = @@ -384,15 +384,15 @@ freezeMutableSizedCornice step finish = go ) v2 return $ AnnotatedCorniceCap sz v2 -newMutableSizedCornice :: forall s p a c. - Cornice Headed p a c - -> ST s (MutableSizedCornice s p a c) +newMutableSizedCornice :: forall s h p a c. + Cornice h 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 @@ -406,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 f (OneColonnade h b) = OneColonnade (fmap f h) b +mapOneColonnadeHeader :: (h c -> h c) -> OneColonnade h a c -> OneColonnade h a c +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 @@ -426,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 - Just unhead -> g $ foldMap (\(fromContent,wrap) -> wrap - (foldMap (\(OneColonnade (Sized sz h) _) -> - (fromContent sz (unhead h))) v)) fromContentList - Nothing -> mempty + in g $ foldMap (\(fromContent,wrap) -> wrap + (foldMap (\(OneColonnade h _) -> + (fromContent 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) -> - (fromContent (size b) h)) v)) fromContentList) + (fromContent $ Sized (size b) h)) v)) fromContentList) <> case ef of Nothing -> case flattenAnnotated v of Nothing -> mempty @@ -447,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 @@ -457,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 @@ -466,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 - -> Vector (OneCornice (AnnotatedCornice sz h) p a c) + OneCornice (AnnotatedCornice sz) h (Cap 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 MutableSizedCorniceCap :: - {-# UNPACK #-} !(Vector (OneCornice (MutableSizedCornice s) p a c)) - -> MutableSizedCornice s (Cap p) a c + {-# UNPACK #-} !(Vector (OneCornice (MutableSizedCornice s) h p a c)) + -> MutableSizedCornice s h (Cap p) a c data MutableSizedColonnade s h a c = MutableSizedColonnade { _mutableSizedColonnadeColumns :: {-# UNPACK #-} !(Vector (OneColonnade h a c)) @@ -594,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 - { oneCorniceHead :: !c - , oneCorniceBody :: !(k p a c) +data OneCornice k h (p :: Pillar) a c = OneCornice + { oneCorniceHead :: !(h 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 @@ -628,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 @@ -650,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