{-# OPTIONS_HADDOCK not-home #-}
module Morley.Michelson.Typed.ClassifiedInstr.Internal.InstrEnum
( module Morley.Michelson.Typed.ClassifiedInstr.Internal.InstrEnum
) where
import Prelude hiding (Type)
import Language.Haskell.TH
import Morley.Michelson.Typed.Instr (Instr)
{-# ANN module ("HLint: ignore Language.Haskell.TH should be imported post-qualified or with an explicit import list" :: Text) #-}
do
TyConI (DataD _ _ _ _ cons _) <- reify ''Instr
[DataD cxt' name tvb mk _ ders] <-
[d|data InstrEnum deriving stock (Eq, Ord, Enum, Bounded, Show)|]
let substOne :: Con -> Q Con
substOne = \case
GadtC [nm] _ _ -> normalC (mkName $ nameBase nm) []
ForallC _ _ con -> substOne con
c -> error $ "unsupported " <> show (ppr c)
cons'' <- mapM substOne cons
pure [DataD cxt' name tvb mk cons'' ders]
fromName :: Name -> InstrEnum
fromName :: Name -> InstrEnum
fromName (Name -> String
nameBase -> String
inputName) = $(do
TyConI (DataD _ _ _ _ cons _) <- reify ''Instr
let substOne :: Con -> Q Match
substOne = \case
GadtC [nm] _ _ ->
match
(litP $ StringL $ nameBase nm)
(normalB $ conE (mkName $ nameBase nm)) []
ForallC _ _ con -> substOne con
c -> error $ "unsupported " <> show (ppr c)
caseE [|inputName|] $ map substOne cons
)