initialize Settings

src/Model.hs

@@ -9,3 +9,4 @@ import Model.Amount as M
 import Model.Journal as M
 import Model.Avatar as M
 import Model.Role as M
+import Model.Settings as M

src/Model/Settings.hs

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

src/Types.hs

@@ -13,3 +13,4 @@ import Types.Journal as T
 import Types.Avatar as T
 import Types.Role as T
 import Types.Meta as T
+import Types.Settings as T