@@ -4,7 +4,6 @@
44{-# LANGUAGE DeriveDataTypeable #-}
55{-# LANGUAGE FlexibleContexts #-}
66{-# LANGUAGE FlexibleInstances #-}
7−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
87{-# LANGUAGE MultiParamTypeClasses #-}
98{-# LANGUAGE OverloadedStrings #-}
109{-# LANGUAGE PolyKinds #-}
@@ -13,6 +12,7 @@
1312{-# LANGUAGE TupleSections #-}
1413{-# LANGUAGE TypeFamilies #-}
1514{-# LANGUAGE TypeOperators #-}
15+{-# LANGUAGE UndecidableInstances #-}
1616
1717#include "overlapping-compat.h"
1818
@@ -87,6 +87,10 @@ import Servant.Server.Internal.Router
8787import Servant.Server.Internal.RoutingApplication
8888import Servant.Server.Internal.ServantErr
8989
90+#if MIN_VERSION_base(4,9,0)
91+import Data.Void
92+import GHC.TypeLits (TypeError, ErrorMessage (..))
93+#endif
9094
9195class HasServer api context where
9296 type ServerT api (m :: * -> *) :: *
@@ -703,3 +707,54 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA
703707 subContext = descendIntoNamedContext (Proxy :: Proxy name) context
704708
705709 hoistServerWithContext _ _ nt s = hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s
710+
711+-------------------------------------------------------------------------------
712+-- TypeError helpers
713+-------------------------------------------------------------------------------
714+
715+#if MIN_VERSION_base(4,9,0)
716+-- | This instance catches mistakes when there are non-saturated
717+-- type applications on LHS of ':>'.
718+--
719+-- >>> serve (Proxy :: Proxy (Capture "foo" :> Get '[JSON] Int)) (error "...")
720+-- ...
721+-- ...Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'.
722+-- ...Maybe you haven't applied enough arguments to
723+-- ...Capture "foo"
724+-- ...
725+instance TypeError
726+ ('Text "Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'."
727+ ':$$: 'Text "Maybe you haven't applied enough arguments to"
728+ ':$$: 'ShowType arr)
729+ => HasServer ((arr :: k -> l) :> api) context
730+ where
731+ type ServerT (arr :> api) m = Void
732+ -- it doens't really matter what sub route we peak
733+ route Proxy context d = route (Proxy :: Proxy Raw) context (vacuous d)
734+ hoistServerWithContext _ _ _ = id
735+
736+-- | This instance prevents from accidentally using '->' instead of ':>'
737+--
738+-- >>> serve (Proxy :: Proxy (Capture "foo" Int -> Get '[JSON] Int)) (error "...")
739+-- ...
740+-- ...No instance HasServer (a -> b).
741+-- ...Maybe you have used '->' instead of ':>' between
742+-- ...Capture "foo" Int
743+-- ...and
744+-- ...Verb 'GET 200 '[JSON] Int
745+-- ...
746+instance TypeError
747+ ('Text "No instance HasServer (a -> b)."
748+ ':$$: 'Text "Maybe you have used '->' instead of ':>' between "
749+ ':$$: 'ShowType a
750+ ':$$: 'Text "and"
751+ ':$$: 'ShowType b)
752+ => HasServer (a -> b) context
753+ where
754+ type ServerT (a -> b) m = Void
755+ route Proxy context d = route (Proxy :: Proxy Raw) context (vacuous d)
756+ hoistServerWithContext _ _ _ = id
757+#endif
758+
759+-- $setup
760+-- >>> import Servant