Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100755 96 lines (87 sloc) 4.478 kb
daaafff @alsonkemp Initial commit
authored
1 module Turbinado.View (
2 getEnvironment,
3 setEnvironment,
4 evalView,
5 defaultContentType,
6 -- limited export from Turbinado.View.Monad
7 View, ViewT, ViewT',
8 runView, runViewT,
9 -- * Functions
1e33cd0 @alsonkemp Switching to HasEnvironment class; adding 'Components'; improving the…
authored
10 liftIO, catch,
11 insertComponent,
daaafff @alsonkemp Initial commit
authored
12
13 -- Module Exports
14 module Turbinado.View.HTML,
15 module Turbinado.View.XML,
16 module Turbinado.View.XML.PCDATA,
17 module Turbinado.View.XMLGenerator,
18 module Turbinado.Environment.CodeStore,
a1aa2cd @alsonkemp Updating the ORM; Adding a mini-CMS; Adding a little HAML translator
authored
19 module Turbinado.Environment.Params,
daaafff @alsonkemp Initial commit
authored
20 module Turbinado.Environment.Request,
21 module Turbinado.Environment.Response,
a8f9a12 @alsonkemp still learning git... updates...
authored
22 module Turbinado.Environment.Settings,
a1aa2cd @alsonkemp Updating the ORM; Adding a mini-CMS; Adding a little HAML translator
authored
23 module Turbinado.Environment.Types,
24 module Turbinado.Environment.ViewData
daaafff @alsonkemp Initial commit
authored
25 ) where
26
27 import Control.Exception (catchDyn)
28 import Control.Monad
29 import Control.Monad.State
30 import Control.Monad.Trans (MonadIO(..))
1e33cd0 @alsonkemp Switching to HasEnvironment class; adding 'Components'; improving the…
authored
31 import Data.Char
a8f9a12 @alsonkemp still learning git... updates...
authored
32 import Data.List
daaafff @alsonkemp Initial commit
authored
33 import Data.Maybe
34 import qualified Network.HTTP as HTTP
a8f9a12 @alsonkemp still learning git... updates...
authored
35 import qualified Network.URI as URI
daaafff @alsonkemp Initial commit
authored
36 import Prelude hiding (catch)
a8f9a12 @alsonkemp still learning git... updates...
authored
37 import System.FilePath
daaafff @alsonkemp Initial commit
authored
38
c59c8d3 Checking in all of the Environment + Website changes
alson authored
39 import Turbinado.Controller.Monad hiding (catch)
40 import Turbinado.Environment.CodeStore
1e33cd0 @alsonkemp Switching to HasEnvironment class; adding 'Components'; improving the…
authored
41 import Turbinado.Environment.Logger
a1aa2cd @alsonkemp Updating the ORM; Adding a mini-CMS; Adding a little HAML translator
authored
42 import Turbinado.Environment.Params
daaafff @alsonkemp Initial commit
authored
43 import Turbinado.Environment.Request
44 import Turbinado.Environment.Response
a8f9a12 @alsonkemp still learning git... updates...
authored
45 import Turbinado.Environment.Settings
c59c8d3 Checking in all of the Environment + Website changes
alson authored
46 import Turbinado.Environment.Types
a1aa2cd @alsonkemp Updating the ORM; Adding a mini-CMS; Adding a little HAML translator
authored
47 import Turbinado.Environment.ViewData
c59c8d3 Checking in all of the Environment + Website changes
alson authored
48 import Turbinado.Server.StandardResponse
daaafff @alsonkemp Initial commit
authored
49 import Turbinado.View.Exception
50 import Turbinado.View.HTML
1e33cd0 @alsonkemp Switching to HasEnvironment class; adding 'Components'; improving the…
authored
51 import Turbinado.View.Monad hiding (liftIO)
daaafff @alsonkemp Initial commit
authored
52 import Turbinado.View.XML hiding (Name)
53 import Turbinado.View.XML.PCDATA
54 import Turbinado.View.XMLGenerator
55 import Turbinado.Utility.General
56
1e33cd0 @alsonkemp Switching to HasEnvironment class; adding 'Components'; improving the…
authored
57 evalView :: (HasEnvironment m) => View XML -> m ()
58 evalView p = do e <- getEnvironment
59 (x, e') <- liftIO $ runView p e
c59c8d3 Checking in all of the Environment + Website changes
alson authored
60 pageResponse [] $ renderAsHTML x
daaafff @alsonkemp Initial commit
authored
61
62 defaultContentType :: String
63 defaultContentType = "text/html; charset=ISO-8859-1"
64
1e33cd0 @alsonkemp Switching to HasEnvironment class; adding 'Components'; improving the…
authored
65 insertComponent :: String -> String -> [(String, String)] -> View XML
66 insertComponent controller action opts =
67 do debugM $ " insertComponent: Starting"
68 p <- retrieveCode CTComponentController (controller, (toLower $ head action) : (tail action))
69 case p of
70 CodeLoadMissing -> return $ cdata $ "insertComponent error: code missing : " ++ controller ++ " - " ++ action
71 CodeLoadFailure e -> return $ cdata $ "insertComponent error: " ++ e
72 CodeLoadComponentController p' _ _ -> do oldE <- getEnvironment
73 mapM_ (\(k, v) -> setSetting k v) opts
74 lift $ p'
75 -- allow for overloading of the Component Controller and View
76 c <- getSetting "component-controller"
77 a <- getSetting "component-view"
78 insertComponentView oldE (fromMaybe controller c) (fromMaybe action a)
79 _ -> return $ cdata $ "insertComponent error: received incorrect CodeStatus"
80
81 insertComponentView :: Environment -> String -> String -> View XML
82 insertComponentView oldE controller action =
83 do debugM $ " insertComponentView: Starting"
84 v <- retrieveCode CTComponentView (joinPath [controller, action], "markup")
85 case v of
86 CodeLoadMissing -> do setEnvironment oldE
87 return $ cdata $ "insertComponentView error: code missing : " ++ (joinPath [controller, action]) ++ " - markup"
88 CodeLoadFailure e -> do setEnvironment oldE
89 return $ cdata $ "insertComponentView error: " ++ e
90 CodeLoadComponentView v' _ _ -> do res <- v'
91 setEnvironment oldE
92 return res
93 _ -> do setEnvironment oldE
94 return $ cdata $ "insertComponentView error"
a8f9a12 @alsonkemp still learning git... updates...
authored
95
Something went wrong with that request. Please try again.