lexer-applicative-1.1: tests/test.hs

{-# LANGUAGE ScopedTypeVariables #-}
import Test.Tasty
import Test.Tasty.HUnit

import Language.Lexer.Applicative
import Text.Regex.Applicative
import Text.Regex.Applicative.Common
import Data.Char
import Data.Loc (L(..), Loc(..), Pos(..))
import Control.Exception
import Control.DeepSeq

whitespace = () <$ some (psym isSpace)

unloc (L l a) = (a, l)

-- this is bad, because it accepts an empty string
badWhitespace = () <$ many (psym isSpace)

main = defaultMain $ testGroup "Tests"
  [ testCase "Empty string" $
      tokens (empty :: RE Char Int) empty "-" "" @=? []
  , testCase "Space- and newline-separated numbers" $
      unloc <$> tokens decimal whitespace "-" "1\n 23  456" @?=
      [ (1,  Loc (Pos "-" 1 1 0) (Pos "-" 1 1 0))
      , (23, Loc (Pos "-" 2 2 3) (Pos "-" 2 3 4))
      , (456,Loc (Pos "-" 2 6 7) (Pos "-" 2 8 9))
      ]
  , testCase "Nullable parser, no error" $ do
      r <- try . evaluate $ tokens decimal badWhitespace "-" "31 45"
      case r of
        Right (_ :: [L Int]) -> return ()
        Left (e :: SomeException) -> assertFailure $ show e
  , testCase "Nullable parser, error" $ do
      r <- try . evaluate . force $ tokens decimal badWhitespace "-" "31? 45"
      case r of
        Right (_ :: [L Int]) -> assertFailure "No error?"
        Left (LexicalError p) -> p @?= Pos "-" 1 3 2
  ]

-- orphan
instance NFData a => NFData (L a) where
  rnf (L loc a) = loc `seq` rnf a