colonnade 0.5 → 1.0.0

raw patch · 8 files changed

+544/−678 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• colonnade.cabal +3/−4
• src/Colonnade.hs +296/−0
• src/Colonnade/Decoding.hs +0/−160
• src/Colonnade/Encode.hs +152/−0
• src/Colonnade/Encoding.hs +0/−344
• src/Colonnade/Internal.hs +92/−17
• src/Colonnade/Types.hs +0/−152
• test/Main.hs +1/−1

@@ -1,5 +1,5 @@ name:                colonnade-version:             0.5+version:             1.0.0 synopsis:            Generic types and functions for columnar encoding and decoding description:   The `colonnade` package provides a way to to talk about@@ -28,9 +28,8 @@ library   hs-source-dirs:      src   exposed-modules:-    Colonnade.Types-    Colonnade.Encoding-    Colonnade.Decoding+    Colonnade+    Colonnade.Encode     Colonnade.Internal   build-depends:       base >= 4.7 && < 5

@@ -0,0 +1,296 @@+-- | Build backend-agnostic columnar encodings that can be +--   used to visualize tabular data.+module Colonnade+  ( -- * Example+    -- $setup+    -- * Types+    Colonnade+  , Headed+  , Headless+    -- * Create+  , headed+  , headless+  , singleton+    -- * Transform+  , fromMaybe+  , columns+  , bool+  , replaceWhen+  , modifyWhen+  , mapContent+    -- * Ascii Table+  , ascii+  ) where++import Colonnade.Internal+import qualified Colonnade.Encode as Encode+import Data.Vector (Vector)+import Data.Foldable+import Data.Monoid (Endo(..))+import Control.Monad+import Data.Functor.Contravariant+import qualified Data.Bool+import qualified Data.Maybe+import qualified Data.List as List+import qualified Data.Vector as Vector++-- $setup+--+-- First, let\'s bring in some neccessary imports that will be+-- used for the remainder of the examples in the docs:+--+-- >>> import Data.Monoid (mconcat,(<>))+-- >>> import Data.Functor.Contravariant (contramap)+--+-- The data types we wish to encode are:+--+-- >>> data Color = Red | Green | Blue deriving (Show,Eq)+-- >>> data Person = Person { name :: String, age :: Int }+-- >>> data House = House { color :: Color, price :: Int }+--+-- One potential columnar encoding of a @Person@ would be:+--+-- >>> :{+-- let colPerson :: Colonnade Headed String Person+--     colPerson = mconcat+--       [ headed "Name" name+--       , headed "Age" (show . age)+--       ]+-- :}+--+-- The type signature on @colPerson@ is not neccessary+-- but is included for clarity. We can feed data into this encoding+-- to build a table:+--+-- >>> let people = [Person "David" 63, Person "Ava" 34, Person "Sonia" 12]+-- >>> putStr (ascii colPerson people)+-- +-------+-----++-- | Name  | Age |+-- +-------+-----++-- | David | 63  |+-- | Ava   | 34  |+-- | Sonia | 12  |+-- +-------+-----++--+-- Similarly, we can build a table of houses with:+--+-- >>> let showDollar = (('$':) . show) :: Int -> String+-- >>> :{+-- let encodingHouse :: Colonnade Headed String House+--     encodingHouse = mconcat+--       [ headed "Color" (show . color)+--       , headed "Price" (showDollar . price)+--       ]+-- :}+--+-- >>> let houses = [House Green 170000, House Blue 115000, House Green 150000]+-- >>> putStr (ascii encodingHouse houses)+-- +-------+---------++-- | Color | Price   |+-- +-------+---------++-- | Green | $170000 |+-- | Blue  | $115000 |+-- | Green | $150000 |+-- +-------+---------++++-- | A single column with a header.+headed :: c -> (a -> c) -> Colonnade Headed c a+headed h = singleton (Headed h)++-- | A single column without a header.+headless :: (a -> c) -> Colonnade Headless c a+headless = singleton Headless++-- | A single column with any kind of header. This is not typically needed.+singleton :: f c -> (a -> c) -> Colonnade f c a+singleton h = Colonnade . Vector.singleton . OneColonnade h++-- | 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:+--+-- >>> :{+-- let owners :: [(Person,Maybe House)]+--     owners =+--       [ (Person "Jordan" 18, Nothing)+--       , (Person "Ruth" 25, Just (House Red 125000))+--       , (Person "Sonia" 12, Just (House Green 145000))+--       ]+-- :}+--+-- The column encodings defined earlier can be reused with+-- the help of 'fromMaybe':+--+-- >>> :{+-- let colOwners :: Colonnade Headed String (Person,Maybe House)+--     colOwners = mconcat+--       [ contramap fst colPerson+--       , contramap snd (fromMaybe "" encodingHouse)+--       ]+-- :}+--+-- >>> putStr (ascii colOwners owners)+-- +--------+-----+-------+---------++-- | Name   | Age | Color | Price   |+-- +--------+-----+-------+---------++-- | Jordan | 18  |       |         |+-- | Ruth   | 25  | Red   | $125000 |+-- | Sonia  | 12  | Green | $145000 |+-- +--------+-----+-------+---------++fromMaybe :: c -> Colonnade f c a -> Colonnade f c (Maybe a)+fromMaybe c (Colonnade v) = Colonnade $ flip Vector.map v $+  \(OneColonnade h encode) -> OneColonnade h (maybe c encode)++-- | Convert a collection of @b@ values into a columnar encoding of+--   the same size. Suppose we decide to show a house\'s color+--   by putting a check mark in the column corresponding to+--   the color instead of by writing out the name of the color:+--+-- >>> let allColors = [Red,Green,Blue]+-- >>> let encColor = columns (\c1 c2 -> if c1 == c2 then "✓" else "") (Headed . show) allColors+-- >>> :t encColor+-- encColor :: Colonnade Headed [Char] Color+-- >>> let encHouse = headed "Price" (showDollar . price) <> contramap color encColor+-- >>> :t encHouse+-- encHouse :: Colonnade Headed [Char] House+-- >>> putStr (ascii encHouse houses)+-- +---------+-----+-------+------++-- | Price   | Red | Green | Blue |+-- +---------+-----+-------+------++-- | $170000 |     | ✓     |      |+-- | $115000 |     |       | ✓    |+-- | $150000 |     | ✓     |      |+-- +---------+-----+-------+------++columns :: Foldable g+  => (b -> a -> c) -- ^ Cell content function+  -> (b -> f c) -- ^ Header content function+  -> g b -- ^ Basis for column encodings+  -> Colonnade f c a+columns getCell getHeader = id+  . Colonnade+  . Vector.map (\b -> OneColonnade (getHeader b) (getCell b))+  . Vector.fromList+  . toList++bool ::+     f c -- ^ Heading+  -> (a -> Bool) -- ^ Predicate+  -> (a -> c) -- ^ Contents when predicate is false+  -> (a -> c) -- ^ Contents when predicate is true+  -> Colonnade f c a+bool h p onTrue onFalse = singleton h (Data.Bool.bool <$> onFalse <*> onTrue <*> p)++-- | Modify the contents of cells in rows whose values satisfy the+--   given predicate. Header content is unaffected. With an HTML backend, +--   this can be used to strikethrough the contents of cells with data that is+--   considered invalid.+modifyWhen ::+     (c -> c) -- ^ Content change+  -> (a -> Bool) -- ^ Row predicate+  -> Colonnade f c a -- ^ Original 'Colonnade'+  -> Colonnade f c a+modifyWhen changeContent p (Colonnade v) = Colonnade+  ( Vector.map+    (\(OneColonnade h encode) -> OneColonnade h $ \a ->+      if p a then changeContent (encode a) else encode a+    ) v+  )++-- | Replace the contents of cells in rows whose values satisfy the+--   given predicate. Header content is unaffected.+replaceWhen ::+     c -- ^ New content+  -> (a -> Bool) -- ^ Row predicate+  -> Colonnade f c a -- ^ Original 'Colonnade'+  -> Colonnade f c a+replaceWhen newContent p (Colonnade v) = Colonnade+  ( Vector.map+    (\(OneColonnade h encode) -> OneColonnade h $ \a ->+      if p a then newContent else encode a+    ) v+  )++-- | 'Colonnade' is covariant in its content type. Consequently, it can be+--   mapped over. There is no standard typeclass for types that are covariant+--   in their second-to-last argument, so this function is provided for+--   situations that require this.+mapContent :: Functor f => (c1 -> c2) -> Colonnade f c1 a -> Colonnade f c2 a+mapContent f (Colonnade v) = Colonnade+  $ Vector.map (\(OneColonnade h c) -> (OneColonnade (fmap f h) (f . c))) v++-- | Render a collection of rows as an ascii table. The table\'s columns are+-- specified by the given 'Colonnade'. This implementation is inefficient and+-- does not provide any wrapping behavior. It is provided so that users can+-- try out @colonnade@ in ghci and so that @doctest@ can verify examples+-- code in the haddocks.+ascii :: Foldable f+  => Colonnade Headed String a -- ^ columnar encoding+  -> f a -- ^ rows+  -> String+ascii enc xs =+  let theHeader :: [(Int,String)]+      theHeader = (zip (enumFrom 0) . map (\s -> " " ++ s ++ " ")) (toList (Encode.header id enc))+      theBody :: [[(Int,String)]]+      theBody = map (zip (enumFrom 0) . map (\s -> " " ++ s ++ " ") . toList . Encode.row id enc) (toList xs)+      sizes :: [Int]+      sizes = ($ replicate (length theHeader) 1) $ appEndo $ mconcat+        [ foldMap (\(i,str) -> Endo (replaceAt i (length str))) theHeader+        , (foldMap . foldMap) (\(i,str) -> Endo (replaceAt i (length str))) theBody+        ]+      paddedHeader :: [String]+      paddedHeader = map (\(i,str) -> rightPad (atDef 1 sizes i) ' ' str) theHeader+      paddedBody :: [[String]]+      paddedBody = (map . map) (\(i,str) -> rightPad (atDef 1 sizes i) ' ' str) theBody+      divider :: String+      divider = "+" ++ join (List.intersperse "+" (map (\i -> replicate i '-') sizes)) ++ "+"+      headerStr :: String+      headerStr = "|" ++ join (List.intersperse "|" paddedHeader) ++ "|"+      bodyStr :: String+      bodyStr = List.unlines (map ((\s -> "|" ++ s ++ "|") . join . List.intersperse "|") paddedBody)+   in divider ++ "\n" ++ headerStr+              ++ "\n" ++ divider+              ++ "\n" ++ bodyStr ++ divider ++ "\n"+++-- this has no effect if the index is out of bounds+replaceAt :: Ord a => Int -> a -> [a] -> [a]+replaceAt _ _ [] = []+replaceAt n v (a:as) = if n > 0+  then a : replaceAt (n - 1) v as+  else (max v a) : as++rightPad :: Int -> a -> [a] -> [a]+rightPad m a xs = take m $ xs ++ repeat a++atDef :: a -> [a] -> Int -> a+atDef def = Data.Maybe.fromMaybe def .^ atMay where+  (.^) f g x1 x2 = f (g x1 x2)+  atMay = eitherToMaybe .^ at_+  eitherToMaybe = either (const Nothing) Just+  at_ xs o | o < 0 = Left $ "index must not be negative, index=" ++ show o+           | otherwise = f o xs+      where f 0 (z:_) = Right z+            f i (_:zs) = f (i-1) zs+            f i [] = Left $ "index too large, index=" ++ show o ++ ", length=" ++ show (o-i)++-- data Company = Company String String Int+-- +-- data Company = Company+--   { companyName :: String+--   , companyCountry :: String+--   , companyValue :: Int+--   } deriving (Show)+-- +-- myCompanies :: [Company]+-- myCompanies =+--   [ Company "eCommHub" "United States" 50+--   , Company "Layer 3 Communications" "United States" 10000000+--   , Company "Microsoft" "England" 500000000+--   ]++++++

