module Lorentz.Run
  ( compileLorentz
  , compileLorentzContract
  , interpretLorentzInstr
  , interpretLorentzLambda
  , analyzeLorentz
  ) where

import Data.Constraint ((\\))
import Data.Vinyl.Core (Rec(..))

import Lorentz.Base
import Lorentz.Constraints
import Lorentz.EntryPoints
import Michelson.Analyzer (AnalyzerRes, analyze)
import Michelson.Interpret
import Michelson.Typed
  (FullContract(..), Instr(..), IsoValue, IsoValuesStack(..), ToT, ToTs, isStar, starNotes,
  unParamNotes)

-- | For use outside of Lorentz.
compileLorentz :: (inp :-> out) -> Instr (ToTs inp) (ToTs out)
compileLorentz = iAnyCode

-- | Version of 'compileLorentz' specialized to instruction corresponding to
-- contract code.
compileLorentzContract
  :: forall cp st.
     (NiceParameterFull cp, NiceStorage st)
  => Contract cp st -> FullContract (ToT cp) (ToT st)
compileLorentzContract contract =
  FullContract
  { fcCode = if isStar (unParamNotes cpNotes)
      then  -- We have no annotations. Print contract as such.
        compileLorentz contract
      else  -- If we have some annotations, erase them.
        compileLorentz (I CAST # contract :: Contract cp st)
  , fcParamNotesSafe = cpNotes
  , fcStoreNotes = starNotes
  } \\ niceParameterEvi @cp
    \\ niceStorageEvi @st
  where
    cpNotes = parameterEntryPointsToNotes @cp

-- | Interpret a Lorentz instruction, for test purposes.
interpretLorentzInstr
  :: (IsoValuesStack inp, IsoValuesStack out)
  => ContractEnv
  -> inp :-> out
  -> Rec Identity inp
  -> Either MichelsonFailed (Rec Identity out)
interpretLorentzInstr env (compileLorentz -> instr) inp =
  fromValStack <$> interpretInstr env instr (toValStack inp)

-- | Like 'interpretLorentzInstr', but works on lambda rather than
-- arbitrary instruction.
interpretLorentzLambda
  :: (IsoValue inp, IsoValue out)
  => ContractEnv
  -> Lambda inp out
  -> inp
  -> Either MichelsonFailed out
interpretLorentzLambda env instr inp = do
  res <- interpretLorentzInstr env instr (Identity inp :& RNil)
  let Identity out :& RNil = res
  return out

-- | Lorentz version of analyzer.
analyzeLorentz :: inp :-> out -> AnalyzerRes
analyzeLorentz = analyze . compileLorentz