added new implementation of siphon

colonnade/app/Main.hs

@@ -1,6 +0,0 @@
-module Main where
-
-import Lib
-
-main :: IO ()
-main = someFunc

colonnade/src/Colonnade/Decoding.hs

@@ -24,6 +24,8 @@ headless f = DecodingAp Headless f (DecodingPure id)
 headed :: content -> (content -> Either String a) -> Decoding Headed content a
 headed h f = DecodingAp (Headed h) f (DecodingPure id)
 
+-- | This function does not check to make sure that the indicies in
+--   the 'Decoding' are in the 'Vector'.
 uncheckedRun :: forall content a f.
                 Vector content
              -> Decoding (Indexed f) content a

colonnade/src/Colonnade/Encoding.hs

@@ -1,6 +1,7 @@
 module Colonnade.Encoding where
 
 import Colonnade.Types
+import Data.Vector (Vector)
 import qualified Data.Vector as Vector
 
 mapContent :: Functor f => (c1 -> c2) -> Encoding f c1 a -> Encoding f c2 a
@@ -13,3 +14,34 @@ headless f = Encoding (Vector.singleton (OneEncoding Headless f))
 headed :: content -> (a -> content) -> Encoding Headed content a
 headed h f = Encoding (Vector.singleton (OneEncoding (Headed h) f))
 
+-- runRow' :: Encoding f content a -> a -> Vector content
+-- runRow' = runRow id
+
+-- | Consider providing a variant the produces a list
+-- 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 $ 
+  \(OneEncoding _ encode) -> g (encode a)
+
+runRowMonadic :: Monad m 
+              => Encoding f content a 
+              -> (content -> m ()) 
+              -> a 
+              -> m ()
+runRowMonadic (Encoding v) g a = 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 
+                 => Encoding Headed content a 
+                 -> (content -> m ()) 
+                 -> m ()
+runHeaderMonadic (Encoding v) g = 
+  Vector.mapM_ (g . getHeaded . oneEncodingHead) v
+
+
+

colonnade/src/Colonnade/Types.hs

@@ -91,8 +91,8 @@ 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)
+  } deriving (Monoid)
 
 instance Contravariant (Encoding f content) where
   contramap f (Encoding v) = Encoding

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

@@ -24,7 +24,8 @@ library
     , reflex
     , reflex-dom
     , containers
-  default-language:    Haskell2010
+  default-language: Haskell2010
+  ghc-options:      -Wall
 
 source-repository head
   type:     git

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

@@ -7,6 +7,7 @@ import Reflex.Dynamic (mapDyn)
 import Reflex.Dom (MonadWidget)
 import Reflex.Dom.Widget.Basic
 import Data.Map (Map)
+import qualified Colonnade.Encoding as Encoding
 import qualified Data.Map as Map
 
 cell :: m () -> Cell m
@@ -22,26 +23,27 @@ basic :: (MonadWidget t m, Foldable f)
       -> f a -- ^ Values
       -> 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" $
+    theadBuild encoding
-      forM_ v $ \(OneEncoding (Headed (Cell attrs contents)) _) ->
-        elAttr "th" attrs contents
     el "tbody" $ forM_ as $ \a -> do
-      el "tr" $ forM_ v $ \(OneEncoding _ encode) -> do
+      el "tr" $ mapM_ (Encoding.runRowMonadic encoding (elFromCell "td")) as
-        let Cell attrs contents = encode a
+
-        elAttr "td" attrs contents
+elFromCell :: MonadWidget t m => String -> Cell m -> m ()
+elFromCell name (Cell attrs contents) = elAttr name attrs contents
+
+theadBuild :: MonadWidget t m => Encoding Headed (Cell m) 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
         -> 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" $
+    theadBuild encoding
-      forM_ v $ \(OneEncoding (Headed (Cell attrs contents)) _) ->
-        elAttr "th" attrs contents
     el "tbody" $ forM_ as $ \a -> do
       el "tr" $ forM_ v $ \(OneEncoding _ encode) -> do
         dynPair <- mapDyn encode a

siphon/LICENSE

@@ -0,0 +1,30 @@
+Copyright Andrew Martin (c) 2016
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Andrew Martin nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

siphon/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

siphon/siphon.cabal

