From c7d0fe4d27d276f645d82d1a79d74bc391488bf5 Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Wed, 6 Jul 2016 08:53:44 -0400 Subject: [PATCH] more changes --- colonnade/colonnade.cabal | 2 +- colonnade/src/Colonnade/Encoding.hs | 16 ++++---- .../reflex-dom-colonnade.cabal | 5 ++- .../src/Reflex/Dom/Colonnade.hs | 38 ++++++++++++++----- 4 files changed, 41 insertions(+), 20 deletions(-) diff --git a/colonnade/colonnade.cabal b/colonnade/colonnade.cabal index 512bbc1..3e04bf8 100644 --- a/colonnade/colonnade.cabal +++ b/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 diff --git a/colonnade/src/Colonnade/Encoding.hs b/colonnade/src/Colonnade/Encoding.hs index ccee20f..3a53ab7 100644 --- a/colonnade/src/Colonnade/Encoding.hs +++ b/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 diff --git a/reflex-dom-colonnade/reflex-dom-colonnade.cabal b/reflex-dom-colonnade/reflex-dom-colonnade.cabal index 7a96cef..a5d83f1 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.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 diff --git a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs index 2b8f76a..86c2634 100644 --- a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs +++ b/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)) +