{-# LANGUAGE OverloadedStrings #-} module Model.User where import qualified Data.Text as T import Data.Time.Calendar import Data.Time.Clock import Data.Profunctor.Product (p6) import Data.Int (Int64) import qualified Database.PostgreSQL.Simple as PGS import Control.Arrow ((<<<)) import Control.Monad.IO.Class (liftIO) import Opaleye as O import qualified Opaleye.Constant as C -- internal imports import Types.User import Types.Refine import Types.Reader import Classes initUser :: PGS.Query initUser = mconcat [ "CREATE TABLE IF NOT EXISTS \"user\" (" , "user_id SERIAL PRIMARY KEY," , "user_ident TEXT NOT NULL," , "user_balance INTEGER NOT NULL," , "user_timestamp DATE NOT NULL," , "user_email TEXT," , "user_avatar INTEGER REFERENCES \"avatar\"(\"avatar_id\") ON DELETE CASCADE" , ")" ] userTable :: Table ( Maybe (Field SqlInt4) , Field SqlText , Field SqlInt4 , Field SqlDate , FieldNullable SqlText , FieldNullable SqlInt4 ) ( Field SqlInt4 , Field SqlText , Field SqlInt4 , Field SqlDate , FieldNullable SqlText , FieldNullable SqlInt4 ) userTable = table "user" ( p6 ( tableField "user_id" , tableField "user_ident" , tableField "user_balance" , tableField "user_timestamp" , tableField "user_email" , tableField "user_avatar" ) ) userSelect :: UserRefine -> PGS.Connection -> MateHandler [UserSummary] userSelect ref conn = do today <- utctDay <$> liftIO getCurrentTime users <- liftIO $ map fromDatabase <$> runSelect conn ( orderBy (asc (\(_, ident, _, _, _, _) -> ident)) ( keepWhen (\(_, _, _, ts, _, _) -> case ref of AllUsers -> C.constant True ActiveUsers -> ts .>= C.constant (addDays (-30) today) OldUsers -> ts .< C.constant (addDays (-30) today) ) <<< selectTable userTable) ) :: MateHandler [User] mapM (\(User i1 i2 _ _ _ i6) -> return $ UserSummary i1 i2 i6 ) users userDetailsSelect :: Int -> PGS.Connection -> MateHandler UserDetails userDetailsSelect uid conn = do users <- liftIO $ map fromDatabase <$> runSelect conn (limit 1 $ keepWhen (\(uuid, _, _, _, _, _) -> uuid .== C.constant uid ) <<< queryTable userTable ) :: MateHandler [User] head <$> mapM (\(User i1 i2 i3 _ i5 i6) -> return $ UserDetails i1 i2 i3 i5 i6 ) users userBalanceSelect :: PGS.Connection -> Int -> MateHandler Int userBalanceSelect conn uid = do liftIO $ userBalance . fromDatabase . head <$> runSelect conn ( keepWhen (\(uuid, _, _, _, _, _) -> uuid .== C.constant uid ) <<< queryTable userTable ) insertUser :: T.Text -> Maybe T.Text -> Day -> PGS.Connection -> MateHandler Int insertUser ident email now conn = fmap head $ liftIO $ runInsert_ conn $ Insert { iTable = userTable , iRows = [ ( C.constant (Nothing :: Maybe Int) , C.constant ident , C.constant (0 :: Int) , C.constant now , C.constant email , C.constant (Nothing :: Maybe Int) ) ] , iReturning = rReturning (\(uid, _, _, _, _, _) -> uid) , iOnConflict = Nothing } updateUserDetails :: Int -> UserDetailsSubmit -> Day -> PGS.Connection -> MateHandler Int64 updateUserDetails uid uds now conn = liftIO $ runUpdate_ conn $ Update { uTable = userTable , uUpdateWith = updateEasy (\(id_, _, i3, _, _, _) -> ( id_ , C.constant (userDetailsSubmitIdent uds) , i3 , C.constant now , C.constant (userDetailsSubmitEmail uds) , C.constant (userDetailsSubmitAvatar uds) ) ) , uWhere = \(i1, _, _, _, _, _) -> i1 .== C.constant uid , uReturning = rCount } updateUserTimestamp :: Int -> Day -> PGS.Connection -> MateHandler Int64 updateUserTimestamp uid now conn = liftIO $ runUpdate_ conn $ Update { uTable = userTable , uUpdateWith = updateEasy (\(id_, ident, balance, _, email, ava) -> ( id_ , ident , balance , C.constant now , email , ava ) ) , uWhere = \(i1, _, _, _, _, _) -> i1 .== C.constant uid , uReturning = rCount } addToUserBalance :: Int -> Int -> PGS.Connection -> MateHandler Int64 addToUserBalance uid amount conn = liftIO $ runUpdate_ conn $ Update { uTable = userTable , uUpdateWith = updateEasy (\(id_, i2, i3, i4, i5, i6) -> ( id_ , i2 , i3 + C.constant amount , i4 , i5 , i6 ) ) , uWhere = \(i1, _, _, _, _, _) -> i1 .== C.constant uid , uReturning = rCount }