-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | 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 Data.ByteString.Lazy.Char8 qualified as BS (putStrLn)
import Data.Map qualified as Map
import Data.Text.Lazy.Builder (toLazyText)
import Data.Text.Lazy.IO.Utf8 qualified as Utf8 (writeFile)
import Fmt (Buildable(..), blockListF, nameF, pretty, (+|), (|+))
import Options.Applicative qualified as Opt

import Lorentz.Constraints
import Lorentz.Doc
import Lorentz.Print
import Lorentz.Run
import Morley.Micheline
import Morley.Michelson.Analyzer (analyze)
import Morley.Michelson.Printer (printTypedContract)
import Morley.Michelson.Typed (IsoValue(..), Notes)
import Morley.Michelson.Typed qualified as M
import Morley.Util.CLI (mkCommandParser)

data ContractInfo =
  forall cp st vd.
    (NiceStorage st) =>
  ContractInfo
  { ()
ciContract :: Contract cp st vd
  , 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)
?:: :: forall 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 ->
          FilePath -> IO (ContractInfo, Text)
forall (m :: * -> *) a. MonadIO m => FilePath -> m a
die (FilePath -> IO (ContractInfo, Text))
-> FilePath -> IO (ContractInfo, Text)
forall a b. (a -> b) -> a -> b
$ Builder
"No contract with name '" Builder -> Builder -> FilePath
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)
        [] -> FilePath -> IO (ContractInfo, Text)
forall (m :: * -> *) a. MonadIO m => FilePath -> m a
die (FilePath -> IO (ContractInfo, Text))
-> FilePath -> IO (ContractInfo, Text)
forall a b. (a -> b) -> a -> b
$ FilePath
"No contract found"
        [(Text, ContractInfo)]
_ ->
          FilePath -> IO (ContractInfo, Text)
forall (m :: * -> *) a. MonadIO m => FilePath -> m a
die (FilePath -> IO (ContractInfo, Text))
-> FilePath -> IO (ContractInfo, Text)
forall a b. (a -> b) -> a -> b
$ Builder
"Multiple contracts found. Please provide a name.\n" Builder -> Builder -> FilePath
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 FilePath -> IO ()
printContractFromRegistryDoc Maybe Text
mName ContractRegistry
contracts DGitRevision
gitRev Maybe FilePath
mOutput = do
  (ContractInfo{Bool
Maybe (Parser st)
Maybe (Notes (ToT st))
Contract cp st vd
ciStorageNotes :: Maybe (Notes (ToT st))
ciStorageParser :: Maybe (Parser st)
ciIsDocumented :: Bool
ciContract :: Contract cp st vd
ciStorageNotes :: ()
ciStorageParser :: ()
ciIsDocumented :: ContractInfo -> Bool
ciContract :: ()
..}, Text
name) <- Maybe Text -> ContractRegistry -> IO (ContractInfo, Text)
getContract Maybe Text
mName ContractRegistry
contracts
  if Bool
ciIsDocumented
  then
     FilePath -> Maybe FilePath -> LText -> IO ()
writeFunc (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
name FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".md") Maybe FilePath
mOutput (LText -> IO ()) -> LText -> IO ()
forall a b. (a -> b) -> a -> b
$
       WithFinalizedDoc (Contract cp st vd) -> LText
forall a. ContainsDoc a => WithFinalizedDoc a -> LText
buildMarkdownDoc (WithFinalizedDoc (Contract cp st vd) -> LText)
-> WithFinalizedDoc (Contract cp st vd) -> LText
forall a b. (a -> b) -> a -> b
$ DGitRevision
-> Contract cp st vd -> WithFinalizedDoc (Contract cp st vd)
forall a.
ContainsUpdateableDoc a =>
DGitRevision -> a -> WithFinalizedDoc a
attachDocCommons DGitRevision
gitRev Contract cp st vd
ciContract
  else FilePath -> IO ()
forall (m :: * -> *) a. MonadIO m => FilePath -> m a
die FilePath
"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 =
      FilePath
-> Parser CmdLnArgs -> FilePath -> Mod CommandFields CmdLnArgs
forall a. FilePath -> Parser a -> FilePath -> Mod CommandFields a
mkCommandParser FilePath
"list"
      (CmdLnArgs -> Parser CmdLnArgs
forall (f :: * -> *) a. Applicative f => a -> f a
pure CmdLnArgs
List)
      FilePath
"Show all available contracts"

    printSubCmd :: Mod CommandFields CmdLnArgs
printSubCmd =
      FilePath
