/* -----------------------------------------------------------------------------
Copyright 2020 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- */

// Author: Kevin P. Barry [ta0kira@gmail.com]

testcase "reduce to self" {
  success Test$run()
}

concrete Value {
  @type create () -> (Value)
}

define Value {
  create () {
    return Value{}
  }
}

define Test {
  run () {
    Value value <- Value$create()
    scoped {
      optional Value value2 <- reduce<Value,Value>(value)
    } in if (!present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce to unrelated" {
  success Test$run()
}

concrete Value {
  @type create () -> (Value)
}

define Value {
  create () {
    return Value{}
  }
}

define Test {
  run () {
    Value value <- Value$create()
    scoped {
      optional Test value2 <- reduce<Value,Test>(value)
    } in if (present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce wrong arg type" {
  error
  require "argument"
}

concrete Value {
  @type create () -> (Value)
}

define Value {
  create () {
    return Value{}
  }
}

define Test {
  run () {
    Value value <- Value$create()
    optional Value value2 <- reduce<Test,Value>(value)
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce wrong return type" {
  error
  require "assignment"
}

concrete Value {
  @type create () -> (Value)
}

define Value {
  create () {
    return Value{}
  }
}

define Test {
  run () {
    Value value <- Value$create()
    optional Value value2 <- reduce<Value,Test>(value)
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce success with param" {
  success Test$run()
}

concrete Value<|#x> {
  @type create () -> (Value<#x>)

  @value attempt<#y>
  () -> (optional Value<#y>)
}

define Value {
  create () {
    return Value<#x>{}
  }

  attempt () {
    return reduce<Value<#x>,Value<#y>>(self)
  }
}

@value interface Type1 {}

@value interface Type2 {
  refines Type1
}

define Test {
  run () {
    Value<Type2> value <- Value<Type2>$create()
    scoped {
      optional Value<Type1> value2 <- value.attempt<Type1>()
    } in if (!present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce fail with param" {
  success Test$run()
}

concrete Value<|#x> {
  @type create () -> (Value<#x>)

  @value attempt<#y>
  () -> (optional Value<#y>)
}

define Value {
  create () {
    return Value<#x>{}
  }

  attempt () {
    return reduce<Value<#x>,Value<#y>>(self)
  }
}

@value interface Type1 {}

@value interface Type2 {
  refines Type1
}

define Test {
  run () {
    Value<Type1> value <- Value<Type1>$create()
    scoped {
      optional Value<Type2> value2 <- value.attempt<Type2>()
    } in if (present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce success with contra param" {
  success Test$run()
}

concrete Value<#x|> {
  @type create () -> (Value<#x>)

  @value attempt<#y>
  () -> (optional Value<#y>)
}

define Value {
  create () {
    return Value<#x>{}
  }

  attempt () {
    return reduce<Value<#x>,Value<#y>>(self)
  }
}

@value interface Type1 {}

@value interface Type2 {
  refines Type1
}

define Test {
  run () {
    Value<Value<Type2>> value <- Value<Value<Type2>>$create()
    scoped {
      optional Value<Value<Type1>> value2 <- value.attempt<Value<Type1>>()
    } in if (!present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce fail with contra param" {
  success Test$run()
}

concrete Value<#x|> {
  @type create () -> (Value<#x>)

  @value attempt<#y>
  () -> (optional Value<#y>)
}

define Value {
  create () {
    return Value<#x>{}
  }

  attempt () {
    return reduce<Value<#x>,Value<#y>>(self)
  }
}

@value interface Type1 {}

@value interface Type2 {
  refines Type1
}

define Test {
  run () {
    Value<Value<Type1>> value <- Value<Value<Type1>>$create()
    scoped {
      optional Value<Value<Type2>> value2 <- value.attempt<Value<Type2>>()
    } in if (present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce success from union" {
  success Test$run()
}

@value interface Base {}

concrete Value1 {
  refines Base

  @type create () -> (Value1)
}

define Value1 {
  create () {
    return Value1{}
  }
}

@value interface Value2 {
  refines Base
}

define Test {
  run () {
    [Value1|Value2] value <- Value1$create()
    scoped {
      optional Base value2 <- reduce<[Value1|Value2],Base>(value)
    } in if (!present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce fail from union" {
  success Test$run()
}

@value interface Base {}

concrete Value1 {
  refines Base

  @type create () -> (Value1)
}

define Value1 {
  create () {
    return Value1{}
  }
}

@value interface Value2 {
  refines Base
}

define Test {
  run () {
    [Value1|Value2] value <- Value1$create()
    scoped {
      optional Value2 value2 <- reduce<[Value1|Value2],Value2>(value)
    } in if (present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce success to intersect" {
  success Test$run()
}

@value interface Base1 {}

@value interface Base2 {}

concrete Value {
  refines Base1
  refines Base2

  @type create () -> (Value)
}

define Value {
  create () {
    return Value{}
  }
}

define Test {
  run () {
    Value value <- Value$create()
    scoped {
      optional [Base1&Base2] value2 <- reduce<Value,[Base1&Base2]>(value)
    } in if (!present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce fail to intersect" {
  success Test$run()
}

@value interface Base1 {}

@value interface Base2 {}

concrete Value {
  refines Base1

  @type create () -> (Value)
}

define Value {
  create () {
    return Value{}
  }
}

define Test {
  run () {
    Value value <- Value$create()
    scoped {
      optional [Base1&Base2] value2 <- reduce<Value,[Base1&Base2]>(value)
    } in if (present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce success union to intersect" {
  success Test$run()
}

@value interface Base1 {}

@value interface Base2 {}

@value interface Value1 {
  refines Base1
  refines Base2
}

concrete Value2 {
  refines Base1
  refines Base2

  @type create () -> (Value2)
}

define Value2 {
  create () {
    return Value2{}
  }
}

define Test {
  run () {
    [Value1|Value2] value <- Value2$create()
    scoped {
      optional [Base1&Base2] value2 <- reduce<[Value1|Value2],[Base1&Base2]>(value)
    } in if (!present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce fail union to intersect" {
  success Test$run()
}

@value interface Base1 {}

@value interface Base2 {}

@value interface Value1 {
  refines Base1
  refines Base2
}

concrete Value2 {
  refines Base1

  @type create () -> (Value2)
}

define Value2 {
  create () {
    return Value2{}
  }
}

define Test {
  run () {
    [Value1|Value2] value <- Value2$create()
    scoped {
      optional [Base1&Base2] value2 <- reduce<[Value1|Value2],[Base1&Base2]>(value)
    } in if (present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce success intersect to union" {
  success Test$run()
}

@value interface Base1 {}

@value interface Base2 {}

@value interface Value1 {
  refines Base1
}

@value interface Value2 {}

concrete Data {
  refines Value1
  refines Value2

  @type create () -> (Data)
}

define Data {
  create () {
    return Data{}
  }
}

define Test {
  run () {
    [Value1&Value2] value <- Data$create()
    scoped {
      optional [Base1|Base2] value2 <- reduce<[Value1&Value2],[Base1|Base2]>(value)
    } in if (!present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce fail intersect to union" {
  success Test$run()
}

@value interface Base1 {}

@value interface Base2 {}

@value interface Value1 {}

@value interface Value2 {}

concrete Data {
  refines Value1
  refines Value2

  @type create () -> (Data)
}

define Data {
  create () {
    return Data{}
  }
}

define Test {
  run () {
    [Value1&Value2] value <- Data$create()
    scoped {
      optional [Base1|Base2] value2 <- reduce<[Value1&Value2],[Base1|Base2]>(value)
    } in if (present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce succeeds to covariant any" {
  success Test$run()
}

concrete Value<|#x> {
  @type create () -> (Value<#x>)
}

define Value {
  create () {
    return Value<#x>{}
  }
}

define Test {
  run () {
    Value<Test> value <- Value<Test>$create()
    scoped {
      optional Value<any> value2 <- reduce<Value<Test>,Value<any>>(value)
    } in if (!present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce succeeds to contravariant all" {
  success Test$run()
}

concrete Value<#x|> {
  @type create () -> (Value<#x>)
}

define Value {
  create () {
    return Value<#x>{}
  }
}

define Test {
  run () {
    Value<Test> value <- Value<Test>$create()
    scoped {
      optional Value<all> value2 <- reduce<Value<Test>,Value<all>>(value)
    } in if (!present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce fails to invariant any" {
  success Test$run()
}

concrete Value<#x> {
  @type create () -> (Value<#x>)
}

define Value {
  create () {
    return Value<#x>{}
  }
}

define Test {
  run () {
    Value<Test> value <- Value<Test>$create()
    scoped {
      optional Value<any> value2 <- reduce<Value<Test>,Value<any>>(value)
    } in if (present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce succeeds from covariant all" {
  success Test$run()
}

concrete Value<|#x> {
  @type create () -> (Value<#x>)
}

define Value {
  create () {
    return Value<#x>{}
  }
}

define Test {
  run () {
    Value<all> value <- Value<all>$create()
    scoped {
      optional Value<Test> value2 <- reduce<Value<all>,Value<Test>>(value)
    } in if (!present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce succeeds from contravariant any" {
  success Test$run()
}

concrete Value<#x|> {
  @type create () -> (Value<#x>)
}

define Value {
  create () {
    return Value<#x>{}
  }
}

define Test {
  run () {
    Value<any> value <- Value<any>$create()
    scoped {
      optional Value<Test> value2 <- reduce<Value<any>,Value<Test>>(value)
    } in if (!present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce fails from invariant all" {
  success Test$run()
}

concrete Value<#x> {
  @type create () -> (Value<#x>)
}

define Value {
  create () {
    return Value<#x>{}
  }
}

define Test {
  run () {
    Value<all> value <- Value<all>$create()
    scoped {
      optional Value<Test> value2 <- reduce<Value<all>,Value<Test>>(value)
    } in if (present(value2)) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "bad instance in reduce param" {
  error
  require "Test"
  require "define"
  require "Equals"
}

@value interface Value<#x> {
  #x defines Equals<#x>
}

concrete Call {
  @type call<#x> () -> ()
}

define Call {
  call () {}
}

define Test {
  run () {
    \ reduce<Value<Test>,Formatted>(empty)
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce from interface" {
  success Test$run()
}

@value interface Base0 {
}

@value interface Base1 {
  refines Base0
}

concrete Value {
  refines Base1
  @type create () -> (Value)
}

define Value {
  create () {
    return Value{ }
  }
}

define Test {
  run () {
    if (!present(reduce<Base1,Base0>(Value$create()))) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}


testcase "reduce with internal override" {
  success Test$run()
}

@value interface Base0 {}

@value interface Base1 {
  refines Base0
}

@value interface Base2<|#x> {}

concrete Value {
  refines Base2<Base0>
  @type create () -> (Value)
}

define Value {
  refines Base2<Base1>

  create () {
    return Value{ }
  }
}

define Test {
  run () {
    if (!present(reduce<Value,Base2<Base0>>(Value$create()))) {
      fail("Failed")
    }
    if (present(reduce<Value,Base2<Base1>>(Value$create()))) {
      fail("Failed")
    }
  }
}

concrete Test {
  @type run () -> ()
}