{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, OverloadedStrings #-}
module Network.NineP.File
( isDir
, simpleFile
, simpleFileBy
, simpleDirectory
, rwFile
, memoryFile
, memoryDirectory
) where
import Control.Concurrent.Chan
import Control.Exception
import Control.Monad
import Control.Monad.EmbedIO
import Control.Monad.Trans
import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Bits
import Data.Convertible.Base
import Data.IORef
import Data.StateRef
import Data.Word
import Prelude hiding (read)
import Network.NineP.Error
import Network.NineP.Internal.File
isDir :: Word32
-> Bool
isDir :: Word32 -> Bool
isDir Word32
perms = Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word32
perms Int
31
simpleRead :: (Monad m, EmbedIO m) => m ByteString -> Word64 -> Word32 -> m ByteString
simpleRead :: m ByteString -> Word64 -> Word32 -> m ByteString
simpleRead m ByteString
get Word64
offset Word32
count = do
ByteString
r <- m ByteString
get
(ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString)
-> (ByteString -> ByteString) -> ByteString -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString -> ByteString
B.take (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
count) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString -> ByteString
B.drop (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
offset)) ByteString
r
simpleWrite :: (Monad m, EmbedIO m) => (ByteString -> m ()) -> Word64 -> ByteString -> m Word32
simpleWrite :: (ByteString -> m ()) -> Word64 -> ByteString -> m Word32
simpleWrite ByteString -> m ()
put Word64
offset ByteString
d = case Word64
offset of
Word64
_ -> do
()
r <- ByteString -> m ()
put ByteString
d
(m Word32 -> () -> m Word32
forall a b. a -> b -> a
const (m Word32 -> () -> m Word32) -> m Word32 -> () -> m Word32
forall a b. (a -> b) -> a -> b
$ Word32 -> m Word32
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> m Word32) -> Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word32) -> Int64 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length ByteString
d) ()
r
rwFile :: forall m. (EmbedIO m)
=> String
-> Maybe (m ByteString)
-> Maybe (ByteString -> m ())
-> NineFile m
rwFile :: String
-> Maybe (m ByteString) -> Maybe (ByteString -> m ()) -> NineFile m
rwFile String
name Maybe (m ByteString)
rc Maybe (ByteString -> m ())
wc = String
-> (m ByteString, ByteString -> m ())
-> (ByteString -> ByteString, ByteString -> ByteString)
-> NineFile m
forall a b (m :: * -> *).
(Monad m, EmbedIO m) =>
String
-> (m a, b -> m ())
-> (a -> ByteString, ByteString -> b)
-> NineFile m
simpleFileBy String
name (m ByteString
-> (m ByteString -> m ByteString)
-> Maybe (m ByteString)
-> m ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((m ByteString, ByteString -> m ()) -> m ByteString
forall a b. (a, b) -> a
fst (m ByteString, ByteString -> m ())
forall (m :: * -> *) a. MonadIO m => (m a, a -> m ())
nulls) m ByteString -> m ByteString
forall a. a -> a
id Maybe (m ByteString)
rc, (ByteString -> m ())
-> ((ByteString -> m ()) -> ByteString -> m ())
-> Maybe (ByteString -> m ())
-> ByteString
-> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((m ByteString, ByteString -> m ()) -> ByteString -> m ()
forall a b. (a, b) -> b
snd (m ByteString, ByteString -> m ())
forall (m :: * -> *) a. MonadIO m => (m a, a -> m ())
nulls) (ByteString -> m ()) -> ByteString -> m ()
forall a. a -> a
id Maybe (ByteString -> m ())
wc) (ByteString -> ByteString
forall a. a -> a
id, ByteString -> ByteString
forall a. a -> a
id)
nulls :: MonadIO m => (m a, a -> m ())
nulls :: (m a, a -> m ())
nulls = (ArithException -> m a
forall a e. Exception e => e -> a
throw (ArithException -> m a) -> ArithException -> m a
forall a b. (a -> b) -> a -> b
$ ArithException
Underflow, m () -> a -> m ()
forall a b. a -> b -> a
const (m () -> a -> m ()) -> m () -> a -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
simpleFile :: forall a b m rr wr. (Monad m, EmbedIO m, ReadRef rr m a, Convertible a ByteString, WriteRef wr m b, Convertible ByteString b)
=> String
-> rr
-> wr
-> NineFile m
simpleFile :: String -> rr -> wr -> NineFile m
simpleFile String
name rr
rr wr
wr = String
-> (m a, b -> m ())
-> (a -> ByteString, ByteString -> b)
-> NineFile m
forall a b (m :: * -> *).
(Monad m, EmbedIO m) =>
String
-> (m a, b -> m ())
-> (a -> ByteString, ByteString -> b)
-> NineFile m
simpleFileBy String
name (rr -> m a
forall sr (m :: * -> *) a. ReadRef sr m a => sr -> m a
readReference rr
rr, wr -> b -> m ()
forall sr (m :: * -> *) a. WriteRef sr m a => sr -> a -> m ()
writeReference wr
wr) (a -> ByteString
forall a b. Convertible a b => a -> b
convert, ByteString -> b
forall a b. Convertible a b => a -> b
convert)
simpleFileBy :: forall a b m. (Monad m, EmbedIO m)
=> String
-> (m a, b -> m ())
-> (a -> ByteString, ByteString -> b)
-> NineFile m
simpleFileBy :: String
-> (m a, b -> m ())
-> (a -> ByteString, ByteString -> b)
-> NineFile m
simpleFileBy String
name (m a
rd, b -> m ()
wr) (a -> ByteString
rdc, ByteString -> b
wrc) = (String -> NineFile m
forall (m :: * -> *). (Monad m, EmbedIO m) => String -> NineFile m
boringFile String
name :: NineFile m) {
read :: Word64 -> Word32 -> m ByteString
read = m ByteString -> Word64 -> Word32 -> m ByteString
forall (m :: * -> *).
(Monad m, EmbedIO m) =>
m ByteString -> Word64 -> Word32 -> m ByteString
simpleRead (m ByteString -> Word64 -> Word32 -> m ByteString)
-> m ByteString -> Word64 -> Word32 -> m ByteString
forall a b. (a -> b) -> a -> b
$ (a -> ByteString) -> m a -> m ByteString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> ByteString
rdc (m a -> m ByteString) -> m a -> m ByteString
forall a b. (a -> b) -> a -> b
$ m a
rd,
write :: Word64 -> ByteString -> m Word32
write = (ByteString -> m ()) -> Word64 -> ByteString -> m Word32
forall (m :: * -> *).
(Monad m, EmbedIO m) =>
(ByteString -> m ()) -> Word64 -> ByteString -> m Word32
simpleWrite ((ByteString -> m ()) -> Word64 -> ByteString -> m Word32)
-> (ByteString -> m ()) -> Word64 -> ByteString -> m Word32
forall a b. (a -> b) -> a -> b
$ b -> m ()
wr (b -> m ()) -> (ByteString -> b) -> ByteString -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> b
wrc
}
memoryFile :: forall m. (Monad m, EmbedIO m)
=> String
-> IO (NineFile m)
memoryFile :: String -> IO (NineFile m)
memoryFile String
name = do
IORef ByteString
c <- ByteString -> IO (IORef ByteString)
forall a. a -> IO (IORef a)
newIORef ByteString
"" :: IO (IORef ByteString)
NineFile m -> IO (NineFile m)
forall (m :: * -> *) a. Monad m => a -> m a
return (NineFile m -> IO (NineFile m)) -> NineFile m -> IO (NineFile m)
forall a b. (a -> b) -> a -> b
$ String
-> (m ByteString, ByteString -> m ())
-> (ByteString -> ByteString, ByteString -> ByteString)
-> NineFile m
forall a b (m :: * -> *).
(Monad m, EmbedIO m) =>
String
-> (m a, b -> m ())
-> (a -> ByteString, ByteString -> b)
-> NineFile m
simpleFileBy String
name (
IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ IORef ByteString -> IO ByteString
forall a. IORef a -> IO a
readIORef IORef ByteString
c,
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (ByteString -> IO ()) -> ByteString -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef ByteString -> ByteString -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ByteString
c
) (ByteString -> ByteString
forall a. a -> a
id, ByteString -> ByteString
forall a. a -> a
id)
simpleDirectory :: forall m. (Monad m, EmbedIO m)
=> String
-> (String -> m (NineFile m))
-> (String -> m (NineFile m))
-> IO (NineFile m, IORef [(String, NineFile m)])
simpleDirectory :: String
-> (String -> m (NineFile m))
-> (String -> m (NineFile m))
-> IO (NineFile m, IORef [(String, NineFile m)])
simpleDirectory String
name String -> m (NineFile m)
newfile String -> m (NineFile m)
newdir = do
IORef [(String, NineFile m)]
files <- [(String, NineFile m)] -> IO (IORef [(String, NineFile m)])
forall a. a -> IO (IORef a)
newIORef [] :: IO (IORef [(String, NineFile m)])
(NineFile m, IORef [(String, NineFile m)])
-> IO (NineFile m, IORef [(String, NineFile m)])
forall (m :: * -> *) a. Monad m => a -> m a
return ((NineFile m, IORef [(String, NineFile m)])
-> IO (NineFile m, IORef [(String, NineFile m)]))
-> (NineFile m, IORef [(String, NineFile m)])
-> IO (NineFile m, IORef [(String, NineFile m)])
forall a b. (a -> b) -> a -> b
$ (\NineFile m
f -> (NineFile m
f, IORef [(String, NineFile m)]
files)) (NineFile m -> (NineFile m, IORef [(String, NineFile m)]))
-> NineFile m -> (NineFile m, IORef [(String, NineFile m)])
forall a b. (a -> b) -> a -> b
$ (String -> [(String, NineFile m)] -> NineFile m
forall (m :: * -> *).
(Monad m, EmbedIO m) =>
String -> [(String, NineFile m)] -> NineFile m
boringDir String
name [] :: NineFile m) {
create :: String -> Word32 -> m (NineFile m)
create = \String
name Word32
perms -> do
NineFile m
nf <- (if Word32 -> Bool
isDir Word32
perms then String -> m (NineFile m)
newdir else String -> m (NineFile m)
newfile) String
name
let nelem :: (String, NineFile m)
nelem = (String
name, NineFile m
nf)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef [(String, NineFile m)]
-> ([(String, NineFile m)] -> ([(String, NineFile m)], ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [(String, NineFile m)]
files (\[(String, NineFile m)]
l -> ((String, NineFile m)
nelem(String, NineFile m)
-> [(String, NineFile m)] -> [(String, NineFile m)]
forall a. a -> [a] -> [a]
:[(String, NineFile m)]
l, ()))
NineFile m -> m (NineFile m)
forall (m :: * -> *) a. Monad m => a -> m a
return NineFile m
nf,
getFiles :: m [NineFile m]
getFiles = IO [NineFile m] -> m [NineFile m]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [NineFile m] -> m [NineFile m])
-> IO [NineFile m] -> m [NineFile m]
forall a b. (a -> b) -> a -> b
$ ([(String, NineFile m)] -> [NineFile m])
-> IO [(String, NineFile m)] -> IO [NineFile m]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (((String, NineFile m) -> NineFile m)
-> [(String, NineFile m)] -> [NineFile m]
forall a b. (a -> b) -> [a] -> [b]
map (String, NineFile m) -> NineFile m
forall a b. (a, b) -> b
snd) (IO [(String, NineFile m)] -> IO [NineFile m])
-> IO [(String, NineFile m)] -> IO [NineFile m]
forall a b. (a -> b) -> a -> b
$ IORef [(String, NineFile m)] -> IO [(String, NineFile m)]
forall a. IORef a -> IO a
readIORef IORef [(String, NineFile m)]
files,
descend :: String -> m (NineFile m)
descend = \String
name -> do
[(String, NineFile m)]
d <- IO [(String, NineFile m)] -> m [(String, NineFile m)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(String, NineFile m)] -> m [(String, NineFile m)])
-> IO [(String, NineFile m)] -> m [(String, NineFile m)]
forall a b. (a -> b) -> a -> b
$ IORef [(String, NineFile m)] -> IO [(String, NineFile m)]
forall a. IORef a -> IO a
readIORef IORef [(String, NineFile m)]
files
m (NineFile m)
-> (NineFile m -> m (NineFile m))
-> Maybe (NineFile m)
-> m (NineFile m)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (NineError -> m (NineFile m)
forall a e. Exception e => e -> a
throw (NineError -> m (NineFile m)) -> NineError -> m (NineFile m)
forall a b. (a -> b) -> a -> b
$ String -> NineError
ENoFile String
name) (NineFile m -> m (NineFile m)
forall (m :: * -> *) a. Monad m => a -> m a
return) (Maybe (NineFile m) -> m (NineFile m))
-> Maybe (NineFile m) -> m (NineFile m)
forall a b. (a -> b) -> a -> b
$ String -> [(String, NineFile m)] -> Maybe (NineFile m)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [(String, NineFile m)]
d
}
memoryDirectory :: forall m. (Monad m, EmbedIO m)
=> String
-> IO (NineFile m)
memoryDirectory :: String -> IO (NineFile m)
memoryDirectory String
name = ((NineFile m, IORef [(String, NineFile m)]) -> NineFile m)
-> IO (NineFile m, IORef [(String, NineFile m)]) -> IO (NineFile m)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (NineFile m, IORef [(String, NineFile m)]) -> NineFile m
forall a b. (a, b) -> a
fst (IO (NineFile m, IORef [(String, NineFile m)]) -> IO (NineFile m))
-> IO (NineFile m, IORef [(String, NineFile m)]) -> IO (NineFile m)
forall a b. (a -> b) -> a -> b
$ String
-> (String -> m (NineFile m))
-> (String -> m (NineFile m))
-> IO (NineFile m, IORef [(String, NineFile m)])
forall (m :: * -> *).
(Monad m, EmbedIO m) =>
String
-> (String -> m (NineFile m))
-> (String -> m (NineFile m))
-> IO (NineFile m, IORef [(String, NineFile m)])
simpleDirectory String
name (IO (NineFile m) -> m (NineFile m)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (NineFile m) -> m (NineFile m))
-> (String -> IO (NineFile m)) -> String -> m (NineFile m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (NineFile m)
forall (m :: * -> *).
(Monad m, EmbedIO m) =>
String -> IO (NineFile m)
memoryFile) (IO (NineFile m) -> m (NineFile m)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (NineFile m) -> m (NineFile m))
-> (String -> IO (NineFile m)) -> String -> m (NineFile m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (NineFile m)
forall (m :: * -> *).
(Monad m, EmbedIO m) =>
String -> IO (NineFile m)
memoryDirectory)