{-# 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