require 'test/spec'

require 'theme.tab.rb'

def T(code)
  ThemeParser.new.parse(code)
end

describe "ThemeParser" do
  it "should parse atoms" do
    T("Foo").should.equal Atom.new("Foo")
    T("Foo_Bar").should.equal Atom.new("Foo_Bar")
    T("Foo23").should.equal Atom.new("Foo23")

    T("foo").should.not.be.kind_of Atom
    T("_Foo").should.not.be.kind_of Atom
    T("Foo-Bar").should.not.be.kind_of Atom

    should.raise(Theme::LexError) { T("23Foo") }
  end

  it "should parse identifiers" do
    T("foo").should.equal Variable.new("foo")
    T("foo_bar").should.equal Variable.new("foo_bar")
    T("foo23").should.equal Variable.new("foo23")
    T("_").should.equal Variable.new("_")
    T("_bar").should.equal Variable.new("_bar")

    T("Foo").should.not.be.kind_of Variable
    T("foo-bar").should.not.be.kind_of Variable

    should.raise(Theme::LexError) { T("23foo") }
  end

  it "should parse operators in parens as identifiers" do
    T("(+)").should.equal Variable.new("+")
    T("(-)").should.equal Variable.new("-")

    T("(//~~)").should.equal Variable.new("//~~")

    should.raise(Theme::ParseError) { T("(|)") }
    should.raise(Theme::ParseError) { T("(,)") }
    should.raise(Theme::ParseError) { T("(=)") }
    should.raise(Theme::ParseError) { T("(`)") }

    T("(||)").should.equal Variable.new("||")
    T("(==)").should.equal Variable.new("==")

    should.raise(Theme::ParseError) { T("(``)") }
    should.raise(Theme::ParseError) { T("(,,)") }
  end

  it "should parse tuples" do
    T("V[X,Y]").should.be.kind_of Tuple
    T("V[X,Y,Z]").should.be.kind_of Tuple

    T("V[]").should.be.kind_of Tuple
    T("V[X]").should.be.kind_of Tuple
    
    T("(X)").should.not.be.kind_of Tuple

    should.raise(Theme::ParseError) { T("V[A,]") }
    should.raise(Theme::ParseError) { T("V[,A]") }
    should.raise(Theme::ParseError) { T("[A,]") }
    should.raise(Theme::ParseError) { T("[,A]") }
    should.raise(Theme::ParseError) { T("[A]") }
    should.raise(Theme::ParseError) { T("[]") }
  end

  it "should parse function calls" do
    T("foo bar").should.be.kind_of Call
    T("foo(bar)").should.be.kind_of Call
    T("(foo -> foo)(bar)").should.be.kind_of Call

    T("foo V[bar, quux]").should.be.kind_of Call
    T("foo V[bar, quux, meh]").should.be.kind_of Call

    should.raise(Theme::ParseError) { T("foo()") }
  end

  it "should parse operator calls" do
    T("a + b").should.be.kind_of Call
    T("a ++ b").should.be.kind_of Call
    T("a +++ b").should.be.kind_of Call

    T("a + b + c").should.be.kind_of Call

    T("a `op` b").should.be.kind_of Call
    T("a :+: b").should.be.kind_of Call

    should.raise(Theme::ParseError) { T("a , b") }
    should.raise(Theme::ParseError) { T("a | b") }
  end

  it "should parse lambdas" do
    T("a -> b").should.be.kind_of Lambda
    T("(a) -> b").should.be.kind_of Lambda
    T("a -> b -> b").should.be.kind_of Lambda
    T("X(a) -> b").should.be.kind_of Lambda

    should.raise(Theme::ParseError) { T("(a ->)") }
    should.raise(Theme::ParseError) { T("(-> b)") }
  end

  it "should parse lambda chains" do
    T("a -> b | c -> d").should.be.kind_of Chain
    T("a -> b | c -> d | e -> f").should.be.kind_of Chain

    should.raise(Theme::ParseError) { T("a -> b |") }
    should.raise(Theme::ParseError) { T("| a -> b") }
  end

  it "should parse/desugar where clauses" do
    T("a where b = c").should.be.kind_of Call
    T("a where b = c where e = f").should.be.kind_of Call
    T("a where b = (c where e = f)").should.be.kind_of Call

    should.raise(Theme::ParseError) { T("a where b") }
  end

  it "should parse/desugar let clauses" do
    T("let a = b in c").should.be.kind_of Call
    T("let a = b in let c = d in e").should.be.kind_of Call

    should.raise(Theme::ParseError) { T("let a = b") }
  end

  it "should parse/desugar case clauses" do
    T("case a of (b -> c)").should.be.kind_of Call
    T("case a of (b -> case d of (e -> f))").should.be.kind_of Call

    should.raise(Theme::ParseError) { T("case a of") }
    should.raise(Theme::ParseError) { T("case a of b") }
  end

  it "should remove line comments" do
    T("#foo\nfoo").should.equal Variable.new("foo")
    T("foo#foo").should.equal Variable.new("foo")
  end
end


