rest-happstack 0.2.9.9 → 0.2.10

raw patch · 3 files changed

+55/−11 lines, 3 filesdep +rest-gendep −rest-typesdep −transformersdep ~rest-core

Dependencies added: rest-gen

Dependencies removed: rest-types, transformers

Dependency ranges changed: rest-core

Files

• CHANGELOG.md +4/−0
• rest-happstack.cabal +11/−11
• src/Rest/Driver/Happstack/Docs.hs +40/−0

@@ -1,5 +1,9 @@ # Changelog +#### 0.2.10++* Introduced `Rest.Driver.Happstack.Docs` module that was moved from `rest-gen:Rest.Gen.Docs.Happstack`+ #### 0.2.9.9  * Allow `mtl == 2.2.*` and `transformers == 0.4.*`

@@ -1,5 +1,5 @@ name:                rest-happstack-version:             0.2.9.9+version:             0.2.10 description:         Rest driver for Happstack. synopsis:            Rest driver for Happstack. maintainer:          code@silk.co@@ -20,14 +20,14 @@ library   ghc-options:       -Wall   hs-source-dirs:    src-  exposed-modules:   Rest.Driver.Happstack+  exposed-modules:+    Rest.Driver.Happstack+    Rest.Driver.Happstack.Docs   build-depends:-      base             == 4.*-    , containers       >= 0.4    && < 0.6-    , happstack-server >= 7.0.5  && < 7.4-    , mtl              >= 2.0    && < 2.3-    , rest-types       == 1.10.*-    , transformers     >= 0.3 && < 0.5-    , utf8-string      == 0.3.*-    , rest-core        >= 0.28 && < 0.31-+      base == 4.*+    , containers >= 0.4 && < 0.6+    , happstack-server >= 7.0.5 && < 7.4+    , mtl >= 2.0 && < 2.3+    , rest-core == 0.31.*+    , rest-gen == 0.14.*+    , utf8-string == 0.3.*

@@ -0,0 +1,40 @@+{-# LANGUAGE FlexibleContexts #-}+module Rest.Driver.Happstack.Docs+  ( apiDocsHandler+  ) where++import Control.Monad+import Control.Monad.Trans+import Happstack.Server+import Rest.Api+import Rest.Gen.Base+import Rest.Gen.Docs++-- | Web interface for documentation+apiDocsHandler :: (ServerMonad m, MonadPlus m, FilterMonad Response m, MonadIO m) => String -> String -> Api a -> m Response+apiDocsHandler rootURL tmpls api =+  let mkCtx v ct = DocsContext (rootURL ++ ct ++ "/") v tmpls+      serve ctx = serveDocs ctx . sortTree . noPrivate . (\(Some1 r) -> apiSubtrees r)+  in path $ \i -> withVersion i api mzero $ \v -> serve (mkCtx v i)++serveDocs :: (ServerMonad m, MonadPlus m, FilterMonad Response m, MonadIO m) => DocsContext -> ApiResource -> m Response+serveDocs ctx tree =+  msum $+    [ nullDir >> allDocsHandler ctx tree+    , docHandlers ctx tree+    ]++allDocsHandler :: (ServerMonad m, MonadPlus m, FilterMonad Response m, MonadIO m) => DocsContext -> ApiResource -> m Response+allDocsHandler ctx tree =+  do pg <- liftIO $ mkAllResources ctx tree+     setHeaderM "Content-Type" "text/html"+     return $ toResponse pg++docHandlers :: (ServerMonad m, MonadPlus m, FilterMonad Response m, MonadIO m) => DocsContext -> ApiResource -> m Response+docHandlers ctx = foldTreeChildren msum $ \it subs ->+  dir (resName it) $ msum $+       [ nullDir >> do pg <- liftIO $ mkSingleResource ctx it+                       setHeaderM "Content-Type" "text/html"+                       return $ toResponse pg+       ]+    ++ subs