103 lines
4.2 KiB
Haskell
103 lines
4.2 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
{-# LANGUAGE TypeApplications #-}
|
|
|
|
module Handler.SAP
|
|
( getQualificationSAPDirectR
|
|
)
|
|
where
|
|
|
|
import Import
|
|
|
|
import Handler.Utils
|
|
import Handler.Utils.Csv
|
|
|
|
-- import qualified Data.CaseInsensitive as CI
|
|
import qualified Data.Csv as Csv
|
|
import qualified Database.Esqueleto.Experimental as Ex -- needs TypeApplications Lang-Pragma
|
|
-- import qualified Database.Esqueleto.Legacy as E
|
|
import qualified Database.Esqueleto.Utils as E
|
|
|
|
|
|
data SapUserTableCsv = SapUserTableCsv -- for csv export only
|
|
{ csvSUTpersonalNummer :: Text
|
|
, csvSUTqualifikation :: Text
|
|
, csvSUTgültigVon :: Day
|
|
, csvSUTgültigBis :: Day
|
|
-- , csvSUTsupendiertBis :: Maybe Day
|
|
, csvSUTausprägung :: Text
|
|
}
|
|
deriving (Show, Generic)
|
|
makeLenses_ ''SapUserTableCsv
|
|
|
|
sapUserTableCsvHeader :: Csv.Header
|
|
sapUserTableCsvHeader = Csv.header
|
|
[ "PersonalNummer"
|
|
, "Qualifikation"
|
|
, "GültigVon"
|
|
, "GültigBis"
|
|
-- , "SupendiertBis"
|
|
, "Ausprägung"
|
|
]
|
|
|
|
instance ToNamedRecord SapUserTableCsv where
|
|
toNamedRecord SapUserTableCsv{..} = Csv.namedRecord
|
|
[ "PersonalNummer" Csv..= csvSUTpersonalNummer
|
|
, "Qualifikation" Csv..= csvSUTqualifikation
|
|
, "GültigVon" Csv..= csvSUTgültigVon
|
|
, "GültigBis" Csv..= csvSUTgültigBis
|
|
-- , "SupendiertBis" Csv..= csvSUTsupendiertBis
|
|
, "Ausprägung" Csv..= csvSUTausprägung
|
|
]
|
|
|
|
-- | Removes all elements containing Nothing, which should not be returend by the query anyway (only qualfications with sap id and users with internal personal number must be transmitted)
|
|
-- TODO: once temporary suspensions are implemented, a user must be transmitted to SAP in two rows: firstheld->suspensionFrom & suspensionTo->validTo
|
|
sapRes2csv :: [(Ex.Value (Maybe Text), Ex.Value Day, Ex.Value Day, Ex.Value (Maybe Text))] -> [SapUserTableCsv]
|
|
sapRes2csv l = [ res | (Ex.Value (Just persNo), Ex.Value firstHeld, Ex.Value validUntil, Ex.Value (Just sapId)) <- l
|
|
, let res = SapUserTableCsv
|
|
{ csvSUTpersonalNummer = persNo
|
|
, csvSUTqualifikation = sapId
|
|
, csvSUTgültigVon = firstHeld
|
|
, csvSUTgültigBis = validUntil
|
|
-- , csvSUTsupendiertBis = blocked
|
|
, csvSUTausprägung = "J"
|
|
}
|
|
]
|
|
|
|
getQualificationSAPDirectR :: Handler TypedContent
|
|
getQualificationSAPDirectR = do
|
|
qualUsers <- runDB $ Ex.select $ do
|
|
(qual Ex.:& qualUser Ex.:& user) <-
|
|
Ex.from $ Ex.table @Qualification
|
|
`Ex.innerJoin` Ex.table @QualificationUser
|
|
`Ex.on` (\(qual Ex.:& qualUser) -> qual Ex.^. QualificationId Ex.==. qualUser Ex.^. QualificationUserQualification)
|
|
`Ex.innerJoin` Ex.table @User
|
|
`Ex.on` (\(_ Ex.:& qualUser Ex.:& user) -> qualUser Ex.^. QualificationUserUser Ex.==. user Ex.^. UserId)
|
|
Ex.where_ $ E.isJust (qual Ex.^. QualificationSapId)
|
|
Ex.&&. E.isJust (user Ex.^. UserCompanyPersonalNumber)
|
|
return
|
|
( user Ex.^. UserCompanyPersonalNumber
|
|
, qualUser Ex.^. QualificationUserFirstHeld
|
|
, qualUser Ex.^. QualificationUserValidUntil
|
|
-- , qualUser Ex.^. QualificationUserBlockedDue
|
|
, qual Ex.^. QualificationSapId
|
|
)
|
|
now <- liftIO getCurrentTime
|
|
fdate <- formatTime' "%Y%m%d_%H-%M" now
|
|
let csvRendered = toCsvRendered sapUserTableCsvHeader $ sapRes2csv qualUsers
|
|
fmtOpts = def { csvIncludeHeader = True
|
|
, csvDelimiter = ','
|
|
, csvUseCrLf = True
|
|
}
|
|
csvOpts = def { csvFormat = fmtOpts }
|
|
csvSheetName = "fradrive_sap_" <> fdate <> ".csv"
|
|
nr = length qualUsers
|
|
msg = "Qualification download file " <> csvSheetName <> " containing " <> tshow nr <> " rows"
|
|
$logInfoS "SAP" msg
|
|
addHeader "Content-Disposition" $ "attachment; filename=\"" <> csvSheetName <> "\""
|
|
csvRenderedToTypedContentWith csvOpts csvSheetName csvRendered
|
|
|
|
-- direct Download see:
|
|
-- https://ersocon.net/blog/2017/2/22/creating-csv-files-in-yesod |