-- | This module exposes the labels that can be used to stamp
-- 'Cooked.Skeleton.TxSkel' with additional arbitrary pieces of information.
module Cooked.Skeleton.Label
  ( LabelConstrs,
    TxLabel (..),
  )
where

import Cooked.Pretty.Class
import Type.Reflection

-- | These are type constraints that must be satisfied by labels
type LabelConstrs x = (PrettyCooked x, Show x, Typeable x, Eq x, Ord x)

-- | Labels are arbitrary information that can be added to skeleton. They are
-- meant to be pretty-printed. The common use case we currently have is to tag
-- skeletons that have been modified by tweaks and automated attacks.
data TxLabel where
  TxLabel :: (LabelConstrs x) => x -> TxLabel

instance Eq TxLabel where
  TxLabel
a == :: TxLabel -> TxLabel -> Bool
== TxLabel
x = TxLabel -> TxLabel -> Ordering
forall a. Ord a => a -> a -> Ordering
compare TxLabel
a TxLabel
x Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Show TxLabel where
  show :: TxLabel -> String
show (TxLabel x
x) = x -> String
forall a. Show a => a -> String
show x
x

instance PrettyCooked TxLabel where
  prettyCookedOpt :: PrettyCookedOpts -> TxLabel -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts (TxLabel x
x) = PrettyCookedOpts -> x -> DocCooked
forall a. PrettyCooked a => PrettyCookedOpts -> a -> DocCooked
prettyCookedOpt PrettyCookedOpts
opts x
x

instance Ord TxLabel where
  compare :: TxLabel -> TxLabel -> Ordering
compare (TxLabel x
a) (TxLabel x
x) =
    case SomeTypeRep -> SomeTypeRep -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TypeRep x -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (x -> TypeRep x
forall a. Typeable a => a -> TypeRep a
typeOf x
a)) (TypeRep x -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
SomeTypeRep (x -> TypeRep x
forall a. Typeable a => a -> TypeRep a
typeOf x
x)) of
      Ordering
LT -> Ordering
LT
      Ordering
GT -> Ordering
GT
      Ordering
EQ -> case x -> TypeRep x
forall a. Typeable a => a -> TypeRep a
typeOf x
a TypeRep x -> TypeRep x -> Maybe (x :~~: x)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` x -> TypeRep x
forall a. Typeable a => a -> TypeRep a
typeOf x
x of
        Just x :~~: x
HRefl -> x -> x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare x
a x
x
x
        -- This can never happen, since 'eqTypeRep' is implemented in terms of
        -- '==' on the type representation:
        Maybe (x :~~: x)
Nothing -> String -> Ordering
forall a. HasCallStack => String -> a
error String
"Type representations compare as EQ, but are not eqTypeRep"