Case.hs

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

-- | Tests on mere @case@ in Lorentz (without entrypoints).
module Test.Lorentz.Case
  ( test_caseT
  ) where


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

import Lorentz ((#), (/->))
import Lorentz qualified as L
import Lorentz.Run.Simple
import Morley.Michelson.Typed (IsoValue)

data Data0
  deriving stock (Generic)
  deriving anyclass (IsoValue)

data Data1 = Data1 Natural
  deriving stock (Generic, Eq, Show)
  deriving anyclass (IsoValue)

data Data1N = Data1N
  deriving stock (Generic, Eq, Show)
  deriving anyclass (IsoValue)

data Data3
  = Data3Ctor1 Natural
  | Data3Ctor2 Integer
  | Data3Ctor3
  deriving stock (Generic, Eq, Show)
  deriving anyclass (IsoValue)

test_caseT :: [TestTree]
test_caseT =
  [ testCase "No constructors" $
      evaluateNF_ . L.compileLorentz $ L.caseT @Data0 ()

  , testCase "One constructor" $
      -- 'stackType' is necessary because '&-' may accept multiple stack elements
      -- as input, and here it is not possible to infer how much we provide.
      -- That's a point for not making '&-' such complex.
      Data1 5 &- L.stackType @'[_] # L.caseT @Data1
        ( #cData1 /-> L.nop
        )
      @?= 5

  , testCase "One nullary constructor" $
      Data1N &- L.stackType @'[_] # L.caseT @Data1N
        ( #cData1N /-> L.unit
        )
      @?= ()

  , testCase "Several constructors" $
      L.caseT @Data3
        ( #cData3Ctor1 /-> L.int
        , #cData3Ctor2 /-> L.nop
        , #cData3Ctor3 /-> L.push 0
        ) <-$> [Data3Ctor1 5, Data3Ctor2 -5, Data3Ctor3]
      @?= [5, -5, 0]
  ]