From 92b11968306dc0e34090cebc96170103c7d37e16 Mon Sep 17 00:00:00 2001
From: "Julian K. Arni" <jkarni@gmail.com>
Date: Mon, 22 Aug 2016 12:24:36 -0300
Subject: [PATCH] Redundant import fixes

---
 servant-docs/src/Servant/Docs/Internal.hs     |  2 -
 .../src/Servant/Foreign/Internal.hs           |  1 -
 servant/src/Servant/API/TypeLevel.hs          | 57 ++++++++++++++++++-
 servant/test/Servant/Utils/LinksSpec.hs       |  1 -
 4 files changed, 54 insertions(+), 7 deletions(-)

diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs
index 076ced71..502c540f 100644
--- a/servant-docs/src/Servant/Docs/Internal.hs
+++ b/servant-docs/src/Servant/Docs/Internal.hs
@@ -37,13 +37,11 @@ import           Data.Ord                   (comparing)
 import           Data.Proxy                 (Proxy(Proxy))
 import           Data.String.Conversions    (cs)
 import           Data.Text                  (Text, unpack)
-import           GHC.Exts                   (Constraint)
 import           GHC.Generics
 import           GHC.TypeLits
 import           Servant.API
 import           Servant.API.ContentTypes
 import           Servant.API.TypeLevel
-import           Servant.Utils.Links
 
 import qualified Data.HashMap.Strict        as HM
 import qualified Data.Text                  as T
diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs
index e05583d3..5165a8e5 100644
--- a/servant-foreign/src/Servant/Foreign/Internal.hs
+++ b/servant-foreign/src/Servant/Foreign/Internal.hs
@@ -16,7 +16,6 @@ import           Data.Proxy
 import           Data.String
 import           Data.Text
 import           Data.Text.Encoding (decodeUtf8)
-import           GHC.Exts (Constraint)
 import           GHC.TypeLits
 import qualified Network.HTTP.Types as HTTP
 import           Prelude hiding (concat)
diff --git a/servant/src/Servant/API/TypeLevel.hs b/servant/src/Servant/API/TypeLevel.hs
index 9565ee5d..759d89c0 100644
--- a/servant/src/Servant/API/TypeLevel.hs
+++ b/servant/src/Servant/API/TypeLevel.hs
@@ -1,8 +1,11 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE UndecidableInstances #-}
 module Servant.API.TypeLevel where
 
@@ -14,6 +17,9 @@ import Servant.API.Header ( Header )
 import Servant.API.Verbs ( Verb )
 import Servant.API.Sub ( type (:>) )
 import Servant.API.Alternative ( type (:<|>) )
+#if MIN_VERSION_base(4,9,0)
+import GHC.TypeLits (TypeError, ErrorMessage(..))
+#endif
 
 -- * API predicates
 
@@ -104,9 +110,24 @@ type family IsSubList a b :: Constraint where
     IsSubList '[] b          = ()
     IsSubList (x ': xs) y    = Elem x y `And` IsSubList xs y
 
-type family Elem e es :: Constraint where
-    Elem x (x ': xs) = ()
-    Elem y (x ': xs) = Elem y xs
+-- | Check that an eleme is an element of a list:
+--
+-- >>> ok (Proxy :: Proxy (Elem Bool '[Int, Bool]))
+-- OK
+--
+-- >>> ok (Proxy  :: Proxy (Elem String '[Int, Bool]))
+-- ...
+--     No instance for (ElemNotFoundIn [Char] '[Int, Bool])
+--       arising from a use of ‘ok’
+-- ...
+type Elem e es = ElemGo e es es
+
+-- 'orig' is used to store original list for better error messages
+type family ElemGo e es orig :: Constraint where
+    ElemGo x (x ': xs) orig = ()
+    ElemGo y (x ': xs) orig = ElemGo y xs orig
+    ElemGo x '[] orig       = ElemNotFoundIn x orig
+
 
 -- ** Logic
 
@@ -121,3 +142,33 @@ type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
 type family And (a :: Constraint) (b :: Constraint) :: Constraint where
     And () ()     = ()
 
+-- * Custom type errors
+
+#if MIN_VERSION_base(4,9,0)
+-- GHC >= 8
+
+
+type ElemNotFoundIn val list = TypeError
+  (ShowType val :<>: Text " expected in list " :<>: ShowList list)
+
+
+-- Utilities
+
+type family ShowListGo ls :: ErrorMessage where
+  ShowListGo '[] = Text ""
+  ShowListGo (x ': xs) = ShowType x :<>: Text ", " :<>: ShowListGo xs
+
+type ShowList ls = Text "[" :<>: ShowListGo ls :<>: Text "]"
+
+
+#else
+
+-- GHC < 8
+class ElemNotFoundIn val list
+
+#endif
+
+-- $setup
+-- >>> import Data.Proxy
+-- >>> data OK = OK deriving (Show)
+-- >>> let ok :: ctx => Proxy ctx -> OK; ok _ = OK
diff --git a/servant/test/Servant/Utils/LinksSpec.hs b/servant/test/Servant/Utils/LinksSpec.hs
index fbc5ce0b..6a6bb8dc 100644
--- a/servant/test/Servant/Utils/LinksSpec.hs
+++ b/servant/test/Servant/Utils/LinksSpec.hs
@@ -10,7 +10,6 @@ import           Test.Hspec              (Expectation, Spec, describe, it,
 import           Data.String             (fromString)
 
 import           Servant.API
-import           Servant.API.TypeLevel
 
 type TestApi =
   -- Capture and query params