@@ -0,0 +1,35 @@
+name:                siphon
+version:             0.1
+synopsis:            Generic types and functions for columnar encoding and decoding
+description:         Please see README.md
+homepage:            https://github.com/andrewthad/colonnade#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Andrew Martin
+maintainer:          andrew.thaddeus@gmail.com
+copyright:           2016 Andrew Martin
+category:            web
+build-type:          Simple
+cabal-version:       >=1.10
+
+library
+  hs-source-dirs:      src
+  exposed-modules:
+    Siphon.Text
+    Siphon.ByteString.Char8
+    Siphon
+    Siphon.Types
+    Siphon.Encoding
+  build-depends:
+      base >= 4.7 && < 5
+    , colonnade
+    , text
+    , bytestring
+    , contravariant
+    , vector
+    , pipes
+  default-language:    Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/andrewthad/colonnade

siphon/src/Siphon.hs

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

siphon/src/Siphon/ByteString/Char8.hs

@@ -0,0 +1 @@
+module Siphon.ByteString.Char8 where

siphon/src/Siphon/Decoding.hs

@@ -0,0 +1,10 @@
+module Siphon.Decoding where
+
+import Siphon.Types
+
+-- unrow :: c1 -> (Vector c2,c1)
+-- 
+-- row :: _
+--     -> Decoding (Indexed f) c a
+--     -> Vector c
+--     -> Either DecodingErrors a

siphon/src/Siphon/Encoding.hs

@@ -0,0 +1,29 @@
+module Siphon.Encoding where
+
+import Siphon.Types
+import Colonnade.Types
+import Pipes (Pipe,yield)
+import qualified Pipes.Prelude as Pipes
+import qualified Colonnade.Encoding as Encoding
+
+row :: Siphon c1 c2 
+    -> Encoding f c1 a 
+    -> a 
+    -> c2
+row (Siphon escape intercalate) e =
+  intercalate . Encoding.runRow escape e
+
+header :: Siphon c1 c2 
+       -> Encoding Headed c1 a 
+       -> c2
+header (Siphon escape intercalate) e =
+  intercalate (Encoding.runHeader escape e)
+
+pipe :: Monad m => Siphon c1 c2 -> Encoding f c1 a -> Pipe a c2 m x
+pipe siphon encoding = Pipes.map (row siphon encoding)
+
+pipeWithHeader :: Monad m => Siphon c1 c2 -> Encoding Headed c1 a -> Pipe a c2 m x
+pipeWithHeader siphon encoding = do
+  yield (header siphon encoding)
+  pipe siphon encoding
+

siphon/src/Siphon/Text.hs

@@ -0,0 +1,32 @@
+module Siphon.Text where
+
+import Siphon.Types
+import Data.Text (Text)
+import Data.Vector (Vector)
+import Data.Coerce (coerce)
+import qualified Data.Text   as Text
+import qualified Data.Vector as Vector
+
+siphon :: Siphon Text Text
+siphon = Siphon escape encodeRow
+
+encodeRow :: Vector (Escaped Text) -> Text
+encodeRow = id
+  . Text.intercalate (Text.pack ",")
+  . Vector.toList
+  . coerce
+
+escape :: Text -> Escaped Text
+escape t = case Text.find (\c -> c == '\n' || c == ',' || c == '"') t of
+  Nothing -> Escaped t
+  Just _  -> escapeAlways t
+
+escapeAlways :: Text -> Escaped Text
+escapeAlways t = Escaped $ Text.concat
+  [ Text.singleton '"'
+  , Text.replace (Text.pack "\"") (Text.pack "\"\"") t
+  , Text.singleton '"'
+  ]
+
+
+

siphon/src/Siphon/Types.hs

@@ -0,0 +1,17 @@
+module Siphon.Types where
+
+import Data.Vector (Vector)
+
+newtype Escaped c = Escaped { getEscaped :: c }
+
+-- | Consider changing out the use of 'Vector' here
+-- with the humble list instead. It might fuse away
+-- better. Not sure though.
+data Siphon c1 c2 = Siphon
+  { siphonEscape :: !(c1 -> Escaped c2)
+  , siphonIntercalate :: !(Vector (Escaped c2) -> c2)
+  }
+
+-- data Clarify = Clarify
+--   { clarify 
+--   }

stack.yaml

@@ -38,6 +38,7 @@ resolver: lts-6.4
 packages:
 - 'colonnade'
 - 'reflex-dom-colonnade'
+- 'siphon'
 # Dependency packages to be pulled from upstream that are not in the resolver
 # (e.g., acme-missiles-0.3)
 extra-deps: