Expr.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' expressions.
module Test.Lorentz.Expr
  ( test_Basic
  ) where

import Lorentz

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

test_Basic :: [TestTree]
test_Basic =
  [ testCase "Can compare two values" $
      push [mt|a|] |<| push [mt|b|] -$ ()
        @?= True

  , testCase "Unary operation" $
      unaryExpr neg take -$ (5 :: Natural)
        @?= (-5)

  , testCase "Unary operation operator" $
      neg $: neg $: take -$ (5 :: Natural)
        @?= 5

  , testCase "Can read from stack several times" $
      (take |*| push @Integer 5 |+| take) -$ (5 :: Integer, 10 :: Integer)
        @?= 35

  , testCase "Can access deep elements of the stack" $
      () &- do
        push @Integer 5; toNamed #a
        push @Natural 2; toNamed #b
        push [mt|x|]; toNamed #c
        push (); toNamed #d
        push @Natural 5 |*| dupL #a |+| push @Natural 8 |*| dupL #b
        dip $ do drop; drop; drop; drop; drop
      @?= 41
  ]