eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Remove Matrix params.

Browse source 
For servant-docs, -foreign, -js, and -mock.
This commit is contained in:
Julian K. Arni 2015-10-08 23:33:32 +02:00
parent afc76b8f6c
commit ec55f4b981
7 changed files with 60 additions and 294 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
servant-docs/example/greet.hs
View file

@ -46,13 +46,6 @@ instance ToParam (QueryParam "capital" Bool) where
\Default is false." \Default is false."
Normal Normal
instance ToParam (MatrixParam "lang" String) where
toParam _ =
DocQueryParam "lang"
["en", "sv", "fr"]
"Get the greeting message selected language. Default is en."
Normal
instance ToSample Greet where instance ToSample Greet where
toSamples _ = toSamples _ =
[ ("If you use ?capital=true", Greet "HELLO, HASKELLER") [ ("If you use ?capital=true", Greet "HELLO, HASKELLER")
@ -81,7 +74,7 @@ intro2 = DocIntro "This title is below the last"
-- API specification -- API specification
type TestApi = type TestApi =
-- GET /hello/:name?capital={true, false} returns a Greet as JSON or PlainText -- GET /hello/:name?capital={true, false} returns a Greet as JSON or PlainText
"hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet
-- POST /greet with a Greet as JSON in the request body, -- POST /greet with a Greet as JSON in the request body,
-- returns a Greet as JSON -- returns a Greet as JSON

75
servant-docs/example/greet.md
View file

@ -1,10 +1,10 @@
#### On proper introductions. ## On proper introductions.
Hello there. Hello there.
As documentation is usually written for humans, it's often useful to introduce concepts with a few words. As documentation is usually written for humans, it's often useful to introduce concepts with a few words.
#### This title is below the last ## This title is below the last
You'll also note that multiple intros are possible. You'll also note that multiple intros are possible.
@ -19,12 +19,13 @@ You'll also note that multiple intros are possible.
- Example: `application/json` - Example: `application/json`
```javascript ```javascript
"Hello, haskeller!" "HELLO, HASKELLER"
``` ```
#### Response: #### Response:
- Status code 201 - Status code 201
- Headers: [("X-Example","1729")]
- Supported content types are: - Supported content types are:
@ -42,22 +43,44 @@ You'll also note that multiple intros are possible.
"Hello, haskeller" "Hello, haskeller"
``` ```
## GET /hello;lang=<value>/:name ## DELETE /greet/:greetid
#### Title
This is some text
#### Second secton
And some more
#### Captures:
- *greetid*: identifier of the greet msg to remove
- This endpoint is sensitive to the value of the **unicorns** HTTP header.
#### Response:
- Status code 200
- Headers: []
- Supported content types are:
- `application/json`
- Response body as below.
```javascript
[]
```
## GET /hello/:name
#### Captures: #### Captures:
- *name*: name of the person to greet - *name*: name of the person to greet
#### Matrix Parameters:
**hello**:
- lang
- **Values**: *en, sv, fr*
- **Description**: Get the greeting message selected language. Default is en.
#### GET Parameters: #### GET Parameters:
- capital - capital
@ -68,6 +91,7 @@ You'll also note that multiple intros are possible.
#### Response: #### Response:
- Status code 200 - Status code 200
- Headers: []
- Supported content types are: - Supported content types are:
@ -98,27 +122,4 @@ You'll also note that multiple intros are possible.
"Hello, haskeller" "Hello, haskeller"
``` ```
## DELETE /greet/:greetid
#### Title
This is some text
#### Second secton
And some more
#### Captures:
- *greetid*: identifier of the greet msg to remove
- This endpoint is sensitive to the value of the **unicorns** HTTP header.
#### Response:
- Status code 200
- No response body

121
servant-docs/src/Servant/Docs.hs
View file

@ -20,126 +20,7 @@
-- The only thing you'll need to do will be to implement some classes -- The only thing you'll need to do will be to implement some classes
-- for your captures, get parameters and request or response bodies. -- for your captures, get parameters and request or response bodies.
-- --
-- Here is a complete example that you can run to see the markdown pretty -- See example/greet.hs for an example.
-- printer in action:
--
-- > {-# LANGUAGE DataKinds #-}
-- > {-# LANGUAGE DeriveGeneric #-}
-- > {-# LANGUAGE FlexibleInstances #-}
-- > {-# LANGUAGE MultiParamTypeClasses #-}
-- > {-# LANGUAGE OverloadedStrings #-}
-- > {-# LANGUAGE TypeOperators #-}
-- > {-# OPTIONS_GHC -fno-warn-orphans #-}
-- > import Control.Lens
-- > import Data.Aeson
-- > import Data.Proxy
-- > import Data.String.Conversions
-- > import Data.Text (Text)
-- > import GHC.Generics
-- > import Servant.API
-- > import Servant.Docs
-- >
-- > -- * Example
-- >
-- > -- | A greet message data type
-- > newtype Greet = Greet Text
-- > deriving (Generic, Show)
-- >
-- > -- | We can get JSON support automatically. This will be used to parse
-- > -- and encode a Greeting as 'JSON'.
-- > instance FromJSON Greet
-- > instance ToJSON Greet
-- >
-- > -- | We can also implement 'MimeRender' for additional formats like 'PlainText'.
-- > instance MimeRender PlainText Greet where
-- > mimeRender Proxy (Greet s) = "\"" <> cs s <> "\""
-- >
-- > -- We add some useful annotations to our captures,
-- > -- query parameters and request body to make the docs
-- > -- really helpful.
-- > instance ToCapture (Capture "name" Text) where
-- > toCapture _ = DocCapture "name" "name of the person to greet"
-- >
-- > instance ToCapture (Capture "greetid" Text) where
-- > toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove"
-- >
-- > instance ToParam (QueryParam "capital" Bool) where
-- > toParam _ =
-- > DocQueryParam "capital"
-- > ["true", "false"]
-- > "Get the greeting message in uppercase (true) or not (false).\
-- > \Default is false."
-- > Normal
-- >
-- > instance ToParam (MatrixParam "lang" String) where
-- > toParam _ =
-- > DocQueryParam "lang"
-- > ["en", "sv", "fr"]
-- > "Get the greeting message selected language. Default is en."
-- > Normal
-- >
-- > instance ToSample Greet where
-- > toSample _ = Just $ Greet "Hello, haskeller!"
-- >
-- > toSamples _ =
-- > [ ("If you use ?capital=true", Greet "HELLO, HASKELLER")
-- > , ("If you use ?capital=false", Greet "Hello, haskeller")
-- > ]
-- >
-- > -- We define some introductory sections, these will appear at the top of the
-- > -- documentation.
-- > --
-- > -- We pass them in with 'docsWith', below. If you only want to add
-- > -- introductions, you may use 'docsWithIntros'
-- > intro1 :: DocIntro
-- > intro1 = DocIntro "On proper introductions." -- The title
-- > [ "Hello there."
-- > , "As documentation is usually written for humans, it's often useful \
-- > \to introduce concepts with a few words." ] -- Elements are paragraphs
-- >
-- > intro2 :: DocIntro
-- > intro2 = DocIntro "This title is below the last"
-- > [ "You'll also note that multiple intros are possible." ]
-- >
-- >
-- > -- API specification
-- > type TestApi =
-- > -- GET /hello/:name?capital={true, false} returns a Greet as JSON or PlainText
-- > "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet
-- >
-- > -- POST /greet with a Greet as JSON in the request body,
-- > -- returns a Greet as JSON
-- > :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet
-- >
-- > -- DELETE /greet/:greetid
-- > :<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] ()
-- >
-- > testApi :: Proxy TestApi
-- > testApi = Proxy
-- >
-- > -- Build some extra information for the DELETE /greet/:greetid endpoint. We
-- > -- want to add documentation about a secret unicorn header and some extra
-- > -- notes.
-- > extra :: ExtraInfo TestApi
-- > extra =
-- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete '[JSON] ())) $
-- > defAction & headers <>~ ["unicorns"]
-- > & notes <>~ [ DocNote "Title" ["This is some text"]
-- > , DocNote "Second secton" ["And some more"]
-- > ]
-- >
-- > -- Generate the data that lets us have API docs. This
-- > -- is derived from the type as well as from
-- > -- the 'ToCapture', 'ToParam' and 'ToSample' instances from above.
-- > --
-- > -- If you didn't want intros and extra information, you could just call:
-- > --
-- > -- > docs testAPI :: API
-- > docsGreet :: API
-- > docsGreet = docsWith [intro1, intro2] extra testApi
-- >
-- > main :: IO ()
-- > main = putStrLn $ markdown docsGreet
module Servant.Docs module Servant.Docs
( -- * 'HasDocs' class and key functions ( -- * 'HasDocs' class and key functions
HasDocs(..), docs, markdown HasDocs(..), docs, markdown

60
servant-docs/src/Servant/Docs/Internal.hs
View file

@ -24,8 +24,7 @@ module Servant.Docs.Internal where
import Control.Applicative import Control.Applicative
import Control.Arrow (second) import Control.Arrow (second)
import Control.Lens (makeLenses, over, traversed, (%~), import Control.Lens (makeLenses, over, traversed, (%~),
(&), (.~), (<>~), (^.), _1, _2, (&), (.~), (<>~), (^.), (|>))
_last, (|>))
import qualified Control.Monad.Omega as Omega import qualified Control.Monad.Omega as Omega
import Data.ByteString.Conversion (ToByteString, toByteString) import Data.ByteString.Conversion (ToByteString, toByteString)
import Data.ByteString.Lazy.Char8 (ByteString) import Data.ByteString.Lazy.Char8 (ByteString)
@ -546,7 +545,6 @@ markdown api = unlines $
"" : "" :
notesStr (action ^. notes) ++ notesStr (action ^. notes) ++
capturesStr (action ^. captures) ++ capturesStr (action ^. captures) ++
mxParamsStr (action ^. mxParams) ++
headersStr (action ^. headers) ++ headersStr (action ^. headers) ++
paramsStr (action ^. params) ++ paramsStr (action ^. params) ++
rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++ rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++
@ -590,20 +588,6 @@ markdown api = unlines $
captureStr cap = captureStr cap =
"- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc) "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)
mxParamsStr :: [(String, [DocQueryParam])] -> [String]
mxParamsStr [] = []
mxParamsStr l =
"#### Matrix Parameters:" :
"" :
map segmentStr l
segmentStr :: (String, [DocQueryParam]) -> String
segmentStr (segment, l) = unlines $
("**" ++ segment ++ "**:") :
"" :
map paramStr l ++
"" :
[]
headersStr :: [Text] -> [String] headersStr :: [Text] -> [String]
headersStr [] = [] headersStr [] = []
headersStr l = [""] ++ map headerStr l ++ [""] headersStr l = [""] ++ map headerStr l ++ [""]
@ -898,48 +882,6 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout)
action' = over params (|> toParam paramP) action action' = over params (|> toParam paramP) action
instance (KnownSymbol sym, ToParam (MatrixParam sym a), HasDocs sublayout)
=> HasDocs (MatrixParam sym a :> sublayout) where
docsFor Proxy (endpoint, action) =
docsFor sublayoutP (endpoint', action')
where sublayoutP = Proxy :: Proxy sublayout
paramP = Proxy :: Proxy (MatrixParam sym a)
segment = endpoint ^. (path._last)
segment' = action ^. (mxParams._last._1)
endpoint' = over (path._last) (\p -> p ++ ";" ++ symbolVal symP ++ "=<value>") endpoint
action' = if segment' /= segment
-- This is the first matrix parameter for this segment, insert a new entry into the mxParams list
then over mxParams (|> (segment, [toParam paramP])) action
-- We've already inserted a matrix parameter for this segment, append to the existing list
else action & mxParams._last._2 <>~ [toParam paramP]
symP = Proxy :: Proxy sym
instance (KnownSymbol sym, {- ToParam (MatrixParams sym a), -} HasDocs sublayout)
=> HasDocs (MatrixParams sym a :> sublayout) where
docsFor Proxy (endpoint, action) =
docsFor sublayoutP (endpoint', action)
where sublayoutP = Proxy :: Proxy sublayout
endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP ++ "=<value>"]) endpoint
symP = Proxy :: Proxy sym
instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout)
=> HasDocs (MatrixFlag sym :> sublayout) where
docsFor Proxy (endpoint, action) =
docsFor sublayoutP (endpoint', action)
where sublayoutP = Proxy :: Proxy sublayout
endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP]) endpoint
symP = Proxy :: Proxy sym
instance HasDocs Raw where instance HasDocs Raw where
docsFor _proxy (endpoint, action) _ = docsFor _proxy (endpoint, action) _ =
single endpoint action single endpoint action

51
servant-foreign/src/Servant/Foreign.hs
View file

@ -20,7 +20,6 @@ module Servant.Foreign
( HasForeign(..) ( HasForeign(..)
, Segment(..) , Segment(..)
, SegmentType(..) , SegmentType(..)
, MatrixArg
, FunctionName , FunctionName
, QueryArg(..) , QueryArg(..)
, HeaderArg(..) , HeaderArg(..)
@ -47,15 +46,14 @@ module Servant.Foreign
, module Servant.API , module Servant.API
) where ) where
import Control.Lens (makeLenses, (%~), (&), (.~), import Control.Lens (makeLenses, (%~), (&), (.~), (<>~))
(<>~), _last)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.Text
import Data.Proxy import Data.Proxy
import Data.Text
import GHC.Exts (Constraint) import GHC.Exts (Constraint)
import GHC.TypeLits import GHC.TypeLits
import Servant.API
import Prelude hiding (concat) import Prelude hiding (concat)
import Servant.API
-- | Function name builder that simply concat each part together -- | Function name builder that simply concat each part together
concatCase :: FunctionName -> Text concatCase :: FunctionName -> Text
@ -76,7 +74,7 @@ camelCase (p:ps) = concat $ p : camelCase' ps
type Arg = Text type Arg = Text
data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] } newtype Segment = Segment { _segment :: SegmentType }
deriving (Eq, Show) deriving (Eq, Show)
data SegmentType = Static Text -- ^ a static path segment. like "/foo" data SegmentType = Static Text -- ^ a static path segment. like "/foo"
@ -105,8 +103,6 @@ data HeaderArg = HeaderArg
} deriving (Eq, Show) } deriving (Eq, Show)
type MatrixArg = QueryArg
data Url = Url data Url = Url
{ _path :: Path { _path :: Path
, _queryStr :: [QueryArg] , _queryStr :: [QueryArg]
@ -132,11 +128,11 @@ makeLenses ''Url
makeLenses ''Req makeLenses ''Req
isCapture :: Segment -> Bool isCapture :: Segment -> Bool
isCapture (Segment (Cap _) _) = True isCapture (Segment (Cap _)) = True
isCapture _ = False isCapture _ = False
captureArg :: Segment -> Arg captureArg :: Segment -> Arg
captureArg (Segment (Cap s) _) = s captureArg (Segment (Cap s)) = s
captureArg _ = error "captureArg called on non capture" captureArg _ = error "captureArg called on non capture"
defReq :: Req defReq :: Req
@ -169,7 +165,7 @@ instance (KnownSymbol sym, HasForeign sublayout)
foreignFor Proxy req = foreignFor Proxy req =
foreignFor (Proxy :: Proxy sublayout) $ foreignFor (Proxy :: Proxy sublayout) $
req & reqUrl.path <>~ [Segment (Cap str) []] req & reqUrl.path <>~ [Segment (Cap str)]
& funcName %~ (++ ["by", str]) & funcName %~ (++ ["by", str])
where str = pack . symbolVal $ (Proxy :: Proxy sym) where str = pack . symbolVal $ (Proxy :: Proxy sym)
@ -242,37 +238,6 @@ instance (KnownSymbol sym, HasForeign sublayout)
where str = pack . symbolVal $ (Proxy :: Proxy sym) where str = pack . symbolVal $ (Proxy :: Proxy sym)
instance (KnownSymbol sym, HasForeign sublayout)
=> HasForeign (MatrixParam sym a :> sublayout) where
type Foreign (MatrixParam sym a :> sublayout) = Foreign sublayout
foreignFor Proxy req =
foreignFor (Proxy :: Proxy sublayout) $
req & reqUrl.path._last.matrix <>~ [QueryArg strArg Normal]
where str = pack . symbolVal $ (Proxy :: Proxy sym)
strArg = str <> "Value"
instance (KnownSymbol sym, HasForeign sublayout)
=> HasForeign (MatrixParams sym a :> sublayout) where
type Foreign (MatrixParams sym a :> sublayout) = Foreign sublayout
foreignFor Proxy req =
foreignFor (Proxy :: Proxy sublayout) $
req & reqUrl.path._last.matrix <>~ [QueryArg str List]
where str = pack . symbolVal $ (Proxy :: Proxy sym)
instance (KnownSymbol sym, HasForeign sublayout)
=> HasForeign (MatrixFlag sym :> sublayout) where
type Foreign (MatrixFlag sym :> sublayout) = Foreign sublayout
foreignFor Proxy req =
foreignFor (Proxy :: Proxy sublayout) $
req & reqUrl.path._last.matrix <>~ [QueryArg str Flag]
where str = pack . symbolVal $ (Proxy :: Proxy sym)
instance HasForeign Raw where instance HasForeign Raw where
type Foreign Raw = Method -> Req type Foreign Raw = Method -> Req
@ -293,7 +258,7 @@ instance (KnownSymbol path, HasForeign sublayout)
foreignFor Proxy req = foreignFor Proxy req =
foreignFor (Proxy :: Proxy sublayout) $ foreignFor (Proxy :: Proxy sublayout) $
req & reqUrl.path <>~ [Segment (Static str) []] req & reqUrl.path <>~ [Segment (Static str)]
& funcName %~ (++ [str]) & funcName %~ (++ [str])
where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path) where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path)

9
servant-js/src/Servant/JS/Internal.hs
View file

@ -9,7 +9,6 @@ module Servant.JS.Internal
, segmentTypeToStr , segmentTypeToStr
, jsParams , jsParams
, jsGParams , jsGParams
, jsMParams
, paramToStr , paramToStr
, toValidFunctionName , toValidFunctionName
, toJSHeader , toJSHeader
@ -134,8 +133,8 @@ jsSegments [x] = "/" <> segmentToStr x False
jsSegments (x:xs) = "/" <> segmentToStr x True <> jsSegments xs jsSegments (x:xs) = "/" <> segmentToStr x True <> jsSegments xs
segmentToStr :: Segment -> Bool -> Text segmentToStr :: Segment -> Bool -> Text
segmentToStr (Segment st ms) notTheEnd = segmentToStr (Segment st) notTheEnd =
segmentTypeToStr st <> jsMParams ms <> if notTheEnd then "" else "'" segmentTypeToStr st <> if notTheEnd then "" else "'"
segmentTypeToStr :: SegmentType -> Text segmentTypeToStr :: SegmentType -> Text
segmentTypeToStr (Static s) = s segmentTypeToStr (Static s) = s
@ -149,10 +148,6 @@ jsGParams s (x:xs) = paramToStr x True <> s <> jsGParams s xs
jsParams :: [QueryArg] -> Text jsParams :: [QueryArg] -> Text
jsParams = jsGParams "&" jsParams = jsGParams "&"
jsMParams :: [MatrixArg] -> Text
jsMParams [] = ""
jsMParams xs = ";" <> jsGParams ";" xs
paramToStr :: QueryArg -> Bool -> Text paramToStr :: QueryArg -> Bool -> Text
paramToStr qarg notTheEnd = paramToStr qarg notTheEnd =
case qarg ^. argType of case qarg ^. argType of

11
servant-mock/src/Servant/Mock.hs
View file

@ -136,17 +136,6 @@ instance (KnownSymbol s, FromHttpApiData a, HasMock rest)
instance (KnownSymbol s, HasMock rest) => HasMock (QueryFlag s :> rest) where instance (KnownSymbol s, HasMock rest) => HasMock (QueryFlag s :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest) mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol s, FromHttpApiData a, HasMock rest)
=> HasMock (MatrixParam s a :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol s, FromHttpApiData a, HasMock rest)
=> HasMock (MatrixParams s a :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol s, HasMock rest) => HasMock (MatrixFlag s :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol h, FromHttpApiData a, HasMock rest) => HasMock (Header h a :> rest) where instance (KnownSymbol h, FromHttpApiData a, HasMock rest) => HasMock (Header h a :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest) mock _ = \_ -> mock (Proxy :: Proxy rest)