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

fix(sap): yet another fix for finding date intervals

Browse Source
This commit is contained in:
Steffen Jost 2023-10-18 14:38:02 +00:00
parent ebf250bd8c
commit fde97b048a
2 changed files with 13 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Handler/SAP.hs
View File

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

5
test/Handler/SAPSpec.hs
View File

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