reflex-dom-colonnade 0.2 → 0.3

raw patch · 2 files changed

+46/−20 lines, 2 filesdep +semigroupsdep ~colonnade

Dependencies added: semigroups

Dependency ranges changed: colonnade

Files

• reflex-dom-colonnade.cabal +5/−3
• src/Reflex/Dom/Colonnade.hs +41/−17

@@ -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,13 +18,15 @@     Reflex.Dom.Colonnade   build-depends:       base >= 4.7 && < 5-    , colonnade+    , colonnade >= 0.3     , contravariant     , vector     , reflex     , reflex-dom     , containers-  default-language:    Haskell2010+    , semigroups+  default-language: Haskell2010+  ghc-options:      -Wall  source-repository head   type:     git

@@ -2,49 +2,73 @@  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 v) = do+basic tableAttrs as encoding = do   elAttr "table" tableAttrs $ do-    el "thead" $ el "tr" $ forM_ v $ \(Headed (Cell attrs contents),_) ->-      elAttr "th" attrs contents+    theadBuild encoding     el "tbody" $ forM_ as $ \a -> do-      el "tr" $ forM_ v $ \(_,encode) -> do-        let Cell attrs contents = encode a-        elAttr "td" attrs contents+      el "tr" $ mapM_ (Encoding.runRowMonadic encoding (elFromCell "td")) as +elFromCell :: MonadWidget t m => String -> Cell m b -> m b+elFromCell name (Cell attrs contents) = elAttr name attrs contents++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 v) = do+dynamic tableAttrs as encoding@(Encoding v) = do   elAttr "table" tableAttrs $ do-    el "thead" $ el "tr" $ forM_ v $ \(Headed (Cell attrs contents),_) ->-      elAttr "th" attrs contents+    theadBuild encoding     el "tbody" $ forM_ as $ \a -> do-      el "tr" $ forM_ v $ \(_,encode) -> do+      el "tr" $ forM_ v $ \(OneEncoding _ encode) -> do         dynPair <- mapDyn encode a         dynAttrs <- mapDyn cellAttrs dynPair         dynContent <- mapDyn cellContents dynPair         _ <- 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))