{-# LANGUAGE FlexibleContexts #-}
module Network.NineP.Internal.State
( Nine
, NineVersion(..)
, readVersion
, Config(..)
, NineState(..)
, emptyState
, lookup
, insert
, delete
, iounit
, call
) where
import Control.Concurrent.Async
import Control.Concurrent.MState
import Control.Exception (throw)
import Control.Exception.Peel as P
import Control.Monad.Catch
import Control.Monad.EmbedIO
import Control.Monad.IO.Peel
import Control.Monad.Reader
import Control.Monad.State.Class
import Data.List (isPrefixOf)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Word
import Prelude hiding (lookup)
import Network.NineP.Error
import Network.NineP.Internal.File
data NineVersion = VerUnknown | Ver9P2000
instance Show NineVersion where
show :: NineVersion -> String
show NineVersion
VerUnknown = String
"unknown"
show NineVersion
Ver9P2000 = String
"9P2000"
readVersion :: String -> NineVersion
readVersion :: String -> NineVersion
readVersion String
s = if String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"9P2000" String
s then NineVersion
Ver9P2000 else NineVersion
VerUnknown
data Config m = Config {
Config m -> NineFile m
root :: NineFile m,
Config m -> String
addr :: String,
Config m -> Content m
monadState :: Content m
}
data NineState m = NineState {
NineState m -> Map Word32 (NineFile m)
fidMap :: Map Word32 (NineFile m),
NineState m -> Map Word16 (IO ())
flushMap :: Map Word16 (IO ()),
NineState m -> Word32
msize :: Word32,
NineState m -> NineVersion
protoVersion :: NineVersion,
NineState m -> Content m
mState :: Content m
}
emptyState :: Content m -> NineState m
emptyState Content m
m = NineState :: forall (m :: * -> *).
Map Word32 (NineFile m)
-> Map Word16 (IO ())
-> Word32
-> NineVersion
-> Content m
-> NineState m
NineState {
fidMap :: Map Word32 (NineFile m)
fidMap = forall k a. Map k a
forall (m :: * -> *). Map Word32 (NineFile m)
M.empty :: Map Word32 (NineFile m),
flushMap :: Map Word16 (IO ())
flushMap = Map Word16 (IO ())
forall k a. Map k a
M.empty :: Map Word16 (IO ()),
msize :: Word32
msize = Word32
0,
protoVersion :: NineVersion
protoVersion = NineVersion
VerUnknown,
mState :: Content m
mState = Content m
m
}
type Nine m x = MState (NineState m) (ReaderT (Config m) IO) x
instance MonadThrow m => MonadThrow (MState s m) where
throwM :: e -> MState s m a
throwM e
e = m a -> MState s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> MState s m a) -> m a -> MState s m a
forall a b. (a -> b) -> a -> b
$ e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM e
e
instance (MonadCatch m, MonadPeelIO m) => MonadCatch (MState s m) where
catch :: MState s m a -> (e -> MState s m a) -> MState s m a
catch = MState s m a -> (e -> MState s m a) -> MState s m a
forall (m :: * -> *) e a.
(MonadPeelIO m, Exception e) =>
m a -> (e -> m a) -> m a
P.catch
call :: (EmbedIO m) => Word16 -> m a -> MState (NineState m) (ReaderT (Config m) IO) a
call :: Word16 -> m a -> MState (NineState m) (ReaderT (Config m) IO) a
call Word16
tag m a
x = do
Content m
s <- (Content m
-> MState (NineState m) (ReaderT (Config m) IO) (Content m)
forall (m :: * -> *) a. Monad m => a -> m a
return (Content m
-> MState (NineState m) (ReaderT (Config m) IO) (Content m))
-> (NineState m -> Content m)
-> NineState m
-> MState (NineState m) (ReaderT (Config m) IO) (Content m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NineState m -> Content m
forall (m :: * -> *). NineState m -> Content m
mState) (NineState m
-> MState (NineState m) (ReaderT (Config m) IO) (Content m))
-> MState (NineState m) (ReaderT (Config m) IO) (NineState m)
-> MState (NineState m) (ReaderT (Config m) IO) (Content m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MState (NineState m) (ReaderT (Config m) IO) (NineState m)
forall s (m :: * -> *). MonadState s m => m s
get
Async a
thread <- IO (Async a)
-> MState (NineState m) (ReaderT (Config m) IO) (Async a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async a)
-> MState (NineState m) (ReaderT (Config m) IO) (Async a))
-> IO (Async a)
-> MState (NineState m) (ReaderT (Config m) IO) (Async a)
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Async a)
forall a. IO a -> IO (Async a)
async (IO a -> IO (Async a)) -> IO a -> IO (Async a)
forall a b. (a -> b) -> a -> b
$ m a -> Content m -> IO a
forall (o :: * -> *) a. EmbedIO o => o a -> Content o -> IO a
callback m a
x Content m
s
Word16 -> Async a -> Nine m ()
forall a (m :: * -> *). Word16 -> Async a -> Nine m ()
flushable Word16
tag Async a
thread
ReaderT (Config m) IO a
-> MState (NineState m) (ReaderT (Config m) IO) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Config m) IO a
-> MState (NineState m) (ReaderT (Config m) IO) a)
-> ReaderT (Config m) IO a
-> MState (NineState m) (ReaderT (Config m) IO) a
forall a b. (a -> b) -> a -> b
$ IO a -> ReaderT (Config m) IO a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> ReaderT (Config m) IO a)
-> IO a -> ReaderT (Config m) IO a
forall a b. (a -> b) -> a -> b
$ Async a -> IO a
forall a. Async a -> IO a
wait Async a
thread
lookup :: Word32 -> Nine m (NineFile m)
lookup :: Word32 -> Nine m (NineFile m)
lookup Word32
fid = do
Map Word32 (NineFile m)
m <- (Map Word32 (NineFile m)
-> MState
(NineState m) (ReaderT (Config m) IO) (Map Word32 (NineFile m))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Word32 (NineFile m)
-> MState
(NineState m) (ReaderT (Config m) IO) (Map Word32 (NineFile m)))
-> (NineState m -> Map Word32 (NineFile m))
-> NineState m
-> MState
(NineState m) (ReaderT (Config m) IO) (Map Word32 (NineFile m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NineState m -> Map Word32 (NineFile m)
forall (m :: * -> *). NineState m -> Map Word32 (NineFile m)
fidMap) (NineState m
-> MState
(NineState m) (ReaderT (Config m) IO) (Map Word32 (NineFile m)))
-> MState (NineState m) (ReaderT (Config m) IO) (NineState m)
-> MState
(NineState m) (ReaderT (Config m) IO) (Map Word32 (NineFile m))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MState (NineState m) (ReaderT (Config m) IO) (NineState m)
forall s (m :: * -> *). MonadState s m => m s
get
case Word32 -> Map Word32 (NineFile m) -> Maybe (NineFile m)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Word32
fid Map Word32 (NineFile m)
m of
Maybe (NineFile m)
Nothing -> NineError -> Nine m (NineFile m)
forall a e. Exception e => e -> a
throw (NineError -> Nine m (NineFile m))
-> NineError -> Nine m (NineFile m)
forall a b. (a -> b) -> a -> b
$ Word32 -> NineError
ENoFid Word32
fid
Just NineFile m
f -> NineFile m -> Nine m (NineFile m)
forall (m :: * -> *) a. Monad m => a -> m a
return NineFile m
f
insert :: Word32 -> NineFile m -> Nine m ()
insert :: Word32 -> NineFile m -> Nine m ()
insert Word32
fid NineFile m
f = do
Map Word32 (NineFile m)
m <- (Map Word32 (NineFile m)
-> MState
(NineState m) (ReaderT (Config m) IO) (Map Word32 (NineFile m))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Word32 (NineFile m)
-> MState
(NineState m) (ReaderT (Config m) IO) (Map Word32 (NineFile m)))
-> (NineState m -> Map Word32 (NineFile m))
-> NineState m
-> MState
(NineState m) (ReaderT (Config m) IO) (Map Word32 (NineFile m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NineState m -> Map Word32 (NineFile m)
forall (m :: * -> *). NineState m -> Map Word32 (NineFile m)
fidMap) (NineState m
-> MState
(NineState m) (ReaderT (Config m) IO) (Map Word32 (NineFile m)))
-> MState (NineState m) (ReaderT (Config m) IO) (NineState m)
-> MState
(NineState m) (ReaderT (Config m) IO) (Map Word32 (NineFile m))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MState (NineState m) (ReaderT (Config m) IO) (NineState m)
forall s (m :: * -> *). MonadState s m => m s
get
(NineState m -> NineState m) -> Nine m ()
forall (m :: * -> *) t. MonadIO m => (t -> t) -> MState t m ()
modifyM_ (\NineState m
s -> NineState m
s { fidMap :: Map Word32 (NineFile m)
fidMap = Word32
-> NineFile m -> Map Word32 (NineFile m) -> Map Word32 (NineFile m)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Word32
fid NineFile m
f (Map Word32 (NineFile m) -> Map Word32 (NineFile m))
-> Map Word32 (NineFile m) -> Map Word32 (NineFile m)
forall a b. (a -> b) -> a -> b
$ NineState m -> Map Word32 (NineFile m)
forall (m :: * -> *). NineState m -> Map Word32 (NineFile m)
fidMap NineState m
s })
delete :: Word32 -> Nine m ()
delete :: Word32 -> Nine m ()
delete Word32
fid = do
(NineState m -> NineState m) -> Nine m ()
forall (m :: * -> *) t. MonadIO m => (t -> t) -> MState t m ()
modifyM_ (\NineState m
s -> NineState m
s { fidMap :: Map Word32 (NineFile m)
fidMap = Word32 -> Map Word32 (NineFile m) -> Map Word32 (NineFile m)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Word32
fid (Map Word32 (NineFile m) -> Map Word32 (NineFile m))
-> Map Word32 (NineFile m) -> Map Word32 (NineFile m)
forall a b. (a -> b) -> a -> b
$ NineState m -> Map Word32 (NineFile m)
forall (m :: * -> *). NineState m -> Map Word32 (NineFile m)
fidMap NineState m
s })
iounit :: Nine m Word32
iounit :: Nine m Word32
iounit = do
Word32
ms <- (Word32 -> Nine m Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Nine m Word32)
-> (NineState m -> Word32) -> NineState m -> Nine m Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NineState m -> Word32
forall (m :: * -> *). NineState m -> Word32
msize) (NineState m -> Nine m Word32)
-> MState (NineState m) (ReaderT (Config m) IO) (NineState m)
-> Nine m Word32
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MState (NineState m) (ReaderT (Config m) IO) (NineState m)
forall s (m :: * -> *). MonadState s m => m s
get
Word32 -> Nine m Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Nine m Word32) -> Word32 -> Nine m Word32
forall a b. (a -> b) -> a -> b
$ Word32
ms Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
24
flushable :: Word16 -> Async a -> Nine m ()
flushable :: Word16 -> Async a -> Nine m ()
flushable Word16
tag Async a
thread = (NineState m -> NineState m) -> Nine m ()
forall (m :: * -> *) t. MonadIO m => (t -> t) -> MState t m ()
modifyM_ (\NineState m
s -> NineState m
s { flushMap :: Map Word16 (IO ())
flushMap = Word16 -> IO () -> Map Word16 (IO ()) -> Map Word16 (IO ())
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Word16
tag (Async a -> IO ()
forall a. Async a -> IO ()
cancel Async a
thread) (Map Word16 (IO ()) -> Map Word16 (IO ()))
-> Map Word16 (IO ()) -> Map Word16 (IO ())
forall a b. (a -> b) -> a -> b
$ NineState m -> Map Word16 (IO ())
forall (m :: * -> *). NineState m -> Map Word16 (IO ())
flushMap NineState m
s })
flush :: Word16 -> Nine m ()
flush :: Word16 -> Nine m ()
flush Word16
tag = do
Map Word16 (IO ())
m <- (Map Word16 (IO ())
-> MState
(NineState m) (ReaderT (Config m) IO) (Map Word16 (IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Word16 (IO ())
-> MState
(NineState m) (ReaderT (Config m) IO) (Map Word16 (IO ())))
-> (NineState m -> Map Word16 (IO ()))
-> NineState m
-> MState
(NineState m) (ReaderT (Config m) IO) (Map Word16 (IO ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NineState m -> Map Word16 (IO ())
forall (m :: * -> *). NineState m -> Map Word16 (IO ())
flushMap) (NineState m
-> MState
(NineState m) (ReaderT (Config m) IO) (Map Word16 (IO ())))
-> MState (NineState m) (ReaderT (Config m) IO) (NineState m)
-> MState
(NineState m) (ReaderT (Config m) IO) (Map Word16 (IO ()))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MState (NineState m) (ReaderT (Config m) IO) (NineState m)
forall s (m :: * -> *). MonadState s m => m s
get
case Word16 -> Map Word16 (IO ()) -> Maybe (IO ())
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Word16
tag Map Word16 (IO ())
m of
Maybe (IO ())
Nothing -> () -> Nine m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just IO ()
handler -> ReaderT (Config m) IO () -> Nine m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Config m) IO () -> Nine m ())
-> ReaderT (Config m) IO () -> Nine m ()
forall a b. (a -> b) -> a -> b
$ IO () -> ReaderT (Config m) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO ()
handler