Add refinement option for active users (which is default)
This commit is contained in:
parent
5ba35c5648
commit
b7c4215e27
3 changed files with 16 additions and 12 deletions
|
@ -13,6 +13,8 @@ import Data.Time (getCurrentTime, utctDay)
|
||||||
|
|
||||||
import Data.ByteString.Random (random)
|
import Data.ByteString.Random (random)
|
||||||
|
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
-- internal imports
|
-- internal imports
|
||||||
|
@ -61,7 +63,7 @@ userUpdate (Just aid) uid uds =
|
||||||
userList :: Maybe UserRefine -> MateHandler [UserSummary]
|
userList :: Maybe UserRefine -> MateHandler [UserSummary]
|
||||||
userList ref = do
|
userList ref = do
|
||||||
conn <- rsConnection <$> ask
|
conn <- rsConnection <$> ask
|
||||||
userSelect ref conn
|
userSelect (fromMaybe ActiveUsers ref) conn
|
||||||
|
|
||||||
userRecharge :: Maybe Int -> UserRecharge -> MateHandler ()
|
userRecharge :: Maybe Int -> UserRecharge -> MateHandler ()
|
||||||
userRecharge (Just auid) (UserRecharge amount) =
|
userRecharge (Just auid) (UserRecharge amount) =
|
||||||
|
@ -96,7 +98,7 @@ userTransfer (Just auid) (UserTransfer target amount) =
|
||||||
user <- userDetailsSelect auid conn
|
user <- userDetailsSelect auid conn
|
||||||
if amount < userDetailsBalance user
|
if amount < userDetailsBalance user
|
||||||
then do
|
then do
|
||||||
mtarget <- filter (\u -> userSummaryId u == target) <$> userSelect (Just AllUsers) conn
|
mtarget <- filter (\u -> userSummaryId u == target) <$> userSelect AllUsers conn
|
||||||
if not (null mtarget)
|
if not (null mtarget)
|
||||||
then do
|
then do
|
||||||
void $ addToUserBalance auid (-amount) conn
|
void $ addToUserBalance auid (-amount) conn
|
||||||
|
|
|
@ -78,17 +78,17 @@ userTable = table "user" (
|
||||||
)
|
)
|
||||||
|
|
||||||
userSelect
|
userSelect
|
||||||
:: Maybe UserRefine
|
:: UserRefine
|
||||||
-> PGS.Connection
|
-> PGS.Connection
|
||||||
-> MateHandler [UserSummary]
|
-> MateHandler [UserSummary]
|
||||||
userSelect ref conn = do
|
userSelect ref conn = do
|
||||||
today <- utctDay <$> (liftIO $ getCurrentTime)
|
today <- utctDay <$> (liftIO $ getCurrentTime)
|
||||||
users <- liftIO $ runSelect conn (case ref of
|
users <- liftIO $ runSelect conn (case ref of
|
||||||
Nothing -> keepWhen (\(_, _, _, ts, _, _, _, _, _) ->
|
AllUsers -> selectTable userTable
|
||||||
|
ActiveUsers -> keepWhen (\(_, _, _, ts, _, _, _, _, _) ->
|
||||||
ts .>= C.constant (addDays (-30) today)
|
ts .>= C.constant (addDays (-30) today)
|
||||||
) <<< queryTable userTable
|
) <<< queryTable userTable
|
||||||
Just AllUsers -> selectTable userTable
|
OldUsers -> keepWhen (\(_, _, _, ts, _, _, _, _, _) ->
|
||||||
Just OldUsers -> keepWhen (\(_, _, _, ts, _, _, _, _, _) ->
|
|
||||||
ts .<= C.constant (addDays (-30) today)
|
ts .<= C.constant (addDays (-30) today)
|
||||||
) <<< queryTable userTable
|
) <<< queryTable userTable
|
||||||
) :: MateHandler
|
) :: MateHandler
|
||||||
|
|
|
@ -7,19 +7,21 @@ import GHC.Generics
|
||||||
|
|
||||||
import Web.HttpApiData
|
import Web.HttpApiData
|
||||||
|
|
||||||
data UserRefine = AllUsers | OldUsers
|
data UserRefine = AllUsers | ActiveUsers | OldUsers
|
||||||
deriving (Generic, Show, Enum)
|
deriving (Generic, Show, Enum)
|
||||||
|
|
||||||
instance FromHttpApiData UserRefine where
|
instance FromHttpApiData UserRefine where
|
||||||
parseQueryParam t =
|
parseQueryParam t =
|
||||||
case t of
|
case t of
|
||||||
"all" -> Right AllUsers
|
"all" -> Right AllUsers
|
||||||
|
"active" -> Right ActiveUsers
|
||||||
"old" -> Right OldUsers
|
"old" -> Right OldUsers
|
||||||
x -> Left ("Error: Unknown refine " <> x)
|
x -> Left ("Error: Unknown refine " <> x)
|
||||||
|
|
||||||
instance ToHttpApiData UserRefine where
|
instance ToHttpApiData UserRefine where
|
||||||
toUrlPiece x = case x of
|
toUrlPiece x = case x of
|
||||||
AllUsers -> "all"
|
AllUsers -> "all"
|
||||||
|
ActiveUsers -> "active"
|
||||||
OldUsers -> "old"
|
OldUsers -> "old"
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue