work in progress

colonnade/colonnade.cabal

@@ -28,9 +28,8 @@ cabal-version:       >=1.10
 library
   hs-source-dirs:      src
   exposed-modules:
-    Colonnade.Types
+    Colonnade
-    Colonnade.Encoding
+    Colonnade.Internal
-    Colonnade.Decoding
   build-depends:
       base >= 4.7 && < 5
     , contravariant >= 1.2 && < 1.5

colonnade/src/Colonnade.hs

@@ -0,0 +1,361 @@
+-- | 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
+  , mapContent
+    -- * Render
+    -- $render
+  , runRow
+  , runRowMonadic
+  , runRowMonadic_
+  , runRowMonadicWith
+  , runHeader
+  , runHeaderMonadic
+  , runHeaderMonadic_
+  , runHeaderMonadicGeneral
+  , runHeaderMonadicGeneral_
+  , runBothMonadic_
+    -- * Ascii Table
+  , ascii
+  ) where
+
+import Colonnade.Internal
+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)
+--
+-- 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
+
+-- $render
+--
+-- The rendering functions, which by convention begin with
+-- the word @run@, are provided as a convenience for for
+-- apply a columnar encoding.
+
+
+
+-- | 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 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 (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_ (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)
+
+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
+
+
+

colonnade/src/Colonnade/Encoding.hs

@@ -1,347 +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
-
--- $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 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 (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_ (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)
-
-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
-
-

colonnade/src/Colonnade/Internal.hs

@@ -0,0 +1,90 @@
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE DeriveFoldable             #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+{-# OPTIONS_HADDOCK not-home #-}
+
+module Colonnade.Internal
+  ( Colonnade(..)
+  , OneColonnade(..)
+  , Headed(..)
+  , Headless(..)
+  ) 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
+
+-- | 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)
+
+-- | 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 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 avoids 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)
+

colonnade/test/Main.hs

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