{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UnboxedTuples              #-}
{-# LANGUAGE UndecidableInstances       #-}

-- | Mocked, monad transformer-based implementation of the 'HasFS' interface.
module System.FS.Sim.Prim (
    FSSimT
  , runFSSimT
  , primHasMockFS
  ) where

import           Control.Monad.Except
import           Control.Monad.Primitive
import           Control.Monad.State

import           System.FS.API

import qualified System.FS.Sim.MockFS as Mock
import           System.FS.Sim.MockFS (MockFS)

-- | Monad transformer that extends a monad @m@ with pure features: (i) 'MockFS'
-- state, and (ii) throwing/catching 'FsError's.
newtype FSSimT m a = PureSimFS {
    forall (m :: * -> *) a.
FSSimT m a -> StateT MockFS (ExceptT FsError m) a
unFSSimT :: StateT MockFS (ExceptT FsError m) a
  }
  deriving newtype ( (forall a b. (a -> b) -> FSSimT m a -> FSSimT m b)
-> (forall a b. a -> FSSimT m b -> FSSimT m a)
-> Functor (FSSimT m)
forall a b. a -> FSSimT m b -> FSSimT m a
forall a b. (a -> b) -> FSSimT m a -> FSSimT m b
forall (m :: * -> *) a b.
Functor m =>
a -> FSSimT m b -> FSSimT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> FSSimT m a -> FSSimT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> FSSimT m a -> FSSimT m b
fmap :: forall a b. (a -> b) -> FSSimT m a -> FSSimT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> FSSimT m b -> FSSimT m a
<$ :: forall a b. a -> FSSimT m b -> FSSimT m a
Functor, Functor (FSSimT m)
Functor (FSSimT m) =>
(forall a. a -> FSSimT m a)
-> (forall a b. FSSimT m (a -> b) -> FSSimT m a -> FSSimT m b)
-> (forall a b c.
    (a -> b -> c) -> FSSimT m a -> FSSimT m b -> FSSimT m c)
-> (forall a b. FSSimT m a -> FSSimT m b -> FSSimT m b)
-> (forall a b. FSSimT m a -> FSSimT m b -> FSSimT m a)
-> Applicative (FSSimT m)
forall a. a -> FSSimT m a
forall a b. FSSimT m a -> FSSimT m b -> FSSimT m a
forall a b. FSSimT m a -> FSSimT m b -> FSSimT m b
forall a b. FSSimT m (a -> b) -> FSSimT m a -> FSSimT m b
forall a b c.
(a -> b -> c) -> FSSimT m a -> FSSimT m b -> FSSimT m c
forall (m :: * -> *). Monad m => Functor (FSSimT m)
forall (m :: * -> *) a. Monad m => a -> FSSimT m a
forall (m :: * -> *) a b.
Monad m =>
FSSimT m a -> FSSimT m b -> FSSimT m a
forall (m :: * -> *) a b.
Monad m =>
FSSimT m a -> FSSimT m b -> FSSimT m b
forall (m :: * -> *) a b.
Monad m =>
FSSimT m (a -> b) -> FSSimT m a -> FSSimT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> FSSimT m a -> FSSimT m b -> FSSimT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> FSSimT m a
pure :: forall a. a -> FSSimT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
FSSimT m (a -> b) -> FSSimT m a -> FSSimT m b
<*> :: forall a b. FSSimT m (a -> b) -> FSSimT m a -> FSSimT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> FSSimT m a -> FSSimT m b -> FSSimT m c
liftA2 :: forall a b c.
(a -> b -> c) -> FSSimT m a -> FSSimT m b -> FSSimT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
FSSimT m a -> FSSimT m b -> FSSimT m b
*> :: forall a b. FSSimT m a -> FSSimT m b -> FSSimT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
FSSimT m a -> FSSimT m b -> FSSimT m a
<* :: forall a b. FSSimT m a -> FSSimT m b -> FSSimT m a
Applicative, Applicative (FSSimT m)
Applicative (FSSimT m) =>
(forall a b. FSSimT m a -> (a -> FSSimT m b) -> FSSimT m b)
-> (forall a b. FSSimT m a -> FSSimT m b -> FSSimT m b)
-> (forall a. a -> FSSimT m a)
-> Monad (FSSimT m)
forall a. a -> FSSimT m a
forall a b. FSSimT m a -> FSSimT m b -> FSSimT m b
forall a b. FSSimT m a -> (a -> FSSimT m b) -> FSSimT m b
forall (m :: * -> *). Monad m => Applicative (FSSimT m)
forall (m :: * -> *) a. Monad m => a -> FSSimT m a
forall (m :: * -> *) a b.
Monad m =>
FSSimT m a -> FSSimT m b -> FSSimT m b
forall (m :: * -> *) a b.
Monad m =>
FSSimT m a -> (a -> FSSimT m b) -> FSSimT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
FSSimT m a -> (a -> FSSimT m b) -> FSSimT m b
>>= :: forall a b. FSSimT m a -> (a -> FSSimT m b) -> FSSimT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
FSSimT m a -> FSSimT m b -> FSSimT m b
>> :: forall a b. FSSimT m a -> FSSimT m b -> FSSimT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> FSSimT m a
return :: forall a. a -> FSSimT m a
Monad
                   , MonadState MockFS, MonadError FsError, Monad (FSSimT m)
Monad (FSSimT m) =>
(forall a.
 (State# (PrimState (FSSimT m))
  -> (# State# (PrimState (FSSimT m)), a #))
 -> FSSimT m a)
-> PrimMonad (FSSimT m)
forall a.
(State# (PrimState (FSSimT m))
 -> (# State# (PrimState (FSSimT m)), a #))
-> FSSimT m a
forall (m :: * -> *).
Monad m =>
(forall a.
 (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> PrimMonad m
forall (m :: * -> *). PrimMonad m => Monad (FSSimT m)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState (FSSimT m))
 -> (# State# (PrimState (FSSimT m)), a #))
-> FSSimT m a
$cprimitive :: forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState (FSSimT m))
 -> (# State# (PrimState (FSSimT m)), a #))
-> FSSimT m a
primitive :: forall a.
(State# (PrimState (FSSimT m))
 -> (# State# (PrimState (FSSimT m)), a #))
-> FSSimT m a
PrimMonad )

runFSSimT :: FSSimT m a -> MockFS -> m (Either FsError (a, MockFS))
runFSSimT :: forall (m :: * -> *) a.
FSSimT m a -> MockFS -> m (Either FsError (a, MockFS))
runFSSimT FSSimT m a
act !MockFS
st = ExceptT FsError m (a, MockFS) -> m (Either FsError (a, MockFS))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT FsError m (a, MockFS) -> m (Either FsError (a, MockFS)))
-> ExceptT FsError m (a, MockFS) -> m (Either FsError (a, MockFS))
forall a b. (a -> b) -> a -> b
$ (StateT MockFS (ExceptT FsError m) a
 -> MockFS -> ExceptT FsError m (a, MockFS))
-> MockFS
-> StateT MockFS (ExceptT FsError m) a
-> ExceptT FsError m (a, MockFS)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT MockFS (ExceptT FsError m) a
-> MockFS -> ExceptT FsError m (a, MockFS)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT MockFS
st (StateT MockFS (ExceptT FsError m) a
 -> ExceptT FsError m (a, MockFS))
-> StateT MockFS (ExceptT FsError m) a
-> ExceptT FsError m (a, MockFS)
forall a b. (a -> b) -> a -> b
$ FSSimT m a -> StateT MockFS (ExceptT FsError m) a
forall (m :: * -> *) a.
FSSimT m a -> StateT MockFS (ExceptT FsError m) a
unFSSimT FSSimT m a
act

-- | Mocked, monad transformer-based implementation of the 'HasFS' interface.
--
-- This implementation is pure when running in a monad @m@ that is
-- 'Control.Monad.ST.ST'.
--
-- This implementation runs in a primitive monad @m@ extended with an 'FSSimT'
-- monad transformer. It is recommended to use 'System.FS.Sim.STM.simHasFS' or
-- 'System.FS.Sim.Error.simErrorHasFS' instead because they hide the monad
-- transformer. The caveat is that @m@ should be IO-like.
primHasMockFS :: PrimMonad m => HasFS (FSSimT m) Mock.HandleMock
-- An alternative design could have fixed this implementation to
-- 'Control.Monad.ST.ST', and used 'Control.Monad.Class.MonadST.stToIO' to
-- convert between a pure and 'IO' version. However, it's simpler to just
-- overload this function.
primHasMockFS :: forall (m :: * -> *). PrimMonad m => HasFS (FSSimT m) HandleMock
primHasMockFS = HasFS {
      dumpState :: FSSimT m String
dumpState                = FSSimT m String
forall (m :: * -> *). CanSimFS m => m String
Mock.dumpState
    , hOpen :: HasCallStack => FsPath -> OpenMode -> FSSimT m (Handle HandleMock)
hOpen                    = HasCallStack => FsPath -> OpenMode -> FSSimT m (Handle HandleMock)
FsPath -> OpenMode -> FSSimT m (Handle HandleMock)
forall (m :: * -> *).
CanSimFS m =>
FsPath -> OpenMode -> m (Handle HandleMock)
Mock.hOpen
    , hClose :: HasCallStack => Handle HandleMock -> FSSimT m ()
hClose                   = HasCallStack => Handle HandleMock -> FSSimT m ()
Handle HandleMock -> FSSimT m ()
forall (m :: * -> *). CanSimFS m => Handle HandleMock -> m ()
Mock.hClose
    , hIsOpen :: HasCallStack => Handle HandleMock -> FSSimT m Bool
hIsOpen                  = HasCallStack => Handle HandleMock -> FSSimT m Bool
Handle HandleMock -> FSSimT m Bool
forall (m :: * -> *). CanSimFS m => Handle HandleMock -> m Bool
Mock.hIsOpen
    , hSeek :: HasCallStack =>
Handle HandleMock -> SeekMode -> Int64 -> FSSimT m ()
hSeek                    = HasCallStack =>
Handle HandleMock -> SeekMode -> Int64 -> FSSimT m ()
Handle HandleMock -> SeekMode -> Int64 -> FSSimT m ()
forall (m :: * -> *).
CanSimFS m =>
Handle HandleMock -> SeekMode -> Int64 -> m ()
Mock.hSeek
    , hGetSome :: HasCallStack => Handle HandleMock -> Word64 -> FSSimT m ByteString
hGetSome                 = HasCallStack => Handle HandleMock -> Word64 -> FSSimT m ByteString
Handle HandleMock -> Word64 -> FSSimT m ByteString
forall (m :: * -> *).
CanSimFS m =>
Handle HandleMock -> Word64 -> m ByteString
Mock.hGetSome
    , hGetSomeAt :: HasCallStack =>
Handle HandleMock -> Word64 -> AbsOffset -> FSSimT m ByteString
hGetSomeAt               = HasCallStack =>
Handle HandleMock -> Word64 -> AbsOffset -> FSSimT m ByteString
Handle HandleMock -> Word64 -> AbsOffset -> FSSimT m ByteString
forall (m :: * -> *).
CanSimFS m =>
Handle HandleMock -> Word64 -> AbsOffset -> m ByteString
Mock.hGetSomeAt
    , hPutSome :: HasCallStack => Handle HandleMock -> ByteString -> FSSimT m Word64
hPutSome                 = HasCallStack => Handle HandleMock -> ByteString -> FSSimT m Word64
Handle HandleMock -> ByteString -> FSSimT m Word64
forall (m :: * -> *).
CanSimFS m =>
Handle HandleMock -> ByteString -> m Word64
Mock.hPutSome
    , hTruncate :: HasCallStack => Handle HandleMock -> Word64 -> FSSimT m ()
hTruncate                = HasCallStack => Handle HandleMock -> Word64 -> FSSimT m ()
Handle HandleMock -> Word64 -> FSSimT m ()
forall (m :: * -> *).
CanSimFS m =>
Handle HandleMock -> Word64 -> m ()
Mock.hTruncate
    , hGetSize :: HasCallStack => Handle HandleMock -> FSSimT m Word64
hGetSize                 = HasCallStack => Handle HandleMock -> FSSimT m Word64
Handle HandleMock -> FSSimT m Word64
forall (m :: * -> *). CanSimFS m => Handle HandleMock -> m Word64
Mock.hGetSize
    , createDirectory :: HasCallStack => FsPath -> FSSimT m ()
createDirectory          = HasCallStack => FsPath -> FSSimT m ()
FsPath -> FSSimT m ()
forall (m :: * -> *). CanSimFS m => FsPath -> m ()
Mock.createDirectory
    , createDirectoryIfMissing :: HasCallStack => Bool -> FsPath -> FSSimT m ()
createDirectoryIfMissing = HasCallStack => Bool -> FsPath -> FSSimT m ()
Bool -> FsPath -> FSSimT m ()
forall (m :: * -> *). CanSimFS m => Bool -> FsPath -> m ()
Mock.createDirectoryIfMissing
    , listDirectory :: HasCallStack => FsPath -> FSSimT m (Set String)
listDirectory            = HasCallStack => FsPath -> FSSimT m (Set String)
FsPath -> FSSimT m (Set String)
forall (m :: * -> *). CanSimFS m => FsPath -> m (Set String)
Mock.listDirectory
    , doesDirectoryExist :: HasCallStack => FsPath -> FSSimT m Bool
doesDirectoryExist       = HasCallStack => FsPath -> FSSimT m Bool
FsPath -> FSSimT m Bool
forall (m :: * -> *). CanSimFS m => FsPath -> m Bool
Mock.doesDirectoryExist
    , doesFileExist :: HasCallStack => FsPath -> FSSimT m Bool
doesFileExist            = HasCallStack => FsPath -> FSSimT m Bool
FsPath -> FSSimT m Bool
forall (m :: * -> *). CanSimFS m => FsPath -> m Bool
Mock.doesFileExist
    , removeDirectoryRecursive :: HasCallStack => FsPath -> FSSimT m ()
removeDirectoryRecursive = HasCallStack => FsPath -> FSSimT m ()
FsPath -> FSSimT m ()
forall (m :: * -> *). CanSimFS m => FsPath -> m ()
Mock.removeDirectoryRecursive
    , removeFile :: HasCallStack => FsPath -> FSSimT m ()
removeFile               = HasCallStack => FsPath -> FSSimT m ()
FsPath -> FSSimT m ()
forall (m :: * -> *). CanSimFS m => FsPath -> m ()
Mock.removeFile
    , renameFile :: HasCallStack => FsPath -> FsPath -> FSSimT m ()
renameFile               = HasCallStack => FsPath -> FsPath -> FSSimT m ()
FsPath -> FsPath -> FSSimT m ()
forall (m :: * -> *). CanSimFS m => FsPath -> FsPath -> m ()
Mock.renameFile
    , mkFsErrorPath :: FsPath -> FsErrorPath
mkFsErrorPath            = FsPath -> FsErrorPath
fsToFsErrorPathUnmounted
    , unsafeToFilePath :: FsPath -> FSSimT m String
unsafeToFilePath         = \FsPath
_ -> String -> FSSimT m String
forall a. HasCallStack => String -> a
error String
"pureHasFS:unsafeToFilePath"
      -- File I\/O with user-supplied buffers
    , hGetBufSome :: HasCallStack =>
Handle HandleMock
-> MutableByteArray (PrimState (FSSimT m))
-> BufferOffset
-> ByteCount
-> FSSimT m ByteCount
hGetBufSome              = HasCallStack =>
Handle HandleMock
-> MutableByteArray (PrimState (FSSimT 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 (FSSimT m))
-> BufferOffset
-> ByteCount
-> AbsOffset
-> FSSimT m ByteCount
hGetBufSomeAt            = HasCallStack =>
Handle HandleMock
-> MutableByteArray (PrimState (FSSimT 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 (FSSimT m))
-> BufferOffset
-> ByteCount
-> FSSimT m ByteCount
hPutBufSome              = HasCallStack =>
Handle HandleMock
-> MutableByteArray (PrimState (FSSimT 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 (FSSimT m))
-> BufferOffset
-> ByteCount
-> AbsOffset
-> FSSimT m ByteCount
hPutBufSomeAt            = HasCallStack =>
Handle HandleMock
-> MutableByteArray (PrimState (FSSimT 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
    }