From 2941f7d92ae519be71248d808aa909297759d8a5 Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Thu, 20 Oct 2016 17:10:19 -0400
Subject: [PATCH] improve documentation for core library

---
 colonnade/colonnade.cabal                     |  21 +-
 colonnade/src/Colonnade/Encoding.hs           | 208 ++++++++++++++++--
 colonnade/test/Main.hs                        |   4 +
 .../reflex-dom-colonnade.cabal                |  16 +-
 yesod-colonnade/yesod-colonnade.cabal         |   6 +-
 5 files changed, 221 insertions(+), 34 deletions(-)
 create mode 100644 colonnade/test/Main.hs

diff --git a/colonnade/colonnade.cabal b/colonnade/colonnade.cabal
index 05de72b..cdd3a1f 100644
--- a/colonnade/colonnade.cabal
+++ b/colonnade/colonnade.cabal
@@ -1,5 +1,5 @@
 name:                colonnade
-version:             0.4.5
+version:             0.4.6
 synopsis:            Generic types and functions for columnar encoding and decoding
 description:         Please see README.md
 homepage:            https://github.com/andrewthad/colonnade#readme
@@ -25,11 +25,22 @@ library
     Colonnade.Internal
   build-depends:
       base >= 4.7 && < 5
-    , contravariant
-    , vector
-    , text
-    , bytestring
+    , contravariant >= 1.2 && < 1.5
+    , vector >= 0.10 && < 0.12
+    , 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
diff --git a/colonnade/src/Colonnade/Encoding.hs b/colonnade/src/Colonnade/Encoding.hs
index 616b419..8aa1a5c 100644
--- a/colonnade/src/Colonnade/Encoding.hs
+++ b/colonnade/src/Colonnade/Encoding.hs
@@ -1,23 +1,153 @@
-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
+  , 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.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
+--
+-- 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 }
+--
+-- One potential columnar encoding of a @Person@ would be:
+--
+-- >>> :{
+-- let encodingPerson :: Encoding Headed String Person
+--     encodingPerson = mconcat
+--       [ headed "Name" personName
+--       , headed "Age" (show . personAge)
+--       ]
+-- :}
+--
+-- 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 encodingHouse :: Encoding Headed String House
+--     encodingHouse = mconcat
+--       [ headed "Color" (show . houseColor)
+--       , headed "Price" (('$':) . show . housePrice)
+--       ]
+-- :}
+--
+-- >>> let houses = [House Green 170000, House Blue 115000]
+-- >>> putStr $ ascii encodingHouse houses
+-- +-------+---------+
+-- | Color | Price   |
+-- +-------+---------+
+-- | Green | $170000 |
+-- | Blue  | $115000 |
+-- +-------+---------+
 
-headless :: (a -> content) -> Encoding Headless content a
-headless f = Encoding (Vector.singleton (OneEncoding Headless f))
 
+-- | A column with a header.
 headed :: content -> (a -> content) -> Encoding Headed content a
 headed h f = Encoding (Vector.singleton (OneEncoding (Headed h) f))
 
--- runRow' :: Encoding f content a -> a -> Vector content
--- runRow' = runRow id
+-- | A column without a header.
+headless :: (a -> content) -> Encoding Headless content a
+headless f = Encoding (Vector.singleton (OneEncoding Headless f))
+
+-- | 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 '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
+
+
+-- | Technically, 'Encoding' is a @Bifunctor@. This maps covariantly over the
+-- content type. The instance will be added once GHC8 has its next release.
+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
@@ -99,16 +229,58 @@ runHeaderMonadic_ ::
   -> 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)
-
-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
+-- | 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"
 
 
+-- 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)
 
diff --git a/colonnade/test/Main.hs b/colonnade/test/Main.hs
new file mode 100644
index 0000000..9e51547
--- /dev/null
+++ b/colonnade/test/Main.hs
@@ -0,0 +1,4 @@
+import Test.DocTest
+
+main :: IO ()
+main = doctest ["src/Colonnade/Encoding.hs"]
diff --git a/reflex-dom-colonnade/reflex-dom-colonnade.cabal b/reflex-dom-colonnade/reflex-dom-colonnade.cabal
index 1e0a4be..deed5c0 100644
--- a/reflex-dom-colonnade/reflex-dom-colonnade.cabal
+++ b/reflex-dom-colonnade/reflex-dom-colonnade.cabal
@@ -1,5 +1,5 @@
 name:                reflex-dom-colonnade
-version:             0.4.5
+version:             0.4.6
 synopsis:            Use colonnade with reflex-dom
 description:         Please see README.md
 homepage:            https://github.com/andrewthad/colonnade#readme
@@ -17,15 +17,15 @@ library
   exposed-modules:
     Reflex.Dom.Colonnade
   build-depends:
-      base >= 4.7 && < 5
-    , colonnade >= 0.4.4
-    , contravariant
-    , vector
+      base >= 4.7 && < 5.0
+    , colonnade >= 0.4.6 && < 0.5
+    , contravariant >= 1.2 && < 1.5
+    , vector >= 0.10 && < 0.12
+    , text >= 1.0 && < 1.3
     , reflex
     , reflex-dom
-    , containers
-    , semigroups
-    , text
+    , containers >= 0.5 && < 0.6
+    , semigroups >= 0.16 && < 0.19
   default-language: Haskell2010
   ghc-options:      -Wall
 
diff --git a/yesod-colonnade/yesod-colonnade.cabal b/yesod-colonnade/yesod-colonnade.cabal
index 30ec5ca..8a50738 100644
--- a/yesod-colonnade/yesod-colonnade.cabal
+++ b/yesod-colonnade/yesod-colonnade.cabal
@@ -18,9 +18,9 @@ library
     Yesod.Colonnade
   build-depends:
       base >= 4.7 && < 5
-    , colonnade
-    , yesod-core
-    , text
+    , colonnade >= 0.4.6 && < 0.5
+    , yesod-core >= 1.4.0 && < 1.5
+    , text >= 1.0 && < 1.3
   default-language:    Haskell2010
 
 source-repository head