module Morley.Test.Import
( readContract
, specWithContract
, specWithTypedContract
, specWithUntypedContract
, importContract
, importUntypedContract
, ImportContractError (..)
) where
import Control.Exception (IOException)
import Data.Typeable ((:~:)(..), TypeRep, eqT, typeRep)
import Fmt (Buildable(build), pretty, (+|), (|+), (||+))
import Test.Hspec (Spec, describe, expectationFailure, it, runIO)
import Michelson.TypeCheck (SomeContract(..), TCError)
import Michelson.Typed (Contract)
import qualified Michelson.Untyped as U
import Michelson.Untyped.Aliases (UntypedContract)
import Morley.Ext (typeCheckMorleyContract)
import Morley.Runtime (parseExpandContract, prepareContract)
import Morley.Types (ParserException(..))
specWithContract
:: (Typeable cp, Typeable st)
=> FilePath -> ((UntypedContract, Contract cp st) -> Spec) -> Spec
specWithContract = specWithContractImpl importContract
specWithTypedContract
:: (Typeable cp, Typeable st)
=> FilePath -> (Contract cp st -> Spec) -> Spec
specWithTypedContract = specWithContractImpl (fmap snd . importContract)
specWithUntypedContract :: FilePath -> (UntypedContract -> Spec) -> Spec
specWithUntypedContract = specWithContractImpl importUntypedContract
specWithContractImpl
:: (FilePath -> IO contract) -> FilePath -> (contract -> Spec) -> Spec
specWithContractImpl doImport file execSpec =
either errorSpec (describe ("Test contract " <> file) . execSpec)
=<< runIO
( (Right <$> doImport file)
`catch` (\(e :: ImportContractError) -> pure $ Left $ displayException e)
`catch` \(e :: IOException) -> pure $ Left $ displayException e )
where
errorSpec = it ("Import contract " <> file) . expectationFailure
readContract
:: forall cp st .
(Typeable cp, Typeable st)
=> FilePath -> Text -> Either ImportContractError (UntypedContract, Contract cp st)
readContract filePath txt = do
contract <- first ICEParse $ parseExpandContract (Just filePath) txt
SomeContract (instr :: Contract cp' st') _ _
<- first ICETypeCheck $ typeCheckMorleyContract contract
case (eqT @cp @cp', eqT @st @st') of
(Just Refl, Just Refl) -> pure (contract, instr)
(Nothing, _) -> Left $
ICEUnexpectedParamType (U.para contract) (typeRep (Proxy @cp))
_ -> Left (ICEUnexpectedStorageType (U.stor contract) (typeRep (Proxy @st)))
importContract
:: forall cp st .
(Typeable cp, Typeable st)
=> FilePath -> IO (UntypedContract, Contract cp st)
importContract file = either throwM pure =<< readContract file <$> readFile file
importUntypedContract :: FilePath -> IO UntypedContract
importUntypedContract = prepareContract . Just
data ImportContractError
= ICEUnexpectedParamType !U.Type !TypeRep
| ICEUnexpectedStorageType !U.Type !TypeRep
| ICEParse !ParserException
| ICETypeCheck !TCError
deriving Show
instance Buildable ImportContractError where
build =
\case
ICEUnexpectedParamType actual expected ->
"Unexpected parameter type: " +| actual |+
", expected: " +| expected ||+ ""
ICEUnexpectedStorageType actual expected ->
"Unexpected storage type: " +| actual |+
", expected: " +| expected ||+ ""
ICEParse e -> "Failed to parse the contract: " +| e |+ ""
ICETypeCheck e -> "The contract is ill-typed: " +| e |+ ""
instance Exception ImportContractError where
displayException = pretty