{-# 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
(UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> Bool) -> Eq UserInfo
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
(Int -> UserInfo -> ShowS)
-> (UserInfo -> String) -> ([UserInfo] -> ShowS) -> Show UserInfo
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 ServerTime -> ServerTime -> Bool
forall a. Ord a => a -> a -> Bool
> ServerTime
c
userInfoFromUser :: User -> Bool -> UserInfo
userInfoFromUser :: User -> Bool -> UserInfo
userInfoFromUser User
up Bool
inTeam = UserInfo :: Text
-> UserId
-> UserStatus
-> Bool
-> Maybe Text
-> Text
-> Text
-> Text
-> Bool
-> UserInfo
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 (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ User -> UserText
userNickname User
up
in if Text -> Bool
T.null Text
nick then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
nick
, _uiFirstName :: Text
_uiFirstName = UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ User -> UserText
userFirstName User
up
, _uiLastName :: Text
_uiLastName = UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ User -> UserText
userLastName User
up
, _uiEmail :: Text
_uiEmail = UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
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
(UserStatus -> UserStatus -> Bool)
-> (UserStatus -> UserStatus -> Bool) -> Eq UserStatus
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
(Int -> UserStatus -> ShowS)
-> (UserStatus -> String)
-> ([UserStatus] -> ShowS)
-> Show UserStatus
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 { AllMyUsers a -> HashMap UserId a
_ofUsers :: HashMap UserId a
, AllMyUsers a -> Set Text
_usernameSet :: S.Set Text
}
deriving a -> AllMyUsers b -> AllMyUsers a
(a -> b) -> AllMyUsers a -> AllMyUsers b
(forall a b. (a -> b) -> AllMyUsers a -> AllMyUsers b)
-> (forall a b. a -> AllMyUsers b -> AllMyUsers a)
-> Functor AllMyUsers
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
<$ :: a -> AllMyUsers b -> AllMyUsers a
$c<$ :: forall a b. a -> AllMyUsers b -> AllMyUsers a
fmap :: (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 = Users -> Set Text
forall a. AllMyUsers a -> Set Text
_usernameSet
noUsers :: Users
noUsers :: Users
noUsers = HashMap UserId UserInfo -> Set Text -> Users
forall a. HashMap UserId a -> Set Text -> AllMyUsers a
AllUsers HashMap UserId UserInfo
forall k v. HashMap k v
HM.empty Set Text
forall a. Monoid a => a
mempty
getAllUserIds :: Users -> [UserId]
getAllUserIds :: Users -> [UserId]
getAllUserIds = HashMap UserId UserInfo -> [UserId]
forall k v. HashMap k v -> [k]
HM.keys (HashMap UserId UserInfo -> [UserId])
-> (Users -> HashMap UserId UserInfo) -> Users -> [UserId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Users -> HashMap UserId UserInfo
forall a. AllMyUsers a -> HashMap UserId a
_ofUsers
addUser :: UserInfo -> Users -> Users
addUser :: UserInfo -> Users -> Users
addUser UserInfo
userinfo Users
u =
Users
u Users -> (Users -> Users) -> Users
forall a b. a -> (a -> b) -> b
& (HashMap UserId UserInfo -> Identity (HashMap UserId UserInfo))
-> Users -> Identity Users
forall a a.
Lens
(AllMyUsers a) (AllMyUsers a) (HashMap UserId a) (HashMap UserId a)
ofUsers ((HashMap UserId UserInfo -> Identity (HashMap UserId UserInfo))
-> Users -> Identity Users)
-> (HashMap UserId UserInfo -> HashMap UserId UserInfo)
-> Users
-> Users
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ UserId
-> UserInfo -> HashMap UserId UserInfo -> HashMap UserId UserInfo
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (UserInfo
userinfoUserInfo -> Getting UserId UserInfo UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId UserInfo UserId
Lens' UserInfo UserId
uiId) UserInfo
userinfo
Users -> (Users -> Users) -> Users
forall a b. a -> (a -> b) -> b
& (Set Text -> Identity (Set Text)) -> Users -> Identity Users
forall a. Lens' (AllMyUsers a) (Set Text)
usernameSet ((Set Text -> Identity (Set Text)) -> Users -> Identity Users)
-> (Set Text -> Set Text) -> Users -> Users
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
S.insert (UserInfo
userinfoUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiName)
allUsers :: Users -> [UserInfo]
allUsers :: Users -> [UserInfo]
allUsers = HashMap UserId UserInfo -> [UserInfo]
forall k v. HashMap k v -> [v]
HM.elems (HashMap UserId UserInfo -> [UserInfo])
-> (Users -> HashMap UserId UserInfo) -> Users -> [UserInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Users -> HashMap UserId UserInfo
forall a. AllMyUsers a -> HashMap UserId a
_ofUsers
type TypingUsers = AllMyUsers (Max UTCTime)
noTypingUsers :: TypingUsers
noTypingUsers :: TypingUsers
noTypingUsers = HashMap UserId (Max UTCTime) -> Set Text -> TypingUsers
forall a. HashMap UserId a -> Set Text -> AllMyUsers a
AllUsers HashMap UserId (Max UTCTime)
forall k v. HashMap k v
HM.empty Set Text
forall a. Monoid a => a
mempty
addTypingUser :: UserId -> UTCTime -> TypingUsers -> TypingUsers
addTypingUser :: UserId -> UTCTime -> TypingUsers -> TypingUsers
addTypingUser UserId
uId UTCTime
ts = (HashMap UserId (Max UTCTime)
-> Identity (HashMap UserId (Max UTCTime)))
-> TypingUsers -> Identity TypingUsers
forall a a.
Lens
(AllMyUsers a) (AllMyUsers a) (HashMap UserId a) (HashMap UserId a)
ofUsers ((HashMap UserId (Max UTCTime)
-> Identity (HashMap UserId (Max UTCTime)))
-> TypingUsers -> Identity TypingUsers)
-> (HashMap UserId (Max UTCTime) -> HashMap UserId (Max UTCTime))
-> TypingUsers
-> TypingUsers
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Max UTCTime -> Max UTCTime -> Max UTCTime)
-> UserId
-> Max UTCTime
-> HashMap UserId (Max UTCTime)
-> HashMap UserId (Max UTCTime)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith Max UTCTime -> Max UTCTime -> Max UTCTime
forall a. Semigroup a => a -> a -> a
(<>) UserId
uId (UTCTime -> Max UTCTime
forall a. a -> Max a
Max UTCTime
ts)
allTypingUsers :: TypingUsers -> [UserId]
allTypingUsers :: TypingUsers -> [UserId]
allTypingUsers = HashMap UserId (Max UTCTime) -> [UserId]
forall k v. HashMap k v -> [k]
HM.keys (HashMap UserId (Max UTCTime) -> [UserId])
-> (TypingUsers -> HashMap UserId (Max UTCTime))
-> TypingUsers
-> [UserId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypingUsers -> HashMap UserId (Max UTCTime)
forall a. AllMyUsers a -> HashMap UserId a
_ofUsers
expireTypingUsers :: UTCTime -> TypingUsers -> TypingUsers
expireTypingUsers :: UTCTime -> TypingUsers -> TypingUsers
expireTypingUsers UTCTime
expiryTimestamp =
(HashMap UserId (Max UTCTime)
-> Identity (HashMap UserId (Max UTCTime)))
-> TypingUsers -> Identity TypingUsers
forall a a.
Lens
(AllMyUsers a) (AllMyUsers a) (HashMap UserId a) (HashMap UserId a)
ofUsers ((HashMap UserId (Max UTCTime)
-> Identity (HashMap UserId (Max UTCTime)))
-> TypingUsers -> Identity TypingUsers)
-> (HashMap UserId (Max UTCTime) -> HashMap UserId (Max UTCTime))
-> TypingUsers
-> TypingUsers
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Max UTCTime -> Bool)
-> HashMap UserId (Max UTCTime) -> HashMap UserId (Max UTCTime)
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HM.filter (\(Max UTCTime
ts') -> UTCTime
ts' UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
>= UTCTime
expiryTimestamp)
findUserById :: UserId -> Users -> Maybe UserInfo
findUserById :: UserId -> Users -> Maybe UserInfo
findUserById UserId
uId = UserId -> HashMap UserId UserInfo -> Maybe UserInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup UserId
uId (HashMap UserId UserInfo -> Maybe UserInfo)
-> (Users -> HashMap UserId UserInfo) -> Users -> Maybe UserInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Users -> HashMap UserId UserInfo
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 ((UserId, UserInfo) -> Bool)
-> [(UserId, UserInfo)] -> [(UserId, UserInfo)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
trimUserSigil Text
name) (Text -> Bool)
-> ((UserId, UserInfo) -> Text) -> (UserId, UserInfo) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserInfo -> Text
_uiName (UserInfo -> Text)
-> ((UserId, UserInfo) -> UserInfo) -> (UserId, UserInfo) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UserId, UserInfo) -> UserInfo
forall a b. (a, b) -> b
snd) ([(UserId, UserInfo)] -> [(UserId, UserInfo)])
-> [(UserId, UserInfo)] -> [(UserId, UserInfo)]
forall a b. (a -> b) -> a -> b
$ HashMap UserId UserInfo -> [(UserId, UserInfo)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap UserId UserInfo -> [(UserId, UserInfo)])
-> HashMap UserId UserInfo -> [(UserId, UserInfo)]
forall a b. (a -> b) -> a -> b
$ Users -> HashMap UserId UserInfo
forall a. AllMyUsers a -> HashMap UserId a
_ofUsers Users
allusers of
((UserId, UserInfo)
usr : []) -> (UserId, UserInfo) -> Maybe (UserId, UserInfo)
forall a. a -> Maybe a
Just (UserId, UserInfo)
usr
[(UserId, UserInfo)]
_ -> Maybe (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 ((UserId, UserInfo) -> Bool)
-> [(UserId, UserInfo)] -> [(UserId, UserInfo)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
trimUserSigil Text
nick)) (Maybe Text -> Bool)
-> ((UserId, UserInfo) -> Maybe Text) -> (UserId, UserInfo) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserInfo -> Maybe Text
_uiNickName (UserInfo -> Maybe Text)
-> ((UserId, UserInfo) -> UserInfo)
-> (UserId, UserInfo)
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UserId, UserInfo) -> UserInfo
forall a b. (a, b) -> b
snd) ([(UserId, UserInfo)] -> [(UserId, UserInfo)])
-> [(UserId, UserInfo)] -> [(UserId, UserInfo)]
forall a b. (a -> b) -> a -> b
$ HashMap UserId UserInfo -> [(UserId, UserInfo)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap UserId UserInfo -> [(UserId, UserInfo)])
-> HashMap UserId UserInfo -> [(UserId, UserInfo)]
forall a b. (a -> b) -> a -> b
$ Users -> HashMap UserId UserInfo
forall a. AllMyUsers a -> HashMap UserId a
_ofUsers Users
us of
((UserId, UserInfo)
pair : []) -> (UserId, UserInfo) -> Maybe (UserId, UserInfo)
forall a. a -> Maybe a
Just (UserId, UserInfo)
pair
[(UserId, UserInfo)]
_ -> Maybe (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 Text -> Text -> Text
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 = (HashMap UserId UserInfo -> Identity (HashMap UserId UserInfo))
-> Users -> Identity Users
forall a a.
Lens
(AllMyUsers a) (AllMyUsers a) (HashMap UserId a) (HashMap UserId a)
ofUsers((HashMap UserId UserInfo -> Identity (HashMap UserId UserInfo))
-> Users -> Identity Users)
-> ((UserInfo -> Identity UserInfo)
-> HashMap UserId UserInfo -> Identity (HashMap UserId UserInfo))
-> (UserInfo -> Identity UserInfo)
-> Users
-> Identity Users
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (HashMap UserId UserInfo)
-> Traversal'
(HashMap UserId UserInfo) (IxValue (HashMap UserId UserInfo))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix(UserId
Index (HashMap UserId UserInfo)
uId) ((UserInfo -> Identity UserInfo) -> Users -> Identity Users)
-> (UserInfo -> UserInfo) -> Users -> Users
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ UserInfo -> UserInfo
f