-> Parser CmdLnArgs -> FilePath -> Mod CommandFields CmdLnArgs
forall a. FilePath -> Parser a -> FilePath -> Mod CommandFields a
mkCommandParser FilePath
"print"
      (Maybe Text -> Maybe FilePath -> Bool -> Bool -> CmdLnArgs
Print (Maybe Text -> Maybe FilePath -> Bool -> Bool -> CmdLnArgs)
-> Parser (Maybe Text)
-> Parser (Maybe FilePath -> Bool -> Bool -> CmdLnArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Text)
mNameption Parser (Maybe FilePath -> Bool -> Bool -> CmdLnArgs)
-> Parser (Maybe FilePath) -> Parser (Bool -> Bool -> CmdLnArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe FilePath)
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)
      FilePath
"Dump a contract in form of Michelson code"

    documentSubCmd :: Mod CommandFields CmdLnArgs
documentSubCmd =
      FilePath
-> Parser CmdLnArgs -> FilePath -> Mod CommandFields CmdLnArgs
forall a. FilePath -> Parser a -> FilePath -> Mod CommandFields a
mkCommandParser FilePath
"document"
      (Maybe Text -> Maybe FilePath -> DGitRevision -> CmdLnArgs
Document (Maybe Text -> Maybe FilePath -> DGitRevision -> CmdLnArgs)
-> Parser (Maybe Text)
-> Parser (Maybe FilePath -> DGitRevision -> CmdLnArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Text)
mNameption Parser (Maybe FilePath -> DGitRevision -> CmdLnArgs)
-> Parser (Maybe FilePath) -> Parser (DGitRevision -> CmdLnArgs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe FilePath)
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)
      FilePath
"Dump contract documentation in Markdown"

    analyzerSubCmd :: Mod CommandFields CmdLnArgs
analyzerSubCmd =
      FilePath
-> Parser CmdLnArgs -> FilePath -> Mod CommandFields CmdLnArgs
forall a. FilePath -> Parser a -> FilePath -> Mod CommandFields a
mkCommandParser FilePath
"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)
      FilePath
"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'
      , FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"name"
      , FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"IDENTIFIER"
      , FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Name of a contract returned by `list` command."
      ]

    outputOptions :: Parser (Maybe FilePath)
