adding respondsTo

App/Controllers/Test.hs

@@ -9,12 +9,5 @@ show  = do id'  <- getSetting_u "id"
            p <- find id'
            setViewDataValue "page-title" (title p)
            setViewDataValue "page-content" (content p)
-           handleFormat
+           respondTo "format" []
 
-handleFormat :: Controller ()
-handleFormat = do f <- getSetting "format"
-                  case f of
-                    Nothing -> return ()
-                    Just f' -> do clearLayout
-                                  a <- getSetting_u "action"
-                                  setSetting "action" $ a ++ f'

Turbinado/Controller.hs

@@ -21,6 +21,7 @@ module Turbinado.Controller (
         module Data.Maybe,
 
         module Config.Master,
+        module Turbinado.Controller.Routes,
         module Turbinado.Environment.CodeStore,
         module Turbinado.Environment.Cookie,
         module Turbinado.Environment.Header,
@@ -55,6 +56,7 @@ import Turbinado.Environment.Settings
 import Turbinado.Environment.Types
 import Turbinado.Environment.ViewData
 import Turbinado.Controller.Monad
+import Turbinado.Controller.Routes
 import Turbinado.Utility.General
 import Turbinado.Server.StandardResponse
 

Turbinado/Controller/Routes.hs

@@ -0,0 +1,29 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Turbinado.Controller.Routes
+-- Copyright   :  (c) Alson Kemp 2009
+-- License     :  BSD-style (see the file LICENSE)
+-- 
+-- Maintainer  :  Alson Kemp (alson@alsonkemp.com)
+-- Stability   :  experimental
+-----------------------------------------------------------------------------
+module Turbinado.Controller.Routes (
+	respondTo
+  ) where
+
+import Data.Maybe
+import Turbinado.Environment.Settings
+import Turbinado.Controller.Monad
+
+-- | Automates the process of responding to various file formats
+respondTo :: String -> [(String,  Controller ())] -> Controller ()
+respondTo f'' actions = do f' <- getSetting f''
+                           case f' of
+                             Nothing -> error $ "Routes.respondTo: There is no setting called '" ++ f'' ++ "' for me to respondTo"
+                             Just f  -> do let a' = lookup f actions
+                                           clearLayout
+                                           oldAction <- getSetting_u "action"
+                                           setSetting "action" (oldAction ++ f)
+                                           case a' of
+                                             Nothing -> return ()
+                                             Just a  -> do a 

Turbinado/Environment/Routes.hs

@@ -36,7 +36,7 @@ runRoutes   = do debugM $ "  Routes.runRoutes : starting"
                  let Routes rs = fromJust' "Routes : runRoutes : getRoutes" $ getRoutes e
                      r         = fromJust' "Routes : runRoutes : getRequest" $ getRequest e
                      p    = URI.uriPath $ HTTP.rqURI r
-                     sets = msum $ map (\(r, k) -> maybe [] (zip k) (matchRegex r p)) rs
+                     sets = head $ filter (not . null) $ map (\(r, k) -> maybe [] (zip k) (matchRegex r p)) rs
                  case sets of
                   [] -> throwController $ ParameterLookupFailed $ "No routes matched for " ++ p
                   _  -> do mapM (\(k, v) -> setSetting k v) sets

Turbinado/Environment/Settings.hs

@@ -60,7 +60,6 @@ getSetting_u s = do v <- getSetting s
 -- 'show' to convert to a String). 
 setSetting :: (HasEnvironment m, Typeable a) => String -> a -> m ()
 setSetting k v = do e <- getEnvironment
-                    debugM $ "  setSetting :   " ++ k
                     setEnvironment $ e { getSettings = Just (M.insert k (toDyn v) (fromJust' "Settings : setSetting" $ getSettings e))}
 
 -- | Unsets a setting.  If the key does not exist, no error is thrown.