105 lines
3.9 KiB
Haskell
105 lines
3.9 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
|
|
]
|
|
|
|
sapRes2csv :: Text -> (Ex.Value (Maybe Text), Ex.Value Day, Ex.Value Day) -> SapUserTableCsv
|
|
sapRes2csv qsh ( Ex.unValue -> Just persNo
|
|
, Ex.unValue -> firstHeld
|
|
, Ex.unValue -> validUntil
|
|
-- , Ex.unValue -> blocked
|
|
) =
|
|
SapUserTableCsv -- for csv export only
|
|
{ csvSUTpersonalNummer = persNo
|
|
, csvSUTqualifikation = qsh
|
|
, csvSUTgültigVon = firstHeld
|
|
, csvSUTgültigBis = validUntil
|
|
-- , csvSUTsupendiertBis = blocked
|
|
, csvSUTausprägung = "J"
|
|
}
|
|
sapRes2csv _ _ = error "SAP CSV export failed: filtered query returned user without internal personal number."
|
|
|
|
getQualificationSAPDirectR :: SchoolId -> QualificationShorthand -> Handler TypedContent
|
|
getQualificationSAPDirectR sid qsh = do
|
|
qualUsers <- runDB $ do
|
|
qid <- getKeyBy404 $ SchoolQualificationShort sid qsh
|
|
Ex.select $ do
|
|
(qualUser Ex.:& user) <-
|
|
Ex.from $ Ex.table @QualificationUser `Ex.innerJoin` Ex.table @User
|
|
`Ex.on` (\(qualUser Ex.:& user) -> qualUser Ex.^. QualificationUserUser Ex.==. user Ex.^. UserId)
|
|
Ex.where_ $ (Ex.val qid Ex.==. qualUser Ex.^. QualificationUserQualification)
|
|
Ex.&&. E.isJust (user Ex.^. UserCompanyPersonalNumber)
|
|
return
|
|
( user Ex.^. UserCompanyPersonalNumber
|
|
, qualUser Ex.^. QualificationUserFirstHeld
|
|
, qualUser Ex.^. QualificationUserValidUntil
|
|
-- , qualUser Ex.^. QualificationUserBlockedDue
|
|
)
|
|
now <- liftIO getCurrentTime
|
|
fdate <- formatTime' "%Y%m%d_%H-%M" now
|
|
let qshOrg = CI.original qsh
|
|
sidOrg = CI.original $ unSchoolKey sid
|
|
csvRendered = toCsvRendered sapUserTableCsvHeader $ sapRes2csv qshOrg <$> qualUsers
|
|
fmtOpts = def { csvIncludeHeader = True
|
|
, csvDelimiter = ','
|
|
, csvUseCrLf = True
|
|
}
|
|
csvOpts = def { csvFormat = fmtOpts }
|
|
csvSheetName = "fradrive_" <> sidOrg <> "_" <> qshOrg <> "_" <> 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 |