git.iko.soy/servant
on master help sign in
Custom type errors
02e4281Julian K. Arni
servant/src/Servant/API/TypeLevel.hs+28−23
compare with master
unifiedsplit
@@ -110,7 +110,8 @@ type family IsSubList a b :: Constraint where
110 IsSubList '[] b = ()
110 IsSubList '[] b = ()
111 IsSubList (x ': xs) y = Elem x y `And` IsSubList xs y
111 IsSubList (x ': xs) y = Elem x y `And` IsSubList xs y
112
112
113+#if !MIN_VERSION_base(4,9,0)
113−-- | Check that an eleme is an element of a list:
114+-- | Check that a value is an element of a list:
114--
115--
115-- >>> ok (Proxy :: Proxy (Elem Bool '[Int, Bool]))
116-- >>> ok (Proxy :: Proxy (Elem Bool '[Int, Bool]))
116-- OK
117-- OK
@@ -121,13 +122,31 @@ type family IsSubList a b :: Constraint where
121-- arising from a use of ‘ok’
122-- arising from a use of ‘ok’
122-- ...
123-- ...
123type Elem e es = ElemGo e es es
124type Elem e es = ElemGo e es es
125+#else
126+-- | Check that a value is an element of a list:
127+--
128+-- >>> ok (Proxy :: Proxy (Elem Bool '[Int, Bool]))
129+-- OK
130+--
131+-- >>> ok (Proxy :: Proxy (Elem String '[Int, Bool]))
132+-- ...
133+-- ... [Char] expected in list '[Int, Bool]
134+-- ...
135+type Elem e es = ElemGo e es es
136+#endif
124
137
125-- 'orig' is used to store original list for better error messages
138-- 'orig' is used to store original list for better error messages
126type family ElemGo e es orig :: Constraint where
139type family ElemGo e es orig :: Constraint where
127 ElemGo x (x ': xs) orig = ()
140 ElemGo x (x ': xs) orig = ()
128 ElemGo y (x ': xs) orig = ElemGo y xs orig
141 ElemGo y (x ': xs) orig = ElemGo y xs orig
142+#if MIN_VERSION_base(4,9,0)
143+ -- Note [Custom Errors]
144+ ElemGo x '[] orig = TypeError ('ShowType x
145+ ':<>: 'Text " expected in list "
146+ ':<>: 'ShowType orig)
147+#else
129 ElemGo x '[] orig = ElemNotFoundIn x orig
148 ElemGo x '[] orig = ElemNotFoundIn x orig
130−
149+#endif
131
150
132-- ** Logic
151-- ** Logic
133
152
@@ -144,30 +163,16 @@ type family And (a :: Constraint) (b :: Constraint) :: Constraint where
144
163
145-- * Custom type errors
164-- * Custom type errors
146
165
147−#if MIN_VERSION_base(4,9,0)
166+#if !MIN_VERSION_base(4,9,0)
148−-- GHC >= 8
149−
150−
151−type ElemNotFoundIn val list = TypeError
152− (ShowType val :<>: Text " expected in list " :<>: ShowList list)
153−
154−
155−-- Utilities
156−
157−type family ShowListGo ls :: ErrorMessage where
158− ShowListGo '[] = Text ""
159− ShowListGo (x ': xs) = ShowType x :<>: Text ", " :<>: ShowListGo xs
160−
161−type ShowList ls = Text "[" :<>: ShowListGo ls :<>: Text "]"
162−
163−
164−#else
165−
166−-- GHC < 8
167class ElemNotFoundIn val list
167class ElemNotFoundIn val list
168−
169#endif
168#endif
170
169
170+{- Note [Custom Errors]
171+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
172+We might try to factor these our more cleanly, but the type synonyms and type
173+families are not evaluated (see https://ghc.haskell.org/trac/ghc/ticket/12048).
174+-}
175+
171-- $setup
176-- $setup
172-- >>> import Data.Proxy
177-- >>> import Data.Proxy
173-- >>> data OK = OK deriving (Show)
178-- >>> data OK = OK deriving (Show)