outputOptions = Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser FilePath -> Parser (Maybe FilePath))
-> (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath
-> Parser (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption (Mod OptionFields FilePath -> Parser (Maybe FilePath))
-> Mod OptionFields FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
      [ Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'o'
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"output"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
Opt.metavar FilePath
"FILEPATH"
      , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help (FilePath -> Mod OptionFields FilePath)
-> FilePath -> Mod OptionFields FilePath
forall a b. (a -> b) -> a -> b
$
        FilePath
"File to use as output. If not specified, the file name " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
        FilePath
"will be constructed from the contract name." FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
        FilePath
"Pass - to use stdout."
      ]

    onelineOption :: Opt.Parser Bool
    onelineOption :: Parser Bool
onelineOption = Mod FlagFields Bool -> Parser Bool
Opt.switch (
      FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"oneline" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
      FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Force single line output")

    michelineOption :: Opt.Parser Bool
    michelineOption :: Parser Bool
michelineOption = Mod FlagFields Bool -> Parser Bool
Opt.switch (
      FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Opt.long FilePath
"micheline" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
      FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
Opt.help FilePath
"Print using low-level Micheline representation")

    storageSubCmd ::
      (Text, ContractInfo) -> Maybe $ Opt.Mod Opt.CommandFields CmdLnArgs
    storageSubCmd :: (Text, ContractInfo) -> Maybe (Mod CommandFields CmdLnArgs)
storageSubCmd (Text -> FilePath
forall a. ToString a => a -> FilePath
toString -> FilePath
name, ContractInfo {Bool
Maybe (Parser st)
Maybe (Notes (ToT st))
Contract cp st vd
ciStorageNotes :: Maybe (Notes (ToT st))
ciStorageParser :: Maybe (Parser st)
ciIsDocumented :: Bool
ciContract :: Contract cp st vd
ciStorageNotes :: ()
ciStorageParser :: ()
ciIsDocumented :: ContractInfo -> Bool
ciContract :: ()
..}) = do
      Parser st
storageParser <- Maybe (Parser st)
ciStorageParser
      pure $ FilePath
-> Parser CmdLnArgs -> FilePath -> Mod CommandFields CmdLnArgs
forall a. FilePath -> Parser a -> FilePath -> Mod CommandFields a
mkCommandParser (FilePath
"storage-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
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)
        (FilePath
"Print initial storage for the contract '" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
name FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"'")

    -- 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 -> FilePath
forall a. ToString a => a -> FilePath
toString -> FilePath
name, ContractInfo {Bool
Maybe (Parser st)
Maybe (Notes (ToT st))
Contract cp st vd
ciStorageNotes :: Maybe (Notes (ToT st))
ciStorageParser :: Maybe (Parser st)
ciIsDocumented :: Bool
ciContract :: Contract cp st vd
ciStorageNotes :: ()
ciStorageParser :: ()
ciIsDocumented :: ContractInfo -> Bool
ciContract :: ()
..}) = do
      Parser st
storageParser <- Maybe (Parser st)
ciStorageParser
      pure $ FilePath
-> Parser CmdLnArgs -> FilePath -> Mod CommandFields CmdLnArgs
forall a. FilePath -> Parser a -> FilePath -> Mod CommandFields a
mkCommandParser FilePath
"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)
        (FilePath
"Print initial storage for the contract '" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
name FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"'")

-- | 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 FilePath
mOutput Bool
forceOneLine Bool
useMicheline -> do
    (ContractInfo{Bool
Maybe (Parser st)
Maybe (Notes (ToT st))
Contract cp st vd
ciStorageNotes :: Maybe (Notes (ToT st))
ciStorageParser :: Maybe (Parser st)
ciIsDocumented :: Bool
ciContract :: Contract cp st vd
ciStorageNotes :: ()
ciStorageParser :: ()
ciIsDocumented :: ContractInfo -> Bool
ciContract :: ()
..}, Text
name) <- Maybe Text -> ContractRegistry -> IO (ContractInfo, Text)
getContract Maybe Text
mName ContractRegistry
registry
    let
      compiledContract :: Contract' Instr (ToT cp) (ToT st)
compiledContract = case Maybe (Notes (ToT st))
ciStorageNotes of
        Just Notes (ToT st)
notes -> (Contract cp st vd -> Contract' Instr (ToT cp) (ToT st)
forall cp st vd. Contract cp st vd -> Contract (ToT cp) (ToT st)
toMichelsonContract Contract cp st vd
ciContract) { cStoreNotes :: Notes (ToT st)
M.cStoreNotes = Notes (ToT st)
notes }
        Maybe (Notes (ToT st))
Nothing -> Contract cp st vd -> Contract' Instr (ToT cp) (ToT st)
forall cp st vd. Contract cp st vd -> Contract (ToT cp) (ToT st)
toMichelsonContract Contract cp st vd
ciContract
    FilePath -> Maybe FilePath -> LText -> IO ()
writeFunc (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
name FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".tz") Maybe FilePath
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' Instr (ToT cp) (ToT st) -> Expression
forall a. ToExpression a => a -> Expression
toExpression Contract' Instr (ToT cp) (ToT st)
compiledContract
      else Bool -> Contract' Instr (ToT cp) (ToT st) -> LText
forall (p :: T) (s :: T). Bool -> Contract p s -> LText
printTypedContract Bool
forceOneLine (Contract' Instr (ToT cp) (ToT st) -> LText)
-> Contract' Instr (ToT cp) (ToT st) -> LText
forall a b. (a -> b) -> a -> b
$ Contract' Instr (ToT cp) (ToT st)
compiledContract
  Document Maybe Text
mName Maybe FilePath
mOutput DGitRevision
gitRev -> do
    Maybe Text
-> ContractRegistry -> DGitRevision -> Maybe FilePath -> IO ()
printContractFromRegistryDoc Maybe Text
mName ContractRegistry
registry DGitRevision
gitRev Maybe FilePath
mOutput
  Analyze Maybe Text
mName -> do
    (ContractInfo{Bool
Maybe (Parser st)
Maybe (Notes (ToT st))
Contract cp st vd
ciStorageNotes :: Maybe (Notes (ToT st))
ciStorageParser :: Maybe (Parser st)
ciIsDocumented :: Bool
ciContract :: Contract cp st vd
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 vd -> Contract (ToT cp) (ToT st)
forall cp st vd. Contract cp st vd -> Contract (ToT cp) (ToT st)
toMichelsonContract Contract cp st vd
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
$ ContractCode' Instr (ToT cp) (ToT st)
-> Instr (ContractInp (ToT cp) (ToT st)) (ContractOut (ToT st))
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
ContractCode' instr cp st
-> instr (ContractInp cp st) (ContractOut st)
M.unContractCode (ContractCode' Instr (ToT cp) (ToT st)
 -> Instr (ContractInp (ToT cp) (ToT st)) (ContractOut (ToT st)))
-> ContractCode' Instr (ToT cp) (ToT st)
-> Instr (ContractInp (ToT cp) (ToT st)) (ContractOut (ToT st))
forall a b. (a -> b) -> a -> b
$ Contract (ToT cp) (ToT st) -> ContractCode' Instr (ToT cp) (ToT st)
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ContractCode' instr 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. NiceUntypedValue v => Bool -> v -> LText
printLorentzValue Bool
True st
storage
  where
    toExpressionHelper :: forall st'. NiceStorage st' => st' -> Expression
    toExpressionHelper :: forall st'. NiceStorage st' => 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

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