summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2016-11-11 17:29:11 -0400
committerJoey Hess2016-11-11 17:29:25 -0400
commitc0d0e57257fe8dee1f9d37a6d49b6322af985a69 (patch)
treebe921c1ad45c42e6ed1c987fc51d6e9b7e013689
parentc24acf55af190bc332b29d0ef4a04dda9335b01a (diff)
Clean up build warnings about redundant constraints when built with ghc 8.0.
Only a couple of the constraints were really redundant. The rest are essential to propellor's tracking of Info propigation, so I silenced the warning for those. It would be better to only silence the warning for the functions with the extra constraints, but IIRC warnings can only be silenced on an entire file basis. This commit was sponsored by Andreas on Patreon.
-rw-r--r--debian/changelog1
-rw-r--r--src/Propellor/Container.hs4
-rw-r--r--src/Propellor/EnsureProperty.hs6
-rw-r--r--src/Propellor/Info.hs7
-rw-r--r--src/Propellor/Message.hs2
-rw-r--r--src/Propellor/PropAccum.hs10
-rw-r--r--src/Propellor/Property.hs2
7 files changed, 29 insertions, 3 deletions
diff --git a/debian/changelog b/debian/changelog
index 99c296d6..73c9244e 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,6 +1,7 @@
propellor (3.2.2) UNRELEASED; urgency=medium
* Added Linode.serialGrub property.
+ * Clean up build warnings about redundant constraints when built with ghc 8.0.
-- Joey Hess <id@joeyh.name> Fri, 21 Oct 2016 14:59:09 -0400
diff --git a/src/Propellor/Container.hs b/src/Propellor/Container.hs
index c4d6f864..5c365f59 100644
--- a/src/Propellor/Container.hs
+++ b/src/Propellor/Container.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE DataKinds, TypeFamilies #-}
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Propellor.Container where
@@ -43,6 +44,9 @@ propagateContainer
::
-- Since the children being added probably have info,
-- require the Property's metatypes to have info.
+ -- -Wredundant-constraints is turned off because
+ -- this constraint appears redundant, but is actually
+ -- crucial.
( IncludesInfo metatypes ~ 'True
, IsContainer c
)
diff --git a/src/Propellor/EnsureProperty.hs b/src/Propellor/EnsureProperty.hs
index c4666722..e8602047 100644
--- a/src/Propellor/EnsureProperty.hs
+++ b/src/Propellor/EnsureProperty.hs
@@ -3,6 +3,7 @@
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Propellor.EnsureProperty
( ensureProperty
@@ -37,6 +38,9 @@ import Prelude
-- with the property to be lost.
ensureProperty
::
+ -- -Wredundant-constraints is turned off because
+ -- this constraint appears redundant, but is actually
+ -- crucial.
( Cannot_ensureProperty_WithInfo inner ~ 'True
, (Targets inner `NotSuperset` Targets outer) ~ 'CanCombine
)
@@ -45,7 +49,7 @@ ensureProperty
-> Propellor Result
ensureProperty _ = catchPropellor . getSatisfy
--- The name of this was chosen to make type errors a more understandable.
+-- The name of this was chosen to make type errors a bit more understandable.
type family Cannot_ensureProperty_WithInfo (l :: [a]) :: Bool
type instance Cannot_ensureProperty_WithInfo '[] = 'True
type instance Cannot_ensureProperty_WithInfo (t ': ts) =
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index e9218291..75f0b76a 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE PackageImports, TypeFamilies, DataKinds, PolyKinds #-}
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Propellor.Info (
osDebian,
@@ -38,6 +39,9 @@ import Prelude
--
-- The new Property will include HasInfo in its metatypes.
setInfoProperty
+ -- -Wredundant-constraints is turned off because
+ -- this constraint appears redundant, but is actually
+ -- crucial.
:: (MetaTypes metatypes' ~ (+) HasInfo metatypes, SingI metatypes')
=> Property metatypes
-> Info
@@ -47,6 +51,9 @@ setInfoProperty (Property _ d a oldi c) newi =
-- | Adds more info to a Property that already HasInfo.
addInfoProperty
+ -- -Wredundant-constraints is turned off because
+ -- this constraint appears redundant, but is actually
+ -- crucial.
:: (IncludesInfo metatypes ~ 'True)
=> Property metatypes
-> Info
diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
index f728e143..97573516 100644
--- a/src/Propellor/Message.hs
+++ b/src/Propellor/Message.hs
@@ -73,7 +73,7 @@ actionMessage = actionMessage' Nothing
actionMessageOn :: (MonadIO m, MonadMask m, ActionResult r) => HostName -> Desc -> m r -> m r
actionMessageOn = actionMessage' . Just
-actionMessage' :: (MonadIO m, MonadMask m, ActionResult r) => Maybe HostName -> Desc -> m r -> m r
+actionMessage' :: (MonadIO m, ActionResult r) => Maybe HostName -> Desc -> m r -> m r
actionMessage' mhn desc a = do
liftIO $ outputConcurrent
=<< whenConsole (setTitleCode $ "propellor: " ++ desc)
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index fcac60bf..c7ef946a 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -4,6 +4,7 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DataKinds #-}
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Propellor.PropAccum
( host
@@ -51,6 +52,9 @@ type instance GetMetaTypes (RevertableProperty (MetaTypes t) undo) = MetaTypes t
(&)
::
( IsProp p
+ -- -Wredundant-constraints is turned off because
+ -- this constraint appears redundant, but is actually
+ -- crucial.
, MetaTypes y ~ GetMetaTypes p
, CheckCombinable x y ~ 'CanCombine
)
@@ -63,6 +67,9 @@ Props c & p = Props (c ++ [toChildProperty p])
(&^)
::
( IsProp p
+ -- -Wredundant-constraints is turned off because
+ -- this constraint appears redundant, but is actually
+ -- crucial.
, MetaTypes y ~ GetMetaTypes p
, CheckCombinable x y ~ 'CanCombine
)
@@ -73,6 +80,9 @@ Props c &^ p = Props (toChildProperty p : c)
-- | Adds a property in reverted form.
(!)
+ -- -Wredundant-constraints is turned off because
+ -- this constraint appears redundant, but is actually
+ -- crucial.
:: (CheckCombinable x z ~ 'CanCombine)
=> Props (MetaTypes x)
-> RevertableProperty (MetaTypes y) (MetaTypes z)
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 7ee9397e..ae4fc914 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -345,7 +345,7 @@ revert (RevertableProperty p1 p2) = RevertableProperty p2 p1
-- | Apply a property to each element of a list.
applyToList
- :: (Foldable t, Functor t, IsProp p, Combines p p, p ~ CombinedType p p)
+ :: (Foldable t, Functor t, Combines p p, p ~ CombinedType p p)
=> (b -> p)
-> t b
-> p