Import.hs

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

-- TODO [#712]: Remove this next major release
{-# OPTIONS_GHC -Wno-deprecations #-}

module Morley.Michelson.Runtime.Import
  (
    -- * Read, parse, typecheck contract
    readContract
  , readSomeContract
  , readUntypedContract
  , importContract
  , importSomeContract
  , importUntypedContract
  , ContractReadError(..)
  , readUntypedContractExt
  , readContractExt
  , readSomeContractExt

    -- * Read, parse, typecheck value
  , readValue
  , importValue
  , importSomeValue
  , importUntypedValue
  , ValueReadError (..)

    -- * Generic helpers
  , MichelsonSource(..)
  , importUsing
  ) where

import Data.Default (def)
import Data.Text.IO.Utf8 qualified as Utf8 (readFile)
import Fmt (Buildable(build), pretty, unlessF, (+|), (|+))

import Morley.Michelson.Parser (parseExpandValue)
import Morley.Michelson.Parser.Error (ParserException(..))
import Morley.Michelson.Parser.Types (MichelsonSource(..))
import Morley.Michelson.Runtime (parseExpandContract, parseExpandContractExt)
import Morley.Michelson.TypeCheck
  (TCError, typeCheckContract, typeCheckTopLevelType, typeCheckingWith, typeVerifyContract,
  typeVerifyTopLevelType)
import Morley.Michelson.Typed (Contract, SingI, SomeContract(..), SomeValue, Value)
import Morley.Michelson.Untyped qualified as U

----------------------------------------------------------------------------
-- Reading, parsing, typechecking contract
----------------------------------------------------------------------------

-- | Purely read an untyped contract from Michelson textual representation.
--
-- 'MichelsonSource' is accepted solely as a hint for error messages.
readUntypedContract
  :: MichelsonSource
  -> Text
  -> Either ContractReadError U.Contract
readUntypedContract source txt = do
  first (CREParse source) $ parseExpandContract source txt

-- TODO [#712]: Remove this next major release
-- | Purely read an untyped contract from Michelson textual representation
-- with Morley extensions.
--
-- 'MichelsonSource' is accepted solely as a hint for error messages.
readUntypedContractExt
  :: MichelsonSource
  -> Text
  -> Either ContractReadError U.Contract
readUntypedContractExt source txt = do
  first (CREParse source) $ parseExpandContractExt source txt

{-# DEPRECATED readUntypedContractExt "Morley extensions are deprecated" #-}

-- | Purely read a typed contract from Michelson textual representation.
readSomeContract
  :: MichelsonSource
  -> Text
  -> Either ContractReadError SomeContract
readSomeContract source txt = do
  contract <- readUntypedContract source txt
  first (CRETypeCheck source) $
    typeCheckingWith def $ typeCheckContract contract

-- TODO [#712]: Remove this next major release
-- | Purely read a typed contract from Michelson textual representation
-- with Morley extensions.
readSomeContractExt
  :: MichelsonSource
  -> Text
  -> Either ContractReadError SomeContract
readSomeContractExt source txt = do
  contract <- readUntypedContractExt source txt
  first (CRETypeCheck source) $
    typeCheckingWith def $ typeCheckContract contract

{-# DEPRECATED readSomeContractExt "Morley extensions are deprecated" #-}

-- | Purely read a typed contract from Michelson textual representation,
-- failing if parameter or storage types mismatch with the expected ones.
readContract
  :: forall cp st .
     Each '[SingI] [cp, st]
  => MichelsonSource
  -> Text
  -> Either ContractReadError (Contract cp st)
readContract source txt = do
  contract <- readUntypedContract source txt
  first (CRETypeCheck source) $
    typeCheckingWith def $ typeVerifyContract contract

-- TODO [#712]: Remove this next major release
-- | Purely read a typed contract from Michelson textual representation
-- with Morley extensions,
-- failing if parameter or storage types mismatch with the expected ones.
readContractExt
  :: forall cp st .
     Each '[SingI] [cp, st]
  => MichelsonSource
  -> Text
  -> Either ContractReadError (Contract cp st)
readContractExt source txt = do
  contract <- readUntypedContractExt source txt
  first (CRETypeCheck source) $
    typeCheckingWith def $ typeVerifyContract contract

{-# DEPRECATED readContractExt "Morley extensions are deprecated" #-}

-- | Read a thing from a file, using the provided parsing function.
importUsing
  :: (Exception e)
  => (MichelsonSource -> Text -> Either e a)
  -> FilePath -> IO a
importUsing readFn file =
  either throwM pure . readFn (MSFile file) =<< Utf8.readFile file

-- | Import untyped contract from a given file path.
--
-- This function reads file, and parses a contract.
--
-- This function may throw t'Control.Exception.IOException' and 'ContractReadError'.
importUntypedContract :: FilePath -> IO U.Contract
importUntypedContract = importUsing readUntypedContract

-- | Import contract from a given file path.
--
-- This function reads file, parses and type checks a contract.
-- Within the typechecking we assume that no contracts are originated,
-- otherwise a type checking error will be caused.
--
-- This function may throw t'Control.Exception.IOException' and 'ContractReadError'.
importContract
  :: forall cp st .
     Each '[SingI] [cp, st]
  => FilePath -> IO (Contract cp st)
importContract = importUsing readContract

-- | Version of 'importContract' that doesn't require you to know
-- contract's parameter and storage types.
importSomeContract :: FilePath -> IO SomeContract
importSomeContract = importUsing readSomeContract

-- | Error type for 'importContract' function.
data ContractReadError
  = CREParse MichelsonSource ParserException
  | CRETypeCheck MichelsonSource TCError
  deriving stock (Show, Eq)

instance Buildable ContractReadError where
  build =
    \case
      CREParse source e -> mconcat
        [ unlessF (source == MSUnspecified) $
            "Error at " +| source |+ "\n"
        , "Failed to parse the contract: " +| e |+ "\n"
        ]
      CRETypeCheck source e -> mconcat
        [ unlessF (source == MSUnspecified) $
            "Error at " +| source |+ "\n"
        , "The contract is ill-typed: " +| e |+ "\n"
        ]

instance Exception ContractReadError where
  displayException = pretty

----------------------------------------------------------------------------
-- Reading, parsing, typechecking value
----------------------------------------------------------------------------

-- | Purely read an untyped Michelson value from textual representation.
--
-- 'FilePath' is accepted solely as a hint for error messages.
readUntypedValue
  :: MichelsonSource
  -> Text
  -> Either ValueReadError U.Value
readUntypedValue source txt = do
  first (VREParse source) $ parseExpandValue source txt

-- | Purely read a typed Michelson value from textual representation.
--
-- Expected type is provided explicitly.
readSomeValue
  :: U.Ty
  -> MichelsonSource
  -> Text
  -> Either ValueReadError SomeValue
readSomeValue ty source txt = do
  valueU <- readUntypedValue source txt
  first (VRETypeCheck source) $
    typeCheckingWith def $ typeCheckTopLevelType Nothing ty valueU

-- | Purely read a typed Michelson value from textual representation.
readValue
  :: forall t. SingI t
  => MichelsonSource
  -> Text
  -> Either ValueReadError (Value t)
readValue source txt = do
  valueU <- readUntypedValue source txt
  first (VRETypeCheck source) $
    typeCheckingWith def $ typeVerifyTopLevelType Nothing valueU

-- | Import an untyped value from a given file path.
importUntypedValue :: FilePath -> IO U.Value
importUntypedValue = importUsing readUntypedValue

-- | Import a typed value from a given file path.
--
-- Expected type is provided explicitly.
importSomeValue :: U.Ty -> FilePath -> IO SomeValue
importSomeValue = importUsing . readSomeValue

-- | Import a typed value from a given file path.
importValue
  :: forall t . SingI t
  => FilePath -> IO (Value t)
importValue = importUsing readValue

-- | Error type for 'importValue' function.
data ValueReadError
  = VREParse MichelsonSource ParserException
  | VRETypeCheck MichelsonSource TCError
  deriving stock (Show, Eq)

instance Buildable ValueReadError where
  build =
    \case
      VREParse source e -> mconcat
        [ unlessF (source == MSUnspecified) $
            "Error at " +| source |+ "\n"
        , "Failed to parse the value: " +| e |+ "\n"
        ]
      VRETypeCheck source e -> mconcat
        [ unlessF (source == MSUnspecified) $
            "Error at " +| source |+ "\n"
        , "Invalid value for required type: " +| e |+ "\n"
        ]

instance Exception ValueReadError where
  displayException = pretty