6533d4b · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

Void -> TypeError

6533d4bOleg Grenrus9 years ago

servant-docs/servant-docs.cabal+3−3

compare with master

unifiedsplit

@@ -40,7 +40,7 @@ library

40 , base-compat >= 0.9.1 && <0.10

41 , aeson

42 , aeson-pretty

43− , bytestring

43+ , bytestring >= 0.10.4.0 && <0.11

44 , case-insensitive

45 , hashable

46 , http-media >= 0.6

@@ -49,8 +49,8 @@ library

49 , servant == 0.12.*

50 , string-conversions

51 , text

52− , unordered-containers

52+ , unordered-containers >=0.2.5.0

53− , control-monad-omega == 0.3.*

53+ , control-monad-omega >= 0.3.1 && <0.4

54 if !impl(ghc >= 8.0)

55 build-depends:

56 semigroups >=0.17 && <0.19

servant-server/src/Servant/Server/Internal.hs+45−18

@@ -12,7 +12,14 @@

12{-# LANGUAGE TupleSections #-}

13{-# LANGUAGE TypeFamilies #-}

14{-# LANGUAGE TypeOperators #-}

15+

16+#if MIN_VERSION_base(4,9,0) && __GLASGOW_HASKELL__ >= 802

17+#define HAS_TYPE_ERROR

18+#endif

19+

20+#ifdef HAS_TYPE_ERROR

15{-# LANGUAGE UndecidableInstances #-}

21{-# LANGUAGE UndecidableInstances #-}

22+#endif

17#include "overlapping-compat.h"

24#include "overlapping-compat.h"

@@ -87,8 +94,7 @@ import Servant.Server.Internal.Router

87import Servant.Server.Internal.RoutingApplication

94import Servant.Server.Internal.RoutingApplication

88import Servant.Server.Internal.ServantErr

95import Servant.Server.Internal.ServantErr

90−#if MIN_VERSION_base(4,9,0)

97+#ifdef HAS_TYPE_ERROR

91−import Data.Void

92import GHC.TypeLits (TypeError, ErrorMessage (..))

98import GHC.TypeLits (TypeError, ErrorMessage (..))

93#endif

99#endif

100

@@ -712,7 +718,7 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA

712-- TypeError helpers

718-- TypeError helpers

713-------------------------------------------------------------------------------

719-------------------------------------------------------------------------------

714

720

715−#if MIN_VERSION_base(4,9,0)

721+#ifdef HAS_TYPE_ERROR

716-- | This instance catches mistakes when there are non-saturated

722-- | This instance catches mistakes when there are non-saturated

717-- type applications on LHS of ':>'.

723-- type applications on LHS of ':>'.

718--

724--

@@ -722,17 +728,27 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA

722-- ...Maybe you haven't applied enough arguments to

728-- ...Maybe you haven't applied enough arguments to

723-- ...Capture "foo"

729-- ...Capture "foo"

724-- ...

730-- ...

725−instance TypeError

731+--

732+-- >>> undefined :: Server (Capture "foo" :> Get '[JSON] Int)

733+-- ...

726− ('Text "Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'."

734+-- ...Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'.

727− ':$$: 'Text "Maybe you haven't applied enough arguments to"

735+-- ...Maybe you haven't applied enough arguments to

728− ':$$: 'ShowType arr)

736+-- ...Capture "foo"

737+-- ...

738+--

729− => HasServer ((arr :: k -> l) :> api) context

739+instance TypeError (HasServerArrowKindError arr) => HasServer ((arr :: k -> l) :> api) context

730 where

740 where

731− type ServerT (arr :> api) m = Void

741+ type ServerT (arr :> api) m = TypeError (HasServerArrowKindError arr)

732 -- it doens't really matter what sub route we peak

742 -- it doens't really matter what sub route we peak

733− route Proxy context d = route (Proxy :: Proxy Raw) context (vacuous d)

743+ route _ _ _ = error "servant-server panic: impossible happened in HasServer (arr :> api)"

734 hoistServerWithContext _ _ _ = id

744 hoistServerWithContext _ _ _ = id

735

745

746+-- Cannot have TypeError here, otherwise use of this symbol will error :)

747+type HasServerArrowKindError arr =

748+ 'Text "Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'."

749+ ':$$: 'Text "Maybe you haven't applied enough arguments to"

750+ ':$$: 'ShowType arr

751+

736-- | This instance prevents from accidentally using '->' instead of ':>'

752-- | This instance prevents from accidentally using '->' instead of ':>'

737--

753--

738-- >>> serve (Proxy :: Proxy (Capture "foo" Int -> Get '[JSON] Int)) (error "...")

754-- >>> serve (Proxy :: Proxy (Capture "foo" Int -> Get '[JSON] Int)) (error "...")

@@ -743,17 +759,28 @@ instance TypeError

743-- ...and

759-- ...and

744-- ...Verb 'GET 200 '[JSON] Int

760-- ...Verb 'GET 200 '[JSON] Int

745-- ...

761-- ...

762+--

763+-- >>> undefined :: Server (Capture "foo" Int -> Get '[JSON] Int)

764+-- ...

765+-- ...No instance HasServer (a -> b).

766+-- ...Maybe you have used '->' instead of ':>' between

767+-- ...Capture "foo" Int

768+-- ...and

769+-- ...Verb 'GET 200 '[JSON] Int

770+-- ...

771+--

746−instance TypeError

772+instance TypeError (HasServerArrowTypeError a b) => HasServer (a -> b) context

773+ where

774+ type ServerT (a -> b) m = TypeError (HasServerArrowTypeError a b)

775+ route _ _ _ = error "servant-server panic: impossible happened in HasServer (a -> b)"

776+ hoistServerWithContext _ _ _ = id

777+

778+type HasServerArrowTypeError a b =

747− ('Text "No instance HasServer (a -> b)."

779+ 'Text "No instance HasServer (a -> b)."

748 ':$$: 'Text "Maybe you have used '->' instead of ':>' between "

780 ':$$: 'Text "Maybe you have used '->' instead of ':>' between "

749 ':$$: 'ShowType a

781 ':$$: 'ShowType a

750 ':$$: 'Text "and"

782 ':$$: 'Text "and"

751− ':$$: 'ShowType b)

783+ ':$$: '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

784#endif

758

785

759-- $setup

786-- $setup