From a1e1de91a9bc9a391c81f25cf1a379511254ebb6 Mon Sep 17 00:00:00 2001 From: "Julian K. Arni" Date: Tue, 13 Jan 2015 20:38:34 +0100 Subject: [PATCH] ReqBody content types. And general cleanup. --- servant.cabal | 19 ++++++++++++++++--- src/Servant/API.hs | 3 ++- src/Servant/API/ContentTypes.hs | 1 + src/Servant/API/Raw.hs | 4 +++- src/Servant/API/ReqBody.hs | 5 +++-- src/Servant/QQ.hs | 4 ++-- src/Servant/Utils/Links.hs | 8 +++++--- test/Servant/Utils/LinksSpec.hs | 5 ++--- 8 files changed, 34 insertions(+), 15 deletions(-) diff --git a/servant.cabal b/servant.cabal index 51d51b89..f03d915c 100644 --- a/servant.cabal +++ b/servant.cabal @@ -47,13 +47,26 @@ library base >=4.7 && <5 , bytestring == 0.10.* , http-types == 0.8.* - , text >= 1 - , template-haskell + , text >= 1 && < 2 + , template-haskell >= 2.7 && < 2.10 , parsec >= 3.1 - , string-conversions >= 0.3 + , string-conversions >= 0.3 && < 0.4 , network-uri >= 2.6 hs-source-dirs: src default-language: Haskell2010 + extensions: DataKinds + , DeriveDataTypeable + , FunctionalDependencies + , KindSignatures + , MultiParamTypeClasses + , PolyKinds + , QuasiQuotes + , ScopedTypeVariables + , TemplateHaskell + , TypeFamilies + , TypeOperators + , UndecidableInstances + , FlexibleInstances ghc-options: -Wall test-suite spec diff --git a/src/Servant/API.hs b/src/Servant/API.hs index ae7ce8f5..ed271466 100644 --- a/src/Servant/API.hs +++ b/src/Servant/API.hs @@ -46,7 +46,8 @@ module Servant.API ( import Servant.API.Alternative ( (:<|>)(..) ) import Servant.API.Capture ( Capture ) -import Servant.API.ContentTypes ( HTML, XML, JSON, JavaScript, CSS, PlainText ) +import Servant.API.ContentTypes ( HTML, XML, JSON, JavaScript, CSS + , PlainText, OctetStream ) import Servant.API.Delete ( Delete ) import Servant.API.Get ( Get ) import Servant.API.Header ( Header ) diff --git a/src/Servant/API/ContentTypes.hs b/src/Servant/API/ContentTypes.hs index e9fef23b..c3d382dc 100644 --- a/src/Servant/API/ContentTypes.hs +++ b/src/Servant/API/ContentTypes.hs @@ -10,3 +10,4 @@ data JSON deriving Typeable data JavaScript deriving Typeable data CSS deriving Typeable data PlainText deriving Typeable +data OctetStream deriving Typeable diff --git a/src/Servant/API/Raw.hs b/src/Servant/API/Raw.hs index fddfd461..eeaec597 100644 --- a/src/Servant/API/Raw.hs +++ b/src/Servant/API/Raw.hs @@ -1,5 +1,7 @@ +{-# LANGUAGE DeriveDataTypeable #-} module Servant.API.Raw where +import Data.Typeable (Typeable) -- | Endpoint for plugging in your own Wai 'Application's. -- -- The given 'Application' will get the request as received by the server, potentially with @@ -9,4 +11,4 @@ module Servant.API.Raw where -- this can also be used with 'Servant.Utils.StaticFiles.serveDirectory' to serve -- static files stored in a particular directory on your filesystem, or to serve -- your API's documentation with 'Servant.Utils.StaticFiles.serveDocumentation'. -data Raw +data Raw deriving Typeable diff --git a/src/Servant/API/ReqBody.hs b/src/Servant/API/ReqBody.hs index 550275aa..e7df0b7b 100644 --- a/src/Servant/API/ReqBody.hs +++ b/src/Servant/API/ReqBody.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} module Servant.API.ReqBody where @@ -6,5 +7,5 @@ module Servant.API.ReqBody where -- Example: -- -- > -- POST /books --- > type MyApi = "books" :> ReqBody Book :> Post Book -data ReqBody a +-- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post Book +data ReqBody (ls::[*]) a diff --git a/src/Servant/QQ.hs b/src/Servant/QQ.hs index 6c09e2bf..461d559b 100644 --- a/src/Servant/QQ.hs +++ b/src/Servant/QQ.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} diff --git a/src/Servant/Utils/Links.hs b/src/Servant/Utils/Links.hs index d9bd1c00..baf700a1 100644 --- a/src/Servant/Utils/Links.hs +++ b/src/Servant/Utils/Links.hs @@ -2,10 +2,11 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} -- | Type safe generation of internal links. @@ -155,7 +156,8 @@ type family IsElem endpoint api :: Constraint where IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb) IsElem (e :> sa) (e :> sb) = IsElem sa sb IsElem sa (Header x :> sb) = IsElem sa sb - IsElem sa (ReqBody x :> sb) = IsElem sa sb + IsElem sa (ReqBody y x :> sb) = IsElem sa sb + IsElem (e :> sa) (Capture x y :> sb) = IsElem sa sb IsElem sa (QueryParam x y :> sb) = IsElem sa sb IsElem sa (QueryParams x y :> sb) = IsElem sa sb IsElem sa (QueryFlag x :> sb) = IsElem sa sb diff --git a/test/Servant/Utils/LinksSpec.hs b/test/Servant/Utils/LinksSpec.hs index 1ddd10d4..4d373572 100644 --- a/test/Servant/Utils/LinksSpec.hs +++ b/test/Servant/Utils/LinksSpec.hs @@ -12,7 +12,6 @@ import Servant.API ( type (:<|>), ReqBody, QueryParam, MatrixParam, MatrixParams , MatrixFlag, Get, Post, Capture, type (:>) , HTML , JSON, XML ) import Servant.QQSpec ( (~>) ) import Servant.Utils.Links ( IsElem, IsLink ) -<<<<<<< HEAD type TestApi = -- Capture and query/matrix params @@ -28,7 +27,7 @@ type TestApi = -- All of the verbs :<|> "get" :> Get '[JSON] () :<|> "put" :> Put '[JSON] () - :<|> "post" :> ReqBody 'True :> Post '[JSON] () + :<|> "post" :> ReqBody '[JSON] 'True :> Post '[JSON] () :<|> "delete" :> Header "ponies" :> Delete :<|> "raw" :> Raw @@ -44,7 +43,7 @@ type BadTestLink' = "hello" :> "hi" :> Get '[HTML] Bool type BadTestLink'2 = "greet" :> Get '[HTML] Bool type NotALink = "hello" :> Capture "x" Bool :> Get '[JSON] Bool -type NotALink2 = "hello" :> ReqBody 'True :> Get '[JSON] Bool +type NotALink2 = "hello" :> ReqBody '[JSON] 'True :> Get '[JSON] Bool apiLink :: (IsElem endpoint TestApi, HasLink endpoint) => Proxy endpoint -> MkLink endpoint