{-# LANGUAGE OverloadedLists, OverloadedStrings #-} import Data.Yaml.Combinators import Data.Functor import Test.Tasty import Test.Tasty.HUnit import Data.Aeson hiding (object) import qualified Data.Text as T import Data.Monoid import qualified Data.HashMap.Strict as HM main = defaultMain tests tests = testGroup "Data.Yaml.Combinators" [ testCase "Expect String, get String" $ runParser string (String "hi") @?= Right "hi" , testCase "Expect String, get Number" $ runParser string (Number 3) @?= Left (ParseError 0 $ ExpectedInsteadOf ["String"] (Number 3)) , testCase "Expect specific String, get another String" $ runParser (theString "bye") (String "hi") @?= Left (ParseError 0 $ ExpectedInsteadOf ["\"bye\""] (String "hi")) , testCase "Expect specific String or Number, get another string" $ runParser (theString "bye" <> void number) (String "hi") @?= Left (ParseError 0 $ ExpectedInsteadOf ["\"bye\""] (String "hi")) , testCase "Expect an array, get an array" $ runParser (array string) (Array [String "hi"]) @?= Right ["hi"] , testCase "Expect an array, get an object" $ runParser (array string) (Object HM.empty) @?= Left (ParseError 0 $ ExpectedInsteadOf ["Array"] (Object [])) , testCase "Expect an array of Strings, get an array of Numbers" $ runParser (array string) (Array [Number 3]) @?= Left (ParseError 1 $ ExpectedInsteadOf ["String"] (Number 3)) , testCase "Expect an object, get an object" $ runParser (object $ field "foo" number) (Object [("foo", Number 1)]) @?= Right 1 , testCase "Validated String, accepts anything" $ runParser (validate string Right) (String "foo") @?= Right "foo" , testCase "Validated String, rejects everything" $ runParser (validate string (const (Left "contrarianism" :: Either String String))) (String "foo") @?= Left (ParseError 1 (ExpectedInsteadOf ["contrarianism"] (String "foo"))) , testCase "Expect an object, get an array" $ runParser (object $ field "foo" number) (Array []) @?= Left (ParseError 0 $ ExpectedInsteadOf ["Object"] (Array [])) , testCase "Expect an object, get an object missing a field" $ runParser (object $ field "foo" number *> field "bar" string) (Object [("foo", Number 1)]) @?= Left (ParseError 1 $ ExpectedAsPartOf ["field \"bar\""] (Object ([("foo",Number 1.0)]))) , testCase "Expect an object, get an object with an extra field" $ runParser (object $ field "foo" number) (Object [("foo", Number 1), ("bar", String "x")]) @?= Left (ParseError 1 $ UnexpectedAsPartOf (Object [("bar", String "x")]) (Object [("foo", Number 1), ("bar", String "x")])) , testCase "Expect an object, get a field that doesn't match" $ runParser (object $ field "foo" number) (Object [("foo", String "hi")]) @?= Left (ParseError 1 $ ExpectedInsteadOf ["Number"] (String "hi")) , testCase "Expect an object with opt field, field present" $ runParser (object $ optField "foo" number) (Object [("foo", Number 1)]) @?= Right (Just 1) , testCase "Expect an object with opt field, field absent" $ runParser (object $ optField "foo" number) (Object []) @?= Right Nothing , testCase "Expect an object with default field, field present" $ runParser (object $ defaultField "foo" 7 number) (Object [("foo", Number 16309)]) @?= Right 16309 , testCase "Expect an object with default field, field present" $ runParser (object $ defaultField "foo" 7 number) (Object []) @?= Right 7 , testCase "Expect an array of number and string, get it" $ runParser (theArray $ (,) <$> element number <*> element string) (Array [Number 2, String "hi"]) @?= Right (2, "hi") , testCase "Expect an array of number and string, get only number" $ runParser (theArray $ (,) <$> element number <*> element string) (Array [Number 2]) @?= Left (ParseError 1 (ExpectedAsPartOf ["at least 2 elements"] (Array [Number 2]))) , testCase "Expect an array of number and string, get only string" $ runParser (theArray $ (,) <$> element number <*> element string) (Array [String "hi"]) @?= Left (ParseError 1 $ ExpectedInsteadOf ["Number"] (String "hi")) , testCase "Expect an array of number and string, get them and something else" $ runParser (theArray $ (,) <$> element number <*> element string) (Array [Number 2, String "hi", Number 42]) @?= Left (ParseError 1 $ UnexpectedAsPartOf (Number 42) (Array [Number 2.0,String "hi",Number 42])) , testCase "Wrong tag" $ runParser ((object (Nothing <$ theField "tag" "Nothing")) <> (object (Just <$ theField "tag" "Just" <*> field "value" number))) (Object [("tag", String "Nothing"), ("value", Number 3)]) @?= Left (ParseError 1 (UnexpectedAsPartOf (Object ([("value",Number 3.0)])) (Object ([("tag",String "Nothing"),("value",Number 3.0)])))) , testCase "More serious error takes precedence even though it happens later" $ runParser (theArray (element (object (pure ())) *> element number)) (Array [Object [("foo","bar")], String "baz"]) @?= Left (ParseError 1 (ExpectedInsteadOf ["Number"] (String "baz"))) , testCase "Prefer the branch with missing data to the branch with mismatched tag" $ do let p1 = object $ () <$ theField "tag" "one" <* field "a" string p2 = object $ () <$ theField "tag" "two" v = Object [("tag", String "one")] expected_result = Left (ParseError 1 (ExpectedAsPartOf ["field \"a\""] v )) runParser p1 v @?= expected_result runParser (p1 <> p2) v @?= expected_result runParser (p2 <> p1) v @?= expected_result , testCase "When a tag is mismatched, all alternatives get collected" $ do let p1 = object $ () <$ theField "tag" "one" <* field "a" string p2 = object $ () <$ theField "tag" "two" p3 = object $ () <$ theField "foo" "bar" <* theField "tag" "three" v = Object [("tag", String "xxx"),("garbage",Number 7)] expected_result = Left (ParseError 1 (ExpectedInsteadOf ["\"one\"", "\"two\"", "\"three\""] (String "xxx") )) runParser (p1 <> p2 <> p3) v @?= expected_result , testCase "Alternatives are only reported once" $ do let even_str = validate string $ \s -> if even (T.length s) then Right s else Left "even-length string" runParser (even_str <> even_str) (String "x") @?= Left (ParseError 1 (ExpectedInsteadOf ["even-length string"] (String "x"))) ]