53 lines
1.9 KiB
Haskell
53 lines
1.9 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Handler.Utils.Company where
|
|
|
|
import Import
|
|
-- import Utils.PathPiece
|
|
|
|
-- import Data.CaseInsensitive (CI)
|
|
import qualified Data.CaseInsensitive as CI
|
|
import qualified Data.Char as Char
|
|
import qualified Data.Text as Text
|
|
|
|
|
|
-- | Ensure that the given user is linked to the given company
|
|
upsertUserCompany :: UserId -> Maybe Text -> DB ()
|
|
upsertUserCompany uid (Just cName) | notNull cName = do
|
|
cid <- upsertCompany cName
|
|
void $ upsertBy (UniqueUserCompany uid)
|
|
(UserCompany uid cid False)
|
|
[UserCompanyCompany =. cid, UserCompanySupervisor =. False]
|
|
upsertUserCompany uid _ = deleteBy (UniqueUserCompany uid)
|
|
|
|
upsertCompany :: Text -> DB CompanyId
|
|
upsertCompany cName =
|
|
let cName' = CI.mk cName in
|
|
getBy (UniqueCompanyName cName') >>= \case
|
|
Just ent -> return $ entityKey ent
|
|
Nothing -> getBy (UniqueCompanySynonym cName') >>= \case
|
|
Just ent -> return . CompanyKey . companySynonymCanonical $ entityVal ent
|
|
Nothing -> do
|
|
let cShort = companyShorthandFromName cName
|
|
cShort' <- findShort cName' $ CI.mk cShort
|
|
let compy = Company cName' cShort'
|
|
either entityKey id <$> insertBy compy
|
|
where
|
|
findShort :: CompanyName -> CompanyShorthand -> DB CompanyShorthand
|
|
findShort fna fsh = aux 0
|
|
where
|
|
aux n = let fsh' = if n==0 then fsh else fsh <> CI.mk (tshow n) in
|
|
checkUnique (Company fna fsh') >>= \case
|
|
Nothing -> return fsh'
|
|
_other -> aux (n+1)
|
|
|
|
-- | Just a cheap heuristic, needs manual intervention anyway
|
|
companyShorthandFromName :: Text -> Text
|
|
companyShorthandFromName cName =
|
|
let cpats = splitCamel cName
|
|
strip = Text.filter Char.isAlphaNum . Text.take 3
|
|
spats = strip <$> cpats
|
|
in Text.concat spats
|