fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(avs): E.values working example established

Browse Source
This commit is contained in:
Steffen Jost 2022-11-28 09:54:27 +01:00
parent 3794f7482b
commit 59f268a796
2 changed files with 30 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Database/Esqueleto/Utils.hs
View File

@ -7,7 +7,7 @@
module Database.Esqueleto.Utils
( true, false
, justVal, justValList
, justVal, justValList, toValues
, isJust, alt
, isInfixOf, hasInfix
, strConcat, substring
@ -50,7 +50,9 @@ import Data.Universe
import qualified Data.Set as Set
import qualified Data.List as List
import qualified Data.Foldable as F
import Data.List.NonEmpty (NonEmpty(..))
import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Experimental as Ex
import qualified Database.Esqueleto.PostgreSQL as E
import qualified Database.Esqueleto.Internal.Internal as E
import Database.Esqueleto.Utils.TH
@ -104,6 +106,9 @@ justValList :: PersistField typ => [typ] -> E.SqlExpr (E.ValueList (Maybe typ))
-- justValList = E.valList . map Just
justValList = E.justList . E.valList
toValues :: PersistField typ => NonEmpty typ -> Ex.From (Ex.SqlExpr (Ex.Value typ)) -- E.From does not work here! Requires Experimental!
toValues = E.values . fmap Ex.val
infixl 4 =?.
(=?.) :: PersistField typ => E.SqlExpr (E.Value typ) -> E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value Bool)
(=?.) = (E.==.) . E.just

37
src/Handler/Utils/Avs.hs
View File

@ -6,7 +6,7 @@
{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- TODO: remove this line, once the module is completed
{-# OPTIONS_GHC -Wno-error=unused-local-binds #-} -- TODO: remove this line, once the module is completed
{-# OPTIONS_GHC -Wno-warn=unused-local-binds #-} -- TODO: remove this line, once the module is completed
module Handler.Utils.Avs
@ -134,24 +134,35 @@ checkLicences = do
noOne = AvsPersonId 0
vorORrollfeld' = Set.dropWhileAntitone (`avsPersonLicenceIsLEQ` AvsNoLicence) licences
rollfeld' = Set.dropWhileAntitone (`avsPersonLicenceIsLEQ` AvsLicenceVorfeld) vorORrollfeld'
vorORrollfeld :: NonEmpty AvsPersonId = set2NonEmpty noOne (Set.map avsLicencePersonID vorORrollfeld')
vorORrollfeld = set2NonEmpty noOne (Set.map avsLicencePersonID vorORrollfeld')
rollfeld = set2NonEmpty noOne (Set.map avsLicencePersonID rollfeld' )
-- we get a weird type error so we try a simple demo here:
(_res :: [(E.Value AvsPersonId, E.Value AvsPersonId )]) <- runDB $ E.select $ do
(usrAvs E.:& (excl,_)) <-
E.from $ E.table @UserAvs `E.innerJoin` E.values ((E.val (AvsPersonId 10), E.val ("ten" :: Text))
:| [ (E.val (AvsPersonId 20), E.val "twenty")
, (E.val (AvsPersonId 30), E.val "thirty") ]
)
`E.on` (\(usrAvs E.:& (excl,_)) -> excl E.==. usrAvs E.^. UserAvsPersonId)
(usrAvs E.:& excl) <-
E.from $ E.table @UserAvs `E.innerJoin` E.toValues rollfeld
`E.on` (\(usrAvs E.:& excl) -> excl E.==. usrAvs E.^. UserAvsPersonId)
return (usrAvs E.^. UserAvsPersonId, excl)
-- > Looks like we need te Type NonEmpty (SqlExpr (Value typ)) i.e. we need to wrap everything with E.val?!
{-
-- antijoinAvsLicences :: AvsLicence -> NonEmpty AvsPersonId -> DB [(E.Value (Maybe AvsPersonId), E.Value (Maybe AvsPersonId))]
{-
Cases to consider (AVS_Licence,has_valid_F, has_valid_R):
(0,0,0) -> ok; avs_id not returned from queries, no problem
(0,0,1) -> do nothing -- CHECK since id is returned by roll-query
(0,1,0) -> set F for id
(0,1,1) -> set R for id
(1,0,0) -> unset F for id
(1,0,1) -> unset F for id
(1,1,0) -> ok
(1,1,1) -> set R for id
(2,0,0) -> unset R for id
(2,0,1) -> unset R for id -- CHECK
(2,1,0) -> set F for id
(2,1,1) -> ok
-}
antijoinAvsLicences :: AvsLicence -> NonEmpty AvsPersonId -> DB [(E.Value (Maybe AvsPersonId), E.Value (Maybe AvsPersonId))]
antijoinAvsLicences lic avsLics = --fmap (fmap $(E.unValueN 2)) $
E.select $ do
((_qauli E.:& _qualUser E.:& usrAvs) E.:& excl) <-
@ -167,11 +178,11 @@ checkLicences = do
)
`E.innerJoin` E.table @UserAvs
`E.on` (\(_ E.:& qualUser E.:& usrAvs) -> qualUser E.^. QualificationUserUser E.==. usrAvs E.^. UserAvsUser)
) `E.fullOuterJoin` E.values avsLics -- left-hand side produces all currently valid matching qualifications
) `E.fullOuterJoin` E.toValues avsLics -- left-hand side produces all currently valid matching qualifications
`E.on` (\((_ E.:& _ E.:& usrAvs) E.:& excl) -> usrAvs E.?. UserAvsPersonId E.==. excl)
E.where_ $ E.isNothing excl E.||. E.isNothing (usrAvs E.?. UserAvsPersonId) -- anti join
return (usrAvs E.?. UserAvsPersonId, excl)
-}
-- (_rollDelta, _vorfDelta) <- runDB $ (,)
-- <$> antijoinAvsLicences AvsLicenceRollfeld rollfeld
-- <*> antijoinAvsLicences AvsLicenceVorfeld vorORrollfeld