Conditionals.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# LANGUAGE NoApplicativeDo, RebindableSyntax #-}
{-# OPTIONS_GHC -Wno-unused-do-bind #-}

-- | Tests (and examples) on Lorentz' @if .. then .. else ..@.
module Test.Lorentz.Conditionals
  ( test_Named
  , test_Not
  , test_Complex
  ) where

import Lorentz

import Test.HUnit ((@?=))
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase)


test_Named :: [TestTree]
test_Named =
  [ testCase "Named compare works good" $
      myContract -$? (5 :: Natural)
        @?= Right True
  ]
  where
    myContract = do
      toNamed #x
      push @Natural 3; toNamed #y
      if #y >=. #x
        then push False
        else push True

test_Not :: [TestTree]
test_Not =
  [ testCase "Not Holds" $
      False &- (if Not Holds then push [mt|ok|] else push [mt|bad|])
        @?= [mt|ok|]

  , testCase "Not IsZero" $
      (5 :: Integer) &- (if Not IsZero then push [mt|ok|] else push [mt|bad|])
        @?= [mt|ok|]

  , testCase "Not IsNone" $
      Just [mt|x|] &- (if Not IsNone then nop else push [mt|bad|])
        @?= [mt|x|]

  ]

test_Complex :: [TestTree]
test_Complex =
  [ testCase "Can evaluate complex conditions" $
      myContract -$? (5 :: Natural)
        @?= Right True
  ]
  where
    myContract :: Lambda Natural Bool
    myContract = do
      toNamed #x
      dup
      if fromNamed #x |>| push 3 |&| fromNamed #x |<| push 7
      then push True
      else push False