module Bein.Web.Routing where import Control.Monad import Data.Monoid import Bein.Web.Types import Bein.Web.Commands import Bein.Web.Pages.Index import Bein.Web.Pages.Object import Bein.Web.Pages.Settings import Bein.Web.Pages.SignOut import Bein.Web.Pages.New import Happstack.Server hiding (dirs) import Control.Monad.Trans import System.FilePath import Bein.Web.Pages.Login breakAll :: (a -> Bool) -> [a] -> [[a]] breakAll _ [] = [] breakAll f l = let (a,b) = break f l in a : breakAll f (safeTail b) where safeTail [] = [] safeTail (_:b) = b dirs :: (ServerMonad m, MonadPlus m) => String -> m a -> m a dirs d r = let ds = breakAll ('/'==) d in foldr (\p q -> (dir p).q) id ds $ r routing :: BeinServerPart Response routing = do basePath <- lift $ configField http_base_path dirs basePath $ mconcat [ nullDir >> index, dir "login" $ login, dir "settings" $ settings, guardObject $ object, exactDir "signout" $ signOut, dir "new" $ newObject, staticData ] staticData :: BeinServerPart Response staticData = mconcat [ staticFile "default.css" "text/css; charset=utf-8" ] -- staticFile "jquery.js" "text/javascript", -- staticFile "script.js" "text/javascript" ] where staticFile dirName contType = dir dirName $ do d <- lift $ configField static_content_directory setHeaderM "Content-Type" contType fileServe [] (joinPath [d,dirName])