    {-# LANGUAGE CPP #-}

    -- |

    -- Module : Caching.ExpiringCacheMap.Utils.TestSequence

    -- Copyright: (c) 2014 Edward L. Blake

    -- License: BSD-style

    -- Maintainer: Edward L. Blake <edwardlblake@gmail.com>

    -- Stability: experimental

    -- Portability: portable

    --

    -- TestSequence monad for testing caching behaviour.

    --

    -- > {-# LANGUAGE OverloadedStrings #-}

    -- >

    -- > import Caching.ExpiringCacheMap.HashECM (newECMForM, lookupECM, CacheSettings(..), consistentDuration)

    -- > import qualified Caching.ExpiringCacheMap.Utils.TestSequence as TestSeq

    -- >

    -- > import qualified Data.ByteString.Char8 as BS

    -- >

    -- > test = do

    -- >   (TestSeq.TestSequenceState (_, events, _), return_value) <- TestSeq.runTestSequence test'

    -- >   (putStrLn . show . reverse) events

    -- >   return ()

    -- >   where

    -- >     test' = do

    -- >       filecache <- newECMForM

    -- >             (consistentDuration 100 -- Duration between access and expiry time of each item, no state needed.

    -- >               (\state _id -> do number <- TestSeq.readNumber

    -- >                                 return (state, number)))

    -- >             (TestSeq.getCurrentTime >>= return)

    -- >             12000 -- Time check frequency: (accumulator `mod` this_number) == 0.

    -- >             (CacheWithLRUList

    -- >               6   -- Expected size of key-value map when removing elements.

    -- >               6   -- Size of map when to remove items from key-value map.

    -- >               12  -- Size of list when to compact

    -- >               )

    -- >             TestSeq.newTestSVar TestSeq.enterTestSVar TestSeq.readTestSVar

    -- >

    -- >       -- Use lookupECM whenever the contents of "file1" is needed.

    -- >       b <- lookupECM filecache ("file1" :: BS.ByteString)

    -- >       TestSeq.haveNumber b

    -- >       b <- lookupECM filecache "file1"

    -- >       b <- lookupECM filecache "file2"

    -- >       TestSeq.haveNumber b

    -- >       return b

    -- >

    --

    -- Evaluating the @test@ function results in a list of events.

    --

    -- >>> test

    -- [GetVar 3,ReadNumber 4,GetTime 7,PutVar 11,HaveNumber 4,GetVar 14,PutVar 17,

    --  GetVar 19,ReadNumber 20,GetTime 23,PutVar 27,HaveNumber 20]

    --

    -- In this example the history shows 2 time accesses (@GetTime 7@ and

    -- @GetTime 23@) since the time check frequency number is a high value (12000),

    -- but regardless the high value a time check is still requested again because

    -- of the new key request for @"file2"@.

    --

    -- Changing the time frequency to 1 will alter the list of events with more

    -- frequent time checks:

    --

    -- >>> test

    -- [GetVar 3,ReadNumber 4,GetTime 7,PutVar 11,HaveNumber 4,GetVar 14,GetTime 15,

    --  GetTime 18,PutVar 22,GetVar 24,ReadNumber 25,GetTime 28,PutVar 32,

    --  HaveNumber 25]

    --

    module Caching.ExpiringCacheMap.Utils.TestSequence (
        runTestSequence,
        newTestSVar,
        enterTestSVar,
        readTestSVar,
        getCurrentTime,
        readNumber,
        haveNumber,
        TestSequenceEvents(..),
        TestSequenceState(..),
        TestSequence(..),
        TestSVar(..)
    ) where

    #if (!defined(__GLASGOW_HASKELL__)) || (__GLASGOW_HASKELL__ < 710)
    import Control.Applicative (Applicative(..))
    #endif
    import Control.Monad (ap, liftM)
    import Data.Word (Word32)

    data TestSequenceEvents =
      GetVar Word32 |
      PutVar Word32 |
      GetTime Word32 |
      ReadNumber Int |
      HaveNumber Int
      deriving (TestSequenceEvents -> TestSequenceEvents -> Bool
    (TestSequenceEvents -> TestSequenceEvents -> Bool)
    -> (TestSequenceEvents -> TestSequenceEvents -> Bool)
    -> Eq TestSequenceEvents
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TestSequenceEvents -> TestSequenceEvents -> Bool
    == :: TestSequenceEvents -> TestSequenceEvents -> Bool
    $c/= :: TestSequenceEvents -> TestSequenceEvents -> Bool
    /= :: TestSequenceEvents -> TestSequenceEvents -> Bool
    Eq)

    instance Show TestSequenceEvents where
      show :: TestSequenceEvents -> String
    show (GetVar Word32
    a)     = String
    "GetVar " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (Word32 -> String
    forall a. Show a => a -> String
    show Word32
    a)
      show (PutVar Word32
    a)     = String
    "PutVar " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (Word32 -> String
    forall a. Show a => a -> String
    show Word32
    a)
      show (GetTime Word32
    a)    = String
    "GetTime " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (Word32 -> String
    forall a. Show a => a -> String
    show Word32
    a)
      show (ReadNumber Int
    a) = String
    "ReadNumber " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (Int -> String
    forall a. Show a => a -> String
    show Int
    a)
      show (HaveNumber Int
    a) = String
    "HaveNumber " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (Int -> String
    forall a. Show a => a -> String
    show Int
    a)

    newtype TestSequenceState b =
      TestSequenceState (Word32, [TestSequenceEvents], Maybe b)

    instance Show (TestSequenceState ct) where
      show :: TestSequenceState ct -> String
    show (TestSequenceState (Word32
    a,[TestSequenceEvents]
    b,Maybe ct
    _)) =
        String
    "TestSequenceState " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (Word32 -> String
    forall a. Show a => a -> String
    show Word32
    a) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ([TestSequenceEvents] -> String
    forall a. Show a => a -> String
    show [TestSequenceEvents]
    b)

    newtype TestSequence b a =
      TestSequence (TestSequenceState b -> (TestSequenceState b, a))

    newtype TestSVar a = TestSVar a

    -- For GHC 7.10

    instance Functor (TestSequence a) where
      fmap :: forall a b. (a -> b) -> TestSequence a a -> TestSequence a b
    fmap = (a -> b) -> TestSequence a a -> TestSequence a b
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM

    instance Applicative (TestSequence a) where
      pure :: forall a. a -> TestSequence a a
    pure = a -> TestSequence a a
    forall a. a -> TestSequence a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
      <*> :: forall a b.
    TestSequence a (a -> b) -> TestSequence a a -> TestSequence a b
    (<*>) = TestSequence a (a -> b) -> TestSequence a a -> TestSequence a b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monad (TestSequence a) where
      TestSequence TestSequenceState a -> (TestSequenceState a, a)
    fun >>= :: forall a b.
    TestSequence a a -> (a -> TestSequence a b) -> TestSequence a b
    >>= a -> TestSequence a b
    k =
        (TestSequenceState a -> (TestSequenceState a, b))
    -> TestSequence a b
    forall b a.
    (TestSequenceState b -> (TestSequenceState b, a))
    -> TestSequence b a
    TestSequence
          (\TestSequenceState a
    state -> let (TestSequenceState a
    state', a
    ret) = (TestSequenceState a -> (TestSequenceState a, a)
    fun TestSequenceState a
    state)
                         TestSequence TestSequenceState a -> (TestSequenceState a, b)
    fun' = a -> TestSequence a b
    k a
    ret
                      in TestSequenceState a -> (TestSequenceState a, b)
    fun' TestSequenceState a
    state')
      return :: forall a. a -> TestSequence a a
    return a
    ret =
        (TestSequenceState a -> (TestSequenceState a, a))
    -> TestSequence a a
    forall b a.
    (TestSequenceState b -> (TestSequenceState b, a))
    -> TestSequence b a
    TestSequence ((TestSequenceState a -> (TestSequenceState a, a))
     -> TestSequence a a)
    -> (TestSequenceState a -> (TestSequenceState a, a))
    -> TestSequence a a
    forall a b. (a -> b) -> a -> b
    $
          \(TestSequenceState (Word32
    timer, [TestSequenceEvents]
    hl, Maybe a
    testsvar)) ->
           ((Word32, [TestSequenceEvents], Maybe a) -> TestSequenceState a
    forall b.
    (Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
    TestSequenceState (Word32
    timerWord32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    +Word32
    1,[TestSequenceEvents]
    hl, Maybe a
    testsvar), a
    ret)

    runTestSequence :: Show a => TestSequence b a -> IO (TestSequenceState b, a)
    runTestSequence :: forall a b.
    Show a =>
    TestSequence b a -> IO (TestSequenceState b, a)
    runTestSequence TestSequence b a
    f = do
      let ret :: (TestSequenceState b, a)
    ret = (TestSequenceState b -> (TestSequenceState b, a)
    fun ((Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
    forall b.
    (Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
    TestSequenceState (Word32
    0, [], Maybe b
    forall a. Maybe a
    Nothing)))
       in (TestSequenceState b, a) -> IO (TestSequenceState b, a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TestSequenceState b, a)
    ret
      where
        TestSequence TestSequenceState b -> (TestSequenceState b, a)
    fun = ((TestSequenceState b -> (TestSequenceState b, ()))
    -> TestSequence b ()
    forall b a.
    (TestSequenceState b -> (TestSequenceState b, a))
    -> TestSequence b a
    TestSequence
          (\(TestSequenceState (Word32
    t, [TestSequenceEvents]
    hl, Maybe b
    testsvar)) ->
            ((Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
    forall b.
    (Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
    TestSequenceState (Word32
    tWord32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    +Word32
    1, [TestSequenceEvents]
    hl, Maybe b
    testsvar), ()))) TestSequence b () -> TestSequence b a -> TestSequence b a
    forall a b.
    TestSequence b a -> TestSequence b b -> TestSequence b b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TestSequence b a
    f

    newTestSVar :: a -> TestSequence a (TestSVar a)
    newTestSVar :: forall a. a -> TestSequence a (TestSVar a)
    newTestSVar a
    var = (TestSequenceState a -> (TestSequenceState a, TestSVar a))
    -> TestSequence a (TestSVar a)
    forall b a.
    (TestSequenceState b -> (TestSequenceState b, a))
    -> TestSequence b a
    TestSequence ((TestSequenceState a -> (TestSequenceState a, TestSVar a))
     -> TestSequence a (TestSVar a))
    -> (TestSequenceState a -> (TestSequenceState a, TestSVar a))
    -> TestSequence a (TestSVar a)
    forall a b. (a -> b) -> a -> b
    $
      \(TestSequenceState (Word32
    timer, [TestSequenceEvents]
    hl, Maybe a
    Nothing)) ->
       ((Word32, [TestSequenceEvents], Maybe a) -> TestSequenceState a
    forall b.
    (Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
    TestSequenceState (Word32
    timerWord32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    +Word32
    1, [TestSequenceEvents]
    hl, a -> Maybe a
    forall a. a -> Maybe a
    Just a
    var), a -> TestSVar a
    forall a. a -> TestSVar a
    TestSVar a
    var)

    enterTestSVar :: TestSVar a -> (a -> TestSequence a (a,b)) -> TestSequence a b
    enterTestSVar :: forall a b.
    TestSVar a -> (a -> TestSequence a (a, b)) -> TestSequence a b
    enterTestSVar TestSVar a
    testsvar a -> TestSequence a (a, b)
    fun = do
      teststate <- TestSVar a -> TestSequence a a
    forall a. TestSVar a -> TestSequence a a
    readTestSVar TestSVar a
    testsvar
      (teststate',passalong) <- fun teststate
      putTestSVar testsvar teststate'
      return passalong

    -- 'putTestSVar' is used along with 'readTestSVar' to implement enterTestSVar.

    --

    putTestSVar :: TestSVar a -> a -> TestSequence a a
    putTestSVar :: forall a. TestSVar a -> a -> TestSequence a a
    putTestSVar TestSVar a
    _testsvar a
    testsvar' = (TestSequenceState a -> (TestSequenceState a, a))
    -> TestSequence a a
    forall b a.
    (TestSequenceState b -> (TestSequenceState b, a))
    -> TestSequence b a
    TestSequence ((TestSequenceState a -> (TestSequenceState a, a))
     -> TestSequence a a)
    -> (TestSequenceState a -> (TestSequenceState a, a))
    -> TestSequence a a
    forall a b. (a -> b) -> a -> b
    $
      \(TestSequenceState (Word32
    timer, [TestSequenceEvents]
    hl, Maybe a
    testsvar)) ->
       ((Word32, [TestSequenceEvents], Maybe a) -> TestSequenceState a
    forall b.
    (Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
    TestSequenceState (Word32
    timerWord32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    +Word32
    1, (Word32 -> TestSequenceEvents
    PutVar Word32
    timer) TestSequenceEvents -> [TestSequenceEvents] -> [TestSequenceEvents]
    forall a. a -> [a] -> [a]
    : [TestSequenceEvents]
    hl, a -> Maybe a
    forall a. a -> Maybe a
    Just a
    testsvar'),
          case Maybe a
    testsvar of
            Maybe a
    Nothing -> a
    testsvar'
            Just a
    testsvar'' -> a
    testsvar'')

    readTestSVar :: TestSVar a -> TestSequence a a
    readTestSVar :: forall a. TestSVar a -> TestSequence a a
    readTestSVar TestSVar a
    _testsvar = (TestSequenceState a -> (TestSequenceState a, a))
    -> TestSequence a a
    forall b a.
    (TestSequenceState b -> (TestSequenceState b, a))
    -> TestSequence b a
    TestSequence ((TestSequenceState a -> (TestSequenceState a, a))
     -> TestSequence a a)
    -> (TestSequenceState a -> (TestSequenceState a, a))
    -> TestSequence a a
    forall a b. (a -> b) -> a -> b
    $
      \(TestSequenceState (Word32
    timer, [TestSequenceEvents]
    hl, Just a
    testsvar)) ->
       ((Word32, [TestSequenceEvents], Maybe a) -> TestSequenceState a
    forall b.
    (Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
    TestSequenceState (Word32
    timerWord32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    +Word32
    1, (Word32 -> TestSequenceEvents
    GetVar Word32
    timer) TestSequenceEvents -> [TestSequenceEvents] -> [TestSequenceEvents]
    forall a. a -> [a] -> [a]
    : [TestSequenceEvents]
    hl, a -> Maybe a
    forall a. a -> Maybe a
    Just a
    testsvar), a
    testsvar)

    getCurrentTime :: TestSequence a Int
    getCurrentTime :: forall a. TestSequence a Int
    getCurrentTime = (TestSequenceState a -> (TestSequenceState a, Int))
    -> TestSequence a Int
    forall b a.
    (TestSequenceState b -> (TestSequenceState b, a))
    -> TestSequence b a
    TestSequence ((TestSequenceState a -> (TestSequenceState a, Int))
     -> TestSequence a Int)
    -> (TestSequenceState a -> (TestSequenceState a, Int))
    -> TestSequence a Int
    forall a b. (a -> b) -> a -> b
    $
      \(TestSequenceState (Word32
    timer, [TestSequenceEvents]
    hl, Maybe a
    testsvar)) ->
       ((Word32, [TestSequenceEvents], Maybe a) -> TestSequenceState a
    forall b.
    (Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
    TestSequenceState (Word32
    timerWord32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    +Word32
    1, (Word32 -> TestSequenceEvents
    GetTime Word32
    timer) TestSequenceEvents -> [TestSequenceEvents] -> [TestSequenceEvents]
    forall a. a -> [a] -> [a]
    : [TestSequenceEvents]
    hl, Maybe a
    testsvar), Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    timer)

    readNumber :: TestSequence a Int
    readNumber :: forall a. TestSequence a Int
    readNumber = (TestSequenceState a -> (TestSequenceState a, Int))
    -> TestSequence a Int
    forall b a.
    (TestSequenceState b -> (TestSequenceState b, a))
    -> TestSequence b a
    TestSequence ((TestSequenceState a -> (TestSequenceState a, Int))
     -> TestSequence a Int)
    -> (TestSequenceState a -> (TestSequenceState a, Int))
    -> TestSequence a Int
    forall a b. (a -> b) -> a -> b
    $
      \(TestSequenceState (Word32
    timer, [TestSequenceEvents]
    hl, Maybe a
    testsvar)) ->
        let number :: Int
    number = Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    timer
         in ((Word32, [TestSequenceEvents], Maybe a) -> TestSequenceState a
    forall b.
    (Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
    TestSequenceState (Word32
    timerWord32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    +Word32
    1, (Int -> TestSequenceEvents
    ReadNumber Int
    number) TestSequenceEvents -> [TestSequenceEvents] -> [TestSequenceEvents]
    forall a. a -> [a] -> [a]
    : [TestSequenceEvents]
    hl, Maybe a
    testsvar), Int
    number)

    haveNumber :: Int -> TestSequence a ()
    haveNumber :: forall a. Int -> TestSequence a ()
    haveNumber Int
    number = (TestSequenceState a -> (TestSequenceState a, ()))
    -> TestSequence a ()
    forall b a.
    (TestSequenceState b -> (TestSequenceState b, a))
    -> TestSequence b a
    TestSequence ((TestSequenceState a -> (TestSequenceState a, ()))
     -> TestSequence a ())
    -> (TestSequenceState a -> (TestSequenceState a, ()))
    -> TestSequence a ()
    forall a b. (a -> b) -> a -> b
    $
      \(TestSequenceState (Word32
    timer, [TestSequenceEvents]
    hl, Maybe a
    testsvar)) ->
       ((Word32, [TestSequenceEvents], Maybe a) -> TestSequenceState a
    forall b.
    (Word32, [TestSequenceEvents], Maybe b) -> TestSequenceState b
    TestSequenceState (Word32
    timerWord32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    +Word32
    1, (Int -> TestSequenceEvents
    HaveNumber Int
    number) TestSequenceEvents -> [TestSequenceEvents] -> [TestSequenceEvents]
    forall a. a -> [a] -> [a]
    : [TestSequenceEvents]
    hl, Maybe a
    testsvar), ())