chore(avs): improve avs interface, check licences (WIP)

models/lms.model

@@ -15,9 +15,11 @@ Qualification
   -- elearningOnly       Bool                   -- successful E-learing automatically increases validity. NO!
   -- refreshInvitation   StoredMarkup           -- hard-coded I18N-MSGs used instead, but displayed on qualification page NO!
   -- expiryNotification  StoredMarkup Maybe     -- configurable user-profile-notifcations are used instead NO!
+  avsLicence          AvsLicence Maybe          -- if set, is synchronized to Avs as a driving licence
   sapId               Text Maybe                -- if set, all QualificationUsers with userCompanyPersonalNumber are transmitted via SAP interface under this id
   SchoolQualificationShort school shorthand            -- must be unique per school and shorthand
   SchoolQualificationName  school name                 -- must be unique per school and name
+  UniqueQualificationAvsLicence avsLicence             -- across all schools, only one qualification may be a driving licence
   deriving Generic
 
 -- TODOs:

src/Handler/Utils/Avs.hs

@@ -29,8 +29,9 @@ import Foundation.Yesod.Auth (upsertCampusUserByCn,CampusUserConversionException
 import Handler.Utils.Company
 import Handler.Users.Add
 
---import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
+import           Database.Esqueleto.Experimental ((:&))
---import qualified Database.Esqueleto.Utils as E
+import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
+import qualified Database.Esqueleto.Utils as E
 
 
 --------------------
@@ -115,7 +116,7 @@ setLicencesAvs pls = do
 --   Only react to changes as compared to last seen status in avs.model
 --   TODO: turn into a job, once the interface is actually available
 checkLicences :: Handler ()
-checkLicences = do
+checkLicences = do  
   {-
   AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery  
   AvsResponseGetLicences licences <- throwLeftM avsQueryGetAllLicences  
@@ -124,17 +125,39 @@ checkLicences = do
   --     rollfeld             = Set.filter    (`avsPersonLicenceIs` AvsLicenceRollfeld) nonvorfeld
   let (noOrVorfeld, rollfeld) = Set.spanAntitone (`avsPersonLicenceIsLEQ` AvsLicenceVorfeld) licences
       (_nolicence ,  vorfeld) = Set.spanAntitone (`avsPersonLicenceIsLEQ` AvsNoLicence)      noOrVorfeld
-  now <- liftIO getCurrentTime
+      idsRollfeld = avsLicencePersonId <$> Set.toList rollfeld
+      idsVorfeld  = avsLicencePersonId <$> Set.toList vorfeld
 
+  -- let licenceMap Map.map avsLicencePersonID $ avsMap.fromSet avsLicenceRampLicence licences
+  --     idsRollfeld = concat $ Map.lookup AvsLicenceRollfeld licenceMap
+  --     idsVorfeld  = concat $ Map.lookup AvsLicenceVorfeld
+
+  now <- liftIO getCurrentTime
 
 
   runDB $ do
     E.select $ do
-  -}  
+      (qauli E.:& qualUser E.:& usrAvs) <-
+        E.from $      E.table @Qualification
+        `E.innerJoin` E.table @QualificationUser
+        `E.on` (\(quali E.:& qualUser) -> qual E.^. QualificationId E.==. qualUser E.^. QualificationUserQualification)
+        `E.innerJoin` E.table @UserAvs
+        `E.on` (\(_ E.:& qualUser E.:& usrAvs) -> qualUser E.^. QualificationUserUser E.==. usrAvs E.^. UserAvsUser)
+      E.where_ $ E.isJust (quali E.^. QualificationAvsLicence)
+          E.&&.  (usrAvs E.^. QualificationAvsLicence `E.notIn` E.valList
 
+      -- WAS WILL ICH HIER WIRKLICH:
+      --  Liefere alle avsIds, welche die falsche Qualifikation zugewiesen bekommen haben?
+          -- Wie erhalte ich alle IDs, welche es KEINE Qualifikation haben?  FROM valList scheint es nicht zu geben!
+
+      return 
+        ( userAvs E.^. UserAvsPersonId
+        , quali   E.^. QualificationAvsLicence
+        )
 
   --TODO this must be chunked into separate jobs/tasks
   --forM licences $ \AvsPersonLicence{..} -> do
+  -}
   error "CONTINUE HERE" -- TODO STUB
 
 

src/Model/Types/Avs.hs

@@ -356,7 +356,7 @@ instance ToJSON AvsDataPerson where
     , "personCards"         .= avsPersonPersonCards   -- starts with lower case letter!
     ]
 
-{- Dervied instance decodes empty Texts to Just "", which is annoying
+{- Derived instance decodes empty Texts to Just "", which is annoying
 deriveJSON defaultOptions
   { fieldLabelModifier = \case { "avsPersonPersonCards" -> "personCards"; others -> dropCamel 2 others }
   , omitNothingFields = True

test/Database/Fill.hs

@@ -511,9 +511,9 @@ fillDb = do
   let f_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf den Fahrstrassen des Vorfeldes.|]
   let r_descr = Just $ htmlToStoredMarkup [shamlet|<p>Berechtigung zum Führen eines Fahrzeuges auf dem gesamten Rollfeld.|]
   let l_descr = Just $ htmlToStoredMarkup [shamlet|<p>für unhabilitierte|]
-  qid_f  <- insert' $ Qualification avn "F" "Vorfeldführerschein"  f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) True  $ Just "F4466"
+  qid_f  <- insert' $ Qualification avn "F" "Vorfeldführerschein"  f_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 0 60) True  (Just AvsLicenceVorfeld)  $ Just "F4466"
-  qid_r  <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 2 3)  False $ Just "R2801"
+  qid_r  <- insert' $ Qualification avn "R" "Rollfeldführerschein" r_descr (Just 24) (Just 6) (Just $ CalendarDiffDays 2 3)  False (Just AvsLicenceRollfeld) $ Just "R2801"
-  qid_l  <- insert' $ Qualification ifi "L" "Lehrbefähigung"       l_descr Nothing   (Just 6) Nothing True Nothing
+  qid_l  <- insert' $ Qualification ifi "L" "Lehrbefähigung"       l_descr Nothing   (Just 6) Nothing True Nothing Nothing
   void . insert' $ QualificationUser jost       qid_f (n_day    9) (n_day $   -1) (n_day $   -22) Nothing -- TODO: better dates!
   void . insert' $ QualificationUser jost       qid_r (n_day   99) (n_day $  -11) (n_day $  -222) (Just $ QualificationBlockedLms $ n_day $ -5)-- TODO: better dates!
   void . insert' $ QualificationUser jost       qid_l (n_day  999) (n_day $ -111) (n_day $ -2222) Nothing -- TODO: better dates!