git.gnu.io has moved to IP address 209.51.188.249 -- please double check where you are logging in.

Commit b7012f6a authored by Bryan Richter's avatar Bryan Richter

Assuage pedantry

parent d87478ba
......@@ -61,7 +61,6 @@ library
Handler.NewDesign
Handler.PostLogin
Handler.Project
Handler.ProjectBlog
Handler.ResetPassphrase
Handler.Simple
Handler.TH
......@@ -88,7 +87,6 @@ library
Local.Ord
Model
Model.Application
Model.Blog
Model.Count
Model.Currency
Model.Issue
......@@ -102,7 +100,6 @@ library
Model.Project
Model.Project.Signup
Model.Project.Signup.Internal
Model.Project.Sql
Model.ResetPassphrase
Model.Role
Model.Settings
......@@ -125,7 +122,6 @@ library
View.ResetPassphrase
View.Time
View.User
Widgets.Doc
Widgets.Markdown
Widgets.Navbar
Widgets.Preview
......@@ -254,48 +250,6 @@ executable Snowdrift
ghc-options: -threaded
-- executable SnowdriftProcessPayments {{{1
executable SnowdriftProcessPayments
if flag(library-only)
Buildable: False
if flag(dev)
ghc-options: -Wall -O0 -fobject-code
if flag(merge)
ghc-options: -Wall -Werror -O0 -fobject-code
default-language: Haskell2010
main-is: SnowdriftProcessPayments.hs
hs-source-dirs: app
build-depends: base
, blaze-builder
, bytestring
, fast-logger
, lifted-base
, monad-logger
, mtl
, persistent
, resourcet
, Snowdrift
, text
, time
, yesod
ghc-options: -threaded
default-extensions: TemplateHaskell
QuasiQuotes
OverloadedStrings
NoImplicitPrelude
MultiParamTypeClasses
TypeFamilies
GADTs
GeneralizedNewtypeDeriving
FlexibleContexts
EmptyDataDecls
NoMonomorphismRestriction
DeriveDataTypeable
ScopedTypeVariables
-- executable sendmail-mock {{{1
executable sendmail-mock
if flag(dev)
......
import Import hiding (runDB, runSDB)
import Control.Monad.Logger
import Control.Monad.Trans.Resource
import Control.Monad.Writer
import Yesod.Default.Config
import qualified Database.Persist.Sql
import Settings
runDB :: (PersistConfig c, MonadBaseControl IO m, MonadIO m)
=> c
-> PersistConfigPool c
-> PersistConfigBackend c (ResourceT (LoggingT m)) a
-> m a
runDB dbconf poolconf sql =
runStdoutLoggingT $
runResourceT $ Database.Persist.Sql.runPool dbconf sql poolconf
runSDB :: (PersistConfig c, MonadBaseControl IO m, MonadIO m)
=> c
-> PersistConfigPool c
-> WriterT t (PersistConfigBackend c (ResourceT (LoggingT m))) b
-> m b
runSDB dbconf poolconf = fmap fst . runDB dbconf poolconf . runWriterT
main :: IO ()
main = do
conf <- fromArgs parseExtra
dbconf <- withYamlEnvironment "config/postgresql.yml" (appEnv conf)
Database.Persist.Sql.loadConfig >>= Database.Persist.Sql.applyEnv
pool_conf <-
Database.Persist.Sql.createPoolConfig (dbconf :: Settings.PersistConf)
now <- liftIO getCurrentTime
runSDB dbconf pool_conf $ do
projects <- lift $ Mech.projectsToPay now
lift $ mapM_ (Mech.payout now) projects
Mech.rebalanceAllPledges
......@@ -241,19 +241,6 @@ DefaultTagColor
DatabaseVersion
lastMigration Int
PledgeFormRendered
ts UTCTime
order Text
project ProjectId
user UserId Maybe
SharesPledged
ts UTCTime
user UserId
project ProjectId
shares Int64
render PledgeFormRenderedId
Image
ts UTCTime
uploader UserId
......
module Model.Project.Sql where
import Import
import Model.Wiki.Sql
-- | Query that returns all WikiEdits made on any WikiPage on this Project
querProjectWikiEdits :: ProjectId -> SqlQuery (SqlExpr (Value WikiEditId))
querProjectWikiEdits project_id =
from $ \(wp `InnerJoin` we) -> do
on_ (wp ^. WikiPageId ==. we ^. WikiEditPage)
where_ (exprWikiPageOnProject wp project_id)
return (we ^. WikiEditId)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment