module Michelson.Runtime.Import
(
readContract
, readSomeContract
, readUntypedContract
, importContract
, importSomeContract
, importUntypedContract
, ImportContractError(..)
, readValue
, importValue
, importSomeValue
, importUntypedValue
, ImportValueError (..)
, importUsing
) where
import Data.Default (def)
import qualified Data.Text.IO.Utf8 as Utf8 (readFile)
import Fmt (Buildable(build), pretty, unlinesF, (+|), (|+))
import Michelson.Parser (parseExpandValueFromFile)
import Michelson.Parser.Error (ParserException(..))
import Michelson.Runtime (parseExpandContract)
import Michelson.TypeCheck
(TCError, typeCheckContract, typeCheckTopLevelType, typeCheckingWith,
typeVerifyContract, typeVerifyTopLevelType)
import Michelson.Typed (Contract(..), SingI, SomeContract(..), SomeValue, Value)
import qualified Michelson.Untyped as U
readUntypedContract
:: FilePath
-> Text
-> Either ImportContractError U.Contract
readUntypedContract :: FilePath -> Text -> Either ImportContractError Contract
readUntypedContract FilePath
filePath Text
txt = do
(ParserException -> ImportContractError)
-> Either ParserException Contract
-> Either ImportContractError Contract
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FilePath -> ParserException -> ImportContractError
ICEParse FilePath
filePath) (Either ParserException Contract
-> Either ImportContractError Contract)
-> Either ParserException Contract
-> Either ImportContractError Contract
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> Text -> Either ParserException Contract
parseExpandContract (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
filePath) Text
txt
readSomeContract
:: FilePath
-> Text
-> Either ImportContractError SomeContract
readSomeContract :: FilePath -> Text -> Either ImportContractError SomeContract
readSomeContract FilePath
filePath Text
txt = do
Contract
contract <- FilePath -> Text -> Either ImportContractError Contract
readUntypedContract FilePath
filePath Text
txt
(TCError -> ImportContractError)
-> Either TCError SomeContract
-> Either ImportContractError SomeContract
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FilePath -> TCError -> ImportContractError
ICETypeCheck FilePath
filePath) (Either TCError SomeContract
-> Either ImportContractError SomeContract)
-> Either TCError SomeContract
-> Either ImportContractError 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]
=> FilePath
-> Text
-> Either ImportContractError (Contract cp st)
readContract :: FilePath -> Text -> Either ImportContractError (Contract cp st)
readContract FilePath
filePath Text
txt = do
Contract
contract <- FilePath -> Text -> Either ImportContractError Contract
readUntypedContract FilePath
filePath Text
txt
(TCError -> ImportContractError)
-> Either TCError (Contract cp st)
-> Either ImportContractError (Contract cp st)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FilePath -> TCError -> ImportContractError
ICETypeCheck FilePath
filePath) (Either TCError (Contract cp st)
-> Either ImportContractError (Contract cp st))
-> Either TCError (Contract cp st)
-> Either ImportContractError (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)
=> (FilePath -> Text -> Either e a)
-> FilePath -> IO a
importUsing :: (FilePath -> Text -> Either e a) -> FilePath -> IO a
importUsing FilePath -> 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
. FilePath -> Text -> Either e a
readFn 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 = (FilePath -> Text -> Either ImportContractError Contract)
-> FilePath -> IO Contract
forall e a.
Exception e =>
(FilePath -> Text -> Either e a) -> FilePath -> IO a
importUsing FilePath -> Text -> Either ImportContractError Contract
readUntypedContract
importContract
:: forall cp st .
Each '[SingI] [cp, st]
=> FilePath -> IO (Contract cp st)
importContract :: FilePath -> IO (Contract cp st)
importContract = (FilePath -> Text -> Either ImportContractError (Contract cp st))
-> FilePath -> IO (Contract cp st)
forall e a.
Exception e =>
(FilePath -> Text -> Either e a) -> FilePath -> IO a
importUsing FilePath -> Text -> Either ImportContractError (Contract cp st)
forall (cp :: T) (st :: T).
Each '[SingI] '[cp, st] =>
FilePath -> Text -> Either ImportContractError (Contract cp st)
readContract
importSomeContract :: FilePath -> IO SomeContract
importSomeContract :: FilePath -> IO SomeContract
importSomeContract = (FilePath -> Text -> Either ImportContractError SomeContract)
-> FilePath -> IO SomeContract
forall e a.
Exception e =>
(FilePath -> Text -> Either e a) -> FilePath -> IO a
importUsing FilePath -> Text -> Either ImportContractError SomeContract
readSomeContract
data ImportContractError
= ICEParse FilePath ParserException
| ICETypeCheck FilePath TCError
deriving stock (Int -> ImportContractError -> ShowS
[ImportContractError] -> ShowS
ImportContractError -> FilePath
(Int -> ImportContractError -> ShowS)
-> (ImportContractError -> FilePath)
-> ([ImportContractError] -> ShowS)
-> Show ImportContractError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ImportContractError] -> ShowS
$cshowList :: [ImportContractError] -> ShowS
show :: ImportContractError -> FilePath
$cshow :: ImportContractError -> FilePath
showsPrec :: Int -> ImportContractError -> ShowS
$cshowsPrec :: Int -> ImportContractError -> ShowS
Show, ImportContractError -> ImportContractError -> Bool
(ImportContractError -> ImportContractError -> Bool)
-> (ImportContractError -> ImportContractError -> Bool)
-> Eq ImportContractError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportContractError -> ImportContractError -> Bool
$c/= :: ImportContractError -> ImportContractError -> Bool
== :: ImportContractError -> ImportContractError -> Bool
$c== :: ImportContractError -> ImportContractError -> Bool
Eq)
instance Buildable ImportContractError where
build :: ImportContractError -> Builder
build =
\case
ICEParse FilePath
filePath ParserException
e -> [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
[ Builder
"Error at " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
forall p. Buildable p => p -> Builder
build FilePath
filePath
, 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
""
]
ICETypeCheck FilePath
filePath TCError
e -> [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
[ Builder
"Error at " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
forall p. Buildable p => p -> Builder
build FilePath
filePath
, 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
""
]
instance Exception ImportContractError where
displayException :: ImportContractError -> FilePath
displayException = ImportContractError -> FilePath
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty
readUntypedValue
:: FilePath
-> Text
-> Either ImportValueError U.Value
readUntypedValue :: FilePath -> Text -> Either ImportValueError Value
readUntypedValue FilePath
filePath Text
txt = do
(ParserException -> ImportValueError)
-> Either ParserException Value -> Either ImportValueError Value
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FilePath -> ParserException -> ImportValueError
IVEParse FilePath
filePath) (Either ParserException Value -> Either ImportValueError Value)
-> Either ParserException Value -> Either ImportValueError Value
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> Either ParserException Value
parseExpandValueFromFile FilePath
filePath Text
txt
readSomeValue
:: U.Ty
-> FilePath
-> Text
-> Either ImportValueError SomeValue
readSomeValue :: Ty -> FilePath -> Text -> Either ImportValueError SomeValue
readSomeValue Ty
ty FilePath
filePath Text
txt = do
Value
valueU <- FilePath -> Text -> Either ImportValueError Value
readUntypedValue FilePath
filePath Text
txt
(TCError -> ImportValueError)
-> Either TCError SomeValue -> Either ImportValueError SomeValue
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FilePath -> TCError -> ImportValueError
IVETypeCheck FilePath
filePath) (Either TCError SomeValue -> Either ImportValueError SomeValue)
-> Either TCError SomeValue -> Either ImportValueError 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
=> FilePath
-> Text
-> Either ImportValueError (Value t)
readValue :: FilePath -> Text -> Either ImportValueError (Value t)
readValue FilePath
filePath Text
txt = do
Value
valueU <- FilePath -> Text -> Either ImportValueError Value
readUntypedValue FilePath
filePath Text
txt
(TCError -> ImportValueError)
-> Either TCError (Value t) -> Either ImportValueError (Value t)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FilePath -> TCError -> ImportValueError
IVETypeCheck FilePath
filePath) (Either TCError (Value t) -> Either ImportValueError (Value t))
-> Either TCError (Value t) -> Either ImportValueError (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 = (FilePath -> Text -> Either ImportValueError Value)
-> FilePath -> IO Value
forall e a.
Exception e =>
(FilePath -> Text -> Either e a) -> FilePath -> IO a
importUsing FilePath -> Text -> Either ImportValueError Value
readUntypedValue
importSomeValue :: U.Ty -> FilePath -> IO SomeValue
importSomeValue :: Ty -> FilePath -> IO SomeValue
importSomeValue = (FilePath -> Text -> Either ImportValueError SomeValue)
-> FilePath -> IO SomeValue
forall e a.
Exception e =>
(FilePath -> Text -> Either e a) -> FilePath -> IO a
importUsing ((FilePath -> Text -> Either ImportValueError SomeValue)
-> FilePath -> IO SomeValue)
-> (Ty -> FilePath -> Text -> Either ImportValueError SomeValue)
-> Ty
-> FilePath
-> IO SomeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ty -> FilePath -> Text -> Either ImportValueError SomeValue
readSomeValue
importValue
:: forall t . SingI t
=> FilePath -> IO (Value t)
importValue :: FilePath -> IO (Value t)
importValue = (FilePath -> Text -> Either ImportValueError (Value t))
-> FilePath -> IO (Value t)
forall e a.
Exception e =>
(FilePath -> Text -> Either e a) -> FilePath -> IO a
importUsing FilePath -> Text -> Either ImportValueError (Value t)
forall (t :: T).
SingI t =>
FilePath -> Text -> Either ImportValueError (Value t)
readValue
data ImportValueError
= IVEParse FilePath ParserException
| IVETypeCheck FilePath TCError
deriving stock (Int -> ImportValueError -> ShowS
[ImportValueError] -> ShowS
ImportValueError -> FilePath
(Int -> ImportValueError -> ShowS)
-> (ImportValueError -> FilePath)
-> ([ImportValueError] -> ShowS)
-> Show ImportValueError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ImportValueError] -> ShowS
$cshowList :: [ImportValueError] -> ShowS
show :: ImportValueError -> FilePath
$cshow :: ImportValueError -> FilePath
showsPrec :: Int -> ImportValueError -> ShowS
$cshowsPrec :: Int -> ImportValueError -> ShowS
Show, ImportValueError -> ImportValueError -> Bool
(ImportValueError -> ImportValueError -> Bool)
-> (ImportValueError -> ImportValueError -> Bool)
-> Eq ImportValueError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportValueError -> ImportValueError -> Bool
$c/= :: ImportValueError -> ImportValueError -> Bool
== :: ImportValueError -> ImportValueError -> Bool
$c== :: ImportValueError -> ImportValueError -> Bool
Eq)
instance Buildable ImportValueError where
build :: ImportValueError -> Builder
build =
\case
IVEParse FilePath
filePath ParserException
e -> [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
[ Builder
"Error at " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
forall p. Buildable p => p -> Builder
build FilePath
filePath
, 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
""
]
IVETypeCheck FilePath
filePath TCError
e -> [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
[ Builder
"Error at " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
forall p. Buildable p => p -> Builder
build FilePath
filePath
, Builder
"The value 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
""
]
instance Exception ImportValueError where
displayException :: ImportValueError -> FilePath
displayException = ImportValueError -> FilePath
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty