module Lorentz.ContractRegistry
(
ContractInfo (..)
, ContractRegistry (..)
, (?::)
, CmdLnArgs (..)
, argParser
, runContractRegistry
, printContractFromRegistryDoc
) where
import Data.Aeson.Encode.Pretty (encodePretty, encodePrettyToTextBuilder)
import qualified Data.ByteString.Lazy.Char8 as BS (putStrLn)
import Data.Constraint ((\\))
import qualified Data.Map as Map
import Data.Text.Lazy.Builder (toLazyText)
import qualified Data.Text.Lazy.IO.Utf8 as Utf8 (writeFile)
import Fmt (Buildable(..), blockListF, nameF, pretty, (+|), (|+))
import qualified Options.Applicative as Opt
import Lorentz.Constraints
import Lorentz.Doc
import Lorentz.Print
import Lorentz.Run
import Michelson.Analyzer (analyze)
import Michelson.Printer (printTypedContract)
import Michelson.Typed (IsoValue(..), Notes)
import qualified Michelson.Typed as M (Contract(..))
import Morley.Micheline
data ContractInfo =
forall cp st.
(NiceParameterFull cp, NiceStorage st) =>
ContractInfo
{ ()
ciContract :: Contract cp st
, ContractInfo -> Bool
ciIsDocumented :: Bool
, ()
ciStorageParser :: Maybe (Opt.Parser st)
, ()
ciStorageNotes :: Maybe (Notes (ToT st))
}
(?::) :: Text -> a -> (Text, a)
?:: :: Text -> a -> (Text, a)
(?::) = (,)
newtype ContractRegistry = ContractRegistry
{ ContractRegistry -> Map Text ContractInfo
unContractRegistry :: Map Text ContractInfo }
getContract :: Maybe Text -> ContractRegistry -> IO (ContractInfo, Text)
getContract :: Maybe Text -> ContractRegistry -> IO (ContractInfo, Text)
getContract mName :: Maybe Text
mName registry :: ContractRegistry
registry =
case Maybe Text
mName of
Just name :: Text
name ->
case Text -> Map Text ContractInfo -> Maybe ContractInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name (ContractRegistry -> Map Text ContractInfo
unContractRegistry ContractRegistry
registry) of
Nothing ->
String -> IO (ContractInfo, Text)
forall (m :: * -> *) a. MonadIO m => String -> m a
die (String -> IO (ContractInfo, Text))
-> String -> IO (ContractInfo, Text)
forall a b. (a -> b) -> a -> b
$ "No contract with name '" Builder -> Builder -> String
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
name Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ "' found\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractRegistry
registry ContractRegistry -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
Just c :: ContractInfo
c -> (ContractInfo, Text) -> IO (ContractInfo, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContractInfo
c, Text
name)
Nothing ->
case Map Text ContractInfo -> [(Text, ContractInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList (ContractRegistry -> Map Text ContractInfo
unContractRegistry ContractRegistry
registry) of
[(ci :: Text
ci, n :: ContractInfo
n)] -> (ContractInfo, Text) -> IO (ContractInfo, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContractInfo
n, Text
ci)
[] -> String -> IO (ContractInfo, Text)
forall (m :: * -> *) a. MonadIO m => String -> m a
die (String -> IO (ContractInfo, Text))
-> String -> IO (ContractInfo, Text)
forall a b. (a -> b) -> a -> b
$ "No contract found"
_ ->
String -> IO (ContractInfo, Text)
forall (m :: * -> *) a. MonadIO m => String -> m a
die (String -> IO (ContractInfo, Text))
-> String -> IO (ContractInfo, Text)
forall a b. (a -> b) -> a -> b
$ "Multiple contracts found. Please provide a name.\n" Builder -> Builder -> String
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractRegistry
registry ContractRegistry -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
instance Buildable ContractRegistry where
build :: ContractRegistry -> Builder
build registry :: ContractRegistry
registry =
Builder -> Builder -> Builder
nameF "Available contracts" ([Text] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
blockListF ([Text] -> Builder) -> [Text] -> Builder
forall a b. (a -> b) -> a -> b
$ Map Text ContractInfo -> [Key (Map Text ContractInfo)]
forall t. ToPairs t => t -> [Key t]
keys (ContractRegistry -> Map Text ContractInfo
unContractRegistry ContractRegistry
registry))
printContractFromRegistryDoc :: Maybe Text -> ContractRegistry -> DGitRevision -> Maybe FilePath -> IO ()
printContractFromRegistryDoc :: Maybe Text
-> ContractRegistry -> DGitRevision -> Maybe String -> IO ()
printContractFromRegistryDoc mName :: Maybe Text
mName contracts :: ContractRegistry
contracts gitRev :: DGitRevision
gitRev mOutput :: Maybe String
mOutput = do
(ContractInfo{..}, name :: Text
name) <- Maybe Text -> ContractRegistry -> IO (ContractInfo, Text)
getContract Maybe Text
mName ContractRegistry
contracts
if Bool
ciIsDocumented
then
String -> Maybe String -> LText -> IO ()
writeFunc (Text -> String
forall a. ToString a => a -> String
toString Text
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ".md") Maybe String
mOutput (LText -> IO ()) -> LText -> IO ()
forall a b. (a -> b) -> a -> b
$
WithFinalizedDoc (Contract cp st) -> LText
forall a. ContainsDoc a => WithFinalizedDoc a -> LText
buildMarkdownDoc (WithFinalizedDoc (Contract cp st) -> LText)
-> WithFinalizedDoc (Contract cp st) -> LText
forall a b. (a -> b) -> a -> b
$ DGitRevision -> Contract cp st -> WithFinalizedDoc (Contract cp st)
forall a.
ContainsUpdateableDoc a =>
DGitRevision -> a -> WithFinalizedDoc a
attachDocCommons DGitRevision
gitRev Contract cp st
ciContract
else String -> IO ()
forall (m :: * -> *) a. MonadIO m => String -> m a
die "This contract is not documented"
data SomeNiceStorage where
SomeNiceStorage :: NiceStorage st => st -> SomeNiceStorage
data CmdLnArgs
= List
| Print (Maybe Text) (Maybe FilePath) Bool Bool
| Document (Maybe Text) (Maybe FilePath) DGitRevision
| Analyze (Maybe Text)
| PrintStorage SomeNiceStorage Bool
argParser :: ContractRegistry -> DGitRevision -> Opt.Parser CmdLnArgs
argParser :: ContractRegistry -> DGitRevision -> Parser CmdLnArgs
argParser registry :: ContractRegistry
registry gitRev :: DGitRevision
gitRev = Mod CommandFields CmdLnArgs -> Parser CmdLnArgs
forall a. Mod CommandFields a -> Parser a
Opt.subparser (Mod CommandFields CmdLnArgs -> Parser CmdLnArgs)
-> Mod CommandFields CmdLnArgs -> Parser CmdLnArgs
forall a b. (a -> b) -> a -> b
$ [Mod CommandFields CmdLnArgs] -> Mod CommandFields CmdLnArgs
forall a. Monoid a => [a] -> a
mconcat ([Mod CommandFields CmdLnArgs] -> Mod CommandFields CmdLnArgs)
-> [Mod CommandFields CmdLnArgs] -> Mod CommandFields CmdLnArgs
forall a b. (a -> b) -> a -> b
$
[ Mod CommandFields CmdLnArgs
listSubCmd
, Mod CommandFields CmdLnArgs
printSubCmd
, Mod CommandFields CmdLnArgs
documentSubCmd
, Mod CommandFields CmdLnArgs
analyzerSubCmd
] [Mod CommandFields CmdLnArgs]
-> [Mod CommandFields CmdLnArgs] -> [Mod CommandFields CmdLnArgs]
forall a. Semigroup a => a -> a -> a
<> (
case ([(Text, ContractInfo)] -> Maybe (NonEmpty (Text, ContractInfo))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([(Text, ContractInfo)] -> Maybe (NonEmpty (Text, ContractInfo)))
-> [(Text, ContractInfo)] -> Maybe (NonEmpty (Text, ContractInfo))
forall a b. (a -> b) -> a -> b
$ Map Text ContractInfo -> [(Text, ContractInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Text ContractInfo -> [(Text, ContractInfo)])
-> Map Text ContractInfo -> [(Text, ContractInfo)]
forall a b. (a -> b) -> a -> b
$ ContractRegistry -> Map Text ContractInfo
unContractRegistry ContractRegistry
registry) of
Just (a :: (Text, ContractInfo)
a :| []) ->
((Text, ContractInfo) -> Maybe (Mod CommandFields CmdLnArgs))
-> [(Text, ContractInfo)] -> [Mod CommandFields CmdLnArgs]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text, ContractInfo) -> Maybe (Mod CommandFields CmdLnArgs)
storageSubCmdSingle [(Text, ContractInfo)
a]
_ ->
((Text, ContractInfo) -> Maybe (Mod CommandFields CmdLnArgs))
-> [(Text, ContractInfo)] -> [Mod CommandFields CmdLnArgs]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text, ContractInfo) -> Maybe (Mod CommandFields CmdLnArgs)
storageSubCmd (Map Text ContractInfo -> [(Text, ContractInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Text ContractInfo -> [(Text, ContractInfo)])
-> Map Text ContractInfo -> [(Text, ContractInfo)]
forall a b. (a -> b) -> a -> b
$ ContractRegistry -> Map Text ContractInfo
unContractRegistry ContractRegistry
registry)
)
where
mkCommandParser :: String -> Parser a -> String -> Mod CommandFields a
mkCommandParser commandName :: String
commandName parser :: Parser a
parser desc :: String
desc =
String -> ParserInfo a -> Mod CommandFields a
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command String
commandName (ParserInfo a -> Mod CommandFields a)
-> ParserInfo a -> Mod CommandFields a
forall a b. (a -> b) -> a -> b
$
Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (Parser (a -> a)
forall a. Parser (a -> a)
Opt.helper Parser (a -> a) -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
parser) (InfoMod a -> ParserInfo a) -> InfoMod a -> ParserInfo a
forall a b. (a -> b) -> a -> b
$
String -> InfoMod a
forall a. String -> InfoMod a
Opt.progDesc String
desc
listSubCmd :: Mod CommandFields CmdLnArgs
listSubCmd =
String -> Parser CmdLnArgs -> String -> Mod CommandFields CmdLnArgs
forall a. String -> Parser a -> String -> Mod CommandFields a
mkCommandParser "list"
(CmdLnArgs -> Parser CmdLnArgs
forall (f :: * -> *) a. Applicative f => a -> f a
pure CmdLnArgs
List)
"Show all available contracts"
printSubCmd :: Mod CommandFields CmdLnArgs
printSubCmd =
String -> Parser CmdLnArgs -> String -> Mod CommandFields CmdLnArgs
forall a. String -> Parser a -> String -> Mod CommandFields a
mkCommandParser "print"
(Maybe Text -> Maybe String -> Bool -> Bool -> CmdLnArgs
Print (Maybe Text -> Maybe String -> Bool -> Bool -> CmdLnArgs)
-> Parser (Maybe Text)
-> Parser (Maybe String -> Bool -> Bool -> CmdLnArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Text)
mNameption Parser (Maybe String -> Bool -> Bool -> CmdLnArgs)
-> Parser (Maybe String) -> Parser (Bool -> Bool -> CmdLnArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe String)
outputOptions Parser (Bool -> Bool -> CmdLnArgs)
-> Parser Bool -> Parser (Bool -> CmdLnArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
onelineOption Parser (Bool -> CmdLnArgs) -> Parser Bool -> Parser CmdLnArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
michelineOption)
"Dump a contract in form of Michelson code"
documentSubCmd :: Mod CommandFields CmdLnArgs
documentSubCmd =
String -> Parser CmdLnArgs -> String -> Mod CommandFields CmdLnArgs
forall a. String -> Parser a -> String -> Mod CommandFields a
mkCommandParser "document"
(Maybe Text -> Maybe String -> DGitRevision -> CmdLnArgs
Document (Maybe Text -> Maybe String -> DGitRevision -> CmdLnArgs)
-> Parser (Maybe Text)
-> Parser (Maybe String -> DGitRevision -> CmdLnArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Text)
mNameption Parser (Maybe String -> DGitRevision -> CmdLnArgs)
-> Parser (Maybe String) -> Parser (DGitRevision -> CmdLnArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe String)
outputOptions Parser (DGitRevision -> CmdLnArgs)
-> Parser DGitRevision -> Parser CmdLnArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DGitRevision -> Parser DGitRevision
forall (f :: * -> *) a. Applicative f => a -> f a
pure DGitRevision
gitRev)
"Dump contract documentation in Markdown"
analyzerSubCmd :: Mod CommandFields CmdLnArgs
analyzerSubCmd =
String -> Parser CmdLnArgs -> String -> Mod CommandFields CmdLnArgs
forall a. String -> Parser a -> String -> Mod CommandFields a
mkCommandParser "analyze"
(Maybe Text -> CmdLnArgs
Analyze (Maybe Text -> CmdLnArgs)
-> Parser (Maybe Text) -> Parser CmdLnArgs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Text)
mNameption)
"Analyze the contract and prints statistics about it."
mNameption :: Parser (Maybe Text)
mNameption = Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text -> Parser (Maybe Text))
-> (Mod OptionFields Text -> Parser Text)
-> Mod OptionFields Text
-> Parser (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption (Mod OptionFields Text -> Parser (Maybe Text))
-> Mod OptionFields Text -> Parser (Maybe Text)
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields Text] -> Mod OptionFields Text
forall a. Monoid a => [a] -> a
mconcat
[ Char -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short 'n'
, String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long "name"
, String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar "IDENTIFIER"
, String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opt.help "Name of a contract returned by `list` command."
]
outputOptions :: Parser (Maybe String)
outputOptions = Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields String] -> Mod OptionFields String
forall a. Monoid a => [a] -> a
mconcat
[ Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short 'o'
, String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long "output"
, String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar "FILEPATH"
, String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help (String -> Mod OptionFields String)
-> String -> Mod OptionFields String
forall a b. (a -> b) -> a -> b
$
"File to use as output. If not specified, the file name " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
"will be constructed from the contract name." String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
"Pass - to use stdout."
]
onelineOption :: Opt.Parser Bool
onelineOption :: Parser Bool
onelineOption = Mod FlagFields Bool -> Parser Bool
Opt.switch (
String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long "oneline" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help "Force single line output")
michelineOption :: Opt.Parser Bool
michelineOption :: Parser Bool
michelineOption = Mod FlagFields Bool -> Parser Bool
Opt.switch (
String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long "micheline" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
Opt.help "Print using low-level Micheline representation")
storageSubCmd ::
(Text, ContractInfo) -> Maybe $ Opt.Mod Opt.CommandFields CmdLnArgs
storageSubCmd :: (Text, ContractInfo) -> Maybe (Mod CommandFields CmdLnArgs)
storageSubCmd (Text -> String
forall a. ToString a => a -> String
toString -> String
name, ContractInfo {..}) = do
Parser st
storageParser <- Maybe (Parser st)
ciStorageParser
pure $ String -> Parser CmdLnArgs -> String -> Mod CommandFields CmdLnArgs
forall a. String -> Parser a -> String -> Mod CommandFields a
mkCommandParser ("storage-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name)
(SomeNiceStorage -> Bool -> CmdLnArgs
PrintStorage (SomeNiceStorage -> Bool -> CmdLnArgs)
-> (st -> SomeNiceStorage) -> st -> Bool -> CmdLnArgs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. st -> SomeNiceStorage
forall st. NiceStorage st => st -> SomeNiceStorage
SomeNiceStorage (st -> Bool -> CmdLnArgs)
-> Parser st -> Parser (Bool -> CmdLnArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser st
storageParser Parser (Bool -> CmdLnArgs) -> Parser Bool -> Parser CmdLnArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
michelineOption)
("Print initial storage for the contract '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "'")
storageSubCmdSingle ::
(Text, ContractInfo) -> Maybe $ Opt.Mod Opt.CommandFields CmdLnArgs
storageSubCmdSingle :: (Text, ContractInfo) -> Maybe (Mod CommandFields CmdLnArgs)
storageSubCmdSingle (Text -> String
forall a. ToString a => a -> String
toString -> String
name, ContractInfo {..}) = do
Parser st
storageParser <- Maybe (Parser st)
ciStorageParser
pure $ String -> Parser CmdLnArgs -> String -> Mod CommandFields CmdLnArgs
forall a. String -> Parser a -> String -> Mod CommandFields a
mkCommandParser "storage"
(SomeNiceStorage -> Bool -> CmdLnArgs
PrintStorage (SomeNiceStorage -> Bool -> CmdLnArgs)
-> (st -> SomeNiceStorage) -> st -> Bool -> CmdLnArgs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. st -> SomeNiceStorage
forall st. NiceStorage st => st -> SomeNiceStorage
SomeNiceStorage (st -> Bool -> CmdLnArgs)
-> Parser st -> Parser (Bool -> CmdLnArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser st
storageParser Parser (Bool -> CmdLnArgs) -> Parser Bool -> Parser CmdLnArgs
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
michelineOption)
("Print initial storage for the contract '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "'")
runContractRegistry :: ContractRegistry -> CmdLnArgs -> IO ()
runContractRegistry :: ContractRegistry -> CmdLnArgs -> IO ()
runContractRegistry registry :: ContractRegistry
registry = \case
List -> ContractRegistry -> IO ()
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty ContractRegistry
registry
Print mName :: Maybe Text
mName mOutput :: Maybe String
mOutput forceOneLine :: Bool
forceOneLine useMicheline :: Bool
useMicheline -> do
(ContractInfo{..}, name :: Text
name) <- Maybe Text -> ContractRegistry -> IO (ContractInfo, Text)
getContract Maybe Text
mName ContractRegistry
registry
let
compiledContract :: Contract (ToT cp) (ToT st)
compiledContract = case Maybe (Notes (ToT st))
ciStorageNotes of
Just notes :: Notes (ToT st)
notes -> (Contract cp st -> Contract (ToT cp) (ToT st)
forall cp st.
(NiceParameterFull cp, NiceStorage st) =>
Contract cp st -> Contract (ToT cp) (ToT st)
compileLorentzContract Contract cp st
ciContract) { cStoreNotes :: Notes (ToT st)
M.cStoreNotes = Notes (ToT st)
notes }
Nothing -> Contract cp st -> Contract (ToT cp) (ToT st)
forall cp st.
(NiceParameterFull cp, NiceStorage st) =>
Contract cp st -> Contract (ToT cp) (ToT st)
compileLorentzContract Contract cp st
ciContract
String -> Maybe String -> LText -> IO ()
writeFunc (Text -> String
forall a. ToString a => a -> String
toString Text
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ".tz") Maybe String
mOutput (LText -> IO ()) -> LText -> IO ()
forall a b. (a -> b) -> a -> b
$
if Bool
useMicheline
then Builder -> LText
toLazyText (Builder -> LText) -> Builder -> LText
forall a b. (a -> b) -> a -> b
$ Expression -> Builder
forall a. ToJSON a => a -> Builder
encodePrettyToTextBuilder (Expression -> Builder) -> Expression -> Builder
forall a b. (a -> b) -> a -> b
$ Contract (ToT cp) (ToT st) -> Expression
forall a. ToExpression a => a -> Expression
toExpression Contract (ToT cp) (ToT st)
compiledContract
else Bool -> Contract (ToT cp) (ToT st) -> LText
forall (p :: T) (s :: T). Bool -> Contract p s -> LText
printTypedContract Bool
forceOneLine (Contract (ToT cp) (ToT st) -> LText)
-> Contract (ToT cp) (ToT st) -> LText
forall a b. (a -> b) -> a -> b
$ Contract (ToT cp) (ToT st)
compiledContract
Document mName :: Maybe Text
mName mOutput :: Maybe String
mOutput gitRev :: DGitRevision
gitRev -> do
Maybe Text
-> ContractRegistry -> DGitRevision -> Maybe String -> IO ()
printContractFromRegistryDoc Maybe Text
mName ContractRegistry
registry DGitRevision
gitRev Maybe String
mOutput
Analyze mName :: Maybe Text
mName -> do
(ContractInfo{..}, _) <- Maybe Text -> ContractRegistry -> IO (ContractInfo, Text)
getContract Maybe Text
mName ContractRegistry
registry
let compiledContract :: Contract (ToT cp) (ToT st)
compiledContract =
Contract cp st -> Contract (ToT cp) (ToT st)
forall cp st.
(NiceParameterFull cp, NiceStorage st) =>
Contract cp st -> Contract (ToT cp) (ToT st)
compileLorentzContract Contract cp st
ciContract
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ AnalyzerRes -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (AnalyzerRes -> Text) -> AnalyzerRes -> Text
forall a b. (a -> b) -> a -> b
$ Instr (ContractInp (ToT cp) (ToT st)) (ContractOut (ToT st))
-> AnalyzerRes
forall (inp :: [T]) (out :: [T]). Instr inp out -> AnalyzerRes
analyze (Instr (ContractInp (ToT cp) (ToT st)) (ContractOut (ToT st))
-> AnalyzerRes)
-> Instr (ContractInp (ToT cp) (ToT st)) (ContractOut (ToT st))
-> AnalyzerRes
forall a b. (a -> b) -> a -> b
$ Contract (ToT cp) (ToT st)
-> Instr (ContractInp (ToT cp) (ToT st)) (ContractOut (ToT st))
forall (cp :: T) (st :: T). Contract cp st -> ContractCode cp st
M.cCode Contract (ToT cp) (ToT st)
compiledContract
PrintStorage (SomeNiceStorage (st
storage :: st)) useMicheline :: Bool
useMicheline ->
if Bool
useMicheline
then ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Expression -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty (Expression -> ByteString) -> Expression -> ByteString
forall a b. (a -> b) -> a -> b
$ st -> Expression
forall st'. NiceStorage st' => st' -> Expression
toExpressionHelper st
storage
else LText -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (LText -> IO ()) -> LText -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> st -> LText
forall v. NicePrintedValue v => Bool -> v -> LText
printLorentzValue Bool
True st
storage
where
toExpressionHelper :: forall st'. NiceStorage st' => st' -> Expression
toExpressionHelper :: st' -> Expression
toExpressionHelper = Value (ToT st') -> Expression
forall a. ToExpression a => a -> Expression
toExpression (Value (ToT st') -> Expression)
-> (st' -> Value (ToT st')) -> st' -> Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. st' -> Value (ToT st')
forall a. IsoValue a => a -> Value (ToT a)
toVal ((KnownT (ToT st'), HasNoOp (ToT st'),
HasNoNestedBigMaps (ToT st'), HasNoContract (ToT st')) =>
st' -> Expression)
-> ((HasAnnotation st', KnownValue st',
(KnownT (ToT st'), FailOnOperationFound (ContainsOp (ToT st')),
FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st')),
FailOnContractFound (ContainsContract (ToT st'))))
:- (KnownT (ToT st'), HasNoOp (ToT st'),
HasNoNestedBigMaps (ToT st'), HasNoContract (ToT st')))
-> st'
-> Expression
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (HasAnnotation st', KnownValue st',
(KnownT (ToT st'), FailOnOperationFound (ContainsOp (ToT st')),
FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st')),
FailOnContractFound (ContainsContract (ToT st'))))
:- (KnownT (ToT st'), HasNoOp (ToT st'),
HasNoNestedBigMaps (ToT st'), HasNoContract (ToT st'))
forall a. NiceStorage a :- StorageScope (ToT a)
niceStorageEvi @st'
writeFunc :: FilePath -> Maybe FilePath -> LText -> IO ()
writeFunc :: String -> Maybe String -> LText -> IO ()
writeFunc defName :: String
defName = \case
Nothing -> String -> LText -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> LText -> m ()
Utf8.writeFile String
defName
Just "-" -> LText -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn
Just output :: String
output -> String -> LText -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> LText -> m ()
Utf8.writeFile String
output