wai-route-1.0.0: examples/compose.hs

{-# LANGUAGE
    TypeApplications
  , DataKinds
  , GADTs
  , OverloadedStrings
#-}

module Examples.Wildcard where

import Data.Binary.Builder (toLazyByteString)
import Data.Text (Text)
import Data.Text.Lazy (fromStrict)
import Data.Text.Lazy.Encoding (encodeUtf8)
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Internal
import Network.Wai.Route
import Prelude

import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy.Char8 as LC8
import qualified Data.Text as Text

-- $setup
-- >>> :set -XOverloadedStrings

-- Routes

prefixRoutes :: [Route IO]
prefixRoutes = [ defRoute (str "files" ./ end) filesHandler ]

otherRoutes :: [Route IO]
otherRoutes = [ defRoute (str "echo" ./ some @Text ./ end) echoHandler ]

filesHandler :: Params '[] -> App IO
filesHandler Nil rq send =
    let path = Text.intercalate "/" (pathInfo rq)
    in send (response200 (encodeUtf8 (fromStrict path)))

echoHandler :: Params '[Some Text] -> App IO
echoHandler (t ::: Nil) _rq send =
    send (response200 (encodeUtf8 (fromStrict t)))

response200 :: LC8.ByteString -> Response
response200 = responseLBS status200 []

-- Fake requests

filesReq :: Request
filesReq = defaultRequest { pathInfo = ["files","foo","bar","baz.jpg"] }

echoReq :: Request
echoReq = defaultRequest { pathInfo = ["echo","Hello"] }

bogusReq :: Request
bogusReq = defaultRequest { pathInfo = ["bogus"] }

-- Fake response sending

printResponse :: Response -> IO ResponseReceived
printResponse rs = do
    case rs of
        ResponseBuilder s _ b -> do
            putStr (show (statusCode s))
            putStr " "
            putStr (C8.unpack (statusMessage s))
            putStr ": "
            putStrLn (LC8.unpack (toLazyByteString b))
        _ -> return ()
    return ResponseReceived

-- Application

app :: App IO
app = routePrefix (compileRoutes prefixRoutes)
    $ route (compileRoutes otherRoutes)
    $ app404

-- $examples
--
-- >>> app filesReq printResponse
-- 200 OK: foo/bar/baz.jpg
--
-- >>> app echoReq printResponse
-- 200 OK: Hello
--
-- >>> app bogusReq printResponse
-- 404 Not Found: