67 lines
3.3 KiB
Haskell
67 lines
3.3 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Handler.Utils.Database
|
|
( getSchoolsOf
|
|
, makeSchoolDictionaryDB, makeSchoolDictionary
|
|
, StudyFeaturesDescription'
|
|
, studyFeaturesQuery, studyFeaturesQuery'
|
|
) where
|
|
|
|
import Import
|
|
|
|
import Data.Map as Map
|
|
-- import Data.CaseInsensitive (CI)
|
|
-- import qualified Data.CaseInsensitive as CI
|
|
|
|
import qualified Database.Esqueleto.Legacy as E
|
|
|
|
makeSchoolDictionaryDB :: DB (Map.Map SchoolId SchoolName)
|
|
makeSchoolDictionaryDB = makeSchoolDictionary <$> selectList [] [Asc SchoolShorthand]
|
|
|
|
makeSchoolDictionary :: [Entity School] -> Map.Map SchoolId SchoolName
|
|
makeSchoolDictionary schools = Map.fromDistinctAscList [ (ssh,schoolName) | Entity ssh School{schoolName} <- schools ]
|
|
|
|
-- getSchoolsOf :: ( BaseBackend backend ~ SqlBackend
|
|
-- , PersistEntityBackend val ~ SqlBackend
|
|
-- , PersistUniqueRead backend, PersistQueryRead backend
|
|
-- , IsPersistBackend backend, PersistEntity val, MonadIO m) =>
|
|
-- UserId -> EntityField val SchoolId -> EntityField val UserId -> ReaderT backend m [E.Value SchoolName]
|
|
getSchoolsOf :: (PersistEntity val, PersistEntityBackend val ~ SqlBackend) => UserId -> EntityField val SchoolId -> EntityField val UserId -> DB [SchoolName]
|
|
getSchoolsOf uid uschool uuser = fmap (Import.map E.unValue) $ E.select $ E.from $ \(urights `E.InnerJoin` school) -> do
|
|
E.on $ urights E.^. uschool E.==. school E.^. SchoolId
|
|
E.where_ $ urights E.^. uuser E.==. E.val uid
|
|
E.orderBy [E.asc $ school E.^.SchoolName]
|
|
return $ school E.^. SchoolName
|
|
|
|
|
|
-- | Sub-Query to retrieve StudyFeatures with their human-readable names
|
|
studyFeaturesQuery
|
|
:: E.SqlExpr (E.Value StudyFeaturesId) -- ^ query is joined on this @StudyFeaturesId@
|
|
-> E.SqlExpr (Entity StudyFeatures) `E.InnerJoin` E.SqlExpr (Entity StudyDegree) `E.InnerJoin` E.SqlExpr (Entity StudyTerms)
|
|
-> E.SqlQuery (E.SqlExpr (Entity StudyFeatures), E.SqlExpr (Entity StudyDegree), E.SqlExpr (Entity StudyTerms))
|
|
studyFeaturesQuery studyFeaturesId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do
|
|
E.on $ terms E.^. StudyTermsId E.==. features E.^. StudyFeaturesField
|
|
E.on $ degree E.^. StudyDegreeId E.==. features E.^. StudyFeaturesDegree
|
|
E.on $ features E.^. StudyFeaturesId E.==. studyFeaturesId
|
|
return (features, degree, terms)
|
|
|
|
type StudyFeaturesDescription' =
|
|
( E.SqlExpr (Maybe (Entity StudyFeatures))
|
|
, E.SqlExpr (Maybe (Entity StudyDegree))
|
|
, E.SqlExpr (Maybe (Entity StudyTerms))
|
|
)
|
|
|
|
-- | Variant of @studyFeaturesQuery@ to be used in outer joins
|
|
-- Sub-Query to retrieve StudyFeatures with their human-readable names
|
|
studyFeaturesQuery'
|
|
:: E.SqlExpr (E.Value (Maybe StudyFeaturesId)) -- ^ query is joined on this @Maybe StudyFeaturesId@
|
|
-> (E.SqlExpr (Maybe (Entity StudyFeatures)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree)) `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms)))
|
|
-> E.SqlQuery StudyFeaturesDescription'
|
|
studyFeaturesQuery' studyFeatureId (features `E.InnerJoin` degree `E.InnerJoin` terms) = do
|
|
E.on $ terms E.?. StudyTermsId E.==. features E.?. StudyFeaturesField
|
|
E.on $ degree E.?. StudyDegreeId E.==. features E.?. StudyFeaturesDegree
|
|
E.on $ features E.?. StudyFeaturesId E.==. studyFeatureId
|
|
return (features, degree, terms)
|