servant 0.2.2 → 0.4.0
raw patch · 21 files changed
+1265/−434 lines, 21 filesdep +aesondep +attoparsecdep +bytestringdep −template-haskelldep ~basedep ~parsecdep ~string-conversions
Dependencies added: aeson, attoparsec, bytestring, bytestring-conversion, case-insensitive, doctest, filemanip, http-media, http-types, network-uri, quickcheck-instances, url
Dependencies removed: template-haskell
Dependency ranges changed: base, parsec, string-conversions, text
Files
- servant.cabal +52/−6
- src/Servant/API.hs +59/−29
- src/Servant/API/Alternative.hs +25/−4
- src/Servant/API/Capture.hs +17/−5
- src/Servant/API/ContentTypes.hs +375/−0
- src/Servant/API/Delete.hs +15/−4
- src/Servant/API/Get.hs +14/−4
- src/Servant/API/Header.hs +24/−7
- src/Servant/API/MatrixParam.hs +27/−11
- src/Servant/API/Patch.hs +29/−0
- src/Servant/API/Post.hs +17/−7
- src/Servant/API/Put.hs +15/−5
- src/Servant/API/QueryParam.hs +26/−11
- src/Servant/API/Raw.hs +5/−3
- src/Servant/API/ReqBody.hs +17/−4
- src/Servant/API/ResponseHeaders.hs +168/−0
- src/Servant/API/Sub.hs +19/−8
- src/Servant/Common/Text.hs +34/−15
- src/Servant/QQ.hs +0/−228
- src/Servant/Utils/Links.hs +311/−83
- test/Doctests.hs +16/−0
servant.cabal view
@@ -1,5 +1,5 @@ name: servant-version: 0.2.2+version: 0.4.0 synopsis: A family of combinators for defining webservices APIs description: A family of combinators for defining webservices APIs and serving them@@ -8,6 +8,8 @@ . <https://github.com/haskell-servant/servant-server/blob/master/example/greet.hs Here>'s a runnable example, with comments, that defines a dummy API and implements a webserver that serves this API, using the <http://hackage.haskell.org/package/servant-server servant-server> package.+ .+ <https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md CHANGELOG> homepage: http://haskell-servant.github.io/ Bug-reports: http://github.com/haskell-servant/servant/issues license: BSD3@@ -28,27 +30,55 @@ Servant.API Servant.API.Alternative Servant.API.Capture+ Servant.API.ContentTypes Servant.API.Delete Servant.API.Get Servant.API.Header+ Servant.API.Patch Servant.API.Post Servant.API.Put Servant.API.QueryParam Servant.API.MatrixParam Servant.API.Raw Servant.API.ReqBody+ Servant.API.ResponseHeaders Servant.API.Sub Servant.Common.Text- Servant.QQ Servant.Utils.Links build-depends: base >=4.7 && <5- , text >= 1- , template-haskell- , parsec >= 3.1- , string-conversions >= 0.3+ , aeson >= 0.7+ , attoparsec >= 0.12+ , bytestring == 0.10.*+ , bytestring-conversion == 0.3.*+ , case-insensitive >= 1.2+ , http-media >= 0.4 && < 0.7+ , http-types == 0.8.*+ , text >= 1 && < 2+ , string-conversions >= 0.3 && < 0.4+ , network-uri >= 2.6 hs-source-dirs: src default-language: Haskell2010+ other-extensions: CPP+ , ConstraintKinds+ , DataKinds+ , DeriveDataTypeable+ , FlexibleInstances+ , FunctionalDependencies+ , GADTs+ , KindSignatures+ , MultiParamTypeClasses+ , OverlappingInstances+ , OverloadedStrings+ , PolyKinds+ , QuasiQuotes+ , RecordWildCards+ , ScopedTypeVariables+ , TemplateHaskell+ , TypeFamilies+ , TypeOperators+ , TypeSynonymInstances+ , UndecidableInstances ghc-options: -Wall test-suite spec@@ -60,9 +90,25 @@ main-is: Spec.hs build-depends: base == 4.*+ , aeson+ , attoparsec+ , bytestring , hspec == 2.* , QuickCheck+ , quickcheck-instances , parsec , servant , string-conversions , text+ , url++test-suite doctests+ build-depends: base+ , servant+ , doctest+ , filemanip+ type: exitcode-stdio-1.0+ main-is: test/Doctests.hs+ buildable: True+ default-language: Haskell2010+ ghc-options: -threaded
src/Servant/API.hs view
@@ -1,55 +1,85 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} module Servant.API ( -- * Combinators- -- | Type-level combinator for expressing subrouting: @':>'@ module Servant.API.Sub,- -- | Type-level combinator for alternative endpoints: @':<|>'@+ -- | Type-level combinator for expressing subrouting: @':>'@ module Servant.API.Alternative,+ -- | Type-level combinator for alternative endpoints: @':<|>'@ -- * Accessing information from the request- -- | Capturing parts of the url path as parsed values: @'Capture'@ module Servant.API.Capture,- -- | Retrieving specific headers from the request+ -- | Capturing parts of the url path as parsed values: @'Capture'@ module Servant.API.Header,- -- | Retrieving parameters from the query string of the 'URI': @'QueryParam'@+ -- | Retrieving specific headers from the request module Servant.API.QueryParam,- -- | Accessing the request body as a JSON-encoded type: @'ReqBody'@+ -- | Retrieving parameters from the query string of the 'URI': @'QueryParam'@ module Servant.API.ReqBody,- -- | Retrieving matrix parameters from the 'URI' segment: @'MatrixParam'@+ -- | Accessing the request body as a JSON-encoded type: @'ReqBody'@ module Servant.API.MatrixParam,+ -- | Retrieving matrix parameters from the 'URI' segment: @'MatrixParam'@ -- * Actual endpoints, distinguished by HTTP method- -- | GET requests module Servant.API.Get,- -- | POST requests+ -- | @GET@ requests module Servant.API.Post,- -- | DELETE requests+ -- | @POST@ requests module Servant.API.Delete,- -- | PUT requests+ -- | @DELETE@ requests module Servant.API.Put,+ -- | @PUT@ requests+ module Servant.API.Patch,+ -- | @PATCH@ requests + -- * Content Types+ module Servant.API.ContentTypes,+ -- | Serializing and deserializing types based on @Accept@ and+ -- @Content-Type@ headers.++ -- * Response Headers+ module Servant.API.ResponseHeaders,+ -- * Untyped endpoints- -- | Plugging in a wai 'Network.Wai.Application', serving directories module Servant.API.Raw,+ -- | Plugging in a wai 'Network.Wai.Application', serving directories + -- * FromText and ToText+ module Servant.Common.Text,+ -- | Classes and instances for types that can be converted to and from @Text@+ -- * Utilities- -- | QuasiQuotes for endpoints- module Servant.QQ,- -- | Type-safe internal URLs module Servant.Utils.Links,+ -- | Type-safe internal URIs ) where -import Servant.API.Alternative ( (:<|>)(..) )-import Servant.API.Capture ( Capture )-import Servant.API.Delete ( Delete )-import Servant.API.Get ( Get )-import Servant.API.Header ( Header )-import Servant.API.Post ( Post )-import Servant.API.Put ( Put )-import Servant.API.QueryParam ( QueryFlag, QueryParams, QueryParam )-import Servant.API.MatrixParam ( MatrixFlag, MatrixParams, MatrixParam )-import Servant.API.Raw ( Raw )-import Servant.API.ReqBody ( ReqBody )-import Servant.API.Sub ( (:>)(..) )-import Servant.QQ ( sitemap )-import Servant.Utils.Links ( mkLink )+import Servant.API.Alternative ((:<|>) (..))+import Servant.API.Capture (Capture)+import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,+ FromFormUrlEncoded (..), JSON,+ MimeRender (..),+ MimeUnrender (..), OctetStream,+ PlainText, ToFormUrlEncoded (..))+import Servant.API.Delete (Delete)+import Servant.API.Get (Get)+import Servant.API.Header (Header (..))+import Servant.API.MatrixParam (MatrixFlag, MatrixParam,+ MatrixParams)+import Servant.API.Patch (Patch)+import Servant.API.Post (Post)+import Servant.API.Put (Put)+import Servant.API.QueryParam (QueryFlag, QueryParam,+ QueryParams)+import Servant.API.Raw (Raw)+import Servant.API.ReqBody (ReqBody)+import Servant.API.ResponseHeaders (AddHeader (addHeader),+ BuildHeadersTo (buildHeadersTo),+ GetHeaders (getHeaders),+ HList (..), Headers (..),+ getHeadersHList, getResponse)+import Servant.API.Sub ((:>))+import Servant.Common.Text (FromText (..), ToText (..))+import Servant.Utils.Links (HasLink (..), IsElem, IsElem',+ URI (..), safeLink)+
src/Servant/API/Alternative.hs view
@@ -1,11 +1,32 @@-{-# LANGUAGE TypeOperators #-}-module Servant.API.Alternative where+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_HADDOCK not-home #-}+module Servant.API.Alternative ((:<|>)(..)) where +#if !MIN_VERSION_base(4,8,0)+import Data.Monoid (Monoid (..))+#endif+import Data.Typeable (Typeable) -- | Union of two APIs, first takes precedence in case of overlap. -- -- Example: ----- > type MyApi = "books" :> Get [Book] -- GET /books--- > :<|> "books" :> ReqBody Book :> Post Book -- POST /books+-- >>> :{+--type MyApi = "books" :> Get '[JSON] [Book] -- GET /books+-- :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] () -- POST /books+-- :} data a :<|> b = a :<|> b+ deriving (Typeable, Eq, Show) infixr 8 :<|>++instance (Monoid a, Monoid b) => Monoid (a :<|> b) where+ mempty = mempty :<|> mempty+ (a :<|> b) `mappend` (a' :<|> b') = (a `mappend` a') :<|> (b `mappend` b')++-- $setup+-- >>> import Servant.API+-- >>> import Data.Aeson+-- >>> import Data.Text+-- >>> data Book+-- >>> instance ToJSON Book where { toJSON = undefined }
src/Servant/API/Capture.hs view
@@ -1,10 +1,22 @@-{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE PolyKinds #-}+{-# OPTIONS_HADDOCK not-home #-} module Servant.API.Capture (Capture) where +import Data.Typeable (Typeable)+import GHC.TypeLits (Symbol) -- | Capture a value from the request path under a certain type @a@. -- -- Example:------ > -- GET /books/:isbn--- > type MyApi = "books" :> Capture "isbn" Text :> Get Book-data Capture sym a+-- >>> -- GET /books/:isbn+-- >>> type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book+data Capture (sym :: Symbol) a+ deriving (Typeable)++-- $setup+-- >>> import Servant.API+-- >>> import Data.Aeson+-- >>> import Data.Text+-- >>> data Book+-- >>> instance ToJSON Book where { toJSON = undefined }
+ src/Servant/API/ContentTypes.hs view
@@ -0,0 +1,375 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_HADDOCK not-home #-}++-- | A collection of basic Content-Types (also known as Internet Media+-- Types, or MIME types). Additionally, this module provides classes that+-- encapsulate how to serialize or deserialize values to or from+-- a particular Content-Type.+--+-- Content-Types are used in `ReqBody` and the method combinators:+--+-- >>> type MyEndpoint = ReqBody '[JSON, PlainText] Book :> Get '[JSON, PlainText] :> Book+--+-- Meaning the endpoint accepts requests of Content-Type @application/json@+-- or @text/plain;charset-utf8@, and returns data in either one of those+-- formats (depending on the @Accept@ header).+--+-- If you would like to support Content-Types beyond those provided here,+-- then:+--+-- (1) Declare a new data type with no constructors (e.g. @data HTML@).+-- (2) Make an instance of it for `Accept`.+-- (3) If you want to be able to serialize data *into* that+-- Content-Type, make an instance of it for `MimeRender`.+-- (4) If you want to be able to deserialize data *from* that+-- Content-Type, make an instance of it for `MimeUnrender`.+--+-- Note that roles are reversed in @servant-server@ and @servant-client@:+-- to be able to serve (or even typecheck) a @Get '[JSON, XML] MyData@,+-- you'll need to have the appropriate `MimeRender` instances in scope,+-- whereas to query that endpoint with @servant-client@, you'll need+-- a `MimeUnrender` instance in scope.+module Servant.API.ContentTypes+ (+ -- * Provided Content-Types+ JSON+ , PlainText+ , FormUrlEncoded+ , OctetStream++ -- * Building your own Content-Type+ , Accept(..)+ , MimeRender(..)+ , MimeUnrender(..)++ -- * Internal+ , AcceptHeader(..)+ , AllCTRender(..)+ , AllCTUnrender(..)+ , AllMimeRender(..)+ , AllMimeUnrender(..)+ , FromFormUrlEncoded(..)+ , ToFormUrlEncoded(..)+ , IsNonEmpty+ , eitherDecodeLenient+ ) where++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<*))+#endif+import Control.Arrow (left)+import Control.Monad+import Data.Aeson (FromJSON, ToJSON, Value,+ encode, parseJSON)+import Data.Aeson.Parser (value)+import Data.Aeson.Types (parseEither)+import Data.Attoparsec.ByteString (endOfInput, parseOnly)+import qualified Data.ByteString as BS+import Data.ByteString.Lazy (ByteString, fromStrict, toStrict)+import qualified Data.ByteString.Lazy as B+import Data.Monoid+import Data.String.Conversions (cs)+import qualified Data.Text as TextS+import qualified Data.Text.Encoding as TextS+import qualified Data.Text.Lazy as TextL+import qualified Data.Text.Lazy.Encoding as TextL+import Data.Typeable+import GHC.Exts (Constraint)+import qualified Network.HTTP.Media as M+import Network.URI (escapeURIString, isUnreserved,+ unEscapeString)++-- * Provided content types+data JSON deriving Typeable+data PlainText deriving Typeable+data FormUrlEncoded deriving Typeable+data OctetStream deriving Typeable++-- * Accept class++-- | Instances of 'Accept' represent mimetypes. They are used for matching+-- against the @Accept@ HTTP header of the request, and for setting the+-- @Content-Type@ header of the response+--+-- Example:+--+-- >>> import Network.HTTP.Media ((//), (/:))+-- >>> data HTML+-- >>> :{+--instance Accept HTML where+-- contentType _ = "text" // "html" /: ("charset", "utf-8")+-- :}+--+class Accept ctype where+ contentType :: Proxy ctype -> M.MediaType++-- | @application/json@+instance Accept JSON where+ contentType _ = "application" M.// "json"++-- | @application/x-www-form-urlencoded@+instance Accept FormUrlEncoded where+ contentType _ = "application" M.// "x-www-form-urlencoded"++-- | @text/plain;charset=utf-8@+instance Accept PlainText where+ contentType _ = "text" M.// "plain" M./: ("charset", "utf-8")++-- | @application/octet-stream@+instance Accept OctetStream where+ contentType _ = "application" M.// "octet-stream"++newtype AcceptHeader = AcceptHeader BS.ByteString+ deriving (Eq, Show)++-- * Render (serializing)++-- | Instantiate this class to register a way of serializing a type based+-- on the @Accept@ header.+--+-- Example:+--+-- > data MyContentType+-- >+-- > instance Accept MyContentType where+-- > contentType _ = "example" // "prs.me.mine" /: ("charset", "utf-8")+-- >+-- > instance Show a => MimeRender MyContentType where+-- > mimeRender _ val = pack ("This is MINE! " ++ show val)+-- >+-- > type MyAPI = "path" :> Get '[MyContentType] Int+--+class Accept ctype => MimeRender ctype a where+ mimeRender :: Proxy ctype -> a -> ByteString++class AllCTRender (list :: [*]) a where+ -- If the Accept header can be matched, returns (Just) a tuple of the+ -- Content-Type and response (serialization of @a@ into the appropriate+ -- mimetype).+ handleAcceptH :: Proxy list -> AcceptHeader -> a -> Maybe (ByteString, ByteString)++instance ( AllMimeRender ctyps a, IsNonEmpty ctyps+ ) => AllCTRender ctyps a where+ handleAcceptH _ (AcceptHeader accept) val = M.mapAcceptMedia lkup accept+ where pctyps = Proxy :: Proxy ctyps+ amrs = allMimeRender pctyps val+ lkup = fmap (\(a,b) -> (a, (cs $ show a, b))) amrs+++--------------------------------------------------------------------------+-- * Unrender++-- | Instantiate this class to register a way of deserializing a type based+-- on the request's @Content-Type@ header.+--+-- >>> import Network.HTTP.Media hiding (Accept)+-- >>> import qualified Data.ByteString.Lazy.Char8 as BSC+-- >>> data MyContentType = MyContentType String+--+-- >>> :{+--instance Accept MyContentType where+-- contentType _ = "example" // "prs.me.mine" /: ("charset", "utf-8")+-- :}+--+-- >>> :{+--instance Read a => MimeUnrender MyContentType a where+-- mimeUnrender _ bs = case BSC.take 12 bs of+-- "MyContentType" -> return . read . BSC.unpack $ BSC.drop 12 bs+-- _ -> Left "didn't start with the magic incantation"+-- :}+--+-- >>> type MyAPI = "path" :> ReqBody '[MyContentType] Int :> Get '[JSON] Int+--+class Accept ctype => MimeUnrender ctype a where+ mimeUnrender :: Proxy ctype -> ByteString -> Either String a++class (IsNonEmpty list) => AllCTUnrender (list :: [*]) a where+ handleCTypeH :: Proxy list+ -> ByteString -- Content-Type header+ -> ByteString -- Request body+ -> Maybe (Either String a)++instance ( AllMimeUnrender ctyps a, IsNonEmpty ctyps+ ) => AllCTUnrender ctyps a where+ handleCTypeH _ ctypeH body = M.mapContentMedia lkup (cs ctypeH)+ where lkup = allMimeUnrender (Proxy :: Proxy ctyps) body++--------------------------------------------------------------------------+-- * Utils (Internal)+++--------------------------------------------------------------------------+-- Check that all elements of list are instances of MimeRender+--------------------------------------------------------------------------+class AllMimeRender (list :: [*]) a where+ allMimeRender :: Proxy list+ -> a -- value to serialize+ -> [(M.MediaType, ByteString)] -- content-types/response pairs++instance ( MimeRender ctyp a ) => AllMimeRender '[ctyp] a where+ allMimeRender _ a = [(contentType pctyp, mimeRender pctyp a)]+ where pctyp = Proxy :: Proxy ctyp++instance ( MimeRender ctyp a+ , AllMimeRender (ctyp' ': ctyps) a+ ) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where+ allMimeRender _ a = (contentType pctyp, mimeRender pctyp a)+ :(allMimeRender pctyps a)+ where pctyp = Proxy :: Proxy ctyp+ pctyps = Proxy :: Proxy (ctyp' ': ctyps)+++instance AllMimeRender '[] a where+ allMimeRender _ _ = []++--------------------------------------------------------------------------+-- Check that all elements of list are instances of MimeUnrender+--------------------------------------------------------------------------+class AllMimeUnrender (list :: [*]) a where+ allMimeUnrender :: Proxy list+ -> ByteString+ -> [(M.MediaType, Either String a)]++instance AllMimeUnrender '[] a where+ allMimeUnrender _ _ = []++instance ( MimeUnrender ctyp a+ , AllMimeUnrender ctyps a+ ) => AllMimeUnrender (ctyp ': ctyps) a where+ allMimeUnrender _ val = (contentType pctyp, mimeUnrender pctyp val)+ :(allMimeUnrender pctyps val)+ where pctyp = Proxy :: Proxy ctyp+ pctyps = Proxy :: Proxy ctyps++type family IsNonEmpty (list :: [*]) :: Constraint where+ IsNonEmpty (x ': xs) = ()+++--------------------------------------------------------------------------+-- * MimeRender Instances++-- | `encode`+instance ToJSON a => MimeRender JSON a where+ mimeRender _ = encode++-- | @encodeFormUrlEncoded . toFormUrlEncoded@+-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only+-- holds if every element of x is non-null (i.e., not @("", "")@)+instance ToFormUrlEncoded a => MimeRender FormUrlEncoded a where+ mimeRender _ = encodeFormUrlEncoded . toFormUrlEncoded++-- | `TextL.encodeUtf8`+instance MimeRender PlainText TextL.Text where+ mimeRender _ = TextL.encodeUtf8++-- | @fromStrict . TextS.encodeUtf8@+instance MimeRender PlainText TextS.Text where+ mimeRender _ = fromStrict . TextS.encodeUtf8++-- | @id@+instance MimeRender OctetStream ByteString where+ mimeRender _ = id++-- | `fromStrict`+instance MimeRender OctetStream BS.ByteString where+ mimeRender _ = fromStrict+++--------------------------------------------------------------------------+-- * MimeUnrender Instances++-- | Like 'Data.Aeson.eitherDecode' but allows all JSON values instead of just+-- objects and arrays.+eitherDecodeLenient :: FromJSON a => ByteString -> Either String a+eitherDecodeLenient input = do+ v :: Value <- parseOnly (Data.Aeson.Parser.value <* endOfInput) (cs input)+ parseEither parseJSON v++-- | `eitherDecode`+instance FromJSON a => MimeUnrender JSON a where+ mimeUnrender _ = eitherDecodeLenient++-- | @decodeFormUrlEncoded >=> fromFormUrlEncoded@+-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only+-- holds if every element of x is non-null (i.e., not @("", "")@)+instance FromFormUrlEncoded a => MimeUnrender FormUrlEncoded a where+ mimeUnrender _ = decodeFormUrlEncoded >=> fromFormUrlEncoded++-- | @left show . TextL.decodeUtf8'@+instance MimeUnrender PlainText TextL.Text where+ mimeUnrender _ = left show . TextL.decodeUtf8'++-- | @left show . TextS.decodeUtf8' . toStrict@+instance MimeUnrender PlainText TextS.Text where+ mimeUnrender _ = left show . TextS.decodeUtf8' . toStrict++-- | @Right . id@+instance MimeUnrender OctetStream ByteString where+ mimeUnrender _ = Right . id++-- | @Right . toStrict@+instance MimeUnrender OctetStream BS.ByteString where+ mimeUnrender _ = Right . toStrict+++--------------------------------------------------------------------------+-- * FormUrlEncoded++-- | A type that can be converted to @application/x-www-form-urlencoded@+class ToFormUrlEncoded a where+ toFormUrlEncoded :: a -> [(TextS.Text, TextS.Text)]++instance ToFormUrlEncoded [(TextS.Text, TextS.Text)] where+ toFormUrlEncoded = id++-- | A type that can be converted from @application/x-www-form-urlencoded@,+-- with the possibility of failure.+class FromFormUrlEncoded a where+ fromFormUrlEncoded :: [(TextS.Text, TextS.Text)] -> Either String a++instance FromFormUrlEncoded [(TextS.Text, TextS.Text)] where+ fromFormUrlEncoded = return++encodeFormUrlEncoded :: [(TextS.Text, TextS.Text)] -> ByteString+encodeFormUrlEncoded xs =+ let escape :: TextS.Text -> ByteString+ escape = cs . escapeURIString isUnreserved . cs+ encodePair :: (TextS.Text, TextS.Text) -> ByteString+ encodePair (k, "") = escape k+ encodePair (k, v) = escape k <> "=" <> escape v+ in B.intercalate "&" $ map encodePair xs++decodeFormUrlEncoded :: ByteString -> Either String [(TextS.Text, TextS.Text)]+decodeFormUrlEncoded "" = return []+decodeFormUrlEncoded q = do+ let xs :: [TextS.Text]+ xs = TextS.splitOn "&" . cs $ q+ parsePair :: TextS.Text -> Either String (TextS.Text, TextS.Text)+ parsePair p =+ case TextS.splitOn "=" p of+ [k,v] -> return ( unescape k+ , unescape v+ )+ [k] -> return ( unescape k, "" )+ _ -> Left $ "not a valid pair: " <> cs p+ unescape :: TextS.Text -> TextS.Text+ unescape = cs . unEscapeString . cs . TextS.intercalate "%20" . TextS.splitOn "+"+ mapM parsePair xs++-- $setup+-- >>> import Servant.API+-- >>> import Data.Aeson+-- >>> import Data.Text+-- >>> data Book+-- >>> instance ToJSON Book where { toJSON = undefined }
src/Servant/API/Delete.hs view
@@ -1,5 +1,8 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-}-module Servant.API.Delete where+{-# LANGUAGE KindSignatures #-}+{-# OPTIONS_HADDOCK not-home #-}+module Servant.API.Delete (Delete) where import Data.Typeable ( Typeable ) @@ -7,7 +10,15 @@ -- -- Example: ----- > -- DELETE /books/:isbn--- > type MyApi = "books" :> Capture "isbn" Text :> Delete-data Delete+-- >>> -- DELETE /books/:isbn+-- >>> type MyApi = "books" :> Capture "isbn" Text :> Delete+data Delete (contentTypes :: [*]) a deriving Typeable+++-- $setup+-- >>> import Servant.API+-- >>> import Data.Aeson+-- >>> import Data.Text+-- >>> data Book+-- >>> instance ToJSON Book where { toJSON = undefined }
src/Servant/API/Get.hs view
@@ -1,12 +1,22 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-}-module Servant.API.Get where+{-# LANGUAGE KindSignatures #-}+{-# OPTIONS_HADDOCK not-home #-}+module Servant.API.Get (Get) where -import Data.Typeable ( Typeable )+import Data.Typeable (Typeable) -- | Endpoint for simple GET requests. Serves the result as JSON. -- -- Example: ----- > type MyApi = "books" :> Get [Book]-data Get a+-- >>> type MyApi = "books" :> Get '[JSON] [Book]+data Get (contentTypes :: [*]) a deriving Typeable++-- $setup+-- >>> import Servant.API+-- >>> import Data.Aeson+-- >>> import Data.Text+-- >>> data Book+-- >>> instance ToJSON Book where { toJSON = undefined }
src/Servant/API/Header.hs view
@@ -1,13 +1,30 @@-{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE PolyKinds #-}+{-# OPTIONS_HADDOCK not-home #-} module Servant.API.Header where +import Data.ByteString (ByteString)+import Data.Typeable (Typeable)+import GHC.TypeLits (Symbol) -- | Extract the given header's value as a value of type @a@. -- -- Example: ----- > newtype Referer = Referer Text--- > deriving (Eq, Show, FromText, ToText)--- >--- > -- GET /view-my-referer--- > type MyApi = "view-my-referer" :> Header "from" Referer :> Get Referer-data Header sym a+-- >>> newtype Referer = Referer Text deriving (Eq, Show)+-- >>>+-- >>> -- GET /view-my-referer+-- >>> type MyApi = "view-my-referer" :> Header "from" Referer :> Get '[JSON] Referer+data Header (sym :: Symbol) a = Header a+ | MissingHeader+ | UndecodableHeader ByteString+ deriving (Typeable, Eq, Show, Functor)++-- $setup+-- >>> import Servant.API+-- >>> import Servant.Common.Text+-- >>> import Data.Aeson+-- >>> import Data.Text+-- >>> data Book+-- >>> instance ToJSON Book where { toJSON = undefined }
src/Servant/API/MatrixParam.hs view
@@ -1,14 +1,20 @@-{-# LANGUAGE PolyKinds #-}-module Servant.API.MatrixParam where+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE PolyKinds #-}+{-# OPTIONS_HADDOCK not-home #-}+module Servant.API.MatrixParam (MatrixFlag, MatrixParam, MatrixParams) where +import Data.Typeable (Typeable)+import GHC.TypeLits (Symbol) -- | Lookup the value associated to the @sym@ matrix string parameter -- and try to extract it as a value of type @a@. -- -- Example: ----- > -- /books;author=<author name>--- > type MyApi = "books" :> MatrixParam "author" Text :> Get [Book]-data MatrixParam sym a+-- >>> -- /books;author=<author name>+-- >>> type MyApi = "books" :> MatrixParam "author" Text :> Get '[JSON] [Book]+data MatrixParam (sym :: Symbol) a+ deriving (Typeable) -- | Lookup the values associated to the @sym@ matrix string parameter -- and try to extract it as a value of type @[a]@. This is typically@@ -19,9 +25,10 @@ -- -- Example: ----- > -- /books;authors[]=<author1>;authors[]=<author2>;...--- > type MyApi = "books" :> MatrixParams "authors" Text :> Get [Book]-data MatrixParams sym a+-- >>> -- /books;authors[]=<author1>;authors[]=<author2>;...+-- >>> type MyApi = "books" :> MatrixParams "authors" Text :> Get '[JSON] [Book]+data MatrixParams (sym :: Symbol) a+ deriving (Typeable) -- | Lookup a potentially value-less matrix string parameter -- with boolean semantics. If the param @sym@ is there without any value,@@ -30,6 +37,15 @@ -- -- Example: ----- > -- /books;published--- > type MyApi = "books" :> MatrixFlag "published" :> Get [Book]-data MatrixFlag sym+-- >>> -- /books;published+-- >>> type MyApi = "books" :> MatrixFlag "published" :> Get '[JSON] [Book]+data MatrixFlag (sym :: Symbol)+ deriving (Typeable)+++-- $setup+-- >>> import Servant.API+-- >>> import Data.Aeson+-- >>> import Data.Text+-- >>> data Book+-- >>> instance ToJSON Book where { toJSON = undefined }
+ src/Servant/API/Patch.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE KindSignatures #-}+{-# OPTIONS_HADDOCK not-home #-}+module Servant.API.Patch (Patch) where++import Data.Typeable (Typeable)++-- | Endpoint for PATCH requests. The type variable represents the type of the+-- response body (not the request body, use 'Servant.API.ReqBody.ReqBody' for+-- that).+--+-- If the HTTP response is empty, only () is supported.+--+-- Example:+--+-- >>> -- PATCH /books+-- >>> -- with a JSON encoded Book as the request body+-- >>> -- returning the just-created Book+-- >>> type MyApi = "books" :> ReqBody '[JSON] Book :> Patch '[JSON] Book+data Patch (contentTypes :: [*]) a+ deriving Typeable++-- $setup+-- >>> import Servant.API+-- >>> import Data.Aeson+-- >>> import Data.Text+-- >>> data Book+-- >>> instance ToJSON Book where { toJSON = undefined }
src/Servant/API/Post.hs view
@@ -1,7 +1,10 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-}-module Servant.API.Post where+{-# LANGUAGE KindSignatures #-}+{-# OPTIONS_HADDOCK not-home #-}+module Servant.API.Post (Post) where -import Data.Typeable ( Typeable )+import Data.Typeable (Typeable) -- | Endpoint for POST requests. The type variable represents the type of the -- response body (not the request body, use 'Servant.API.ReqBody.ReqBody' for@@ -9,9 +12,16 @@ -- -- Example: ----- > -- POST /books--- > -- with a JSON encoded Book as the request body--- > -- returning the just-created Book--- > type MyApi = "books" :> ReqBody Book :> Post Book-data Post a+-- >>> -- POST /books+-- >>> -- with a JSON encoded Book as the request body+-- >>> -- returning the just-created Book+-- >>> type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book+data Post (contentTypes :: [*]) a deriving Typeable++-- $setup+-- >>> import Servant.API+-- >>> import Data.Aeson+-- >>> import Data.Text+-- >>> data Book+-- >>> instance ToJSON Book where { toJSON = undefined }
src/Servant/API/Put.hs view
@@ -1,5 +1,8 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-}-module Servant.API.Put where+{-# LANGUAGE KindSignatures #-}+{-# OPTIONS_HADDOCK not-home #-}+module Servant.API.Put (Put) where import Data.Typeable ( Typeable ) @@ -8,8 +11,15 @@ -- -- Example: ----- > -- PUT /books/:isbn--- > -- with a Book as request body, returning the updated Book--- > type MyApi = "books" :> Capture "isbn" Text :> ReqBody Book :> Put Book-data Put a+-- >>> -- PUT /books/:isbn+-- >>> -- with a Book as request body, returning the updated Book+-- >>> type MyApi = "books" :> Capture "isbn" Text :> ReqBody '[JSON] Book :> Put '[JSON] Book+data Put (contentTypes :: [*]) a deriving Typeable++-- $setup+-- >>> import Servant.API+-- >>> import Data.Aeson+-- >>> import Data.Text+-- >>> data Book+-- >>> instance ToJSON Book where { toJSON = undefined }
src/Servant/API/QueryParam.hs view
@@ -1,14 +1,21 @@-{-# LANGUAGE PolyKinds #-}-module Servant.API.QueryParam where+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE PolyKinds #-}+{-# OPTIONS_HADDOCK not-home #-}+module Servant.API.QueryParam (QueryFlag, QueryParam, QueryParams) where +import Data.Typeable (Typeable)+import GHC.TypeLits (Symbol) -- | Lookup the value associated to the @sym@ query string parameter -- and try to extract it as a value of type @a@. -- -- Example: ----- > -- /books?author=<author name>--- > type MyApi = "books" :> QueryParam "author" Text :> Get [Book]-data QueryParam sym a+-- >>> -- /books?author=<author name>+-- >>> type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]+data QueryParam (sym :: Symbol) a+ deriving Typeable -- | Lookup the values associated to the @sym@ query string parameter -- and try to extract it as a value of type @[a]@. This is typically@@ -19,9 +26,10 @@ -- -- Example: ----- > -- /books?authors[]=<author1>&authors[]=<author2>&...--- > type MyApi = "books" :> QueryParams "authors" Text :> Get [Book]-data QueryParams sym a+-- >>> -- /books?authors[]=<author1>&authors[]=<author2>&...+-- >>> type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]+data QueryParams (sym :: Symbol) a+ deriving Typeable -- | Lookup a potentially value-less query string parameter -- with boolean semantics. If the param @sym@ is there without any value,@@ -30,6 +38,13 @@ -- -- Example: ----- > -- /books?published--- > type MyApi = "books" :> QueryFlag "published" :> Get [Book]-data QueryFlag sym+-- >>> -- /books?published+-- >>> type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book]+data QueryFlag (sym :: Symbol)++-- $setup+-- >>> import Servant.API+-- >>> import Data.Aeson+-- >>> import Data.Text+-- >>> data Book+-- >>> instance ToJSON Book where { toJSON = undefined }
src/Servant/API/Raw.hs view
@@ -1,5 +1,8 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# OPTIONS_HADDOCK not-home #-} 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@@ -7,6 +10,5 @@ -- -- In addition to just letting you plug in your existing WAI 'Application's, -- 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+-- static files stored in a particular directory on your filesystem+data Raw deriving Typeable
src/Servant/API/ReqBody.hs view
@@ -1,10 +1,23 @@-{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE PolyKinds #-}+{-# OPTIONS_HADDOCK not-home #-} module Servant.API.ReqBody where +import Data.Typeable (Typeable) -- | Extract the request body as a value of type @a@. -- -- Example: ----- > -- POST /books--- > type MyApi = "books" :> ReqBody Book :> Post Book-data ReqBody a+-- >>> -- POST /books+-- >>> type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book+data ReqBody (contentTypes :: [*]) a+ deriving (Typeable)++-- $setup+-- >>> import Servant.API+-- >>> import Servant.Common.Text+-- >>> import Data.Aeson+-- >>> import Data.Text+-- >>> data Book+-- >>> instance ToJSON Book where { toJSON = undefined }
+ src/Servant/API/ResponseHeaders.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+#if !MIN_VERSION_base(4,8,0)+{-# LANGUAGE OverlappingInstances #-}+#endif+{-# OPTIONS_HADDOCK not-home #-}++-- | This module provides facilities for adding headers to a response.+--+-- >>> let headerVal = addHeader "some-url" 5 :: Headers '[Header "Location" String] Int+--+-- The value is added to the header specified by the type (@Location@ in the+-- example above).+module Servant.API.ResponseHeaders+ ( Headers(..)+ , AddHeader(addHeader)+ , BuildHeadersTo(buildHeadersTo)+ , GetHeaders(getHeaders)+ , HeaderValMap+ , HList(..)+ ) where++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>))+#endif+import Data.ByteString.Char8 as BS (pack, unlines, init)+import Data.ByteString.Conversion (ToByteString, toByteString',+ FromByteString, fromByteString)+import qualified Data.CaseInsensitive as CI+import Data.Proxy+import GHC.TypeLits (KnownSymbol, symbolVal)+import qualified Network.HTTP.Types.Header as HTTP++import Servant.API.Header (Header (..))++-- | Response Header objects. You should never need to construct one directly.+-- Instead, use 'addHeader'.+data Headers ls a = Headers { getResponse :: a+ -- ^ The underlying value of a 'Headers'+ , getHeadersHList :: HList ls+ -- ^ HList of headers.+ } deriving (Functor)++data HList a where+ HNil :: HList '[]+ HCons :: Header h x -> HList xs -> HList (Header h x ': xs)++type family HeaderValMap (f :: * -> *) (xs :: [*]) where+ HeaderValMap f '[] = '[]+ HeaderValMap f (Header h x ': xs) = Header h (f x) ': (HeaderValMap f xs)+++class BuildHeadersTo hs where+ buildHeadersTo :: [HTTP.Header] -> HList hs+ -- ^ Note: if there are multiple occurences of a header in the argument,+ -- the values are interspersed with commas before deserialization (see+ -- <http://www.w3.org/Protocols/rfc2616/rfc2616-sec4.html#sec4.2 RFC2616 Sec 4.2>)++instance+#if MIN_VERSION_base(4,8,0)+ {-# OVERLAPPING #-}+#endif+ BuildHeadersTo '[] where+ buildHeadersTo _ = HNil++instance+#if MIN_VERSION_base(4,8,0)+ {-# OVERLAPPABLE #-}+#endif+ ( FromByteString v, BuildHeadersTo xs, KnownSymbol h, Contains h xs ~ 'False+ ) => BuildHeadersTo ((Header h v) ': xs) where+ buildHeadersTo headers =+ let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h)+ matching = snd <$> filter (\(h, _) -> h == wantedHeader) headers+ in case matching of+ [] -> MissingHeader `HCons` buildHeadersTo headers+ xs -> case fromByteString (BS.init $ BS.unlines xs) of+ Nothing -> UndecodableHeader (BS.init $ BS.unlines xs)+ `HCons` buildHeadersTo headers+ Just h -> Header h `HCons` buildHeadersTo headers++-- * Getting++class GetHeaders ls where+ getHeaders :: ls -> [HTTP.Header]++instance+#if MIN_VERSION_base(4,8,0)+ {-# OVERLAPPING #-}+#endif+ GetHeaders (HList '[]) where+ getHeaders _ = []++instance+#if MIN_VERSION_base(4,8,0)+ {-# OVERLAPPABLE #-}+#endif+ ( KnownSymbol h, ToByteString x, GetHeaders (HList xs)+ ) => GetHeaders (HList (Header h x ': xs)) where+ getHeaders hdrs = case hdrs of+ Header val `HCons` rest -> (headerName , toByteString' val):getHeaders rest+ UndecodableHeader h `HCons` rest -> (headerName, h) : getHeaders rest+ MissingHeader `HCons` rest -> getHeaders rest+ where headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)++instance+#if MIN_VERSION_base(4,8,0)+ {-# OVERLAPPING #-}+#endif+ GetHeaders (Headers '[] a) where+ getHeaders _ = []++instance+#if MIN_VERSION_base(4,8,0)+ {-# OVERLAPPABLE #-}+#endif+ ( KnownSymbol h, GetHeaders (HList rest), ToByteString v+ ) => GetHeaders (Headers (Header h v ': rest) a) where+ getHeaders hs = getHeaders $ getHeadersHList hs++-- * Adding++-- We need all these fundeps to save type inference+class AddHeader h v orig new+ | h v orig -> new, new -> h, new -> v, new -> orig where+ addHeader :: v -> orig -> new -- ^ N.B.: The same header can't be added multiple times+++instance+#if MIN_VERSION_base(4,8,0)+ {-# OVERLAPPING #-}+#endif+ ( KnownSymbol h, ToByteString v, Contains h (fst ': rest) ~ 'False+ ) => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where+ addHeader a (Headers resp heads) = Headers resp (HCons (Header a) heads)++instance+#if MIN_VERSION_base(4,8,0)+ {-# OVERLAPPABLE #-}+#endif+ ( KnownSymbol h, ToByteString v+ , new ~ (Headers '[Header h v] a)+ ) => AddHeader h v a new where+ addHeader a resp = Headers resp (HCons (Header a) HNil)++type family Contains x xs where+ Contains x ((Header x a) ': xs) = 'True+ Contains x ((Header y a) ': xs) = Contains x xs+ Contains x '[] = 'False++-- $setup+-- >>> import Servant.API+-- >>> import Data.Aeson+-- >>> import Data.Text+-- >>> data Book+-- >>> instance ToJSON Book where { toJSON = undefined }
src/Servant/API/Sub.hs view
@@ -1,16 +1,27 @@-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE TypeOperators #-}-module Servant.API.Sub where+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_HADDOCK not-home #-}+module Servant.API.Sub ((:>)) where -import Data.Proxy ( Proxy )+import Data.Typeable (Typeable) -- | The contained API (second argument) can be found under @("/" ++ path)@ -- (path being the first argument). -- -- Example: ----- > -- GET /hello/world--- > -- returning a JSON encoded World value--- > type MyApi = "hello" :> "world" :> Get World-data (path :: k) :> a = Proxy path :> a+-- >>> -- GET /hello/world+-- >>> -- returning a JSON encoded World value+-- >>> type MyApi = "hello" :> "world" :> Get '[JSON] World+data (path :: k) :> a+ deriving (Typeable) infixr 9 :>++-- $setup+-- >>> import Servant.API+-- >>> import Servant.Common.Text+-- >>> import Data.Aeson+-- >>> import Data.Text+-- >>> data World+-- >>> instance ToJSON World where { toJSON = undefined }
src/Servant/Common/Text.hs view
@@ -1,22 +1,34 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} module Servant.Common.Text ( FromText(..) , ToText(..) ) where -import Data.String.Conversions ( cs )-import Data.Int ( Int8, Int16, Int32, Int64 )-import Data.Text ( Text )-import Data.Text.Read ( rational, signed, decimal, Reader )-import Data.Word ( Word, Word8, Word16, Word32, Word64 )+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>))+#endif+import Data.Int (Int16, Int32, Int64, Int8)+import Data.String.Conversions (cs)+import Data.Text (Text)+import Data.Text.Read (Reader, decimal, rational, signed)+import Data.Word (Word16, Word32, Word64, Word8+#if !MIN_VERSION_base(4,8,0)+ , Word+#endif+ ) -- | For getting values from url captures and query string parameters+-- Instances should obey:+-- > fromText (toText a) == Just a class FromText a where fromText :: Text -> Maybe a -- | For putting values in paths and query string parameters+-- Instances should obey:+-- > fromText (toText a) == Just a class ToText a where toText :: a -> Text @@ -33,17 +45,22 @@ toText = cs -- |--- > fromText "true" = Just True--- > fromText "false" = Just False--- > fromText _ = Nothing+-- >>> fromText ("true"::Text) :: Maybe Bool+-- Just True+-- >>> fromText ("false"::Text) :: Maybe Bool+-- Just False+-- >>> fromText ("anything else"::Text) :: Maybe Bool+-- Nothing instance FromText Bool where fromText "true" = Just True fromText "false" = Just False fromText _ = Nothing -- |--- > toText True = "true"--- > toText False = "false"+-- >>> toText True+-- "true"+-- >>> toText False+-- "false" instance ToText Bool where toText True = "true" toText False = "false"@@ -109,19 +126,21 @@ toText = cs . show instance FromText Integer where- fromText = runReader decimal+ fromText = runReader (signed decimal) instance ToText Integer where toText = cs . show instance FromText Double where- fromText = runReader rational+ fromText x = fromRational <$> runReader rational x instance ToText Double where toText = cs . show instance FromText Float where- fromText = runReader rational+ -- Double is more practically accurate due to weird rounding when using+ -- rational. We convert to double and then convert to Float.+ fromText x = fromRational <$> runReader rational x instance ToText Float where toText = cs . show
− src/Servant/QQ.hs
@@ -1,228 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}--- | QuasiQuoting utilities for API types.------ 'sitemap' allows you to write your type in a very natural way:------ @--- [sitemap|--- PUT hello String -> ()--- POST hello/p:Int String -> ()--- GET hello/?name:String Int--- |]--- @------ Will generate:------ @--- "hello" :> ReqBody String :> Put ()--- :\<|> "hello" :> Capture "p" Int :> ReqBody String :> Post ()--- :\<|> "hello" :> QueryParam "name" String :> Get Int--- @------ Note the @/@ before a @QueryParam@!-module Servant.QQ (sitemap) where--import Control.Monad ( void )-import Language.Haskell.TH.Quote ( QuasiQuoter(..) )-import Language.Haskell.TH- ( mkName, Type(AppT, ConT, LitT), TyLit(StrTyLit) )-import Text.ParserCombinators.Parsec- ( try,- Parser,- manyTill,- endBy,- sepBy1,- optional,- optionMaybe,- string,- anyChar,- char,- spaces,- noneOf,- parse,- skipMany,- many,- lookAhead,- (<|>),- (<?>) )-import Servant.API.Capture ( Capture )-import Servant.API.Get ( Get )-import Servant.API.Post ( Post )-import Servant.API.Put ( Put )-import Servant.API.Delete ( Delete )-import Servant.API.QueryParam ( QueryParam )-import Servant.API.MatrixParam ( MatrixParam )-import Servant.API.ReqBody ( ReqBody )-import Servant.API.Sub ( (:>) )-import Servant.API.Alternative ( (:<|>) )---- | Finally-tagless encoding for our DSL.--- Keeping 'repr'' and 'repr' distinct when writing functions with an--- @ExpSYM@ context ensures certain invariants (for instance, that there is--- only one of 'get', 'post', 'put', and 'delete' in a value), but--- sometimes requires a little more work.-class ExpSYM repr' repr | repr -> repr', repr' -> repr where- lit :: String -> repr' -> repr- capture :: String -> String -> repr -> repr- reqBody :: String -> repr -> repr- queryParam :: String -> String -> repr -> repr- matrixParam :: String -> String -> repr -> repr- conj :: repr' -> repr -> repr- get :: String -> repr- post :: String -> repr- put :: String -> repr- delete :: String -> repr---infixr 6 >:--(>:) :: Type -> Type -> Type-(>:) = conj---instance ExpSYM Type Type where- lit name r = LitT (StrTyLit name) >: r- capture name typ r = AppT (AppT (ConT ''Capture) (LitT (StrTyLit name)))- (ConT $ mkName typ) >: r- reqBody typ r = AppT (ConT ''ReqBody) (ConT $ mkName typ) >: r- queryParam name typ r = AppT (AppT (ConT ''QueryParam) (LitT (StrTyLit name)))- (ConT $ mkName typ) >: r- matrixParam name typ r = AppT (AppT (ConT ''MatrixParam) (LitT (StrTyLit name)))- (ConT $ mkName typ) >: r- conj x = AppT (AppT (ConT ''(:>)) x)- get typ = AppT (ConT ''Get) (ConT $ mkName typ)- post typ = AppT (ConT ''Post) (ConT $ mkName typ)- put typ = AppT (ConT ''Put) (ConT $ mkName typ)- delete "()" = ConT ''Delete- delete _ = error "Delete does not return a request body"--parseMethod :: ExpSYM repr' repr => Parser (String -> repr)-parseMethod = try (string "GET" >> return get)- <|> try (string "POST" >> return post)- <|> try (string "PUT" >> return put)- <|> try (string "DELETE" >> return delete)--parseUrlSegment :: ExpSYM repr repr => Parser (repr -> repr)-parseUrlSegment = try parseCapture- <|> try parseQueryParam- <|> try parseLit- where- parseCapture = do- cname <- many (noneOf " ?/:;")- char ':'- ctyp <- many (noneOf " ?/:;")- mx <- many parseMatrixParam- return $ capture cname ctyp . foldr (.) id mx- parseQueryParam = do- char '?'- cname <- many (noneOf " ?/:;")- char ':'- ctyp <- many (noneOf " ?/:;")- return $ queryParam cname ctyp- parseLit = do- lt <- many (noneOf " ?/:;")- mx <- many parseMatrixParam- return $ lit lt . foldr (.) id mx- parseMatrixParam = do- char ';'- cname <- many (noneOf " ?/:;")- char ':'- ctyp <- many (noneOf " ?/:;")- return $ matrixParam cname ctyp--parseUrl :: ExpSYM repr repr => Parser (repr -> repr)-parseUrl = do- optional $ char '/'- url <- parseUrlSegment `sepBy1` char '/'- return $ foldr1 (.) url--data Typ = Val String- | ReqArgVal String String--parseTyp :: Parser Typ-parseTyp = do- f <- many (noneOf "-{\n\r")- spaces- s <- optionMaybe (try parseRet)- try $ optional inlineComment- try $ optional blockComment- case s of- Nothing -> return $ Val (stripTr f)- Just s' -> return $ ReqArgVal (stripTr f) (stripTr s')- where- parseRet :: Parser String- parseRet = do- string "->"- spaces- many (noneOf "-{\n\r")- stripTr = reverse . dropWhile (== ' ') . reverse---parseEntry :: ExpSYM repr repr => Parser repr-parseEntry = do- met <- parseMethod- spaces- url <- parseUrl- spaces- typ <- parseTyp- case typ of- Val s -> return $ url (met s)- ReqArgVal i o -> return $ url $ reqBody i (met o)--blockComment :: Parser ()-blockComment = do- string "{-"- manyTill anyChar (try $ string "-}")- return ()--inlineComment :: Parser ()-inlineComment = do- string "--"- manyTill anyChar (try $ lookAhead eol)- return ()--eol :: Parser String-eol = try (string "\n\r")- <|> try (string "\r\n")- <|> string "\n"- <|> string "\r"- <?> "end of line"--eols :: Parser ()-eols = skipMany $ void eol <|> blockComment <|> inlineComment--parseAll :: Parser Type-parseAll = do- eols- entries <- parseEntry `endBy` eols- return $ foldr1 union entries- where union :: Type -> Type -> Type- union a = AppT (AppT (ConT ''(:<|>)) a)---- | The sitemap QuasiQuoter.------ * @.../<var>:<type>/...@ becomes a capture--- * @.../?<var>:<type>@ becomes a query parameter--- * @<method> ... <typ>@ becomes a method returning @<typ>@--- * @<method> ... <typ1> -> <typ2>@ becomes a method with request--- body of @<typ1>@ and returning @<typ2>@------ Comments are allowed, and have the standard Haskell format------ * @--@ for inline--- * @{- ... -}@ for block----sitemap :: QuasiQuoter-sitemap = QuasiQuoter { quoteExp = undefined- , quotePat = undefined- , quoteType = \x -> case parse parseAll "" x of- Left err -> error $ show err- Right st -> return st- , quoteDec = undefined- }
src/Servant/Utils/Links.hs view
@@ -1,131 +1,359 @@-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UndecidableInstances #-}--- | Type safe internal links.+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_HADDOCK not-home #-}++-- | Type safe generation of internal links. ----- Provides the function 'mkLink':+-- Given an API with a few endpoints: ----- @--- type API = Proxy ("hello" :> Get Int--- :<|> "bye" :> QueryParam "name" String :> Post Bool)+-- >>> :set -XDataKinds -XTypeFamilies -XTypeOperators+-- >>> import Servant.API+-- >>> import Servant.Utils.Links+-- >>> import Data.Proxy+-- >>>+-- >>>+-- >>>+-- >>> type Hello = "hello" :> Get '[JSON] Int+-- >>> type Bye = "bye" :> QueryParam "name" String :> Delete '[JSON] ()+-- >>> type API = Hello :<|> Bye+-- >>> let api = Proxy :: Proxy API ----- api :: API--- api = proxy+-- It is possible to generate links that are guaranteed to be within 'API' with+-- 'safeLink'. The first argument to 'safeLink' is a type representing the API+-- you would like to restrict links to. The second argument is the destination+-- endpoint you would like the link to point to, this will need to end with a+-- verb like GET or POST. Further arguments may be required depending on the+-- type of the endpoint. If everything lines up you will get a 'URI' out the+-- other end. ----- link1 :: Proxy ("hello" :> Get Int)--- link1 = proxy+-- You may omit 'QueryParam's and the like should you not want to provide them,+-- but types which form part of the URL path like 'Capture' must be included.+-- The reason you may want to omit 'QueryParam's is that safeLink is a bit+-- magical: if parameters are included that could take input it will return a+-- function that accepts that input and generates a link. This is best shown+-- with an example. Here, a link is generated with no parameters: ----- link2 :: Proxy ("hello" :> Delete)--- link2 = proxy+-- >>> let hello = Proxy :: Proxy ("hello" :> Get '[JSON] Int)+-- >>> print (safeLink api hello :: URI)+-- hello ----- mkLink link1 API -- typechecks, returns 'Link "/hello"'+-- If the API has an endpoint with parameters then we can generate links with+-- or without those: ----- mkLink link2 API -- doesn't typecheck--- @+-- >>> let with = Proxy :: Proxy ("bye" :> QueryParam "name" String :> Delete '[JSON] ())+-- >>> print $ safeLink api with "Hubert"+-- bye?name=Hubert ----- That is, 'mkLink' takes two arguments, a link proxy and a sitemap, and--- returns a 'Link', but only typechecks if the link proxy is a valid link,--- and part of the sitemap.+-- >>> let without = Proxy :: Proxy ("bye" :> Delete '[JSON] ())+-- >>> print $ safeLink api without+-- bye ----- __N.B.:__ 'mkLink' assumes a capture matches any string (without slashes).+-- If you would like create a helper for generating links only within that API,+-- you can partially apply safeLink if you specify a correct type signature+-- like so:+--+-- >>> :set -XConstraintKinds+-- >>> :{+-- >>> let apiLink :: (IsElem endpoint API, HasLink endpoint)+-- >>> => Proxy endpoint -> MkLink endpoint+-- >>> apiLink = safeLink api+-- >>> :}+--+-- Attempting to construct a link to an endpoint that does not exist in api+-- will result in a type error like this:+--+-- >>> let bad_link = Proxy :: Proxy ("hello" :> Delete '[JSON] ())+-- >>> safeLink api bad_link+-- <BLANKLINE>+-- <interactive>:64:1:+-- Could not deduce (Or+-- (IsElem' (Delete '[JSON] ()) (Get '[JSON] Int))+-- (IsElem'+-- ("hello" :> Delete '[JSON] ())+-- ("bye" :> (QueryParam "name" String :> Delete '[JSON] ()))))+-- arising from a use of ‘safeLink’+-- In the expression: safeLink api bad_link+-- In an equation for ‘it’: it = safeLink api bad_link+--+-- This error is essentially saying that the type family couldn't find+-- bad_link under api after trying the open (but empty) type family+-- `IsElem'` as a last resort. module Servant.Utils.Links (- -- * Link and mkLink- -- | The only end-user utilities- mkLink- , Link- -- * Internal- -- | These functions will likely only be of interest if you are writing- -- more API combinators and would like to extend the behavior of- -- 'mkLink'- , ValidLinkIn()- , VLinkHelper(..)- , IsElem- , IsLink- )where+ -- * Building and using safe links+ --+ -- | Note that 'URI' is Network.URI.URI from the network-uri package.+ safeLink+ , URI(..)+ -- * Adding custom types+ , HasLink(..)+ , linkURI+ , Link+ , IsElem'+ -- * Illustrative exports+ , IsElem+ , Or+) where +import Data.List import Data.Proxy ( Proxy(..) )-import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )+import Data.Text (Text, unpack)+#if !MIN_VERSION_base(4,8,0)+import Data.Monoid ( Monoid(..), (<>) )+#else+import Data.Monoid ( (<>) )+#endif+import Network.URI ( URI(..), escapeURIString, isUnreserved )+import GHC.TypeLits ( KnownSymbol, symbolVal )+import GHC.Exts(Constraint) +import Servant.Common.Text import Servant.API.Capture ( Capture ) import Servant.API.ReqBody ( ReqBody ) import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag ) import Servant.API.MatrixParam ( MatrixParam, MatrixParams, MatrixFlag )+import Servant.API.Header ( Header ) import Servant.API.Get ( Get ) import Servant.API.Post ( Post ) import Servant.API.Put ( Put ) import Servant.API.Delete ( Delete ) import Servant.API.Sub ( type (:>) )+import Servant.API.Raw ( Raw ) import Servant.API.Alternative ( type (:<|>) ) +-- | A safe link datatype.+-- The only way of constructing a 'Link' is using 'safeLink', which means any+-- 'Link' is guaranteed to be part of the mentioned API.+data Link = Link+ { _segments :: [String] -- ^ Segments of "foo/bar" would be ["foo", "bar"]+ , _queryParams :: [Param Query]+ } deriving Show -type family Or a b where- Or 'False 'False = 'False- Or 'True b = 'True- Or a 'True = 'True+-- | If either a or b produce an empty constraint, produce an empty constraint.+type family Or (a :: Constraint) (b :: Constraint) :: Constraint where+ Or () b = ()+ Or a () = () -type family And a b where- And 'True 'True = 'True- And a 'False = 'False- And 'False b = 'False+-- | If both a or b produce an empty constraint, produce an empty constraint.+type family And (a :: Constraint) (b :: Constraint) :: Constraint where+ And () () = () -type family IsElem a s where+-- | You may use this type family to tell the type checker that your custom type+-- may be skipped as part of a link. This is useful for things like+-- 'QueryParam' that are optional in a URI and do not affect them if they are+-- omitted.+--+-- >>> data CustomThing+-- >>> type instance IsElem' e (CustomThing :> s) = IsElem e s+--+-- Note that 'IsElem' is called, which will mutually recurse back to `IsElem'`+-- if it exhausts all other options again.+--+-- Once you have written a HasLink instance for CustomThing you are ready to+-- go.+type family IsElem' a s :: Constraint++-- | Closed type family, check if endpoint is within api+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 y x :> sb) = IsElem sa sb IsElem (e :> sa) (Capture x y :> sb) = IsElem sa sb- IsElem sa (ReqBody x :> 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 IsElem sa (MatrixParam x y :> sb) = IsElem sa sb IsElem sa (MatrixParams x y :> sb) = IsElem sa sb IsElem sa (MatrixFlag x :> sb) = IsElem sa sb- IsElem e e = 'True- IsElem e a = 'False+ IsElem (Get ct typ) (Get ct' typ) = IsSubList ct ct'+ IsElem (Post ct typ) (Post ct' typ) = IsSubList ct ct'+ IsElem (Put ct typ) (Put ct' typ) = IsSubList ct ct'+ IsElem (Delete ct typ) (Delete ct' typ) = IsSubList ct ct'+ IsElem e e = ()+ IsElem e a = IsElem' e a -type family IsLink'' l where- IsLink'' (e :> Get x) = IsLink' e- IsLink'' (e :> Post x) = IsLink' e- IsLink'' (e :> Put x) = IsLink' e- IsLink'' (e :> Delete) = IsLink' e- IsLink'' a = 'False -type family IsLink' e where- IsLink' (f :: Symbol) = 'True+type family IsSubList a b :: Constraint where+ IsSubList '[] b = ()+ IsSubList '[x] (x ': xs) = ()+ IsSubList '[x] (y ': ys) = IsSubList '[x] ys+ IsSubList (x ': xs) y = IsSubList '[x] y `And` IsSubList xs y -type family IsLink e where- IsLink (a :> b) = Or (And (IsLink' a) (IsLink'' b))- (IsLink'' (a :> b))+-- Phantom types for Param+data Matrix+data Query +-- | Query/Matrix param+data Param a+ = SingleParam String Text+ | ArrayElemParam String Text+ | FlagParam String+ deriving Show --- | The 'ValidLinkIn f s' constraint holds when 's' is an API that--- contains 'f', and 'f' is a link.-class ValidLinkIn f s where- mkLink :: f -> s -> Link -- ^ This function will only typecheck if `f`- -- is an URI within `s`+addSegment :: String -> Link -> Link+addSegment seg l = l { _segments = _segments l <> [seg] } -instance ( IsElem f s ~ 'True- , IsLink f ~ 'True- , VLinkHelper f) => ValidLinkIn f s where- mkLink _ _ = Link (vlh (Proxy :: Proxy f))+addQueryParam :: Param Query -> Link -> Link+addQueryParam qp l =+ l { _queryParams = _queryParams l <> [qp] } --- | A safe link datatype.--- The only way of constructing a 'Link' is using 'mkLink', which means any--- 'Link' is guaranteed to be part of the mentioned API.-data Link = Link String deriving Show+-- Not particularly efficient for many updates. Something to optimise if it's+-- a problem.+addMatrixParam :: Param Matrix -> Link -> Link+addMatrixParam param l = l { _segments = f (_segments l) }+ where+ f [] = []+ f xs = init xs <> [g (last xs)]+ -- Modify the segment at the "top" of the stack+ g :: String -> String+ g seg =+ case param of+ SingleParam k v -> seg <> ";" <> k <> "=" <> escape (unpack v)+ ArrayElemParam k v -> seg <> ";" <> k <> "[]=" <> escape (unpack v)+ FlagParam k -> seg <> ";" <> k -class VLinkHelper f where- vlh :: forall proxy. proxy f -> String+linkURI :: Link -> URI+linkURI (Link segments q_params) =+ URI mempty -- No scheme (relative)+ Nothing -- Or authority (relative)+ (intercalate "/" segments)+ (makeQueries q_params) mempty+ where+ makeQueries :: [Param Query] -> String+ makeQueries [] = ""+ makeQueries xs =+ "?" <> intercalate "&" (fmap makeQuery xs) -instance (KnownSymbol s, VLinkHelper e) => VLinkHelper (s :> e) where- vlh _ = "/" ++ symbolVal (Proxy :: Proxy s) ++ vlh (Proxy :: Proxy e)+ makeQuery :: Param Query -> String+ makeQuery (ArrayElemParam k v) = escape k <> "[]=" <> escape (unpack v)+ makeQuery (SingleParam k v) = escape k <> "=" <> escape (unpack v)+ makeQuery (FlagParam k) = escape k -instance VLinkHelper (Get x) where- vlh _ = ""+escape :: String -> String+escape = escapeURIString isUnreserved -instance VLinkHelper (Post x) where- vlh _ = ""+-- | Create a valid (by construction) relative URI with query params.+--+-- This function will only typecheck if `endpoint` is part of the API `api`+safeLink+ :: forall endpoint api. (IsElem endpoint api, HasLink endpoint)+ => Proxy api -- ^ The whole API that this endpoint is a part of+ -> Proxy endpoint -- ^ The API endpoint you would like to point to+ -> MkLink endpoint+safeLink _ endpoint = toLink endpoint (Link mempty mempty)++-- | Construct a toLink for an endpoint.+class HasLink endpoint where+ type MkLink endpoint+ toLink :: Proxy endpoint -- ^ The API endpoint you would like to point to+ -> Link+ -> MkLink endpoint++-- Naked symbol instance+instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where+ type MkLink (sym :> sub) = MkLink sub+ toLink _ =+ toLink (Proxy :: Proxy sub) . addSegment seg+ where+ seg = symbolVal (Proxy :: Proxy sym)+++-- QueryParam instances+instance (KnownSymbol sym, ToText v, HasLink sub)+ => HasLink (QueryParam sym v :> sub) where+ type MkLink (QueryParam sym v :> sub) = v -> MkLink sub+ toLink _ l v =+ toLink (Proxy :: Proxy sub)+ (addQueryParam (SingleParam k (toText v)) l)+ where+ k :: String+ k = symbolVal (Proxy :: Proxy sym)++instance (KnownSymbol sym, ToText v, HasLink sub)+ => HasLink (QueryParams sym v :> sub) where+ type MkLink (QueryParams sym v :> sub) = [v] -> MkLink sub+ toLink _ l =+ toLink (Proxy :: Proxy sub) .+ foldl' (\l' v -> addQueryParam (ArrayElemParam k (toText v)) l') l+ where+ k = symbolVal (Proxy :: Proxy sym)++instance (KnownSymbol sym, HasLink sub)+ => HasLink (QueryFlag sym :> sub) where+ type MkLink (QueryFlag sym :> sub) = Bool -> MkLink sub+ toLink _ l False =+ toLink (Proxy :: Proxy sub) l+ toLink _ l True =+ toLink (Proxy :: Proxy sub) $ addQueryParam (FlagParam k) l+ where+ k = symbolVal (Proxy :: Proxy sym)++-- MatrixParam instances+instance (KnownSymbol sym, ToText v, HasLink sub)+ => HasLink (MatrixParam sym v :> sub) where+ type MkLink (MatrixParam sym v :> sub) = v -> MkLink sub+ toLink _ l v =+ toLink (Proxy :: Proxy sub) $+ addMatrixParam (SingleParam k (toText v)) l+ where+ k = symbolVal (Proxy :: Proxy sym)++instance (KnownSymbol sym, ToText v, HasLink sub)+ => HasLink (MatrixParams sym v :> sub) where+ type MkLink (MatrixParams sym v :> sub) = [v] -> MkLink sub+ toLink _ l =+ toLink (Proxy :: Proxy sub) .+ foldl' (\l' v -> addMatrixParam (ArrayElemParam k (toText v)) l') l+ where+ k = symbolVal (Proxy :: Proxy sym)++instance (KnownSymbol sym, HasLink sub)+ => HasLink (MatrixFlag sym :> sub) where+ type MkLink (MatrixFlag sym :> sub) = Bool -> MkLink sub+ toLink _ l False =+ toLink (Proxy :: Proxy sub) l+ toLink _ l True =+ toLink (Proxy :: Proxy sub) $ addMatrixParam (FlagParam k) l+ where+ k = symbolVal (Proxy :: Proxy sym)++-- Misc instances+instance HasLink sub => HasLink (ReqBody ct a :> sub) where+ type MkLink (ReqBody ct a :> sub) = MkLink sub+ toLink _ = toLink (Proxy :: Proxy sub)++instance (ToText v, HasLink sub)+ => HasLink (Capture sym v :> sub) where+ type MkLink (Capture sym v :> sub) = v -> MkLink sub+ toLink _ l v =+ toLink (Proxy :: Proxy sub) $+ addSegment (escape . unpack $ toText v) l++-- Verb (terminal) instances+instance HasLink (Get y r) where+ type MkLink (Get y r) = URI+ toLink _ = linkURI++instance HasLink (Post y r) where+ type MkLink (Post y r) = URI+ toLink _ = linkURI++instance HasLink (Put y r) where+ type MkLink (Put y r) = URI+ toLink _ = linkURI++instance HasLink (Delete y r) where+ type MkLink (Delete y r) = URI+ toLink _ = linkURI++instance HasLink Raw where+ type MkLink Raw = URI+ toLink _ = linkURI
+ test/Doctests.hs view
@@ -0,0 +1,16 @@+module Main where++import System.FilePath.Find+import Test.DocTest++main :: IO ()+main = do+ files <- find always (extension ==? ".hs") "src"+ doctest $ [ "-isrc"+ , "-optP-include"+ , "-optPdist/build/autogen/cabal_macros.h"+ , "-XOverloadedStrings"+ , "-XFlexibleInstances"+ , "-XMultiParamTypeClasses"+ ] ++ files+