diff --git a/servant-docs/example/greet.hs b/servant-docs/example/greet.hs index 50051258..e94e065b 100644 --- a/servant-docs/example/greet.hs +++ b/servant-docs/example/greet.hs @@ -46,13 +46,6 @@ instance ToParam (QueryParam "capital" Bool) where \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 toSamples _ = [ ("If you use ?capital=true", Greet "HELLO, HASKELLER") @@ -81,7 +74,7 @@ intro2 = DocIntro "This title is below the last" -- 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 + "hello" :> 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 diff --git a/servant-docs/example/greet.md b/servant-docs/example/greet.md index 16ab9782..67e1a666 100644 --- a/servant-docs/example/greet.md +++ b/servant-docs/example/greet.md @@ -1,10 +1,10 @@ -#### On proper introductions. +## On proper introductions. Hello there. 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. @@ -19,12 +19,13 @@ You'll also note that multiple intros are possible. - Example: `application/json` ```javascript -"Hello, haskeller!" +"HELLO, HASKELLER" ``` #### Response: - Status code 201 +- Headers: [("X-Example","1729")] - Supported content types are: @@ -42,22 +43,44 @@ You'll also note that multiple intros are possible. "Hello, haskeller" ``` -## GET /hello;lang=/: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: - *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: - capital @@ -68,6 +91,7 @@ You'll also note that multiple intros are possible. #### Response: - Status code 200 +- Headers: [] - Supported content types are: @@ -98,27 +122,4 @@ You'll also note that multiple intros are possible. "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 - diff --git a/servant-docs/src/Servant/Docs.hs b/servant-docs/src/Servant/Docs.hs index ac908c96..2f081127 100644 --- a/servant-docs/src/Servant/Docs.hs +++ b/servant-docs/src/Servant/Docs.hs @@ -20,126 +20,7 @@ -- The only thing you'll need to do will be to implement some classes -- for your captures, get parameters and request or response bodies. -- --- Here is a complete example that you can run to see the markdown pretty --- 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 +-- See example/greet.hs for an example. module Servant.Docs ( -- * 'HasDocs' class and key functions HasDocs(..), docs, markdown diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index f02d8ac5..53ae472d 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -24,8 +24,7 @@ module Servant.Docs.Internal where import Control.Applicative import Control.Arrow (second) import Control.Lens (makeLenses, over, traversed, (%~), - (&), (.~), (<>~), (^.), _1, _2, - _last, (|>)) + (&), (.~), (<>~), (^.), (|>)) import qualified Control.Monad.Omega as Omega import Data.ByteString.Conversion (ToByteString, toByteString) import Data.ByteString.Lazy.Char8 (ByteString) @@ -546,7 +545,6 @@ markdown api = unlines $ "" : notesStr (action ^. notes) ++ capturesStr (action ^. captures) ++ - mxParamsStr (action ^. mxParams) ++ headersStr (action ^. headers) ++ paramsStr (action ^. params) ++ rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++ @@ -590,20 +588,6 @@ markdown api = unlines $ captureStr cap = "- *" ++ (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 [] = [] headersStr l = [""] ++ map headerStr l ++ [""] @@ -898,48 +882,6 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout) 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 ++ "=") 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 ++ "="]) 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 docsFor _proxy (endpoint, action) _ = single endpoint action diff --git a/servant-foreign/src/Servant/Foreign.hs b/servant-foreign/src/Servant/Foreign.hs index d5ea0e29..49ef540d 100644 --- a/servant-foreign/src/Servant/Foreign.hs +++ b/servant-foreign/src/Servant/Foreign.hs @@ -20,7 +20,6 @@ module Servant.Foreign ( HasForeign(..) , Segment(..) , SegmentType(..) - , MatrixArg , FunctionName , QueryArg(..) , HeaderArg(..) @@ -47,15 +46,14 @@ module Servant.Foreign , module Servant.API ) where -import Control.Lens (makeLenses, (%~), (&), (.~), - (<>~), _last) -import Data.Monoid ((<>)) -import Data.Text -import Data.Proxy -import GHC.Exts (Constraint) -import GHC.TypeLits -import Servant.API -import Prelude hiding (concat) +import Control.Lens (makeLenses, (%~), (&), (.~), (<>~)) +import Data.Monoid ((<>)) +import Data.Proxy +import Data.Text +import GHC.Exts (Constraint) +import GHC.TypeLits +import Prelude hiding (concat) +import Servant.API -- | Function name builder that simply concat each part together concatCase :: FunctionName -> Text @@ -76,7 +74,7 @@ camelCase (p:ps) = concat $ p : camelCase' ps type Arg = Text -data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] } +newtype Segment = Segment { _segment :: SegmentType } deriving (Eq, Show) data SegmentType = Static Text -- ^ a static path segment. like "/foo" @@ -105,8 +103,6 @@ data HeaderArg = HeaderArg } deriving (Eq, Show) -type MatrixArg = QueryArg - data Url = Url { _path :: Path , _queryStr :: [QueryArg] @@ -132,12 +128,12 @@ makeLenses ''Url makeLenses ''Req isCapture :: Segment -> Bool -isCapture (Segment (Cap _) _) = True -isCapture _ = False +isCapture (Segment (Cap _)) = True +isCapture _ = False captureArg :: Segment -> Arg -captureArg (Segment (Cap s) _) = s -captureArg _ = error "captureArg called on non capture" +captureArg (Segment (Cap s)) = s +captureArg _ = error "captureArg called on non capture" defReq :: Req defReq = Req defUrl "GET" [] False [] @@ -169,7 +165,7 @@ instance (KnownSymbol sym, HasForeign sublayout) foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ - req & reqUrl.path <>~ [Segment (Cap str) []] + req & reqUrl.path <>~ [Segment (Cap str)] & funcName %~ (++ ["by", str]) where str = pack . symbolVal $ (Proxy :: Proxy sym) @@ -242,37 +238,6 @@ instance (KnownSymbol sym, HasForeign sublayout) 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 type Foreign Raw = Method -> Req @@ -293,7 +258,7 @@ instance (KnownSymbol path, HasForeign sublayout) foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ - req & reqUrl.path <>~ [Segment (Static str) []] + req & reqUrl.path <>~ [Segment (Static str)] & funcName %~ (++ [str]) where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path) diff --git a/servant-js/src/Servant/JS/Internal.hs b/servant-js/src/Servant/JS/Internal.hs index c53124f7..a5cb527c 100644 --- a/servant-js/src/Servant/JS/Internal.hs +++ b/servant-js/src/Servant/JS/Internal.hs @@ -9,7 +9,6 @@ module Servant.JS.Internal , segmentTypeToStr , jsParams , jsGParams - , jsMParams , paramToStr , toValidFunctionName , toJSHeader @@ -92,7 +91,7 @@ toValidFunctionName :: Text -> Text toValidFunctionName t = case T.uncons t of Just (x,xs) -> - setFirstChar x `T.cons` T.filter remainder xs + setFirstChar x `T.cons` T.filter remainder xs Nothing -> "_" where setFirstChar c = if firstChar c then c else '_' @@ -105,7 +104,7 @@ toValidFunctionName t = , Set.titlecaseLetter , Set.modifierLetter , Set.otherLetter - , Set.letterNumber + , Set.letterNumber ] remainderOK = firstLetterOK <> mconcat @@ -134,8 +133,8 @@ jsSegments [x] = "/" <> segmentToStr x False jsSegments (x:xs) = "/" <> segmentToStr x True <> jsSegments xs segmentToStr :: Segment -> Bool -> Text -segmentToStr (Segment st ms) notTheEnd = - segmentTypeToStr st <> jsMParams ms <> if notTheEnd then "" else "'" +segmentToStr (Segment st) notTheEnd = + segmentTypeToStr st <> if notTheEnd then "" else "'" segmentTypeToStr :: SegmentType -> Text segmentTypeToStr (Static s) = s @@ -149,10 +148,6 @@ jsGParams s (x:xs) = paramToStr x True <> s <> jsGParams s xs jsParams :: [QueryArg] -> Text jsParams = jsGParams "&" -jsMParams :: [MatrixArg] -> Text -jsMParams [] = "" -jsMParams xs = ";" <> jsGParams ";" xs - paramToStr :: QueryArg -> Bool -> Text paramToStr qarg notTheEnd = case qarg ^. argType of diff --git a/servant-mock/src/Servant/Mock.hs b/servant-mock/src/Servant/Mock.hs index bbd24b0e..3fa5d077 100644 --- a/servant-mock/src/Servant/Mock.hs +++ b/servant-mock/src/Servant/Mock.hs @@ -136,17 +136,6 @@ instance (KnownSymbol s, FromHttpApiData a, HasMock rest) instance (KnownSymbol s, HasMock rest) => HasMock (QueryFlag s :> rest) where 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 mock _ = \_ -> mock (Proxy :: Proxy rest)