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 Data.Text.IO.Utf8 qualified 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 Morley.Michelson.Untyped qualified 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 a b c. (a -> b) -> Either a c -> Either b c
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 a b c. (a -> b) -> Either a c -> Either b c
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 ExpandedOp SomeContract
-> Either TcError SomeContract
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult ExpandedOp SomeContract
-> Either TcError SomeContract)
-> TypeCheckResult ExpandedOp SomeContract
-> Either TcError SomeContract
forall a b. (a -> b) -> a -> b
$ Contract -> TypeCheckResult ExpandedOp SomeContract
typeCheckContract Contract
contract
readContract
:: forall cp st .
Each '[SingI] [cp, st]
=> MichelsonSource
-> Text
-> Either ContractReadError (Contract cp st)
readContract :: forall (cp :: T) (st :: T).
Each '[SingI] '[cp, st] =>
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 a b c. (a -> b) -> Either a c -> Either b c
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 ExpandedOp (Contract cp st)
-> Either TcError (Contract cp st)
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult ExpandedOp (Contract cp st)
-> Either TcError (Contract cp st))
-> TypeCheckResult ExpandedOp (Contract cp st)
-> Either TcError (Contract cp st)
forall a b. (a -> b) -> a -> b
$ Contract -> TypeCheckResult ExpandedOp (Contract cp st)
forall (cp :: T) (st :: T).
(SingI cp, SingI st) =>
Contract -> TypeCheckResult ExpandedOp (Contract cp st)
typeVerifyContract Contract
contract
importUsing
:: (Exception e)
=> (MichelsonSource -> Text -> Either e a)
-> FilePath -> IO a
importUsing :: forall e a.
Exception e =>
(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 a. 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 :: forall (cp :: T) (st :: T).
Each '[SingI] '[cp, st] =>
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
$cshowsPrec :: Int -> ContractReadError -> ShowS
showsPrec :: Int -> ContractReadError -> ShowS
$cshow :: ContractReadError -> FilePath
show :: ContractReadError -> FilePath
$cshowList :: [ContractReadError] -> ShowS
showList :: [ContractReadError] -> ShowS
Show, ContractReadError -> ContractReadError -> Bool
(ContractReadError -> ContractReadError -> Bool)
-> (ContractReadError -> ContractReadError -> Bool)
-> Eq ContractReadError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContractReadError -> ContractReadError -> Bool
== :: ContractReadError -> ContractReadError -> Bool
$c/= :: ContractReadError -> ContractReadError -> Bool
/= :: ContractReadError -> ContractReadError -> Bool
Eq)
instance Buildable ContractReadError where
build :: ContractReadError -> Doc
build =
\case
CREParse MichelsonSource
source ParserException
e -> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat
[ Bool -> Doc -> Doc
unlessF (MichelsonSource
source MichelsonSource -> MichelsonSource -> Bool
forall a. Eq a => a -> a -> Bool
== MichelsonSource
MSUnspecified) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Doc
"Error at " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| MichelsonSource
source MichelsonSource -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"\n"
, Doc
"Failed to parse the contract: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParserException
e ParserException -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"\n"
]
CRETypeCheck MichelsonSource
source TcError
e -> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat
[ Bool -> Doc -> Doc
unlessF (MichelsonSource
source MichelsonSource -> MichelsonSource -> Bool
forall a. Eq a => a -> a -> Bool
== MichelsonSource
MSUnspecified) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Doc
"Error at " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| MichelsonSource
source MichelsonSource -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"\n"
, Doc
"The contract is ill-typed: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| TcError
e TcError -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"\n"
]
instance Exception ContractReadError where
displayException :: ContractReadError -> FilePath
displayException = ContractReadError -> FilePath
forall a b. (Buildable a, FromDoc 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 a b c. (a -> b) -> Either a c -> Either b c
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 a b c. (a -> b) -> Either a c -> Either b c
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 ExpandedOp SomeValue -> Either TcError SomeValue
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult ExpandedOp SomeValue -> Either TcError SomeValue)
-> TypeCheckResult ExpandedOp SomeValue -> Either TcError SomeValue
forall a b. (a -> b) -> a -> b
$ Maybe TcOriginatedContracts
-> Ty -> Value -> TypeCheckResult ExpandedOp 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 :: forall (t :: T).
SingI t =>
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 a b c. (a -> b) -> Either a c -> Either b c
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 ExpandedOp (Value t) -> Either TcError (Value t)
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult ExpandedOp (Value t) -> Either TcError (Value t))
-> TypeCheckResult ExpandedOp (Value t) -> Either TcError (Value t)
forall a b. (a -> b) -> a -> b
$ Maybe TcOriginatedContracts
-> Value -> TypeCheckResult ExpandedOp (Value t)
forall (t :: T).
SingI t =>
Maybe TcOriginatedContracts
-> Value -> TypeCheckResult ExpandedOp (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 :: forall (t :: T). SingI t => 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
$cshowsPrec :: Int -> ValueReadError -> ShowS
showsPrec :: Int -> ValueReadError -> ShowS
$cshow :: ValueReadError -> FilePath
show :: ValueReadError -> FilePath
$cshowList :: [ValueReadError] -> ShowS
showList :: [ValueReadError] -> ShowS
Show, ValueReadError -> ValueReadError -> Bool
(ValueReadError -> ValueReadError -> Bool)
-> (ValueReadError -> ValueReadError -> Bool) -> Eq ValueReadError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValueReadError -> ValueReadError -> Bool
== :: ValueReadError -> ValueReadError -> Bool
$c/= :: ValueReadError -> ValueReadError -> Bool
/= :: ValueReadError -> ValueReadError -> Bool
Eq)
instance Buildable ValueReadError where
build :: ValueReadError -> Doc
build =
\case
VREParse MichelsonSource
source ParserException
e -> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat
[ Bool -> Doc -> Doc
unlessF (MichelsonSource
source MichelsonSource -> MichelsonSource -> Bool
forall a. Eq a => a -> a -> Bool
== MichelsonSource
MSUnspecified) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Doc
"Error at " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| MichelsonSource
source MichelsonSource -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"\n"
, Doc
"Failed to parse the value: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParserException
e ParserException -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"\n"
]
VRETypeCheck MichelsonSource
source TcError
e -> [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat
[ Bool -> Doc -> Doc
unlessF (MichelsonSource
source MichelsonSource -> MichelsonSource -> Bool
forall a. Eq a => a -> a -> Bool
== MichelsonSource
MSUnspecified) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Doc
"Error at " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| MichelsonSource
source MichelsonSource -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"\n"
, Doc
"Invalid value for required type: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| TcError
e TcError -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"\n"
]
instance Exception ValueReadError where
displayException :: ValueReadError -> FilePath
displayException = ValueReadError -> FilePath
forall a b. (Buildable a, FromDoc b) => a -> b
pretty