{-# LANGUAGE OverloadedStrings #-}
import qualified Data.Attoparsec.ByteString as AB
import qualified Data.Attoparsec.Text as AT
import qualified Data.ByteString as BS
import Data.Char
import qualified Data.Machine.Attoparsec.ByteString as PB
import qualified Data.Machine.Attoparsec.Text as PT
import Data.Machine
import Data.Machine.Stack
import Test.Tasty
import Test.Tasty.HUnit
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Word
main :: IO ()
main = defaultMain tests
tests :: TestTree
tests = testGroup "Tests" [bsTests, tTests]
nl8 :: Word8
nl8 = fromIntegral (ord '\n')
parseLineT :: AT.Parser T.Text
parseLineT = AT.takeTill ((==) '\n') <* AT.char '\n'
parseLineBS :: AB.Parser BS.ByteString
parseLineBS = AB.takeTill ((==) nl8) <* AB.word8 nl8
testT :: T.Text
testT = "test"
testBS :: BS.ByteString
testBS = TE.encodeUtf8 testT
nlBS :: BS.ByteString
nlBS = TE.encodeUtf8 "\n"
bsTests :: TestTree
bsTests = testGroup "ByteString"
[ testCase "parse nothing" $ do
[] @=? (run $ source [] `stack` (PB.parse parseLineBS))
, testCase "parse no nl" $ do
[Left "not enough input"] @=? (run $ source [testBS] `stack` (PB.parse parseLineBS))
, testCase "parse with nl" $ do
[Right testBS] @=? (run $ source [testBS, nlBS] `stack` (PB.parse parseLineBS))
, testCase "parse starting mempty" $ do
[Right testBS] @=? (run $ source [mempty, testBS, nlBS] `stack` (PB.parse parseLineBS))
, testCase "parse middle mempty" $ do
[Right testBS] @=? (run $ source [testBS, mempty, nlBS] `stack` (PB.parse parseLineBS))
, testCase "many nothing" $ do
[] @=?
(run $ source [] `stack` (PB.many parseLineBS))
, testCase "many no nl" $ do
[Left "not enough input"] @=?
(run $ source [testBS] `stack` (PB.many parseLineBS))
, testCase "many" $ do
[Right testBS] @=?
(run $ source [testBS, nlBS] `stack` (PB.many parseLineBS))
, testCase "many multi-lines" $ do
[Right testBS, Right testBS] @=?
(run $ source [testBS, nlBS, testBS, nlBS] `stack` (PB.many parseLineBS))
, testCase "many multi-lines start mempty" $ do
[Right testBS, Right testBS] @=?
(run $ source [mempty, testBS, nlBS, testBS, nlBS] `stack` (PB.many parseLineBS))
, testCase "many multi-lines middle mempty" $ do
[Right testBS, Right testBS] @=?
(run $ source [testBS, mempty, nlBS, testBS, nlBS] `stack` (PB.many parseLineBS))
]
tTests :: TestTree
tTests = testGroup "Text"
[ testCase "parse nothing" $ do
[] @=? (run $ source [] `stack` (PT.parse parseLineT))
, testCase "parse no nl" $ do
[Left "not enough input"] @=? (run $ source [testT] `stack` (PT.parse parseLineT))
, testCase "parse with nl" $ do
[Right testT] @=? (run $ source [testT, "\n"] `stack` (PT.parse parseLineT))
, testCase "parse starting mempty" $ do
[Right testT] @=? (run $ source [mempty, testT, "\n"] `stack` (PT.parse parseLineT))
, testCase "parse middle mempty" $ do
[Right testT] @=? (run $ source [testT, mempty, "\n"] `stack` (PT.parse parseLineT))
, testCase "many nothing" $ do
[] @=?
(run $ source [] `stack` (PT.many parseLineT))
, testCase "many no nl" $ do
[Left "not enough input"] @=?
(run $ source [testT] `stack` (PT.many parseLineT))
, testCase "many" $ do
[Right testT] @=?
(run $ source [testT, "\n"] `stack` (PT.many parseLineT))
, testCase "many multi-lines" $ do
[Right testT, Right testT] @=?
(run $ source [testT, "\n", testT, "\n"] `stack` (PT.many parseLineT))
, testCase "many multi-lines start mempty" $ do
[Right testT, Right testT] @=?
(run $ source [mempty, testT, "\n", testT, "\n"] `stack` (PT.many parseLineT))
, testCase "many multi-lines middle mempty" $ do
[Right testT, Right testT] @=?
(run $ source [testT, mempty, "\n", testT, "\n"] `stack` (PT.many parseLineT))
]