diff --git a/colonnade/colonnade.cabal b/colonnade/colonnade.cabal index cdd3a1f..89957d9 100644 --- a/colonnade/colonnade.cabal +++ b/colonnade/colonnade.cabal @@ -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 diff --git a/colonnade/examples/ex1.hs b/colonnade/examples/ex1.hs new file mode 100644 index 0000000..9b375e5 --- /dev/null +++ b/colonnade/examples/ex1.hs @@ -0,0 +1,63 @@ +import Colonnade.Encoding +import Colonnade.Types +import Data.Functor.Contravariant + +data Color = Red | Green | Blue deriving (Show) +data Person = Person { personName :: String, personAge :: Int } +data House = House { houseColor :: Color, housePrice :: Int } + +encodingPerson :: Encoding Headed String Person +encodingPerson = mconcat + [ headed "Name" personName + , headed "Age" (show . personAge) + ] + +encodingHouse :: Encoding Headed String House +encodingHouse = mconcat + [ headed "Color" (show . houseColor) + , headed "Price" (('$':) . show . housePrice) + ] + +encodingPerson2 :: Encoding Headless String Person +encodingPerson2 = mconcat + [ headless personName + , headless (show . personAge) + ] + +people :: [Person] +people = [Person "David" 63, Person "Ava" 34, Person "Sonia" 12] + +houses :: [House] +houses = [House Green 170000, House Blue 115000] + +peopleInHouses :: [(Person,House)] +peopleInHouses = (,) <$> people <*> houses + +encodingPersonHouse :: Encoding Headed String (Person,House) +encodingPersonHouse = mconcat + [ contramap fst encodingPerson + , contramap snd encodingHouse + ] + +owners :: [(Person,Maybe House)] +owners = + [ (Person "Jordan" 18, Nothing) + , (Person "Ruth" 25, Just (House Red 125000)) + , (Person "Sonia" 12, Just (House Green 145000)) + ] + +encodingOwners :: Encoding Headed String (Person,Maybe House) +encodingOwners = mconcat + [ contramap fst encodingPerson + , contramap snd (fromMaybe "(none)" encodingHouse) + ] + +main :: IO () +main = do + putStr $ ascii encodingPerson people + putStrLn "" + putStr $ ascii encodingHouse houses + putStrLn "" + putStr $ ascii encodingOwners owners + putStrLn "" + diff --git a/colonnade/src/Colonnade/Encoding.hs b/colonnade/src/Colonnade/Encoding.hs index 8aa1a5c..b764df2 100644 --- a/colonnade/src/Colonnade/Encoding.hs +++ b/colonnade/src/Colonnade/Encoding.hs @@ -1,6 +1,5 @@ -- | Build backend-agnostic columnar encodings that can be used to visualize data. - module Colonnade.Encoding ( -- * Example -- $setup @@ -10,6 +9,8 @@ module Colonnade.Encoding -- * Transform , fromMaybe , columns + , bool + , replaceWhen , mapContent -- * Render , runRow @@ -32,6 +33,7 @@ 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 @@ -39,19 +41,25 @@ 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) --- >>> data Person = Person { personName :: String, personAge :: Int } --- >>> data House = House { houseColor :: Color, housePrice :: Int } +-- >>> 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" personName --- , headed "Age" (show . personAge) +-- [ headed "Name" name +-- , headed "Age" (show . age) -- ] -- :} -- @@ -60,7 +68,7 @@ import qualified Colonnade.Internal as Internal -- to build a table: -- -- >>> let people = [Person "David" 63, Person "Ava" 34, Person "Sonia" 12] --- >>> putStr $ ascii encodingPerson people +-- >>> putStr (ascii encodingPerson people) -- +-------+-----+ -- | Name | Age | -- +-------+-----+ @@ -71,31 +79,37 @@ import qualified Colonnade.Internal as Internal -- -- 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 . houseColor) --- , headed "Price" (('$':) . show . housePrice) +-- [ headed "Color" (show . color) +-- , headed "Price" (showDollar . price) -- ] -- :} -- --- >>> let houses = [House Green 170000, House Blue 115000] --- >>> putStr $ ascii encodingHouse houses +-- >>> let houses = [House Green 170000, House Blue 115000, House Green 150000] +-- >>> putStr (ascii encodingHouse houses) -- +-------+---------+ -- | Color | Price | -- +-------+---------+ -- | Green | $170000 | -- | Blue | $115000 | +-- | Green | $150000 | -- +-------+---------+ --- | A column with a header. -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) --- | A column without a header. -headless :: (a -> content) -> Encoding Headless content a -headless f = Encoding (Vector.singleton (OneEncoding Headless f)) +-- | 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 @@ -121,7 +135,7 @@ headless f = Encoding (Vector.singleton (OneEncoding Headless f)) -- >>> ] -- >>> :} -- --- >>> putStr $ ascii encodingOwners owners +-- >>> putStr (ascii encodingOwners owners) -- +--------+-----+-------+---------+ -- | Name | Age | Color | Price | -- +--------+-----+-------+---------+ @@ -133,18 +147,61 @@ 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 'Vector' of @b@ values into a columnar encoding of --- the same size. -columns :: (b -> a -> c) -- ^ Cell content function - -> (b -> f c) -- ^ Header content function - -> Vector b -- ^ Basis for column encodings - -> Encoding f c a -columns getCell getHeader bs = - Encoding $ Vector.map (\b -> OneEncoding (getHeader b) (getCell b)) bs +-- | 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) --- | Technically, 'Encoding' is a @Bifunctor@. This maps covariantly over the --- content type. The instance will be added once GHC8 has its next release. +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 diff --git a/colonnade/src/Colonnade/Types.hs b/colonnade/src/Colonnade/Types.hs index 628cda0..8e7d0ac 100644 --- a/colonnade/src/Colonnade/Types.hs +++ b/colonnade/src/Colonnade/Types.hs @@ -23,11 +23,11 @@ import Control.Exception (Exception) 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 @@ data OneEncoding f content a = OneEncoding 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 diff --git a/colonnade/test/Main.hs b/colonnade/test/Main.hs index 9e51547..4da1ab0 100644 --- a/colonnade/test/Main.hs +++ b/colonnade/test/Main.hs @@ -1,4 +1,6 @@ import Test.DocTest main :: IO () -main = doctest ["src/Colonnade/Encoding.hs"] +main = doctest + [ "src/Colonnade/Encoding.hs" + ]