-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | This module contains various datatypes and functions which are
-- common for contract registry packages (e.g.
-- [morley-ledgers](https://gitlab.com/morley-framework/morley-ledgers/)).

module Lorentz.ContractRegistry
  ( -- * Registry types
    ContractInfo (..)
  , ContractRegistry (..)
  , (?::)

  -- * Things to do in @main@
  , CmdLnArgs (..)
  , argParser
  , runContractRegistry

  -- * Building blocks
  , 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
import Util.CLI (mkCommandParser)

data ContractInfo =
  forall cp st.
    (NiceStorage st) =>
  ContractInfo
  { ()
ciContract :: Contract cp st
  , ContractInfo -> Bool
ciIsDocumented :: Bool
  , ()
ciStorageParser :: Maybe (Opt.Parser st)
  -- ^ Specifies how to parse initial storage value.
  --
  -- Normally you pass some user data and call a function that
  -- constructs storage from that data.
  --
  -- If storage is simple and can be easilly constructed manually, you
  -- can use 'Nothing'.
  , ()
ciStorageNotes :: Maybe (Notes (ToT st))
  -- ^ Rewrite annotations in storage.
  -- We don't won't to uncoditionally override storage notes since
  -- after #20 we require notes to be non-empty, so we wrap them into `Maybe`.
  }

(?::) :: 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 Maybe Text
mName ContractRegistry
registry =
  case Maybe Text
mName of
    Just 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
        Maybe ContractInfo
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
$ Builder
"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
|+ Builder
"' 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
|+ Builder
""
        Just ContractInfo
c -> (ContractInfo, Text) -> IO (ContractInfo, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContractInfo
c, Text
name)
    Maybe Text
Nothing ->
      -- When there is exactly one contract, return it.
      case Map Text ContractInfo -> [(Text, ContractInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList (ContractRegistry -> Map Text ContractInfo
unContractRegistry ContractRegistry
registry) of
        [(Text
ci, 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
$ String
"No contract found"
        [(Text, ContractInfo)]
_ ->
          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
$ Builder
"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
|+ Builder
""

instance Buildable ContractRegistry where
  build :: ContractRegistry -> Builder
build ContractRegistry
registry =
    Builder -> Builder -> Builder
nameF Builder
"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 Maybe Text
mName ContractRegistry
contracts DGitRevision
gitRev Maybe String
mOutput = do
  (ContractInfo{Bool
Maybe (Parser st)
Maybe (Notes (ToT st))
Contract cp st
ciStorageNotes :: Maybe (Notes (ToT st))
ciStorageParser :: Maybe (Parser st)
ciIsDocumented :: Bool
ciContract :: Contract cp st
ciStorageNotes :: ()
ciStorageParser :: ()
ciIsDocumented :: ContractInfo -> Bool
ciContract :: ()
..}, 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
<> String
".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 String
"This contract is not documented"

data SomeNiceStorage where
  SomeNiceStorage :: NiceStorage st => st -> SomeNiceStorage

-- | 'ContractRegistry' actions parsed from CLI.
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 ContractRegistry
registry 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 ((Text, ContractInfo)
a :| []) ->
        -- When there is exactly one contract.
        ((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]
      Maybe (NonEmpty (Text, ContractInfo))
_ ->
        ((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
    listSubCmd :: Mod CommandFields CmdLnArgs
listSubCmd =
      String -> Parser CmdLnArgs -> String -> Mod CommandFields CmdLnArgs
forall a. String -> Parser a -> String -> Mod CommandFields a
mkCommandParser String
"list"
      (CmdLnArgs -> Parser CmdLnArgs
forall (f :: * -> *) a. Applicative f => a -> f a
pure CmdLnArgs
List)
      String
"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 String
"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)
      String
"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 String
"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)
      String
"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 String
"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)
      String
"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 Char
'n'
      , String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"name"
      , String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"IDENTIFIER"
      , String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"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 Char
'o'
      , String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"output"
      , String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"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
$
        String
"File to use as output. If not specified, the file name " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
        String
"will be constructed from the contract name." String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
        String
"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 String
"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 String
"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 String
"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 String
"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 {Bool
Maybe (Parser st)
Maybe (Notes (ToT st))
Contract cp st
ciStorageNotes :: Maybe (Notes (ToT st))
ciStorageParser :: Maybe (Parser st)
ciIsDocumented :: Bool
ciContract :: Contract cp st
ciStorageNotes :: ()
ciStorageParser :: ()
ciIsDocumented :: ContractInfo -> Bool
ciContract :: ()
..}) = 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 (String
"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)
        (String
"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
<> String
"'")

    -- | This will generated `storage` command instead of `storage-<contractName>` commands
    -- Useful when there is exactly one contract.
    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 {Bool
Maybe (Parser st)
Maybe (Notes (ToT st))
Contract cp st
ciStorageNotes :: Maybe (Notes (ToT st))
ciStorageParser :: Maybe (Parser st)
ciIsDocumented :: Bool
ciContract :: Contract cp st
ciStorageNotes :: ()
ciStorageParser :: ()
ciIsDocumented :: ContractInfo -> Bool
ciContract :: ()
..}) = 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 String
"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)
        (String
"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
<> String
"'")

-- | Run an action operating with 'ContractRegistry'.
runContractRegistry :: ContractRegistry -> CmdLnArgs -> IO ()
runContractRegistry :: ContractRegistry -> CmdLnArgs -> IO ()
runContractRegistry ContractRegistry
registry = \case
  CmdLnArgs
List -> ContractRegistry -> IO ()
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty ContractRegistry
registry
  Print Maybe Text
mName Maybe String
mOutput Bool
forceOneLine Bool
useMicheline -> do
    (ContractInfo{Bool
Maybe (Parser st)
Maybe (Notes (ToT st))
Contract cp st
ciStorageNotes :: Maybe (Notes (ToT st))
ciStorageParser :: Maybe (Parser st)
ciIsDocumented :: Bool
ciContract :: Contract cp st
ciStorageNotes :: ()
ciStorageParser :: ()
ciIsDocumented :: ContractInfo -> Bool
ciContract :: ()
..}, 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 (ToT st)
notes -> (Contract cp st -> Contract (ToT cp) (ToT st)
forall cp st. Contract cp st -> Contract (ToT cp) (ToT st)
toMichelsonContract Contract cp st
ciContract) { cStoreNotes :: Notes (ToT st)
M.cStoreNotes = Notes (ToT st)
notes }
        Maybe (Notes (ToT st))
Nothing -> Contract cp st -> Contract (ToT cp) (ToT st)
forall cp st. Contract cp st -> Contract (ToT cp) (ToT st)
toMichelsonContract 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
<> String
".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 Maybe Text
mName Maybe String
mOutput DGitRevision
gitRev -> do
    Maybe Text
-> ContractRegistry -> DGitRevision -> Maybe String -> IO ()
printContractFromRegistryDoc Maybe Text
mName ContractRegistry
registry DGitRevision
gitRev Maybe String
mOutput
  Analyze Maybe Text
mName -> do
    (ContractInfo{Bool
Maybe (Parser st)
Maybe (Notes (ToT st))
Contract cp st
ciStorageNotes :: Maybe (Notes (ToT st))
ciStorageParser :: Maybe (Parser st)
ciIsDocumented :: Bool
ciContract :: Contract cp st
ciStorageNotes :: ()
ciStorageParser :: ()
ciIsDocumented :: ContractInfo -> Bool
ciContract :: ()
..}, Text
_) <- 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. Contract cp st -> Contract (ToT cp) (ToT st)
toMichelsonContract 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)) 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 (StorageScope (ToT st') => st' -> Expression)
-> (((SingI (ToT st'), FailOnOperationFound (ContainsOp (ToT st')),
      FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st')),
      FailOnContractFound (ContainsContract (ToT st'))),
     HasAnnotation st', KnownValue st')
    :- StorageScope (ToT st'))
-> st'
-> Expression
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ ((SingI (ToT st'), FailOnOperationFound (ContainsOp (ToT st')),
  FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st')),
  FailOnContractFound (ContainsContract (ToT st'))),
 HasAnnotation st', KnownValue st')
:- StorageScope (ToT st')
forall a. NiceStorage a :- StorageScope (ToT a)
niceStorageEvi @st'

writeFunc :: FilePath -> Maybe FilePath -> LText -> IO ()
writeFunc :: String -> Maybe String -> LText -> IO ()
writeFunc String
defName = \case
  Maybe String
Nothing -> String -> LText -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> LText -> m ()
Utf8.writeFile String
defName
  Just String
"-" -> LText -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn
  Just String
output -> String -> LText -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> LText -> m ()
Utf8.writeFile String
output