module ControllerBasic where 

import Happstack.Server
import Happstack.Helpers
import Data.Monoid
import Text.StringTemplate.Helpers
import Control.Monad.Trans
import Text.StringTemplate 
import Control.Monad

{-
ServerPartTs conceptually just take a request to a response.

A Happstack webserver is fundamentally just a ServerPartT.  
This is where the Monoid instance of ServerPartT comes in, as many ServerPartTs can
be combined together with mappend.  mzero corresponds to a 404 and 
mzero `mappend` f = f, while if f is not mzero then f `mappend` g = f.
This means that when the wrapped function is run, the combination of ServerPartTs will be
tried from left to right until one does not return mzero.  If they all return mzero the
final result of the request is a 404. 

-}

-- For everything below, the m monad is always IO and the result type is always Response,
-- to nail down types with more precision, which I have found helps with debugging
-- and understanding what's going on.  Until now we've been using String as the return
-- type of the ServerPartT.  Why change to Response?  Isn't the whole point of the
-- ToMessage class that we don't have to explicitely use Response?  Well, yes, but
-- for the purpose of this example we want to combine a variety of ServerPartTs and
-- so we use the common denominator of the toResponse function to make them all have
-- the same type.

simpleHandlers :: ServerPartT IO Response
simpleHandlers = msum [do
    rq <- askRq -- If you explicitly want the Request received
                -- then use askRq.  It's essentially just a convenience
                -- wrapper around the MonadReader method ask
    let ru = rqURL rq
    if ru == "/helloworld"
       then return . toResponse $ "hello world, this is Happstack" 
       else mzero
 
  -- 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 handler
  -- exactdir runs the handlers against the request if the request url matches the first argument.
  -- exactdir is from the happstack-helpers package on hackage, also maintained by the author

    -- argument is an exact url path.
    -- so first arg is preceded by a /.
    -- you can use exactdir "" to match the root path
    , exactdir "/exactdir" ( return . toResponse $ "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" (return . toResponse $ "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.
  -- The following should be a simple example of the monoidal product
  -- of ServerPartTs
  , mappend ( exactdir "/handleraddition1" (return . toResponse $ "handleraddition 1") )
            ( exactdir "/handleraddition2" (return . toResponse $ "handleraddition 2") )

  -- more of same
  , mconcat [ mempty -- the zero handler has no effect
              , exactdir "/handleraddition3" (return . toResponse $ "handleraddition 3")
              , exactdir "/handleraddition4" (return . toResponse $ "handleraddition 4")
              , exactdir "/handleraddition5" (return . toResponse $ "handleraddition 5")
            ] 


  -- zero handler using mempty from the monoid instance, and the same thing again spelled out explicitly
  , exactdir "/nohandle1" mempty

  , exactdir "/exactdir/anotherResponse"
                  (return . toResponse $ "Another response generated using exactdir") 
  -- Here we're making use of the MonadIO instance for ServerPartT to arbitrarily
  -- lift a computation into IO.  While it's entirely redundant and silly in this example...
  , (exactdir "/ioaction"
                  ( liftIO . return . toResponse $ HtmlString "This is an IO value.\
                                       \It could just as easily be the result of a file read operation,\
                                       \or a database lookup.") )
  -- ...the ability to serve a file is a very good way to make use of liftIO
  , (exactdir "/ioaction2"
                  (do slurp <- liftIO $ readFile "src/Main.hs"
                      return . toResponse . HtmlString $ "Let's try reading the Main.hs file: .....\n" ++ slurp ))
  -- Now when you convert a straight string as a Response it won't actually display properly as
  -- HTML.  Now why on Earth could that be?  Very simply, its because the content type provided
  -- by the ToMessage instance for String is "text/plain".
  , (exactdir "/htmlAttemptWrong"
                  (return . toResponse $ "first try at displaying <font color=\"red\">red formatted</font> html (wrong)"))
  -- Here we're making use of another convenience bit from happstack-helpers, the HtmlString wrapper.
  -- It allows you to take a string but have its content type be "text/html".
  , (exactdir "/htmlAttemptRight"
                  (return . toResponse . HtmlString  $ "second attempt at displaying <font color=\"red\">red formatted</font> html (right)"))
  
  , (exactdir "/htmlAttemptForeignChars"
                  (return . toResponse . HtmlString  $ 
                      "<html><head></head><body><font color=red>some foreign chars: ä ö ü</font></body></html>"))

  , dir "dirdemo" (return . toResponse $  "dir match. subpages will work")
  -- Redirection of urls in Happstack can be done using the seeOther function.
  -- seeOther can eat any valid representation of a URI, i.e. an instance of
  -- ToSURI, a response to accompany the redirect, and will then 
  -- perform a redirection to the provided url.  In this case clicking the link
  -- will appear to have no effect at all as it will redirect back to the
  -- url handling chapter.
  , dir "redirect" $ seeOther "/tutorial/basic-url-handling" (toResponse "")]

-- pretty much useless little server part constructor, for demo purposes
simplematch :: String -> ServerPartT IO Response
simplematch u = do
    rq <- askRq
    let ru = rqURL rq
    if ru == ("/simplematch" ++ u)
       then ( return . toResponse ) ( "matched " ++ u) 
       else mzero

myFavoriteAnimal :: ServerPartT IO Response
myFavoriteAnimal = 
  exactdir "/usingtemplates/my-favorite-animal" $
        liftIO $ do 
          templates <- directoryGroup "templates"
          let fp2 :: String
              fp2 = renderTemplateGroup templates [("favoritePlantTwo","Venus Fly Trap")] "favoritePlant"
              mineralList :: String
              mineralList = renderTemplateGroup templates [("favoriteMinerals",["zinc ","talc"])] "myFavoriteAnimal"
              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","Wheat")
                                                , ("favoritePlant","Ficus")
                                                , ("favoritePlant","Sugarcane")
                                                           -- note that template variable names must be alpha
                                                           -- favoritePlant2 below would get rejected 
                                                , ("fpTwo", fp2)
                                                , ("favoriteMinerals",mineralList)] "myFavoriteAnimalBase" 
          return . toResponse . HtmlString $ r
                            -- if template key is repeated, only the first value appears