[stress test uses parsec instead of pcre, making install more straightforward
thomashartman1@gmail.com**20081006103224] hunk ./src/Controller.hs 63
- , dir "jobs" [ methodSP GET . viewJobs $ rglobs]
+ , dir "jobs" [ methodSP GET $ viewJobs rglobs]
hunk ./src/Controller.hs 67
- , dir "editconsultantprofile" [ methodSP GET . viewEditConsultantProfile $ rglobs ]
- , dir "editconsultantprofile" [ methodSP POST . processformEditConsultantProfile $ rglobs ]
+ , dir "editconsultantprofile" [ methodSP GET $ viewEditConsultantProfile rglobs ]
+ , dir "editconsultantprofile" [ methodSP POST $ processformEditConsultantProfile rglobs ]
hunk ./src/Controller.hs 70
- , dir "editjob" [ methodSP GET . viewEditJobWD $ rglobs ]
- , dir "deletejob" [ methodSP GET . deleteJobWD $ rglobs ]
- , dir "editjob" [ methodSP POST . processformEditJob $ rglobs ]
+ , dir "editjob" [ methodSP GET $ viewEditJobWD rglobs ]
+ , dir "deletejob" [ methodSP GET $ deleteJobWD rglobs ]
+ , dir "editjob" [ methodSP POST $ processformEditJob rglobs ]
hunk ./src/Controller.hs 74
- , dir "postnewjob" [ methodSP POST . processformNewJob $ rglobs ]
- , dir "myjobposts" [ methodSP GET . pageMyJobPosts $ rglobs ]
- , dir "viewprofile" [ methodSP GET . userProfile $ rglobs ]
- , dir "viewjob" [ methodSP GET . viewJob $ rglobs ]
+ , dir "postnewjob" [ methodSP POST $ processformNewJob rglobs ]
+ , dir "myjobposts" [ methodSP GET $ pageMyJobPosts rglobs ]
+ , dir "viewprofile" [ methodSP GET $ userProfile rglobs ]
+ , dir "viewjob" [ methodSP GET $ viewJob rglobs ]
hunk ./src/Controller.hs 79
- [ dir "login" [ methodSP POST . loginPage $ rglobs ]
- , dir "newuser" [ methodSP POST . newUserPage $ rglobs ]
+ [ dir "login" [ methodSP POST $ loginPage rglobs ]
+ , dir "newuser" [ methodSP POST $ newUserPage rglobs ]
hunk ./src/Controller.hs 88
-spJustShowTemplate rglobs = lastPathPartSp0 (\_ tmpl -> ( return . tutlayoutU rglobs []) tmpl )
+spJustShowTemplate rglobs = lastPathPartSp0 (\_ tmpl -> return $ tutlayoutU rglobs [] tmpl )
hunk ./src/ControllerGetActions.hs 53
- fromData = liftM2 JobLookup (look "user")
- (look "job")
+ fromData = liftM2 JobLookup (look "user" `mplus` return "")
+ (look "job" `mplus` return "")
hunk ./src/ControllerGetActions.hs 74
- fromData = liftM UserNameUrlString (look "user")
+ fromData = liftM UserNameUrlString (look "user" `mplus` return "")
hunk ./src/ControllerStressTests.hs 1
+{-# LANGUAGE NoMonomorphismRestriction #-}
hunk ./src/ControllerStressTests.hs 10
-import Text.Regex.PCRE
hunk ./src/ControllerStressTests.hs 11
+import Text.ParserCombinators.Parsec
hunk ./src/ControllerStressTests.hs 32
- let startNum = case ( mapMaybe ( parseDummyNumber . username ) us ) of
+ let startNum = case ( mapMaybe ( getDummyNumber . username ) us ) of
hunk ./src/ControllerStressTests.hs 41
+{-
hunk ./src/ControllerStressTests.hs 45
- matched@(_,_,_,subgroups) = u =~ "^(user)(\\d*)$"
+ matched@(_,_,_,subgroups) = u =~ "^(user)([[:digit]]*)$"
hunk ./src/ControllerStressTests.hs 50
+-}
+
+
+
+getDummyNumber :: String -> Maybe Int
+getDummyNumber s = do
+ let i = parse parseDummyNumber "parseDummyNumber" s
+ case i of
+ Left err -> Nothing
+ Right i -> Just i
+
+
+
+parseDummyNumber :: Parser Int
+parseDummyNumber = do
+ string "user"
+ i <- return . read =<< many digit
+ eof
+ return i
hunk ./src/ControllerStressTests.hs 86
- liftIO $ putStrLn $ show ("adding job",username u,jobname j)
+ -- liftIO $ putStrLn $ show ("adding job",username u,jobname j)
hunk ./templates/getandpost.st 1
-Get and post data
+GET and POST data
+
+
GET data is data attached to an http request via the url string. In the job board app, an example of this is
+ tphyahoo's profile, where the user is specified on the url string.
+ Another example is fetching a particular job.
+
+
POST data is data attached to a request after submitting a form.
+ One place this is used is in the registration process.
+ Once you have a user created, you can also see POST in action by editing your profile or creating jobs.
+
+
HAppS deals with GET and POST data similarly.
+
+
Let's look at how
+ tphyahoo's profile gets displayed.
+
+
Controller.hs: ... , dir "viewprofile" [ methodSP GET \$ userProfile rglobs ] ...
+
+
using dir and methodSP as above is a common pattern. dir pops the head element of the path array
+ ["viewprofile"], resulting in an empty array. methodSP checks that the path array is empty and that
+ the method is GET. If so, control is passed to the next sp: userProfile rglobs, which is in another module.
+
+
ControllerGetActions.hs:
+
+
data UserNameUrlString = UserNameUrlString {profilename :: String}
+
instance FromData UserNameUrlString where
+
fromData = liftM UserNameUrlString (look "user" `mplus` return "")
+
userProfile rglobs =
+
withData \$ \(UserNameUrlString user) ->
+
[ ServerPartT \$ \rq -> do .....
+
+
+
*Main> :t withData :: FromData a => (a->[ServerPartT IO Response]) -> ServerPartT IO Response
+
+
The above is the main pattern for processing GET or POST data in happs.
+
+
First, you decide what argument type withData should accept. This might be a datatype you have already
+ defined, like User or Job, which already plays a major role in the app.
+ Or it could be an ad-hoc datatype which is only used this once, in the form processing.
+ Whatever the case you declare that data type an instance of FromData, and define how it should
+ grab data attached to the request. In this case, UserNameUrlString takes one argument, so we use LiftM
+ -- for two args we would use LiftM2, three args LiftM3 etc.
+ To get that one arg, we look for a request GET variable named "user" and if we don't find it we
+ use a reasonable default, in this case the empty string. The result is a value of type UserNameUrlString
+ which gets passed to the ServerPartT handler in the userProfile function.
+
+
Another use is... (pagination. now... sleeep.....)
+