describe "Theme evaluator" do
  it "should not evaluate primitive values" do
    T("Foo").eval.should.equal T("Foo")
    T("a -> b").eval.should.equal T("a -> b")
    T("a -> b | c -> d").eval.should.equal T("a -> b | c -> d")
  end

  it "should reduce tuples" do
    T("Foo[Bar[Quux]]").eval.
      should.be.equal Tuple.new(Atom.new("Foo"),
                                [Tuple.new(Atom.new("Bar"),
                                           [Atom.new("Quux")])])
  end

  it "should evaluate simple lambdas" do
    T("(a -> a)(I)").eval.should.equal T("I").eval
    T("(a -> X[a])(I)").eval.should.equal T("X[I]").eval
    T("(a -> X[a,a])(I)").eval.should.equal T("X[I, I]").eval
    T("(Z[a, b] -> X[a,b]) Z[I, J]").eval.should.equal T("X[I, J]").eval
    T("(a -> b -> X[a,b]) I J").eval.should.equal T("X[I, J]").eval
  end

  it "should do correct beta reduction" do
    T("(x -> (y -> x))(Z)").eval.should.equal T("y -> Z")
    T("(x -> (x -> x))(Z)").eval.should.equal T("x -> x")

    T("(x -> (x -> x | y -> x | y -> y))(Z)").eval.
      should.equal T("x -> x | y -> Z | y -> y")

    T("(x -> y -> (x -> P[x, y])) Z Z").eval.should.equal T("x -> P[x, Z]")
  end

  it "should evaluate where correctly" do
    T("x where x = Z").eval.should.equal T("Z")
    T("x where x = P[y,y] where y = Z").eval.should.equal T("P[Z, Z]").eval
  end

  it "should pattern-match by length" do
    T("(one -> One)(X)").eval.should.equal T("One")
    T("(T[one, two] -> Two) T[X, Y]").eval.should.equal T("Two")

    T("(T[one, two] -> Two | T[one] -> One) T[X]").eval.should.equal T("One")
    T("(T[one, two] -> Two | T[one] -> One) T[X, Y]").eval.should.equal T("Two")
    T("(T[x,y] -> Two | T[x,y,z] -> Three | T[x] -> One) T[X,Y,Z]").eval.should.equal T("Three")
  end

  it "should pattern-match by structure" do
    T("(One -> Two | Two -> Three | _ -> NoIdea)(One)").eval.
      should.equal T("Two")
    T("(One -> Two | Two -> Three | _ -> NoIdea)(Two)").eval.
      should.equal T("Three")
    T("(One -> Two | Two -> Three | _ -> NoIdea)(Three)").eval.
      should.equal T("NoIdea")

    T("(Box[item] -> item)(Box[Gift])").eval.should.equal T("Gift")
    T("(Z -> X)(Z)").eval.should.equal T("X")
    T("(B[Z] -> X)(B[Z])").eval.should.equal T("X")

    T("(B[Z] -> X)(B[W])").eval.should.equal T("NoMatch[B[W]]").eval
  end

  it "should pattern-match by predicate" do
    T("(x(z) -> True | _ -> False)(Z) where x = Z -> True").eval.
      should.equal T("True")
    T("(x(z) -> z | _ -> False)(Z) where x = Z -> True").eval.
      should.equal T("Z")

    T("(y(z) -> z | _ -> False)(X) where y = Y -> True | Z -> True").eval.
      should.equal T("False")
    T("(y(z) -> z | _ -> False)(Y) where y = Y -> True | Z -> True").eval.
      should.equal T("Y")

    T("(x(d) -> d)(Z) where x = X -> True").
      eval.should.equal T("NoMatch[Z]").eval
    T("(x(d) -> d)(X) where x = X -> True").
      eval.should.equal T("X")

    T("List[react(GoodGuy), react(GoodGuy2), react(BadGuy), react(Stranger)]
         where react = nice(guy)  -> Say[HiThere, guy]
                     | angry(guy) -> Say[FuckOff, guy]
                     | _          -> Say[Sup]
         where nice  = GoodGuy -> True | GoodGuy2 -> True
         where angry = BadGuy -> True
      ").eval.
      should.equal T("List[Say[HiThere, GoodGuy],
                           Say[HiThere, GoodGuy2],
                           Say[FuckOff, BadGuy],
                           Say[Sup]]").eval
  end

  it "should support nested lambdas" do
    T("(x -> y -> x) X").eval.should.equal T("y -> X")
    T("(x -> y -> x) X Y").eval.should.equal T("X")

    T("((x -> y -> List[x, y]) X) Y").eval.should.equal T("List[X, Y]").eval
    T("(x -> y -> List[x, y]) X Y").eval.should.equal T("List[X, Y]").eval
  end

  it "should notice invalid calls" do
    should.raise(Theme::RunError) { T("X Y").eval }
    should.raise(Theme::RunError) { T("X[Z] Y").eval }
    should.raise(Theme::RunError) { T("(x -> y -> x) X Y Z").eval }
  end

  it "should support at-bindings" do
    T("(x@y -> x) Foo").eval.should.equal T("Foo")
    T("(x@Foo[y] -> Cons[x,y]) Foo[N]").eval.should.equal T("Cons[Foo[N], N]")

    T("(x -> x) X  where x = Z").eval.should.equal T("X")
    T("(x -> x) Z  where x = Z").eval.should.equal T("Z")

    T("(x@_ -> x) X  where x = Z").eval.should.equal T("NoMatch[X]")
    T("(x@_ -> x) Z  where x = Z").eval.should.equal T("Z")

    T("List[eq X X, eq X Y]  where eq = x -> (x@_ -> True | _ -> False)").eval.
      should.equal T("List[True, False]")
  end

  it "should do case right" do
    T("List[not True, not False, not X]  where not = x -> case x of 
                                                           ( True  -> False
                                                           | False -> True)
      ").eval.should.equal T("List[False, True, NoMatch[X]]")
  end
end