forked from haskell/colonnade
allow cornices to be more polymorphic in headedness
This commit is contained in:
parent
5d26cc3c08
commit
a353b05802
@ -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"
|
||||
)
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user