hnix/tests/ParserTests.hs
2016-01-25 01:00:27 -06:00

347 lines
13 KiB
Haskell

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module ParserTests (tests) where
import Data.Fix
import Data.Text (pack)
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.TH
import qualified Data.Map as Map
import Nix.Atoms
import Nix.Expr
import Nix.Parser
import Nix.StringOperations
import Prelude
case_constant_int :: Assertion
case_constant_int = assertParseString "234" $ mkInt 234
case_constant_bool :: Assertion
case_constant_bool = do
assertParseString "true" $ mkBool True
assertParseString "false" $ mkBool False
case_constant_path :: Assertion
case_constant_path = do
assertParseString "./." $ mkPath False "./."
assertParseString "./+-_/cdef/09ad+-" $ mkPath False "./+-_/cdef/09ad+-"
assertParseString "/abc" $ mkPath False "/abc"
assertParseString "../abc" $ mkPath False "../abc"
assertParseString "<abc>" $ mkPath True "abc"
assertParseString "<../cdef>" $ mkPath True "../cdef"
assertParseString "a//b" $ mkOper2 NUpdate (mkSym "a") (mkSym "b")
assertParseString "rec+def/cdef" $ mkPath False "rec+def/cdef"
assertParseString "a/b//c/def//<g> < def/d" $ mkOper2 NLt
(mkOper2 NUpdate (mkPath False "a/b") $ mkOper2 NUpdate
(mkPath False "c/def") (mkPath True "g"))
(mkPath False "def/d")
assertParseString "a'b/c" $ Fix $ NApp (mkSym "a'b") (mkPath False "/c")
assertParseFail "."
assertParseFail ".."
assertParseFail "/"
assertParseFail "a/"
assertParseFail "a/def/"
case_constant_uri :: Assertion
case_constant_uri = do
assertParseString "a:a" $ mkUri "a:a"
assertParseString "http://foo.bar" $ mkUri "http://foo.bar"
assertParseString "a+de+.adA+-:%%%ads%5asdk&/" $ mkUri "a+de+.adA+-:%%%ads%5asdk&/"
assertParseString "rec+def:c" $ mkUri "rec+def:c"
assertParseString "f.foo:bar" $ mkUri "f.foo:bar"
assertParseFail "http://foo${\"bar\"}"
assertParseFail ":bcdef"
assertParseFail "a%20:asda"
assertParseFail ".:adasd"
assertParseFail "+:acdcd"
case_simple_set :: Assertion
case_simple_set = do
assertParseString "{ a = 23; b = 4; }" $ Fix $ NSet
[ NamedVar (mkSelector "a") $ mkInt 23
, NamedVar (mkSelector "b") $ mkInt 4
]
assertParseFail "{ a = 23 }"
case_set_inherit :: Assertion
case_set_inherit = do
assertParseString "{ e = 3; inherit a b; }" $ Fix $ NSet
[ NamedVar (mkSelector "e") $ mkInt 3
, Inherit Nothing $ StaticKey <$> ["a", "b"]
]
assertParseString "{ inherit; }" $ Fix $ NSet [ Inherit Nothing [] ]
case_set_scoped_inherit :: Assertion
case_set_scoped_inherit = assertParseString "{ inherit (a) b c; e = 4; inherit(a)b c; }" $ Fix $ NSet
[ Inherit (Just (mkSym "a")) $ StaticKey <$> ["b", "c"]
, NamedVar (mkSelector "e") $ mkInt 4
, Inherit (Just (mkSym "a")) $ StaticKey <$> ["b", "c"]
]
case_set_rec :: Assertion
case_set_rec = assertParseString "rec { a = 3; b = a; }" $ Fix $ NRecSet
[ NamedVar (mkSelector "a") $ mkInt 3
, NamedVar (mkSelector "b") $ mkSym "a"
]
case_set_complex_keynames :: Assertion
case_set_complex_keynames = do
assertParseString "{ \"\" = null; }" $ Fix $ NSet
[ NamedVar [DynamicKey (Plain "")] mkNull ]
assertParseString "{ a.b = 3; a.c = 4; }" $ Fix $ NSet
[ NamedVar [StaticKey "a", StaticKey "b"] $ mkInt 3
, NamedVar [StaticKey "a", StaticKey "c"] $ mkInt 4
]
assertParseString "{ ${let a = \"b\"; in a} = 4; }" $ Fix $ NSet
[ NamedVar [DynamicKey (Antiquoted letExpr)] $ mkInt 4 ]
assertParseString "{ \"a${let a = \"b\"; in a}c\".e = 4; }" $ Fix $ NSet
[ NamedVar [DynamicKey (Plain str), StaticKey "e"] $ mkInt 4 ]
where
letExpr = Fix $ NLet [ NamedVar (mkSelector "a") (mkStr "b") ] (mkSym "a")
str = DoubleQuoted [Plain "a", Antiquoted letExpr, Plain "c"]
case_set_inherit_direct :: Assertion
case_set_inherit_direct = assertParseString "{ inherit ({a = 3;}); }" $ Fix $ NSet
[ flip Inherit [] $ Just $ Fix $ NSet [NamedVar (mkSelector "a") $ mkInt 3]
]
case_inherit_selector :: Assertion
case_inherit_selector = do
assertParseString "{ inherit \"a\"; }" $ Fix $ NSet
[Inherit Nothing [DynamicKey (Plain "a")]]
assertParseFail "{ inherit a.x; }"
case_int_list :: Assertion
case_int_list = assertParseString "[1 2 3]" $ Fix $ NList
[ mkInt i | i <- [1,2,3] ]
case_int_null_list :: Assertion
case_int_null_list = assertParseString "[1 2 3 null 4]" $ Fix (NList (map (Fix . NConstant) [NInt 1, NInt 2, NInt 3, NNull, NInt 4]))
case_mixed_list :: Assertion
case_mixed_list = do
assertParseString "[{a = 3;}.a (if true then null else false) null false 4 [] c.d or null]" $ Fix $ NList
[ Fix (NSelect (Fix (NSet [NamedVar (mkSelector "a") (mkInt 3)])) (mkSelector "a") Nothing)
, Fix (NIf (mkBool True) mkNull (mkBool False))
, mkNull, mkBool False, mkInt 4, Fix (NList [])
, Fix (NSelect (mkSym "c") (mkSelector "d") (Just mkNull))
]
assertParseFail "[if true then null else null]"
assertParseFail "[a ? b]"
assertParseFail "[a : a]"
assertParseFail "[${\"test\")]"
case_simple_lambda :: Assertion
case_simple_lambda = assertParseString "a: a" $ Fix $ NAbs (Param "a") (mkSym "a")
case_lambda_or_uri :: Assertion
case_lambda_or_uri = do
assertParseString "a :b" $ Fix $ NAbs (Param "a") (mkSym "b")
assertParseString "a c:def" $ Fix $ NApp (mkSym "a") (mkUri "c:def")
assertParseString "c:def: c" $ Fix $ NApp (mkUri "c:def:") (mkSym "c")
assertParseString "a:{}" $ Fix $ NAbs (Param "a") $ Fix $ NSet []
assertParseString "a:[a]" $ Fix $ NAbs (Param "a") $ Fix $ NList [mkSym "a"]
assertParseFail "def:"
case_lambda_pattern :: Assertion
case_lambda_pattern = do
assertParseString "{b, c ? 1}: b" $
Fix $ NAbs (fixed args Nothing) (mkSym "b")
assertParseString "{ b ? x: x }: b" $
Fix $ NAbs (fixed args2 Nothing) (mkSym "b")
assertParseString "a@{b,c ? 1}: b" $
Fix $ NAbs (fixed args (Just "a")) (mkSym "b")
assertParseString "{b,c?1}@a: c" $
Fix $ NAbs (fixed args (Just "a")) (mkSym "c")
assertParseString "{b,c?1,...}@a: c" $
Fix $ NAbs (variadic vargs (Just "a")) (mkSym "c")
assertParseString "{...}: 1" $
Fix $ NAbs (variadic mempty Nothing) (mkInt 1)
assertParseFail "a@b: a"
assertParseFail "{a}@{b}: a"
where
fixed args mname = ParamSet (FixedParamSet args) mname
variadic args mname = ParamSet (VariadicParamSet args) mname
args = Map.fromList [("b", Nothing), ("c", Just $ mkInt 1)]
vargs = Map.fromList [("b", Nothing), ("c", Just $ mkInt 1)]
args2 = Map.fromList [("b", Just lam)]
lam = Fix $ NAbs (Param "x") (mkSym "x")
case_lambda_app_int :: Assertion
case_lambda_app_int = assertParseString "(a: a) 3" $ Fix (NApp lam int) where
int = mkInt 3
lam = Fix (NAbs (Param "a") asym)
asym = mkSym "a"
case_simple_let :: Assertion
case_simple_let = do
assertParseString "let a = 4; in a" $ Fix (NLet binds $ mkSym "a")
assertParseFail "let a = 4 in a"
where
binds = [NamedVar (mkSelector "a") $ mkInt 4]
case_nested_let :: Assertion
case_nested_let = do
assertParseString "let a = 4; in let b = 5; in a" $ Fix $ NLet
[ NamedVar (mkSelector "a") $ mkInt 4 ]
(Fix $ NLet [NamedVar (mkSelector "b") $ mkInt 5] $ mkSym "a")
assertParseFail "let a = 4; let b = 3; in b"
case_let_scoped_inherit :: Assertion
case_let_scoped_inherit = do
assertParseString "let a = null; inherit (b) c; in c" $ Fix $ NLet
[ NamedVar (mkSelector "a") mkNull
, Inherit (Just $ mkSym "b") [StaticKey "c"] ]
(mkSym "c")
assertParseFail "let inherit (b) c in c"
case_if :: Assertion
case_if = do
assertParseString "if true then true else false" $ Fix $ NIf (mkBool True) (mkBool True) (mkBool False)
assertParseFail "if true then false"
assertParseFail "else"
assertParseFail "if true then false else"
assertParseFail "if true then false else false else"
assertParseFail "1 + 2 then"
case_identifier_special_chars :: Assertion
case_identifier_special_chars = do
assertParseString "_a" $ mkSym "_a"
assertParseString "a_b" $ mkSym "a_b"
assertParseString "a'b" $ mkSym "a'b"
assertParseString "a''b" $ mkSym "a''b"
assertParseString "a-b" $ mkSym "a-b"
assertParseString "a--b" $ mkSym "a--b"
assertParseString "a12a" $ mkSym "a12a"
assertParseFail ".a"
assertParseFail "'a"
makeStringParseTest :: String -> Assertion
makeStringParseTest str = assertParseString ("\"" ++ str ++ "\"") $ mkStr $ pack str
case_simple_string :: Assertion
case_simple_string = mapM_ makeStringParseTest ["abcdef", "a", "A", " a a ", ""]
case_string_dollar :: Assertion
case_string_dollar = mapM_ makeStringParseTest ["a$b", "a$$b", "$cdef", "gh$i"]
case_string_escape :: Assertion
case_string_escape = do
assertParseString "\"\\$\\n\\t\\r\\\\\"" $ mkStr "$\n\t\r\\"
assertParseString "\" \\\" \\' \"" $ mkStr " \" ' "
case_string_antiquote :: Assertion
case_string_antiquote = do
assertParseString "\"abc${ if true then \"def\" else \"abc\" } g\"" $
Fix $ NStr $ DoubleQuoted
[ Plain "abc"
, Antiquoted $ Fix $ NIf (mkBool True) (mkStr "def") (mkStr "abc")
, Plain " g"
]
assertParseString "\"\\${a}\"" $ mkStr "${a}"
assertParseFail "\"a"
assertParseFail "${true}"
assertParseFail "\"${true\""
case_select :: Assertion
case_select = do
assertParseString "a . e .di. f" $ Fix $ NSelect (mkSym "a")
[ StaticKey "e", StaticKey "di", StaticKey "f" ]
Nothing
assertParseString "a.e . d or null" $ Fix $ NSelect (mkSym "a")
[ StaticKey "e", StaticKey "d" ]
(Just mkNull)
assertParseString "{}.\"\"or null" $ Fix $ NSelect (Fix (NSet []))
[ DynamicKey (Plain "") ] (Just mkNull)
case_select_path :: Assertion
case_select_path = do
assertParseString "f ./." $ Fix $ NApp (mkSym "f") (mkPath False "./.")
assertParseString "f.b ../a" $ Fix $ NApp select (mkPath False "../a")
assertParseString "{}./def" $ Fix $ NApp (Fix (NSet [])) (mkPath False "./def")
assertParseString "{}.\"\"./def" $ Fix $ NApp
(Fix $ NSelect (Fix (NSet [])) [DynamicKey (Plain "")] Nothing)
(mkPath False "./def")
where select = Fix $ NSelect (mkSym "f") (mkSelector "b") Nothing
case_fun_app :: Assertion
case_fun_app = do
assertParseString "f a b" $ Fix $ NApp (Fix $ NApp (mkSym "f") (mkSym "a")) (mkSym "b")
assertParseString "f a.x or null" $ Fix $ NApp (mkSym "f") $ Fix $
NSelect (mkSym "a") (mkSelector "x") (Just mkNull)
assertParseFail "f if true then null else null"
case_indented_string :: Assertion
case_indented_string = do
assertParseString "''a''" $ mkIndentedStr "a"
assertParseString "''\n foo\n bar''" $ mkIndentedStr "foo\nbar"
assertParseString "'' ''" $ mkIndentedStr ""
assertParseString "'''''''" $ mkIndentedStr "''"
assertParseString "'' ${null}\n a${null}''" $ Fix $ NStr $ Indented
[ Antiquoted mkNull
, Plain "\na"
, Antiquoted mkNull
]
assertParseFail "'''''"
assertParseFail "'' '"
case_indented_string_escape :: Assertion
case_indented_string_escape = assertParseString
"'' ''\\n ''\\t ''\\\\ ''${ \\ \\n ' ''' ''" $
mkIndentedStr "\n \t \\ ${ \\ \\n ' '' "
case_operator_fun_app :: Assertion
case_operator_fun_app = do
assertParseString "a ++ b" $ mkOper2 NConcat (mkSym "a") (mkSym "b")
assertParseString "a ++ f b" $ mkOper2 NConcat (mkSym "a") $ Fix $ NApp
(mkSym "f") (mkSym "b")
case_operators :: Assertion
case_operators = do
assertParseString "1 + 2 - 3" $ mkOper2 NMinus
(mkOper2 NPlus (mkInt 1) (mkInt 2)) (mkInt 3)
assertParseFail "1 + if true then 1 else 2"
assertParseString "1 + (if true then 2 else 3)" $ mkOper2 NPlus (mkInt 1) $ Fix $ NIf
(mkBool True) (mkInt 2) (mkInt 3)
assertParseString "{ a = 3; } // rec { b = 4; }" $ mkOper2 NUpdate
(Fix $ NSet [NamedVar (mkSelector "a") (mkInt 3)])
(Fix $ NRecSet [NamedVar (mkSelector "b") (mkInt 4)])
assertParseString "--a" $ mkOper NNeg $ mkOper NNeg $ mkSym "a"
assertParseString "a - b - c" $ mkOper2 NMinus
(mkOper2 NMinus (mkSym "a") (mkSym "b")) $
mkSym "c"
assertParseString "foo<bar" $ mkOper2 NLt (mkSym "foo") (mkSym "bar")
assertParseFail "+ 3"
assertParseFail "foo +"
case_comments :: Assertion
case_comments = do
Success expected <- parseNixFile "data/let.nix"
assertParseFile "let-comments-multiline.nix" expected
assertParseFile "let-comments.nix" expected
tests :: TestTree
tests = $testGroupGenerator
--------------------------------------------------------------------------------
assertParseString :: String -> NExpr -> Assertion
assertParseString str expected = case parseNixString str of
Success actual -> assertEqual ("When parsing " ++ str) expected actual
Failure err -> assertFailure $ "Unexpected error parsing `" ++ str ++ "':\n" ++ show err
assertParseFile :: FilePath -> NExpr -> Assertion
assertParseFile file expected = do
res <- parseNixFile $ "data/" ++ file
case res of
Success actual -> assertEqual ("Parsing data file " ++ file) expected actual
Failure err -> assertFailure $ "Unexpected error parsing data file `" ++ file ++ "':\n" ++ show err
assertParseFail :: String -> Assertion
assertParseFail str = case parseNixString str of
Failure _ -> return ()
Success r -> assertFailure $ "Unexpected success parsing `" ++ str ++ ":\nParsed value: " ++ show r