{-# 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 (p3) import qualified Database.PostgreSQL.Simple as PGS import Opaleye as O -- internal imports import Types import Classes -- | This function does (as opposed to all other init functions) create just the table, -- but also creates a first settings object with default values. initSettings :: PGS.Query initSettings = mconcat [ "CREATE TABLE IF NOT EXISTS \"settings\" (" , "settings_signup_blocked BOOLEAN NOT NULL DEFAULT false," , "settings_imprint TEXT DEFAULT \'\'," , "settings_idle_time INTEGER NOT NULL DEFAULT 30" , ");" , "INSERT INTO \"settings\" DEFAULT VALUES" ] settingsTable :: Table ( Field SqlBool , FieldNullable SqlText , Field SqlInt4 ) ( Field SqlBool , FieldNullable SqlText , Field SqlInt4 ) settingsTable = table "settings" ( p3 ( tableField "settings_signup_blocked" , tableField "settings_imprint" , tableField "settings_idle_time" ) ) selectSettings :: PGS.Connection -> MateHandler Settings selectSettings conn = liftIO $ do head . map fromDatabase <$> runSelect conn ( proc () -> do ret <- limit 1 $ selectTable settingsTable -< () returnA -< ret ) :: IO Settings selectIdleTime :: PGS.Connection -> MateHandler Int selectIdleTime conn = settingsIdleTime <$> selectSettings conn selectSignupBlocked :: PGS.Connection -> MateHandler Bool selectSignupBlocked conn = settingsBlockRegistration <$> selectSettings conn updateSettings :: Settings -> PGS.Connection -> MateHandler () updateSettings (Settings block imprint idleTime) conn = do void $ liftIO $ runUpdate_ conn $ Update { uTable = settingsTable , uUpdateWith = updateEasy (\(_, _, _) -> ( toFields block , toFields imprint , toFields idleTime ) ) , uWhere = const (sqlBool True) , uReturning = rCount }