61 lines
2.5 KiB
Haskell
61 lines
2.5 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
|
|
|
|
import Database.Persist.Postgresql
|
|
|
|
-- | Ensure that the given user is linked to the given company
|
|
upsertUserCompany :: UserId -> Maybe Text -> Maybe StoredMarkup -> DB ()
|
|
upsertUserCompany uid (Just cName) cAddr | notNull cName = do
|
|
cid <- upsertCompany cName cAddr
|
|
void $ upsertBy (UniqueUserCompany uid cid)
|
|
(UserCompany uid cid False False)
|
|
[]
|
|
superVs <- selectList [UserCompanyCompany ==. cid, UserCompanySupervisor ==. True] []
|
|
upsertManyWhere [ UserSupervisor super uid reroute
|
|
| Entity{entityVal=UserCompany{userCompanyUser=super, userCompanySupervisorReroute=reroute, userCompanySupervisor=True}} <- superVs
|
|
] [] [] []
|
|
upsertUserCompany uid _ _ =
|
|
deleteWhere [ UserCompanyUser ==. uid ] -- maybe also delete company supervisors?
|
|
|
|
-- | Does not update company address for now
|
|
-- TODO: update company address, maybe?!
|
|
upsertCompany :: Text -> Maybe StoredMarkup -> DB CompanyId
|
|
upsertCompany cName cAddr =
|
|
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' 0 False cAddr -- TODO: Fix this once AVS CR3 SCF-165 is implemented
|
|
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' 0 False Nothing) >>= \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
|