add inter-row stuff

colonnade/colonnade.cabal

@@ -1,5 +1,5 @@
 name:                colonnade
-version:             0.4
+version:             0.4.1
 synopsis:            Generic types and functions for columnar encoding and decoding
 description:         Please see README.md
 homepage:            https://github.com/andrewthad/colonnade#readme

colonnade/src/Colonnade/Encoding.hs

@@ -2,7 +2,9 @@ module Colonnade.Encoding where
 
 import Colonnade.Types
 import Data.Vector (Vector)
+import Data.Foldable
 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
@@ -29,10 +31,25 @@ runRowMonadic :: (Monad m, Monoid b)
               -> (content -> m b)
               -> a
               -> m b
-runRowMonadic (Encoding v) g a = fmap (mconcat . Vector.toList) 
+runRowMonadic (Encoding v) g a =
-  $ Vector.forM v 
+  --   fmap (mconcat . Vector.toList)
+  -- $ Vector.forM v
+  flip Internal.foldMapM v
   $ \e -> g (oneEncodingEncode e a)
 
+runRowMonadicWith :: (Monad m)
+              => b
+              -> (b -> b -> b)
+              -> Encoding f content a
+              -> (content -> m b)
+              -> a
+              -> m b
+runRowMonadicWith bempty bappend (Encoding v) g a =
+  foldrM (\e br -> do
+    bl <- g (oneEncodingEncode e a)
+    return (bappend bl br)
+  ) bempty v
+
 runHeader :: (c1 -> c2) -> Encoding Headed c1 a -> Vector c2
 runHeader g (Encoding v) =
   Vector.map (g . getHeaded . oneEncodingHead) v
@@ -44,14 +61,23 @@ runHeaderMonadic :: (Monad m, Monoid b)
 runHeaderMonadic (Encoding v) g =
   fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneEncodingHead) v
 
+runHeaderMonadic_ ::
+     (Monad m)
+  => Encoding Headed content a
+  -> (content -> m b)
+  -> 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) 
+        -> (b -> f c)
-        -> Vector b 
+        -> Vector b
         -> Encoding f c a
 columns getCell getHeader bs =
   Encoding $ Vector.map (\b -> OneEncoding (getHeader b) (getCell b)) bs
 
+
+

colonnade/src/Colonnade/Internal.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE DeriveFunctor #-}
 module Colonnade.Internal where
 
+import Data.Foldable (foldrM)
+
 newtype EitherWrap a b = EitherWrap
   { getEitherWrap :: Either a b
   } deriving (Functor)
@@ -15,3 +17,7 @@ instance Monoid a => Applicative (EitherWrap a) where
 mapLeft :: (a -> b) -> Either a c -> Either b c
 mapLeft _ (Right a) = Right a
 mapLeft f (Left a) = Left (f a)
+
+foldMapM :: (Foldable t, Monoid b, Monad m) => (a -> m b) -> t a -> m b
+foldMapM f = foldrM (\a b -> fmap (flip mappend b) (f a)) mempty
+

reflex-dom-colonnade/reflex-dom-colonnade.cabal

@@ -1,5 +1,5 @@
 name:                reflex-dom-colonnade
-version:             0.4
+version:             0.4.1
 synopsis:            Use colonnade with reflex-dom
 description:         Please see README.md
 homepage:            https://github.com/andrewthad/colonnade#readme
@@ -18,7 +18,7 @@ library
     Reflex.Dom.Colonnade
   build-depends:
       base >= 4.7 && < 5
-    , colonnade >= 0.3
+    , colonnade >= 0.4.1
     , contravariant
     , vector
     , reflex

reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs

@@ -10,13 +10,15 @@ module Reflex.Dom.Colonnade
 
 import Colonnade.Types
 import Control.Monad
+import Data.Maybe
 import Data.Foldable
-import Reflex (Dynamic,Event,switchPromptly,never)
+import Reflex (Dynamic,Event,switchPromptly,never,leftmost)
 import Reflex.Dynamic (mapDyn)
 import Reflex.Dom (MonadWidget)
 import Reflex.Dom.Widget.Basic
 import Data.Map (Map)
 import Data.Semigroup (Semigroup)
+import qualified Data.Vector as Vector
 import qualified Colonnade.Encoding as Encoding
 import qualified Data.Map as Map
 
@@ -44,6 +46,33 @@ basic tableAttrs as encoding = do
     el "tbody" $ forM_ as $ \a -> do
       el "tr" $ Encoding.runRowMonadic encoding (elFromCell "td") a
 
+interRowContent :: (MonadWidget t m, Foldable f)
+  => String
+  -> String
+  -> f a
+  -> Encoding Headed (Cell m (Event t (Maybe (m ())))) a
+  -> m ()
+interRowContent tableClass tdExtraClass as encoding@(Encoding v) = do
+  let vlen = Vector.length v
+  elAttr "table" (Map.singleton "class" tableClass) $ do
+    -- Discarding this result is technically the wrong thing
+    -- to do, but I cannot imagine why anyone would want to
+    -- drop down content under the heading.
+    _ <- theadBuild_ encoding
+    el "tbody" $ forM_ as $ \a -> do
+      e' <- el "tr" $ do
+        e <- Encoding.runRowMonadicWith never const encoding (elFromCell "td") a
+        let e' = flip fmap e $ \mwidg -> case mwidg of
+              Nothing -> return ()
+              Just widg -> el "tr" $ do
+                elAttr "td" ( Map.fromList
+                    [ ("class",tdExtraClass)
+                    , ("colspan",show vlen)
+                    ]
+                  ) widg
+        return e'
+      widgetHold (return ()) e'
+
 elFromCell :: MonadWidget t m => String -> Cell m b -> m b
 elFromCell name (Cell attrs contents) = elAttr name attrs contents
 
@@ -51,6 +80,10 @@ theadBuild :: (MonadWidget t m, Monoid b) => Encoding Headed (Cell m b) a -> m b
 theadBuild encoding = el "thead" . el "tr"
   $ Encoding.runHeaderMonadic encoding (elFromCell "th")
 
+theadBuild_ :: (MonadWidget t m) => Encoding Headed (Cell m b) a -> m ()
+theadBuild_ encoding = el "thead" . el "tr"
+  $ Encoding.runHeaderMonadic_  encoding (elFromCell "th")
+
 dynamic :: (MonadWidget t m, Foldable f)
         => Map String String -- ^ Table element attributes
         -> f (Dynamic t a) -- ^ Dynamic values