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

-- | Tests on 'Convert'.
module Test.Michelson.Typed.Convert
  ( test_sub
  , test_sub_mutez
  , test_sha
  , test_arith
  , test_wrappers
  ) where

import Data.Vinyl.Core (Rec(..))
import Test.HUnit (assertEqual, (@?=))
import Test.Hspec ()
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase)

import Morley.Michelson.Typed qualified as T
import Morley.Michelson.Typed.Convert (instrToOps)
import Morley.Michelson.Typed.Instr (Instr(..))
import Morley.Michelson.Typed.Value (Value'(..))
import Morley.Michelson.Untyped qualified as U
import Test.Cleveland.Instances ()

annA, annB :: U.Annotation a
annA = "a"
annB = "b"

test_sub :: TestTree
test_sub =
  testCase "SUB accepts one annotation" $
    assertEqual "SUB accepts one annotation" (instrToOps sub) subExpected
  where
    sub = PUSH (VInt 9) `Seq` PUSH (VInt 8) `Seq` InstrWithVarNotes (annA :| []) SUB
    subExpected =
      [ U.PrimEx $ U.PUSH U.noAnn (U.Ty U.TInt U.noAnn) (U.ValueInt 9)
      , U.PrimEx $ U.PUSH U.noAnn (U.Ty U.TInt U.noAnn) (U.ValueInt 8)
      , U.PrimEx $ U.SUB annA
      ]

test_sub_mutez :: TestTree
test_sub_mutez =
  testCase "SUB_MUTEZ accepts one annotation" $
    assertEqual "SUB_MUTEZ accepts one annotation" (instrToOps sub) subExpected
  where
    sub = PUSH (VMutez 9) `Seq` PUSH (VMutez 8) `Seq` InstrWithVarNotes (annA :| []) SUB_MUTEZ
    subExpected =
      [ U.PrimEx $ U.PUSH U.noAnn (U.Ty U.TMutez U.noAnn) (U.ValueInt 9)
      , U.PrimEx $ U.PUSH U.noAnn (U.Ty U.TMutez U.noAnn) (U.ValueInt 8)
      , U.PrimEx $ U.SUB_MUTEZ annA
      ]

test_sha :: TestTree
test_sha =
  testCase "SHA256 and SHA512 accept one annotation" $ do
    assertEqual "SHA256 accepts one annotation" (instrToOps sha256) sha256Expected
    assertEqual "SHA512 accepts one annotation" (instrToOps sha512) sha512Expected
  where
    push = U.PrimEx $ U.PUSH U.noAnn (U.Ty U.TBytes U.noAnn) (U.ValueBytes $ U.InternalByteString $ "foo")
    sha256 = PUSH (VBytes "foo") `Seq` InstrWithVarNotes (annA :| []) SHA256
    sha256Expected = [push, U.PrimEx $ U.SHA256 annA]
    sha512 = PUSH (VBytes "foo") `Seq` InstrWithVarNotes (annA :| []) SHA512
    sha512Expected = [push, U.PrimEx $ U.SHA512 annA]

test_arith :: TestTree
test_arith = testCase "arithmetic operators have proper annotations" $
  zipWithM_ (assertEqual "single annotation in arithmetic works")
    (instrToOps <$> instrCmp)
    instrCmpExpected
  where
    instr =
      InstrWithVarNotes (annA :| []) (PUSH (VInt 2))
      `Seq` InstrWithVarNotes (annB :| []) (PUSH (VInt 1))
    instrExpected =
      [ U.PrimEx $ U.PUSH annA (U.Ty U.TInt U.noAnn) (U.ValueInt 2)
      , U.PrimEx $ U.PUSH annB (U.Ty U.TInt U.noAnn) (U.ValueInt 1)
      ]
    instrCmp = mkTArith <$> arithTOps
    instrCmpExpected = mkUArith <$> arithUOps

    -- Signature omitted due to being too cumbersome to read.
    mkTArith op = instr `Seq` InstrWithVarNotes (annA :| []) op

    mkUArith :: (U.VarAnn -> U.ExpandedInstr) -> [U.ExpandedOp]
    mkUArith op = instrExpected <> [U.PrimEx (op annA)]

    arithTOps = [T.EQ, T.NEQ, T.LT, T.GT, T.LE, T.GE]
    arithUOps = [U.EQ, U.NEQ, U.LT, U.GT, U.LE, U.GE]

test_wrappers :: TestTree
test_wrappers = testGroup "instruction wrappers interact sensibly"
  [ testCase "Meta under notes" do
      instrToOps
        (T.InstrWithNotes (Proxy @'[]) (T.NTUnit [U.annQ|meq|] :& RNil) $
          T.InstrWithVarNotes (one [U.annQ|kek|]) $
            T.Meta (T.SomeMeta ()) $
              T.UNIT
        )
        @?= [U.PrimEx $ U.UNIT [U.annQ|meq|] [U.annQ|kek|]]
  ]