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

{-# OPTIONS_HADDOCK not-home #-}

-- | A more ergonomic way of matching on classified instructions.
module Morley.Michelson.Typed.ClassifiedInstr.Internal.WithClassifiedInstr
  ( module Morley.Michelson.Typed.ClassifiedInstr.Internal.WithClassifiedInstr
  ) where

import Data.Singletons (Sing, SingI(..))

import Morley.Michelson.Typed.ClassifiedInstr.Internal.MainImpl
import Morley.Michelson.Typed.ClassifiedInstr.Internal.Types
import Morley.Michelson.Typed.Instr (Instr)

class WithClassifiedInstr instr where
  type WCIConstraint instr (cls' :: InstrClass) :: Constraint
  {- | Perform a computation with a classified instruction.

  Intended to be used with @LambdaCase@, e.g.

  @
  isRealInstr :: T.Instr a b -> Bool
  isRealInstr = withClassifiedInstr \\case
    'SFromMichelson' -> True
    'SStructural' -> False
    'SAdditional' -> \\case
      'C_Nop' -> False
      'C_Ext'{} -> True
    'SPhantom' -> False
  @

  You can use 'withClassifiedInstr' again to obtain a different classification:

  @
  go = 'withClassifiedInstr' \\case
    'SFailingNormal' -> 'withClassifiedInstr' \\case
      'SNoChildren' -> _
  @

  If you need to reference the original instruction, consider using '&' for
  convenient pointful syntax:

  @
  go i = i & 'withClassifiedInstr' \\case
    'SFailingNormal' -> 'withClassifiedInstr' \\case
      'SNoChildren' -> doStuffWith i
  @
  -}
  withClassifiedInstr
    :: forall t inp out r. ClassifyInstr t
    => (forall cls. (SingI cls, WCIConstraint instr cls)
        => Sing (GetClassified cls :: t)
        -> ClassifiedInstr cls inp out
        -> r)
    -> instr inp out
    -> r

instance WithClassifiedInstr Instr where
  type WCIConstraint Instr _ = ()
  withClassifiedInstr f instr = case classifyInstr instr of
    WCI cinstr -> f (getInstrClass cinstr) cinstr

instance SingI cls => WithClassifiedInstr (ClassifiedInstr cls) where
  type WCIConstraint (ClassifiedInstr cls) cls' = cls ~ cls'
  withClassifiedInstr f cinstr = f (getInstrClass cinstr) cinstr