mirror of
https://github.com/byteverse/colonnade.git
synced 2024-09-11 06:45:41 +03:00
add more tests. make headed decoding work
This commit is contained in:
parent
6a35f83550
commit
4d591380a5
@ -17,6 +17,7 @@ library
|
||||
exposed-modules:
|
||||
Colonnade.Types
|
||||
Colonnade.Encoding
|
||||
Colonnade.Encoding.Text
|
||||
Colonnade.Encoding.ByteString.Char8
|
||||
Colonnade.Decoding
|
||||
Colonnade.Decoding.ByteString.Char8
|
||||
|
@ -19,3 +19,6 @@ bool x = case x of
|
||||
True -> BC8.pack "true"
|
||||
False -> BC8.pack "false"
|
||||
|
||||
byteString :: ByteString -> ByteString
|
||||
byteString = id
|
||||
|
||||
|
19
colonnade/src/Colonnade/Encoding/Text.hs
Normal file
19
colonnade/src/Colonnade/Encoding/Text.hs
Normal file
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user