Cornice completed. compiling and passing tests.
This commit is contained in:
Andrew Martin
parent
ba183422b0
commit
47a89ea3d3
@ -84,14 +84,9 @@ import qualified Data.Vector as Vector
|
||||
-- Similarly, we can build a table of houses with:
|
||||
--
|
||||
-- >>> let showDollar = (('$':) . show) :: Int -> String
|
||||
-- >>> :{
|
||||
-- let colHouse :: Colonnade Headed House String
|
||||
-- colHouse = mconcat
|
||||
-- [ headed "Color" (show . color)
|
||||
-- , headed "Price" (showDollar . price)
|
||||
-- ]
|
||||
-- :}
|
||||
--
|
||||
-- >>> colHouse = mconcat [headed "Color" (show . color), headed "Price" (showDollar . price)]
|
||||
-- >>> :t colHouse
|
||||
-- colHouse :: Colonnade Headed House [Char]
|
||||
-- >>> 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 "|"
|
||||
(Right (\s -> "|" ++ s ++ "\n"))
|
||||
(\sz c -> " " ++ rightPad sz ' ' c ++ " |") annCor
|
||||
sizedCol = CE.uncapAnnotated annCor
|
||||
in CE.headersMonoidal
|
||||
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
|
||||
]
|
||||
|
||||
@ -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
|
||||
-> [Int -> c -> m] -- ^ Build content from cell content and size
|
||||
=> Maybe (Fascia p r, r -> m -> m) -- ^ Apply the Fascia header row content
|
||||
-> [(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
|
||||
Left (FasciaBase r, f) -> f r m
|
||||
in foldMap (\fromContent -> g
|
||||
Nothing -> m
|
||||
Just (FasciaBase r, f) -> f r m
|
||||
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
|
||||
Left (FasciaCap r _, f) -> f r m
|
||||
in g (foldMap (\(OneCornice h b) ->
|
||||
Nothing -> m
|
||||
Just (FasciaCap r _, f) -> f r m
|
||||
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
|
||||
Left (FasciaCap _ fn, f) -> case flattenAnnotated v of
|
||||
Just annCoreNext -> go Nothing annCoreNext
|
||||
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user