37 lines
1.4 KiB
Haskell
37 lines
1.4 KiB
Haskell
module Handler.Utils.Profile
|
|
( validDisplayName
|
|
) where
|
|
|
|
import Import.NoFoundation
|
|
|
|
import qualified Data.Text as Text
|
|
import qualified Data.MultiSet as MultiSet
|
|
import qualified Data.Set as Set
|
|
|
|
|
|
|
|
validDisplayName :: Maybe UserTitle
|
|
-> UserFirstName
|
|
-> UserSurname
|
|
-> UserDisplayName
|
|
-> Bool
|
|
validDisplayName (fmap Text.strip -> mTitle) (Text.strip -> fName) (Text.strip -> sName) (Text.strip -> dName)
|
|
= and [ dNameFrags `MultiSet.isSubsetOf` MultiSet.unions [titleFrags, fNameFrags, sNameFrags]
|
|
, sName `Text.isInfixOf` dName
|
|
, all ((<= 1) . Text.length) . filter (Text.any isAdd) $ Text.group dName
|
|
, dNameLetters `Set.isSubsetOf` Set.unions [titleLetters, fNameLetters, sNameLetters, addLetters]
|
|
]
|
|
where
|
|
titleFrags = MultiSet.fromList $ maybe [] Text.words mTitle
|
|
fNameFrags = MultiSet.fromList $ Text.words fName
|
|
sNameFrags = MultiSet.fromList $ Text.words sName
|
|
dNameFrags = MultiSet.fromList $ stripAdd <$> Text.words dName
|
|
|
|
titleLetters = Set.fromList $ maybe [] unpack mTitle
|
|
fNameLetters = Set.fromList $ unpack fName
|
|
sNameLetters = Set.fromList $ unpack sName
|
|
dNameLetters = Set.fromList $ unpack dName
|
|
addLetters = Set.fromList [' ', ',', '.']
|
|
|
|
isAdd = (`Set.member` addLetters)
|
|
stripAdd = Text.dropWhileEnd isAdd -- ? Text.dropAround isAdd |