{-# LANGUAGE OverloadedStrings #-}
module Oden.Parser.ParseExprSpec where

import           Test.Hspec

import           Oden.Identifier
import           Oden.Parser
import           Oden.SourceInfo
import           Oden.Syntax

import           Oden.Assertions

src :: Line -> Column -> SourceInfo
src l c = SourceInfo (Position "<stdin>" l c)

spec :: Spec
spec = describe "parseExpr" $ do
  it "parses identifier" $
    parseExpr "foo"
    `shouldSucceedWith`
    Symbol (src 1 1) (Identifier "foo")

  it "parses single member access" $
    parseExpr "foo.bar"
    `shouldSucceedWith`
    MemberAccess
    (src 1 1)
    (Symbol (src 1 1) (Identifier "foo"))
    (Symbol (src 1 5) (Identifier "bar"))

  it "parses multiple member accesses" $
    parseExpr "foo.bar.baz"
    `shouldSucceedWith`
    MemberAccess
    (src 1 1)
    (MemberAccess
      (src 1 1)
      (Symbol (src 1 1) (Identifier "foo"))
      (Symbol (src 1 5) (Identifier "bar")))
    (Symbol (src 1 9) (Identifier "baz"))

  it "parses protocol method reference" $
    parseExpr "Foo::bar"
    `shouldSucceedWith`
    ProtocolMethodReference
    (src 1 1)
    (Symbol (src 1 1) (Identifier "Foo"))
    (Symbol (src 1 6) (Identifier "bar"))

  it "parses integer literal" $
    parseExpr "123"
    `shouldSucceedWith`
    Literal (src 1 1) (Int 123)

  it "parses float literal" $
    parseExpr "123.91239129312931293"
    `shouldSucceedWith`
    Literal (src 1 1) (Float 123.91239129312931293)

  it "parses false literal" $
    parseExpr "false"
    `shouldSucceedWith`
    Literal (src 1 1) (Bool False)

  it "parses true literal" $
    parseExpr "true"
    `shouldSucceedWith`
    Literal (src 1 1) (Bool True)

  it "parses string literal" $
    parseExpr "\"foo bar 123\""
    `shouldSucceedWith`
    Literal (src 1 1) (String "foo bar 123")

  it "parses fn expression" $
    parseExpr "(x) -> x"
    `shouldSucceedWith`
    Fn (src 1 1) [NameBinding (src 1 2) (Identifier "x")] (Symbol (src 1 8) (Identifier "x"))

  it "parses multi-arg fn expression" $
    parseExpr "(x, y, z) -> x"
    `shouldSucceedWith`
    Fn
    (src 1 1)
    [NameBinding (src 1 2) (Identifier "x"), NameBinding (src 1 5) (Identifier "y"), NameBinding (src 1 8) (Identifier "z")]
    (Symbol (src 1 14) (Identifier "x"))

  it "parses no-arg fn expression" $
    parseExpr "() -> x"
    `shouldSucceedWith`
    Fn (src 1 1) [] (Symbol (src 1 7) (Identifier "x"))

  it "parses if expression" $
    parseExpr "if a then b else c"
    `shouldSucceedWith`
    If
    (src 1 1)
    (Symbol (src 1 4) (Identifier "a"))
    (Symbol (src 1 11) (Identifier "b"))
    (Symbol (src 1 18) (Identifier "c"))

  it "parses empty block as unit literal" $
    parseExpr "()"
    `shouldSucceedWith`
    Literal (src 1 1) Unit

  it "parses expression in parens" $
    parseExpr "(())"
    `shouldSucceedWith`
    Literal (src 1 2) Unit

  it "parses tuple with two elements" $
    parseExpr "(1, ())"
    `shouldSucceedWith`
    Tuple
    (src 1 1)
    (Literal (src 1 2) (Int 1))
    (Literal (src 1 5) Unit)
    []

  it "parses tuple with three elements" $
    parseExpr "(1, (), 2)"
    `shouldSucceedWith`
    Tuple
    (src 1 1)
    (Literal (src 1 2) (Int 1))
    (Literal (src 1 5) Unit)
    [Literal (src 1 9) (Int 2)]

  it "parses block of symbols" $
    parseExpr "{\n  x\n  y\n  z\n}"
    `shouldSucceedWith`
    Block (src 1 1) [
        Symbol (src 2 3) (Identifier "x"),
        Symbol (src 3 3) (Identifier "y"),
        Symbol (src 4 3) (Identifier "z")
      ]

  it "parses let binding and block of symbol" $
    parseExpr "let x = y in { x }"
    `shouldSucceedWith`
    Let
    (src 1 1)
    [LetPair (src 1 5) (NameBinding (src 1 5) (Identifier "x")) (Symbol (src 1 9) (Identifier "y"))]
    (Block (src 1 14) [Symbol (src 1 16) (Identifier "x")])

  it "parses block with let binding and block of symbol" $
    parseExpr "{\n  let x = y in {\n    x\n  }\n}"
    `shouldSucceedWith`
    Block (src 1 1) [
        Let
        (src 2 3)
        [LetPair (src 2 7) (NameBinding (src 2 7) (Identifier "x")) (Symbol (src 2 11) (Identifier "y"))]
        (Block (src 2 16) [Symbol (src 3 5) (Identifier "x")])
      ]

  it "fails on if expression with newlines" pending
  it "fails on let expression with newlines" pending

  it "parses let expression" $
    parseExpr "let x = y in z"
    `shouldSucceedWith`
    Let
    (src 1 1)
    [LetPair (src 1 5) (NameBinding (src 1 5) (Identifier "x")) (Symbol (src 1 9) (Identifier "y"))]
    (Symbol (src 1 14) (Identifier "z"))

  it "parses unary negative operator application" $
    parseExpr "-x"
    `shouldSucceedWith`
    UnaryOp
    (src 1 1)
    Negate
    (Symbol (src 1 2) (Identifier "x"))

  it "parses binary operator application" $
    parseExpr "x + y"
    `shouldSucceedWith`
    BinaryOp
    (src 1 3)
    Add
    (Symbol (src 1 1) (Identifier "x"))
    (Symbol (src 1 5) (Identifier "y"))

  it "parses string concat application" $
    parseExpr "x ++ y"
    `shouldSucceedWith`
    BinaryOp
    (src 1 3)
    MonoidApply
    (Symbol (src 1 1) (Identifier "x"))
    (Symbol (src 1 6) (Identifier "y"))

  it "parses fn application with string concatenation" $
    parseExpr "foo(y) ++ \"!\""
    `shouldSucceedWith`
    BinaryOp
    (src 1 8)
    MonoidApply
    (Application
      (src 1 4)
      (Symbol (src 1 1) (Identifier "foo"))
      [Symbol (src 1 5) (Identifier "y")])
    (Literal (src 1 11) (String "!"))

  it "parses package member fn application" $
    parseExpr "foo.Bar(y)"
    `shouldSucceedWith`
    Application
    (src 1 8)
    (MemberAccess
      (src 1 1)
      (Symbol (src 1 1) (Identifier "foo"))
      (Symbol (src 1 5) (Identifier "Bar")))
    [Symbol (src 1 9) (Identifier "y")]

  it "parses fn application member access" $
    pending
    {-
    parseExpr "foo(y).Bar"
    `shouldSucceedWith`
    MemberAccess
    (src 1 8)
    (Application
      (src 1 1)
      (Symbol (src 1 1) (Identifier "foo"))
      [Symbol (src 1 5) (Identifier "y")])
    (Symbol (src 1 8) (Identifier "Bar"))
    -}

  it "parses protocol method application" $
    parseExpr "Foo::bar(y)"
    `shouldSucceedWith`
    Application
    (src 1 9)
    (ProtocolMethodReference
      (src 1 1)
      (Symbol (src 1 1) (Identifier "Foo"))
      (Symbol (src 1 6) (Identifier "bar")))
    [Symbol (src 1 10) (Identifier "y")]

  it "parses single-arg fn application" $
    parseExpr "x(y)"
    `shouldSucceedWith`
    Application
    (src 1 2)
    (Symbol (src 1 1) (Identifier "x"))
    [Symbol (src 1 3) (Identifier "y")]

  it "parses single-arg fn application" $
    parseExpr "((x) -> x)(y)"
    `shouldSucceedWith`
    Application
    (src 1 11)
    (Fn (src 1 2) [NameBinding (src 1 3) (Identifier "x")] (Symbol (src 1 9) (Identifier "x")))
    [Symbol (src 1 12) (Identifier "y")]

  it "ignores whitespace" $
    parseExpr "x(   \n\n y \r\n\t   )"
    `shouldSucceedWith`
    Application
    (src 1 2)
    (Symbol (src 1 1) (Identifier "x"))
    [Symbol (src 3 2) (Identifier "y")]

  it "ignores comments" $
    parseExpr "\n// foobar\nx"
    `shouldSucceedWith`
    Symbol (src 3 1) (Identifier "x")

  it "ignores multi-line comments" $
    parseExpr "/*\n\n foo //whatever\tbar\n*/x"
    `shouldSucceedWith`
    Symbol (src 4 3) (Identifier "x")

  it "parses slice literal" $
    parseExpr "[]{x, y, z}"
    `shouldSucceedWith`
    Slice (src 1 1) [
        Symbol (src 1 4) (Identifier "x"),
        Symbol (src 1 7) (Identifier "y"),
        Symbol (src 1 10) (Identifier "z")
      ]

  it "parses slice subscript" $
    parseExpr "a[b]"
    `shouldSucceedWith`
    Subscript (src 1 1)
      (Symbol (src 1 1) (Identifier "a"))
      [Singular (Symbol (src 1 3) (Identifier "b"))]

  it "parses sublices with closed beginning and end" $
    parseExpr "a[b:c]"
    `shouldSucceedWith`
    Subscript (src 1 1)
      (Symbol (src 1 1) (Identifier "a"))
      [Range (Symbol (src 1 3) (Identifier "b"))
              (Symbol (src 1 5) (Identifier "c"))]

  it "parses subslices with open start" $
    parseExpr "a[:c]"
    `shouldSucceedWith`
    Subscript (src 1 1)
      (Symbol (src 1 1) (Identifier "a"))
      [RangeTo (Symbol (src 1 4) (Identifier "c"))]

  it "parses subslices with open ending" $
    parseExpr "a[b:]"
    `shouldSucceedWith`
    Subscript (src 1 1)
      (Symbol (src 1 1) (Identifier "a"))
      [RangeFrom (Symbol (src 1 3) (Identifier "b"))]

  it "fails on subslices with open start and end" $
    shouldFail $ parseExpr "a[:]"

  it "parses record initializer" $
    parseExpr "{ size = 1 }"
    `shouldSucceedWith`
    RecordInitializer (src 1 1)
      [FieldInitializer (src 1 3) (Identifier "size") (Literal (src 1 10) (Int 1))]

  it "parses record initializer containing multiple fields" $
    parseExpr "{ size = 1, foo = \"foo\" }"
    `shouldSucceedWith`
    RecordInitializer (src 1 1)
      [FieldInitializer (src 1 3) (Identifier "size") (Literal (src 1 10) (Int 1))
      ,FieldInitializer (src 1 13) (Identifier "foo") (Literal (src 1 19) (String "foo"))]
