-- | Utility functions for unit testing.

module Michelson.Test.Unit
  ( ContractReturn
  , ContractPropValidator
  , contractProp
  , contractPropVal
  , contractHasEntryPoints
  , matchContractEntryPoints
  , hasEp
  ) where

import Data.Default (def)
import Data.List.NonEmpty (fromList)
import qualified Data.Map as Map

import Michelson.Interpret (ContractEnv, ContractReturn, interpret)
import Michelson.Printer (printUntypedContract)
import Michelson.Runtime (parseExpandContract)
import Michelson.Typed (Contract, IsoValue(..), ToT, epNameToParamAnn)
import qualified Michelson.Typed as T
import Michelson.Untyped (EpName, para)
import Michelson.Untyped hiding (Contract)
import qualified Michelson.Untyped as U

-- | Type for contract execution validation.
--
-- It's a function which is supplied with contract execution output
-- (failure or new storage with operation list).
--
-- Function returns a property which type is designated by type variable @prop@
-- and might be 'Test.QuickCheck.Property' or 'Test.Hspec.Expectation'
-- or anything else relevant.
type ContractPropValidator st prop = ContractReturn st -> prop

-- | Contract's property tester against given input.
-- Takes contract environment, initial storage and parameter,
-- interprets contract on this input and invokes validation function.
contractProp
  :: ( IsoValue param, IsoValue storage
     , ToT param ~ cp, ToT storage ~ st
     , T.ParameterScope cp
     )
  => Contract cp st
  -> ContractPropValidator st prop
  -> ContractEnv
  -> param
  -> storage
  -> prop
contractProp instr check env param initSt =
  contractPropVal instr check env (toVal param) (toVal initSt)

-- | Version of 'contractProp' which takes 'Val' as arguments instead
-- of regular Haskell values.
contractPropVal
  :: (T.ParameterScope cp)
  => Contract cp st
  -> ContractPropValidator st prop
  -> ContractEnv
  -> T.Value cp
  -> T.Value st
  -> prop
contractPropVal instr check env param initSt =
  check $ interpret instr def param initSt env

-- | Check if entrypoint is present in `T`.
hasEp :: T -> (EpName, U.Type) -> Bool
hasEp (TOr lFieldAnn rFieldAnn lType@(Type lT _) rType@(Type rT _))
      ep@(epNameToParamAnn -> epAnn, epType) = or
  [ (epAnn == lFieldAnn && epType == lType)
  , (epAnn == rFieldAnn && epType == rType)
  , hasEp lT ep
  , hasEp rT ep ]
hasEp _ _ = False

-- | Check whether the given set of entrypoints is present in contract.
contractHasEntryPoints :: U.Contract -> Map EpName U.Type -> Bool
contractHasEntryPoints contract eps = isRight $ matchContractEntryPoints contract eps

-- | Match the given contract with provided set of entrypoints, return left if some
-- entrypoints were not found.
matchContractEntryPoints
  :: HasCallStack
  => U.Contract
  -> Map EpName U.Type
  -> Either (NonEmpty (EpName, U.Type)) ()
matchContractEntryPoints contract eps =
  phi $ fromRight (error "Impossible") parsedContract
  where
    parsedContract = parseExpandContract Nothing
      (toText $ printUntypedContract True contract)
    phi (para -> Type t _) = conv $ filter (\ep -> not (hasEp t ep)) (Map.toList eps)
    conv l | null l = Right ()
           | otherwise = Left $ fromList l