initialize Settings
This commit is contained in:
parent
427b5d4f55
commit
28c6053df5
3 changed files with 66 additions and 0 deletions
|
@ -9,3 +9,4 @@ import Model.Amount as M
|
||||||
import Model.Journal as M
|
import Model.Journal as M
|
||||||
import Model.Avatar as M
|
import Model.Avatar as M
|
||||||
import Model.Role as M
|
import Model.Role as M
|
||||||
|
import Model.Settings as M
|
||||||
|
|
64
src/Model/Settings.hs
Normal file
64
src/Model/Settings.hs
Normal file
|
@ -0,0 +1,64 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE Arrows #-}
|
||||||
|
module Model.Settings where
|
||||||
|
|
||||||
|
import Control.Arrow
|
||||||
|
|
||||||
|
import Control.Monad (void)
|
||||||
|
|
||||||
|
import Control.Monad.IO.Class (liftIO)
|
||||||
|
|
||||||
|
import Data.Profunctor.Product (p2)
|
||||||
|
|
||||||
|
import qualified Database.PostgreSQL.Simple as PGS
|
||||||
|
|
||||||
|
import Opaleye as O
|
||||||
|
|
||||||
|
-- internal imports
|
||||||
|
|
||||||
|
import Types
|
||||||
|
import Classes
|
||||||
|
|
||||||
|
initSettings :: PGS.Query
|
||||||
|
initSettings = mconcat
|
||||||
|
[ "CREATE TABLE IF NOT EXISTS \"settings\" ("
|
||||||
|
, "settings_signup_blocked BOOLEAN NOT NULL DEFAULT false,"
|
||||||
|
, "settings_imprint TEXT DEFAULT \'\'"
|
||||||
|
, ");"
|
||||||
|
, "INSERT INTO \"settings\" DEFAULT VALUES"
|
||||||
|
]
|
||||||
|
|
||||||
|
settingsTable :: Table
|
||||||
|
( Field SqlBool
|
||||||
|
, FieldNullable SqlText
|
||||||
|
)
|
||||||
|
( Field SqlBool
|
||||||
|
, FieldNullable SqlText
|
||||||
|
)
|
||||||
|
settingsTable = table "settings" (
|
||||||
|
p2
|
||||||
|
( tableField "settings_signup_blocked"
|
||||||
|
, tableField "settings_imprint"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
getSettings :: PGS.Connection -> MateHandler Settings
|
||||||
|
getSettings conn = liftIO $ do
|
||||||
|
head . map fromDatabase <$> runSelect conn
|
||||||
|
( proc () -> do
|
||||||
|
ret <- limit 1 $ selectTable settingsTable -< ()
|
||||||
|
returnA -< ret
|
||||||
|
) :: IO Settings
|
||||||
|
|
||||||
|
updateSettings :: Settings -> PGS.Connection -> MateHandler ()
|
||||||
|
updateSettings (Settings block imprint) conn = do
|
||||||
|
void $ liftIO $ runUpdate_ conn $ Update
|
||||||
|
{ uTable = settingsTable
|
||||||
|
, uUpdateWith = updateEasy (\(_, _) ->
|
||||||
|
( toFields block
|
||||||
|
, toFields imprint
|
||||||
|
)
|
||||||
|
)
|
||||||
|
, uWhere = const (sqlBool True)
|
||||||
|
, uReturning = rCount
|
||||||
|
}
|
|
@ -13,3 +13,4 @@ import Types.Journal as T
|
||||||
import Types.Avatar as T
|
import Types.Avatar as T
|
||||||
import Types.Role as T
|
import Types.Role as T
|
||||||
import Types.Meta as T
|
import Types.Meta as T
|
||||||
|
import Types.Settings as T
|
||||||
|
|
Loading…
Reference in a new issue