diff --git a/Turbinado/Environment.hs b/Turbinado/Environment.hs index 4c8601f..03e611e 100644 --- a/Turbinado/Environment.hs +++ b/Turbinado/Environment.hs @@ -1,30 +1,47 @@ module Turbinado.Environment ( Environment, - EnvironmentFilter, newEnvironment, - getKey, - setKey + EnvironmentFilter ) where -import Data.Dynamic import Data.Map import Data.Maybe import System.IO -import System.IO.Unsafe -import System.Log.Logger +import Config.Master --- Using Dynamic for two reasons: --- 1) Break module cycles (Environment doesn't import the various Request, Response, etc bits --- 2) Extensibility - easy for plugins to add data to the Environment -type Environment = Map String Dynamic +import Turbinado.Environment.CodeStore +import Turbinado.Environment.Logger +import Turbinado.Environment.MimeTypes +import Turbinado.Environment.Request +import Turbinado.Environment.Response +import Turbinado.Environment.Routes +import Turbinado.Environment.Settings +import Turbinado.Environment.ViewData +data Environment = Environment { getCodeStore :: Maybe CodeStore + , getLogger :: Maybe Logger + , getMimeTypes :: Maybe MimeTypes + , request :: Maybe Request + , getResponse :: Maybe Response + , getRoutes :: Maybe Routes + , getSettings :: Maybe Settings + , getViewData :: Maybe ViewData + , getAppEnvironment :: Maybe AppEnvironment + } + type EnvironmentFilter = Environment -> IO Environment newEnvironment :: IO Environment -newEnvironment = return (empty :: Environment) +newEnvironment = return $ Environment { + getCodeStore = Nothing + , getLogger = Nothing + , getMimeTypes = Nothing + , getRequest = Nothing + , getResponse = Nothing + , getRoutes = Nothing + , getSettings = Nothing + , getViewData = Nothing + , getAppEnvironment = Nothing + } + -getKey :: (Typeable a) => String -> Environment -> a -getKey k e = fromJust $ fromDynamic $ e ! k - -setKey :: (Typeable a) => String -> a -> EnvironmentFilter -setKey k v = \e -> return $ insert k (toDyn v) e diff --git a/Turbinado/Environment/CodeStore.hs b/Turbinado/Environment/CodeStore.hs index 1aea75c..abeeacd 100755 --- a/Turbinado/Environment/CodeStore.hs +++ b/Turbinado/Environment/CodeStore.hs @@ -29,7 +29,7 @@ import Config.Master import qualified Turbinado.Server.Exception as Ex import Turbinado.Environment.Logger -import Turbinado.Environment +import {-# SOURCE #-} Turbinado.Environment import Turbinado.Environment.Request import Turbinado.Environment.Response import Turbinado.View.Monad diff --git a/Turbinado/Environment/Logger.hs b/Turbinado/Environment/Logger.hs index 8ddc719..7bf7b80 100755 --- a/Turbinado/Environment/Logger.hs +++ b/Turbinado/Environment/Logger.hs @@ -3,7 +3,7 @@ module Turbinado.Environment.Logger where import qualified System.Log.Logger as L import qualified System.Log.Handler.Simple as S import Control.Concurrent.MVar -import Turbinado.Environment +import {-# SOURCE #-} Turbinado.Environment import Config.Master import Data.Dynamic diff --git a/Turbinado/Environment/MimeTypes.hs b/Turbinado/Environment/MimeTypes.hs index 14a3578..b8bc41a 100644 --- a/Turbinado/Environment/MimeTypes.hs +++ b/Turbinado/Environment/MimeTypes.hs @@ -45,7 +45,7 @@ import Data.Typeable import qualified Data.Map as Map hiding (Map) import Text.ParserCombinators.Parsec -import Turbinado.Environment +import {-# SOURCE #-} Turbinado.Environment data MimeTypes = MimeTypes (Map String MimeType) deriving (Typeable) diff --git a/Turbinado/Environment/Request.hs b/Turbinado/Environment/Request.hs index 060b2b5..814841c 100644 --- a/Turbinado/Environment/Request.hs +++ b/Turbinado/Environment/Request.hs @@ -12,7 +12,7 @@ import Turbinado.Utility.General import qualified Data.Map as M import Control.Monad import Data.Maybe -import Turbinado.Environment +import {-# SOURCE #-} Turbinado.Environment requestKey = "request" @@ -20,13 +20,11 @@ addRequestToEnvironment :: HTTP.Request -> EnvironmentFilter addRequestToEnvironment = setRequest getRequest :: Environment -> HTTP.Request -getRequest = getKey requestKey +getRequest = fromJust $ request setRequest :: HTTP.Request -> EnvironmentFilter -setRequest req = setKey requestKey req +setRequest req e = return $ e { request = Just req} -modifyRequest :: (HTTP.Request -> HTTP.Request) -> EnvironmentFilter -modifyRequest f = getRequest >>= (setRequest . f) {- lookupHeader :: (Monad m) => m (Maybe String) diff --git a/Turbinado/Environment/Response.hs b/Turbinado/Environment/Response.hs index e2756c5..4d3d41b 100755 --- a/Turbinado/Environment/Response.hs +++ b/Turbinado/Environment/Response.hs @@ -12,7 +12,7 @@ import Turbinado.Utility.General import qualified Data.Map as M import Control.Monad import Data.Maybe -import Turbinado.Environment +import {-# SOURCE #-} Turbinado.Environment import System.Time import System.Locale diff --git a/Turbinado/Environment/Routes.hs b/Turbinado/Environment/Routes.hs index 00c0a74..8164f2f 100644 --- a/Turbinado/Environment/Routes.hs +++ b/Turbinado/Environment/Routes.hs @@ -12,7 +12,7 @@ import Control.Monad import qualified Network.HTTP as HTTP import qualified Network.URI as URI import Turbinado.Controller.Exception -import Turbinado.Environment +import {-# SOURCE #-} Turbinado.Environment import Turbinado.Environment.Logger import Turbinado.Environment.Request import Turbinado.Environment.Settings diff --git a/Turbinado/Environment/Settings.hs b/Turbinado/Environment/Settings.hs index 6176ca3..2401edb 100755 --- a/Turbinado/Environment/Settings.hs +++ b/Turbinado/Environment/Settings.hs @@ -17,7 +17,7 @@ import Control.Monad.State import Data.Maybe import Data.Char import System.FilePath -import Turbinado.Environment +import {-# SOURCE #-} Turbinado.Environment type Settings = M.Map String Dynamic diff --git a/Turbinado/Environment/ViewData.hs b/Turbinado/Environment/ViewData.hs index eb6d0b4..54644b3 100644 --- a/Turbinado/Environment/ViewData.hs +++ b/Turbinado/Environment/ViewData.hs @@ -7,7 +7,7 @@ module Turbinado.Environment.ViewData ( import qualified Data.Map as M import Control.Monad import Data.Maybe -import Turbinado.Environment +import {-# SOURCE #-} Turbinado.Environment type ViewData = Map String Dynamic diff --git a/turbinado.cabal b/turbinado.cabal index 2e58cdb..1333151 100644 --- a/turbinado.cabal +++ b/turbinado.cabal @@ -12,7 +12,7 @@ Executable server Main-is: Turbinado/Server.hs Build-Depends: base, bytestring, containers, directory, filepath, harp, hslogger, hsx, HTTP, mtl, network, old-locale, old-time, parsec, plugins, pretty, regex-compat, time Hs-Source-Dirs: . , config - ghc-options: -F -pgmFtrhsx -O + ghc-options: -O Extensions: MultiParamTypeClasses, FunctionalDependencies, TypeFamilies,