Import.hs

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

-- | Functions to import contracts to be used in tests.
module Test.Cleveland.Lorentz.Import
  ( -- * Read, parse, typecheck contracts
    importContract
  , embedContract
  , embedContractM
  , M.ContractReadError (..)

    -- * Read, parse, typecheck values
  , importValue
  , embedValue
  , embedValueM
  , M.ValueReadError (..)

    -- * Notes
    -- $embedDepends
  ) where

import Fmt (build, pretty)
import Language.Haskell.TH qualified as TH

import Lorentz qualified as L
import Lorentz.Base
import Lorentz.Constraints
import Lorentz.ViewBase
import Morley.Michelson.Parser.Types (MichelsonSource(..))
import Morley.Michelson.Typed qualified as T
import Morley.Util.Markdown
import Test.Cleveland.Michelson.Import qualified as M

mkImportedContract
  :: forall cp st vd.
     (NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd, DemoteViewsDescriptor vd)
  => FilePath
  -> T.Contract (T.ToT cp) (T.ToT st)
  -> Either L.ViewInterfaceMatchError (Contract cp st vd)
mkImportedContract path cMichelsonContract = verifyingViews Contract
  { cDocumentedCode = L.ContractCode $
      L.fakeCoercing $
        L.docGroup "Imported contract" $
          L.doc $ L.DDescription $ "Read from " <> mdTicked (build path)
  , ..
  }
  where
    verifyingViews r =
      L.checkViewsCoverInterface (L.demoteViewsDescriptor @vd) (T.cViews cMichelsonContract)
      $> r

-- | Import contract from a given 'FilePath'.
--
-- In this and similar functions, parameter and storage types must exactly match
-- the ones in the contract, while for views this is not necessary. Only
-- make sure that all views beyond @vd@ type are present in the contract; @()@
-- always works as views descriptor of the contract.
importContract
  :: forall cp st vd.
     (NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd, DemoteViewsDescriptor vd)
  => FilePath -> IO (Contract cp st vd)
importContract file =
  either throwM pure . mkImportedContract file =<< M.importContract file

{- | Import a contract at compile time assuming its expected type is known.

Use it like:

> myContract :: Contract Parameter Storage
> myContract = $$(embedContract "my_contract.tz")

or

> let myContract = $$(embedContract @Parameter @Storage "my_contract.tz")

See also the note in "Test.Cleveland.Lorentz.Import#embedDepends"
-}
embedContract
  :: forall cp st vd.
    (NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd, DemoteViewsDescriptor vd)
  => FilePath -> TH.Code TH.Q (Contract cp st vd)
embedContract path = embedContractM (pure path)

-- | Version of 'embedContract' that accepts a filepath constructor in IO.
--
-- Useful when the path should depend on environmental variables or other
-- user input.
--
-- See also the note in "Test.Cleveland.Lorentz.Import#embedDepends"
embedContractM
  :: forall cp st vd.
    (NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd, DemoteViewsDescriptor vd)
  => IO FilePath -> TH.Code TH.Q (Contract cp st vd)
embedContractM pathM = TH.Code do
  path <- TH.runIO pathM
  contract <- M.embedTextFile path
  case M.readContract @(T.ToT cp) @(T.ToT st) (MSFile path) contract of
    Left e ->
      -- Emit a compiler error if the contract cannot be read.
      fail (pretty e)
    Right tContract -> case mkImportedContract @cp @st @vd path tContract of
      Left e ->
        -- Emit a compiler error if there are issues with constructing contract
        fail (pretty e)
      -- Emit a haskell expression that reads the contract.
      Right _ -> TH.examineCode
        [||
          -- Note: it's ok to use `unsafe` here, because we just proved that the contract
          -- can be parsed+typechecked.
          contract
            & M.readContract (MSFile path)
            & unsafe
            & mkImportedContract path
            & unsafe
        ||]

-- | Import a value from a given 'FilePath'
importValue :: forall a . T.IsoValue a => FilePath -> IO a
importValue = fmap T.fromVal . M.importValue

{- | Import a value from a given 'FilePath' at compile time
and embed it as a value using Template Haskell, f. ex.

> let someAddress = $$(embedValue @Address "/path/to/addressFile.tz")

See also the note in "Test.Cleveland.Lorentz.Import#embedDepends"
-}
embedValue :: forall a . T.IsoValue a => FilePath -> TH.Code TH.Q a
embedValue = embedValueM . pure

-- | A variant of 'embedValue' that accepts 'FilePath' in 'IO'.
--
-- Can be useful when 'FilePath' depends on the environment.
--
-- See also the note in "Test.Cleveland.Lorentz.Import#embedDepends"
embedValueM :: forall a . T.IsoValue a => IO FilePath -> TH.Code TH.Q a
embedValueM pathM = TH.Code do
  path <- TH.runIO pathM
  rawValue <- M.embedTextFile path
  case M.readValue @(T.ToT a) (MSFile path) rawValue of
    Left e -> fail (pretty e)
    Right _ -> TH.examineCode
          [||
            -- Note: it's ok to use `error` here, because we just proved that the value
            -- can be parsed+typechecked.
            either (error . pretty) T.fromVal $
              M.readValue (MSFile path) rawValue
          ||]

{- $embedDepends

= On 'FilePath' argument with 'embedContract', 'embedValue' and variants #embedDepends#

The 'FilePath' argument is specified relative to the project root (if
using cabal-install or stack, the directory containing the Cabal file and/or @package.yaml@).

As an additional caveat, any files embedded this way are essentially compile-time dependencies. However,
build systems can't track these automatically. In general, it's advisable to add the files used
with 'embedContract', 'embedValue' and variants to the @extra-source-files@ section of the Cabal
file or @package.yaml@, if possible.
-}