colonnade 0.4.6 → 0.4.7

raw patch · 4 files changed

+287/−24 lines, 4 filesdep +colonnadedep +doctestdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: colonnade, doctest

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• colonnade.cabal +12/−1
• src/Colonnade/Encoding.hs +248/−19
• src/Colonnade/Types.hs +21/−4
• test/Main.hs +6/−0

@@ -1,5 +1,5 @@ name:                colonnade-version:             0.4.6+version:             0.4.7 synopsis:            Generic types and functions for columnar encoding and decoding description:         Please see README.md homepage:            https://github.com/andrewthad/colonnade#readme@@ -30,6 +30,17 @@     , text >= 1.0 && < 1.3     , bytestring >= 0.10 && < 0.11   default-language:    Haskell2010+  ghc-options: -Wall++test-suite test+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  main-is:          Main.hs+  build-depends:+      base >= 4.7 && <= 5+    , colonnade+    , doctest+  default-language: Haskell2010  source-repository head   type:     git

@@ -1,24 +1,211 @@-module Colonnade.Encoding where+-- | Build backend-agnostic columnar encodings that can be used to visualize data. +module Colonnade.Encoding+  ( -- * Example+    -- $setup+    -- * Create+    headed+  , headless+    -- * 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 -mapContent :: Functor f => (c1 -> c2) -> Encoding f c1 a -> Encoding f c2 a-mapContent f (Encoding v) = Encoding-  $ Vector.map (\(OneEncoding h c) -> (OneEncoding (fmap f h) (f . c))) v+-- $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 :: Encoding Headed String Person+--     encodingPerson = mconcat+--       [ headed "Name" name+--       , headed "Age" (show . age)+--       ]+-- :}+--+-- The type signature on @basicPersonEncoding@ 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 :: Encoding 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 |+-- +-------+---------+ -headless :: (a -> content) -> Encoding Headless content a-headless f = Encoding (Vector.singleton (OneEncoding Headless f)) -headed :: content -> (a -> content) -> Encoding Headed content a-headed h f = Encoding (Vector.singleton (OneEncoding (Headed h) f))+-- | A single column with a header.+headed :: c -> (a -> c) -> Encoding Headed c a+headed h = singleton (Headed h) --- runRow' :: Encoding f content a -> a -> Vector content--- runRow' = runRow id+-- | A single column without a header.+headless :: (a -> c) -> Encoding Headless c a+headless = singleton Headless +-- | A single column with any kind of header. This is not typically needed.+singleton :: f c -> (a -> c) -> Encoding f c a+singleton h = Encoding . Vector.singleton . OneEncoding 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 :: Encoding 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 -> Encoding f c a -> Encoding f c (Maybe a)+fromMaybe c (Encoding v) = Encoding $ flip Vector.map v $+  \(OneEncoding h encode) -> OneEncoding 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 :: Encoding Headed [Char] Color+-- >>> let encHouse = headed "Price" (showDollar . price) <> contramap color encColor+-- >>> :t encHouse+-- encHouse :: Encoding 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+  -> Encoding f c a+columns getCell getHeader = id+  . Encoding+  . Vector.map (\b -> OneEncoding (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+  -> Encoding f c a+bool h p onTrue onFalse = singleton h (Data.Bool.bool <$> onFalse <*> onTrue <*> p)++replaceWhen ::+     c+  -> (a -> Bool)+  -> Encoding f c a+  -> Encoding f c a+replaceWhen newContent p (Encoding v) = Encoding+  ( Vector.map+    (\(OneEncoding h encode) -> OneEncoding h $ \a ->+      if p a then newContent else encode a+    ) v+  )++-- | 'Encoding' 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) -> Encoding f c1 a -> Encoding f c2 a+mapContent f (Encoding v) = Encoding+  $ Vector.map (\(OneEncoding h c) -> (OneEncoding (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.@@ -99,16 +286,58 @@   -> m () runHeaderMonadic_ (Encoding v) g = Vector.mapM_ (g . getHeaded . oneEncodingHead) v -fromMaybe :: c -> Encoding f c a -> Encoding f c (Maybe a)-fromMaybe c (Encoding v) = Encoding $ flip Vector.map v $-  \(OneEncoding h encode) -> OneEncoding h (maybe c encode)+-- | Render a collection of rows as an ascii table. The table\'s columns are+-- specified by the given 'Encoding'. 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+  => Encoding 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" -columns :: (b -> a -> c)-        -> (b -> f c)-        -> Vector b-        -> Encoding f c a-columns getCell getHeader bs =-  Encoding $ Vector.map (\b -> OneEncoding (getHeader b) (getCell b)) bs +-- 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) 

@@ -23,11 +23,11 @@ import Data.Typeable (Typeable) import qualified Data.Vector as Vector --- | Isomorphic to 'Identity'+-- | This type is isomorphic to 'Identity'. newtype Headed a = Headed { getHeaded :: a }   deriving (Eq,Ord,Functor,Show,Read,Foldable) --- | Isomorphic to 'Proxy'+-- | This type is isomorphic to 'Proxy' data Headless a = Headless   deriving (Eq,Ord,Functor,Show,Read,Foldable) @@ -116,8 +116,25 @@ instance Contravariant (OneEncoding f content) where   contramap f (OneEncoding h e) = OneEncoding h (e . f) -newtype Encoding f content a = Encoding-  { getEncoding :: Vector (OneEncoding f content a)+-- | 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, an 'Encoding' 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+--   'Encoding's are defined at the top-level so that GHC avoid reconstructing+--   them every time they are used.+newtype Encoding f c a = Encoding+  { getEncoding :: Vector (OneEncoding f c a)   } deriving (Monoid)  instance Contravariant (Encoding f content) where

@@ -0,0 +1,6 @@+import Test.DocTest++main :: IO ()+main = doctest+  [ "src/Colonnade/Encoding.hs"+  ]