-
Notifications
You must be signed in to change notification settings - Fork 0
/
Types.hs
186 lines (152 loc) · 5.95 KB
/
Types.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
module Turbinado.Environment.Types where
import Data.Dynamic
import qualified Data.Map as M
import Data.Maybe
import Data.Time
import System.IO
import System.IO.Unsafe
import System.Log.Logger
import Text.Regex
import Control.Concurrent.MVar
import Control.Monad.State
import qualified Network.HTTP as HTTP
import HSX.XMLGenerator (XMLGenT(..), unXMLGenT)
import Turbinado.View.XML
import Database.HDBC
import Codec.MIME.Type (MIMEValue)
-- | The class of types which hold an 'Environment'.
-- 'View' and 'Controller' are both instances of this class.
class (MonadIO m) => HasEnvironment m where
getEnvironment :: m Environment
setEnvironment :: Environment -> m ()
-- | The Environment in which each request is handled.
-- All components are held within 'Maybe's so that the
-- Environment can be partially constructed.
data Environment = Environment { getCodeStore :: Maybe CodeStore
, getDatabase :: Maybe ConnWrapper
, getFiles :: Maybe Files
, getLoggerLock :: Maybe LoggerLock
, getMimeTypes :: Maybe MimeTypes
, getParams :: Maybe Params
, getRequest :: Maybe (HTTP.Request String)
, getResponse :: Maybe (HTTP.Response String)
, getRoutes :: Maybe Routes
, getSession :: Maybe Session
, getSettings :: Maybe Settings
, getViewData :: Maybe ViewData
, getAppEnvironment :: Maybe (MVar Dynamic)
}
-- | Construct a new empty 'Environment'.
newEnvironment :: Environment
newEnvironment = Environment { getCodeStore = Nothing
, getDatabase = Nothing
, getFiles = Nothing
, getLoggerLock = Nothing
, getMimeTypes = Nothing
, getParams = Nothing
, getRequest = Nothing
, getResponse = Nothing
, getRoutes = Nothing
, getSession = Nothing
, getSettings = Nothing
, getViewData = Nothing
, getAppEnvironment = Nothing
}
--
-- * Types for CodeStore
--
data CodeType = CTView | CTController | CTComponentView | CTComponentController | CTLayout deriving (Show)
type CodeDate = UTCTime
type Function = String
type CodeLocation = (FilePath, Function)
data CodeStore = CodeStore (MVar CodeMap)
type CodeMap = M.Map CodeLocation CodeStatus
data CodeStatus = CodeLoadMissing |
CodeLoadFailure String |
CodeLoadController (StateT Environment IO ()) CodeDate |
CodeLoadView (XMLGenT (StateT Environment IO) XML ) CodeDate |
CodeLoadComponentController (StateT Environment IO ()) CodeDate |
CodeLoadComponentView (XMLGenT (StateT Environment IO) XML ) CodeDate
--
-- * Types for Cookies
--
-- | Contains all information about a cookie set by the server.
data Cookie = Cookie {
-- | Name of the cookie.
cookieName :: String,
-- | Value of the cookie.
cookieValue :: String,
-- | Expiry date of the cookie. If 'Nothing', the
-- cookie expires when the browser sessions ends.
-- If the date is in the past, the client should
-- delete the cookie immediately.
cookieExpires :: Maybe UTCTime,
-- | The domain suffix to which this cookie will be sent.
cookieDomain :: Maybe String,
-- | The path to which this cookie will be sent.
cookiePath :: Maybe String
}
deriving (Show, Read, Eq, Ord)
--
-- * Types for Files
--
data Files = Files (M.Map String MIMEValue)
--
-- * Types for Logger
--
type LoggerLock = MVar ()
--
-- * Types for MimeTypes
--
data MimeTypes = MimeTypes (M.Map String MimeType)
data MimeType = MimeType String String
instance Show MimeType where
showsPrec _ (MimeType part1 part2) = showString (part1 ++ '/':part2)
--
-- * Types for Files
--
data Params = Params (M.Map String String)
--
-- * Types for Request
--
-- Just a basic Request from Network.HTTP
--
-- * Types for Response
--
-- Just a basic Response from Network.HTTP
--
-- * Types for Routes
--
type Keys = [String]
data Routes = Routes [(Regex, Keys)]
--
-- * Types for Session
--
data Session = Session {
sessionName :: Maybe String, -- Used by Cookie session
sessionId :: Maybe Int, -- Used by DB and Filesystem sessions
expires :: Maybe UTCTime,
dataRep :: M.Map String String
} deriving (Eq, Read, Show)
emptySession = Session Nothing Nothing Nothing M.empty
class HasSession m where
newSession :: [(String, String)] -> m ()
retrieveSession :: [(String, String)] -> m ()
persistSession :: [(String, String)] -> m ()
hasValidSession :: m Bool
abandonSession :: m ()
getSessionValue :: String -> m (Maybe String)
setSessionValue :: String -> String -> m ()
deleteSessionKey :: String -> m ()
getSessionId :: m (Maybe Int)
setSessionId :: Maybe Int -> m ()
getSessionExpires :: m (Maybe UTCTime)
setSessionExpires :: Maybe UTCTime -> m ()
--
-- * Types for Settings
--
type Settings = M.Map String Dynamic
--
-- * Types for ViewData
--
type ViewData = M.Map String Dynamic