module ControllerBasic where import HAppS.Server import Misc import Data.Monoid import Text.StringTemplate.Helpers import Control.Monad.Trans import Text.StringTemplate {- 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 = [ 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 -- 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 $ HtmlString "This is an IO value.\ \It could just as easily be the result of a file read operation,\ \or a database lookup." :: IO HtmlString) ] ) , (exactdir "/ioaction2" [ ioMsgToSp $ do slurp <- readFile "src/Main.hs" return $ HtmlString $ "Let's try reading the Main.hs file: .....\n" ++ slurp ]) , (exactdir "/htmlAttemptWrong" [msgToSp "first try at displaying red formatted html (wrong)"]) , (exactdir "/htmlAttemptRight" [ ( msgToSp . HtmlString ) "second attempt at displaying red formatted html (right)"]) , (exactdir "/htmlAttemptForeignChars" [ ( msgToSp . HtmlString ) $ "some foreign chars: ä ö ü"]) , 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 let ru = rqURL rq if ru == ("/simplematch" ++ u) then ( return . toResponse ) ( "matched " ++ u) else noHandle :: TutWebT -- don't like these functions, feel they obfuscate. -- I wrote them when I had a less good understanding -- oh well, at least I don't use them in "real" code. (eg, took this out of misc.) msgToSp :: (Monad m, ToMessage a) => a -> ServerPartT m Response msgToSp = anyRequest . msgToWeb msgToWeb :: (Monad m, ToMessage a) => a -> WebT m Response msgToWeb = return . toResponse ioMsgToSp = anyRequest . liftIO . ( return . toResponse =<< ) myFavoriteAnimal :: ServerPartT IO Response myFavoriteAnimal = exactdir "/usingtemplates/my-favorite-animal" [ ServerPartT $ \rq -> liftIO $ do templates <- directoryGroup "templates" let fp2 :: String fp2 = renderTemplateGroup templates [("favoritePlantTwo","Venus Fly Trap")] "favoritePlant" r = renderTemplateGroup templates [("favoriteAnimal", "Tyrannasaurus Rex") , ("leastFavoriteAnimal","Bambi") -- if you set the same template variable several times it -- gets repeated when it gets displayed -- I think this is reasonable, because it gives you -- feedback that there's probably a bug in your program , ("favoritePlant","Ficus") , ("favoritePlant","Wheat") , ("favoritePlant","Sugarcane") -- note that template variable names must be alpha -- favoritePlant2 below would get rejected , ("fpTwo", fp2)] $ "myFavoriteAnimalBase" return . toResponse . HtmlString $ r -- if template key is repeated, only the first value appears ]