diff --git a/colonnade/src/Colonnade.hs b/colonnade/src/Colonnade.hs index 56802bc..dc365a1 100644 --- a/colonnade/src/Colonnade.hs +++ b/colonnade/src/Colonnade.hs @@ -1,4 +1,4 @@ - +{-# LANGUAGE DataKinds #-} -- | Build backend-agnostic columnar encodings that can be -- used to visualize tabular data. @@ -6,25 +6,26 @@ module Colonnade ( -- * Example -- $setup -- * Types - -- ** Colonnade Colonnade , Headed , Headless - -- ** Cornice - , Cornice - , Pillar(..) - , Fascia(..) -- * Create , headed , headless , singleton -- * Transform + , mapHeaderContent , fromMaybe , columns , bool , replaceWhen , modifyWhen -- * Cornice + -- ** Types + , Cornice + , Pillar(..) + , Fascia(..) + -- ** Create , cap , recap -- * Ascii Table @@ -84,15 +85,15 @@ import qualified Data.Vector as Vector -- -- >>> let showDollar = (('$':) . show) :: Int -> String -- >>> :{ --- let encodingHouse :: Colonnade Headed House String --- encodingHouse = mconcat +-- let colHouse :: Colonnade Headed House String +-- colHouse = mconcat -- [ headed "Color" (show . color) -- , headed "Price" (showDollar . price) -- ] -- :} -- -- >>> let houses = [House Green 170000, House Blue 115000, House Green 150000] --- >>> putStr (ascii encodingHouse houses) +-- >>> putStr (ascii colHouse houses) -- +-------+---------+ -- | Color | Price | -- +-------+---------+ @@ -111,9 +112,15 @@ headless :: (a -> c) -> Colonnade Headless a c headless = singleton Headless -- | A single column with any kind of header. This is not typically needed. -singleton :: f c -> (a -> c) -> Colonnade f a c +singleton :: h c -> (a -> c) -> Colonnade h a c singleton h = Colonnade . Vector.singleton . OneColonnade h +-- | Map over the content in the header. This is similar performing 'fmap' +-- on a 'Colonnade' except that the body content is unaffected. +mapHeaderContent :: Functor h => (c -> c) -> Colonnade h a c -> Colonnade h a c +mapHeaderContent f (Colonnade v) = + Colonnade (Vector.map (\(OneColonnade h e) -> OneColonnade (fmap f h) e) v) + -- | Lift a column over a 'Maybe'. For example, if some people -- have houses and some do not, the data that pairs them together -- could be represented as: @@ -134,7 +141,7 @@ singleton h = Colonnade . Vector.singleton . OneColonnade h -- let colOwners :: Colonnade Headed (Person,Maybe House) String -- colOwners = mconcat -- [ lmap fst colPerson --- , lmap snd (fromMaybe "" encodingHouse) +-- , lmap snd (fromMaybe "" colHouse) -- ] -- :} -- @@ -219,21 +226,65 @@ replaceWhen newContent p (Colonnade v) = Colonnade ) v ) -toCornice :: Colonnade Headed a c -> Cornice Base a c -toCornice = CorniceBase +-- | Augment a 'Colonnade' with a header spans over all of the +-- existing headers. This is best demonstrated by example. +-- Let\'s consider how we might encode a pairing of the people +-- and houses from the initial example: +-- +-- >>> let personHomePairs = zip people houses +-- >>> let colPersonFst = lmap fst colPerson +-- >>> let colHouseSnd = lmap snd colHouse +-- >>> putStr (ascii (colPersonFst <> colHouseSnd) personHomePairs) +-- +-------+-----+-------+---------+ +-- | Name | Age | Color | Price | +-- +-------+-----+-------+---------+ +-- | David | 63 | Green | $170000 | +-- | Ava | 34 | Blue | $115000 | +-- | Sonia | 12 | Green | $150000 | +-- +-------+-----+-------+---------+ +-- +-- This tabular encoding leaves something to be desired. The heading +-- not indicate that the name and age refer to a person and that +-- the color and price refer to a house. Without reaching for 'Cornice', +-- we can still improve this situation with 'mapHeaderContent': +-- +-- >>> let colPersonFst' = mapHeaderContent ("Person " ++) colPersonFst +-- >>> let colHouseSnd' = mapHeaderContent ("House " ++) colHouseSnd +-- >>> putStr (ascii (colPersonFst' <> colHouseSnd') personHomePairs) +-- +-------------+------------+-------------+-------------+ +-- | Person Name | Person Age | House Color | House Price | +-- +-------------+------------+-------------+-------------+ +-- | David | 63 | Green | $170000 | +-- | Ava | 34 | Blue | $115000 | +-- | Sonia | 12 | Green | $150000 | +-- +-------------+------------+-------------+-------------+ +-- +-- This is much better, but for longer tables, the redundancy +-- 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] +-- >>> :t cor +-- cor :: Cornice ('Cap 'Base) (Person, House) [Char] +-- >>> putStr (asciiCapped cor personHomePairs) +-- foo +-- +cap :: c -> Colonnade Headed a c -> Cornice (Cap Base) a c +cap h = CorniceCap . Vector.singleton . OneCornice h . CorniceBase -cap :: c -> Cornice p a c -> Cornice (Cap p) a c -cap h cor = CorniceCap (V.singleton (OneCornice h cor)) +recap :: c -> Cornice p a c -> Cornice (Cap p) a c +recap h cor = CorniceCap (Vector.singleton (OneCornice h cor)) - -asciiMulti :: Foldable f +asciiCapped :: Foldable f => Cornice p a String -- ^ columnar encoding -> f a -- ^ rows -> String -asciiMulti cor xs = +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 + in CE.headersMonoidal "|" + (Right (\s -> "|" ++ s ++ "\n")) + (\sz c -> " " ++ rightPad sz ' ' c ++ " |") annCor -- | Render a collection of rows as an ascii table. The table\'s columns are diff --git a/colonnade/src/Colonnade/Cornice/Encode.hs b/colonnade/src/Colonnade/Cornice/Encode.hs index 9e26c96..51896da 100644 --- a/colonnade/src/Colonnade/Cornice/Encode.hs +++ b/colonnade/src/Colonnade/Cornice/Encode.hs @@ -38,7 +38,10 @@ endow f x = case x of 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 - go (CorniceBase c) = AnnotatedCorniceBase (mapHeadedness (Sized 1) c) + go (CorniceBase c) = let len = V.length (getColonnade c) in + AnnotatedCorniceBase + (if len > 0 then (Just len) else Nothing) + (mapHeadedness (Sized 1) c) go (CorniceCap children) = let annChildren = fmap (mapOneCorniceBody go) children in AnnotatedCorniceCap @@ -98,11 +101,21 @@ freezeMutableSizedCornice :: forall s p a c. freezeMutableSizedCornice step finish = go where go :: forall p' a' c'. MutableSizedCornice s p' a' c' -> ST s (AnnotatedCornice p' a' c') - go (MutableSizedCorniceBase msc) = - fmap AnnotatedCorniceBase (E.freezeMutableSizedColonnade msc) + go (MutableSizedCorniceBase msc) = do + szCol <- E.freezeMutableSizedColonnade msc + let sz = + ( mapJustInt finish + . V.foldl' (combineJustInt step) Nothing + . V.map (Just . sizedSize . oneColonnadeHead) + ) (getColonnade szCol) + return (AnnotatedCorniceBase sz szCol) go (MutableSizedCorniceCap v1) = do v2 <- V.mapM (traverseOneCorniceBody go) v1 - let sz = (mapJustInt finish . V.foldl' (combineJustInt step) Nothing . V.map (size . oneCorniceBody)) v2 + let sz = + ( mapJustInt finish + . V.foldl' (combineJustInt step) Nothing + . V.map (size . oneCorniceBody) + ) v2 return $ AnnotatedCorniceCap sz v2 newMutableSizedCornice :: forall s p a c. @@ -120,25 +133,11 @@ mapHeadedness :: (forall x. h x -> h' x) -> Colonnade h a c -> Colonnade h' a c mapHeadedness f (Colonnade v) = Colonnade (V.map (\(OneColonnade h c) -> OneColonnade (f h) c) v) --- annotate :: --- Int -- ^ initial --- -> (Int -> Int -> Int) -- ^ fold function --- -> (Int -> Int) -- ^ finalize --- -> Cornice p a c --- -> AnnotatedCornice p a c --- annotate i0 g finish = go where --- go :: forall p a c. Cornice p a c -> AnnotatedCornice p a c --- go (CorniceBase c) = AnnotatedCorniceBase c --- go (CorniceCap children) = --- let annChildren = fmap (mapOneCorniceBody go) children --- in AnnotatedCorniceCap ((finish . V.foldl' g i0 . V.map (size . oneCorniceBody)) annChildren) annChildren -- | This is an O(1) operation, sort of size :: AnnotatedCornice p a c -> Maybe Int size x = case x of - AnnotatedCorniceBase (Colonnade v) -> if V.length v > 0 - then Just ((V.sum . V.map (sizedSize . oneColonnadeHead)) v) - else Nothing + 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 @@ -150,29 +149,30 @@ 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 + -> [Int -> c -> m] -- ^ Build content from cell content and size -> AnnotatedCornice p a c -> m -headersMonoidal wrapRow fromContent = go wrapRow +headersMonoidal wrapRow fromContentList = go wrapRow where go :: forall p'. Either (Fascia p' r, r -> m -> m) (m -> m) -> AnnotatedCornice p' a c -> m - go ef (AnnotatedCorniceBase (Colonnade v)) = + 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 (\(OneColonnade (Sized sz (Headed h)) _) -> - g (fromContent sz h)) v + in foldMap (\fromContent -> g + (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 foldMap (\(OneCornice h b) -> + in g (foldMap (\(OneCornice h b) -> (case size b of Nothing -> mempty - Just sz -> g (fromContent sz h)) - ) v + Just sz -> fromContent sz h) + ) v) <> case ef of Right f -> case flattenAnnotated v of Nothing -> mempty @@ -185,14 +185,14 @@ flattenAnnotated :: Vector (OneCornice AnnotatedCornice p a c) -> Maybe (Annotat flattenAnnotated v = case v V.!? 0 of Nothing -> Nothing Just (OneCornice _ x) -> Just $ case x of - AnnotatedCorniceBase _ -> flattenAnnotatedBase v + AnnotatedCorniceBase m _ -> flattenAnnotatedBase m v AnnotatedCorniceCap m _ -> flattenAnnotatedCap m v -flattenAnnotatedBase :: Vector (OneCornice AnnotatedCornice Base a c) -> AnnotatedCornice Base a c -flattenAnnotatedBase = AnnotatedCorniceBase +flattenAnnotatedBase :: Maybe Int -> Vector (OneCornice AnnotatedCornice Base a c) -> AnnotatedCornice Base a c +flattenAnnotatedBase msz = AnnotatedCorniceBase msz . Colonnade . V.concatMap - (\(OneCornice _ (AnnotatedCorniceBase (Colonnade v))) -> v) + (\(OneCornice _ (AnnotatedCorniceBase _ (Colonnade v))) -> v) flattenAnnotatedCap :: Maybe Int -> Vector (OneCornice AnnotatedCornice (Cap p) a c) -> AnnotatedCornice (Cap p) a c flattenAnnotatedCap m = AnnotatedCorniceCap m . V.concatMap getTheVector diff --git a/colonnade/src/Colonnade/Internal.hs b/colonnade/src/Colonnade/Internal.hs index 72e0a34..c04ec5b 100644 --- a/colonnade/src/Colonnade/Internal.hs +++ b/colonnade/src/Colonnade/Internal.hs @@ -174,7 +174,7 @@ getCorniceCap :: Cornice (Cap p) a c -> Vector (OneCornice Cornice p a c) getCorniceCap (CorniceCap c) = c data AnnotatedCornice (p :: Pillar) a c where - AnnotatedCorniceBase :: !(Colonnade (Sized Headed) a c) -> AnnotatedCornice Base a c + AnnotatedCorniceBase :: !(Maybe Int) -> !(Colonnade (Sized Headed) a c) -> AnnotatedCornice Base a c AnnotatedCorniceCap :: !(Maybe Int) -> {-# UNPACK #-} !(Vector (OneCornice AnnotatedCornice p a c))