hnix/tests/ParserTests.hs

280 lines
10 KiB
Haskell
Raw Normal View History

2014-08-03 14:17:43 +02:00
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module ParserTests (tests) where
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.TH
import Data.Text (pack)
2014-08-03 14:17:43 +02:00
import qualified Data.Map as Map
2014-08-03 14:17:43 +02:00
import Nix.Types
import Nix.Parser
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
2014-08-03 14:17:43 +02:00
2014-08-16 00:16:12 +02:00
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"
2014-08-16 00:16:12 +02:00
assertParseFail "."
assertParseFail ".."
assertParseFail "/"
2014-08-03 14:17:43 +02:00
case_simple_set :: Assertion
case_simple_set = do
assertParseString "{ a = 23; b = 4; }" $ Fix $ NSet NonRec
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
[ 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 NonRec
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
[ NamedVar (mkSelector "e") $ mkInt 3
, Inherit Nothing [mkSelector "a", mkSelector "b"]
]
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
assertParseString "{ inherit; }" $ Fix $ NSet NonRec [ Inherit Nothing [] ]
case_set_scoped_inherit :: Assertion
case_set_scoped_inherit = assertParseString "{ inherit (a) b c; e = 4; inherit(a)b c; }" $ Fix $ NSet NonRec
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
[ Inherit (Just (mkSym "a")) [mkSelector "b", mkSelector "c"]
, NamedVar (mkSelector "e") $ mkInt 4
, Inherit (Just (mkSym "a")) [mkSelector "b", mkSelector "c"]
]
case_set_rec :: Assertion
case_set_rec = assertParseString "rec { a = 3; b = a; }" $ Fix $ NSet Rec
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
[ NamedVar (mkSelector "a") $ mkInt 3
, NamedVar (mkSelector "b") $ mkSym "a"
]
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
case_set_complex_keynames :: Assertion
case_set_complex_keynames = do
assertParseString "{ \"\" = null; }" $ Fix $ NSet NonRec
[ NamedVar [DynamicKey (Plain "")] mkNull ]
assertParseString "{ a.b = 3; a.c = 4; }" $ Fix $ NSet NonRec
[ NamedVar [StaticKey "a", StaticKey "b"] $ mkInt 3
, NamedVar [StaticKey "a", StaticKey "c"] $ mkInt 4
]
assertParseString "{ ${let a = \"b\"; in a} = 4; }" $ Fix $ NSet NonRec
[ NamedVar [DynamicKey (Antiquoted letExpr)] $ mkInt 4 ]
assertParseString "{ \"a${let a = \"b\"; in a}c\".e = 4; }" $ Fix $ NSet NonRec
[ NamedVar [DynamicKey (Plain str), StaticKey "e"] $ mkInt 4 ]
where
letExpr = Fix $ NLet [ NamedVar (mkSelector "a") (mkStr DoubleQuoted "b") ] (mkSym "a")
str = NString DoubleQuoted [Plain "a", Antiquoted letExpr, Plain "c"]
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
case_set_inherit_direct :: Assertion
case_set_inherit_direct = assertParseString "{ inherit ({a = 3;}); }" $ Fix $ NSet NonRec
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
[ flip Inherit [] $ Just $ Fix $ NSet NonRec [NamedVar (mkSelector "a") $ mkInt 3]
2014-08-03 14:17:43 +02:00
]
2014-08-15 23:30:24 +02:00
case_inherit_selector :: Assertion
case_inherit_selector = do
assertParseString "{ inherit \"a\"; }" $ Fix $ NSet NonRec
[ Inherit Nothing [ [DynamicKey (Plain "a")] ] ]
assertParseFail "{ inherit a.x; }"
2014-08-03 14:17:43 +02:00
case_int_list :: Assertion
case_int_list = assertParseString "[1 2 3]" $ Fix $ NList
[ mkInt i | i <- [1,2,3] ]
2014-08-03 14:17:43 +02:00
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]))
2014-08-15 23:30:24 +02:00
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 NonRec [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\")]"
2014-08-03 14:17:43 +02:00
case_simple_lambda :: Assertion
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
case_simple_lambda = assertParseString "a: a" $ Fix $ NAbs (FormalName "a") (mkSym "a")
2014-08-03 14:17:43 +02:00
case_lambda_or_uri :: Assertion
case_lambda_or_uri = do
assertParseString "a :b" $ Fix $ NAbs (FormalName "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")
assertParseFail "def:"
case_lambda_pattern :: Assertion
case_lambda_pattern = do
assertParseString "{b, c ? 1}: b" $
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
Fix $ NAbs (FormalSet args) (mkSym "b")
2014-08-16 00:16:12 +02:00
assertParseString "{ b ? x: x }: b" $
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
Fix $ NAbs (FormalSet args2) (mkSym "b")
assertParseString "a@{b,c ? 1}: b" $
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
Fix $ NAbs (FormalLeftAt "a" args) (mkSym "b")
assertParseString "{b,c?1}@a: c" $
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
Fix $ NAbs (FormalRightAt args "a") (mkSym "c")
assertParseFail "a@b: a"
assertParseFail "{a}@{b}: a"
where
args = FormalParamSet $ Map.fromList [("b", Nothing), ("c", Just $ mkInt 1)]
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
args2 = FormalParamSet $ Map.fromList [("b", Just lam)]
lam = Fix $ NAbs (FormalName "x") (mkSym "x")
2014-08-03 14:17:43 +02:00
case_lambda_app_int :: Assertion
case_lambda_app_int = assertParseString "(a: a) 3" $ Fix (NApp lam int) where
int = mkInt 3
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
lam = Fix (NAbs (FormalName "a") asym)
asym = mkSym "a"
2014-08-03 14:17:43 +02:00
case_simple_let :: Assertion
case_simple_let = do
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
assertParseString "let a = 4; in a" $ Fix (NLet binds $ mkSym "a")
assertParseFail "let a = 4 in a"
where
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
binds = [NamedVar (mkSelector "a") $ mkInt 4]
2014-08-03 14:17:43 +02:00
case_nested_let :: Assertion
case_nested_let = do
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
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
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
assertParseString "let a = null; inherit (b) c; in c" $ Fix $ NLet
[ NamedVar (mkSelector "a") mkNull, Inherit (Just $ mkSym "b") [mkSelector "c"] ]
(mkSym "c")
assertParseFail "let inherit (b) c in c"
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 DoubleQuoted $ 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
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
case_string_escape = do
assertParseString "\"\\$\\n\\t\\r\\\\\"" $ mkStr DoubleQuoted "$\n\t\r\\"
assertParseString "\" \\\" \\' \"" $ mkStr DoubleQuoted " \" ' "
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"
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
case_string_antiquote :: Assertion
case_string_antiquote = do
assertParseString "\"abc${ if true then \"def\" else \"abc\" } g\"" $
Fix $ NStr $ NString DoubleQuoted
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
[ Plain "abc"
, Antiquoted $ Fix $ NIf (mkBool True) (mkStr DoubleQuoted "def") (mkStr DoubleQuoted "abc")
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
, Plain " g"
]
assertParseString "\"\\${a}\"" $ mkStr DoubleQuoted "${a}"
antiquotes + improve pretty printer + restructure This commit improves the pretty printing and adds support for antiquotes. It also fixes an issue with the parser that caused `[if true then false else true]` to parse successfully, even though that is not a valid nix expression. The pretty printer now produces a lot more readable output and also supports operator precedences. The changes to the AST are: * strings are no longer atomic, because they may contain other expressions in the form of antiquotes. For strings, the new type NString is introduced and the constructor NStr is added to NExprF * the unused NVar constructor of NExprF is removed * operators are now represented uniformly so that the pretty printer can lookup information about operators (in particular, associativity and precedence) * the NArgs constructor is removed. The first argument of the NAbs constructor now directly represents the lambda arguments. * the select and the hasattr operator are moved into NExpr because they are special (they only accept a selector as second argument, and select also supports 'or') The list of operators is now in Types.hs and Parser.hs re-uses that list to build the parser. This is required because the pretty printer and parser both need access to operator precedences. Parser and evaluator also support dynamic attributes and attributes with dots now. As an example, `let b.a = 3; b.c = { e = {}; }; b.c.e.${"f"} = 4; in b` is parsed and evaluated correctly. As a side effect, NSym values now don't evaluate to themselves anymore, but instead to the value retrieved by looking up the variable in the current environment. Support for evaluating `inherit` bindings was removed because it was broken before (`{ inherit a; }` would evaluate to a set where the attribute `a` had the value `NSym a`, not the value of `a`). The manual Show instances for the AST were replaced by derived ones, because the manual instances often resulted in output were it was difficult to determine the missing parentheses.
2014-08-15 22:11:54 +02:00
assertParseFail "\"a"
assertParseFail "${true}"
assertParseFail "\"${true\""
2014-08-16 01:31:41 +02:00
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 NonRec []))
[ DynamicKey (Plain "") ] (Just mkNull)
2014-08-16 01:17:01 +02:00
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")
2014-08-16 01:17:01 +02:00
where select = Fix $ NSelect (mkSym "f") (mkSelector "b") Nothing
2014-08-16 00:16:12 +02:00
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_uri :: Assertion
case_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&/"
assertParseFail "http://foo${\"bar\"}"
assertParseFail ":bcdef"
assertParseFail "a%20:asda"
assertParseFail ".:adasd"
assertParseFail "+:acdcd"
case_indented_string :: Assertion
case_indented_string = do
assertParseString "''a''" $ mkStr Indented "a"
assertParseString "''\n foo\n bar''" $ mkStr Indented "foo\nbar"
assertParseString "'' ''" $ mkStr Indented ""
assertParseString "'''''''" $ mkStr Indented "''"
assertParseString "'' ${null}\n a${null}''" $ Fix $ NStr $ NString Indented
[ Antiquoted mkNull
, Plain "\na"
, Antiquoted mkNull
]
assertParseFail "'''''"
assertParseFail "'' '"
case_indented_string_escape :: Assertion
case_indented_string_escape = assertParseString
"'' ''\\n ''\\t ''\\\\ ''${ \\ \\n ' ''' ''" $
mkStr Indented "\n \t \\ ${ \\ \\n ' '' "
2014-08-03 14:17:43 +02:00
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
assertParseFail :: String -> Assertion
assertParseFail str = case parseNixString str of
Failure _ -> return ()
2014-08-15 23:30:24 +02:00
Success r -> assertFailure $ "Unexpected success parsing `" ++ str ++ ":\nParsed value: " ++ show r