begin adding tests

colonnade/src/Colonnade/Decoding.hs

@@ -25,6 +25,16 @@ 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)
 
+indexed :: Int -> (content -> Either String a) -> Decoding (Indexed Headless) content a
+indexed ix f = DecodingAp (Indexed ix Headless) f (DecodingPure id)
+
+maxIndex :: forall f c a. Decoding (Indexed f) c a -> Int
+maxIndex = go 0 where
+  go :: forall b. Int -> Decoding (Indexed f) c b -> Int
+  go !ix (DecodingPure _) = ix
+  go !ix1 (DecodingAp (Indexed ix2 _) decode apNext) =
+    go (max ix1 ix2) apNext
+
 -- | This function uses 'unsafeIndex' to access
 --   elements of the 'Vector'.
 uncheckedRunWithRow ::

colonnade/src/Colonnade/Types.hs

@@ -71,6 +71,7 @@ data RowError f content
   | RowErrorDecode !(DecodingCellErrors f content) -- ^ Error decoding the content
   | RowErrorSize !Int !Int -- ^ Wrong number of cells in the row
   | RowErrorHeading !(HeadingErrors content)
+  | RowErrorMinSize !Int !Int
 
 -- instance (Show (f content), Typeable content) => Exception (DecodingErrors f content)
 

siphon/siphon.cabal

@@ -33,6 +33,24 @@ library
     , attoparsec
   default-language:    Haskell2010
 
+test-suite siphon-test
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             Test.hs
+  build-depends:       
+      base
+    , either
+    , siphon
+    , colonnade
+    , contravariant
+    , test-framework
+    , test-framework-quickcheck2
+    , QuickCheck
+    , text
+    , bytestring
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
 source-repository head
   type:     git
   location: https://github.com/andrewthad/colonnade

siphon/src/Siphon/Decoding.hs

@@ -45,6 +45,7 @@ mkParseError i ctxs msg = id
     , "]"
     ]
 
+-- | This is seldom useful but is included for completeness.
 headlessPipe :: Monad m
   => SiphonDecoding c1 c2 
   -> Decoding Headless c2 a
@@ -54,6 +55,23 @@ headlessPipe sd decoding = uncheckedPipe requiredLength 0 sd indexedDecoding Not
   indexedDecoding = Decoding.headlessToIndexed decoding
   requiredLength = Decoding.length indexedDecoding
 
+indexedPipe :: Monad m
+  => SiphonDecoding c1 c2 
+  -> Decoding (Indexed Headless) c2 a
+  -> Pipe c1 a m (DecodingRowError Headless c2)
+indexedPipe sd decoding = do
+  (firstRow, mleftovers) <- consumeGeneral sd mkParseError 
+  let req = Decoding.maxIndex decoding
+      vlen = Vector.length firstRow
+  if vlen < req
+    then return (DecodingRowError 0 (RowErrorMinSize req vlen))
+    else case Decoding.uncheckedRun decoding firstRow of
+      Left cellErr -> return $ DecodingRowError 0 $ RowErrorDecode cellErr
+      Right a -> do
+        yield a
+        uncheckedPipe vlen 1 sd decoding mleftovers
+
+
 headedPipe :: (Monad m, Eq c2)
   => SiphonDecoding c1 c2 
   -> Decoding Headed c2 a
@@ -63,7 +81,7 @@ headedPipe sd decoding = do
   case Decoding.headedToIndexed headers decoding of
     Left headingErrs -> return (DecodingRowError 0 (RowErrorHeading headingErrs))
     Right indexedDecoding -> 
-      let requiredLength = Decoding.length indexedDecoding
+      let requiredLength = Vector.length headers
        in uncheckedPipe requiredLength 1 sd indexedDecoding mleftovers
   
 

siphon/test/Test.hs

@@ -0,0 +1,86 @@
+module Main (main) where
+
+import Test.QuickCheck                      (Gen, Arbitrary(..), choose)
+import Test.Framework                       (defaultMain, testGroup, Test)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Data.ByteString                      (ByteString)
+import Data.Either.Combinators
+import Colonnade.Types
+import Data.Functor.Contravariant           (contramap)
+import Data.Functor.Contravariant.Divisible (divided,conquered)
+import qualified Data.ByteString.Builder    as Builder
+import qualified Data.ByteString.Lazy       as LByteString
+import qualified Data.ByteString            as ByteString
+import qualified Data.ByteString.Char8      as BC8
+import qualified Colonnade.Decoding         as Decoding
+import qualified Colonnade.Encoding         as Encoding
+
+main :: IO ()
+main = defaultMain tests
+
+tests :: [Test]
+tests = []
+  [ testGroup "ByteString encode/decode" 
+    [ testProperty "Headless Isomorphism (int,char,bool)" 
+        $ propEncodeDecodeIso 
+          (ipv4ToTextNaive) 
+          (ipv4FromTextNaive)
+    ]
+  ]
+
+
+byteStringDecodeInt :: ByteString -> Either String Int
+byteStringDecodeInt b = do
+  (a,bsRem) <- maybe (Left "could not parse int") Right (BC8.readInt b)
+  if ByteString.null bsRem
+    then Right a
+    else Left "found extra characters after int"
+
+byteStringDecodeChar :: ByteString -> Either String Char
+byteStringDecodeChar b = case BC8.length b of
+  1 -> Right (BC8.head b)
+  0 -> Left "cannot decode Char from empty bytestring"
+  _ -> Left "cannot decode Char from multi-character bytestring"
+
+byteStringDecodeBool :: ByteString -> Either String Bool
+byteStringDecodeBool b
+  | b == BC8.pack "true" = Right True
+  | b == BC8.pack "false" = Right False
+  | otherwise = Left "must be true or false"
+
+byteStringEncodeChar :: Char -> ByteString
+byteStringEncodeChar = BC8.singleton
+
+byteStringEncodeInt :: Int -> ByteString
+byteStringEncodeInt = LByteString.toStrict
+                    . Builder.toLazyByteString 
+                    . Builder.intDec
+
+byteStringEncodeBool :: Bool -> ByteString
+byteStringEncodeBool x = case x of
+  True -> BC8.pack "true"
+  False -> BC8.pack "false"
+
+
+decodingA :: Decoding Headless ByteString (Int,Char,Bool)
+decodingA = (,,)
+  <$> Decoding.headless byteStringDecodeInt
+  <*> Decoding.headless byteStringDecodeChar
+  <*> Decoding.headless byteStringDecodeBool
+
+encodingA :: Encoding Headless ByteString (Int,Char,Bool)
+encodingA = contramap tripleToPairs
+  $ divided (Encoding.headless byteStringEncodeInt)
+  $ divided (Encoding.headless byteStringEncodeChar)
+  $ divided (Encoding.headless byteStringEncodeBool)
+  $ conquered 
+
+tripleToPairs :: (a,b,c) -> (a,(b,(c,())))
+tripleToPairs (a,b,c) = (a,(b,(c,())))
+
+propEncodeDecodeIso :: Eq a => (a -> b) -> (b -> Maybe a) -> a -> Bool
+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
+