add more tests. make headed decoding work

colonnade/colonnade.cabal

@@ -17,6 +17,7 @@ library
   exposed-modules:
     Colonnade.Types
     Colonnade.Encoding
+    Colonnade.Encoding.Text
     Colonnade.Encoding.ByteString.Char8
     Colonnade.Decoding
     Colonnade.Decoding.ByteString.Char8

colonnade/src/Colonnade/Encoding/ByteString/Char8.hs

@@ -19,3 +19,6 @@ bool x = case x of
   True -> BC8.pack "true"
   False -> BC8.pack "false"
 
+byteString :: ByteString -> ByteString
+byteString = id
+

colonnade/src/Colonnade/Encoding/Text.hs

@@ -0,0 +1,19 @@
+module Colonnade.Encoding.Text where
+
+import Data.Text
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy as LText
+import qualified Data.Text.Lazy.Builder as Builder
+import qualified Data.Text.Lazy.Builder.Int as Builder
+
+char :: Char -> Text
+char = Text.singleton
+
+int :: Int -> Text
+int = LText.toStrict
+    . Builder.toLazyText
+    . Builder.decimal
+
+text :: Text -> Text
+text = id
+

siphon/src/Siphon/Decoding.hs

@@ -16,19 +16,6 @@ import qualified Data.Attoparsec.ByteString as AttoByteString
 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
---     -> Either DecodingErrors a
-
--- decodeVectorPipe ::
---      Monad m
---   => Decoding (Indexed f) c a
---   -> Pipe (Vector c) a m ()
--- decodeVectorPipe
-
 mkParseError :: Int -> [String] -> String -> DecodingRowError f content
 mkParseError i ctxs msg = id
   $ DecodingRowError i
@@ -55,16 +42,19 @@ indexedPipe :: Monad m
   -> Decoding (Indexed Headless) c a
   -> Pipe c a m (DecodingRowError Headless c)
 indexedPipe sd decoding = do
-  (firstRow, mleftovers) <- consumeGeneral sd mkParseError
+  e <- consumeGeneral 0 sd mkParseError
-  let req = Decoding.maxIndex decoding
+  case e of
-      vlen = Vector.length firstRow
+    Left err -> return err
-  if vlen < req
+    Right (firstRow, mleftovers) -> 
-    then return (DecodingRowError 0 (RowErrorMinSize req vlen))
+      let req = Decoding.maxIndex decoding
-    else case Decoding.uncheckedRun decoding firstRow of
+          vlen = Vector.length firstRow
-      Left cellErr -> return $ DecodingRowError 0 $ RowErrorDecode cellErr
+       in if vlen < req
-      Right a -> do
+            then return (DecodingRowError 0 (RowErrorMinSize req vlen))
-        yield a
+            else case Decoding.uncheckedRun decoding firstRow of
-        uncheckedPipe vlen 1 sd decoding mleftovers
+              Left cellErr -> return $ DecodingRowError 0 $ RowErrorDecode cellErr
+              Right a -> do
+                yield a
+                uncheckedPipe vlen 1 sd decoding mleftovers
 
 
 headedPipe :: (Monad m, Eq c)
@@ -72,12 +62,15 @@ 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
+  e <- consumeGeneral 0 sd mkParseError
-  case Decoding.headedToIndexed headers decoding of
+  case e of
-    Left headingErrs -> return (DecodingRowError 0 (RowErrorHeading headingErrs))
+    Left err -> return err
-    Right indexedDecoding ->
+    Right (headers, mleftovers) -> 
-      let requiredLength = Vector.length headers
+      case Decoding.headedToIndexed headers decoding of
-       in uncheckedPipe requiredLength 1 sd indexedDecoding mleftovers
+        Left headingErrs -> return (DecodingRowError 0 (RowErrorHeading headingErrs))
+        Right indexedDecoding ->
+          let requiredLength = Vector.length headers
+           in uncheckedPipe requiredLength 1 sd indexedDecoding mleftovers
 
 
 uncheckedPipe :: Monad m
@@ -98,10 +91,26 @@ uncheckedPipe requiredLength ix sd d mleftovers =
       else Decoding.uncheckedRunWithRow rowIx d v
 
 consumeGeneral :: Monad m
-  => Siphon c
+  => Int
+  -> Siphon c
   -> (Int -> [String] -> String -> e)
-  -> Consumer' c m (Vector c, Maybe c)
+  -> Consumer' c m (Either e (Vector c, Maybe c))
-consumeGeneral = error "ahh"
+consumeGeneral ix (Siphon _ _ parse isNull) wrapParseError = do
+  c <- awaitSkip isNull
+  handleResult (parse c)
+  where
+  go k = do
+    c <- awaitSkip isNull
+    handleResult (k c)
+  handleResult r = case r of
+    Atto.Fail _ ctxs msg -> return $ Left 
+      $ wrapParseError ix ctxs msg
+    Atto.Done c v ->
+      let mcontent = if isNull c
+            then Nothing
+            else Just c
+       in return (Right (v,mcontent))
+    Atto.Partial k -> go k
 
 pipeGeneral :: Monad m
   => Int -- ^ index of first row, usually zero or one

siphon/test/Test.hs

