module Morley.Michelson.Runtime.Import
(
readContract
, readSomeContract
, readUntypedContract
, importContract
, importSomeContract
, importUntypedContract
, ContractReadError(..)
, readValue
, importValue
, importSomeValue
, importUntypedValue
, ValueReadError (..)
, MichelsonSource(..)
, importUsing
) where
import Data.Default (def)
import qualified Data.Text.IO.Utf8 as Utf8 (readFile)
import Fmt (Buildable(build), pretty, unlessF, (+|), (|+))
import Morley.Michelson.Parser (parseExpandValue)
import Morley.Michelson.Parser.Error (ParserException(..))
import Morley.Michelson.Parser.Types (MichelsonSource(..))
import Morley.Michelson.Runtime (parseExpandContract)
import Morley.Michelson.TypeCheck
(TCError, typeCheckContract, typeCheckTopLevelType, typeCheckingWith, typeVerifyContract,
typeVerifyTopLevelType)
import Morley.Michelson.Typed (Contract, SingI, SomeContract(..), SomeValue, Value)
import qualified Morley.Michelson.Untyped as U
readUntypedContract
:: MichelsonSource
-> Text
-> Either ContractReadError U.Contract
readUntypedContract :: MichelsonSource -> Text -> Either ContractReadError Contract
readUntypedContract MichelsonSource
source Text
txt = do
(ParserException -> ContractReadError)
-> Either ParserException Contract
-> Either ContractReadError Contract
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (MichelsonSource -> ParserException -> ContractReadError
CREParse MichelsonSource
source) (Either ParserException Contract
-> Either ContractReadError Contract)
-> Either ParserException Contract
-> Either ContractReadError Contract
forall a b. (a -> b) -> a -> b
$ MichelsonSource -> Text -> Either ParserException Contract
parseExpandContract MichelsonSource
source Text
txt
readSomeContract
:: MichelsonSource
-> Text
-> Either ContractReadError SomeContract
readSomeContract :: MichelsonSource -> Text -> Either ContractReadError SomeContract
readSomeContract MichelsonSource
source Text
txt = do
Contract
contract <- MichelsonSource -> Text -> Either ContractReadError Contract
readUntypedContract MichelsonSource
source Text
txt
(TCError -> ContractReadError)
-> Either TCError SomeContract
-> Either ContractReadError SomeContract
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (MichelsonSource -> TCError -> ContractReadError
CRETypeCheck MichelsonSource
source) (Either TCError SomeContract
-> Either ContractReadError SomeContract)
-> Either TCError SomeContract
-> Either ContractReadError SomeContract
forall a b. (a -> b) -> a -> b
$
TypeCheckOptions
-> TypeCheckResult SomeContract -> Either TCError SomeContract
forall a. TypeCheckOptions -> TypeCheckResult a -> Either TCError a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult SomeContract -> Either TCError SomeContract)
-> TypeCheckResult SomeContract -> Either TCError SomeContract
forall a b. (a -> b) -> a -> b
$ Contract -> TypeCheckResult SomeContract
typeCheckContract Contract
contract
readContract
:: forall cp st .
Each '[SingI] [cp, st]
=> MichelsonSource
-> Text
-> Either ContractReadError (Contract cp st)
readContract :: MichelsonSource
-> Text -> Either ContractReadError (Contract cp st)
readContract MichelsonSource
source Text
txt = do
Contract
contract <- MichelsonSource -> Text -> Either ContractReadError Contract
readUntypedContract MichelsonSource
source Text
txt
(TCError -> ContractReadError)
-> Either TCError (Contract cp st)
-> Either ContractReadError (Contract cp st)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (MichelsonSource -> TCError -> ContractReadError
CRETypeCheck MichelsonSource
source) (Either TCError (Contract cp st)
-> Either ContractReadError (Contract cp st))
-> Either TCError (Contract cp st)
-> Either ContractReadError (Contract cp st)
forall a b. (a -> b) -> a -> b
$
TypeCheckOptions
-> TypeCheckResult (Contract cp st)
-> Either TCError (Contract cp st)
forall a. TypeCheckOptions -> TypeCheckResult a -> Either TCError a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult (Contract cp st)
-> Either TCError (Contract cp st))
-> TypeCheckResult (Contract cp st)
-> Either TCError (Contract cp st)
forall a b. (a -> b) -> a -> b
$ Contract -> TypeCheckResult (Contract cp st)
forall (cp :: T) (st :: T).
(SingI cp, SingI st) =>
Contract -> TypeCheckResult (Contract cp st)
typeVerifyContract Contract
contract
importUsing
:: (Exception e)
=> (MichelsonSource -> Text -> Either e a)
-> FilePath -> IO a
importUsing :: (MichelsonSource -> Text -> Either e a) -> FilePath -> IO a
importUsing MichelsonSource -> Text -> Either e a
readFn FilePath
file =
(e -> IO a) -> (a -> IO a) -> Either e a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> IO a) -> (Text -> Either e a) -> Text -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MichelsonSource -> Text -> Either e a
readFn (FilePath -> MichelsonSource
MSFile FilePath
file) (Text -> IO a) -> IO Text -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO Text
forall (m :: * -> *). MonadIO m => FilePath -> m Text
Utf8.readFile FilePath
file
importUntypedContract :: FilePath -> IO U.Contract
importUntypedContract :: FilePath -> IO Contract
importUntypedContract = (MichelsonSource -> Text -> Either ContractReadError Contract)
-> FilePath -> IO Contract
forall e a.
Exception e =>
(MichelsonSource -> Text -> Either e a) -> FilePath -> IO a
importUsing MichelsonSource -> Text -> Either ContractReadError Contract
readUntypedContract
importContract
:: forall cp st .
Each '[SingI] [cp, st]
=> FilePath -> IO (Contract cp st)
importContract :: FilePath -> IO (Contract cp st)
importContract = (MichelsonSource
-> Text -> Either ContractReadError (Contract cp st))
-> FilePath -> IO (Contract cp st)
forall e a.
Exception e =>
(MichelsonSource -> Text -> Either e a) -> FilePath -> IO a
importUsing MichelsonSource
-> Text -> Either ContractReadError (Contract cp st)
forall (cp :: T) (st :: T).
Each '[SingI] '[cp, st] =>
MichelsonSource
-> Text -> Either ContractReadError (Contract cp st)
readContract
importSomeContract :: FilePath -> IO SomeContract
importSomeContract :: FilePath -> IO SomeContract
importSomeContract = (MichelsonSource -> Text -> Either ContractReadError SomeContract)
-> FilePath -> IO SomeContract
forall e a.
Exception e =>
(MichelsonSource -> Text -> Either e a) -> FilePath -> IO a
importUsing MichelsonSource -> Text -> Either ContractReadError SomeContract
readSomeContract
data ContractReadError
= CREParse MichelsonSource ParserException
| CRETypeCheck MichelsonSource TCError
deriving stock (Int -> ContractReadError -> ShowS
[ContractReadError] -> ShowS
ContractReadError -> FilePath
(Int -> ContractReadError -> ShowS)
-> (ContractReadError -> FilePath)
-> ([ContractReadError] -> ShowS)
-> Show ContractReadError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ContractReadError] -> ShowS
$cshowList :: [ContractReadError] -> ShowS
show :: ContractReadError -> FilePath
$cshow :: ContractReadError -> FilePath
showsPrec :: Int -> ContractReadError -> ShowS
$cshowsPrec :: Int -> ContractReadError -> ShowS
Show, ContractReadError -> ContractReadError -> Bool
(ContractReadError -> ContractReadError -> Bool)
-> (ContractReadError -> ContractReadError -> Bool)
-> Eq ContractReadError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContractReadError -> ContractReadError -> Bool
$c/= :: ContractReadError -> ContractReadError -> Bool
== :: ContractReadError -> ContractReadError -> Bool
$c== :: ContractReadError -> ContractReadError -> Bool
Eq)
instance Buildable ContractReadError where
build :: ContractReadError -> Builder
build =
\case
CREParse MichelsonSource
source ParserException
e -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Bool -> Builder -> Builder
unlessF (MichelsonSource
source MichelsonSource -> MichelsonSource -> Bool
forall a. Eq a => a -> a -> Bool
== MichelsonSource
MSUnspecified) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
Builder
"Error at " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| MichelsonSource
source MichelsonSource -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
, Builder
"Failed to parse the contract: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ParserException
e ParserException -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
]
CRETypeCheck MichelsonSource
source TCError
e -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Bool -> Builder -> Builder
unlessF (MichelsonSource
source MichelsonSource -> MichelsonSource -> Bool
forall a. Eq a => a -> a -> Bool
== MichelsonSource
MSUnspecified) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
Builder
"Error at " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| MichelsonSource
source MichelsonSource -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
, Builder
"The contract is ill-typed: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| TCError
e TCError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
]
instance Exception ContractReadError where
displayException :: ContractReadError -> FilePath
displayException = ContractReadError -> FilePath
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty
readUntypedValue
:: MichelsonSource
-> Text
-> Either ValueReadError U.Value
readUntypedValue :: MichelsonSource -> Text -> Either ValueReadError Value
readUntypedValue MichelsonSource
source Text
txt = do
(ParserException -> ValueReadError)
-> Either ParserException Value -> Either ValueReadError Value
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (MichelsonSource -> ParserException -> ValueReadError
VREParse MichelsonSource
source) (Either ParserException Value -> Either ValueReadError Value)
-> Either ParserException Value -> Either ValueReadError Value
forall a b. (a -> b) -> a -> b
$ MichelsonSource -> Text -> Either ParserException Value
parseExpandValue MichelsonSource
source Text
txt
readSomeValue
:: U.Ty
-> MichelsonSource
-> Text
-> Either ValueReadError SomeValue
readSomeValue :: Ty -> MichelsonSource -> Text -> Either ValueReadError SomeValue
readSomeValue Ty
ty MichelsonSource
source Text
txt = do
Value
valueU <- MichelsonSource -> Text -> Either ValueReadError Value
readUntypedValue MichelsonSource
source Text
txt
(TCError -> ValueReadError)
-> Either TCError SomeValue -> Either ValueReadError SomeValue
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (MichelsonSource -> TCError -> ValueReadError
VRETypeCheck MichelsonSource
source) (Either TCError SomeValue -> Either ValueReadError SomeValue)
-> Either TCError SomeValue -> Either ValueReadError SomeValue
forall a b. (a -> b) -> a -> b
$
TypeCheckOptions
-> TypeCheckResult SomeValue -> Either TCError SomeValue
forall a. TypeCheckOptions -> TypeCheckResult a -> Either TCError a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult SomeValue -> Either TCError SomeValue)
-> TypeCheckResult SomeValue -> Either TCError SomeValue
forall a b. (a -> b) -> a -> b
$ Maybe TcOriginatedContracts
-> Ty -> Value -> TypeCheckResult SomeValue
typeCheckTopLevelType Maybe TcOriginatedContracts
forall a. Maybe a
Nothing Ty
ty Value
valueU
readValue
:: forall t. SingI t
=> MichelsonSource
-> Text
-> Either ValueReadError (Value t)
readValue :: MichelsonSource -> Text -> Either ValueReadError (Value t)
readValue MichelsonSource
source Text
txt = do
Value
valueU <- MichelsonSource -> Text -> Either ValueReadError Value
readUntypedValue MichelsonSource
source Text
txt
(TCError -> ValueReadError)
-> Either TCError (Value t) -> Either ValueReadError (Value t)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (MichelsonSource -> TCError -> ValueReadError
VRETypeCheck MichelsonSource
source) (Either TCError (Value t) -> Either ValueReadError (Value t))
-> Either TCError (Value t) -> Either ValueReadError (Value t)
forall a b. (a -> b) -> a -> b
$
TypeCheckOptions
-> TypeCheckResult (Value t) -> Either TCError (Value t)
forall a. TypeCheckOptions -> TypeCheckResult a -> Either TCError a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult (Value t) -> Either TCError (Value t))
-> TypeCheckResult (Value t) -> Either TCError (Value t)
forall a b. (a -> b) -> a -> b
$ Maybe TcOriginatedContracts -> Value -> TypeCheckResult (Value t)
forall (t :: T).
SingI t =>
Maybe TcOriginatedContracts -> Value -> TypeCheckResult (Value t)
typeVerifyTopLevelType Maybe TcOriginatedContracts
forall a. Maybe a
Nothing Value
valueU
importUntypedValue :: FilePath -> IO U.Value
importUntypedValue :: FilePath -> IO Value
importUntypedValue = (MichelsonSource -> Text -> Either ValueReadError Value)
-> FilePath -> IO Value
forall e a.
Exception e =>
(MichelsonSource -> Text -> Either e a) -> FilePath -> IO a
importUsing MichelsonSource -> Text -> Either ValueReadError Value
readUntypedValue
importSomeValue :: U.Ty -> FilePath -> IO SomeValue
importSomeValue :: Ty -> FilePath -> IO SomeValue
importSomeValue = (MichelsonSource -> Text -> Either ValueReadError SomeValue)
-> FilePath -> IO SomeValue
forall e a.
Exception e =>
(MichelsonSource -> Text -> Either e a) -> FilePath -> IO a
importUsing ((MichelsonSource -> Text -> Either ValueReadError SomeValue)
-> FilePath -> IO SomeValue)
-> (Ty
-> MichelsonSource -> Text -> Either ValueReadError SomeValue)
-> Ty
-> FilePath
-> IO SomeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ty -> MichelsonSource -> Text -> Either ValueReadError SomeValue
readSomeValue
importValue
:: forall t . SingI t
=> FilePath -> IO (Value t)
importValue :: FilePath -> IO (Value t)
importValue = (MichelsonSource -> Text -> Either ValueReadError (Value t))
-> FilePath -> IO (Value t)
forall e a.
Exception e =>
(MichelsonSource -> Text -> Either e a) -> FilePath -> IO a
importUsing MichelsonSource -> Text -> Either ValueReadError (Value t)
forall (t :: T).
SingI t =>
MichelsonSource -> Text -> Either ValueReadError (Value t)
readValue
data ValueReadError
= VREParse MichelsonSource ParserException
| VRETypeCheck MichelsonSource TCError
deriving stock (Int -> ValueReadError -> ShowS
[ValueReadError] -> ShowS
ValueReadError -> FilePath
(Int -> ValueReadError -> ShowS)
-> (ValueReadError -> FilePath)
-> ([ValueReadError] -> ShowS)
-> Show ValueReadError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ValueReadError] -> ShowS
$cshowList :: [ValueReadError] -> ShowS
show :: ValueReadError -> FilePath
$cshow :: ValueReadError -> FilePath
showsPrec :: Int -> ValueReadError -> ShowS
$cshowsPrec :: Int -> ValueReadError -> ShowS
Show, ValueReadError -> ValueReadError -> Bool
(ValueReadError -> ValueReadError -> Bool)
-> (ValueReadError -> ValueReadError -> Bool) -> Eq ValueReadError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValueReadError -> ValueReadError -> Bool
$c/= :: ValueReadError -> ValueReadError -> Bool
== :: ValueReadError -> ValueReadError -> Bool
$c== :: ValueReadError -> ValueReadError -> Bool
Eq)
instance Buildable ValueReadError where
build :: ValueReadError -> Builder
build =
\case
VREParse MichelsonSource
source ParserException
e -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Bool -> Builder -> Builder
unlessF (MichelsonSource
source MichelsonSource -> MichelsonSource -> Bool
forall a. Eq a => a -> a -> Bool
== MichelsonSource
MSUnspecified) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
Builder
"Error at " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| MichelsonSource
source MichelsonSource -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
, Builder
"Failed to parse the value: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ParserException
e ParserException -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
]
VRETypeCheck MichelsonSource
source TCError
e -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
[ Bool -> Builder -> Builder
unlessF (MichelsonSource
source MichelsonSource -> MichelsonSource -> Bool
forall a. Eq a => a -> a -> Bool
== MichelsonSource
MSUnspecified) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
Builder
"Error at " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| MichelsonSource
source MichelsonSource -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
, Builder
"Invalid value for required type: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| TCError
e TCError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n"
]
instance Exception ValueReadError where
displayException :: ValueReadError -> FilePath
displayException = ValueReadError -> FilePath
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty