82ff0a6 · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

added Servant.Utils.StaticFiles.serveDocumentation

82ff0a6Sönke Hahn12 years ago

servant.cabal+1

compare with master

unifiedsplit

@@ -53,6 +53,7 @@ library

53 , transformers

54 , template-haskell

55 , text

56+ , system-filepath

56 , lens

57 , lens

57 , unordered-containers

58 , unordered-containers

58 , hashable

59 , hashable

src/Servant/API/Raw.hs+5

@@ -4,6 +4,7 @@ module Servant.API.Raw where

5import Data.Proxy

6import Network.Wai

7+import Servant.Docs

7import Servant.Server

8import Servant.Server

9-- | Endpoint for plugging in your own Wai 'Application's.

10-- | Endpoint for plugging in your own Wai 'Application's.

@@ -16,3 +17,7 @@ instance HasServer Raw where

16 type Server Raw = Application

17 type Server Raw = Application

17 route Proxy rawApplication request respond =

18 route Proxy rawApplication request respond =

18 rawApplication request (respond . succeedWith)

19 rawApplication request (respond . succeedWith)

20+

21+instance HasDocs Raw where

22+ docsFor _proxy (endpoint, action) =

23+ single endpoint action

src/Servant/Docs.hs+69−59

@@ -85,7 +85,7 @@

85-- > main = printMarkdown greetDocs

86module Servant.Docs

87 ( -- * 'HasDocs' class and key functions

88− HasDocs(..), docs, printMarkdown

88+ HasDocs(..), docs, markdown, printMarkdown

90 , -- * Classes you need to implement for your types

91 ToSample(..), ToParam(..), ToCapture(..)

@@ -106,7 +106,6 @@ module Servant.Docs

106 ) where

107

108import Control.Lens hiding (Action)

109−import Control.Monad (when)

110import Data.Aeson

109import Data.Aeson

111import Data.ByteString.Lazy.Char8 (ByteString)

110import Data.ByteString.Lazy.Char8 (ByteString)

112import Data.Hashable

111import Data.Hashable

@@ -114,9 +113,9 @@ import Data.HashMap.Strict (HashMap)

114import Data.List

113import Data.List

115import Data.Monoid

114import Data.Monoid

116import Data.Proxy

115import Data.Proxy

116+import Data.String.Conversions

117import GHC.Generics

118

119−import qualified Data.ByteString.Lazy.Char8 as LB

120import qualified Data.HashMap.Strict as HM

119import qualified Data.HashMap.Strict as HM

121

120

122-- | Supported HTTP request methods

121-- | Supported HTTP request methods

@@ -349,69 +348,80 @@ class ToCapture c where

349-- | Print documentation in Markdown format for

348-- | Print documentation in Markdown format for

350-- the given 'API', on standard output.

349-- the given 'API', on standard output.

351printMarkdown :: API -> IO ()

350printMarkdown :: API -> IO ()

352−printMarkdown = imapM_ printEndpoint

351+printMarkdown = print . markdown

353−

352+

353+markdown :: API -> String

354+markdown = unlines . concat . map (uncurry printEndpoint) . HM.toList

355+

354− where printEndpoint endpoint action = do

356+ where printEndpoint :: Endpoint -> Action -> [String]

357+ printEndpoint endpoint action =

355− putStrLn $ str

358+ str :

356− putStrLn $ replicate len '-'

359+ replicate len '-' :

357− putStrLn ""

360+ "" :

358− capturesStr (action ^. captures)

361+ capturesStr (action ^. captures) ++

359− paramsStr (action ^. params)

362+ paramsStr (action ^. params) ++

360− rqbodyStr (action ^. rqbody)

363+ rqbodyStr (action ^. rqbody) ++

361− responseStr (action ^. response)

364+ responseStr (action ^. response) ++

365+ []

362

366

363 where str = show (endpoint^.method) ++ " " ++ endpoint^.path

367 where str = show (endpoint^.method) ++ " " ++ endpoint^.path

364 len = length str

368 len = length str

365

369

366− capturesStr :: [DocCapture] -> IO ()

370+ capturesStr :: [DocCapture] -> [String]

367− capturesStr [] = return ()

371+ capturesStr [] = []

368− capturesStr l = do

372+ capturesStr l =

369− putStrLn "**Captures**: "

373+ "**Captures**: " :

370− putStrLn ""

374+ "" :

371− mapM_ captureStr l

375+ map captureStr l ++

372− putStrLn ""

376+ "" :

377+ []

373 captureStr cap =

378 captureStr cap =

374− putStrLn $ "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)

379+ "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc)

375−

380+

376− paramsStr :: [DocQueryParam] -> IO ()

