Utils.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Network.HxWeb.Utils
-- Copyright   :  (c) David Himmelstrup 2006
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-----------------------------------------------------------------------------
module Network.HxWeb.Utils
    ( readM       -- (Monad m, Read a) => String -> m a
    , getInput'   -- String -> WebPage st String
    , readInput'  -- Read a => String -> WebPage st a
    , escape      -- String -> WebPage st a
    , runWebPage  -- st -> WebPage st CGIResult -> CGI CGIResult
    ) where

import Network.CGI           ( CGI, CGIResult, output, redirect
                             , getInput )
import Control.Monad.State   ( evalStateT )

import Network.HxWeb.Monad   ( WebPage(..), WebResult(..) )

readM :: (Monad m,Read a) => String -> m a
readM str = case reads str of
              [] -> fail "No parse"
              [(val,_)] -> return val
              _ -> fail "Ambiguous parse"

getInput' :: String -> WebPage st String
getInput' key = do mbVal <- getInput key
                   case mbVal of
                     Nothing -> fail $ "Failed to lookup key: " ++ key
                     Just val -> return val

readInput' :: Read a => String -> WebPage st a
readInput' key
    = do val <- getInput' key
         readM val

escape :: String -> WebPage st a
escape redirect
    = WebPage (return (Redirect redirect))

runWebPage :: st -> WebPage st CGIResult -> CGI CGIResult
runWebPage st (WebPage r)
    = do ret <- evalStateT r st
         case ret of
           WebResult a  -> return a
           Fail str     -> output $ "Uncaught error: " ++ str
           Redirect url -> redirect url