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

-- | Module containing pretty-printing of Indigo contracts

module Indigo.Print
  ( printIndigoContract
  , renderIndigoDoc

  , printAsMichelson
  , saveAsMichelson
  , printDocumentation
  , saveDocumentation
  ) where

import Data.Text.Lazy.IO.Utf8 (writeFile)

import Indigo.Compilation
import Indigo.Internal.Object
import Indigo.Lorentz
import Indigo.Prelude

-- | Pretty-print an Indigo contract into Michelson code.
printIndigoContract
  :: forall param st .
     ( IsObject st
     , NiceParameterFull param
     , NiceStorage st
     )
  => Bool -- ^ Force result to be single line
  -> IndigoContract param st
  -> LText
printIndigoContract :: Bool -> IndigoContract param st -> LText
printIndigoContract forceSingleLine :: Bool
forceSingleLine ctr :: IndigoContract param st
ctr = Bool -> Contract param st -> LText
forall cp st.
(NiceParameterFull cp, NiceStorage st) =>
Bool -> Contract cp st -> LText
printLorentzContract Bool
forceSingleLine (Contract param st -> LText) -> Contract param st -> LText
forall a b. (a -> b) -> a -> b
$
  ContractCode param st -> Contract param st
forall cp st. ContractCode cp st -> Contract cp st
defaultContract (ContractCode param st -> Contract param st)
-> ContractCode param st -> Contract param st
forall a b. (a -> b) -> a -> b
$
  IndigoContract param st -> ContractCode param st
forall param st.
(KnownValue param, IsObject st) =>
IndigoContract param st -> ContractCode param st
compileIndigoContract @param @st IndigoContract param st
ctr

-- | Generate an Indigo contract documentation.
renderIndigoDoc
  :: forall param st .
     ( IsObject st
     , NiceParameterFull param
     )
  => IndigoContract param st
  -> LText
renderIndigoDoc :: IndigoContract param st -> LText
renderIndigoDoc ctr :: IndigoContract param st
ctr =
  DGitRevision -> ('[(param, st)] :-> ContractOut st) -> LText
forall (inp :: [*]) (out :: [*]).
DGitRevision -> (inp :-> out) -> LText
renderLorentzDocWithGitRev DGitRevision
DGitRevisionUnknown (('[(param, st)] :-> ContractOut st) -> LText)
-> ('[(param, st)] :-> ContractOut st) -> LText
forall a b. (a -> b) -> a -> b
$ IndigoContract param st -> '[(param, st)] :-> ContractOut st
forall param st.
(KnownValue param, IsObject st) =>
IndigoContract param st -> ContractCode param st
compileIndigoContract @param @st IndigoContract param st
ctr

-- | Prints the pretty-printed Michelson code of an Indigo contract to
-- the standard output.
--
-- This is intended to be easy to use for newcomers.
printAsMichelson
  :: forall param st m . ( IsObject st
     , NiceParameterFull param, NiceStorage st
     , MonadIO m
     )
  => IndigoContract param st
  -> m ()
printAsMichelson :: IndigoContract param st -> m ()
printAsMichelson cntr :: IndigoContract param st
cntr = LText -> m ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (Bool -> IndigoContract param st -> LText
forall param st.
(IsObject st, NiceParameterFull param, NiceStorage st) =>
Bool -> IndigoContract param st -> LText
printIndigoContract @param @st Bool
False IndigoContract param st
cntr)

-- | Saves the pretty-printed Michelson code of an Indigo contract to
-- the given file.
--
-- This is intended to be easy to use for newcomers.
saveAsMichelson
  :: forall param st m . ( IsObject st
     , NiceParameterFull param, NiceStorage st
     , MonadIO m, MonadMask m
     )
  => IndigoContract param st
  -> FilePath
  -> m ()
saveAsMichelson :: IndigoContract param st -> FilePath -> m ()
saveAsMichelson cntr :: IndigoContract param st
cntr filePath :: FilePath
filePath =
  FilePath -> LText -> m ()
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
FilePath -> LText -> m ()
writeFile FilePath
filePath (Bool -> IndigoContract param st -> LText
forall param st.
(IsObject st, NiceParameterFull param, NiceStorage st) =>
Bool -> IndigoContract param st -> LText
printIndigoContract @param @st Bool
False IndigoContract param st
cntr)

-- | Print the generated documentation to the standard output.
printDocumentation
  :: forall param st m . ( IsObject st
     , NiceParameterFull param
     , MonadIO m
     )
  => IndigoContract param st
  -> m ()
printDocumentation :: IndigoContract param st -> m ()
printDocumentation ctr :: IndigoContract param st
ctr =
  LText -> m ()
forall a (m :: * -> *). (Print a, MonadIO m) => a -> m ()
putStrLn (LText -> m ()) -> LText -> m ()
forall a b. (a -> b) -> a -> b
$ IndigoContract param st -> LText
forall param st.
(IsObject st, NiceParameterFull param) =>
IndigoContract param st -> LText
renderIndigoDoc @param @st IndigoContract param st
ctr

-- | Save the generated documentation to the given file.
saveDocumentation
  :: forall param st m . ( IsObject st
     , NiceParameterFull param
     , MonadIO m, MonadMask m
     )
  => IndigoContract param st
  -> FilePath
  -> m ()
saveDocumentation :: IndigoContract param st -> FilePath -> m ()
saveDocumentation ctr :: IndigoContract param st
ctr filePath :: FilePath
filePath = do
  FilePath -> LText -> m ()
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
FilePath -> LText -> m ()
writeFile FilePath
filePath (IndigoContract param st -> LText
forall param st.
(IsObject st, NiceParameterFull param) =>
IndigoContract param st -> LText
renderIndigoDoc @param @st IndigoContract param st
ctr)