-- SPDX-FileCopyrightText: 2022 Steffen Jost -- -- 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 Nothing -- 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 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