381+ paramsStr :: [DocQueryParam] -> [String]

377− paramsStr [] = return ()

382+ paramsStr [] = []

378− paramsStr l = do

383+ paramsStr l =

379− putStrLn "**GET Parameters**: "

384+ "**GET Parameters**: " :

380− putStrLn ""

385+ "" :

381− mapM_ paramStr l

386+ map paramStr l ++

382− putStrLn ""

387+ "" :

388+ []

383− paramStr param = do

389+ paramStr param = unlines $

384− putStrLn $ " - " ++ param ^. paramName

390+ (" - " ++ param ^. paramName) :

385− when (not (null values) || param ^. paramKind /= Flag) $

391+ (if (not (null values) || param ^. paramKind /= Flag)

386− putStrLn $ " - **Values**: *" ++ intercalate ", " values ++ "*"

392+ then [" - **Values**: *" ++ intercalate ", " values ++ "*"]

393+ else []) ++

387− putStrLn $ " - **Description**: " ++ param ^. paramDesc

394+ (" - **Description**: " ++ param ^. paramDesc) :

388− when (param ^. paramKind == List) $

395+ (if (param ^. paramKind == List)

389− putStrLn $ " - This parameter is a **list**. All GET parameters with the name "

396+ then [" - This parameter is a **list**. All GET parameters with the name "

390− ++ param ^. paramName ++ "[] will forward their values in a list to the handler."

397+ ++ param ^. paramName ++ "[] will forward their values in a list to the handler."]

398+ else []) ++

391− when (param ^. paramKind == Flag) $

399+ (if (param ^. paramKind == Flag)

392− putStrLn $ " - This parameter is a **flag**. This means no value is expected to be associated to this parameter."

400+ then [" - This parameter is a **flag**. This means no value is expected to be associated to this parameter."]

401+ else []) ++

402+ []

393

403

394 where values = param ^. paramValues

404 where values = param ^. paramValues

395

405

396− rqbodyStr :: Maybe ByteString -> IO ()

406+ rqbodyStr :: Maybe ByteString -> [String]

397− rqbodyStr Nothing = return ()

407+ rqbodyStr Nothing = []

398− rqbodyStr (Just b) = do

408+ rqbodyStr (Just b) =

399− putStrLn "**Request Body**: "

409+ "**Request Body**: " :

400 jsonStr b

410 jsonStr b

401

411

402− jsonStr b = do

412+ jsonStr b =

403− putStrLn ""

413+ "" :

404− putStrLn "``` javascript"

414+ "``` javascript" :

405− LB.putStrLn b

415+ cs b :

406− putStrLn "```"

416+ "```" :

407− putStrLn ""

417+ "" :

408−

418+ []

419+

409− responseStr :: Response -> IO ()

420+ responseStr :: Response -> [String]

410− responseStr resp = do

421+ responseStr resp =

411− putStrLn $ "**Response**: "

422+ "**Response**: " :

412− putStrLn $ ""

423+ "" :

413− putStrLn $ " - Status code " ++ show (resp ^. respStatus)

424+ (" - Status code " ++ show (resp ^. respStatus)) :

414− resp ^. respBody &

425+ (resp ^. respBody &

415− maybe (putStrLn " - No response body\n")

426+ maybe [" - No response body\n"]

416− (\b -> putStrLn " - Response body as below." >> jsonStr b)

427+ (\b -> " - Response body as below." : jsonStr b))

417−

src/Servant/Utils/StaticFiles.hs+23−1

@@ -1,11 +1,33 @@

1−module Servant.Utils.StaticFiles where

1+module Servant.Utils.StaticFiles (

2+ serveDirectory,

3+ serveDocumentation,

4+ ) where

6+import Data.Proxy

7+import Data.String.Conversions

3import Filesystem.Path.CurrentOS (decodeString)

8import Filesystem.Path.CurrentOS (decodeString)

9+import Network.HTTP.Types

10+import Network.Wai

4import Network.Wai.Application.Static

11import Network.Wai.Application.Static

6import Servant.API

13import Servant.API

14+import Servant.Docs

7import Servant.Server

15import Servant.Server

9serveDirectory :: FilePath -> Server Raw

17serveDirectory :: FilePath -> Server Raw

10serveDirectory documentRoot =

18serveDirectory documentRoot =

11 staticApp (defaultFileServerSettings (decodeString (documentRoot ++ "/")))

19 staticApp (defaultFileServerSettings (decodeString (documentRoot ++ "/")))

20+

21+serveDocumentation :: HasDocs api => Proxy api -> Server Raw

22+serveDocumentation proxy _request respond =

23+ respond $ responseLBS ok200 [] $ cs $ toHtml $ markdown $ docs proxy

