Add doctest

Web/Scotty.hs

@@ -61,6 +61,33 @@
 import Web.Scotty.Internal.Types (ScottyT, ActionT, ErrorHandler, Param, RoutePattern, Options, defaultOptions, File, Kilobytes, ScottyState, defaultScottyState, ScottyException, StatusError(..), Content(..))
 import UnliftIO.Exception (Handler(..), catch)
 
+{- $setup
+>>> :{
+import Control.Monad.IO.Class (MonadIO(..))
+import qualified Network.HTTP.Client as H
+import qualified Network.HTTP.Types as H
+import qualified Network.Wai as W (httpVersion)
+import qualified Data.ByteString.Lazy.Char8 as LBS (unpack)
+import qualified Data.Text as T (pack)
+import Control.Concurrent (ThreadId, forkIO, killThread)
+import Control.Exception (bracket)
+import qualified Web.Scotty as S (ScottyM, scottyOpts, get, text, regex, pathParam, Options(..), defaultOptions)
+-- | GET an HTTP path
+curl :: MonadIO m =>
+        String -- ^ path
+     -> m String -- ^ response body
+curl path = liftIO $ do
+  req0 <- H.parseRequest path
+  let req = req0 { H.method = "GET"}
+  mgr <- H.newManager H.defaultManagerSettings
+  (LBS.unpack . H.responseBody) <$> H.httpLbs req mgr
+-- | Fork a process, run a Scotty server in it and run an action while the server is running. Kills the scotty thread once the inner action is done.
+withScotty :: S.ScottyM ()
+           -> IO a -- ^ inner action, e.g. 'curl "localhost:3000/"'
+           -> IO a
+withScotty serv act = bracket (forkIO $ S.scottyOpts (S.defaultOptions{ S.verbose = 0 }) serv) killThread (\_ -> act)
+:}
+-}
 
 type ScottyM = ScottyT IO
 type ActionM = ActionT IO
