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

-- | Functions to import contracts to be used in tests.

module Test.Cleveland.Michelson.Import
  (
    -- * Read, parse, typecheck
    readContract
  , readUntypedContract
  , readSomeContract
  , importContract
  , importUntypedContract
  , importSomeContract
  , embedContract
  , embedContractM
  , ContractReadError (..)

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

    -- * Tasty helpers
  , testTreesWithContract
  , testTreesWithTypedContract
  , testTreesWithUntypedContract
  , concatTestTrees

    -- * Helpers
  , embedTextFile
  ) where

import Control.Exception (IOException)
import Data.FileEmbed (makeRelativeToProject)
import Data.Text.IO.Utf8 qualified as Utf8 (readFile)
import Fmt (pretty)
import Language.Haskell.TH qualified as TH
import Language.Haskell.TH.Syntax (qAddDependentFile)
import Test.HUnit (assertFailure)
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase)

import Morley.Michelson.Runtime.Import
import Morley.Michelson.Typed (Contract, SingI)
import Morley.Michelson.Untyped qualified as U

----------------------------------------------------------------------------
-- tasty helpers
----------------------------------------------------------------------------

-- | Import contract and use to create test trees. Both versions of contract are
-- passed to the callback function (untyped and typed).
--
-- If contract's import fails, a tree with single failing test will be generated
-- (so test tree will likely be generated unexceptionally, but a failing
-- result will notify about problem).
testTreesWithContract
  :: (Each '[SingI] [cp, st], HasCallStack)
  => FilePath -> (Contract cp st -> IO [TestTree]) -> IO [TestTree]
testTreesWithContract = testTreesWithContractImpl importContract

-- | Like 'testTreesWithContract' but supplies only untyped contract.
testTreesWithUntypedContract
  :: HasCallStack
  => FilePath -> (U.Contract -> IO [TestTree]) -> IO [TestTree]
testTreesWithUntypedContract =
  testTreesWithContractImpl importUntypedContract

-- | Like 'testTreesWithContract' but supplies only typed contract.
testTreesWithTypedContract
  :: (Each '[SingI] [cp, st], HasCallStack)
  => FilePath -> (Contract cp st -> IO [TestTree]) -> IO [TestTree]
testTreesWithTypedContract =
  testTreesWithContractImpl importContract

testTreesWithContractImpl
  :: HasCallStack
  => (FilePath -> IO contract)
  -> FilePath
  -> (contract -> IO [TestTree])
  -> IO [TestTree]
testTreesWithContractImpl doImport file testImpl =
  saferImport doImport file >>= \case
    Left err -> pure [testCase ("Import contract " <> file) $ assertFailure err]
    Right contract -> testImpl contract

-- A helper function which allows you to use multiple
-- 'testTreesWithTypedContract' in a single top-level test with type
-- 'IO [TestTree]'.
concatTestTrees :: [IO [TestTree]] -> IO [TestTree]
concatTestTrees = fmap concat . sequence

----------------------------------------------------------------------------
-- Helpers
----------------------------------------------------------------------------

-- Catch some errors during contract import, we don't want the whole
-- test suite to crash if something like that happens.
saferImport :: (FilePath -> IO contract) -> FilePath -> IO (Either String contract)
saferImport doImport file =
  ((Right <$> doImport file)
  `catch` \(e :: ContractReadError) -> pure $ Left $ displayException e)
  `catch` \(e :: IOException) -> pure $ Left $ displayException e

----------------------------------------------------------------------------
-- Embedding contract
----------------------------------------------------------------------------

-- | Read a file with textual content at compile time.
--
-- Unlike @embedFile@ from the library, returns typed content.
embedTextFile :: FilePath -> TH.Q Text
embedTextFile rawPath = do
  path <- makeRelativeToProject rawPath
  qAddDependentFile rawPath
  Utf8.readFile path

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

Use it like:

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

or

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

-}
embedContract
  :: forall cp st. (SingI cp, SingI st)
  => FilePath -> TH.Code TH.Q (Contract cp st)
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.
embedContractM
  :: forall cp st. (SingI cp, SingI st)
  => IO FilePath -> TH.Code TH.Q (Contract cp st)
embedContractM pathM = TH.Code do
  path <- TH.runIO pathM
  contract <- embedTextFile path
  case readContract @cp @st (MSFile path) contract of
    Left e ->
      -- Emit a compiler error if the contract cannot be read.
      fail (pretty e)
    Right _ -> TH.examineCode
      -- Emit a haskell expression that reads the contract.
      [||
        -- Note: it's ok to use `unsafe` here, because we just proved that the contrPact
        -- can be parsed+typechecked.
        unsafe $
          readContract (MSFile path) contract
      ||]