siphon-0.8.2.0: test/Test.hs

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric     #-}

module Main (main) where

import Colonnade (headed,headless,Colonnade,Headed,Headless)
import Control.Exception
import Data.ByteString (ByteString)
import Data.Char (ord)
import Data.Either.Combinators
import Data.Functor.Contravariant           (contramap)
import Data.Functor.Contravariant.Divisible (divided,conquered)
import Data.Functor.Identity
import Data.Profunctor (lmap)
import Data.Text (Text)
import Data.Word (Word8)
import Debug.Trace
import GHC.Generics (Generic)
import Siphon.Types
import Streaming (Stream,Of(..))
import Test.Framework (defaultMain, testGroup, Test)
import Test.Framework.Providers.HUnit (testCase)
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.HUnit (Assertion,(@?=))
import Test.QuickCheck (Gen, Arbitrary(..), choose, elements, Property)
import Test.QuickCheck.Property (Result, succeeded, exception)

import qualified Data.Text as Text
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 Data.ByteString as B
import qualified Data.Vector as Vector
import qualified Colonnade as Colonnade
import qualified Siphon as S
import qualified Streaming.Prelude as SMP
import qualified Data.Text.Lazy as LText
import qualified Data.Text.Lazy.Builder as TBuilder
import qualified Data.Text.Lazy.Builder.Int as TBuilder

main :: IO ()
main = defaultMain tests

tests :: [Test]
tests =
  [ testGroup "ByteString encode/decode"
    [ testCase "Headed Encoding (int,char,bool)"
        $ runTestScenario [(4,intToWord8 (ord 'c'),False)]
            S.encodeCsvStreamUtf8
            encodingB
            $ ByteString.concat
              [ "number,letter,boolean\n"
              , "4,c,false\n"
              ]
    , testCase "Headed Encoding (int,char,bool) monoidal building"
        $ runTestScenario [(4,'c',False)]
            S.encodeCsvStreamUtf8
            encodingC
            $ ByteString.concat
              [ "boolean,letter\n"
              , "false,c\n"
              ]
    , testCase "Headed Encoding (escaped characters)"
        $ runTestScenario ["bob","there,be,commas","the \" quote"]
            S.encodeCsvStreamUtf8
            encodingF
            $ ByteString.concat
              [ "name\n"
              , "bob\n"
              , "\"there,be,commas\"\n"
              , "\"the \"\" quote\"\n"
              ]
    , testCase "Headed Decoding (int,char,bool)"
        $ ( runIdentity . SMP.toList )
            ( S.decodeCsvUtf8 decodingB
              ( mapM_ (SMP.yield . BC8.singleton) $ concat
                [ "number,letter,boolean\n"
                , "244,z,true\n"
                ]
              )
            ) @?= ([(244,intToWord8 (ord 'z'),True)] :> Nothing)
    , testCase "Headed Decoding (geolite)"
        $ ( runIdentity . SMP.toList )
            ( S.decodeCsvUtf8 decodingGeolite
              ( SMP.yield $ BC8.pack $ concat
                [ "network,autonomous_system_number,autonomous_system_organization\n"
                , "1,z,y\n"
                ]
              )
            ) @?= ([(1,intToWord8 (ord 'z'),intToWord8 (ord 'y'))] :> Nothing)
    , testCase "Headed Decoding (escaped characters, one big chunk)"
        $ ( runIdentity . SMP.toList )
            ( S.decodeCsvUtf8 decodingF
              ( SMP.yield $ BC8.pack $ concat
                [ "name\n"
                , "drew\n"
                , "\"martin, drew\"\n"
                ]
              )
            ) @?= (["drew","martin, drew"] :> Nothing)
    , testCase "Headed Decoding (escaped characters, character per chunk)"
        $ ( runIdentity . SMP.toList )
            ( S.decodeCsvUtf8 decodingF
              ( mapM_ (SMP.yield . BC8.singleton) $ concat
                [ "name\n"
                , "drew\n"
                , "\"martin, drew\"\n"
                ]
              )
            ) @?= (["drew","martin, drew"] :> Nothing)
    , testCase "Headed Decoding (escaped characters, character per chunk, CRLF)"
        $ ( runIdentity . SMP.toList )
            ( S.decodeCsvUtf8 decodingF
              ( mapM_ (SMP.yield . BC8.singleton) $ concat
                [ "name\r\n"
                , "drew\r\n"
                , "\"martin, drew\"\r\n"
                ]
              )
            ) @?= (["drew","martin, drew"] :> Nothing)
    , testCase "headedToIndexed" $
        let actual = S.headedToIndexed id (Vector.fromList ["letter","boolean","number"]) decodingG
         in case actual of
              Left e -> fail "headedToIndexed failed"
              Right actualInner -> 
                let expected = SiphonAp (Indexed 2 :: Indexed Text) (\_ -> Nothing)
                             $ SiphonAp (Indexed 0 :: Indexed Text) (\_ -> Nothing)
                             $ SiphonAp (Indexed 1 :: Indexed Text) (\_ -> Nothing)
                             $ SiphonPure (\_ _ _ -> ())
                 in case S.eqSiphonHeaders actualInner expected of
                      True -> pure ()
                      False -> fail $
                        "Expected " ++
                        S.showSiphonHeaders expected ++
                        " but got " ++
                        S.showSiphonHeaders actualInner
    , testCase "Indexed Decoding (int,char,bool)"
        $ ( runIdentity . SMP.toList )
            ( S.decodeIndexedCsvUtf8 3 indexedDecodingB
              ( mapM_ (SMP.yield . BC8.singleton) $ concat
                [ "244,z,true\n"
                ]
              )
            ) @?= ([(244,intToWord8 (ord 'z'),True)] :> Nothing)
    , testProperty "Headed Isomorphism (int,char,bool)"
        $ propIsoStream BC8.unpack
          (S.decodeCsvUtf8 decodingB)
          (S.encodeCsvStreamUtf8 encodingB)
    ]
  ]

