summaryrefslogtreecommitdiff
path: root/src/Propellor/PropAccum.hs
diff options
context:
space:
mode:
authorJoey Hess2019-07-02 00:46:21 -0400
committerJoey Hess2019-07-02 00:46:21 -0400
commit2ba2cda972f484771b763603bf09d555003861b7 (patch)
tree13c79ae8e9f46cf6c9ec5353ca366555da0e0ab1 /src/Propellor/PropAccum.hs
parent7ac0fbfa247ca153a6187c47dde9fc3a94c9cdb5 (diff)
Revert "Revert "custom type error messages""
This reverts commit 665ea0d3d9e1b0e90278fd659dee0ef8642030da.
Diffstat (limited to 'src/Propellor/PropAccum.hs')
-rw-r--r--src/Propellor/PropAccum.hs17
1 files changed, 14 insertions, 3 deletions
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index c60ced73..3fc83202 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -19,6 +19,7 @@ import Propellor.Types.MetaTypes
import Propellor.Types.Core
import Propellor.Property
+import GHC.TypeLits
import Data.Monoid
import Prelude
@@ -45,6 +46,16 @@ type family GetMetaTypes x where
GetMetaTypes (Property (MetaTypes t)) = MetaTypes t
GetMetaTypes (RevertableProperty (MetaTypes t) undo) = MetaTypes t
+-- When many properties are combined, ghc error message
+-- can include quite a lot of code, typically starting with
+-- `props and including all the properties up to and including the
+-- one that fails to combine. Point the user in the right direction.
+type family NoteFor symbol :: ErrorMessage where
+ NoteFor symbol =
+ 'Text "Probably the problem is with the last property added with "
+ ':<>: symbol
+ ':<>: 'Text " in the code excerpt below."
+
-- | Adds a property to a Props.
--
-- Can add Properties and RevertableProperties
@@ -55,7 +66,7 @@ type family GetMetaTypes x where
-- this constraint appears redundant, but is actually
-- crucial.
, MetaTypes y ~ GetMetaTypes p
- , CheckCombinable x y ~ 'CanCombine
+ , CheckCombinableNote x y (NoteFor ('Text "&")) ~ 'True
)
=> Props (MetaTypes x)
-> p
@@ -70,7 +81,7 @@ Props c & p = Props (c ++ [toChildProperty p])
-- this constraint appears redundant, but is actually
-- crucial.
, MetaTypes y ~ GetMetaTypes p
- , CheckCombinable x y ~ 'CanCombine
+ , CheckCombinableNote x y (NoteFor ('Text "&^")) ~ 'True
)
=> Props (MetaTypes x)
-> p
@@ -82,7 +93,7 @@ Props c &^ p = Props (toChildProperty p : c)
-- -Wredundant-constraints is turned off because
-- this constraint appears redundant, but is actually
-- crucial.
- :: (CheckCombinable x z ~ 'CanCombine)
+ :: (CheckCombinableNote x z (NoteFor ('Text "!")) ~ 'True)
=> Props (MetaTypes x)
-> RevertableProperty (MetaTypes y) (MetaTypes z)
-> Props (MetaTypes (Combine x z))