Use (a :: *) on phantom type variables for kinder type checking #887

This commit is contained in:
Michael Sloan 2018-01-17 03:19:14 -08:00
parent a6cd6fcdc4
commit 7e0ad51b62
7 changed files with 10 additions and 10 deletions

View file

@ -12,7 +12,7 @@ import GHC.TypeLits (Symbol)
-- --
-- >>> -- GET /books/:isbn -- >>> -- GET /books/:isbn
-- >>> type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book -- >>> type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
data Capture (sym :: Symbol) a data Capture (sym :: Symbol) (a :: *)
deriving (Typeable) deriving (Typeable)
@ -23,7 +23,7 @@ data Capture (sym :: Symbol) a
-- --
-- >>> -- GET /src/* -- >>> -- GET /src/*
-- >>> type MyAPI = "src" :> CaptureAll "segments" Text :> Get '[JSON] SourceFile -- >>> type MyAPI = "src" :> CaptureAll "segments" Text :> Get '[JSON] SourceFile
data CaptureAll (sym :: Symbol) a data CaptureAll (sym :: Symbol) (a :: *)
deriving (Typeable) deriving (Typeable)
-- $setup -- $setup

View file

@ -14,7 +14,7 @@ import GHC.TypeLits (Symbol)
-- --
-- >>> -- /books?author=<author name> -- >>> -- /books?author=<author name>
-- >>> type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book] -- >>> type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]
data QueryParam (sym :: Symbol) a data QueryParam (sym :: Symbol) (a :: *)
deriving Typeable deriving Typeable
-- | Lookup the values associated to the @sym@ query string parameter -- | Lookup the values associated to the @sym@ query string parameter
@ -28,7 +28,7 @@ data QueryParam (sym :: Symbol) a
-- --
-- >>> -- /books?authors[]=<author1>&authors[]=<author2>&... -- >>> -- /books?authors[]=<author1>&authors[]=<author2>&...
-- >>> type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book] -- >>> type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]
data QueryParams (sym :: Symbol) a data QueryParams (sym :: Symbol) (a :: *)
deriving Typeable deriving Typeable
-- | Lookup a potentially value-less query string parameter -- | Lookup a potentially value-less query string parameter

View file

@ -11,7 +11,7 @@ import Data.Typeable (Typeable)
-- --
-- >>> -- POST /books -- >>> -- POST /books
-- >>> type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- >>> type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book
data ReqBody (contentTypes :: [*]) a data ReqBody (contentTypes :: [*]) (a :: *)
deriving (Typeable) deriving (Typeable)
-- $setup -- $setup

View file

@ -23,7 +23,7 @@ import Control.Arrow (first)
import Network.HTTP.Types.Method (StdMethod (..)) import Network.HTTP.Types.Method (StdMethod (..))
-- | A Stream endpoint for a given method emits a stream of encoded values at a given Content-Type, delimited by a framing strategy. Steam endpoints always return response code 200 on success. Type synonyms are provided for standard methods. -- | A Stream endpoint for a given method emits a stream of encoded values at a given Content-Type, delimited by a framing strategy. Steam endpoints always return response code 200 on success. Type synonyms are provided for standard methods.
data Stream (method :: k1) (framing :: *) (contentType :: *) a data Stream (method :: k1) (framing :: *) (contentType :: *) (a :: *)
deriving (Typeable, Generic) deriving (Typeable, Generic)
type StreamGet = Stream 'GET type StreamGet = Stream 'GET

View file

@ -14,7 +14,7 @@ import Data.Typeable (Typeable)
-- >>> -- GET /hello/world -- >>> -- GET /hello/world
-- >>> -- returning a JSON encoded World value -- >>> -- returning a JSON encoded World value
-- >>> type MyApi = "hello" :> "world" :> Get '[JSON] World -- >>> type MyApi = "hello" :> "world" :> Get '[JSON] World
data (path :: k) :> a data (path :: k) :> (a :: *)
deriving (Typeable) deriving (Typeable)
infixr 4 :> infixr 4 :>

View file

@ -23,7 +23,7 @@ import Network.HTTP.Types.Method (Method, StdMethod (..),
-- provided, but you are free to define your own: -- provided, but you are free to define your own:
-- --
-- >>> type Post204 contentTypes a = Verb 'POST 204 contentTypes a -- >>> type Post204 contentTypes a = Verb 'POST 204 contentTypes a
data Verb (method :: k1) (statusCode :: Nat) (contentTypes :: [*]) a data Verb (method :: k1) (statusCode :: Nat) (contentTypes :: [*]) (a :: *)
deriving (Typeable, Generic) deriving (Typeable, Generic)
-- * 200 responses -- * 200 responses

View file

@ -24,7 +24,7 @@ type TestApi =
-- All of the verbs -- All of the verbs
:<|> "get" :> Get '[JSON] NoContent :<|> "get" :> Get '[JSON] NoContent
:<|> "put" :> Put '[JSON] NoContent :<|> "put" :> Put '[JSON] NoContent
:<|> "post" :> ReqBody '[JSON] 'True :> Post '[JSON] NoContent :<|> "post" :> ReqBody '[JSON] Bool :> Post '[JSON] NoContent
:<|> "delete" :> Header "ponies" String :> Delete '[JSON] NoContent :<|> "delete" :> Header "ponies" String :> Delete '[JSON] NoContent
:<|> "raw" :> Raw :<|> "raw" :> Raw
:<|> NoEndpoint :<|> NoEndpoint
@ -124,6 +124,6 @@ type WrongPath = "getTypo" :> Get '[JSON] NoContent
type WrongReturnType = "get" :> Get '[JSON] Bool type WrongReturnType = "get" :> Get '[JSON] Bool
type WrongContentType = "get" :> Get '[OctetStream] NoContent type WrongContentType = "get" :> Get '[OctetStream] NoContent
type WrongMethod = "get" :> Post '[JSON] NoContent type WrongMethod = "get" :> Post '[JSON] NoContent
type NotALink = "hello" :> ReqBody '[JSON] 'True :> Get '[JSON] Bool type NotALink = "hello" :> ReqBody '[JSON] Bool :> Get '[JSON] Bool
type AllGood = "get" :> Get '[JSON] NoContent type AllGood = "get" :> Get '[JSON] NoContent
type NoEndpoint = "empty" :> EmptyAPI type NoEndpoint = "empty" :> EmptyAPI