{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
module ConditionalRestriction.Parse.ParserLibSpec where
-- cannot import Fn specifically
import ConditionalRestriction (Result (..))
import ConditionalRestriction.Internal.Parse.ParserLib
( Parser (parse),
anyOf,
bint,
dbl,
noneOf,
shorten,
str,
strip,
tok,
word,
ws,
)
import Control.Applicative (Alternative (empty, (<|>)))
import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)
import Test.QuickCheck (property)
import Test.QuickCheck.Function -- cannot import Fn directly
{-# ANN spec "HLint: ignore Use <$>" #-} -- L31, ignore because <*> is the function we are testing, so we don't want to replace it with <$>
{-# ANN spec "HLint: ignore Alternative law, left identity" #-} -- L48, ignore because we are checking left identity
spec :: Spec
spec = do
describe "Show (Result e)" $ do
describe "show" $ do
it "shows Ok 'test' as Ok 'test'" $ show (Ok "test" :: Result String String) `shouldBe` "Ok \"test\""
describe "Applicative (Result e)" $ do
describe "pure" $ do
it "is the same as Ok" $ property $ \(x :: String) -> pure x == (Ok x :: Result String String)
describe "(<*>)" $ do
it "can apply any function" $ property $ \(Fn (f :: String -> String)) (x :: String) -> (pure f <*> pure x) == (pure (f x) :: Result String String)
describe "Monad (Result e)" $ do
describe "return" $ do
it "is the same as pure" $ property $ \(x :: String) -> return x == (pure x :: Result String String)
describe "Alternative (Parser i)" $ do
describe "empty" $ do
it "always throws an error" $
property $ \i -> case parse (empty :: Parser String String) i of
Err _ -> True
Ok _ -> False
describe "(<|>)" $ do
it "Chooses second option if first is erroneous" $ property $ \i -> parse (empty <|> str "") i == parse (str "") i
describe "Monad (Parser i)" $ do
describe "return" $ do
it "behaves the same as pure" $ property $ \(x :: String) (i :: String) -> parse (pure x) i == parse (return x) i
describe "(>>=)" $ do
it "parses the same as with applicatives" $
property $ \(x :: String) i ->
parse ((,) <$> str x <*> str x) i
== parse
( do
a <- str x
b <- str x
return (a, b)
)
i
describe "str" $ do
it "can parse any given string" $ property $ \(a, b) -> parse (str a) (a ++ b) == Ok (a, b)
describe "anyOf" $ do
it "can parse the char if it is in the list" $
property $ \c s ->
let shouldParse = c `elem` s
in case parse (anyOf s) [c] of
Err _ | not shouldParse -> True
Ok (_, "") | shouldParse -> True
_ -> False
describe "noneOf" $ do
it "can parse the char if it is not in the list" $
property $ \c s ->
let should_parse = c `notElem` s
in case parse (noneOf s) [c] of
Err _ | not should_parse -> True
Ok (_, "") | should_parse -> True
_ -> False
describe "ws" $ do
it "can parse a string containing only tabs, spaces and newlines" $
let s = "\t \n "
in parse ws s `shouldBe` Ok (s, "")
it "can parse an empty string" $
parse ws "" `shouldBe` Ok ("", "")
it "never outputs a result other than whitespace" $
property $ \s ->
let contains_other = any (`notElem` "\t\n ")
in case parse ws s of
Err _ -> True
Ok (res, _) -> not $ contains_other res
describe "word" $ do
it "can parse any given string followed by whitespace" $
property $ \(a, b) ->
case parse (word a) (a ++ " " ++ b) of
Ok (a', _) -> a == a'
_ -> False
describe "tok" $ do
it "can parse 'a b'" $ parse tok "a b" `shouldBe` Ok ("a", "b")
describe "dbl" $ do
it "can parse any double" $
property $ \(d :: Double) ->
parse dbl (show d) == Ok (d, "")
it "throws an error on invalid value 'a'" $
parse dbl "a" `shouldSatisfy` \case
Err !_ -> True
_ -> False
describe "bint" $ do
it "can parse its max value" $ property $ \i -> let i' = abs i in parse (bint i') (show i') == Ok (i', "")
describe "shorten" $ do
it "never outputs a string longer than given length" $
property $ \len s ->
length (shorten (abs len) s) <= abs len
describe "strip" $ do
it "never outputs a string starting with whitespace" $
property $ \s -> case strip s of
(c : cs) | c `elem` "\t\n " -> False
_ -> True
it "never outputs a string ending with whitespace" $
property $ \s -> case reverse $ strip s of
(c : cs) | c `elem` "\t\n " -> False
_ -> True