{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveFunctor #-}
module Matterhorn.Types.Users
( UserInfo(..)
, UserStatus(..)
, Users
, uiName, uiId, uiStatus, uiInTeam, uiNickName, uiFirstName, uiLastName, uiEmail
, uiDeleted
, userInfoFromUser
, getUsernameSet
, trimUserSigil
, addUserSigil
, statusFromText
, findUserById
, findUserByUsername
, findUserByNickname
, noUsers, addUser, allUsers
, modifyUserById
, userDeleted
, TypingUsers
, noTypingUsers
, addTypingUser
, allTypingUsers
, expireTypingUsers
, getAllUserIds
)
where
import Prelude ()
import Matterhorn.Prelude
import qualified Data.HashMap.Strict as HM
import qualified Data.Set as S
import Data.Semigroup ( Max(..) )
import qualified Data.Text as T
import Lens.Micro.Platform ( (%~), makeLenses, ix )
import Network.Mattermost.Types ( UserId(..), User(..) )
import Matterhorn.Types.Common
import Matterhorn.Constants ( userSigil )
data UserInfo = UserInfo
{ UserInfo -> Text
_uiName :: Text
, UserInfo -> UserId
_uiId :: UserId
, UserInfo -> UserStatus
_uiStatus :: UserStatus
, UserInfo -> Bool
_uiInTeam :: Bool
, UserInfo -> Maybe Text
_uiNickName :: Maybe Text
, UserInfo -> Text
_uiFirstName :: Text
, UserInfo -> Text
_uiLastName :: Text
, UserInfo -> Text
_uiEmail :: Text
, UserInfo -> Bool
_uiDeleted :: Bool
} deriving (UserInfo -> UserInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserInfo -> UserInfo -> Bool
$c/= :: UserInfo -> UserInfo -> Bool
== :: UserInfo -> UserInfo -> Bool
$c== :: UserInfo -> UserInfo -> Bool
Eq, Int -> UserInfo -> ShowS
[UserInfo] -> ShowS
UserInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserInfo] -> ShowS
$cshowList :: [UserInfo] -> ShowS
show :: UserInfo -> String
$cshow :: UserInfo -> String
showsPrec :: Int -> UserInfo -> ShowS
$cshowsPrec :: Int -> UserInfo -> ShowS
Show)
userDeleted :: User -> Bool
userDeleted :: User -> Bool
userDeleted User
u =
case User -> Maybe ServerTime
userCreateAt User
u of
Maybe ServerTime
Nothing -> Bool
False
Just ServerTime
c -> User -> ServerTime
userDeleteAt User
u forall a. Ord a => a -> a -> Bool
> ServerTime
c
userInfoFromUser :: User -> Bool -> UserInfo
userInfoFromUser :: User -> Bool -> UserInfo
userInfoFromUser User
up Bool
inTeam = UserInfo
{ _uiName :: Text
_uiName = User -> Text
userUsername User
up
, _uiId :: UserId
_uiId = User -> UserId
userId User
up
, _uiStatus :: UserStatus
_uiStatus = UserStatus
Offline
, _uiInTeam :: Bool
_uiInTeam = Bool
inTeam
, _uiNickName :: Maybe Text
_uiNickName =
let nick :: Text
nick = UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ User -> UserText
userNickname User
up
in if Text -> Bool
T.null Text
nick then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Text
nick
, _uiFirstName :: Text
_uiFirstName = UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ User -> UserText
userFirstName User
up
, _uiLastName :: Text
_uiLastName = UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ User -> UserText
userLastName User
up
, _uiEmail :: Text
_uiEmail = UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ User -> UserText
userEmail User
up
, _uiDeleted :: Bool
_uiDeleted = User -> Bool
userDeleted User
up
}
data UserStatus
= Online
| Away
| Offline
| DoNotDisturb
| Other Text
deriving (UserStatus -> UserStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserStatus -> UserStatus -> Bool
$c/= :: UserStatus -> UserStatus -> Bool
== :: UserStatus -> UserStatus -> Bool
$c== :: UserStatus -> UserStatus -> Bool
Eq, Int -> UserStatus -> ShowS
[UserStatus] -> ShowS
UserStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserStatus] -> ShowS
$cshowList :: [UserStatus] -> ShowS
show :: UserStatus -> String
$cshow :: UserStatus -> String
showsPrec :: Int -> UserStatus -> ShowS
$cshowsPrec :: Int -> UserStatus -> ShowS
Show)
statusFromText :: Text -> UserStatus
statusFromText :: Text -> UserStatus
statusFromText Text
t = case Text
t of
Text
"online" -> UserStatus
Online
Text
"offline" -> UserStatus
Offline
Text
"away" -> UserStatus
Away
Text
"dnd" -> UserStatus
DoNotDisturb
Text
_ -> Text -> UserStatus
Other Text
t
makeLenses ''UserInfo
data AllMyUsers a =
AllUsers { forall a. AllMyUsers a -> HashMap UserId a
_ofUsers :: HashMap UserId a
, forall a. AllMyUsers a -> Set Text
_usernameSet :: S.Set Text
}
deriving forall a b. a -> AllMyUsers b -> AllMyUsers a
forall a b. (a -> b) -> AllMyUsers a -> AllMyUsers b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> AllMyUsers b -> AllMyUsers a
$c<$ :: forall a b. a -> AllMyUsers b -> AllMyUsers a
fmap :: forall a b. (a -> b) -> AllMyUsers a -> AllMyUsers b
$cfmap :: forall a b. (a -> b) -> AllMyUsers a -> AllMyUsers b
Functor
makeLenses ''AllMyUsers
type Users = AllMyUsers UserInfo
getUsernameSet :: Users -> S.Set Text
getUsernameSet :: Users -> Set Text
getUsernameSet = forall a. AllMyUsers a -> Set Text
_usernameSet
noUsers :: Users
noUsers :: Users
noUsers = forall a. HashMap UserId a -> Set Text -> AllMyUsers a
AllUsers forall k v. HashMap k v
HM.empty forall a. Monoid a => a
mempty
getAllUserIds :: Users -> [UserId]
getAllUserIds :: Users -> [UserId]
getAllUserIds = forall k v. HashMap k v -> [k]
HM.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AllMyUsers a -> HashMap UserId a
_ofUsers
addUser :: UserInfo -> Users -> Users
addUser :: UserInfo -> Users -> Users
addUser UserInfo
userinfo Users
u =
Users
u forall a b. a -> (a -> b) -> b
& forall a a.
Lens
(AllMyUsers a) (AllMyUsers a) (HashMap UserId a) (HashMap UserId a)
ofUsers forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (UserInfo
userinfoforall s a. s -> Getting a s a -> a
^.Lens' UserInfo UserId
uiId) UserInfo
userinfo
forall a b. a -> (a -> b) -> b
& forall a. Lens' (AllMyUsers a) (Set Text)
usernameSet forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. Ord a => a -> Set a -> Set a
S.insert (UserInfo
userinfoforall s a. s -> Getting a s a -> a
^.Lens' UserInfo Text
uiName)
allUsers :: Users -> [UserInfo]
allUsers :: Users -> [UserInfo]
allUsers = forall k v. HashMap k v -> [v]
HM.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AllMyUsers a -> HashMap UserId a
_ofUsers
type TypingUsers = AllMyUsers (Max UTCTime)
noTypingUsers :: TypingUsers
noTypingUsers :: TypingUsers
noTypingUsers = forall a. HashMap UserId a -> Set Text -> AllMyUsers a
AllUsers forall k v. HashMap k v
HM.empty forall a. Monoid a => a
mempty
addTypingUser :: UserId -> UTCTime -> TypingUsers -> TypingUsers
addTypingUser :: UserId -> UTCTime -> TypingUsers -> TypingUsers
addTypingUser UserId
uId UTCTime
ts = forall a a.
Lens
(AllMyUsers a) (AllMyUsers a) (HashMap UserId a) (HashMap UserId a)
ofUsers forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith forall a. Semigroup a => a -> a -> a
(<>) UserId
uId (forall a. a -> Max a
Max UTCTime
ts)
allTypingUsers :: TypingUsers -> [UserId]
allTypingUsers :: TypingUsers -> [UserId]
allTypingUsers = forall k v. HashMap k v -> [k]
HM.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AllMyUsers a -> HashMap UserId a
_ofUsers
expireTypingUsers :: UTCTime -> TypingUsers -> TypingUsers
expireTypingUsers :: UTCTime -> TypingUsers -> TypingUsers
expireTypingUsers UTCTime
expiryTimestamp =
forall a a.
Lens
(AllMyUsers a) (AllMyUsers a) (HashMap UserId a) (HashMap UserId a)
ofUsers forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HM.filter (\(Max UTCTime
ts') -> UTCTime
ts' forall a. Ord a => a -> a -> Bool
>= UTCTime
expiryTimestamp)
findUserById :: UserId -> Users -> Maybe UserInfo
findUserById :: UserId -> Users -> Maybe UserInfo
findUserById UserId
uId = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup UserId
uId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AllMyUsers a -> HashMap UserId a
_ofUsers
findUserByUsername :: Text -> Users -> Maybe (UserId, UserInfo)
findUserByUsername :: Text -> Users -> Maybe (UserId, UserInfo)
findUserByUsername Text
name Users
allusers =
case forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== Text -> Text
trimUserSigil Text
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserInfo -> Text
_uiName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
HM.toList forall a b. (a -> b) -> a -> b
$ forall a. AllMyUsers a -> HashMap UserId a
_ofUsers Users
allusers of
((UserId, UserInfo)
usr : []) -> forall a. a -> Maybe a
Just (UserId, UserInfo)
usr
[(UserId, UserInfo)]
_ -> forall a. Maybe a
Nothing
findUserByNickname:: Text -> Users -> Maybe (UserId, UserInfo)
findUserByNickname :: Text -> Users -> Maybe (UserId, UserInfo)
findUserByNickname Text
nick Users
us =
case forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Text
trimUserSigil Text
nick)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserInfo -> Maybe Text
_uiNickName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
HM.toList forall a b. (a -> b) -> a -> b
$ forall a. AllMyUsers a -> HashMap UserId a
_ofUsers Users
us of
((UserId, UserInfo)
pair : []) -> forall a. a -> Maybe a
Just (UserId, UserInfo)
pair
[(UserId, UserInfo)]
_ -> forall a. Maybe a
Nothing
trimUserSigil :: Text -> Text
trimUserSigil :: Text -> Text
trimUserSigil Text
n
| Text
userSigil Text -> Text -> Bool
`T.isPrefixOf` Text
n = Text -> Text
T.tail Text
n
| Bool
otherwise = Text
n
addUserSigil :: T.Text -> T.Text
addUserSigil :: Text -> Text
addUserSigil Text
t | Text
userSigil Text -> Text -> Bool
`T.isPrefixOf` Text
t = Text
t
| Bool
otherwise = Text
userSigil forall a. Semigroup a => a -> a -> a
<> Text
t
modifyUserById :: UserId -> (UserInfo -> UserInfo) -> Users -> Users
modifyUserById :: UserId -> (UserInfo -> UserInfo) -> Users -> Users
modifyUserById UserId
uId UserInfo -> UserInfo
f = forall a a.
Lens
(AllMyUsers a) (AllMyUsers a) (HashMap UserId a) (HashMap UserId a)
ofUsersforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix(UserId
uId) forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ UserInfo -> UserInfo
f