This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Handler/Utils/Database.hs
2019-02-20 23:42:12 +01:00

32 lines
1.4 KiB
Haskell

module Handler.Utils.Database
( getSchoolsOf
, makeSchoolDictionaryDB, makeSchoolDictionary
) where
import Import
import Data.Map as Map
-- import Data.CaseInsensitive (CI)
-- import qualified Data.CaseInsensitive as CI
import qualified Database.Esqueleto 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