From 47a89ea3d30a3bcba43b03382af4e26b29057622 Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Thu, 16 Feb 2017 09:47:52 -0500 Subject: [PATCH] Cornice completed. compiling and passing tests. --- colonnade/src/Colonnade.hs | 91 ++++++++++++++++++----- colonnade/src/Colonnade/Cornice/Encode.hs | 38 ++++++---- 2 files changed, 96 insertions(+), 33 deletions(-) diff --git a/colonnade/src/Colonnade.hs b/colonnade/src/Colonnade.hs index dc365a1..2a6b72f 100644 --- a/colonnade/src/Colonnade.hs +++ b/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 --- >>> :{ --- 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 ] diff --git a/colonnade/src/Colonnade/Cornice/Encode.hs b/colonnade/src/Colonnade/Cornice/Encode.hs index 51896da..52d6391 100644 --- a/colonnade/src/Colonnade/Cornice/Encode.hs +++ b/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 - -> [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