module Wiki where

import Control.Monad
import Control.Monad.Trans
import Data.Char
import System.Directory

import Network.CGI
import Text.XHtml.Strict

import WikiText

----------------------------------------------------------------------
-- Page types

type PageName = String

type PageContent = String

----------------------------------------------------------------------
-- Page storage

-- Gets the name of the file use to store the contents 
-- of the given page.
pageFile :: PageName -> FilePath
pageFile n = "data/" ++ n

-- Checks whether the given page exists.
doesPageExist :: MonadIO m => PageName -> m Bool
doesPageExist n = liftIO $ doesFileExist (pageFile n)

-- Gets the contents of the given page. 
readPage :: MonadIO m => PageName -> m PageContent
readPage n = liftIO $ readFile (pageFile n)

-- Updates the contents of the given page.
writePage :: MonadIO m => PageName -> PageContent -> m ()
writePage n c = liftIO $ writeFile (pageFile n) c

----------------------------------------------------------------------
-- Page names and URLs

-- Gets the absolute URL of the given page. When redirecting, the
-- absolute URL must be used.
pageViewAbsURL :: MonadCGI m => PageName -> m URL
pageViewAbsURL n = liftM (\u -> show u ++ "/" ++ n) progURI

-- Gets the relative URL for the edit action for the given page.
pageEditURL :: PageName -> URL
pageEditURL n = n ++ "?action=edit"

--Gets the relative URL for the save action for the given page.
pageSaveURL :: PageName -> URL
pageSaveURL n = n ++ "?action=save"

----------------------------------------------------------------------
-- HTML

-- Used by showPageHtml and editPageHtml to create HTML documents.
-- Sets the page title, and the base for relative links.
-- The body contains the page title and the given contents.
mkHtml :: (MonadCGI m, HTML a) => 
          String -- title
       -> a      -- contents
       -> m Html
mkHtml n c = 
    do b <- pageViewAbsURL ""
       return $ header << [thetitle << n, thebase ! [href b]] 
                  +++ body << (h1 << n +++ c)

-- Gets the HTML for the normal view of the given page, with the
-- given page contents. 
-- 
-- The returned HTML document contains the page name as a title,
-- the page contents formatted as HTML, and a link to
-- the edit form for the page.
showPageHtml :: MonadCGI m => PageName -> PageContent -> m Html
showPageHtml n c = mkHtml n $ concatHtml
    [thediv << parseDoc c, 
     p << anchor ! [href (pageEditURL n)] << "Edit this page"]

-- Gets the HTML for the edit form for the given page, with the
-- given page contents.
--
-- The HTML document contains the page title, and a form for 
-- editing the contents of the page.
--
-- The form contains a textarea element called "content" and a submit
-- button. The form has the following attributes:
-- * action: the URL for the save action for the given page. 
-- * method: "post"
editPageHtml :: MonadCGI m => PageName -> PageContent -> m Html
editPageHtml n c = 
    mkHtml ("Edit " ++ n) $ 
          form ! [action (pageSaveURL n), method "post"]
              << [p << textarea ! [name "content", rows "30", cols "80"] << c,
                  p << submit "" "Save"]

----------------------------------------------------------------------
-- Actions

-- The possible actions.
data Action = View PageName
            | Edit PageName
            | Save PageName PageContent
            | Goto PageName
  deriving Show

-- Gets the name of the requested page, if any.
--
-- Use the value of "PATH_INFO" in the environment to get
-- the part of the requested path that follows the name
-- of the CGI program.
--
-- Returns Nothing if no page name was given. Returns Just
-- if a valid page name was given. Calls 'error' with an appropriate
-- error message if an invalid page name vas given.
--
-- A page name is valid if it is non-empty and only contains
-- characters from the set consisting of: 
-- * All alphanumeric ASCII characters (Data.Char.isAlphaNum)
-- * Underscore
-- * Minus
-- * Open and close parantheses
-- * Percentage sign
pageName :: MonadCGI m => m (Maybe PageName)
pageName = pathInfo >>= checkName . dropWhile (=='/')
  where
    checkName n | null n = return Nothing
                | all isValidPageChar n = return $ Just n
                | otherwise =fail $ "Bad page name: " ++ show n
    isValidPageChar c = isAlphaNum c || c `elem` "_-'()%"

-- Gets the action that the user requested.
--
-- Uses the value of the "action" input. If "action" is
-- "view" or not set, a View action is returned, except
-- if no page name is given. In this case, Goto "Main" is
-- returned. If "action" is "edit", an Edit action is returned.
-- If "action" is "save", a Save action is returned.
-- For the Save action, the page content is given in the
-- "content" input.
--
-- If the value of "action" is something other than the values defined 
-- above, or if the page name or page contents are not given when needed,
-- "error" is called with appropriate error messages for each case.
getAction :: MonadCGI m => m Action
getAction = 
    do actionName <- liftM ( maybe "view" id) $ getInput "action"
       page <- pageName
       case (actionName, page) of
           ("view", Nothing) -> return $ Goto "Main"
           ("view", Just n)  -> return $ View n
           ("edit", Just n)  -> return $ Edit n
           ("save", Just n)  -> 
               getInput "content" 
                  >>= maybe (fail "Missing content") (return . Save n)
           (_,      Nothing) -> fail $ "No page given"
           (x,      _)       -> fail $ "Unknown action " ++ show x

-- Performs ths given action, returning the response headers and body.
--
-- For View actions, the page is shown if it exists, otherwise
-- the result is the same as for an Edit command for the same page.
--
-- For Edit actions, an editing form for the page is shown.
-- If the page does not exist, the editing form will contain
-- some small default contents.
--
-- For Save actions, the page with the given name is updated
-- to contain the given contents. After that, the user
-- is redirected to the normal view for the page that was saved.
--
-- For Goto actions, a redirection is made to the given page.
doAction :: (MonadCGI m, MonadIO m) => Action -> m CGIResult
doAction a = case a of
               View n   -> do e <- doesPageExist n
                              if e then viewPage n else editPage n
               Edit n   -> editPage n
               Save n c -> savePage n c
               Goto n   -> gotoPage n
  where
    viewPage n = do c <- readPage n 
                    showPageHtml n c >>= outputHtml
    editPage n = do e <- doesPageExist n
                    c <- if e then readPage n 
                              else return "Enter page content here."
                    editPageHtml n c >>= outputHtml
    savePage n c = writePage n c >> gotoPage n
    gotoPage n = pageViewAbsURL n >>= redirect

outputHtml :: MonadCGI m => Html -> m CGIResult
outputHtml = output . showHtml

cgiMain :: CGI CGIResult
cgiMain = getAction >>= doAction