intToWord8 :: Int -> Word8
intToWord8 = fromIntegral

data Foo = FooA | FooB | FooC
  deriving (Generic,Eq,Ord,Show,Read,Bounded,Enum)

instance Arbitrary Foo where
  arbitrary = elements [minBound..maxBound]

fooToString :: Foo -> String
fooToString x = case x of
  FooA -> "Simple"
  FooB -> "With,Escaped\nChars"
  FooC -> "More\"Escaped,\"\"Chars"

encodeFoo :: (String -> c) -> Foo -> c
encodeFoo f = f . fooToString

fooFromString :: String -> Maybe Foo
fooFromString x = case x of
  "Simple" -> Just FooA
  "With,Escaped\nChars" -> Just FooB
  "More\"Escaped,\"\"Chars" -> Just FooC
  _ -> Nothing

decodeFoo :: (c -> String) -> c -> Maybe Foo
decodeFoo f = fooFromString . f

decodingA :: Siphon Headless ByteString (Int,Char,Bool)
decodingA = (,,)
  <$> S.headless dbInt
  <*> S.headless dbChar
  <*> S.headless dbBool

decodingB :: Siphon Headed ByteString (Int,Word8,Bool)
decodingB = (,,)
  <$> S.headed "number" dbInt
  <*> S.headed "letter" dbWord8
  <*> S.headed "boolean" dbBool

indexedDecodingB :: Siphon Indexed ByteString (Int,Word8,Bool)
indexedDecodingB = (,,)
  <$> S.indexed 0 dbInt
  <*> S.indexed 1 dbWord8
  <*> S.indexed 2 dbBool

decodingG :: Siphon Headed Text ()
decodingG =
  S.headed "number" (\_ -> Nothing)
  <* S.headed "letter" (\_ -> Nothing)
  <* S.headed "boolean" (\_ -> Nothing)

decodingF :: Siphon Headed ByteString ByteString
decodingF = S.headed "name" Just

decodingGeolite :: Siphon Headed ByteString (Int,Word8,Word8)
decodingGeolite = (,,)
  <$> S.headed "network" dbInt
  <*> S.headed "autonomous_system_number" dbWord8
  <*> S.headed "autonomous_system_organization" dbWord8


encodingA :: Colonnade Headless (Int,Char,Bool) ByteString
encodingA = mconcat
  [ lmap fst3 (headless ebInt)
  , lmap snd3 (headless ebChar)
  , lmap thd3 (headless ebBool)
  ]

encodingW :: Colonnade Headless (Int,Char,Bool) Text
encodingW = mconcat
  [ lmap fst3 (headless etInt)
  , lmap snd3 (headless etChar)
  , lmap thd3 (headless etBool)
  ]

encodingY :: Colonnade Headless (Foo,Foo,Foo) Text
encodingY = mconcat
  [ lmap fst3 (headless $ encodeFoo Text.pack)
  , lmap snd3 (headless $ encodeFoo Text.pack)
  , lmap thd3 (headless $ encodeFoo Text.pack)
  ]

