{-# OPTIONS -XPatternSignatures #-}
module ControllerBasic where
import HAppS.Server
import Misc
import Data.Monoid
{-
ServerPartTs take a request to a response, approximately like so
Request -> WebT -> Result -> Response
Request handlers are functions from a request to a WebT, WebT is a wrapper over a Result,
and a Response is extracted from a Result by monadic machinery which you don't need
to understand for now.
A HAppS Server is generally a list of ServerPartTs. When the wrapped functions are run,
either they result in NoHandle or a valid response. If there's a valid response, it gets
displayed. If NoHandle, control is passed to the next ServerPartT/handler in the list.
If all the handlers produce NoHandle as a result, the result is a 404.
ServerPartT :: (Request -> WebT m a) -> ServerPartT m a
WebT :: m (Result a) -> WebT m a
data Result a
= NoHandle | Ok (Response -> Response) a | Escape Response
-}
-- For everything below, the m monad is always IO and a result type is always Response,
-- so nail down types with more precision, which I have found helps with debugging
-- and understanding what's going on.
type TutHandler = ServerPartT IO Response
type TutWebT = WebT IO Response
simpleHandlers :: [ServerPartT IO Response]
simpleHandlers = debugFilter [
ServerPartT $ \rq -> do
ru <- (return . rqURL) rq
if ru == "/helloworld"
then ( return . toResponse ) "hello world, this is HAppS"
else noHandle
:: TutWebT
-- exactdir :: (Monad m) => String -> [ServerPartT m a] -> ServerPartT m a
-- given a url path (for the part of the path after the domain) and a list of handlers
-- exactdir runs the handlers against the request if the request url matches the first argument.
-- msgToSp creates a handler that will return a constant response for any request.
-- it is useful in conjunction with exactdir and other ServerPartT constructors.
-- argument is an exact url path.
-- so first arg is preceded by a /.
-- you can use exactdir "" to match the root path
, exactdir "/exactdir-with-msgtosp" [ msgToSp "this handler uses exactdir and msgToSp. subdirectories not allowed." ]
-- argument is a string, which matches the first element of the rqURL path.
-- pops the rqURL array, and passes the modified request to the list of handlers.
-- e.g., if url is http://myapp.com/dir1/dir2/dir3
-- the first element of the rqURL path is dir1.
-- so first arg is not preceded by a /.
-- you cannot use dir to match the root path.
, dir "dir-with-msgtosp" [ msgToSp "this handler uses dir and msgToSp. subdirectories are allowed." ]
-- ServerPartTs are monoids.
-- instance (Monad m) => Monoid (ServerPartT m a)
-- two handlers can be glued together into one handler with mappend,
-- and a list of handlers can be glued with mconcat,
-- There is a "zero" or "empty" handler which results in a 404 page for any request.
-- The way "handler addition" works is... for h1 `mappend` h2 ...
-- if h1 rq is anything other than NoHandle, return that.
-- if it is noHandle, return h2 rq
, mappend ( exactdir "/handleraddition1" [msgToSp "handleraddition 1"] )
( exactdir "/handleraddition2" [msgToSp "handleraddition 2"] )
-- more of same
, mconcat [ mempty -- the zero handler has no effect
, exactdir "/handleraddition3" [msgToSp "handleraddition 3"]
, exactdir "/handleraddition4" [msgToSp "handleraddition 4"]
, exactdir "/handleraddition5" [msgToSp "handleraddition 5"]
]
-- zero handler using mempty from the monoid instance, and the same thing again spelled out explicitly
, exactdir "/nohandle1" [mempty]
, exactdir "/nohandle2" [ ServerPartT $ \rq -> WebT $ return NoHandle ]
, exactdir "/exactdirAndmsgToSp/anotherResponse"
[ msgToSp "Another response generated using exactdir and msgToSp"]
, (exactdir "/ioaction"
[ ioMsgToSp (return "This is an IO value.\
\It could just as easily be the result of a file read operation,\
\or a database lookup." :: IO String) ] )
, (exactdir "/ioaction2"
[ ioMsgToSp $ do slurp <- readFile "src/Main.hs"
return $ "Let's try reading the Main.hs file: .....\n" ++ slurp ])
, (exactdir "/htmlAttemptWrong"
[msgToSp "first try at displaying <font color=\"red\">red formatted</font> html (wrong)"])
, (exactdir "/htmlAttemptRight"
[ ( msgToSp . HtmlString ) "second attempt at displaying <font color=\"red\">red formatted</font> html (right)"])
, dir "templates" [fileServe [] "templates"]
, dir "dirdemo" [ msgToSp "dir match. subpages will work" ]
]
-- pretty much useless little server part constructor, for demo purposes
simplematch :: String -> TutHandler
simplematch u = ServerPartT $ \rq -> do
ru <- (return . rqURL) rq
if ru == ("/simplematch" ++ u)
then ( return . toResponse ) ( "matched " ++ u)
else noHandle :: TutWebT