@@ -1,160 +0,0 @@-{-# LANGUAGE RankNTypes          #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE BangPatterns        #-}-module Colonnade.Decoding where--import Colonnade.Internal (EitherWrap(..),mapLeft)-import Colonnade.Types-import Data.Functor.Contravariant-import Data.Vector (Vector)-import qualified Data.Vector as Vector-import Data.Char (chr)---- | Converts the content type of a 'Decolonnade'. The @'Contravariant' f@--- constraint means that @f@ can be 'Headless' but not 'Headed'.-contramapContent :: forall c1 c2 f a. Contravariant f => (c2 -> c1) -> Decolonnade f c1 a -> Decolonnade f c2 a-contramapContent f = go-  where-  go :: forall b. Decolonnade f c1 b -> Decolonnade f c2 b-  go (DecolonnadePure x) = DecolonnadePure x-  go (DecolonnadeAp h decode apNext) =-    DecolonnadeAp (contramap f h) (decode . f) (go apNext)--headless :: (content -> Either String a) -> Decolonnade Headless content a-headless f = DecolonnadeAp Headless f (DecolonnadePure id)--headed :: content -> (content -> Either String a) -> Decolonnade Headed content a-headed h f = DecolonnadeAp (Headed h) f (DecolonnadePure id)--indexed :: Int -> (content -> Either String a) -> Decolonnade (Indexed Headless) content a-indexed ix f = DecolonnadeAp (Indexed ix Headless) f (DecolonnadePure id)--maxIndex :: forall f c a. Decolonnade (Indexed f) c a -> Int-maxIndex = go 0 where-  go :: forall b. Int -> Decolonnade (Indexed f) c b -> Int-  go !ix (DecolonnadePure _) = ix-  go !ix1 (DecolonnadeAp (Indexed ix2 _) decode apNext) =-    go (max ix1 ix2) apNext---- | This function uses 'unsafeIndex' to access---   elements of the 'Vector'.-uncheckedRunWithRow ::-     Int-  -> Decolonnade (Indexed f) content a-  -> Vector content-  -> Either (DecolonnadeRowError f content) a-uncheckedRunWithRow i d v = mapLeft (DecolonnadeRowError i . RowErrorDecode) (uncheckedRun d v)---- | This function does not check to make sure that the indicies in---   the 'Decolonnade' are in the 'Vector'.-uncheckedRun :: forall content a f.-                Decolonnade (Indexed f) content a-             -> Vector content-             -> Either (DecolonnadeCellErrors f content) a-uncheckedRun dc v = getEitherWrap (go dc)-  where-  go :: forall b.-        Decolonnade (Indexed f) content b-     -> EitherWrap (DecolonnadeCellErrors f content) b-  go (DecolonnadePure b) = EitherWrap (Right b)-  go (DecolonnadeAp ixed@(Indexed ix h) decode apNext) =-    let rnext = go apNext-        content = Vector.unsafeIndex v ix-        rcurrent = mapLeft (DecolonnadeCellErrors . Vector.singleton . DecolonnadeCellError content ixed) (decode content)-    in rnext <*> (EitherWrap rcurrent)--headlessToIndexed :: forall c a.-  Decolonnade Headless c a -> Decolonnade (Indexed Headless) c a-headlessToIndexed = go 0 where-  go :: forall b. Int -> Decolonnade Headless c b -> Decolonnade (Indexed Headless) c b-  go !ix (DecolonnadePure a) = DecolonnadePure a-  go !ix (DecolonnadeAp Headless decode apNext) =-    DecolonnadeAp (Indexed ix Headless) decode (go (ix + 1) apNext)--length :: forall f c a. Decolonnade f c a -> Int-length = go 0 where-  go :: forall b. Int -> Decolonnade f c b -> Int-  go !a (DecolonnadePure _) = a-  go !a (DecolonnadeAp _ _ apNext) = go (a + 1) apNext---- | Maps over a 'Decolonnade' that expects headers, converting these---   expected headers into the indices of the columns that they---   correspond to.-headedToIndexed :: forall content a. Eq content-                => Vector content -- ^ Headers in the source document-                -> Decolonnade Headed content a -- ^ Decolonnade that contains expected headers-                -> Either (HeadingErrors content) (Decolonnade (Indexed Headed) content a)-headedToIndexed v = getEitherWrap . go-  where-  go :: forall b. Eq content-     => Decolonnade Headed content b-     -> EitherWrap (HeadingErrors content) (Decolonnade (Indexed Headed) content b)-  go (DecolonnadePure b) = EitherWrap (Right (DecolonnadePure b))-  go (DecolonnadeAp hd@(Headed h) decode apNext) =-    let rnext = go apNext-        ixs = Vector.elemIndices h v-        ixsLen = Vector.length ixs-        rcurrent-          | ixsLen == 1 = Right (Vector.unsafeIndex ixs 0)-          | ixsLen == 0 = Left (HeadingErrors (Vector.singleton h) Vector.empty)-          | otherwise   = Left (HeadingErrors Vector.empty (Vector.singleton (h,ixsLen)))-    in (\ix ap -> DecolonnadeAp (Indexed ix hd) decode ap)-       <$> EitherWrap rcurrent-       <*> rnext---- | This adds one to the index because text editors consider---   line number to be one-based, not zero-based.-prettyError :: (c -> String) -> DecolonnadeRowError f c -> String-prettyError toStr (DecolonnadeRowError ix e) = unlines-  $ ("Decolonnade error on line " ++ show (ix + 1) ++ " of file.")-  : ("Error Category: " ++ descr)-  : map ("  " ++) errDescrs-  where (descr,errDescrs) = prettyRowError toStr e--prettyRowError :: (content -> String) -> RowError f content -> (String, [String])-prettyRowError toStr x = case x of-  RowErrorParse err -> (,) "CSV Parsing"-    [ "The line could not be parsed into cells correctly."-    , "Original parser error: " ++ err-    ]-  RowErrorSize reqLen actualLen -> (,) "Row Length"-    [ "Expected the row to have exactly " ++ show reqLen ++ " cells."-    , "The row only has " ++ show actualLen ++ " cells."-    ]-  RowErrorMinSize reqLen actualLen -> (,) "Row Min Length"-    [ "Expected the row to have at least " ++ show reqLen ++ " cells."-    , "The row only has " ++ show actualLen ++ " cells."-    ]-  RowErrorMalformed enc -> (,) "Text Decolonnade"-    [ "Tried to decode the input as " ++ enc ++ " text"-    , "There is a mistake in the encoding of the text."-    ]-  RowErrorHeading errs -> (,) "Header" (prettyHeadingErrors toStr errs)-  RowErrorDecode errs -> (,) "Cell Decolonnade" (prettyCellErrors toStr errs)--prettyCellErrors :: (c -> String) -> DecolonnadeCellErrors f c -> [String]-prettyCellErrors toStr (DecolonnadeCellErrors errs) = drop 1 $-  flip concatMap errs $ \(DecolonnadeCellError content (Indexed ix _) msg) ->-    let str = toStr content in-    [ "-----------"-    , "Column " ++ columnNumToLetters ix-    , "Original parse error: " ++ msg-    , "Cell Content Length: " ++ show (Prelude.length str)-    , "Cell Content: " ++ if null str-        then "[empty cell]"-        else str-    ]--prettyHeadingErrors :: (c -> String) -> HeadingErrors c -> [String]-prettyHeadingErrors conv (HeadingErrors missing duplicates) = concat-  [ concatMap (\h -> ["The header " ++ conv h ++ " was missing."]) missing-  , concatMap (\(h,n) -> ["The header " ++ conv h ++ " occurred " ++ show n ++ " times."]) duplicates-  ]--columnNumToLetters :: Int -> String-columnNumToLetters i-  | i >= 0 && i < 25 = [chr (i + 65)]-  | otherwise = "Beyond Z. Fix this."---

@@ -0,0 +1,152 @@+-- | Most users of this library do not need this module. The functions+--   here are used to build functions that apply a 'Colonnade'+--   to a collection of values, building a table from them. Ultimately, +--   a function that applies a @Colonnade Headed MyCell a@ +--   to data will have roughly the following type:+--+-- > myTableRenderer :: Foldable g => Colonnade Headed MyCell a -> g a -> MyContent+--+--   In the companion packages @yesod-colonnade@ and+--   @reflex-dom-colonnade@, functions with+--   similar type signatures are readily available.+--   These packages use the functions provided here+--   in the implementations of their rendering functions.+--   It is recommended that users who believe they may need+--   this module look at the source of the companion packages +--   to see an example of how this module\'s functions are used.+--   Other backends are encouraged to use these functions+--   to build monadic or monoidal content from a 'Colonnade'.+--+--   The functions exported here take a 'Colonnade' and +--   convert it to a fragment of content. The functions whose+--   names start with @row@ take at least a @Colonnade f c a@ and an @a@+--   value to generate a row of content. The functions whose names+--   start with @header@ need the @Colonnade f c a@ but not+--   an @a@ value since a value is not needed to build a header.+--   +module Colonnade.Encode+  ( row+  , rowMonadic+  , rowMonadic_+  , rowMonadicWith+  , rowMonoidal+  , header+  , headerMonadic+  , headerMonadic_+  , headerMonadicGeneral+  , headerMonadicGeneral_+  , headerMonoidalGeneral+  , bothMonadic_+  ) where++import Colonnade.Internal+import Data.Vector (Vector)+import Data.Foldable+import qualified Data.Vector as Vector++-- | Consider providing a variant the produces a list+-- instead. It may allow more things to get inlined+-- in to a loop.+row :: (c1 -> c2) -> Colonnade f c1 a -> a -> Vector c2+row g (Colonnade v) a = flip Vector.map v $+  \(OneColonnade _ encode) -> g (encode a)++bothMonadic_ :: Monad m+  => Colonnade Headed content a+  -> (content -> content -> m b)+  -> a+  -> m ()+bothMonadic_ (Colonnade v) g a =+  forM_ v $ \(OneColonnade (Headed h) encode) -> g h (encode a)++rowMonadic :: +  (Monad m, Monoid b)+  => Colonnade f content a+  -> (content -> m b)+  -> a+  -> m b+rowMonadic (Colonnade v) g a =+  flip foldlMapM v+  $ \e -> g (oneColonnadeEncode e a)++rowMonadic_ :: +     Monad m+  => Colonnade f content a+  -> (content -> m b)+  -> a+  -> m ()+rowMonadic_ (Colonnade v) g a =+  forM_ v $ \e -> g (oneColonnadeEncode e a)++rowMonoidal ::+     Monoid m+  => Colonnade h c a+  -> (c -> m)+  -> a+  -> m+rowMonoidal (Colonnade v) g a =+  foldMap (\e -> g (oneColonnadeEncode e a)) v++rowMonadicWith :: +  (Monad m)+  => b+  -> (b -> b -> b)+  -> Colonnade f content a+  -> (content -> m b)+  -> a+  -> m b+rowMonadicWith bempty bappend (Colonnade v) g a =+  foldlM (\bl e -> do+    br <- g (oneColonnadeEncode e a)+    return (bappend bl br)+  ) bempty v++header :: (c1 -> c2) -> Colonnade Headed c1 a -> Vector c2+header g (Colonnade v) =+  Vector.map (g . getHeaded . oneColonnadeHead) v++-- | This function is a helper for abusing 'Foldable' to optionally+--   render a header. Its future is uncertain.+headerMonadicGeneral :: (Monad m, Monoid b, Foldable h)+  => Colonnade h content a+  -> (content -> m b)+  -> m b+headerMonadicGeneral (Colonnade v) g = id+  $ fmap (mconcat . Vector.toList)+  $ Vector.mapM (foldlMapM g . oneColonnadeHead) v++headerMonadic :: +     (Monad m, Monoid b)+  => Colonnade Headed content a+  -> (content -> m b)+  -> m b+headerMonadic (Colonnade v) g =+  fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneColonnadeHead) v++headerMonadicGeneral_ :: +     (Monad m, Foldable h)+  => Colonnade h content a+  -> (content -> m b)+  -> m ()+headerMonadicGeneral_ (Colonnade v) g =+  Vector.mapM_ (mapM_ g . oneColonnadeHead) v++headerMonoidalGeneral ::+     (Monoid m, Foldable h)+  => Colonnade h c a+  -> (c -> m)+  -> m+headerMonoidalGeneral (Colonnade v) g =+  foldMap (foldMap g . oneColonnadeHead) v+  ++headerMonadic_ ::+     (Monad m)+  => Colonnade Headed content a+  -> (content -> m b)+  -> m ()+headerMonadic_ (Colonnade v) g = Vector.mapM_ (g . getHeaded . oneColonnadeHead) v++foldlMapM :: (Foldable t, Monoid b, Monad m) => (a -> m b) -> t a -> m b+foldlMapM f = foldlM (\b a -> fmap (mappend b) (f a)) mempty+

@@ -1,344 +0,0 @@--- | Build backend-agnostic columnar encodings that can be used to visualize data.--module Colonnade.Encoding-  ( -- * Example-    -- $setup-    -- * Create-    headed-  , headless-  , singleton-    -- * Transform-  , fromMaybe-  , columns-  , bool-  , replaceWhen-  , mapContent-    -- * Render-  , runRow-  , runRowMonadic-  , runRowMonadic_-  , runRowMonadicWith-  , runHeader-  , runHeaderMonadic-  , runHeaderMonadic_-  , runHeaderMonadicGeneral-  , runHeaderMonadicGeneral_-  , runBothMonadic_-    -- * Ascii Table-  , ascii-  ) where--import Colonnade.Types-import Data.Vector (Vector)-import Data.Foldable-import Data.Monoid (Endo(..))-import Control.Monad-import Data.Functor.Contravariant-import qualified Data.Bool-import qualified Data.Maybe-import qualified Data.List as List-import qualified Data.Vector as Vector-import qualified Colonnade.Internal as Internal---- $setup------ First, let\'s bring in some neccessary imports that will be--- used for the remainder of the examples in the docs:------ >>> import Data.Monoid (mconcat,(<>))--- >>> import Data.Functor.Contravariant (contramap)------ Assume that the data we wish to encode is:------ >>> data Color = Red | Green | Blue deriving (Show,Eq)--- >>> data Person = Person { name :: String, age :: Int }--- >>> data House = House { color :: Color, price :: Int }------ One potential columnar encoding of a @Person@ would be:------ >>> :{--- let encodingPerson :: Colonnade Headed String Person---     encodingPerson = mconcat---       [ headed "Name" name---       , headed "Age" (show . age)---       ]--- :}------ The type signature on @encodingPerson@ is not neccessary--- but is included for clarity. We can feed data into this encoding--- to build a table:------ >>> let people = [Person "David" 63, Person "Ava" 34, Person "Sonia" 12]--- >>> putStr (ascii encodingPerson people)--- +-------+-----+--- | Name  | Age |--- +-------+-----+--- | David | 63  |--- | Ava   | 34  |--- | Sonia | 12  |--- +-------+-----+------ Similarly, we can build a table of houses with:------ >>> let showDollar = (('$':) . show) :: Int -> String--- >>> :{--- let encodingHouse :: Colonnade Headed String House---     encodingHouse = mconcat---       [ headed "Color" (show . color)---       , headed "Price" (showDollar . price)---       ]--- :}------ >>> let houses = [House Green 170000, House Blue 115000, House Green 150000]--- >>> putStr (ascii encodingHouse houses)--- +-------+---------+--- | Color | Price   |--- +-------+---------+--- | Green | $170000 |--- | Blue  | $115000 |--- | Green | $150000 |--- +-------+---------+----- | A single column with a header.-headed :: c -> (a -> c) -> Colonnade Headed c a-headed h = singleton (Headed h)---- | A single column without a header.-headless :: (a -> c) -> Colonnade Headless c a-headless = singleton Headless---- | A single column with any kind of header. This is not typically needed.-singleton :: f c -> (a -> c) -> Colonnade f c a-singleton h = Colonnade . Vector.singleton . OneColonnade h---- | 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:------ >>> :{--- >>> let owners :: [(Person,Maybe House)]--- >>>     owners =--- >>>       [ (Person "Jordan" 18, Nothing)--- >>>       , (Person "Ruth" 25, Just (House Red 125000))--- >>>       , (Person "Sonia" 12, Just (House Green 145000))--- >>>       ]--- >>> :}------ The column encodings defined earlier can be reused with--- the help of 'fromMaybe':------ >>> :{--- >>> let encodingOwners :: Colonnade Headed String (Person,Maybe House)--- >>>     encodingOwners = mconcat--- >>>       [ contramap fst encodingPerson--- >>>       , contramap snd (fromMaybe "" encodingHouse)--- >>>       ]--- >>> :}------ >>> putStr (ascii encodingOwners owners)--- +--------+-----+-------+---------+--- | Name   | Age | Color | Price   |--- +--------+-----+-------+---------+--- | Jordan | 18  |       |         |--- | Ruth   | 25  | Red   | $125000 |--- | Sonia  | 12  | Green | $145000 |--- +--------+-----+-------+---------+-fromMaybe :: c -> Colonnade f c a -> Colonnade f c (Maybe a)-fromMaybe c (Colonnade v) = Colonnade $ flip Vector.map v $-  \(OneColonnade h encode) -> OneColonnade h (maybe c encode)---- | Convert a collection of @b@ values into a columnar encoding of---   the same size. Suppose we decide to show a house\'s color---   by putting a check mark in the column corresponding to---   the color instead of by writing out the name of the color:------ >>> let allColors = [Red,Green,Blue]--- >>> let encColor = columns (\c1 c2 -> if c1 == c2 then "✓" else "") (Headed . show) allColors--- >>> :t encColor--- encColor :: Colonnade Headed [Char] Color--- >>> let encHouse = headed "Price" (showDollar . price) <> contramap color encColor--- >>> :t encHouse--- encHouse :: Colonnade Headed [Char] House--- >>> putStr (ascii encHouse houses)--- +---------+-----+-------+------+--- | Price   | Red | Green | Blue |--- +---------+-----+-------+------+--- | $170000 |     | ✓     |      |--- | $115000 |     |       | ✓    |--- | $150000 |     | ✓     |      |--- +---------+-----+-------+------+-columns :: Foldable g-  => (b -> a -> c) -- ^ Cell content function-  -> (b -> f c) -- ^ Header content function-  -> g b -- ^ Basis for column encodings-  -> Colonnade f c a-columns getCell getHeader = id-  . Colonnade-  . Vector.map (\b -> OneColonnade (getHeader b) (getCell b))-  . Vector.fromList-  . toList--bool ::-     f c -- ^ Heading-  -> (a -> Bool) -- ^ Predicate-  -> (a -> c) -- ^ Contents when predicate is false-  -> (a -> c) -- ^ Contents when predicate is true-  -> Colonnade f c a-bool h p onTrue onFalse = singleton h (Data.Bool.bool <$> onFalse <*> onTrue <*> p)--replaceWhen ::-     c-  -> (a -> Bool)-  -> Colonnade f c a-  -> Colonnade f c a-replaceWhen newContent p (Colonnade v) = Colonnade-  ( Vector.map-    (\(OneColonnade h encode) -> OneColonnade h $ \a ->-      if p a then newContent else encode a-    ) v-  )---- | 'Colonnade' is covariant in its content type. Consequently, it can be---   mapped over. There is no standard typeclass for types that are covariant---   in their second-to-last argument, so this function is provided for---   situations that require this.-mapContent :: Functor f => (c1 -> c2) -> Colonnade f c1 a -> Colonnade f c2 a-mapContent f (Colonnade v) = Colonnade-  $ Vector.map (\(OneColonnade h c) -> (OneColonnade (fmap f h) (f . c))) v---- | Consider providing a variant the produces a list--- instead. It may allow more things to get inlined--- in to a loop.-runRow :: (c1 -> c2) -> Colonnade f c1 a -> a -> Vector c2-runRow g (Colonnade v) a = flip Vector.map v $-  \(OneColonnade _ encode) -> g (encode a)--runBothMonadic_ :: Monad m-  => Colonnade Headed content a-  -> (content -> content -> m b)-  -> a-  -> m ()-runBothMonadic_ (Colonnade v) g a =-  forM_ v $ \(OneColonnade (Headed h) encode) -> g h (encode a)--runRowMonadic :: (Monad m, Monoid b)-              => Colonnade f content a-              -> (content -> m b)-              -> a-              -> m b-runRowMonadic (Colonnade v) g a =-  flip Internal.foldlMapM v-  $ \e -> g (oneColonnadeEncode e a)--runRowMonadic_ :: Monad m-  => Colonnade f content a-  -> (content -> m b)-  -> a-  -> m ()-runRowMonadic_ (Colonnade v) g a =-  forM_ v $ \e -> g (oneColonnadeEncode e a)--runRowMonadicWith :: (Monad m)-              => b-              -> (b -> b -> b)-              -> Colonnade f content a-              -> (content -> m b)-              -> a-              -> m b-runRowMonadicWith bempty bappend (Colonnade v) g a =-  foldlM (\bl e -> do-    br <- g (oneColonnadeEncode e a)-    return (bappend bl br)-  ) bempty v--runHeader :: (c1 -> c2) -> Colonnade Headed c1 a -> Vector c2-runHeader g (Colonnade v) =-  Vector.map (g . getHeaded . oneColonnadeHead) v---- | This function is a helper for abusing 'Foldable' to optionally---   render a header. Its future is uncertain.-runHeaderMonadicGeneral :: (Monad m, Monoid b, Foldable h)-  => Colonnade h content a-  -> (content -> m b)-  -> m b-runHeaderMonadicGeneral (Colonnade v) g = id-  $ fmap (mconcat . Vector.toList)-  $ Vector.mapM (Internal.foldlMapM g . oneColonnadeHead) v--runHeaderMonadic :: (Monad m, Monoid b)-                 => Colonnade Headed content a-                 -> (content -> m b)-                 -> m b-runHeaderMonadic (Colonnade v) g =-  fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneColonnadeHead) v--runHeaderMonadicGeneral_ :: (Monad m, Monoid b, Foldable h)-  => Colonnade h content a-  -> (content -> m b)-  -> m ()-runHeaderMonadicGeneral_ (Colonnade v) g =-  Vector.mapM_ (Internal.foldlMapM g . oneColonnadeHead) v--runHeaderMonadic_ ::-     (Monad m)-  => Colonnade Headed content a-  -> (content -> m b)-  -> m ()-runHeaderMonadic_ (Colonnade v) g = Vector.mapM_ (g . getHeaded . oneColonnadeHead) v---- | Render a collection of rows as an ascii table. The table\'s columns are--- specified by the given 'Colonnade'. This implementation is inefficient and--- does not provide any wrapping behavior. It is provided so that users can--- try out @colonnade@ in ghci and so that @doctest@ can verify examples--- code in the haddocks.-ascii :: Foldable f-  => Colonnade Headed String a -- ^ columnar encoding-  -> f a -- ^ rows-  -> String-ascii enc xs =-  let theHeader :: [(Int,String)]-      theHeader = (zip (enumFrom 0) . map (\s -> " " ++ s ++ " ")) (toList (runHeader id enc))-      theBody :: [[(Int,String)]]-      theBody = map (zip (enumFrom 0) . map (\s -> " " ++ s ++ " ") . toList . runRow id enc) (toList xs)-      sizes :: [Int]-      sizes = ($ replicate (length theHeader) 1) $ appEndo $ mconcat-        [ foldMap (\(i,str) -> Endo (replaceAt i (length str))) theHeader-        , (foldMap . foldMap) (\(i,str) -> Endo (replaceAt i (length str))) theBody-        ]-      paddedHeader :: [String]-      paddedHeader = map (\(i,str) -> rightPad (atDef 1 sizes i) ' ' str) theHeader-      paddedBody :: [[String]]-      paddedBody = (map . map) (\(i,str) -> rightPad (atDef 1 sizes i) ' ' str) theBody-      divider :: String-      divider = "+" ++ join (List.intersperse "+" (map (\i -> replicate i '-') sizes)) ++ "+"-      headerStr :: String-      headerStr = "|" ++ join (List.intersperse "|" paddedHeader) ++ "|"-      bodyStr :: String-      bodyStr = List.unlines (map ((\s -> "|" ++ s ++ "|") . join . List.intersperse "|") paddedBody)-   in divider ++ "\n" ++ headerStr-              ++ "\n" ++ divider-              ++ "\n" ++ bodyStr ++ divider ++ "\n"----- this has no effect if the index is out of bounds-replaceAt :: Ord a => Int -> a -> [a] -> [a]-replaceAt _ _ [] = []-replaceAt n v (a:as) = if n > 0-  then a : replaceAt (n - 1) v as-  else (max v a) : as--rightPad :: Int -> a -> [a] -> [a]-rightPad m a xs = take m $ xs ++ repeat a--atDef :: a -> [a] -> Int -> a-atDef def = Data.Maybe.fromMaybe def .^ atMay where-  (.^) f g x1 x2 = f (g x1 x2)-  atMay = eitherToMaybe .^ at_-  eitherToMaybe = either (const Nothing) Just-  at_ xs o | o < 0 = Left $ "index must not be negative, index=" ++ show o-           | otherwise = f o xs-      where f 0 (z:_) = Right z-            f i (_:zs) = f (i-1) zs-            f i [] = Left $ "index too large, index=" ++ show o ++ ", length=" ++ show (o-i)-

@@ -1,23 +1,98 @@-{-# LANGUAGE DeriveFunctor #-}-module Colonnade.Internal where+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE DeriveFoldable             #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} -import Data.Foldable (foldrM,foldlM)+{-# OPTIONS_HADDOCK not-home #-} -newtype EitherWrap a b = EitherWrap-  { getEitherWrap :: Either a b-  } deriving (Functor)+module Colonnade.Internal+  ( Colonnade(..)+  , OneColonnade(..)+  , Headed(..)+  , Headless(..)+  ) where -instance Monoid a => Applicative (EitherWrap a) where-  pure = EitherWrap . Right-  EitherWrap (Left a1) <*> EitherWrap (Left a2) = EitherWrap (Left (mappend a1 a2))-  EitherWrap (Left a1) <*> EitherWrap (Right _) = EitherWrap (Left a1)-  EitherWrap (Right _) <*> EitherWrap (Left a2) = EitherWrap (Left a2)-  EitherWrap (Right f) <*> EitherWrap (Right b) = EitherWrap (Right (f b))+import Data.Vector (Vector)+import Data.Functor.Contravariant (Contravariant(..))+import Data.Functor.Contravariant.Divisible (Divisible(..))+import Control.Exception (Exception)+import Data.Typeable (Typeable)+import qualified Data.Vector as Vector -mapLeft :: (a -> b) -> Either a c -> Either b c-mapLeft _ (Right a) = Right a-mapLeft f (Left a) = Left (f a)+-- | As the first argument to the 'Colonnade' type +--   constructor, this indictates that the columnar encoding has +--   a header. This type is isomorphic to 'Identity' but is +--   given a new name to clarify its intent:+--+-- > example :: Colonnade Headed Text Foo+--+--   The term @example@ represents a columnar encoding of @Foo@+--   in which the columns have headings.+newtype Headed a = Headed { getHeaded :: a }+  deriving (Eq,Ord,Functor,Show,Read,Foldable) -foldlMapM :: (Foldable t, Monoid b, Monad m) => (a -> m b) -> t a -> m b-foldlMapM f = foldlM (\b a -> fmap (mappend b) (f a)) mempty+-- | As the first argument to the 'Colonnade' type +--   constructor, this indictates that the columnar encoding does not have +--   a header. This type is isomorphic to 'Proxy' but is +--   given a new name to clarify its intent:+--+-- > example :: Colonnade Headless Text Foo+--+--   The term @example@ represents a columnar encoding of @Foo@+--   in which the columns do not have headings.+data Headless a = Headless+  deriving (Eq,Ord,Functor,Show,Read,Foldable)++instance Contravariant Headless where+  contramap _ Headless = Headless++-- | Encodes a header and a cell.+data OneColonnade h content a = OneColonnade+  { oneColonnadeHead   :: !(h content)+  , oneColonnadeEncode :: !(a -> content)+  }++instance Contravariant (OneColonnade h content) where+  contramap f (OneColonnade h e) = OneColonnade h (e . f)++-- | An columnar encoding of @a@. The type variable @h@ determines what+--   is present in each column in the header row. It is typically instantiated+--   to 'Headed' and occasionally to 'Headless'. There is nothing that+--   restricts it to these two types, although they satisfy the majority+--   of use cases. The type variable @c@ is the content type. This can+--   be @Text@, @String@, or @ByteString@. In the companion libraries+--   @reflex-dom-colonnade@ and @yesod-colonnade@, additional types+--   that represent HTML with element attributes are provided that serve+--   as the content type. Presented more visually:+--+-- >             +---- Content (Text, ByteString, Html, etc.)+-- >             |+-- >             v+-- > Colonnade h c a+-- >           ^   ^+-- >           |   |+-- >           |   +-- Value consumed to build a row+-- >           |+-- >           +------ Headedness (Headed or Headless)+--+--   Internally, a 'Colonnade' is represented as a 'Vector' of individual+--   column encodings. It is possible to use any collection type with+--   'Alternative' and 'Foldable' instances. However, 'Vector' was chosen to+--   optimize the data structure for the use case of building the structure+--   once and then folding over it many times. It is recommended that+--   'Colonnade's are defined at the top-level so that GHC avoids reconstructing+--   them every time they are used.+newtype Colonnade h c a = Colonnade+  { getColonnade :: Vector (OneColonnade h c a)+  } deriving (Monoid)++instance Contravariant (Colonnade h content) where+  contramap f (Colonnade v) = Colonnade+    (Vector.map (contramap f) v)++instance Divisible (Colonnade h content) where+  conquer = Colonnade Vector.empty+  divide f (Colonnade a) (Colonnade b) =+    Colonnade $ (Vector.++)+      (Vector.map (contramap (fst . f)) a)+      (Vector.map (contramap (snd . f)) b) 

@@ -1,152 +0,0 @@-{-# LANGUAGE DeriveFunctor              #-}-{-# LANGUAGE DeriveFoldable             #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE GADTs                      #-}-module Colonnade.Types-  ( Colonnade(..)-  , Decolonnade(..)-  , OneColonnade(..)-  , Headed(..)-  , Headless(..)-  , Indexed(..)-  , HeadingErrors(..)-  , DecolonnadeCellError(..)-  , DecolonnadeRowError(..)-  , DecolonnadeCellErrors(..)-  , RowError(..)-  ) where--import Data.Vector (Vector)-import Data.Functor.Contravariant (Contravariant(..))-import Data.Functor.Contravariant.Divisible (Divisible(..))-import Control.Exception (Exception)-import Data.Typeable (Typeable)-import qualified Data.Vector as Vector---- | This type is isomorphic to 'Identity'.-newtype Headed a = Headed { getHeaded :: a }-  deriving (Eq,Ord,Functor,Show,Read,Foldable)---- | This type is isomorphic to 'Proxy'-data Headless a = Headless-  deriving (Eq,Ord,Functor,Show,Read,Foldable)--data Indexed f a = Indexed-  { indexedIndex :: !Int-  , indexedHeading :: !(f a)-  } deriving (Eq,Ord,Functor,Show,Read)--data HeadingErrors content = HeadingErrors-  { headingErrorsMissing   :: Vector content       -- ^ headers that were missing-  , headingErrorsDuplicate :: Vector (content,Int) -- ^ headers that occurred more than once-  } deriving (Show,Read,Eq)--instance (Show content, Typeable content) => Exception (HeadingErrors content)--instance Monoid (HeadingErrors content) where-  mempty = HeadingErrors Vector.empty Vector.empty-  mappend (HeadingErrors a1 b1) (HeadingErrors a2 b2) = HeadingErrors-    (a1 Vector.++ a2) (b1 Vector.++ b2)--data DecolonnadeCellError f content = DecolonnadeCellError-  { decodingCellErrorContent :: !content-  , decodingCellErrorHeader  :: !(Indexed f content)-  , decodingCellErrorMessage :: !String-  } deriving (Show,Read,Eq)---- instance (Show (f content), Typeable content) => Exception (DecolonnadeError f content)--newtype DecolonnadeCellErrors f content = DecolonnadeCellErrors-  { getDecolonnadeCellErrors :: Vector (DecolonnadeCellError f content)-  } deriving (Monoid,Show,Read,Eq)---- newtype ParseRowError = ParseRowError String---- TODO: rewrite the instances for this by hand. They--- currently use FlexibleContexts.-data DecolonnadeRowError f content = DecolonnadeRowError-  { decodingRowErrorRow   :: !Int-  , decodingRowErrorError :: !(RowError f content)-  } deriving (Show,Read,Eq)---- TODO: rewrite the instances for this by hand. They--- currently use FlexibleContexts.-data RowError f content-  = RowErrorParse !String -- ^ Error occurred parsing the document into cells-  | RowErrorDecode !(DecolonnadeCellErrors f content) -- ^ Error decoding the content-  | RowErrorSize !Int !Int -- ^ Wrong number of cells in the row-  | RowErrorHeading !(HeadingErrors content)-  | RowErrorMinSize !Int !Int-  | RowErrorMalformed !String -- ^ Error decoding unicode content-  deriving (Show,Read,Eq)---- instance (Show (f content), Typeable content) => Exception (DecolonnadeErrors f content)--instance Contravariant Headless where-  contramap _ Headless = Headless---- | This just actually a specialization of the free applicative.---   Check out @Control.Applicative.Free@ in the @free@ library to---   learn more about this. The meanings of the fields are documented---   slightly more in the source code. Unfortunately, haddock does not---   play nicely with GADTs.-data Decolonnade f content a where-  DecolonnadePure :: !a -- function-               -> Decolonnade f content a-  DecolonnadeAp :: !(f content) -- header-             -> !(content -> Either String a) -- decoding function-             -> !(Decolonnade f content (a -> b)) -- next decoding-             -> Decolonnade f content b--instance Functor (Decolonnade f content) where-  fmap f (DecolonnadePure a) = DecolonnadePure (f a)-  fmap f (DecolonnadeAp h c apNext) = DecolonnadeAp h c ((f .) <$> apNext)--instance Applicative (Decolonnade f content) where-  pure = DecolonnadePure-  DecolonnadePure f <*> y = fmap f y-  DecolonnadeAp h c y <*> z = DecolonnadeAp h c (flip <$> y <*> z)---- | Encodes a header and a cell.-data OneColonnade f content a = OneColonnade-  { oneColonnadeHead   :: !(f content)-  , oneColonnadeEncode :: !(a -> content)-  }--instance Contravariant (OneColonnade f content) where-  contramap f (OneColonnade h e) = OneColonnade h (e . f)---- | An columnar encoding of @a@. The type variable @f@ determines what---   is present in each column in the header row. It is typically instantiated---   to 'Headed' and occasionally to 'Headless'. There is nothing that---   restricts it to these two types, although they satisfy the majority---   of use cases. The type variable @c@ is the content type. This can---   be @Text@, @String@, or @ByteString@. In the companion libraries---   @reflex-dom-colonnade@ and @yesod-colonnade@, additional types---   that represent HTML with element attributes are provided that serve---   as the content type.------   Internally, a 'Colonnade' is represented as a 'Vector' of individual---   column encodings. It is possible to use any collection type with---   'Alternative' and 'Foldable' instances. However, 'Vector' was chosen to---   optimize the data structure for the use case of building the structure---   once and then folding over it many times. It is recommended that---   'Colonnade's are defined at the top-level so that GHC avoid reconstructing---   them every time they are used.-newtype Colonnade f c a = Colonnade-  { getColonnade :: Vector (OneColonnade f c a)-  } deriving (Monoid)--instance Contravariant (Colonnade f content) where-  contramap f (Colonnade v) = Colonnade-    (Vector.map (contramap f) v)--instance Divisible (Colonnade f content) where-  conquer = Colonnade Vector.empty-  divide f (Colonnade a) (Colonnade b) =-    Colonnade $ (Vector.++)-      (Vector.map (contramap (fst . f)) a)-      (Vector.map (contramap (snd . f)) b)-      -- (Vector.map (\(OneEncoding h c) -> (h,c . fst . f)) a)-      -- (Vector.map (\(OneEncoding h c) -> (h,c . snd . f)) b)-

@@ -2,5 +2,5 @@  main :: IO () main = doctest-  [ "src/Colonnade/Encoding.hs"+  [ "src/Colonnade.hs"   ]