decodingY :: Siphon Headless Text (Foo,Foo,Foo)
decodingY = (,,)
  <$> S.headless (decodeFoo Text.unpack)
  <*> S.headless (decodeFoo Text.unpack)
  <*> S.headless (decodeFoo Text.unpack)

encodingF :: Colonnade Headed ByteString ByteString
encodingF = headed "name" id

encodingB :: Colonnade Headed (Int,Word8,Bool) ByteString
encodingB = mconcat
  [ lmap fst3 (headed "number" ebInt)
  , lmap snd3 (headed "letter" ebWord8)
  , lmap thd3 (headed "boolean" ebBool)
  ]

encodingC :: Colonnade Headed (Int,Char,Bool) ByteString
encodingC = mconcat
  [ lmap thd3 $ headed "boolean" ebBool
  , lmap snd3 $ headed "letter" ebChar
  ]

tripleToPairs :: (a,b,c) -> (a,(b,(c,())))
tripleToPairs (a,b,c) = (a,(b,(c,())))

propIsoStream :: (Eq a, Show a, Monoid c)
  => (c -> String)
  -> (Stream (Of c) Identity () -> Stream (Of a) Identity (Maybe SiphonError))
  -> (Stream (Of a) Identity () -> Stream (Of c) Identity ())
  -> [a]
  -> Result
propIsoStream toStr decode encode as =
  let asNew :> m = runIdentity $ SMP.toList $ decode $ encode $ SMP.each as
   in case m of
        Nothing -> if as == asNew
          then succeeded
          else exception ("expected " ++ show as ++ " but got " ++ show asNew) myException
        Just err ->
          let csv = toStr $ mconcat $ runIdentity $ SMP.toList_ $ encode $ SMP.each as
           in exception (S.humanizeSiphonError err ++ "\nGenerated CSV\n" ++ csv) myException

data MyException = MyException
  deriving (Show,Read,Eq)
instance Exception MyException

myException :: SomeException
myException = SomeException MyException

runTestScenario :: (Monoid c, Eq c, Show c, Eq a, Show a)
  => [a]
  -> (Colonnade f a c -> Stream (Of a) Identity () -> Stream (Of c) Identity ())
  -> Colonnade f a c
  -> c
  -> Assertion
runTestScenario as p e c =
  ( mconcat (runIdentity (SMP.toList_ (p e (mapM_ SMP.yield as))))
  ) @?= c

-- runCustomTestScenario :: (Monoid c, Eq c, Show c)
--   => Siphon c
--   -> (Siphon c -> Colonnade f a c -> Pipe a c Identity ())
--   -> Colonnade f a c
--   -> a
--   -> c
--   -> Assertion
-- runCustomTestScenario s p e a c =
--   ( mconcat $ Pipes.toList $
--     Pipes.yield a >-> 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

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


dbChar :: ByteString -> Maybe Char
dbChar b = case BC8.length b of
  1 -> Just (BC8.head b)
  _ -> Nothing

dbWord8 :: ByteString -> Maybe Word8
dbWord8 b = case B.length b of
  1 -> Just (B.head b)
  _ -> Nothing

dbInt :: ByteString -> Maybe Int
dbInt b = do
  (a,bsRem) <- BC8.readInt b
  if ByteString.null bsRem
    then Just a
    else Nothing

dbBool :: ByteString -> Maybe Bool
dbBool b
  | b == BC8.pack "true" = Just True
  | b == BC8.pack "false" = Just False
  | otherwise = Nothing

ebChar :: Char -> ByteString
ebChar = BC8.singleton

ebWord8 :: Word8 -> ByteString
ebWord8 = B.singleton

ebInt :: Int -> ByteString
ebInt = LByteString.toStrict
    . Builder.toLazyByteString 
    . Builder.intDec

ebBool :: Bool -> ByteString
ebBool x = case x of
  True -> BC8.pack "true"
  False -> BC8.pack "false"

ebByteString :: ByteString -> ByteString
ebByteString = id


etChar :: Char -> Text
etChar = Text.singleton

etInt :: Int -> Text
etInt = LText.toStrict
    . TBuilder.toLazyText
    . TBuilder.decimal

etText :: Text -> Text
etText = id

etBool :: Bool -> Text
etBool x = case x of
  True -> Text.pack "true"
  False -> Text.pack "false"