-- SPDX-FileCopyrightText: 2023 Steffen Jost <s.jost@faport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Handler.SAPSpec where

import TestImport
-- import ModelSpec ()
-- import CryptoID

import Handler.SAP


data BlockIntervalTest = BlockIntervalTest Day Day [(Day,Bool)]
  deriving (Show, Eq, Ord)

instance Arbitrary BlockIntervalTest where
  arbitrary = do
    blocks <- arbitrary
    case blocks of 
      [] -> do 
        dFrom  <- arbitrary
        dUntil <- arbitrary `suchThat` (dFrom <)
        return $ BlockIntervalTest dFrom dUntil []
      ((h,_):t') -> do
        let ds = ncons h (fst <$> t')
            dmin = minimum ds
            dmax = maximum ds
        dFrom  <- arbitrary `suchThat` (<  dmin)
        dUntil <- arbitrary `suchThat` (>= dmax)
        return $ BlockIntervalTest dFrom dUntil $ sort blocks  

  shrink (BlockIntervalTest dFrom dUntil []) 
    = [BlockIntervalTest dF dU [] | dF <- shrink dFrom, dU <- shrink dUntil, dF < dU]
  shrink (BlockIntervalTest dFrom dUntil blocks) 
    = [BlockIntervalTest dFrom dUntil b | b <- shrink blocks, all ((dFrom <=) . fst) b]


cmpBlocks :: BlockIntervalTest -> [(Day,Day)]
cmpBlocks (BlockIntervalTest dFrom dUntil blocks) = makePeriods dFrom dUntil $ cleanBlocks $ sort blocks
  where 
    cleanBlocks ((_,True):r) = cleanBlocks r
    cleanBlocks (b1@(_,False):b2@(_,True):r) = b1:b2:cleanBlocks r
    cleanBlocks (b1@(_,False):  (_,False):r) = cleanBlocks (b1:r)
    cleanBlocks r@[(_,False)] = r
    cleanBlocks [] = []

    makePeriods a b ((d1,False):(d2,True):r) 
      | b > d2 = (a,d1):makePeriods d2 b r
      | otherwise = [(a,d1)]
    makePeriods a b [(d,False)] = [(a,min b d)]
    makePeriods a b _ = [(a,b)]



spec :: Spec
spec = do 
  describe "SAP.compileBlocks" $ do
    it "yields basic intervals" . property $
      \bit@(BlockIntervalTest dFrom dUntil blocks) -> 
        cmpBlocks bit == compileBlocks dFrom dUntil blocks