Merge branch 'master' of https://gitlab.uniworx.de/fradrive/fradrive

CHANGELOG.md

@@ -2,6 +2,16 @@
 
 All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
 
+## [27.4.44](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.43...v27.4.44) (2023-10-18)
+
+
+### Bug Fixes
+
+* **sap:** combine immediate next day licence chnages for SAP ([f4adfdf](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/f4adfdf87270930d4ca6611f2a9956613fcace53))
+* **sap:** combine immediate next day licence chnages for SAP ([cbb44f1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/cbb44f106ad59e0a53ca04963ade5544120b7e21))
+* **sap:** combineBlocks yet another bug squashed ([3924d14](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/3924d14abd868305b42c9d04913536b4999dc45b))
+* **sap:** compileBlocks ([b4a88ab](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/b4a88abcf85783c350ad2bf3a5e973d13d1eb1f6))
+
 ## [27.4.43](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.42...v27.4.43) (2023-10-13)
 
 ## [27.4.42](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.41...v27.4.42) (2023-10-12)

nix/docker/version.json

@@ -1,3 +1,3 @@
 {
-  "version": "27.4.43"
+  "version": "27.4.44"
 }

package-lock.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "27.4.43",
+  "version": "27.4.44",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {

package.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "27.4.43",
+  "version": "27.4.44",
   "description": "",
   "keywords": [],
   "author": "",

package.yaml

@@ -1,5 +1,5 @@
 name: uniworx
-version: 27.4.43
+version: 27.4.44
 dependencies:
   - base
   - yesod

src/Handler/SAP.hs

@@ -79,18 +79,18 @@ compileBlocks :: Day -> Day -> [(Day,Bool)] -> [(Day, Day)]
 compileBlocks dStart dEnd = go (dStart, True) 
   where 
     go :: (Day,Bool) -> [(Day,Bool)] -> [(Day, Day)]
-    go b@(d,s) ((d1,s1):r1@((d2,_s2):_r2))
-      | d1 == d2 || succ d1 == d2 || s == s1 || d1 < d = go b r1  -- ignore unnecessary change
-    go b@(d,s) ((d1,s1):r1)
-      | d1 >= dEnd        = go b []                               -- remaining days extend validity
-      | s, not s1, d < d1 = (d,d1) : go (d1,s1) r1                -- valid interval found
-      | s == s1           =          go  b      r1                -- no change
-      | otherwise         =          go (d1,s1) r1                -- ignore invalid interval
+    go (d,s) (p1@(d1,s1):r1@((d2,s2):r2))
+      | s1 == s2 && d <= d1                            = go (d,s) (p1:r2)   -- ignore unnecessary 2nd change      
+      | d1 == d2 || succ d1 == d2 || s == s1 || d > d1 = go (d,s)     r1    -- ignore unnecessary 1st change      
+    go (d,s) ((d1,s1):r1)
+      | dEnd <= d1        =          go (d ,s ) []                          -- remaining dates extend validity        
+      | s, not s1, d < d1 = (d,d1) : go (d1,s1) r1                          -- valid interval found
+      | s == s1           =          go (d ,s ) r1                          -- no change
+      | otherwise         =          go (d1,s1) r1                          -- ignore invalid interval
     go (d,s) []
       | s         = [(d,dEnd)]
       | otherwise = []
 
-
 -- | Deliver all employess with a successful LDAP synch within the last 3 months
 getQualificationSAPDirectR :: Handler TypedContent
 getQualificationSAPDirectR = do

test/Handler/SAPSpec.hs

@@ -79,6 +79,7 @@ spec = do
           w0 = fromGregorian 2001  9 22
           w1 = fromGregorian 2023  9 22
           w2 = fromGregorian 2023 10 16
+          wF = fromGregorian 2023 10 17
           w3 = fromGregorian 2023 11 17
           w4 = fromGregorian 2024 01 21
       compileBlocks wA wE []           `shouldBe` [(wA,wE)]
@@ -94,6 +95,10 @@ spec = do
       compileBlocks wA wE [(w1,False),(w1,True),(w1,False),(w1,True),(w1,False),(w2,True)] `shouldBe` [(wA,w1),(w2,wE)]
       compileBlocks wA wE [(w0,True),(w1,True),(w1,False),(w1,True),(w1,False),(w2,True),(w3,True)] `shouldBe` [(wA,w1),(w2,wE)]
       compileBlocks wA wE [(w0,False),(w1,False),(w2,True),(w3,False),(w4,True)] `shouldBe` [(wA,w1),(w2,w3),(w4,wE)]
+      compileBlocks wA wE [(w1,False),(w2,True),(wF,True ),(w3,False)] `shouldBe` [(wA,w1),(w2,w3)]
+      compileBlocks wA wE [(w1,True),(w2,False),(wF,False),(w3,True)] `shouldBe` [(wA,w2),(w3,wE)]
+      compileBlocks wA wE [(w2,False),(wF,False),(w3,True)] `shouldBe` [(wA,w2),(w3,wE)]
+      compileBlocks wA wE [(w2,False),(wF,False)] `shouldBe` [(wA,w2) ]
 
     it "handles basic intervals" $ do
       (d1,d2,d3) <- generate $ do