Commit 7cd68066 authored by Austin Seipp's avatar Austin Seipp

Add -fwarn-unticked-promoted-constructors to -Wall

Signed-off-by: default avatarAustin Seipp <austin@well-typed.com>
parent 3ebe304f
......@@ -3332,7 +3332,8 @@ minusWallOpts
Opt_WarnHiShadows,
Opt_WarnOrphans,
Opt_WarnUnusedDoBind,
Opt_WarnTrustworthySafe
Opt_WarnTrustworthySafe,
Opt_WarnUntickedPromotedConstructors
]
enableGlasgowExts :: DynP ()
......
......@@ -1084,7 +1084,8 @@ test.hs:(5,4)-(6,7):
<option>-fwarn-warn-hi-shadowing</option>,
<option>-fwarn-orphans</option>,
<option>-fwarn-unused-do-bind</option>, and
<option>-fwarn-trustworthy-safe</option>.</para>
<option>-fwarn-trustworthy-safe</option>,
<option>-fwarn-unticked-promoted-constructors</option>.</para>
</listitem>
</varlistentry>
......
......@@ -281,9 +281,9 @@ isRight (Right _) = True
-- instance for the == Boolean type-level equality operator
type family EqEither a b where
EqEither (Left x) (Left y) = x == y
EqEither (Right x) (Right y) = x == y
EqEither a b = False
EqEither ('Left x) ('Left y) = x == y
EqEither ('Right x) ('Right y) = x == y
EqEither a b = 'False
type instance a == b = EqEither a b
{-
......
......@@ -28,30 +28,28 @@ import Data.Bool
-- | Type-level "If". @If True a b@ ==> @a@; @If False a b@ ==> @b@
type family If cond tru fls where
If True tru fls = tru
If False tru fls = fls
If 'True tru fls = tru
If 'False tru fls = fls
-- | Type-level "and"
type family a && b where
False && a = False
True && a = a
a && False = False
a && True = a
a && a = a
'False && a = 'False
'True && a = a
a && 'False = 'False
a && 'True = a
a && a = a
infixr 3 &&
-- | Type-level "or"
type family a || b where
False || a = a
True || a = True
a || False = a
a || True = True
a || a = a
'False || a = a
'True || a = 'True
a || 'False = a
a || 'True = 'True
a || a = a
infixr 2 ||
-- | Type-level "not"
type family Not a where
Not False = True
Not True = False
Not 'False = 'True
Not 'True = 'False
......@@ -184,37 +184,37 @@ families.
-- all of the following closed type families are local to this module
type family EqStar (a :: *) (b :: *) where
EqStar a a = True
EqStar a b = False
EqStar a a = 'True
EqStar a b = 'False
-- This looks dangerous, but it isn't. This allows == to be defined
-- over arbitrary type constructors.
type family EqArrow (a :: k1 -> k2) (b :: k1 -> k2) where
EqArrow a a = True
EqArrow a b = False
EqArrow a a = 'True
EqArrow a b = 'False
type family EqBool a b where
EqBool True True = True
EqBool False False = True
EqBool a b = False
EqBool 'True 'True = 'True
EqBool 'False 'False = 'True
EqBool a b = 'False
type family EqOrdering a b where
EqOrdering LT LT = True
EqOrdering EQ EQ = True
EqOrdering GT GT = True
EqOrdering a b = False
EqOrdering 'LT 'LT = 'True
EqOrdering 'EQ 'EQ = 'True
EqOrdering 'GT 'GT = 'True
EqOrdering a b = 'False
type EqUnit (a :: ()) (b :: ()) = True
type EqUnit (a :: ()) (b :: ()) = 'True
type family EqList a b where
EqList '[] '[] = True
EqList '[] '[] = 'True
EqList (h1 ': t1) (h2 ': t2) = (h1 == h2) && (t1 == t2)
EqList a b = False
EqList a b = 'False
type family EqMaybe a b where
EqMaybe Nothing Nothing = True
EqMaybe (Just x) (Just y) = x == y
EqMaybe a b = False
EqMaybe 'Nothing 'Nothing = 'True
EqMaybe ('Just x) ('Just y) = x == y
EqMaybe a b = 'False
type family Eq2 a b where
Eq2 '(a1, b1) '(a2, b2) = a1 == a2 && b1 == b2
......
......@@ -147,13 +147,13 @@ instance Read SomeSymbol where
readsPrec p xs = [ (someSymbolVal a, ys) | (a,ys) <- readsPrec p xs ]
type family EqNat (a :: Nat) (b :: Nat) where
EqNat a a = True
EqNat a b = False
EqNat a a = 'True
EqNat a b = 'False
type instance a == b = EqNat a b
type family EqSymbol (a :: Symbol) (b :: Symbol) where
EqSymbol a a = True
EqSymbol a b = False
EqSymbol a a = 'True
EqSymbol a b = 'False
type instance a == b = EqSymbol a b
--------------------------------------------------------------------------------
......@@ -164,7 +164,7 @@ infixl 7 *
infixr 8 ^
-- | Comparison of type-level naturals, as a constraint.
type x <= y = (x <=? y) ~ True
type x <= y = (x <=? y) ~ 'True
-- | Comparison of type-level symbols, as a function.
--
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment