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

{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Printing lorentz contracts.
module Lorentz.Print
  ( printLorentzValue
  , printLorentzContract
  ) where

import Lorentz.Constraints
import Lorentz.Run
import Morley.Michelson.Printer (printTypedContract, printTypedValue)
import Morley.Michelson.Typed (toVal)

-- | Pretty-print a Haskell value as Michelson one.
printLorentzValue
  :: forall v.
    (NiceUntypedValue v)
  => Bool -> v -> LText
printLorentzValue :: forall v. NiceUntypedValue v => Bool -> v -> LText
printLorentzValue Bool
forceSingleLine =
  (NiceUntypedValue v :- (SingI (ToT v), HasNoOp (ToT v)))
-> ((SingI (ToT v), HasNoOp (ToT v)) => v -> LText) -> v -> LText
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (forall a. NiceUntypedValue a :- UntypedValScope (ToT a)
niceUntypedValueEvi @v) (((SingI (ToT v), HasNoOp (ToT v)) => v -> LText) -> v -> LText)
-> ((SingI (ToT v), HasNoOp (ToT v)) => v -> LText) -> v -> LText
forall a b. (a -> b) -> a -> b
$
    Bool -> Value (ToT v) -> LText
forall (t :: T).
ProperUntypedValBetterErrors t =>
Bool -> Value t -> LText
printTypedValue Bool
forceSingleLine (Value (ToT v) -> LText) -> (v -> Value (ToT v)) -> v -> LText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Value (ToT v)
forall a. IsoValue a => a -> Value (ToT a)
toVal

-- | Pretty-print a Lorentz contract into Michelson code.
printLorentzContract
  :: Bool -> Contract cp st vd -> LText
printLorentzContract :: forall cp st vd. Bool -> Contract cp st vd -> LText
printLorentzContract Bool
forceSingleLine =
  Bool -> Contract (ToT cp) (ToT st) -> LText
forall (p :: T) (s :: T). Bool -> Contract p s -> LText
printTypedContract Bool
forceSingleLine (Contract (ToT cp) (ToT st) -> LText)
-> (Contract cp st vd -> Contract (ToT cp) (ToT st))
-> Contract cp st vd
-> LText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract cp st vd -> Contract (ToT cp) (ToT st)
forall cp st vd. Contract cp st vd -> Contract (ToT cp) (ToT st)
toMichelsonContract