initialize Settings

This commit is contained in:
nek0 2022-02-22 18:24:13 +01:00
parent 427b5d4f55
commit 28c6053df5
3 changed files with 66 additions and 0 deletions

View file

@ -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
View 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
}

View file

@ -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