From 4d591380a5a4c483027368314a76482d537986cb Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Sat, 9 Jul 2016 19:16:11 -0400 Subject: [PATCH] add more tests. make headed decoding work --- colonnade/colonnade.cabal | 1 + .../Colonnade/Encoding/ByteString/Char8.hs | 3 + colonnade/src/Colonnade/Encoding/Text.hs | 19 +++++ siphon/src/Siphon/Decoding.hs | 73 +++++++++-------- siphon/test/Test.hs | 81 +++++++++++++++++-- 5 files changed, 139 insertions(+), 38 deletions(-) create mode 100644 colonnade/src/Colonnade/Encoding/Text.hs diff --git a/colonnade/colonnade.cabal b/colonnade/colonnade.cabal index 0fd7222..d155e06 100644 --- a/colonnade/colonnade.cabal +++ b/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 diff --git a/colonnade/src/Colonnade/Encoding/ByteString/Char8.hs b/colonnade/src/Colonnade/Encoding/ByteString/Char8.hs index 35df8b5..54d3ca7 100644 --- a/colonnade/src/Colonnade/Encoding/ByteString/Char8.hs +++ b/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 + diff --git a/colonnade/src/Colonnade/Encoding/Text.hs b/colonnade/src/Colonnade/Encoding/Text.hs new file mode 100644 index 0000000..604e4c1 --- /dev/null +++ b/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 + diff --git a/siphon/src/Siphon/Decoding.hs b/siphon/src/Siphon/Decoding.hs index bc6b938..0369cd4 100644 --- a/siphon/src/Siphon/Decoding.hs +++ b/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 - 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 + e <- consumeGeneral 0 sd mkParseError + case e of + Left err -> return err + Right (firstRow, mleftovers) -> + let req = Decoding.maxIndex decoding + vlen = Vector.length firstRow + in 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 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 - case Decoding.headedToIndexed headers decoding of - Left headingErrs -> return (DecodingRowError 0 (RowErrorHeading headingErrs)) - Right indexedDecoding -> - let requiredLength = Vector.length headers - in uncheckedPipe requiredLength 1 sd indexedDecoding mleftovers + e <- consumeGeneral 0 sd mkParseError + case e of + Left err -> return err + Right (headers, mleftovers) -> + case Decoding.headedToIndexed headers decoding of + 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) -consumeGeneral = error "ahh" + -> Consumer' c m (Either e (Vector c, Maybe c)) +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 diff --git a/siphon/test/Test.hs b/siphon/test/Test.hs index 2be018c..a4b1150 100644 --- a/siphon/test/Test.hs +++ b/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 -testEncodingA = - ( ByteString.concat $ Pipes.toList $ - Pipes.yield (4,'c',False) >-> SE.pipe SC.byteStringChar8 encodingA - ) @?= "4,c,false\n" +runTestScenario :: (Monoid c, Eq c, Show c) + => Siphon c + -> (Siphon c -> Encoding f c (Int,Char,Bool) -> Pipe (Int,Char,Bool) c Identity ()) + -> Encoding f c (Int,Char,Bool) + -> 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 +