more changes

colonnade/colonnade.cabal

@@ -1,5 +1,5 @@
 name:                colonnade
-version:             0.1
+version:             0.3
 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

@@ -24,24 +24,24 @@ runRow :: (c1 -> c2) -> Encoding f c1 a -> a -> Vector c2
 runRow g (Encoding v) a = flip Vector.map v $
   \(OneEncoding _ encode) -> g (encode a)
 
-runRowMonadic :: Monad m
+runRowMonadic :: (Monad m, Monoid b)
               => Encoding f content a
-              -> (content -> m ())
+              -> (content -> m b)
               -> a
-              -> m ()
-runRowMonadic (Encoding v) g a = Vector.forM_ v $ \e ->
+              -> m b
+runRowMonadic (Encoding v) g a = fmap (mconcat . Vector.toList) $ Vector.forM v $ \e ->
   g (oneEncodingEncode e a)
 
 runHeader :: (c1 -> c2) -> Encoding Headed c1 a -> Vector c2
 runHeader g (Encoding v) =
   Vector.map (g . getHeaded . oneEncodingHead) v
 
-runHeaderMonadic :: Monad m
+runHeaderMonadic :: (Monad m, Monoid b)
                  => Encoding Headed content a
-                 -> (content -> m ())
-                 -> m ()
+                 -> (content -> m b)
+                 -> m b
 runHeaderMonadic (Encoding v) g =
-  Vector.mapM_ (g . getHeaded . oneEncodingHead) v
+  fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneEncodingHead) v
 
 
 

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

@@ -1,5 +1,5 @@
 name:                reflex-dom-colonnade
-version:             0.2
+version:             0.3
 synopsis:            Use colonnade with reflex-dom
 description:         Please see README.md
 homepage:            https://github.com/andrewthad/colonnade#readme
@@ -18,12 +18,13 @@ library
     Reflex.Dom.Colonnade
   build-depends:
       base >= 4.7 && < 5
-    , colonnade
+    , colonnade >= 0.3
     , contravariant
     , vector
     , reflex
     , reflex-dom
     , containers
+    , semigroups
   default-language: Haskell2010
   ghc-options:      -Wall
 

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

@@ -2,26 +2,28 @@ module Reflex.Dom.Colonnade where
 
 import Colonnade.Types
 import Control.Monad
-import Reflex (Dynamic)
+import Data.Foldable
+import Reflex (Dynamic,Event,switchPromptly,never)
 import Reflex.Dynamic (mapDyn)
 import Reflex.Dom (MonadWidget)
 import Reflex.Dom.Widget.Basic
 import Data.Map (Map)
+import Data.Semigroup (Semigroup)
 import qualified Colonnade.Encoding as Encoding
 import qualified Data.Map as Map
 
-cell :: m () -> Cell m
+cell :: m b -> Cell m b
 cell = Cell Map.empty
 
-data Cell m = Cell
-  { cellAttrs :: Map String String
-  , cellContents :: m ()
+data Cell m b = Cell
+  { cellAttrs :: !(Map String String)
+  , cellContents :: !(m b)
   }
 
 basic :: (MonadWidget t m, Foldable f)
       => Map String String -- ^ Table element attributes
       -> f a -- ^ Values
-      -> Encoding Headed (Cell m) a -- ^ Encoding of a value into cells
+      -> Encoding Headed (Cell m ()) a -- ^ Encoding of a value into cells
       -> m ()
 basic tableAttrs as encoding = do
   elAttr "table" tableAttrs $ do
@@ -29,17 +31,17 @@ basic tableAttrs as encoding = do
     el "tbody" $ forM_ as $ \a -> do
       el "tr" $ mapM_ (Encoding.runRowMonadic encoding (elFromCell "td")) as
 
-elFromCell :: MonadWidget t m => String -> Cell m -> m ()
+elFromCell :: MonadWidget t m => String -> Cell m b -> m b
 elFromCell name (Cell attrs contents) = elAttr name attrs contents
 
-theadBuild :: MonadWidget t m => Encoding Headed (Cell m) a -> m ()
+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")
 
 dynamic :: (MonadWidget t m, Foldable f)
         => Map String String -- ^ Table element attributes
         -> f (Dynamic t a) -- ^ Dynamic values
-        -> Encoding Headed (Cell m) a -- ^ Encoding of a value into cells
+        -> Encoding Headed (Cell m ()) a -- ^ Encoding of a value into cells
         -> m ()
 dynamic tableAttrs as encoding@(Encoding v) = do
   elAttr "table" tableAttrs $ do
@@ -52,3 +54,21 @@ dynamic tableAttrs as encoding@(Encoding v) = do
         _ <- elDynAttr "td" dynAttrs $ dyn dynContent
         return ()
 
+dynamicEventful :: (MonadWidget t m, Traversable f, Semigroup e)
+  => Map String String -- ^ Table element attributes
+  -> f (Dynamic t a) -- ^ Dynamic values
+  -> Encoding Headed (Cell m (Event t e)) a -- ^ Encoding of a value into cells
+  -> m (Event t e)
+dynamicEventful tableAttrs as encoding@(Encoding v) = do
+  elAttr "table" tableAttrs $ do
+    b1 <- theadBuild encoding
+    b2 <- el "tbody" $ forM as $ \a -> do
+      el "tr" $ forM v $ \(OneEncoding _ encode) -> do
+        dynPair <- mapDyn encode a
+        dynAttrs <- mapDyn cellAttrs dynPair
+        dynContent <- mapDyn cellContents dynPair
+        e <- elDynAttr "td" dynAttrs $ dyn dynContent
+        -- TODO: This might actually be wrong. Revisit this.
+        switchPromptly never e
+    return (mappend b1 (mconcat $ toList $ mconcat $ toList b2))
+