fix merge conflicts

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/Decoding.hs

@@ -62,7 +62,7 @@ uncheckedRun dc v = getEitherWrap (go dc)
         rcurrent = mapLeft (DecodingCellErrors . Vector.singleton . DecodingCellError content ixed) (decode content)
     in rnext <*> (EitherWrap rcurrent)
 
-headlessToIndexed :: forall c a. 
+headlessToIndexed :: forall c a.
   Decoding Headless c a -> Decoding (Indexed Headless) c a
 headlessToIndexed = go 0 where
   go :: forall b. Int -> Decoding Headless c b -> Decoding (Indexed Headless) c b
@@ -71,7 +71,7 @@ headlessToIndexed = go 0 where
     DecodingAp (Indexed ix Headless) decode (go (ix + 1) apNext)
 
 length :: forall f c a. Decoding f c a -> Int
-length = go 0 where 
+length = go 0 where
   go :: forall b. Int -> Decoding f c b -> Int
   go !a (DecodingPure _) = a
   go !a (DecodingAp _ _ apNext) = go (a + 1) apNext

colonnade/src/Colonnade/Encoding.hs

@@ -21,27 +21,27 @@ headed h f = Encoding (Vector.singleton (OneEncoding (Headed h) f))
 -- instead. It may allow more things to get inlined
 -- in to a loop.
 runRow :: (c1 -> c2) -> Encoding f c1 a -> a -> Vector c2
-runRow g (Encoding v) a = flip Vector.map v $ 
+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 
+              => Encoding f content a
-              -> (content -> m ()) 
+              -> (content -> m b)
-              -> a 
+              -> a
-              -> m ()
+              -> m b
-runRowMonadic (Encoding v) g a = Vector.forM_ v $ \e -> 
+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) = 
+runHeader g (Encoding v) =
   Vector.map (g . getHeaded . oneEncodingHead) v
 
-runHeaderMonadic :: Monad m 
+runHeaderMonadic :: (Monad m, Monoid b)
-                 => Encoding Headed content a 
+                 => Encoding Headed content a
-                 -> (content -> m ()) 
+                 -> (content -> m b)
-                 -> m ()
+                 -> m b
-runHeaderMonadic (Encoding v) g = 
+runHeaderMonadic (Encoding v) g =
-  Vector.mapM_ (g . getHeaded . oneEncodingHead) v
+  fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneEncodingHead) v
 
 
 

colonnade/src/Colonnade/Types.hs

@@ -107,7 +107,7 @@ instance Contravariant (OneEncoding f content) where
   contramap f (OneEncoding h e) = OneEncoding h (e . f)
 
 newtype Encoding f content a = Encoding
