{-# 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 forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"9P2000" String
s then NineVersion
Ver9P2000 else NineVersion
VerUnknown
data Config m = Config {
forall (m :: * -> *). Config m -> NineFile m
root :: NineFile m,
forall (m :: * -> *). Config m -> String
addr :: String,
forall (m :: * -> *). Config m -> Content m
monadState :: Content m
}
data NineState m = NineState {
forall (m :: * -> *). NineState m -> Map Word32 (NineFile m)
fidMap :: Map Word32 (NineFile m),
forall (m :: * -> *). NineState m -> Map Word16 (IO ())
flushMap :: Map Word16 (IO ()),
forall (m :: * -> *). NineState m -> Word32
msize :: Word32,
forall (m :: * -> *). NineState m -> NineVersion
protoVersion :: NineVersion,
forall (m :: * -> *). NineState m -> Content m
mState :: Content m
}
emptyState :: Content m -> NineState m
emptyState Content m
m = NineState {
fidMap :: Map Word32 (NineFile m)
fidMap = forall k a. Map k a
M.empty :: Map Word32 (NineFile m),
flushMap :: Map Word16 (IO ())
flushMap = 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 :: forall e a. Exception e => e -> MState s m a
throwM e
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ 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 :: forall e a.
Exception e =>
MState s m a -> (e -> MState s m a) -> MState s m a
catch = 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 :: forall (m :: * -> *) a.
EmbedIO m =>
Word16 -> m a -> MState (NineState m) (ReaderT (Config m) IO) a
call Word16
tag m a
x = do
Content m
s <- (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). NineState m -> Content m
mState) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *). MonadState s m => m s
get
Async a
thread <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$ forall (o :: * -> *) a. EmbedIO o => o a -> Content o -> IO a
callback m a
x Content m
s
forall a (m :: * -> *). Word16 -> Async a -> Nine m ()
flushable Word16
tag Async a
thread
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. Async a -> IO a
wait Async a
thread
lookup :: Word32 -> Nine m (NineFile m)
lookup :: forall (m :: * -> *). Word32 -> Nine m (NineFile m)
lookup Word32
fid = do
Map Word32 (NineFile m)
m <- (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). NineState m -> Map Word32 (NineFile m)
fidMap) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *). MonadState s m => m s
get
case 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 -> forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ Word32 -> NineError
ENoFid Word32
fid
Just NineFile m
f -> forall (m :: * -> *) a. Monad m => a -> m a
return NineFile m
f
insert :: Word32 -> NineFile m -> Nine m ()
insert :: forall (m :: * -> *). Word32 -> NineFile m -> Nine m ()
insert Word32
fid NineFile m
f = do
Map Word32 (NineFile m)
m <- (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). NineState m -> Map Word32 (NineFile m)
fidMap) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *). MonadState s m => m s
get
forall (m :: * -> *) t. MonadIO m => (t -> t) -> MState t m ()
modifyM_ (\NineState m
s -> NineState m
s { fidMap :: Map Word32 (NineFile m)
fidMap = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Word32
fid NineFile m
f forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). NineState m -> Map Word32 (NineFile m)
fidMap NineState m
s })
delete :: Word32 -> Nine m ()
delete :: forall (m :: * -> *). Word32 -> Nine m ()
delete Word32
fid = do
forall (m :: * -> *) t. MonadIO m => (t -> t) -> MState t m ()
modifyM_ (\NineState m
s -> NineState m
s { fidMap :: Map Word32 (NineFile m)
fidMap = forall k a. Ord k => k -> Map k a -> Map k a
M.delete Word32
fid forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). NineState m -> Map Word32 (NineFile m)
fidMap NineState m
s })
iounit :: Nine m Word32
iounit :: forall (m :: * -> *). Nine m Word32
iounit = do
Word32
ms <- (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). NineState m -> Word32
msize) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *). MonadState s m => m s
get
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word32
ms forall a. Num a => a -> a -> a
- Word32
24
flushable :: Word16 -> Async a -> Nine m ()
flushable :: forall a (m :: * -> *). Word16 -> Async a -> Nine m ()
flushable Word16
tag Async a
thread = forall (m :: * -> *) t. MonadIO m => (t -> t) -> MState t m ()
modifyM_ (\NineState m
s -> NineState m
s { flushMap :: Map Word16 (IO ())
flushMap = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Word16
tag (forall a. Async a -> IO ()
cancel Async a
thread) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). NineState m -> Map Word16 (IO ())
flushMap NineState m
s })
flush :: Word16 -> Nine m ()
flush :: forall (m :: * -> *). Word16 -> Nine m ()
flush Word16
tag = do
Map Word16 (IO ())
m <- (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). NineState m -> Map Word16 (IO ())
flushMap) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *). MonadState s m => m s
get
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Word16
tag Map Word16 (IO ())
m of
Maybe (IO ())
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just IO ()
handler -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO ()
handler