content: module Turbinado.Environment.Routes (
      addRoutesToEnvironment,
      runRoutes
      ) where
  
  import Control.Concurrent.MVar
  import Text.Regex
  import Data.Maybe
  import Data.Typeable
  import Data.Dynamic
  import qualified Data.Map as M
  import Data.Time
  import Control.Monad
  import qualified Network.HTTP as HTTP
  import qualified Network.URI as URI
  import Turbinado.Controller.Monad
  import Turbinado.Controller.Exception
  import Turbinado.Environment.Types
  import Turbinado.Environment.Logger
  import Turbinado.Environment.Request
  import Turbinado.Environment.Settings
  import qualified Turbinado.Environment.Settings as S
  import Turbinado.Utility.Data
  
  import qualified Config.Routes
  
  addRoutesToEnvironment :: (HasEnvironment m) => m ()
  addRoutesToEnvironment = do e <- getEnvironment
                              let CodeStore mv = fromJust' "Turbinado.Environment.Routes.addRoutesToEnvironment : no CodeStore" $ getCodeStore e
                              cm <- liftIO $ takeMVar mv
                              let cm'  = addStaticControllers Config.Routes.staticControllers cm
                                  cm'' = addStaticViews (Config.Routes.staticViews ++ Config.Routes.staticLayouts) cm'
                              liftIO $ putMVar mv cm''
                              setEnvironment $ e {
                                getRoutes = Just $ Routes $ parseRoutes Config.Routes.routes}
  
  
  ------------------------------------------------------------------------------
  -- Given an Environment
  ------------------------------------------------------------------------------
  
  runRoutes :: (HasEnvironment m) => m ()
  runRoutes   = do debugM $ "  Routes.runRoutes : starting"
                   e <- getEnvironment
                   let Routes rs = fromJust' "Routes : runRoutes : getRoutes" $ getRoutes e
                       r         = fromJust' "Routes : runRoutes : getRequest" $ getRequest e
                       p    = URI.uriPath $ HTTP.rqURI r
                       sets = filter (not . null) $ map (\(r, k) -> maybe [] (zip k) (matchRegex r p)) rs
                   case sets of
                    [] -> do setSetting "controller" $ last Config.Routes.routes  -- no match, so use the last route
                             addDefaultAction
                    _  -> do mapM (\(k, v) -> setSetting k v) $ head sets
                             addDefaultAction
  
  addDefaultAction :: (HasEnvironment m) => m ()
  addDefaultAction   = do e <- getEnvironment
                          let s = fromJust' "Routes : addDefaultAction : getSettings" $ getSettings e
                          setEnvironment $ e {getSettings = Just (M.insertWith (\ a b -> b) "action" (toDyn "Index") s)}
  
  ------------------------------------------------------------------------------
  -- Generate the Routes from [String]
  ------------------------------------------------------------------------------
  
  parseRoutes = map (\s -> (routeRegex s, extractKeys s))
  
  extractKeys = map (drop 1) . filter (\l -> (take 1 l) == ":") . ( \s -> concat $ map (splitOn '/') $ splitOn '.' s)
  routeRegex = mkRegex . generateRouteRegex
  
  generateRouteKeysRegexString = "([^/^\\.]+)"
  generateRouteRegexRegex = mkRegex generateRouteKeysRegexString
  generateRouteRegex =  \s -> subRegex generateRouteRegexRegex (escapePeriods s) "([^/^\\.]+)"
  
  escapePeriods []     = []
  escapePeriods ('.':cs) = "\\." ++ escapePeriods cs
  escapePeriods ( c :cs) = c      : escapePeriods cs
  
  splitOn :: Char -> String -> [String]
  splitOn c l = reverse $ worker c l []
       where worker c [] r = r
             worker c (l:ls) [] = if (l == c)
                                    then worker c ls []
                                    else worker c ls [[l]]
             worker c (l:ls) (r:rs) = if (l == c) 
                                        then worker c ls ([]:r:rs)
                                        else worker c ls ((r++[l]):rs)
  
  
  ----------------------------------------------------------------------------
  -- Handle static routes
  ----------------------------------------------------------------------------
  
  --addStaticViews :: [(String, String, View VHtml)] -> CodeMap -> CodeMap
  addStaticViews [] cm = cm
  addStaticViews ((p,f,v):vs) cm = let cm' = M.insert (p,f) (CodeLoadView v $ UTCTime (ModifiedJulianDay 1000000) (secondsToDiffTime 0)) cm in
                                   addStaticViews vs cm'
  
  addStaticControllers [] cm = cm
  addStaticControllers ((p,f,c):cs) cm = let cm' = M.insert (p,f) (CodeLoadController c $ UTCTime (ModifiedJulianDay 1000000) (secondsToDiffTime 0)) cm in
                                         addStaticControllers cs cm'
  
  