Safe Haskell | None |
---|---|
Language | Haskell2010 |
An experimental monadic interface to Tree mutation. The main idea is to
simulate IO-ish manipulation of real filesystem (that's the state part of
the monad), and to keep memory usage down by reasonably often dumping the
intermediate data to disk and forgetting it. The monad interface itself is
generic, and a number of actual implementations can be used. This module
provides just virtualTreeIO
that never writes any changes, but may trigger
filesystem reads as appropriate.
Synopsis
- virtualTreeIO :: TreeIO a -> Tree IO -> IO (a, Tree IO)
- virtualTreeMonad :: Monad m => TreeMonad m a -> Tree m -> m (a, Tree m)
- readFile :: TreeRO m => AnchoredPath -> m ByteString
- writeFile :: TreeRW m => AnchoredPath -> ByteString -> m ()
- createDirectory :: TreeRW m => AnchoredPath -> m ()
- rename :: TreeRW m => AnchoredPath -> AnchoredPath -> m ()
- copy :: TreeRW m => AnchoredPath -> AnchoredPath -> m ()
- unlink :: TreeRW m => AnchoredPath -> m ()
- fileExists :: TreeRO m => AnchoredPath -> m Bool
- directoryExists :: TreeRO m => AnchoredPath -> m Bool
- exists :: TreeRO m => AnchoredPath -> m Bool
- withDirectory :: TreeRO m => AnchoredPath -> m a -> m a
- currentDirectory :: TreeRO m => m AnchoredPath
- tree :: TreeState m -> Tree m
- data TreeState m
- type TreeMonad m = RWST AnchoredPath () (TreeState m) m
- type TreeIO = TreeMonad IO
- runTreeMonad :: Monad m => TreeMonad m a -> TreeState m -> m (a, Tree m)
- initialState :: Tree m -> (TreeItem m -> m Hash) -> (AnchoredPath -> TreeItem m -> TreeMonad m (TreeItem m)) -> TreeState m
- replaceItem :: Monad m => AnchoredPath -> Maybe (TreeItem m) -> TreeMonad m ()
- findM :: Monad m => Tree m -> AnchoredPath -> m (Maybe (TreeItem m))
- findFileM :: Monad m => Tree m -> AnchoredPath -> m (Maybe (Blob m))
- findTreeM :: Monad m => Tree m -> AnchoredPath -> m (Maybe (Tree m))
- class Monad m => TreeRO m
- class TreeRO m => TreeRW m
Documentation
virtualTreeMonad :: Monad m => TreeMonad m a -> Tree m -> m (a, Tree m) Source #
Run a TreeIO action without storing any changes. This is useful for running monadic tree mutations for obtaining the resulting Tree (as opposed to their effect of writing a modified tree to disk). The actions can do both read and write -- reads are passed through to the actual filesystem, but the writes are held in memory in a form of modified Tree.
readFile :: TreeRO m => AnchoredPath -> m ByteString Source #
Grab content of a file in the current Tree at the given path.
writeFile :: TreeRW m => AnchoredPath -> ByteString -> m () Source #
Change content of a file at a given path. The change will be eventually flushed to disk, but might be buffered for some time.
createDirectory :: TreeRW m => AnchoredPath -> m () Source #
rename :: TreeRW m => AnchoredPath -> AnchoredPath -> m () Source #
copy :: TreeRW m => AnchoredPath -> AnchoredPath -> m () Source #
unlink :: TreeRW m => AnchoredPath -> m () Source #
fileExists :: TreeRO m => AnchoredPath -> m Bool Source #
Check for existence of a file.
directoryExists :: TreeRO m => AnchoredPath -> m Bool Source #
Check for existence of a directory.
exists :: TreeRO m => AnchoredPath -> m Bool Source #
Check for existence of a node (file or directory, doesn't matter).
withDirectory :: TreeRO m => AnchoredPath -> m a -> m a Source #
currentDirectory :: TreeRO m => m AnchoredPath Source #
Internal state of the TreeIO
monad. Keeps track of the current Tree
content, unsync'd changes and a current working directory (of the monad).
Instances
type TreeMonad m = RWST AnchoredPath () (TreeState m) m Source #
A TreeIO
monad. A sort of like IO but it keeps a TreeState
around as well,
which is a sort of virtual filesystem. Depending on how you obtained your
TreeIO
, the actions in your virtual filesystem get somehow reflected in the
actual real filesystem. For virtualTreeIO
, nothing happens in real
filesystem, however with plainTreeIO
, the plain tree will be updated every
now and then, and with hashedTreeIO
a darcs-style hashed tree will get
updated.
initialState :: Tree m -> (TreeItem m -> m Hash) -> (AnchoredPath -> TreeItem m -> TreeMonad m (TreeItem m)) -> TreeState m Source #
replaceItem :: Monad m => AnchoredPath -> Maybe (TreeItem m) -> TreeMonad m () Source #
Replace an item with a new version without modifying the content of the
tree. This does not do any change tracking. Ought to be only used from a
sync
implementation for a particular storage format. The presumed use-case
is that an existing in-memory Blob is replaced with a one referring to an
on-disk file.
class Monad m => TreeRO m Source #
currentDirectory, withDirectory, expandTo, readFile, exists, directoryExists, fileExists
Instances
Monad m => TreeRO (TreeMonad m) Source # | |
Defined in Darcs.Util.Tree.Monad currentDirectory :: TreeMonad m AnchoredPath Source # withDirectory :: AnchoredPath -> TreeMonad m a -> TreeMonad m a Source # expandTo :: AnchoredPath -> TreeMonad m AnchoredPath readFile :: AnchoredPath -> TreeMonad m ByteString Source # exists :: AnchoredPath -> TreeMonad m Bool Source # directoryExists :: AnchoredPath -> TreeMonad m Bool Source # fileExists :: AnchoredPath -> TreeMonad m Bool Source # |
class TreeRO m => TreeRW m Source #
Instances
Monad m => TreeRW (TreeMonad m) Source # | |
Defined in Darcs.Util.Tree.Monad writeFile :: AnchoredPath -> ByteString -> TreeMonad m () Source # createDirectory :: AnchoredPath -> TreeMonad m () Source # unlink :: AnchoredPath -> TreeMonad m () Source # rename :: AnchoredPath -> AnchoredPath -> TreeMonad m () Source # copy :: AnchoredPath -> AnchoredPath -> TreeMonad m () Source # |