-- self-test.hs
module Main ( main ) where
import Language.Nix
import qualified Text.Parsec.Token as Parsec ( reservedNames )
import Test.DocTest
import Test.QuickCheck
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.HUnit.Base ( assertFailure, assertEqual )
gives :: (Show err, Eq a, Show a) => Either err a -> a -> Expectation
gives x y = either (assertFailure . msg) (assertEqual "" y) x
where msg z = "expected: " ++ show y ++ "\nbut got parser error: " ++ show z
parseFail :: Show a => NixParser a -> String -> Expectation
parseFail p input = parse p input `shouldSatisfy` either (const True) (const False)
main :: IO ()
main = do
doctest [ "Language/Nix.hs" ]
hspec $ do
describe "identifier" $ do
it "parses hand-picked sample inputs" $ do
parse identifier "abc" `gives` Ident "abc"
parse identifier "abc " `gives` Ident "abc"
parse identifier "__a-b-c-__ " `gives` Ident "__a-b-c-__"
prop "parses all randomly generated samples" $
forAll genIdentifier $ \input -> either (const False) (Ident input ==) (parse identifier input)
it "does not swallow leading whitespace" $
parseFail identifier " abc"
it "does not parse a de-referencing expression" $
parseFail identifier "abc.def"
it "does not accept reserved words" $
mapM_ (parseFail identifier) (Parsec.reservedNames nixLanguage)
it "accepts identifiers that are a prefix of a reserved word" $
parse identifier "lett" `gives` Ident "lett"
describe "scopedIdentifier" $ do
it "parses hand-picked sample inputs" $ do
parse scopedIdentifier "abc" `gives` SIdent ["abc"]
parse scopedIdentifier "abc " `gives` SIdent ["abc"]
parse scopedIdentifier "abc.def" `gives` SIdent ["abc","def"]
-- Need to implement pretty-printing again before this test can be used.
-- prop "parses all randomly generated samples" $
-- \sident -> either (const False) (sident ==) (parse scopedIdentifier (show (pretty sident)))
it "does not swallow leading whitespace" $
parseFail scopedIdentifier " abc"
it "does not accept reserved words" $
mapM_ (parseFail scopedIdentifier) (Parsec.reservedNames nixLanguage)
it "accepts identifiers that are a prefix of a reserved word" $
parse scopedIdentifier "lett" `gives` SIdent ["lett"]
describe "literal" $ do
-- This is not really true: "\n" gives "\\n", not a LF.
-- prop "parses all randomly generated literal strings" $
-- \str -> either (const False) (Lit str ==) (parse literal (show str))
prop "parses all randomly generated integers" $
\n -> either (const False) (Lit (show (abs (n::Int))) ==) (parse literal (show (abs n)))
it "parses paths" $
parse literal "claus/ist/der/beste" `gives` Lit "claus/ist/der/beste"
it "parses URIs" $
parse literal "http://example.org" `gives` Lit "http://example.org"
it "parses antiquotation" $ do
-- The literal parser is more or less useless for actually processing
-- the strings.
parse literal "''abc''${''" `gives` Lit "abc${"
parse literal "\"a${b}c\"" `gives` Lit "ac"
parse literal "\"a${if !x then \"b\" else \"c\"}d\"" `gives` Lit "ad"
parse literal "''a${if b then \"c\" else ''d''}e''" `gives` Lit "ae"
describe "attrSet" $ do
it "parses an empty attribute set" $ do
parse attrSet "{}" `gives` AttrSet False []
parse attrSet "rec {}" `gives` AttrSet True []
it "parses hand-picked sample inputs" $ do
parse attrSet "{ a = b; }" `gives` AttrSet False [Assign (SIdent ["a"]) (Ident "b")]
parse attrSet "{ a = b.c; }" `gives` AttrSet False [Assign (SIdent ["a"]) (Deref (Ident "b") (Ident "c"))]
parse attrSet "{ a = \"b\"; }" `gives` AttrSet False [Assign (SIdent ["a"]) (Lit "b")]
it "parses attribute sets as values of attribute sets" $
parse attrSet "{ a = { b = c; }; }" `gives` AttrSet False [Assign (SIdent ["a"]) (AttrSet False [Assign (SIdent ["b"]) (Ident "c")])]
it "expects assignments to terminated by a semicolon" $
parseFail attrSet "{ a = b }"
it "ignores comments" $
parse attrSet "{ /* foo */ a = /* bar */ b; # foobar\n }" `gives` AttrSet False [Assign (SIdent ["a"]) (Ident "b")]
it "parses recursive attribute sets" $
parse attrSet "rec { a = b; b = a; }" `gives` AttrSet True [Assign (SIdent ["a"]) (Ident "b"), Assign (SIdent ["b"]) (Ident "a")]
it "parses inherit statements" $ do
parse attrSet "{ inherit a; }" `gives` AttrSet False [Inherit (SIdent []) ["a"]]
parse attrSet "{ inherit a; inherit b; }" `gives` AttrSet False [Inherit (SIdent []) ["a"],Inherit (SIdent []) ["b"]]
parse attrSet "{ inherit a b; }" `gives` AttrSet False [Inherit (SIdent []) ["a","b"]]
parse attrSet "{ inherit (a) b c d; }" `gives` AttrSet False [Inherit (SIdent ["a"]) ["b","c","d"]];
-- The parser cannot handle this expample yet.
-- parse attrSet "{ inherit (import ./foo.nix) a b c; }" `gives` Lit "a"
describe "list" $ do
it "parses an empty list" $
parse list "[]" `gives` List []
it "parses hand-picked sample inputs" $ do
parse list "[ a b c ]" `gives` List [Ident "a",Ident "b",Ident "c"]
parse list "[ \"b\" { a = [\"c\"]; } d ]" `gives` List [Lit "b",AttrSet False [Assign (SIdent ["a"]) (List [Lit "c"])],Ident "d"]
parse list "[ (a b) c ]" `gives` List [Apply (Ident "a") (Ident "b"),Ident "c"]
parse list "[ 12 8 a 0 ]" `gives` List [Lit "12", Lit "8", Ident "a", Lit "0"]
describe "reserved" $ do
it "parses a specific reserved name" $ do
parse (reserved "let") "let" `gives` ()
parse (reserved "in") "in" `gives` ()
parse (reserved "rec") "rec" `gives` ()
parseFail (reserved "rec") "let"
it "recognizes if the keyword is actually just a prefix of the input string" $
parseFail (reserved "in") "input"
describe "expr" $ do
it "parses an empty attribute set" $ do
parse expr "{}" `gives` AttrSet False []
parse expr "rec {}" `gives` AttrSet True []
it "parses an empty list" $
parse expr "[]" `gives` List []
it "parses a de-referencing expression" $ do
parse expr "abc.def" `gives` Deref (Ident "abc") (Ident "def")
parse expr "a.b.c" `gives` Deref (Deref (Ident "a") (Ident "b")) (Ident "c")
it "parses recursive attribute sets" $
parse expr "rec { id = x: x; }" `gives` AttrSet True [Assign (SIdent ["id"]) (Fun (Ident "x") (Ident "x"))]
it "parses boolean expressions" $ do
parse expr "true" `gives` Ident "true"
parse expr "false" `gives` Ident "false"
parse expr "system == \"linux\"" `gives` Equal (Ident "system") (Lit "linux")
parse expr "system != \"linux\"" `gives` Inequal (Ident "system") (Lit "linux")
parse expr "true && true" `gives` And (Ident "true") (Ident "true")
parse expr "false || false" `gives` Or (Ident "false") (Ident "false")
parse expr "isLinux || isDarwin" `gives` Or (Ident "isLinux") (Ident "isDarwin")
parse expr "(isLinux || isDarwin)" `gives` Or (Ident "isLinux") (Ident "isDarwin")
parse expr "(isLinux) || (isDarwin)" `gives` Or (Ident "isLinux") (Ident "isDarwin")
parse expr "!(!isLinux) || (isDarwin)" `gives` Or (Not (Not (Ident "isLinux"))) (Ident "isDarwin")
parse expr "!a && b || c" `gives` Or (And (Not (Ident "a")) (Ident "b")) (Ident "c")
parse expr "a && b || c" `gives` Or (And (Ident "a") (Ident "b")) (Ident "c")
parse expr "a || b && c" `gives` Or (Ident "a") (And (Ident "b") (Ident "c"))
parse expr "(a -> b) -> c" `gives` Implies (Implies (Ident "a") (Ident "b")) (Ident "c")
it "parses simple lambda expressions" $ do
parse expr "x: {}" `gives` Fun (Ident "x") (AttrSet False [])
parse expr "x: y: rec{}" `gives` Fun (Ident "x") (Fun (Ident "y") (AttrSet True []))
it "parses attribute set patterns" $ do
parse expr "{}: {}" `gives` Fun (AttrSet False []) (AttrSet False [])
parse expr "{a ? b, c}: {}" `gives` Fun (AttrSetP Nothing [("a",Just (Ident "b")),("c",Nothing)]) (AttrSet False [])
parse expr "{ id = x: x; }" `gives` AttrSet False [Assign (SIdent ["id"]) (Fun (Ident "x") (Ident "x"))]
parse expr "{ a?null, b }: rec {}" `gives` Fun (AttrSetP Nothing [("a",Just (Ident "null")),("b",Nothing)]) (AttrSet True [])
parse expr "{ a?c.d }: {}" `gives` Fun (AttrSetP Nothing [("a",Just (Deref (Ident "c") (Ident "d")))]) (AttrSet False [])
parse expr "{ a?c.d, ... }: {}" `gives` Fun (AttrSetP Nothing [("a",Just (Deref (Ident "c") (Ident "d"))),("...",Nothing)]) (AttrSet False [])
parse expr "e@{ a?c.d, ... }: {}" `gives` Fun (AttrSetP (Just "e") [("a",Just (Deref (Ident "c") (Ident "d"))),("...",Nothing)]) (AttrSet False [])
it "ignores leading/trailing whitespace" $ do
parse expr " {}" `gives` AttrSet False []
parse expr "{} " `gives` AttrSet False []
parse expr " { } " `gives` AttrSet False []
it "ignores comments" $
parse expr "# foo\n/* bar \n */ { /* bla */ }" `gives` AttrSet False []
it "parses function application" $ do
parse expr "a b c" `gives` Apply (Apply (Ident "a") (Ident "b")) (Ident "c")
parse expr "a.b c" `gives` Apply (Deref (Ident "a") (Ident "b")) (Ident "c")
parse expr "a{b=c.d;}" `gives` Apply (Ident "a") (AttrSet False [Assign (SIdent ["b"]) (Deref (Ident "c") (Ident "d"))])
it "parses import statements" $ do
parse expr "(import ../some/function.nix) c" `gives` Apply (Import (Lit "../some/function.nix")) (Ident "c")
parse expr "let x = import ../some/function.nix; in x" `gives` Let [Assign (SIdent ["x"]) (Import (Lit "../some/function.nix"))] (Ident "x")
it "parses if-then-else statements" $
parse expr "if a b then c { inherit d; } else e" `gives` IfThenElse (Apply (Ident "a") (Ident "b")) (Apply (Ident "c") (AttrSet False [Inherit (SIdent []) ["d"]])) (Ident "e")
it "parses with statements" $
parse expr "with a; a" `gives` Apply (With (Ident "a")) (Ident "a")
describe "run" $ do
it "can evaluate simple data types" $ do
run "null" `gives` Null
run "true" `gives` Boolean True
run "false" `gives` Boolean False
run "\"null\"" `gives` Lit "null"
run "123" `gives` Lit "123"
run "http://example.org" `gives` Lit "http://example.org"
it "can evaluate hand-picked Nix expressions" $ do
run "rec { y = \"bar\"; f = x: \"foo\" + x; v = f y; }.v" `gives` Lit "foobar"
-- run "{ a.a.a=1; a.a.b=2; a.b=3; }" `gives` Lit "foo"
-- run "{ a.a.a=1; a.a.b=2; a.b=3; }.a.a.a" `gives` Lit "1"
run "bla or false" `gives` Boolean False
run "let a = \"foo\"; b = a; f = x: x+\"bar\"; in f b" `gives` Lit "foobar"
run "let a = { b = \"claus\"; }; b = \"bar\"; in { a = \"foo\"; inherit b; c = a.b; }" `gives` AttrSet False [Assign (SIdent ["a"]) (Lit "foo"),Assign (SIdent ["b"]) (Lit "bar"),Assign (SIdent ["c"]) (Lit "claus")]
run "let a = { b = \"claus\"; }; b = \"bar\"; in { a = \"foo\"; inherit b; c = a.b; }.c" `gives` Lit "claus"
run "let b = \"bar\"; in rec { a = \"foo\"; inherit b; c = a + b; }" `gives` AttrSet False [Assign (SIdent ["a"]) (Lit "foo"),Assign (SIdent ["b"]) (Lit "bar"),Assign (SIdent ["c"]) (Lit "foobar")]
run "let { a = \"foo\"; b = a; f = x: x+\"bar\"; body = f b; }" `gives` Lit "foobar"