{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module System.FS.Sim.STM (
runSimFS
, simHasFS
, simHasFS'
) where
import Control.Concurrent.Class.MonadSTM.Strict
import Control.Monad.Class.MonadThrow
import Control.Monad.Primitive
import System.FS.API
import qualified System.FS.Sim.MockFS as Mock
import System.FS.Sim.MockFS (HandleMock, MockFS)
import System.FS.Sim.Prim
runSimFS :: (MonadSTM m, MonadThrow m, PrimMonad m)
=> MockFS
-> (HasFS m HandleMock -> m a)
-> m (a, MockFS)
runSimFS :: forall (m :: * -> *) a.
(MonadSTM m, MonadThrow m, PrimMonad m) =>
MockFS -> (HasFS m HandleMock -> m a) -> m (a, MockFS)
runSimFS MockFS
fs HasFS m HandleMock -> m a
act = do
StrictTMVar m MockFS
var <- MockFS -> m (StrictTMVar m MockFS)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTMVar m a)
newTMVarIO MockFS
fs
a
a <- HasFS m HandleMock -> m a
act (StrictTMVar m MockFS -> HasFS m HandleMock
forall (m :: * -> *).
(MonadSTM m, MonadThrow m, PrimMonad m) =>
StrictTMVar m MockFS -> HasFS m HandleMock
simHasFS StrictTMVar m MockFS
var)
MockFS
fs' <- STM m MockFS -> m MockFS
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m MockFS -> m MockFS) -> STM m MockFS -> m MockFS
forall a b. (a -> b) -> a -> b
$ StrictTMVar m MockFS -> STM m MockFS
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
takeTMVar StrictTMVar m MockFS
var
(a, MockFS) -> m (a, MockFS)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, MockFS
fs')
simHasFS' :: (MonadSTM m, MonadThrow m, PrimMonad m)
=> MockFS
-> m (HasFS m HandleMock)
simHasFS' :: forall (m :: * -> *).
(MonadSTM m, MonadThrow m, PrimMonad m) =>
MockFS -> m (HasFS m HandleMock)
simHasFS' MockFS
mockFS = StrictTMVar m MockFS -> HasFS m HandleMock
forall (m :: * -> *).
(MonadSTM m, MonadThrow m, PrimMonad m) =>
StrictTMVar m MockFS -> HasFS m HandleMock
simHasFS (StrictTMVar m MockFS -> HasFS m HandleMock)
-> m (StrictTMVar m MockFS) -> m (HasFS m HandleMock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MockFS -> m (StrictTMVar m MockFS)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTMVar m a)
newTMVarIO MockFS
mockFS
simHasFS :: forall m. (MonadSTM m, MonadThrow m, PrimMonad m)
=> StrictTMVar m MockFS
-> HasFS m HandleMock
simHasFS :: forall (m :: * -> *).
(MonadSTM m, MonadThrow m, PrimMonad m) =>
StrictTMVar m MockFS -> HasFS m HandleMock
simHasFS StrictTMVar m MockFS
var = HasFS {
dumpState :: m String
dumpState = FSSimT m String -> m String
forall a. FSSimT m a -> m a
sim FSSimT m String
forall (m :: * -> *). CanSimFS m => m String
Mock.dumpState
, hOpen :: HasCallStack => FsPath -> OpenMode -> m (Handle HandleMock)
hOpen = FSSimT m (Handle HandleMock) -> m (Handle HandleMock)
forall a. FSSimT m a -> m a
sim (FSSimT m (Handle HandleMock) -> m (Handle HandleMock))
-> (FsPath -> OpenMode -> FSSimT m (Handle HandleMock))
-> FsPath
-> OpenMode
-> m (Handle HandleMock)
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: FsPath -> OpenMode -> FSSimT m (Handle HandleMock)
forall (m :: * -> *).
CanSimFS m =>
FsPath -> OpenMode -> m (Handle HandleMock)
Mock.hOpen
, hClose :: HasCallStack => Handle HandleMock -> m ()
hClose = FSSimT m () -> m ()
forall a. FSSimT m a -> m a
sim (FSSimT m () -> m ())
-> (Handle HandleMock -> FSSimT m ()) -> Handle HandleMock -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle HandleMock -> FSSimT m ()
forall (m :: * -> *). CanSimFS m => Handle HandleMock -> m ()
Mock.hClose
, hIsOpen :: HasCallStack => Handle HandleMock -> m Bool
hIsOpen = FSSimT m Bool -> m Bool
forall a. FSSimT m a -> m a
sim (FSSimT m Bool -> m Bool)
-> (Handle HandleMock -> FSSimT m Bool)
-> Handle HandleMock
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle HandleMock -> FSSimT m Bool
forall (m :: * -> *). CanSimFS m => Handle HandleMock -> m Bool
Mock.hIsOpen
, hSeek :: HasCallStack => Handle HandleMock -> SeekMode -> Int64 -> m ()
hSeek = FSSimT m () -> m ()
forall a. FSSimT m a -> m a
sim (FSSimT m () -> m ())
-> (Handle HandleMock -> SeekMode -> Int64 -> FSSimT m ())
-> Handle HandleMock
-> SeekMode
-> Int64
-> m ()
forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..: Handle HandleMock -> SeekMode -> Int64 -> FSSimT m ()
forall (m :: * -> *).
CanSimFS m =>
Handle HandleMock -> SeekMode -> Int64 -> m ()
Mock.hSeek
, hGetSome :: HasCallStack => Handle HandleMock -> Word64 -> m ByteString
hGetSome = FSSimT m ByteString -> m ByteString
forall a. FSSimT m a -> m a
sim (FSSimT m ByteString -> m ByteString)
-> (Handle HandleMock -> Word64 -> FSSimT m ByteString)
-> Handle HandleMock
-> Word64
-> m ByteString
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: Handle HandleMock -> Word64 -> FSSimT m ByteString
forall (m :: * -> *).
CanSimFS m =>
Handle HandleMock -> Word64 -> m ByteString
Mock.hGetSome
, hGetSomeAt :: HasCallStack =>
Handle HandleMock -> Word64 -> AbsOffset -> m ByteString
hGetSomeAt = FSSimT m ByteString -> m ByteString
forall a. FSSimT m a -> m a
sim (FSSimT m ByteString -> m ByteString)
-> (Handle HandleMock
-> Word64 -> AbsOffset -> FSSimT m ByteString)
-> Handle HandleMock
-> Word64
-> AbsOffset
-> m ByteString
forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..: Handle HandleMock -> Word64 -> AbsOffset -> FSSimT m ByteString
forall (m :: * -> *).
CanSimFS m =>
Handle HandleMock -> Word64 -> AbsOffset -> m ByteString
Mock.hGetSomeAt
, hPutSome :: HasCallStack => Handle HandleMock -> ByteString -> m Word64
hPutSome = FSSimT m Word64 -> m Word64
forall a. FSSimT m a -> m a
sim (FSSimT m Word64 -> m Word64)
-> (Handle HandleMock -> ByteString -> FSSimT m Word64)
-> Handle HandleMock
-> ByteString
-> m Word64
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: Handle HandleMock -> ByteString -> FSSimT m Word64
forall (m :: * -> *).
CanSimFS m =>
Handle HandleMock -> ByteString -> m Word64
Mock.hPutSome
, hTruncate :: HasCallStack => Handle HandleMock -> Word64 -> m ()
hTruncate = FSSimT m () -> m ()
forall a. FSSimT m a -> m a
sim (FSSimT m () -> m ())
-> (Handle HandleMock -> Word64 -> FSSimT m ())
-> Handle HandleMock
-> Word64
-> m ()
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: Handle HandleMock -> Word64 -> FSSimT m ()
forall (m :: * -> *).
CanSimFS m =>
Handle HandleMock -> Word64 -> m ()
Mock.hTruncate
, hGetSize :: HasCallStack => Handle HandleMock -> m Word64
hGetSize = FSSimT m Word64 -> m Word64
forall a. FSSimT m a -> m a
sim (FSSimT m Word64 -> m Word64)
-> (Handle HandleMock -> FSSimT m Word64)
-> Handle HandleMock
-> m Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle HandleMock -> FSSimT m Word64
forall (m :: * -> *). CanSimFS m => Handle HandleMock -> m Word64
Mock.hGetSize
, createDirectory :: HasCallStack => FsPath -> m ()
createDirectory = FSSimT m () -> m ()
forall a. FSSimT m a -> m a
sim (FSSimT m () -> m ()) -> (FsPath -> FSSimT m ()) -> FsPath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FsPath -> FSSimT m ()
forall (m :: * -> *). CanSimFS m => FsPath -> m ()
Mock.createDirectory
, createDirectoryIfMissing :: HasCallStack => Bool -> FsPath -> m ()
createDirectoryIfMissing = FSSimT m () -> m ()
forall a. FSSimT m a -> m a
sim (FSSimT m () -> m ())
-> (Bool -> FsPath -> FSSimT m ()) -> Bool -> FsPath -> m ()
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: Bool -> FsPath -> FSSimT m ()
forall (m :: * -> *). CanSimFS m => Bool -> FsPath -> m ()
Mock.createDirectoryIfMissing
, listDirectory :: HasCallStack => FsPath -> m (Set String)
listDirectory = FSSimT m (Set String) -> m (Set String)
forall a. FSSimT m a -> m a
sim (FSSimT m (Set String) -> m (Set String))
-> (FsPath -> FSSimT m (Set String)) -> FsPath -> m (Set String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FsPath -> FSSimT m (Set String)
forall (m :: * -> *). CanSimFS m => FsPath -> m (Set String)
Mock.listDirectory
, doesDirectoryExist :: HasCallStack => FsPath -> m Bool
doesDirectoryExist = FSSimT m Bool -> m Bool
forall a. FSSimT m a -> m a
sim (FSSimT m Bool -> m Bool)
-> (FsPath -> FSSimT m Bool) -> FsPath -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FsPath -> FSSimT m Bool
forall (m :: * -> *). CanSimFS m => FsPath -> m Bool
Mock.doesDirectoryExist
, doesFileExist :: HasCallStack => FsPath -> m Bool
doesFileExist = FSSimT m Bool -> m Bool
forall a. FSSimT m a -> m a
sim (FSSimT m Bool -> m Bool)
-> (FsPath -> FSSimT m Bool) -> FsPath -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FsPath -> FSSimT m Bool
forall (m :: * -> *). CanSimFS m => FsPath -> m Bool
Mock.doesFileExist
, removeDirectoryRecursive :: HasCallStack => FsPath -> m ()
removeDirectoryRecursive = FSSimT m () -> m ()
forall a. FSSimT m a -> m a
sim (FSSimT m () -> m ()) -> (FsPath -> FSSimT m ()) -> FsPath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FsPath -> FSSimT m ()
forall (m :: * -> *). CanSimFS m => FsPath -> m ()
Mock.removeDirectoryRecursive
, removeFile :: HasCallStack => FsPath -> m ()
removeFile = FSSimT m () -> m ()
forall a. FSSimT m a -> m a
sim (FSSimT m () -> m ()) -> (FsPath -> FSSimT m ()) -> FsPath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FsPath -> FSSimT m ()
forall (m :: * -> *). CanSimFS m => FsPath -> m ()
Mock.removeFile
, renameFile :: HasCallStack => FsPath -> FsPath -> m ()
renameFile = FSSimT m () -> m ()
forall a. FSSimT m a -> m a
sim (FSSimT m () -> m ())
-> (FsPath -> FsPath -> FSSimT m ()) -> FsPath -> FsPath -> m ()
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: FsPath -> FsPath -> FSSimT m ()
forall (m :: * -> *). CanSimFS m => FsPath -> FsPath -> m ()
Mock.renameFile
, mkFsErrorPath :: FsPath -> FsErrorPath
mkFsErrorPath = FsPath -> FsErrorPath
fsToFsErrorPathUnmounted
, unsafeToFilePath :: FsPath -> m String
unsafeToFilePath = \FsPath
_ -> String -> m String
forall a. HasCallStack => String -> a
error String
"simHasFS:unsafeToFilePath"
, hGetBufSome :: HasCallStack =>
Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
hGetBufSome = FSSimT m ByteCount -> m ByteCount
forall a. FSSimT m a -> m a
sim (FSSimT m ByteCount -> m ByteCount)
-> (Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> FSSimT m ByteCount)
-> Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
forall y z x0 x1 x2 x3.
(y -> z)
-> (x0 -> x1 -> x2 -> x3 -> y) -> x0 -> x1 -> x2 -> x3 -> z
...: Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> FSSimT m ByteCount
Handle HandleMock
-> MutableByteArray (PrimState (FSSimT m))
-> BufferOffset
-> ByteCount
-> FSSimT m ByteCount
forall (m :: * -> *).
(CanSimFS m, PrimMonad m) =>
Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
Mock.hGetBufSome
, hGetBufSomeAt :: HasCallStack =>
Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
hGetBufSomeAt = FSSimT m ByteCount -> m ByteCount
forall a. FSSimT m a -> m a
sim (FSSimT m ByteCount -> m ByteCount)
-> (Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> FSSimT m ByteCount)
-> Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
forall y z x0 x1 x2 x3 x4.
(y -> z)
-> (x0 -> x1 -> x2 -> x3 -> x4 -> y)
-> x0
-> x1
-> x2
-> x3
-> x4
-> z
....: Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> FSSimT m ByteCount
Handle HandleMock
-> MutableByteArray (PrimState (FSSimT m))
-> BufferOffset
-> ByteCount
-> AbsOffset
-> FSSimT m ByteCount
forall (m :: * -> *).
(CanSimFS m, PrimMonad m) =>
Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
Mock.hGetBufSomeAt
, hPutBufSome :: HasCallStack =>
Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
hPutBufSome = FSSimT m ByteCount -> m ByteCount
forall a. FSSimT m a -> m a
sim (FSSimT m ByteCount -> m ByteCount)
-> (Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> FSSimT m ByteCount)
-> Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
forall y z x0 x1 x2 x3.
(y -> z)
-> (x0 -> x1 -> x2 -> x3 -> y) -> x0 -> x1 -> x2 -> x3 -> z
...: Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> FSSimT m ByteCount
Handle HandleMock
-> MutableByteArray (PrimState (FSSimT m))
-> BufferOffset
-> ByteCount
-> FSSimT m ByteCount
forall (m :: * -> *).
(CanSimFS m, PrimMonad m) =>
Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> m ByteCount
Mock.hPutBufSome
, hPutBufSomeAt :: HasCallStack =>
Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
hPutBufSomeAt = FSSimT m ByteCount -> m ByteCount
forall a. FSSimT m a -> m a
sim (FSSimT m ByteCount -> m ByteCount)
-> (Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> FSSimT m ByteCount)
-> Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
forall y z x0 x1 x2 x3 x4.
(y -> z)
-> (x0 -> x1 -> x2 -> x3 -> x4 -> y)
-> x0
-> x1
-> x2
-> x3
-> x4
-> z
....: Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> FSSimT m ByteCount
Handle HandleMock
-> MutableByteArray (PrimState (FSSimT m))
-> BufferOffset
-> ByteCount
-> AbsOffset
-> FSSimT m ByteCount
forall (m :: * -> *).
(CanSimFS m, PrimMonad m) =>
Handle HandleMock
-> MutableByteArray (PrimState m)
-> BufferOffset
-> ByteCount
-> AbsOffset
-> m ByteCount
Mock.hPutBufSomeAt
}
where
sim :: FSSimT m a -> m a
sim :: forall a. FSSimT m a -> m a
sim FSSimT m a
m = do
MockFS
st <- STM m MockFS -> m MockFS
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m MockFS -> m MockFS) -> STM m MockFS -> m MockFS
forall a b. (a -> b) -> a -> b
$ StrictTMVar m MockFS -> STM m MockFS
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
takeTMVar StrictTMVar m MockFS
var
FSSimT m a -> MockFS -> m (Either FsError (a, MockFS))
forall (m :: * -> *) a.
FSSimT m a -> MockFS -> m (Either FsError (a, MockFS))
runFSSimT FSSimT m a
m MockFS
st m (Either FsError (a, MockFS))
-> (Either FsError (a, MockFS) -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left FsError
e -> do
STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ StrictTMVar m MockFS -> MockFS -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTMVar m a -> a -> STM m ()
putTMVar StrictTMVar m MockFS
var MockFS
st
FsError -> m a
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO FsError
e
Right (a
a, MockFS
st') -> do
STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ StrictTMVar m MockFS -> MockFS -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTMVar m a -> a -> STM m ()
putTMVar StrictTMVar m MockFS
var MockFS
st'
a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
(.:) :: (y -> z) -> (x0 -> x1 -> y) -> (x0 -> x1 -> z)
(y -> z
f .: :: forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: x0 -> x1 -> y
g) x0
x0 x1
x1 = y -> z
f (x0 -> x1 -> y
g x0
x0 x1
x1)
(..:) :: (y -> z) -> (x0 -> x1 -> x2 -> y) -> (x0 -> x1 -> x2 -> z)
(y -> z
f ..: :: forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..: x0 -> x1 -> x2 -> y
g) x0
x0 x1
x1 x2
x2 = y -> z
f (x0 -> x1 -> x2 -> y
g x0
x0 x1
x1 x2
x2)
(...:) :: (y -> z) -> (x0 -> x1 -> x2 -> x3 -> y) -> (x0 -> x1 -> x2 -> x3 -> z)
(y -> z
f ...: :: forall y z x0 x1 x2 x3.
(y -> z)
-> (x0 -> x1 -> x2 -> x3 -> y) -> x0 -> x1 -> x2 -> x3 -> z
...: x0 -> x1 -> x2 -> x3 -> y
g) x0
x0 x1
x1 x2
x2 x3
x3 = y -> z
f (x0 -> x1 -> x2 -> x3 -> y
g x0
x0 x1
x1 x2
x2 x3
x3)
(....:) :: (y -> z) -> (x0 -> x1 -> x2 -> x3 -> x4 -> y) -> (x0 -> x1 -> x2 -> x3 -> x4 -> z)
(y -> z
f ....: :: forall y z x0 x1 x2 x3 x4.
(y -> z)
-> (x0 -> x1 -> x2 -> x3 -> x4 -> y)
-> x0
-> x1
-> x2
-> x3
-> x4
-> z
....: x0 -> x1 -> x2 -> x3 -> x4 -> y
g) x0
x0 x1
x1 x2
x2 x3
x3 x4
x4 = y -> z
f (x0 -> x1 -> x2 -> x3 -> x4 -> y
g x0
x0 x1
x1 x2
x2 x3
x3 x4
x4)