@@ -115,14 +142,14 @@
 --
 -- Uncaught exceptions turn into HTTP 500 responses.
 raise :: Text -> ActionM a
 raise = Trans.raise
 {-# DEPRECATED raise "Throw an exception instead" #-}
 
 -- | Throw a 'StatusError' exception that has an associated HTTP error code and can be caught with 'catch'.
 --
 -- Uncaught exceptions turn into HTTP responses corresponding to the given status.
 raiseStatus :: Status -> Text -> ActionM a
 raiseStatus = Trans.raiseStatus
 {-# DEPRECATED raiseStatus "Use status, text, and finish instead" #-}
 
 -- | Throw an exception which can be caught within the scope of the current Action with 'catch'.
@@ -172,7 +199,7 @@
 --
 -- > raise JustKidding `catch` (\msg -> text msg)
 rescue :: E.Exception e => ActionM a -> (e -> ActionM a) -> ActionM a
 rescue = Trans.rescue
 {-# DEPRECATED rescue "Use catch instead" #-}
 
 -- | Like 'liftIO', but catch any IO exceptions and turn them into Scotty exceptions.
@@ -407,35 +434,37 @@
 notFound :: ActionM () -> ScottyM ()
 notFound = Trans.notFound
 
--- | Define a route with a 'StdMethod', 'Text' value representing the path spec,
--- and a body ('Action') which modifies the response.
---
--- > addroute GET "/" $ text "beam me up!"
---
--- The path spec can include values starting with a colon, which are interpreted
--- as /captures/. These are named wildcards that can be looked up with 'param'.
---
--- > addroute GET "/foo/:bar" $ do
--- >     v <- param "bar"
--- >     text v
---
--- >>> curl http://localhost:3000/foo/something
--- something
+{- | Define a route with a 'StdMethod', a route pattern representing the path spec,
+and an 'Action' which may modify the response.
+
+> get "/" $ text "beam me up!"
+
+The path spec can include values starting with a colon, which are interpreted
+as /captures/. These are parameters that can be looked up with 'pathParam'.
+
+>>> :{
+let server = S.get "/foo/:bar" (S.pathParam "bar" >>= S.text)
+ in do
+      withScotty server $ curl "http://localhost:3000/foo/something"
+:}
+"something"
+-}
 addroute :: StdMethod -> RoutePattern -> ActionM () -> ScottyM ()
 addroute = Trans.addroute
 
--- | Match requests using a regular expression.
---   Named captures are not yet supported.
---
--- > get (regex "^/f(.*)r$") $ do
--- >    path <- param "0"
--- >    cap <- param "1"
--- >    text $ mconcat ["Path: ", path, "\nCapture: ", cap]
---
--- >>> curl http://localhost:3000/foo/bar
--- Path: /foo/bar
--- Capture: oo/ba
---
+
+{- | Match requests using a regular expression.
+Named captures are not yet supported.
+
+>>> :{
+let server = S.get (S.regex "^/f(.*)r$") $ do
+                cap <- S.pathParam "1"
+                S.text cap
+ in do
+      withScotty server $ curl "http://localhost:3000/foo/bar"
+:}
+"oo/ba"
+-}
 regex :: String -> RoutePattern
 regex = Trans.regex
 
@@ -454,18 +483,20 @@
 capture :: String -> RoutePattern
 capture = Trans.capture
 
--- | Build a route based on a function which can match using the entire 'Request' object.
---   'Nothing' indicates the route does not match. A 'Just' value indicates
---   a successful match, optionally returning a list of key-value pairs accessible
---   by 'param'.
---
--- > get (function $ \req -> Just [("version", pack $ show $ httpVersion req)]) $ do
--- >     v <- param "version"
--- >     text v
---
--- >>> curl http://localhost:3000/
--- HTTP/1.1
---
+
+{- | Build a route based on a function which can match using the entire 'Request' object.
+'Nothing' indicates the route does not match. A 'Just' value indicates
+a successful match, optionally returning a list of key-value pairs accessible by 'param'.
+
+>>> :{
+let server = S.get (function $ \req -> Just [("version", T.pack $ show $ W.httpVersion req)]) $ do
+                v <- S.pathParam "version"
+                S.text v
+ in do
+      withScotty server $ curl "http://localhost:3000/"
+:}
+"HTTP/1.1"
+-}
 function :: (Request -> Maybe [Param]) -> RoutePattern
 function = Trans.function
 

Web/Scotty/Action.hs

@@ -92,7 +92,7 @@
 import           Numeric.Natural
 
 import           Web.Scotty.Internal.Types
 import           Web.Scotty.Util (mkResponse, addIfNotPresent, add, replace, lazyTextToStrictByteString, decodeUtf8Lenient)
 import           UnliftIO.Exception (Handler(..), catch, catches, throwIO)
 
 import Network.Wai.Internal (ResponseReceived(..))
@@ -119,7 +119,7 @@
 -- | Catches 'StatusError' and produces an appropriate HTTP response.
 statusErrorHandler :: MonadIO m => ErrorHandler m
 statusErrorHandler = Handler $ \case
   StatusError s e -> do
     status s
     let code = T.pack $ show $ statusCode s
     let msg = decodeUtf8Lenient $ statusMessage s
@@ -186,7 +186,7 @@
 --
 -- Uncaught exceptions turn into HTTP responses corresponding to the given status.
 raiseStatus :: Monad m => Status -> T.Text -> ActionT m a
 raiseStatus s = E.throw . StatusError s
 {-# DEPRECATED raiseStatus "Use status, text, and finish instead" #-}
 
 -- | Throw an exception which can be caught within the scope of the current Action with 'catch'.
@@ -569,7 +569,7 @@
     changeHeader addIfNotPresent "Content-Type" "text/html; charset=utf-8"
     raw $ BL.fromStrict $ encodeUtf8 t
 
-  -- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\"
+-- | Set the body of the response to the given 'T.Text' value. Also sets \"Content-Type\"
 -- header to \"text/html; charset=utf-8\" if it has not already been set.
 htmlLazy :: (MonadIO m) => TL.Text -> ActionT m ()
 htmlLazy t = do

Web/Scotty/Route.hs

@@ -23,10 +23,38 @@
 import qualified Text.Regex as Regex
 
 import           Web.Scotty.Action
 import           Web.Scotty.Internal.Types (RoutePattern(..), RouteOptions, ActionEnv(..), ActionT, ScottyState(..), ScottyT(..), ErrorHandler, Middleware, BodyInfo, handler, addRoute, defaultScottyResponse)
 import           Web.Scotty.Util (decodeUtf8Lenient)
 import Web.Scotty.Body (cloneBodyInfo, getBodyAction, getBodyChunkAction, getFormParamsAndFilesAction)
 
+{- $setup
+>>> :{
+import Control.Monad.IO.Class (MonadIO(..))
+import qualified Network.HTTP.Client as H
+import qualified Network.HTTP.Types as H
+import qualified Network.Wai as W (httpVersion)
+import qualified Data.ByteString.Lazy.Char8 as LBS (unpack)
+import qualified Data.Text as T (pack)
+import Control.Concurrent (ThreadId, forkIO, killThread)
+import Control.Exception (bracket)
+import qualified Web.Scotty as S (ScottyM, scottyOpts, get, text, regex, pathParam, Options(..), defaultOptions)
+-- | GET an HTTP path
+curl :: MonadIO m =>
+        String -- ^ path
+     -> m String -- ^ response body
+curl path = liftIO $ do
+  req0 <- H.parseRequest path
+  let req = req0 { H.method = "GET"}
+  mgr <- H.newManager H.defaultManagerSettings
+  (LBS.unpack . H.responseBody) <$> H.httpLbs req mgr
+-- | Fork a process, run a Scotty server in it and run an action while the server is running. Kills the scotty thread once the inner action is done.
+withScotty :: S.ScottyM ()
+           -> IO a -- ^ inner action, e.g. 'curl "localhost:3000/"'
+           -> IO a
+withScotty serv act = bracket (forkIO $ S.scottyOpts (S.defaultOptions{ S.verbose = 0 }) serv) killThread (\_ -> act)
+:}
+-}
+
 -- | get = 'addroute' 'GET'
 get :: (MonadUnliftIO m) => RoutePattern -> ActionT m () -> ScottyT m ()
 get = addroute GET
@@ -60,23 +88,21 @@
 notFound :: (MonadUnliftIO m) => ActionT m () -> ScottyT m ()
 notFound action = matchAny (Function (\req -> Just [("path", path req)])) (status status404 >> action)
 
--- | Define a route with a 'StdMethod', 'T.Text' value representing the path spec,
--- and a body ('Action') which modifies the response.
---
--- > addroute GET "/" $ text "beam me up!"
---
--- The path spec can include values starting with a colon, which are interpreted
--- as /captures/. These are named wildcards that can be looked up with 'captureParam'.
---
--- > addroute GET "/foo/:bar" $ do
--- >     v <- captureParam "bar"
--- >     text v
---
--- >>> curl http://localhost:3000/foo/something
--- something
---
--- NB: the 'RouteOptions' and the exception handler of the newly-created route will be
--- copied from the previously-created routes.
+{- | Define a route with a 'StdMethod', a route pattern representing the path spec,
+and an 'Action' which may modify the response.
+
+> get "/" $ text "beam me up!"
+
+The path spec can include values starting with a colon, which are interpreted
+as /captures/. These are parameters that can be looked up with 'pathParam'.
+
+>>> :{
+let server = S.get "/foo/:bar" (S.pathParam "bar" >>= S.text)
+ in do
+      withScotty server $ curl "http://localhost:3000/foo/something"
+:}
+"something"
+-}
 addroute :: (MonadUnliftIO m) => StdMethod -> RoutePattern -> ActionT m () -> ScottyT m ()
 addroute method pat action = ScottyT $ MS.modify $ \s -> addRoute (route (routeOptions s) (handler s) (Just method) pat action) s
 
@@ -85,10 +111,8 @@
       -> Maybe (ErrorHandler m) -> Maybe StdMethod -> RoutePattern -> ActionT m () -> BodyInfo -> Middleware m
 route opts h method pat action bodyInfo app req =
   let tryNext = app req
-        {- |
-          We match all methods in the case where 'method' is 'Nothing'.
-          See https://github.com/scotty-web/scotty/issues/196 and 'matchAny'
-        -}
+      -- We match all methods in the case where 'method' is 'Nothing'.
+      -- See https://github.com/scotty-web/scotty/issues/196 and 'matchAny'
       methodMatches :: Bool
       methodMatches = maybe True (\x -> (Right x == parseMethod (requestMethod req))) method
 
@@ -145,22 +169,22 @@
 parseEncodedParams :: B.ByteString -> [Param]
 parseEncodedParams bs = [ (k, fromMaybe "" v) | (k,v) <- parseQueryText bs ]
 
--- | Match requests using a regular expression.
---   Named captures are not yet supported.
---
--- > get (regex "^/f(.*)r$") $ do
--- >    path <- param "0"
--- >    cap <- param "1"
--- >    text $ mconcat ["Path: ", path, "\nCapture: ", cap]
---
--- >>> curl http://localhost:3000/foo/bar
--- Path: /foo/bar
--- Capture: oo/ba
---
+{- | Match requests using a regular expression.
+Named captures are not yet supported.
+
+>>> :{
+let server = S.get (S.regex "^/f(.*)r$") $ do
+                cap <- S.pathParam "1"
+                S.text cap
+ in do
+      withScotty server $ curl "http://localhost:3000/foo/bar"
+:}
+"oo/ba"
+-}
 regex :: String -> RoutePattern
-regex pattern = Function $ \ req -> fmap (map (T.pack . show *** T.pack) . zip [0 :: Int ..] . strip)
+regex pat = Function $ \ req -> fmap (map (T.pack . show *** T.pack) . zip [0 :: Int ..] . strip)
                                          (Regex.matchRegexAll rgx $ T.unpack $ path req)
-    where rgx = Regex.mkRegex pattern
+    where rgx = Regex.mkRegex pat
           strip (_, match, _, subs) = match : subs
 
 -- | Standard Sinatra-style route. Named captures are prepended with colons.
@@ -178,18 +202,19 @@
 capture :: String -> RoutePattern
 capture = fromString
 
--- | Build a route based on a function which can match using the entire 'Request' object.
---   'Nothing' indicates the route does not match. A 'Just' value indicates
---   a successful match, optionally returning a list of key-value pairs accessible
---   by 'param'.
---
--- > get (function $ \req -> Just [("version", T.pack $ show $ httpVersion req)]) $ do
--- >     v <- param "version"
--- >     text v
---
--- >>> curl http://localhost:3000/
--- HTTP/1.1
---
+{- | Build a route based on a function which can match using the entire 'Request' object.
+'Nothing' indicates the route does not match. A 'Just' value indicates
+a successful match, optionally returning a list of key-value pairs accessible by 'param'.
+
+>>> :{
+let server = S.get (function $ \req -> Just [("version", T.pack $ show $ W.httpVersion req)]) $ do
+                v <- S.pathParam "version"
+                S.text v
+ in do
+      withScotty server $ curl "http://localhost:3000/"
+:}
+"HTTP/1.1"
+-}
 function :: (Request -> Maybe [Param]) -> RoutePattern
 function = Function
 

doctest/Main.hs

@@ -0,0 +1,23 @@
+{-# LANGUAGE CPP #-}
+module Main where
+
+#if __GLASGOW_HASKELL__ >= 946
+import Test.DocTest (doctest)
+
+-- 1. Our current doctests require a number of imports that scotty doesn't need
+-- 2. declaring doctest helper functions in this module doesn't seem to work
+-- 3. cabal tests cannot have exposed modules?
+-- 4. GHCi only started supporting multiline imports since 9.4.6 ( https://gitlab.haskell.org/ghc/ghc/-/issues/20473 )
+-- so lacking a better option we no-op doctest for older GHCs
+
+main :: IO ()
+main = doctest [
+  "Web/Scotty.hs"
+  , "Web/Scotty/Trans.hs"
+  , "-XOverloadedStrings"
+  , "-XLambdaCase"
+  ]
+#else
+main :: IO ()
+main = pure ()
+#endif

scotty.cabal

@@ -122,6 +122,21 @@ test-suite spec
   build-tool-depends:  hspec-discover:hspec-discover == 2.*
   GHC-options:         -Wall -threaded -fno-warn-orphans
 
+test-suite doctest
+  main-is:             Main.hs
+  type:                exitcode-stdio-1.0
+  default-language:    Haskell2010
+  GHC-options:         -Wall -threaded -fno-warn-orphans
+  hs-source-dirs:      doctest
+  build-depends:       base
+                     , bytestring
+                     , doctest >= 0.20.1
+                     , http-client
+                     , http-types
+                     , scotty
+                     , text
+                     , wai
+
 benchmark weigh
   main-is:             Main.hs
   type:                exitcode-stdio-1.0