WithEntryCounter.hs

{-# LANGUAGE RecordWildCards #-}

module Test.Util.WithEntryCounter (
    EntryCounters (..)
  , zeroEntryCounters
  , incrTVar
  , withEntryCounters
  ) where

import           Control.Concurrent.Class.MonadSTM.Strict
import           Data.Word
import           System.FS.API

data EntryCounters f = EntryCounters {
    dumpStateC                :: f Word64
    -- file operations
  , hOpenC                    :: f Word64
  , hCloseC                   :: f Word64
  , hIsOpenC                  :: f Word64
  , hSeekC                    :: f Word64
  , hGetSomeC                 :: f Word64
  , hGetSomeAtC               :: f Word64
  , hPutSomeC                 :: f Word64
  , hTruncateC                :: f Word64
  , hGetSizeC                 :: f Word64
    -- directory operations
  , createDirectoryC          :: f Word64
  , createDirectoryIfMissingC :: f Word64
  , listDirectoryC            :: f Word64
  , doesDirectoryExistC       :: f Word64
  , doesFileExistC            :: f Word64
  , removeDirectoryRecursiveC :: f Word64
  , removeFileC               :: f Word64
  , renameFileC               :: f Word64
    -- file I\/O with user-supplied buffers
  , hGetBufSomeC              :: f Word64
  , hGetBufSomeAtC            :: f Word64
  , hPutBufSomeC              :: f Word64
  , hPutBufSomeAtC            :: f Word64
  }

zeroEntryCounters :: MonadSTM m => m (EntryCounters (StrictTVar m))
zeroEntryCounters = EntryCounters <$>
    newTVarIO 0 <*> newTVarIO 0 <*> newTVarIO 0 <*> newTVarIO 0 <*>
    newTVarIO 0 <*> newTVarIO 0 <*> newTVarIO 0 <*> newTVarIO 0 <*>
    newTVarIO 0 <*> newTVarIO 0 <*> newTVarIO 0 <*> newTVarIO 0 <*>
    newTVarIO 0 <*> newTVarIO 0 <*> newTVarIO 0 <*> newTVarIO 0 <*>
    newTVarIO 0 <*> newTVarIO 0 <*> newTVarIO 0 <*> newTVarIO 0 <*>
    newTVarIO 0 <*> newTVarIO 0

incrTVar :: MonadSTM m => StrictTVar m Word64 -> m ()
incrTVar var = atomically $ modifyTVar var (+1)

withEntryCounters ::
     MonadSTM m
  => EntryCounters (StrictTVar m)
  -> HasFS m h
  -> HasFS m h
withEntryCounters EntryCounters{..} HasFS{..} = HasFS {
      dumpState = incrTVar dumpStateC >> dumpState
      -- file operatoins
    , hOpen = \a b -> incrTVar hOpenC >> hOpen a b
    , hClose = \a -> incrTVar hCloseC >> hClose a
    , hIsOpen = \a -> incrTVar hIsOpenC >> hIsOpen a
    , hSeek = \a b c -> incrTVar hSeekC >> hSeek a b c
    , hGetSome = \a b -> incrTVar hGetSomeC >> hGetSome a b
    , hGetSomeAt = \a b c -> incrTVar hGetSomeAtC >> hGetSomeAt a b c
    , hPutSome = \a b -> incrTVar hPutSomeC >> hPutSome a b
    , hTruncate = \a b -> incrTVar hTruncateC >> hTruncate a b
    , hGetSize = \a -> incrTVar hGetSizeC >> hGetSize a
      -- directory operations
    , createDirectory = \a -> incrTVar createDirectoryC >> createDirectory a
    , createDirectoryIfMissing = \a b -> incrTVar createDirectoryIfMissingC >> createDirectoryIfMissing a b
    , listDirectory = \a -> incrTVar listDirectoryC >> listDirectory a
    , doesDirectoryExist = \a -> incrTVar doesDirectoryExistC >> doesDirectoryExist a
    , doesFileExist = \a -> incrTVar doesFileExistC >> doesFileExist a
    , removeDirectoryRecursive = \a -> incrTVar removeDirectoryRecursiveC >> removeDirectoryRecursive a
    , removeFile = \a -> incrTVar removeFileC >> removeFile a
    , renameFile = \a b -> incrTVar renameFileC >> renameFile a b
    , mkFsErrorPath = mkFsErrorPath
    , unsafeToFilePath = unsafeToFilePath
      -- file I\/O with user-supplied buffers
    , hGetBufSome = \a b c d -> incrTVar hGetBufSomeC >> hGetBufSome a b c d
    , hGetBufSomeAt = \a b c d e -> incrTVar hGetBufSomeAtC >> hGetBufSomeAt a b c d e
    , hPutBufSome = \a b c d -> incrTVar hPutBufSomeC >> hPutBufSome a b c d
    , hPutBufSomeAt = \a b c d e -> incrTVar hPutBufSomeAtC >> hPutBufSomeAt a b c d e
    }