{-# 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 }