Golden.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | This module contains tasty ingredient used for regenerating
-- Indigo golden test.

-- To regenerate the Michelson contracts for golden tests
-- (without running the tests) execute:
-- @stack test indigo --ta --regenerate@
module Test.Util.Golden
  ( regenerateTests
  ) where

import Indigo hiding (Option)
import Test.Tasty.Ingredients
import Test.Tasty.Options

import Test.Decomposition
import Test.Examples
import Test.Lambda
import Test.Util
import Test.DebugComments

newtype RegenGoldenTests = RegenGoldenTests Bool
  deriving newtype (Eq, Ord)

instance IsOption RegenGoldenTests where
  defaultValue = RegenGoldenTests False
  parseValue = fmap RegenGoldenTests . safeReadBool
  optionName = return "regenerate"
  optionHelp = return "Regenerate indigo golden tests."
  optionCLParser = flagCLParser (Just 'r') $ RegenGoldenTests True

-- | The ingredient that provides the golden tests regeneration functionality.
regenerateTests :: Ingredient
regenerateTests = TestManager [Option (Proxy :: Proxy RegenGoldenTests)] $
  \opts _ ->
    case lookupOption opts of
      RegenGoldenTests False -> Nothing
      RegenGoldenTests True -> Just runRegenerate

-- | Regenerate Indigo golden tests.
-- If you add a new golden test, include its code and path in this
-- function to be able to regenerate it.
runRegenerate :: IO Bool
runRegenerate = do
  -- Decomposition
  saveToFile setDecomposedVariable pathSetDecomposedVariable
  saveToFile setMaterializedVariable pathSetMaterializedVariable
  saveToFile setDecomposedField pathSetDecomposedField

  -- Example
  saveToFile contractWhileLorentz pathWhile
  saveToFile contractWhileLeftLorentz pathWhileLeft
  saveToFile contractForEachLorentz pathForEach
  saveToFile contractVarLorentz pathVar
  saveToFile contractIfLorentz pathIf
  saveToFile contractIfValueLorentz pathIfValue
  saveToFile contractIfRightLorentz pathIfRight
  saveToFile contractIfConsLorentz pathIfCons
  saveToFile contractCaseLorentz pathCase
  saveToFile contractOpsLorentz pathOps
  saveToFile contractAssertLorentz pathAssert
  saveToFile contractUserCommentLorentz pathComment

  -- Lambda
  saveToFile sumLambdaCalledOnce pathSumLambdaCalledOnce
  saveToFile sumLambdaCalledTwice pathSumLambdaCalledTwice
  saveToFile lambdasSideEffects pathLambdasSideEffects
  saveToFile lambdaInLambda1 pathLambdaInLambda1
  saveToFile lambdaInLambda2 pathLambdaInLambda2

  -- Debug Comments
  saveToFile (whileLeftComments LogTopLevelFrontendStatements) pathFrontendComments
  saveToFile (whileLeftComments LogBackendStatements) pathBackendComments
  saveToFile (whileLeftComments LogAuxCode) pathAuxComments
  saveToFile (whileLeftComments LogExpressionsComputations) pathExprComments
  saveToFile whileLeftCommentsFullStack pathDebugCommentsFullStack

  putTextLn "Regenerate completed."
  return True

saveToFile
  :: forall cp m st.
     (NiceParameterFull cp, NiceStorage st, MonadIO m, MonadMask m)
  => ContractCode cp st -> FilePath
  -> m ()
saveToFile ctr filePath = withFile filePath WriteMode $
  flip hPutStr (printLorentzContract False $ noOptimizationContract ctr)