mirror of
https://github.com/byteverse/colonnade.git
synced 2024-10-26 08:03:25 +03:00
begin adding tests
This commit is contained in:
parent
45de414367
commit
e3c254a82e
@ -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 ::
|
||||
|
@ -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)
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
||||
|
86
siphon/test/Test.hs
Normal file
86
siphon/test/Test.hs
Normal file
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user