24+

25+toHtml :: String -> String

26+toHtml markdown =

27+ "<html>" ++

28+ "<body>" ++

29+ "<verbatim>" ++

30+ markdown ++

31+ "</verbatim>" ++

32+ "</body>" ++

33+ "</html>"

test/Servant/ServerSpec.hs+3

@@ -29,6 +29,7 @@ import Servant.API.QueryParam

29import Servant.API.Raw

30import Servant.API.Sub

31import Servant.API.Alternative

32+import Servant.Docs

32import Servant.Server

33import Servant.Server

@@ -42,6 +43,8 @@ data Person = Person {

43instance ToJSON Person

44instance ToJSON Person

44instance FromJSON Person

45instance FromJSON Person

46+instance ToSample Person where

47+ toSample _proxy = Just $ encode alice

46alice :: Person

49alice :: Person

47alice = Person "Alice" 42

50alice = Person "Alice" 42

test/Servant/Utils/StaticFilesSpec.hs+40−11

@@ -1,29 +1,51 @@

1{-# LANGUAGE DataKinds #-}

2+{-# LANGUAGE FlexibleInstances #-}

2{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE TypeOperators #-}

4{-# LANGUAGE TypeOperators #-}

5+{-# OPTIONS_GHC -fno-warn-orphans #-}

4module Servant.Utils.StaticFilesSpec where

6module Servant.Utils.StaticFilesSpec where

6−import Test.Hspec hiding (pending)

8+import Control.Exception

7−import System.IO.Temp

9+import Data.Foldable

8−import Test.Hspec.Wai

10+import Data.List

9−import Network.Wai

10import Data.Proxy

11import Data.Proxy

12+import Data.String.Conversions

13+import Network.Wai

14+import Network.Wai.Test

11import System.Directory

15import System.Directory

12−import Control.Exception

16+import System.IO.Temp

17+import Test.Hspec hiding (pending)

18+import Test.Hspec.Wai

14−import Servant.Utils.StaticFiles

20+import Servant.API.Alternative

21+import Servant.API.Capture

15−import Servant.API.Sub

22+import Servant.API.Get

16import Servant.API.Raw

23import Servant.API.Raw

24+import Servant.API.Sub

25+import Servant.Docs

17import Servant.Server

26import Servant.Server

27+import Servant.ServerSpec

28+import Servant.Utils.StaticFiles

19type Api =

30type Api =

31+ "dummy_api" :> Capture "person_name" String :> Get Person

20− "static" :> Raw

32+ :<|> "static" :> Raw

33+ :<|> "documentation" :> Raw

34+

35+instance ToCapture (Capture "person_name" String) where

36+ toCapture _proxy = DocCapture "person_name" "person_name_doc"

37+

38+api :: Proxy Api

39+api = Proxy

22app :: Application

41app :: Application

23−app = serve (Proxy :: Proxy Api) server

42+app = serve api server

25server :: Server Api

44server :: Server Api

45+server =

46+ (\ name -> return (Person name 42))

26−server = serveDirectory "static"

47+ :<|> serveDirectory "static"

48+ :<|> serveDocumentation api

28withStaticFiles :: IO () -> IO ()

50withStaticFiles :: IO () -> IO ()

29withStaticFiles action = withSystemTempDirectory "servant-test" $ \ tmpDir ->

51withStaticFiles action = withSystemTempDirectory "servant-test" $ \ tmpDir ->

@@ -42,10 +64,17 @@ withStaticFiles action = withSystemTempDirectory "servant-test" $ \ tmpDir ->

43spec :: Spec

65spec :: Spec

44spec = do

66spec = do

45− around_ withStaticFiles $ with (return app) $

67+ around_ withStaticFiles $ with (return app) $ do

46 describe "serveDirectory" $ do

68 describe "serveDirectory" $ do

47 it "successfully serves files" $ do

69 it "successfully serves files" $ do

48 get "/static/foo.txt" `shouldRespondWith` "bar"

70 get "/static/foo.txt" `shouldRespondWith` "bar"

50 it "serves the contents of index.html when requesting the root of a directory" $ do

72 it "serves the contents of index.html when requesting the root of a directory" $ do

51 get "/static" `shouldRespondWith` "index"

73 get "/static" `shouldRespondWith` "index"

74+

75+ describe "serveDocumentation" $ do

76+ it "serves documentation about the expose API" $ do

77+ response <- get "/documentation"

78+ liftIO $ forM_ ["person_name" :: String, "static", "dummy_api", "person_name_doc"] $

79+ \ snippet ->

80+ (snippet, cs (simpleBody response)) `shouldSatisfy` uncurry isInfixOf