Import.hs

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

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

    -- * 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)
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

-- | 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

-- | 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

-- | 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