diff --git a/apiary.cabal b/apiary.cabal --- a/apiary.cabal +++ b/apiary.cabal @@ -1,5 +1,5 @@ name: apiary -version: 0.12.4 +version: 0.12.5 synopsis: Simple and type safe web framework that can be automatically generate API documentation. description: Simple and type safe web framework that can be automatically generate API documentation. @@ -35,9 +35,9 @@ . * type safe route filter. . - * auto generate API documentation(example: , ). + * auto generate API documentation(example: , ). . - more examples: + more examples: license: MIT license-file: LICENSE diff --git a/src/Control/Monad/Apiary/Action.hs b/src/Control/Monad/Apiary/Action.hs --- a/src/Control/Monad/Apiary/Action.hs +++ b/src/Control/Monad/Apiary/Action.hs @@ -3,6 +3,7 @@ module Control.Monad.Apiary.Action ( ActionT , ApiaryConfig(..) + , defaultDocumentationAction -- * actions , stop, stopWith @@ -36,7 +37,6 @@ -- * Reexport , module Data.Default.Class , module Network.HTTP.Types.Status - , defaultDocumentationAction -- * deprecated , redirectFound, redirectSeeOther, source diff --git a/src/Control/Monad/Apiary/Action/Internal.hs b/src/Control/Monad/Apiary/Action/Internal.hs --- a/src/Control/Monad/Apiary/Action/Internal.hs +++ b/src/Control/Monad/Apiary/Action/Internal.hs @@ -30,6 +30,7 @@ import Data.Apiary.Document import Data.Default.Class import Blaze.ByteString.Builder +import Text.Blaze.Html import Text.Blaze.Html.Renderer.Utf8 import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L @@ -52,12 +53,12 @@ , documentationAction :: Documents -> ActionT IO () } -defaultDocumentationAction :: Monad m => S.ByteString -> Documents -> ActionT m () -defaultDocumentationAction r d = do +defaultDocumentationAction :: Monad m => S.ByteString -> T.Text -> Maybe Html -> Documents -> ActionT m () +defaultDocumentationAction r t md d = do p <- rawPathInfo <$> getRequest guard $ p == r contentType "text/html" - builder . renderHtmlBuilder $ defaultDocumentToHtml d + builder . renderHtmlBuilder $ defaultDocumentToHtml t md d defNotFound :: Application #ifdef WAI3 @@ -73,7 +74,7 @@ , defaultHeader = [] , rootPattern = ["", "/", "/index.html", "/index.htm"] , mimeType = defaultMimeLookup . T.pack - , documentationAction = defaultDocumentationAction "/api/documentation" + , documentationAction = defaultDocumentationAction "/api/documentation" "API documentation" Nothing } convFile :: (S.ByteString, P.FileInfo L.ByteString) -> File diff --git a/src/Control/Monad/Apiary/Filter.hs b/src/Control/Monad/Apiary/Filter.hs --- a/src/Control/Monad/Apiary/Filter.hs +++ b/src/Control/Monad/Apiary/Filter.hs @@ -23,7 +23,7 @@ , Capture.fetch -- ** query matcher - , QueryKey(..) + , QueryKey(..), (??) , query -- *** specified operators , (=:), (=!:), (=?:), (?:), (=*:), (=+:) @@ -114,6 +114,9 @@ fromString s = case break (== ':') s of (k, []) -> QueryKey (SC.pack k) Nothing (k, d) -> QueryKey (SC.pack k) (Just . toHtml $ tail d) + +(??) :: QueryKey -> Html -> QueryKey +QueryKey k _ ?? d = QueryKey k (Just d) -- | low level query getter. since 0.5.0.0. -- diff --git a/src/Control/Monad/Apiary/Filter/Internal/Capture/TH.hs b/src/Control/Monad/Apiary/Filter/Internal/Capture/TH.hs --- a/src/Control/Monad/Apiary/Filter/Internal/Capture/TH.hs +++ b/src/Control/Monad/Apiary/Filter/Internal/Capture/TH.hs @@ -1,5 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} + module Control.Monad.Apiary.Filter.Internal.Capture.TH where import Language.Haskell.TH @@ -17,12 +19,16 @@ splitPath :: String -> [String] splitPath = map T.unpack . T.splitOn "/" . T.pack -description :: Monad m => String -> m (String, Maybe String) +data Lookup = N Name | S String | None + +description :: String -> Q (String, Lookup) description s = case break (== '(') s of - (t, []) -> return (t, Nothing) + (t, []) -> return (t, None) (t, st) -> case break (== ')') st of - (_:b, ")") -> return (t, Just b) - (_, _) -> fail "capture: syntax error." + (_:'$':b, ")") -> lookupValueName b >>= + maybe (fail $ b ++ " not found.") (return . (t,) . N) + (_:b, ")") -> return (t, S b) + (_, _) -> fail "capture: syntax error." mkCap :: [String] -> ExpQ mkCap [] = [|Capture.endPath|] @@ -30,8 +36,9 @@ (t, mbd) <- description tyStr ty <- lookupTypeName t >>= maybe (fail $ t ++ " not found.") return let d = case mbd of - Nothing -> [|Nothing|] - Just h -> [|Just $(stringE h)|] + None -> [|Nothing|] + S h -> [|Just $(stringE h)|] + N n -> [|Just $(varE n)|] [|Capture.fetch (Proxy :: Proxy $(conT ty)) $d . $(mkCap as)|] mkCap (eq:as) = do [|(Capture.path $(stringE eq)) . $(mkCap as) |] diff --git a/src/Data/Apiary/Document.hs b/src/Data/Apiary/Document.hs --- a/src/Data/Apiary/Document.hs +++ b/src/Data/Apiary/Document.hs @@ -113,47 +113,96 @@ loop _ r p End = (r, if null p then mempty - else H.table ! A.class_ "table table-condensed col-sm-offset-1 col-md-offset-1" $ - H.caption "Route Parameters" <> - H.tr (H.th "#" <> H.th "type" <> H.th "description") <> - mconcat p + else H.table ! A.class_ "table table-condensed" $ + H.tr (mconcat + [ H.th ! A.class_ "col-sm-1 com-md-1" $ "#" + , H.th ! A.class_ "col-sm-1 com-md-1" $ "type" + , H.th "description" + ]) <> mconcat p ) -defaultDocumentToHtml :: Documents -> Html -defaultDocumentToHtml docs = H.docTypeHtml $ H.head headH <> H.body body +defaultDocumentToHtml :: T.Text -> Maybe Html -> Documents -> Html +defaultDocumentToHtml title desc docs = H.docTypeHtml $ H.head headH <> H.body body <> footer where css u = H.link ! A.rel "stylesheet" ! A.href u - headH = H.title "API documentation" <> - css "//maxcdn.bootstrapcdn.com/bootstrap/3.2.0/css/bootstrap.min.css" + headH = mconcat + [ H.title (toHtml title) + , css "//maxcdn.bootstrapcdn.com/bootstrap/3.2.0/css/bootstrap.min.css" + , H.style . toHtml $ T.concat + [ ".fetch{color:gray}" + , "footer{padding-top:40px;" + , "padding-bottom:40px;" + , "margin-top:20px;" + , "text-align:center;" + , "color:#777;" + , "border-top:1px solid #ddd" + , "}" + , ".description{margin-bottom:20px}" + , "table{margin-top:15px !important;margin-bottom:0px !important}" + , ".method{margin-bottom:20px;padding-bottom:10px;border-bottom:1px solid #ddd}" + , ".method:last-child{margin-bottom:0;padding-bottom:0;border-bottom:none}" + ] + ] htmlQR (Strict r) = toHtml (show r) htmlQR (Nullable r) = toHtml (show r ++ "?") htmlQR Check = toHtml ("check" :: T.Text) - query (QueryDoc p s q t) = H.tr $ - H.td (toHtml $ T.decodeUtf8 p) <> H.td (toHtml $ strategyInfo s) <> H.td (htmlQR q) <> H.td t + query (QueryDoc p s q t) = H.tr . mconcat $ + [ H.td (toHtml $ T.decodeUtf8 p) + , H.td (toHtml $ strategyInfo s) + , H.td (htmlQR q) + , H.td t + ] - queriesH [] = mempty - queriesH qs = - H.table ! A.class_ "table table-condensed col-sm-offset-1 col-md-offset-1" $ - H.caption "Query Parameters" <> - H.tr (H.th "name" <> H.th "num" <> H.th "type" <> H.th "description") <> - mconcat (map query qs) + mcMap f = mconcat . map f - method (m, MethodDoc qs d) = + queriesH [] = mempty + queriesH qs = H.div ! A.class_ "col-sm-offset-1 col-md-offset-1" $ - H.h4 (toHtml $ T.decodeUtf8 m) <> - (H.p ! A.class_ "col-sm-offset-1 col-md-offset-1") (toHtml d) <> - queriesH qs + H.table ! A.class_ "table table-condensed" $ mconcat + [ H.caption "Query parameters" + , H.tr $ mconcat [ H.th ! A.class_ "col-sm-1 col-md-1" $ "name" + , H.th ! A.class_ "col-sm-1 col-md-1" $ "num" + , H.th ! A.class_ "col-sm-1 col-md-1" $ "type" + , H.th "description" + ] + , mcMap query qs + ] + method (m, MethodDoc qs d) = + H.div ! A.class_ "method" $ mconcat + [ H.h4 . toHtml $ T.decodeUtf8 m + , H.div ! A.class_ "col-sm-offset-1 col-md-offset-1" $ H.p (toHtml d) + , queriesH qs + ] + pathH (PathDoc r ms) = let (route, rdoc) = routeToHtml r - in H.div $ H.h3 route <> rdoc <> (H.div $ mconcat (map method ms)) + in H.div ! A.class_ "panel panel-default" $ mconcat + [ H.div ! A.class_ "panel-heading" $ mconcat + [ H.h3 ! A.class_ "panel-title" $ route + , rdoc + ] + , H.div ! A.class_ "panel-body" $ mcMap method ms + ] - groupH (g, p) = H.div $ H.h2 (toHtml g) <> (mconcat $ map pathH p) + groupH (g, p) = H.div $ mconcat [H.h2 $ toHtml g, mcMap pathH p] - doc (Documents n g) = H.div (mconcat $ map pathH n) <> mconcat (map groupH g) + doc (Documents n g) = mconcat + [ H.div $ mcMap pathH n + , mcMap groupH g + ] - body = H.div ! A.class_ "container" $ - H.h1 "API documentation" <> doc docs + body = H.div ! A.class_ "container" $ mconcat + [ H.div ! A.class_ "page-header" $ H.h1 (toHtml title) + , maybe mempty (H.div ! A.class_ "description") desc + , doc docs + ] + + footer = H.footer $ mconcat + [ "API documentation generated " + , H.a ! A.href "https://github.com/philopon/apiary" $ "apiary" + , " web framework." + ]