Skip to content
Newer
Older
100755 111 lines (92 sloc) 3.42 KB
daaafff @alsonkemp Initial commit
authored
1 module Turbinado.View (
2 getEnvironment,
3 setEnvironment,
4 evalView,
5 defaultContentType,
6 modifyEnvironment,
7 -- limited export from Turbinado.View.Monad
8 View, ViewT, ViewT',
9 runView, runViewT,
10 -- * Functions
11 doIO, catch,
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,
19 module Turbinado.Environment.CodeStore,
20 module Turbinado.Environment.Request,
21 module Turbinado.Environment.Response,
22 ) where
23
24 import Control.Exception (catchDyn)
25 import Control.Monad
26 import Control.Monad.State
27 import Control.Monad.Trans (MonadIO(..))
28 import Data.Maybe
29 import qualified Network.HTTP as HTTP
30 import Prelude hiding (catch)
31
32 import Turbinado.Environment
33 import Turbinado.Environment.Request
34 import Turbinado.Environment.Response
35 import Turbinado.View.Exception
36 import Turbinado.View.HTML
37 import Turbinado.View.Monad
38 import Turbinado.View.XML hiding (Name)
39 import Turbinado.View.XML.PCDATA
40 import Turbinado.View.XMLGenerator
41 import Turbinado.Environment.CodeStore
42 import Turbinado.Utility.General
43
44
45 evalView :: View XML -> EnvironmentFilter
46 evalView p e =
47 do (x, e') <- runView p e
48 case (HTTP.rspCode $ getResponse e') of
49 (0,0,0) -> setResponse ((getResponse e) {HTTP.rspCode = (2,0,0), HTTP.rspBody = renderAsHTML x}) e'
50 _ -> return e'
51
52 {-
53 evalView :: View XML -> EnvironmentFilter
54 evalView p e =
55 catch
56 (do (x, e') <- runView p e
57 case (HTTP.rspCode $ getResponse e') of
58 (0,0,0) -> return $ setResponse ((getResponse e) {HTTP.rspCode = (2,0,0), HTTP.rspBody = renderXML x}) e'
59 _ -> return e' )
60 (\ex -> setResponse (HTTP.Response (4,0,0) "" [] "evalView failed") e)
61 -}
62
63
64 defaultContentType :: String
65 defaultContentType = "text/html; charset=ISO-8859-1"
66
67 --
68 -- * Environment functions
69 --
70
71 getEnvironment :: View Environment
72 getEnvironment = lift get
73
74 setEnvironment :: Environment -> View ()
75 setEnvironment e = lift $ put e
76
77 modifyEnvironment :: (Environment -> Environment) -> View ()
78 modifyEnvironment = lift . modify
79
80 --
81 -- * Header functions
82 --
83
84 --
85 -- * Cookie functions
86 --
87
88 {-
89 -- | Get the value of a cookie.
90 getCookie :: String -- ^ The name of the cookie.
91 -> View (Maybe String) -- ^ 'Nothing' if the cookie does not exist.
92 getCookie name = getRequest >>= \r -> return $ Cookie.findCookie name
93 (fromMaybe "" $ HTTP.lookupHeader HTTP.HdrCookie (HTTP.rqHeaders $ httpRequest r))
94
95 -- | Same as 'getCookie', but tries to read the value to the desired type.
96 readCookie :: (Read a) =>
97 String -- ^ The name of the cookie.
98 -> View (Maybe a) -- ^ 'Nothing' if the cookie does not exist
99 -- or if the value could not be interpreted
100 -- at the desired type.
101 readCookie = liftM (>>= maybeRead) . getCookie
102
103 -- | Set a cookie.
104 setCookie :: Cookie.Cookie -> View HTTP.Response
105 setCookie c = getResponse >>= return . HTTP.replaceHeader HTTP.HdrSetCookie (Cookie.showCookie c)
106
107 -- | Delete a cookie from the client
108 deleteCookie :: Cookie.Cookie -> View HTTP.Response
109 deleteCookie = setCookie . Cookie.deleteCookie
110 -}
Something went wrong with that request. Please try again.