CleverWarning.hs

{-# LANGUAGE DataKinds, PolyKinds, StandaloneKindSignatures, TypeFamilies, UndecidableInstances #-}

    import GHC.TypeLits
    import Data.Kind

    -- This is the proposed API for Warning/WarningBin

    type Warning :: Symbol -> WarningBin -> ErrorMessage -> Constraint
    class Warning flag bin msg

    data WarningBin = Wdefault | W | Wall | Weverything


    -- The following can all be defined in library code outside base

    type CleverWarning :: k -> Constraint
    type CleverWarning key = Warning (FlagText key) (FlagBin key) (WarningMessage key)

    type WarningKey :: k -> Constraint
    class WarningKey key where
      type FlagText key :: Symbol

      type FlagBin key :: WarningBin
      type FlagBin key = Wdefault

      type WarningMessage key :: ErrorMessage


    instance WarningKey (s :: Symbol) where
      type FlagText       s = "warning"
      type FlagBin        s = Wdefault
      type WarningMessage s = Text s

    instance WarningKey (msg :: ErrorMessage) where
      type FlagText       msg = "warning"
      type FlagBin        msg = Wdefault
      type WarningMessage msg = msg


    type Warn :: Symbol -> Symbol -> Type
    data Warn flag msg

    instance WarningKey (Warn flag msg) where
      type FlagText       (Warn flag msg) = flag
      type FlagBin        (Warn flag msg) = Wdefault
      type WarningMessage (Warn flag msg) = Text msg


    -- User-defined datatypes can be used to identify warnings

    data DecodeWarning
    instance WarningKey DecodeWarning where
      type FlagText DecodeWarning = "decode"
      type FlagBin DecodeWarning = Wall
      type WarningMessage DecodeWarning = Text "Integer may require unbounded memory!"


    -- Examples of use sites

    foo :: CleverWarning "look" => ()
    foo = ()

    bar :: CleverWarning (Text "ook") => ()
    bar = ()

    baz :: CleverWarning (Warn "foo" "blah blah") => ()
    baz = ()

    wurble :: CleverWarning DecodeWarning => ()
    wurble = ()