@@ -10,6 +10,7 @@ import Test.Framework.Providers.HUnit       (testCase)
 import Data.ByteString                      (ByteString)
 import Data.Either.Combinators
 import Colonnade.Types
+import Siphon.Types
 import Data.Functor.Identity
 import Data.Functor.Contravariant           (contramap)
 import Data.Functor.Contravariant.Divisible (divided,conquered)
@@ -33,12 +34,40 @@ main = defaultMain tests
 tests :: [Test]
 tests =
   [ testGroup "ByteString encode/decode"
-    [ testCase "Headless Encoding (int,char,bool)" testEncodingA
+    [ testCase "Headless Encoding (int,char,bool)"
+        $ runTestScenario 
+            SC.byteStringChar8 
+            SE.pipe
+            encodingA 
+            "4,c,false\n"
     , testProperty "Headless Isomorphism (int,char,bool)"
         $ propIsoPipe $
           (SE.pipe SC.byteStringChar8 encodingA)
           >->
           (void $ SD.headlessPipe SC.byteStringChar8 decodingA)
+    , testCase "Headed Encoding (int,char,bool)"
+        $ runTestScenario 
+            SC.byteStringChar8 
+            SE.headedPipe
+            encodingB
+            $ ByteString.concat
+              [ "number,letter,boolean\n"
+              , "4,c,false\n"
+              ]
+    , testCase "Headed Encoding (int,char,bool) monoidal building"
+        $ runTestScenario 
+            SC.byteStringChar8 
+            SE.headedPipe
+            encodingC
+            $ ByteString.concat
+              [ "boolean,letter\n"
+              , "false,c\n"
+              ]
+    , testProperty "Headed Isomorphism (int,char,bool)"
+        $ propIsoPipe $
+          (SE.headedPipe SC.byteStringChar8 encodingB)
+          >->
+          (void $ SD.headedPipe SC.byteStringChar8 decodingB)
     ]
   ]
 
@@ -48,6 +77,12 @@ decodingA = (,,)
   <*> Decoding.headless CDB.char
   <*> Decoding.headless CDB.bool
 
+decodingB :: Decoding Headed ByteString (Int,Char,Bool)
+decodingB = (,,)
+  <$> Decoding.headed "number" CDB.int
+  <*> Decoding.headed "letter" CDB.char
+  <*> Decoding.headed "boolean" CDB.bool
+
 encodingA :: Encoding Headless ByteString (Int,Char,Bool)
 encodingA = contramap tripleToPairs
   $ divided (Encoding.headless CEB.int)
@@ -55,17 +90,38 @@ encodingA = contramap tripleToPairs
   $ divided (Encoding.headless CEB.bool)
   $ conquered 
 
+encodingB :: Encoding Headed ByteString (Int,Char,Bool)
+encodingB = contramap tripleToPairs
+  $ divided (Encoding.headed "number" CEB.int)
+  $ divided (Encoding.headed "letter" CEB.char)
+  $ divided (Encoding.headed "boolean" CEB.bool)
+  $ conquered
+
+encodingC :: Encoding Headed ByteString (Int,Char,Bool)
+encodingC = mconcat
+  [ contramap thd3 $ Encoding.headed "boolean" CEB.bool
+  , contramap snd3 $ Encoding.headed "letter" CEB.char
+  ]
+
 tripleToPairs :: (a,b,c) -> (a,(b,(c,())))
 tripleToPairs (a,b,c) = (a,(b,(c,())))
 
 propIsoPipe :: Eq a => Pipe a a Identity () -> [a] -> Bool
 propIsoPipe p as = (Pipes.toList $ each as >-> p) == as
 
-testEncodingA :: Assertion
+runTestScenario :: (Monoid c, Eq c, Show c)
-testEncodingA =
+  => Siphon c
-  ( ByteString.concat $ Pipes.toList $
+  -> (Siphon c -> Encoding f c (Int,Char,Bool) -> Pipe (Int,Char,Bool) c Identity ())
-    Pipes.yield (4,'c',False) >-> SE.pipe SC.byteStringChar8 encodingA
+  -> Encoding f c (Int,Char,Bool) 
-  ) @?= "4,c,false\n"
+  -> c 
+  -> Assertion
+runTestScenario s p e c = 
+  ( mconcat $ Pipes.toList $
+    Pipes.yield (4,'c',False) >-> p s e
+  ) @?= c
+
+-- testEncodingA :: Assertion
+-- testEncodingA = runTestScenario encodingA "4,c,false\n"
 
 propEncodeDecodeIso :: Eq a => (a -> b) -> (b -> Maybe a) -> a -> Bool
 propEncodeDecodeIso f g a = g (f a) == Just a
@@ -73,3 +129,16 @@ propEncodeDecodeIso f g a = g (f a) == Just a
 propMatching :: Eq b => (a -> b) -> (a -> b) -> a -> Bool
 propMatching f g a = f a == g a
 
+
+-- | Take the first item out of a 3 element tuple
+fst3 :: (a,b,c) -> a
+fst3 (a,b,c) = a
+
+-- | Take the second item out of a 3 element tuple
+snd3 :: (a,b,c) -> b
+snd3 (a,b,c) = b
+
+-- | Take the third item out of a 3 element tuple
+thd3 :: (a,b,c) -> c
+thd3 (a,b,c) = c
+