-  { getEncoding :: Vector (OneEncoding f content a) 
+  { getEncoding :: Vector (OneEncoding f content a)
   } deriving (Monoid)
 
 instance Contravariant (Encoding f content) where

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
+data Cell m b = Cell
-  { cellAttrs :: Map String String
+  { cellAttrs :: !(Map String String)
-  , cellContents :: m ()
+  , 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" 
+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))
+

siphon/src/Siphon.hs

@@ -4,7 +4,7 @@ module Siphon where
 -- encode
 -- decode :: Pipe (Vector c) a m x
 
--- encode :: 
+-- encode ::
 
 -- row :: Vector (Escaped Text) -> Text
 -- row = Vector.

siphon/src/Siphon/Content.hs

@@ -1,4 +1,4 @@
-module Siphon.Content 
+module Siphon.Content
   ( byteStringChar8
   ) where
 

siphon/src/Siphon/Decoding.hs

@@ -17,7 +17,7 @@ import qualified Data.ByteString.Char8 as ByteString
 import qualified Data.Attoparsec.Types as Atto
 
 -- unrow :: c1 -> (Vector c2,c1)
--- 
+--
 -- row :: _
 --     -> Decoding (Indexed f) c a
 --     -> Vector c
@@ -27,7 +27,7 @@ import qualified Data.Attoparsec.Types as Atto
 --      Monad m
 --   => Decoding (Indexed f) c a
 --   -> Pipe (Vector c) a m ()
--- decodeVectorPipe 
+-- decodeVectorPipe
 
 mkParseError :: Int -> [String] -> String -> DecodingRowError f content
 mkParseError i ctxs msg = id
@@ -55,7 +55,7 @@ indexedPipe :: Monad m
   -> Decoding (Indexed Headless) c a
   -> Pipe c a m (DecodingRowError Headless c)
 indexedPipe sd decoding = do
-  (firstRow, mleftovers) <- consumeGeneral sd mkParseError 
+  (firstRow, mleftovers) <- consumeGeneral sd mkParseError
   let req = Decoding.maxIndex decoding
       vlen = Vector.length firstRow
   if vlen < req
@@ -72,28 +72,28 @@ headedPipe :: (Monad m, Eq c)
   -> Decoding Headed c a
   -> Pipe c a m (DecodingRowError Headed c)
 headedPipe sd decoding = do
-  (headers, mleftovers) <- consumeGeneral sd mkParseError 
+  (headers, mleftovers) <- consumeGeneral sd mkParseError
   case Decoding.headedToIndexed headers decoding of
     Left headingErrs -> return (DecodingRowError 0 (RowErrorHeading headingErrs))
-    Right indexedDecoding -> 
+    Right indexedDecoding ->
       let requiredLength = Vector.length headers
        in uncheckedPipe requiredLength 1 sd indexedDecoding mleftovers
-  
+
 
 uncheckedPipe :: Monad m
   => Int -- ^ expected length of each row
   -> Int -- ^ index of first row, usually zero or one
-  -> Siphon c 
+  -> Siphon c
   -> Decoding (Indexed f) c a
   -> Maybe c
   -> Pipe c a m (DecodingRowError f c)
-uncheckedPipe requiredLength ix sd d mleftovers = 
+uncheckedPipe requiredLength ix sd d mleftovers =
   pipeGeneral ix sd mkParseError checkedRunWithRow mleftovers
   where
-  checkedRunWithRow rowIx v = 
+  checkedRunWithRow rowIx v =
     let vlen = Vector.length v in
     if vlen /= requiredLength
-      then Left $ DecodingRowError rowIx 
+      then Left $ DecodingRowError rowIx
                 $ RowErrorSize requiredLength vlen
       else Decoding.uncheckedRunWithRow rowIx d v
 
@@ -110,7 +110,7 @@ pipeGeneral :: Monad m
   -> (Int -> Vector c -> Either e a)
   -> Maybe c -- ^ leftovers that should be handled first
   -> Pipe c a m e
-pipeGeneral initIx (Siphon _ _ parse isNull) wrapParseError decodeRow mleftovers = 
+pipeGeneral initIx (Siphon _ _ parse isNull) wrapParseError decodeRow mleftovers =
   case mleftovers of
     Nothing -> go1 initIx
     Just leftovers -> handleResult initIx (parse leftovers)
@@ -138,6 +138,6 @@ awaitSkip :: Monad m
 awaitSkip f = go where
   go = do
     a <- await
-    if f a then go else return a 
+    if f a then go else return a
 
 

siphon/src/Siphon/Encoding.hs

@@ -7,27 +7,27 @@ import qualified Pipes.Prelude as Pipes
 import qualified Colonnade.Encoding as Encoding
 
 row :: Siphon c
-    -> Encoding f c a 
+    -> Encoding f c a
-    -> a 
+    -> a
     -> c
 row (Siphon escape intercalate _ _) e =
   intercalate . Encoding.runRow escape e
 
 header :: Siphon c
-       -> Encoding Headed c a 
+       -> Encoding Headed c a
        -> c
 header (Siphon escape intercalate _ _) e =
   intercalate (Encoding.runHeader escape e)
 
-pipe :: Monad m 
+pipe :: Monad m
   => Siphon c
-  -> Encoding f c a 
+  -> Encoding f c a
   -> Pipe a c m x
 pipe siphon encoding = Pipes.map (row siphon encoding)
 
-headedPipe :: Monad m 
+headedPipe :: Monad m
-  => Siphon c 
+  => Siphon c
-  -> Encoding Headed c a 
+  -> Encoding Headed c a
   -> Pipe a c m x
 headedPipe siphon encoding = do
   yield (header siphon encoding)

siphon/src/Siphon/Internal.hs

@@ -40,8 +40,8 @@ import Control.Applicative
 import Data.Monoid
 
 byteStringChar8 :: Siphon ByteString
-byteStringChar8 = Siphon 
+byteStringChar8 = Siphon
-  escape 
+  escape
   encodeRow
   (A.parse (row comma))
   B.null
@@ -54,7 +54,7 @@ encodeRow = id
   . coerce
 
 escape :: ByteString -> Escaped ByteString
-escape t = case B.find (\c -> c == newline || c == comma || c == doubleQuote) t of
+escape t = case B.find (\c -> c == newline || c == cr || c == comma || c == doubleQuote) t of
   Nothing -> Escaped t
   Just _  -> escapeAlways t
 

siphon/src/Siphon/Types.hs

@@ -31,6 +31,6 @@ data SiphonDecoding c1 c2 = SiphonDecoding
 --   }
 
 -- data SiphonDecodingError
---   { clarify 
+--   { clarify
 --   }
 

siphon/test/Test.hs

@@ -32,9 +32,9 @@ main = defaultMain tests
 
 tests :: [Test]
 tests =
-  [ testGroup "ByteString encode/decode" 
+  [ testGroup "ByteString encode/decode"
     [ testCase "Headless Encoding (int,char,bool)" testEncodingA
-    , testProperty "Headless Isomorphism (int,char,bool)" 
+    , testProperty "Headless Isomorphism (int,char,bool)"
         $ propIsoPipe $
           (SE.pipe SC.byteStringChar8 encodingA)
           >->
@@ -42,7 +42,6 @@ tests =
     ]
   ]
 
-
 decodingA :: Decoding Headless ByteString (Int,Char,Bool)
 decodingA = (,,)
   <$> Decoding.headless CDB.int
@@ -63,8 +62,8 @@ propIsoPipe :: Eq a => Pipe a a Identity () -> [a] -> Bool
 propIsoPipe p as = (Pipes.toList $ each as >-> p) == as
 
 testEncodingA :: Assertion
-testEncodingA = 
+testEncodingA =
-  ( ByteString.concat $ Pipes.toList $ 
+  ( ByteString.concat $ Pipes.toList $
     Pipes.yield (4,'c',False) >-> SE.pipe SC.byteStringChar8 encodingA
   ) @?= "4,c,false\n"