Commit 0aa10919 authored by Bryan Richter's avatar Bryan Richter

Merge branch 'release-0.1.4' into production

parents 3969bb94 9959bf47
......@@ -90,7 +90,7 @@ withEnv k v action = do
liftIO $ setEnv k v True
result <- action
liftIO $ maybe (unsetEnv k) (\ v' -> setEnv k v' True) original
liftIO $ maybe (unsetEnv k) (\v' -> setEnv k v' True) original
return result
......@@ -156,7 +156,7 @@ makeFoundation conf = do
-- Perform database migration using our application's logging settings.
case appEnv conf of
Testing -> withEnv "PGDATABASE" "template1" (applyEnv $ persistConfig foundation) >>= \ dbconf' -> do
Testing -> withEnv "PGDATABASE" "template1" (applyEnv $ persistConfig foundation) >>= \dbconf' -> do
options <- maybe [] L.words <$> lookupEnv "SNOWDRIFT_TESTING_OPTIONS"
unless (elem "nodrop" options) $ do
......@@ -224,10 +224,10 @@ deprecatedApplyManualMigrations = do
let migration_files :: [(Int, String)]
migration_files = L.sort
$ L.filter ((> migration_number) . fst)
$ mapMaybe (\ s -> fmap (,s) $ readMaybe =<< L.stripPrefix "migrate" s)
$ mapMaybe (\s -> fmap (,s) $ readMaybe =<< L.stripPrefix "migrate" s)
unfiltered_migration_files
forM_ (L.map (("migrations/" <>) . snd) migration_files) $ \ file -> do
forM_ (L.map (("migrations/" <>) . snd) migration_files) $ \file -> do
$(logWarn) $ "running " <> T.pack file <> "..."
migration <- liftIO $ T.readFile file
runSql migration
......
This diff is collapsed.
......@@ -61,9 +61,9 @@ timeConstraintP :: Parser (Filterable -> Bool)
timeConstraintP =
foldl1 (<|>) $ [before, after, between] <*> ["CREATED", "LAST UPDATED"]
where
before name = (\ end x -> not $ S.null $ fst $ S.split end $ getNamedTs x name) <$> (A.string name *> stripP "BEFORE" *> timeP)
after name = (\ start x -> not $ S.null $ snd $ S.split start $ getNamedTs x name) <$> (A.string name *> stripP "AFTER" *> timeP)
between name = (\ start end x -> not $ S.null $ snd $ S.split start $ fst $ S.split end $ getNamedTs x name) <$> (A.string name *> stripP "BETWEEN" *> timeP <* stripP "AND") <*> timeP
before name = (\end x -> not $ S.null $ fst $ S.split end $ getNamedTs x name) <$> (A.string name *> stripP "BEFORE" *> timeP)
after name = (\start x -> not $ S.null $ snd $ S.split start $ getNamedTs x name) <$> (A.string name *> stripP "AFTER" *> timeP)
between name = (\start end x -> not $ S.null $ snd $ S.split start $ fst $ S.split end $ getNamedTs x name) <$> (A.string name *> stripP "BETWEEN" *> timeP <* stripP "AND") <*> timeP
timeP :: Parser UTCTime
timeP = fmap (`UTCTime` 0) $ stripP $ fromGregorian <$> (read <$> A.count 4 digit) <* "-" <*> (read <$> A.count 2 digit) <* "-" <*> (read <$> A.count 2 digit)
......
......@@ -35,7 +35,7 @@ stripP :: Parser a -> Parser a
stripP p = let ws = A.takeWhile (inClass " \t") in ws *> p <* ws
seqP :: Parser (Orderable -> [Double])
seqP = (\ fs ord -> map ($ ord) fs) <$> seqP'
seqP = (\fs ord -> map ($ ord) fs) <$> seqP'
where seqP' = (:) <$> expressionP <* stripP ";" <*> seqP' <|> return <$> expressionP
expressionP :: Parser (Orderable -> Double)
......@@ -88,13 +88,13 @@ timeConstraintP =
void $ A.string name
void $ stripP "BEFORE"
end <- timeP
return $ \ x -> fromIntegral $ fromEnum $ not $ S.null $ fst $ S.split end $ getNamedTs x name
return $ \x -> fromIntegral $ fromEnum $ not $ S.null $ fst $ S.split end $ getNamedTs x name
after name = do
void $ A.string name
void $ stripP "AFTER"
start <- timeP
return $ \ x -> fromIntegral $ fromEnum $ not $ S.null $ snd $ S.split start $ getNamedTs x name
return $ \x -> fromIntegral $ fromEnum $ not $ S.null $ snd $ S.split start $ getNamedTs x name
between name = do
void $ A.string name
......@@ -102,12 +102,12 @@ timeConstraintP =
start <- timeP
void $ stripP "AND"
end <- timeP
return $ \ x -> fromIntegral $ fromEnum $ not $ S.null $ snd $ S.split start $ fst $ S.split end $ getNamedTs x name
return $ \x -> fromIntegral $ fromEnum $ not $ S.null $ snd $ S.split start $ fst $ S.split end $ getNamedTs x name
time name = do
void $ A.string name
void $ stripP "TIME"
return $ \ x -> maybe (-1) (toTimeValue . fst) $ S.maxView $ getNamedTs x name
return $ \x -> maybe (-1) (toTimeValue . fst) $ S.maxView $ getNamedTs x name
timeP :: Parser UTCTime
timeP = fmap (`UTCTime` 0) $ stripP $ fromGregorian <$> (read <$> A.count 4 digit) <* "-" <*> (read <$> A.count 2 digit) <* "-" <*> (read <$> A.count 2 digit)
......
......@@ -109,7 +109,7 @@ mkYesodData "App" $(parseRoutesFile "config/routes")
type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget)
licenseNotice :: LB.ByteString
licenseNotice = E.encodeUtf8 $ renderJavascriptUrl (\ _ _ -> T.empty) [julius|
licenseNotice = E.encodeUtf8 $ renderJavascriptUrl (\_ _ -> T.empty) [julius|
/*
@licstart The following is the entire license notice for the JavaScript code in this page.
......@@ -196,7 +196,7 @@ instance Yesod App where
$nothing
You are not logged in, and this page is not publicly visible. #
<a href="@{AuthR LoginR}">Log in or create an account
\ or return to our #
\or return to our #
<a href="@{HomeR}">main page
.
|]
......@@ -391,10 +391,10 @@ createUser ident passwd name email avatar nick = do
-- TODO: refactor back to insertSelect when quoting issue is resolved
--
-- insertSelect $ from $ \ p -> return $ TagColor <# (p ^. DefaultTagColorTag) <&> val user_id <&> (p ^. DefaultTagColorColor)
-- insertSelect $ from $ \p -> return $ TagColor <# (p ^. DefaultTagColorTag) <&> val user_id <&> (p ^. DefaultTagColorColor)
--
default_tag_colors <- select $ from return
forM_ default_tag_colors $ \ (Entity _ (DefaultTagColor tag color)) -> insert $ TagColor tag user_id color
forM_ default_tag_colors $ \(Entity _ (DefaultTagColor tag color)) -> insert $ TagColor tag user_id color
--
insertDefaultNotificationPrefs user_id
......
......@@ -51,8 +51,7 @@ Working on the code
===================
Again, see our [Beginners' Guide](BEGINNERS.md) for the simplest setup
if you have only minimal development experience and are running Debian or
Ubuntu GNU/Linux or a related derivative.
if you have only minimal development experience.
The Beginners' Guide also has links to various support and learning resources.
The details below specify more advanced and particular items.
......@@ -77,12 +76,12 @@ For vim users, your config file .vimrc should include these lines:
au FileType hamlet setl sw=2 sts=2 et
You should also install
[vim Shakespearean Highlighting](https://github.com/pbrisbin/vim-syntax-shakespeare)
[vim Shakespearean Highlighting](https://github.com/pbrisbin/vim-syntax-shakespeare).
Some other optional vim plugins to consider (among many available):
[Haskell-Vim extra syntax](https://github.com/raichoo/haskell-vim)
and
[vim2hs](https://github.com/dag/vim2hs)
[vim2hs](https://github.com/dag/vim2hs).
### Emacs
......@@ -90,9 +89,10 @@ and
Emacs users should use a package manager (preferably Marmalade) to install
[Haskell Mode](https://github.com/haskell/haskell-mode)
and
[Hamlet Mode](https://github.com/lightquake/hamlet-mode).
[Shakespeare Mode](https://github.com/CodyReichert/shakespeare-mode).
Our included [`.dir-locals.el`](https://www.gnu.org/software/emacs/manual/html_node/emacs/Directory-Variables.html) file
Our included file
[`.dir-locals.el`](https://www.gnu.org/software/emacs/manual/html_node/emacs/Directory-Variables.html)
makes Emacs use the recommended 4-space indentation.
......@@ -124,19 +124,32 @@ See the appendix at the end of this file for more.
### Build steps
Install the essential dependencies: ghc, cabal, postgresql
The easiest install which works on *any* OS
is with a virtual machine using our
[Vagrant installation instructions](SETUP_VAGRANT.md).
We also have a complete set of steps for
[Debian/Ubuntu installation](SETUP_DEBIAN.md).
Neither of those explain what every command does.
Below, we discuss more of these details.
#### General installation process
The following instructions include more explanation of each step
and references for multiple approaches and different systems.
For any system, you must first install the core dependencies:
ghc, cabal, postgresql, and git.
**Note: we are now using GHC 7.8.x**
Various systems may need some libraries and other dependencies.
**<https://www.haskell.org/downloads/linux>** has instructions for
installing ghc, cabal, happy, and alex on Ubuntu, Fedora, and Arch,
along with manual install instructions for other systems.
Depending on system, additional dependencies may be needed.
Please help update this guide if you discover something certain about that.
Come ask for help at #snowdrift on freenode.net IRC
if you have any trouble or questions (or want to help others who might!).
If you didn't run it as part of installation, update cabal's package list:
After installing the core dependencies, you should update cabal's package list:
cabal update
......@@ -156,13 +169,15 @@ Now, upgrade cabal itself:
cabal install cabal-install
If not done already in earlier steps, install alex and happy:
Install alex, happy, and yesod-bin
(some of which may have been installed, depending on which system and
instructions you used, it won't hurt to reinstall):
cabal install alex happy
cabal install alex happy yesod-bin
The following items are suggested but not strictly required:
cabal install haddock hlint yesod-bin
cabal install haddock hlint
**Now, change to your snowdrift project directory (if not already there).**
......@@ -172,7 +187,7 @@ Then, initiate a cabal sandbox:
Install dependencies and build Snowdrift
cabal install --enable-tests -fdev
cabal install -fdev
This will take a *long* time but should ultimately tell you it installed.
Note: the `-fdev` flag skips optimization to make build faster.
......@@ -197,27 +212,44 @@ To set up databases manually, see the appendix at the end of this guide.
Running the site
----------------
After completing all the steps above,
start the server from within your snowdrift directory with the command:
### Yesod devel
Snowdrift Development
The standard approach for running and working on the site is to run
`yesod devel` from the project directory.
It can stay running in one terminal while work is done elsewhere.
It will automatically rebuild and rerun the site whenever it detects changes.
To stop the running server, press ctrl-C
In rare cases, you may need to run `cabal clean` if yesod devel
fails to recognize a change.
To rebuild after code changes, run `cabal install -fdev`
To stop yesod devel, press ENTER a few times.
(`cabal build -fdev` can work but won't recognize changes to template files)
Note that `yesod devel` builds just the library.
After the server starts, it may print a bunch of text about creating tables,
and it will then sit ready, waiting for connections.
### Alternative option to run the site
Note: if you installed the optional yesod-bin above, you can use `yesod devel`
which automatically re-compiles and runs the site whenever it detects changes.
In some cases (such as .cassius files), where yesod devel fails to recognize
changes, use `cabal install -fdev` as above. See the appendix for how to
install yesod-bin in a separate sandbox if you don't want it installed to
the system generally. At this time, it cannot install in the main Snowdrift
sandbox because of some dependency conflicts.
We recommend `yesod devel` in almost all cases, but an alternate approach is
to separately build with `cabal build` and run the site with
`Snowdrift Development`.
This method is *necessary* when updating extra binaries such as the payment
processing script, the sdm database configuration script, or the email daemon.
For the first time with this method, you should run `cabal configure -fdev`
before `cabal build`. Afterward, the configuration will be remembered.
However, if you run `cabal clean` to get a full fresh build, you will need to
run `cabal configure -fdev` again before `cabal build` (or use
`cabal clean --save-config`)
As before, ommit -fdev to optimize for building the final executables for a live
operating site.
When `cabal build` is done, you can start the server with:
Snowdrift Development
To stop the running server, press ctrl-C
Using the live test site
......@@ -240,12 +272,23 @@ to verify that everything compiles and also appears to work as desired,
best practice involves then running our automated tests before sharing
your changes with the main project.
Assuming you ran `sdm init` to set up the databases, run the tests with:
Assuming you ran `sdm init` to set up the databases,
you can now enable the tests with:
cabal install --enable-tests -fdev
That only needs to be done once. From now on, you can run the tests with:
yesod test
If tests fail, try to figure out what is wrong. Ask us for help if needed.
Sometimes, the tests will need updating, and for that you should run:
cabal clean
cabal configure -fdev
cabal build
yesod test
Additional notes about databases
================================
......@@ -335,41 +378,7 @@ Happy hacking!
---
APPENDIX A: Using yesod devel
=============================
`yesod devel` is a command that will rebuild snowdrift, start the server,
*and* can stay running and automatically update the build after file changes
(although it fails to auto-recognize changes in some file types like .cassius).
To enable yesod devel, you must first install yesod-bin.
However, yesod-bin will not currently build in the main sandbox.
So, at this time, to enable yesod devel, make a new directory for yesod-bin.
Call it "yesod-bin-sandbox" perhaps.
Then, inside the new directory, run `cabal sandbox init`
followed by `cabal install yesod-bin`.
Next, add to the new directory to your PATH. Put in your .bashrc the line:
export PATH=~/yesod-bin-sandbox/.cabal-sandbox/bin:$PATH
(change the ~/ to wherever you actually put the directory)
In a new terminal (so it recognizes the new path),
you can rebuild and start the server in your snowdrift directory by running
yesod devel
To stop yesod devel, press ENTER a couple times
Note that `yesod devel` builds just the library,
so `cabal install -fdev` and related commands are needed to update other
resources like sdm or the payment processing script.
APPENDIX B: Using the Nix package manager
APPENDIX A: Using the Nix package manager
=========================================
We're now testing the use of Nix as a reliable, simple way
......@@ -442,7 +451,6 @@ which runs the testsuite.
You can run the application with `dist/build/Snowdrift/Snowdrift Development`.
Note for users of NixOS
-----------------------
......@@ -459,7 +467,7 @@ Afterwards you may need to create the postgres user, like so:
createuser -s -r postgres
APPENDIX C: Manual database management
APPENDIX B: Manual database management
======================================
Our sdm script makes database management quick and easy.
......
......@@ -70,19 +70,19 @@ donutSharesChart patrons_list = do
(legend, caption_renderers) :: ([Text], [Int -> Double -> Double -> String]) = unzip
[ ( "new pledge amount"
, \ patron_count addition total_funding ->
, \patron_count addition total_funding ->
printf "When the %s patron joins at one share, they contribute $%0.4f. The project's total funding is now $%0.4f per month."
(suffixed patron_count)
addition
total_funding
)
, ( "extra 0.01\162 from one earlier patron"
, \ _ addition _ ->
, \_ addition _ ->
printf "With each new one-share patron, a single earlier patron always adds $%0.4f; and with more patrons, this is a continually smaller portion of the total increased funding."
addition
)
, ( "increase from remaining earlier patrons"
, \ patron_count _ total_funding ->
, \patron_count _ total_funding ->
printf "When the %s patron joins, the earlier patrons together match the new patron's pledge. The project's total funding is now $%0.4f per month."
(suffixed patron_count)
total_funding
......@@ -100,7 +100,7 @@ donutSharesChart patrons_list = do
drawRing pass (index, patrons, amounts) = do
let (colors', amounts') = unzip $ filter ((>0) . snd) $ zip chart_colors amounts
total = sum amounts'
segments = map apply_margin $ tail $ scanl (\ segment (render_caption, amount) ->
segments = map apply_margin $ tail $ scanl (\segment (render_caption, amount) ->
Segment { segmentTitle = T.pack $ render_caption patrons amount (0.0001 * fromIntegral patrons * fromIntegral (patrons - 1))
, segmentStart = segmentEnd segment
, segmentEnd = segmentEnd segment + 2 * pi * amount / total
......@@ -167,11 +167,11 @@ donutSharesChart patrons_list = do
let shares = map (share_value 1) patrons_list
prev = map (share_value 1 . (-1 +) . fromIntegral) patrons_list
increase = zipWith (-) shares prev
remaining_patrons = zipWith (\ d i -> fromIntegral (d - 2) * i) patrons_list increase
remaining_patrons = zipWith (\d i -> fromIntegral (d - 2) * i) patrons_list increase
rings = reverse $ zip3 [1..] patrons_list $ zipWith3 (\ a b c -> [a, b, c]) shares increase remaining_patrons
rings = reverse $ zip3 [1..] patrons_list $ zipWith3 (\a b c -> [a, b, c]) shares increase remaining_patrons
list_desc = conjoin "and" $ map (\ n -> show n ++ number_suffix n) patrons_list
list_desc = conjoin "and" $ map (\n -> show n ++ number_suffix n) patrons_list
toWidget [whamlet|
<a name="donut">
......@@ -243,7 +243,7 @@ shareValueChart = do
max_y = share_value 1 max_x :: Double
xs = [1, (div max_x 10) .. max_x] :: [Int]
ys = map (share_value 1) xs
merge = zipWith $ \ x y -> [fromIntegral x, y]
merge = zipWith $ \x y -> [fromIntegral x, y]
ticks = [0 .. max_y]
plots = [merge xs ys] :: [[[Double]]]
......@@ -276,7 +276,7 @@ projectValueChart = do
max_x = 50000 :: Int
xs = [2, 1000 .. max_x] :: [Int]
ys = map (project_value 1) xs :: [Double]
merge = zipWith $ \ x y -> [fromIntegral x, y]
merge = zipWith $ \x y -> [fromIntegral x, y]
plots = [ merge xs ys ]
......
......@@ -25,8 +25,8 @@ getBuildFeedR = do
render <- getUrlRender
entries :: [FeedEntry (Route App)] <- forM builds $ \ build -> do
let prettyDiff = mapM_ (\ line -> toHtml line >> br) $ T.lines $ buildDiff build
entries :: [FeedEntry (Route App)] <- forM builds $ \build -> do
let prettyDiff = mapM_ (\line -> toHtml line >> br) $ T.lines $ buildDiff build
html = [hamlet|
<pre>
#{prettyDiff}
......
......@@ -679,7 +679,7 @@ postUnwatchComment viewer_id comment_id = do
case result of
FormSuccess () -> do
runYDB $ delete $ from $ \ ws -> do
runYDB $ delete $ from $ \ws -> do
where_ $ ws ^. WatchedSubthreadUser ==. val viewer_id
&&. ws ^. WatchedSubthreadRoot ==. val comment_id
......@@ -791,8 +791,8 @@ postCommentTagR comment_id tag_id = do
case maybe_comment_tag_entity of
Nothing -> insert_ (CommentTag comment_id tag_id user_id delta)
Just (Entity comment_tag_id comment_tag) -> case commentTagCount comment_tag + delta of
0 -> delete $ from $ \ ct -> where_ $ ct ^. CommentTagId ==. val comment_tag_id
x -> void $ update $ \ ct -> do
0 -> delete $ from $ \ct -> where_ $ ct ^. CommentTagId ==. val comment_tag_id
x -> void $ update $ \ct -> do
set ct [ CommentTagCount =. val x ]
where_ $ ct ^. CommentTagId ==. val comment_tag_id
......
......@@ -95,7 +95,7 @@ postNameImageR unnamed_image_id = do
Nothing -> do
setMessage "that name is also already taken, try another"
runYDB $ update $ \ ui -> do
runYDB $ update $ \ui -> do
where_ $ ui ^. UnnamedImageId ==. val unnamed_image_id
set ui [ UnnamedImageName =. val (Just name) ]
......
......@@ -40,7 +40,7 @@ postInvitationR _ code = do
then return Nothing
else do
-- TODO make sure project handle matches invite
update $ \ i -> do
update $ \i -> do
set i [ InviteRedeemed =. val True
, InviteRedeemedTs =. val (Just now)
, InviteRedeemedBy =. val (Just viewer_id)
......
This diff is collapsed.
......@@ -178,7 +178,7 @@ getProjectBlogR project_handle = do
post_count <- fromMaybe 10 <$> fmap (read . T.unpack) <$> lookupGetParam "from"
Entity project_id project <- runYDB $ getBy404 $ UniqueProjectHandle project_handle
let apply_offset blog = maybe id (\ from_blog rest -> blog ^. BlogPostId >=. val from_blog &&. rest) maybe_from
let apply_offset blog = maybe id (\from_blog rest -> blog ^. BlogPostId >=. val from_blog &&. rest) maybe_from
(posts, next) <- fmap (splitAt post_count) $ runDB $
select $
......
......@@ -47,7 +47,7 @@ getRepoFeedR = do
lang = "en"
time = commitTime $ head commits
entries <- forM commits $ \ commit -> do
entries <- forM commits $ \commit -> do
let ls = T.lines $ decodeUtf8 $ commitMessage commit
html <- unlinesHtml <$> mapM (prettyHtml prettyThings) ls
return $ FeedEntry (ProjectR "snowdrift") (commitTime commit) (fromMaybe "empty commit message" $ listToMaybe ls) html
......@@ -75,11 +75,11 @@ commitTime = gitTimeToUTC . personTime . commitAuthor
getCommits :: Git -> Ref -> UTCTime -> IO [Commit]
getCommits repo ref bound = do
tree <- flip unfoldTreeM_BF ref $ \ ref' -> do
tree <- flip unfoldTreeM_BF ref $ \ref' -> do
commit <- getCommit repo ref'
return $ if commitTime commit < bound
then (commit, [])
else (commit, commitParents commit)
return $ sortBy (flip compare `on` commitTime) $ filter (\ a -> length (commitParents a) <= 1) $ concat $ levels tree
return $ sortBy (flip compare `on` commitTime) $ filter (\a -> length (commitParents a) <= 1) $ concat $ levels tree
......@@ -47,11 +47,11 @@ getEventWikiPageR event_wiki_page_id = do
WikiPage{..} <- get404 eventWikiPageWikiPage
Project{..} <- get404 wikiPageProject
targets <- select $ from $ \ wt -> do
targets <- select $ from $ \wt -> do
where_ $ wt ^. WikiTargetPage ==. val eventWikiPageWikiPage
return wt
[ wiki_edit_id ] <- fmap unwrapValues $ select $ from $ \ we -> do
[ wiki_edit_id ] <- fmap unwrapValues $ select $ from $ \we -> do
where_ $ we ^. WikiEditPage ==. val eventWikiPageWikiPage
orderBy [ asc $ we ^. WikiEditTs ]
limit 1
......
......@@ -169,7 +169,7 @@ getUserBalanceR' user_id = do
limit' <- lookupParamDefault "count" 20
(transactions, user_accounts, project_accounts) <- runDB $ do
transactions <- select $ from $ \ transaction -> do
transactions <- select $ from $ \transaction -> do
where_ ( transaction ^. TransactionCredit ==. val (Just (userAccount user))
||. transaction ^. TransactionDebit ==. val (Just (userAccount user)))
orderBy [ desc (transaction ^. TransactionTs) ]
......@@ -183,7 +183,7 @@ getUserBalanceR' user_id = do
projects <- selectList [ ProjectAccount <-. accounts ] []
let mkMapBy :: Ord b => (a -> b) -> [a] -> M.Map b a
mkMapBy f = M.fromList . map (\ e -> (f e, e))
mkMapBy f = M.fromList . map (\e -> (f e, e))
return
( transactions
......@@ -218,7 +218,7 @@ postUserBalanceR user_id = do
then alertDanger "Sorry, minimum deposit is $10"
else do
success <- runDB $ do
c <- updateCount $ \ account -> do
c <- updateCount $ \account -> do
set account [ AccountBalance +=. val amount ]
where_ $ account ^. AccountId ==. val (userAccount user)
&&. account ^. AccountBalance +. val amount <=. val balanceCap
......@@ -544,7 +544,7 @@ getUserTicketsR user_id = do
mviewer_id <- maybeAuthId
-- TODO: abstract out grabbing the project
claimed_tickets <- runDB $ select $ from $ \ (c `InnerJoin` t `InnerJoin` tc `LeftOuterJoin` wp `LeftOuterJoin` wt `InnerJoin` p) -> do
claimed_tickets <- runDB $ select $ from $ \(c `InnerJoin` t `InnerJoin` tc `LeftOuterJoin` wp `LeftOuterJoin` wt `InnerJoin` p) -> do
on_ $ p ^. ProjectDiscussion ==. c ^. CommentDiscussion ||. wp ?. WikiPageProject ==. just (p ^. ProjectId)
on_ $ wt ?. WikiTargetPage ==. wp ?. WikiPageId
on_ $ wp ?. WikiPageDiscussion ==. just (c ^. CommentDiscussion)
......@@ -636,7 +636,7 @@ postUserNotificationsR user_id = do
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
case result of
FormSuccess notif_pref -> do
forM_ (userNotificationPref notif_pref) $ \ (ntype, ndeliv) ->
forM_ (userNotificationPref notif_pref) $ \(ntype, ndeliv) ->
runDB $ updateUserNotificationPrefDB user_id ntype ndeliv
alertSuccess "Successfully updated the notification preferences."
redirect $ UserR user_id
......@@ -701,7 +701,7 @@ postProjectNotificationsR user_id project_id = do
Nothing Nothing Nothing
case result of
FormSuccess notif_pref -> do
forM_ (projectNotificationPref notif_pref) $ \ (ntype, ndeliv) ->
forM_ (projectNotificationPref notif_pref) $ \(ntype, ndeliv) ->
runDB $ updateProjectNotificationPrefDB
user_id project_id ntype ndeliv
alertSuccess "Successfully updated the notification preferences."
......
......@@ -45,11 +45,11 @@ checkCommentUrl' mviewer_id user_id comment_id = do
let has_permission :: SqlExpr (Entity Comment) -> SqlExpr (Value Bool)
has_permission = if mviewer_id == Just user_id
then \ _ -> val True
else \ c -> c ^. CommentVisibility ==. val VisPublic
then \_ -> val True
else \c -> c ^. CommentVisibility ==. val VisPublic
||. just (c ^. CommentUser) ==. val mviewer_id
||. ( c ^. CommentId `in_`
( subList_select $ from $ \ (ca `InnerJoin` c2) -> do
( subList_select $ from $ \(ca `InnerJoin` c2) -> do
on_ $ ca ^. CommentAncestorAncestor ==. c2 ^. CommentId
where_ $ just (c2 ^. CommentUser) ==. val mviewer_id
......
......@@ -5,7 +5,7 @@ import Import
volunteerForm :: UTCTime -> ProjectId -> [Entity Interest] -> Entity User -> Form (VolunteerApplication, [InterestId])
volunteerForm now project_id interests (Entity user_id user) = renderBootstrap3 BootstrapBasicForm $
(\ name email contact website location experience interest_ids other ->
(\name email contact website location experience interest_ids other ->
(VolunteerApplication now project_id user_id name email contact website location experience other, interest_ids)
) <$> areq' textField "Name or Internet Handle:" Nothing
<*> areq' emailField "E-mail:" (Just . userIdent $ user)
......@@ -41,7 +41,7 @@ postVolunteerR project_handle = do
FormSuccess (application, interest_ids) -> do
runDB $ do
application_id <- insert application
forM_ interest_ids $ \ interest_id -> insert $ VolunteerInterest application_id interest_id
forM_ interest_ids $ \interest_id -> insert $ VolunteerInterest application_id interest_id
alertSuccess "application submitted"
redirect (VolunteerR project_handle)
......
......@@ -15,7 +15,7 @@ getWhoR project_handle = do
Entity project_id project <- runYDB $ getBy404 $ UniqueProjectHandle project_handle
team_members <- runDB $
select $
from $ \ (user `InnerJoin` project_user_role) -> do
from $ \(user `InnerJoin` project_user_role) -> do
on_ $ user ^. UserId ==. project_user_role ^. ProjectUserRoleUser
where_ $ (project_user_role ^. ProjectUserRoleProject ==. val project_id)
&&. (project_user_role ^. ProjectUserRoleRole ==. val TeamMember)
......
......@@ -127,7 +127,7 @@ getWikiR project_handle language target = do
(Entity project_id project, Entity page_id page, edits) <- runYDB $ do
(project, Entity page_id page, _) <- pageInfo project_handle language target
edits <- select $ from $ \ (we `InnerJoin` le) -> do
edits <- select $ from $ \(we `InnerJoin` le) -> do
on_ $ we ^. WikiEditId ==. le ^. WikiLastEditEdit
where_ $ we ^. WikiEditPage ==. val page_id
return we
......@@ -182,7 +182,7 @@ postWikiR project_handle target_language target = do
Just PostMode -> do
runSYDB $ do
[(Entity _ last_edit)] <- lift $ select $ from $ \ (we `InnerJoin` le) -> do
[(Entity _ last_edit)] <- lift $ select $ from $ \(we `InnerJoin` le) -> do
on_ $ we ^. WikiEditId ==. le ^. WikiLastEditEdit
where_ $ le ^. WikiLastEditPage ==. val page_id
&&. le ^. WikiLastEditLanguage ==. val edit_language
......@@ -197,7 +197,7 @@ postWikiR project_handle target_language target = do
if prev_edit_id == wikiLastEditEdit last_edit
then lift $ lift $ alertSuccess "Updated."
else do
[ Value last_editor ] <- lift $ select $ from $ \ we -> do
[ Value last_editor ] <- lift $ select $ from $ \we -> do
where_ $ we ^. WikiEditId ==. val (wikiLastEditEdit last_edit)
return $ we ^. WikiEditUser
......@@ -250,7 +250,7 @@ postWikiR project_handle target_language target = do
lift $ lift $ alertDanger "conflicting edits (ticket created, notification sent)"
case either_last_edit of
Left (Entity to_update _) -> lift $ update $ \ l -> do
Left (Entity to_update _) -> lift $ update $ \l -> do
set l [WikiLastEditEdit =. val new_edit_id]
where_ $ l ^. WikiLastEditId ==. val to_update
......@@ -260,7 +260,7 @@ postWikiR project_handle target_language target = do
_ -> do