Skip to content

Commit

Permalink
Simplification: Make Typeable superclass of IsLanguage
Browse files Browse the repository at this point in the history
  • Loading branch information
lehins committed Mar 27, 2023
1 parent 9e8d453 commit 004a3cd
Show file tree
Hide file tree
Showing 2 changed files with 9 additions and 25 deletions.
18 changes: 5 additions & 13 deletions eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxInfo.hs
Expand Up @@ -601,15 +601,11 @@ data PlutusDebugLang (l :: Language) where
instance Show (PlutusDebugLang l) where
show _ = "PlutusDebug Omitted"

deriving instance forall (l :: Language). (Eq (SLanguage l)) => Eq (PlutusDebugLang l)
deriving instance Eq (SLanguage l) => Eq (PlutusDebugLang l)

deriving instance Generic (PlutusDebugLang l)

instance
forall (l :: Language).
(Typeable l, IsLanguage l, EncCBOR (SLanguage l)) =>
EncCBOR (PlutusDebugLang l)
where
instance (IsLanguage l, EncCBOR (SLanguage l)) => EncCBOR (PlutusDebugLang l) where
encCBOR (PlutusDebugLang slang costModel exUnits sbs pData protVer) =
encode $
Sum (PlutusDebugLang slang) (fromIntegral (fromEnum (fromSLanguage slang)))
Expand All @@ -619,11 +615,7 @@ instance
!> To pData
!> To protVer

instance
forall (l :: Language).
(Typeable l, IsLanguage l) =>
DecCBOR (PlutusDebugLang l)
where
instance IsLanguage l => DecCBOR (PlutusDebugLang l) where
decCBOR = decodeRecordSum "PlutusDebugLang" $ \tag -> do
let slang = isLanguage @l
lang = fromSLanguage slang
Expand All @@ -636,7 +628,7 @@ instance
pure (6, PlutusDebugLang slang costModel exUnits sbs pData protVer)

data PlutusDebug where
PlutusDebug :: (IsLanguage l, Typeable l) => PlutusDebugLang l -> PlutusDebug
PlutusDebug :: IsLanguage l => PlutusDebugLang l -> PlutusDebug

deriving instance Show PlutusDebug

Expand Down Expand Up @@ -664,7 +656,7 @@ debugPlutus version db =
Left e -> DebugBadHex (show e)
Right bs ->
let plutusDebugLangDecoder ::
forall l. (Typeable l, IsLanguage l) => Proxy l -> Fail String PlutusDebug
forall l. IsLanguage l => Proxy l -> Fail String PlutusDebug
plutusDebugLangDecoder _ =
FailT $
pure $
Expand Down
16 changes: 4 additions & 12 deletions libs/cardano-ledger-core/src/Cardano/Ledger/Language.hs
Expand Up @@ -104,18 +104,10 @@ deriving instance Eq (SLanguage l)

deriving instance Show (SLanguage l)

instance
forall (l :: Language).
(Typeable l, IsLanguage l) =>
EncCBOR (SLanguage l)
where
instance IsLanguage l => EncCBOR (SLanguage l) where
encCBOR = encCBOR . fromSLanguage

instance
forall (l :: Language).
(Typeable l, IsLanguage l) =>
DecCBOR (SLanguage l)
where
instance IsLanguage l => DecCBOR (SLanguage l) where
decCBOR = toSLanguage =<< decCBOR @Language

-- | Reflection for '@SLanguage@'
Expand All @@ -126,7 +118,7 @@ fromSLanguage = \case

-- | For implicit reflection on '@SLanguage@'
-- See "Cardano.Ledger.Alonzo.TxInfo" for example usage
class IsLanguage l where
class Typeable l => IsLanguage (l :: Language) where
isLanguage :: SLanguage l

instance IsLanguage 'PlutusV1 where
Expand All @@ -135,7 +127,7 @@ instance IsLanguage 'PlutusV1 where
instance IsLanguage 'PlutusV2 where
isLanguage = SPlutusV2

toSLanguage :: forall (l :: Language) m. (IsLanguage l, MonadFail m) => Language -> m (SLanguage l)
toSLanguage :: forall l m. (IsLanguage l, MonadFail m) => Language -> m (SLanguage l)
toSLanguage lang
| fromSLanguage thisLanguage == lang = pure thisLanguage
| otherwise =
Expand Down

0 comments on commit 004a3cd

Please sign in to comment.