--  Copyright (C) 2009-2011 Petr Rockai
--
--  BSD3

-- | A 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.
module Darcs.Util.Tree.Monad
    ( -- * 'TreeMonad'
      TreeMonad
    , TreeState(tree)
    , runTreeMonad
    , virtualTreeMonad
      -- * Specializing to 'IO'
    , TreeIO
    , virtualTreeIO
      -- * Read actions
    , readFile
    , exists
    , directoryExists
    , fileExists
      -- * Write actions
    , writeFile
    , createDirectory
    , unlink
    , rename
    , copy
      -- * Other actions
    , findM, findFileM, findTreeM
    ) where

import Darcs.Prelude hiding ( readFile, writeFile )

import Control.Exception ( throw )

import Darcs.Util.Path
import Darcs.Util.Tree

import Data.List( sortBy )
import Data.Int( Int64 )
import Data.Maybe( isNothing, isJust )

import qualified Data.ByteString.Lazy as BL
import Control.Monad.RWS.Strict
import qualified Data.Map as M

-- | Keep track of the size and age of changes to the tree.
type Changed = M.Map AnchoredPath (Int64, Int64) -- size, age

-- | Internal state of the 'TreeMonad'. Keeps track of the current 'Tree'
-- content and unsync'd changes.
data TreeState m = TreeState
  { forall (m :: * -> *). TreeState m -> Tree m
tree :: !(Tree m)
  , forall (m :: * -> *). TreeState m -> Changed
changed :: !Changed
  , forall (m :: * -> *). TreeState m -> Int64
changesize :: !Int64
  , forall (m :: * -> *). TreeState m -> Int64
maxage :: !Int64
  }

data TreeEnv m = TreeEnv
  { forall (m :: * -> *). TreeEnv m -> TreeItem m -> m Hash
updateHash :: TreeItem m -> m Hash
  , forall (m :: * -> *).
TreeEnv m -> AnchoredPath -> TreeItem m -> TreeMonad m (TreeItem m)
update :: AnchoredPath -> TreeItem m -> TreeMonad m (TreeItem m)
  }

-- | A monad transformer that adds state of type 'TreeState' and an environment
-- of type 'AnchoredPath' (for the current directory).
type TreeMonad m = RWST (TreeEnv m) () (TreeState m) m

-- | 'TreeMonad' specialized to 'IO'
type TreeIO = TreeMonad IO

initialEnv :: (TreeItem m -> m Hash)
           -> (AnchoredPath -> TreeItem m -> TreeMonad m (TreeItem m))
           -> TreeEnv m
initialEnv :: forall (m :: * -> *).
(TreeItem m -> m Hash)
-> (AnchoredPath -> TreeItem m -> TreeMonad m (TreeItem m))
-> TreeEnv m
initialEnv TreeItem m -> m Hash
uh AnchoredPath -> TreeItem m -> TreeMonad m (TreeItem m)
u = TreeEnv {updateHash :: TreeItem m -> m Hash
updateHash = TreeItem m -> m Hash
uh, update :: AnchoredPath -> TreeItem m -> TreeMonad m (TreeItem m)
update = AnchoredPath -> TreeItem m -> TreeMonad m (TreeItem m)
u}

initialState :: Tree m -> TreeState m
initialState :: forall (m :: * -> *). Tree m -> TreeState m
initialState Tree m
t =
  TreeState {tree :: Tree m
tree = Tree m
t, changed :: Changed
changed = forall k a. Map k a
M.empty, changesize :: Int64
changesize = Int64
0, maxage :: Int64
maxage = Int64
0}

flush :: Monad m => TreeMonad m ()
flush :: forall (m :: * -> *). Monad m => TreeMonad m ()
flush = do [AnchoredPath]
changed' <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Changed
changed
           [AnchoredPath]
dirs' <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Tree m
tree forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Tree m
t -> forall (m :: * -> *) a. Monad m => a -> m a
return [ AnchoredPath
path | (AnchoredPath
path, SubTree Tree m
_) <- forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
list Tree m
t ]
           forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \TreeState m
st -> TreeState m
st { changed :: Changed
changed = forall k a. Map k a
M.empty, changesize :: Int64
changesize = Int64
0 }
           forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([AnchoredPath]
changed' forall a. [a] -> [a] -> [a]
++ [AnchoredPath]
dirs' forall a. [a] -> [a] -> [a]
++ [[Name] -> AnchoredPath
AnchoredPath []]) forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
flushItem

runTreeMonad' :: Monad m => TreeMonad m a -> TreeEnv m -> TreeState m -> m (a, Tree m)
runTreeMonad' :: forall (m :: * -> *) a.
Monad m =>
TreeMonad m a -> TreeEnv m -> TreeState m -> m (a, Tree m)
runTreeMonad' TreeMonad m a
action TreeEnv m
initEnv TreeState m
initState = do
  (a
out, TreeState m
final, ()
_) <- forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST TreeMonad m a
action TreeEnv m
initEnv TreeState m
initState
  forall (m :: * -> *) a. Monad m => a -> m a
return (a
out, forall (m :: * -> *). TreeState m -> Tree m
tree TreeState m
final)

runTreeMonad :: Monad m
             => TreeMonad m a
             -> Tree m
             -> (TreeItem m -> m Hash)
             -> (AnchoredPath -> TreeItem m -> TreeMonad m (TreeItem m))
             -> m (a, Tree m)
runTreeMonad :: forall (m :: * -> *) a.
Monad m =>
TreeMonad m a
-> Tree m
-> (TreeItem m -> m Hash)
-> (AnchoredPath -> TreeItem m -> TreeMonad m (TreeItem m))
-> m (a, Tree m)
runTreeMonad TreeMonad m a
action Tree m
t TreeItem m -> m Hash
uh AnchoredPath -> TreeItem m -> TreeMonad m (TreeItem m)
u = do
  let action' :: TreeMonad m a
action' = do a
x <- TreeMonad m a
action
                   forall (m :: * -> *). Monad m => TreeMonad m ()
flush
                   forall (m :: * -> *) a. Monad m => a -> m a
return a
x
  forall (m :: * -> *) a.
Monad m =>
TreeMonad m a -> TreeEnv m -> TreeState m -> m (a, Tree m)
runTreeMonad' TreeMonad m a
action' (forall (m :: * -> *).
(TreeItem m -> m Hash)
-> (AnchoredPath -> TreeItem m -> TreeMonad m (TreeItem m))
-> TreeEnv m
initialEnv TreeItem m -> m Hash
uh AnchoredPath -> TreeItem m -> TreeMonad m (TreeItem m)
u) (forall (m :: * -> *). Tree m -> TreeState m
initialState Tree m
t)

-- | Run a 'TreeMonad' 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 the form of a modified 'Tree'.
virtualTreeMonad :: Monad m => TreeMonad m a -> Tree m -> m (a, Tree m)
virtualTreeMonad :: forall (m :: * -> *) a.
Monad m =>
TreeMonad m a -> Tree m -> m (a, Tree m)
virtualTreeMonad TreeMonad m a
action Tree m
t =
  forall (m :: * -> *) a.
Monad m =>
TreeMonad m a
-> Tree m
-> (TreeItem m -> m Hash)
-> (AnchoredPath -> TreeItem m -> TreeMonad m (TreeItem m))
-> m (a, Tree m)
runTreeMonad TreeMonad m a
action Tree m
t (\TreeItem m
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Hash
NoHash) (\AnchoredPath
_ TreeItem m
x -> forall (m :: * -> *) a. Monad m => a -> m a
return TreeItem m
x)

-- | 'virtualTreeMonad' specialized to 'IO'
virtualTreeIO :: TreeIO a -> Tree IO -> IO (a, Tree IO)
virtualTreeIO :: forall a. TreeIO a -> Tree IO -> IO (a, Tree IO)
virtualTreeIO = forall (m :: * -> *) a.
Monad m =>
TreeMonad m a -> Tree m -> m (a, Tree m)
virtualTreeMonad

-- | Modifies an item in the current Tree. This action keeps an account of the
-- modified data, in changed and changesize, for subsequent flush
-- operations. Any modifications (as in "modifyTree") are allowed.
modifyItem :: Monad m
            => AnchoredPath -> Maybe (TreeItem m) -> TreeMonad m ()
modifyItem :: forall (m :: * -> *).
Monad m =>
AnchoredPath -> Maybe (TreeItem m) -> TreeMonad m ()
modifyItem AnchoredPath
path Maybe (TreeItem m)
item = do
  Int64
age <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Int64
maxage
  Changed
changed' <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Changed
changed
  let getsize :: Maybe (TreeItem m) -> t m Int64
getsize (Just (File Blob m
b)) = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ByteString -> Int64
BL.length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Blob m -> m ByteString
readBlob Blob m
b)
      getsize Maybe (TreeItem m)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Int64
0
  Int64
size <- forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad m, Monad (t m)) =>
Maybe (TreeItem m) -> t m Int64
getsize Maybe (TreeItem m)
item
  let change :: Int64
change = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup AnchoredPath
path Changed
changed' of
        Maybe (Int64, Int64)
Nothing -> Int64
size
        Just (Int64
oldsize, Int64
_) -> Int64
size forall a. Num a => a -> a -> a
- Int64
oldsize

  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \TreeState m
st -> TreeState m
st { tree :: Tree m
tree = forall (m :: * -> *).
Monad m =>
Tree m -> AnchoredPath -> Maybe (TreeItem m) -> Tree m
modifyTree (forall (m :: * -> *). TreeState m -> Tree m
tree TreeState m
st) AnchoredPath
path Maybe (TreeItem m)
item
                     , changed :: Changed
changed = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert AnchoredPath
path (Int64
size, Int64
age) (forall (m :: * -> *). TreeState m -> Changed
changed TreeState m
st)
                     , maxage :: Int64
maxage = Int64
age forall a. Num a => a -> a -> a
+ Int64
1
                     , changesize :: Int64
changesize = forall (m :: * -> *). TreeState m -> Int64
changesize TreeState m
st forall a. Num a => a -> a -> a
+ Int64
change }

renameChanged :: Monad m
              => AnchoredPath -> AnchoredPath -> TreeMonad m ()
renameChanged :: forall (m :: * -> *).
Monad m =>
AnchoredPath -> AnchoredPath -> TreeMonad m ()
renameChanged AnchoredPath
from AnchoredPath
to = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \TreeState m
st -> TreeState m
st {changed :: Changed
changed = forall {a}. Map AnchoredPath a -> Map AnchoredPath a
rename' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). TreeState m -> Changed
changed TreeState m
st}
  where
    rename' :: Map AnchoredPath a -> Map AnchoredPath a
rename' = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {b}. (AnchoredPath, b) -> (AnchoredPath, b)
renameone forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList
    renameone :: (AnchoredPath, b) -> (AnchoredPath, b)
renameone (AnchoredPath
x, b
d)
      | AnchoredPath
from AnchoredPath -> AnchoredPath -> Bool
`isPrefix` AnchoredPath
x = (AnchoredPath
to AnchoredPath -> AnchoredPath -> AnchoredPath
`catPaths` AnchoredPath -> AnchoredPath -> AnchoredPath
relative AnchoredPath
from AnchoredPath
x, b
d)
      | Bool
otherwise = (AnchoredPath
x, b
d)
    relative :: AnchoredPath -> AnchoredPath -> AnchoredPath
relative (AnchoredPath [Name]
from') (AnchoredPath [Name]
x) =
      [Name] -> AnchoredPath
AnchoredPath forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
from') [Name]
x

-- | 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.
replaceItem :: Monad m
            => AnchoredPath -> Maybe (TreeItem m) -> TreeMonad m ()
replaceItem :: forall (m :: * -> *).
Monad m =>
AnchoredPath -> Maybe (TreeItem m) -> TreeMonad m ()
replaceItem AnchoredPath
path Maybe (TreeItem m)
item = do
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \TreeState m
st -> TreeState m
st { tree :: Tree m
tree = forall (m :: * -> *).
Monad m =>
Tree m -> AnchoredPath -> Maybe (TreeItem m) -> Tree m
modifyTree (forall (m :: * -> *). TreeState m -> Tree m
tree TreeState m
st) AnchoredPath
path Maybe (TreeItem m)
item }

flushItem :: forall m. Monad m => AnchoredPath -> TreeMonad m ()
flushItem :: forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
flushItem AnchoredPath
path =
  do Tree m
current <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Tree m
tree
     case forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (TreeItem m)
find Tree m
current AnchoredPath
path of
       Maybe (TreeItem m)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return () -- vanished, do nothing
       Just TreeItem m
x -> do TreeItem m
y <- TreeItem m -> TreeMonad m (TreeItem m)
fixHash TreeItem m
x
                    TreeItem m
new <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (m :: * -> *).
TreeEnv m -> AnchoredPath -> TreeItem m -> TreeMonad m (TreeItem m)
update forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a b. (a -> b) -> a -> b
$ TreeItem m
y) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ AnchoredPath
path)
                    forall (m :: * -> *).
Monad m =>
AnchoredPath -> Maybe (TreeItem m) -> TreeMonad m ()
replaceItem AnchoredPath
path (forall a. a -> Maybe a
Just TreeItem m
new)
    where fixHash :: TreeItem m -> TreeMonad m (TreeItem m)
          fixHash :: TreeItem m -> TreeMonad m (TreeItem m)
fixHash f :: TreeItem m
f@(File (Blob m ByteString
con Hash
NoHash)) = do
            Hash
hash <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (m :: * -> *). TreeEnv m -> TreeItem m -> m Hash
updateHash forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TreeItem m -> m Hash
x -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ TreeItem m -> m Hash
x TreeItem m
f
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Blob m -> TreeItem m
File forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). m ByteString -> Hash -> Blob m
Blob m ByteString
con Hash
hash
          fixHash (SubTree Tree m
s) | forall (m :: * -> *). Tree m -> Hash
treeHash Tree m
s forall a. Eq a => a -> a -> Bool
== Hash
NoHash =
            forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall (m :: * -> *). TreeEnv m -> TreeItem m -> m Hash
updateHash forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TreeItem m -> m Hash
f -> forall (m :: * -> *). Tree m -> TreeItem m
SubTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
Monad m =>
(TreeItem m -> m Hash) -> Tree m -> m (Tree m)
addMissingHashes TreeItem m -> m Hash
f Tree m
s)
          fixHash TreeItem m
x = forall (m :: * -> *) a. Monad m => a -> m a
return TreeItem m
x


-- | If buffers are becoming large, sync, otherwise do nothing.
flushSome :: Monad m => TreeMonad m ()
flushSome :: forall (m :: * -> *). Monad m => TreeMonad m ()
flushSome = do Int64
x <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Int64
changesize
               forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
x forall a. Ord a => a -> a -> Bool
> Int64 -> Int64
megs Int64
100) forall a b. (a -> b) -> a -> b
$ do
                 [(AnchoredPath, (Int64, Int64))]
remaining <- forall {m :: * -> *} {b}.
Monad m =>
[(AnchoredPath, (Int64, b))]
-> RWST (TreeEnv m) () (TreeState m) m [(AnchoredPath, (Int64, b))]
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall {a} {a} {a} {a} {a}.
Ord a =>
(a, (a, a)) -> (a, (a, a)) -> Ordering
age forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Changed
changed
                 forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \TreeState m
s -> TreeState m
s { changed :: Changed
changed = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(AnchoredPath, (Int64, Int64))]
remaining }
  where go :: [(AnchoredPath, (Int64, b))]
-> RWST (TreeEnv m) () (TreeState m) m [(AnchoredPath, (Int64, b))]
go [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
        go ((AnchoredPath
path, (Int64
size, b
_)):[(AnchoredPath, (Int64, b))]
chs) = do
          Int64
x <- forall a. Num a => a -> a -> a
subtract Int64
size forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Int64
changesize
          forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
flushItem AnchoredPath
path
          forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \TreeState m
s -> TreeState m
s { changesize :: Int64
changesize = Int64
x }
          if  Int64
x forall a. Ord a => a -> a -> Bool
> Int64 -> Int64
megs Int64
50  then [(AnchoredPath, (Int64, b))]
-> RWST (TreeEnv m) () (TreeState m) m [(AnchoredPath, (Int64, b))]
go [(AnchoredPath, (Int64, b))]
chs
                           else forall (m :: * -> *) a. Monad m => a -> m a
return [(AnchoredPath, (Int64, b))]
chs
        megs :: Int64 -> Int64
megs = (forall a. Num a => a -> a -> a
* (Int64
1024 forall a. Num a => a -> a -> a
* Int64
1024))
        age :: (a, (a, a)) -> (a, (a, a)) -> Ordering
age (a
_, (a
_, a
a)) (a
_, (a
_, a
b)) = forall a. Ord a => a -> a -> Ordering
compare a
a a
b

-- read only actions

expandTo :: Monad m => AnchoredPath -> TreeMonad m ()
expandTo :: forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
expandTo AnchoredPath
p =
    do Tree m
t <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Tree m
tree
       Tree m
t' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
Tree m -> AnchoredPath -> m (Tree m)
expandPath Tree m
t AnchoredPath
p
       forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \TreeState m
st -> TreeState m
st { tree :: Tree m
tree = Tree m
t' }

-- | Check for existence of a file.
fileExists :: Monad m => AnchoredPath -> TreeMonad m Bool
fileExists :: forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m Bool
fileExists AnchoredPath
p =
    do forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
expandTo AnchoredPath
p
       (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (Blob m)
`findFile` AnchoredPath
p)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Tree m
tree

-- | Check for existence of a directory.
directoryExists :: Monad m => AnchoredPath -> TreeMonad m Bool
directoryExists :: forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m Bool
directoryExists AnchoredPath
p =
    do forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
expandTo AnchoredPath
p
       (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (Tree m)
`findTree` AnchoredPath
p)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Tree m
tree

-- | Check for existence of a node (file or directory, doesn't matter).
exists :: Monad m => AnchoredPath -> TreeMonad m Bool
exists :: forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m Bool
exists AnchoredPath
p =
    do forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
expandTo AnchoredPath
p
       forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (TreeItem m)
`find` AnchoredPath
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Tree m
tree

-- | Grab content of a file in the current Tree at the given path.
readFile :: Monad m => AnchoredPath -> TreeMonad m BL.ByteString
readFile :: forall (m :: * -> *).
Monad m =>
AnchoredPath -> TreeMonad m ByteString
readFile AnchoredPath
p =
    do forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
expandTo AnchoredPath
p
       Tree m
t <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Tree m
tree
       let f :: Maybe (Blob m)
f = forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (Blob m)
findFile Tree m
t AnchoredPath
p
       case Maybe (Blob m)
f of
         Maybe (Blob m)
Nothing -> forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ String -> IOError
userError forall a b. (a -> b) -> a -> b
$ String
"No such file " forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
displayPath AnchoredPath
p
         Just Blob m
x -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *). Blob m -> m ByteString
readBlob Blob m
x)

-- | Change content of a file at a given path. The change will be
-- eventually flushed to disk, but might be buffered for some time.
writeFile :: Monad m => AnchoredPath -> BL.ByteString -> TreeMonad m ()
writeFile :: forall (m :: * -> *).
Monad m =>
AnchoredPath -> ByteString -> TreeMonad m ()
writeFile AnchoredPath
p ByteString
con =
    do forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
expandTo AnchoredPath
p
       forall (m :: * -> *).
Monad m =>
AnchoredPath -> Maybe (TreeItem m) -> TreeMonad m ()
modifyItem AnchoredPath
p (forall a. a -> Maybe a
Just TreeItem m
blob)
       forall (m :: * -> *). Monad m => TreeMonad m ()
flushSome
    where blob :: TreeItem m
blob = forall (m :: * -> *). Blob m -> TreeItem m
File forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). m ByteString -> Hash -> Blob m
Blob (forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
con) Hash
hash
          hash :: Hash
hash = Hash
NoHash -- we would like to say "sha256 con" here, but due
                        -- to strictness of Hash in Blob, this would often
                        -- lead to unnecessary computation which would then
                        -- be discarded anyway; we rely on the sync
                        -- implementation to fix up any NoHash occurrences

-- | Create a directory.
createDirectory :: Monad m => AnchoredPath -> TreeMonad m ()
createDirectory :: forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
createDirectory AnchoredPath
p =
    do forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
expandTo AnchoredPath
p
       forall (m :: * -> *).
Monad m =>
AnchoredPath -> Maybe (TreeItem m) -> TreeMonad m ()
modifyItem AnchoredPath
p forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Tree m -> TreeItem m
SubTree forall (m :: * -> *). Tree m
emptyTree

-- | Remove the item at a path.
unlink :: Monad m => AnchoredPath -> TreeMonad m ()
unlink :: forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
unlink AnchoredPath
p =
    do forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
expandTo AnchoredPath
p
       forall (m :: * -> *).
Monad m =>
AnchoredPath -> Maybe (TreeItem m) -> TreeMonad m ()
modifyItem AnchoredPath
p forall a. Maybe a
Nothing

-- | Rename the item at a path.
rename :: Monad m => AnchoredPath -> AnchoredPath -> TreeMonad m ()
rename :: forall (m :: * -> *).
Monad m =>
AnchoredPath -> AnchoredPath -> TreeMonad m ()
rename AnchoredPath
from AnchoredPath
to =
    do forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
expandTo AnchoredPath
from
       forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
expandTo AnchoredPath
to
       Tree m
tr <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Tree m
tree
       let item :: Maybe (TreeItem m)
item = forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (TreeItem m)
find Tree m
tr AnchoredPath
from
           found_to :: Maybe (TreeItem m)
found_to = forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (TreeItem m)
find Tree m
tr AnchoredPath
to
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Maybe a -> Bool
isNothing Maybe (TreeItem m)
found_to) forall a b. (a -> b) -> a -> b
$
              forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ String -> IOError
userError forall a b. (a -> b) -> a -> b
$ String
"Error renaming: destination " forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
displayPath AnchoredPath
to forall a. [a] -> [a] -> [a]
++ String
" exists."
       if forall a. Maybe a -> Bool
isJust Maybe (TreeItem m)
item then do
              forall (m :: * -> *).
Monad m =>
AnchoredPath -> Maybe (TreeItem m) -> TreeMonad m ()
modifyItem AnchoredPath
from forall a. Maybe a
Nothing
              forall (m :: * -> *).
Monad m =>
AnchoredPath -> Maybe (TreeItem m) -> TreeMonad m ()
modifyItem AnchoredPath
to Maybe (TreeItem m)
item
              forall (m :: * -> *).
Monad m =>
AnchoredPath -> AnchoredPath -> TreeMonad m ()
renameChanged AnchoredPath
from AnchoredPath
to
       else
        forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ String -> IOError
userError forall a b. (a -> b) -> a -> b
$ String
"Error renaming: source " forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
displayPath AnchoredPath
from forall a. [a] -> [a] -> [a]
++ String
" does not exist."

-- | Copy an item from some path to another path.
copy :: Monad m => AnchoredPath -> AnchoredPath -> TreeMonad m ()
copy :: forall (m :: * -> *).
Monad m =>
AnchoredPath -> AnchoredPath -> TreeMonad m ()
copy AnchoredPath
from AnchoredPath
to =
    do forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
expandTo AnchoredPath
from
       forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
expandTo AnchoredPath
to
       Tree m
tr <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Tree m
tree
       let item :: Maybe (TreeItem m)
item = forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (TreeItem m)
find Tree m
tr AnchoredPath
from
       forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Maybe a -> Bool
isNothing Maybe (TreeItem m)
item) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
AnchoredPath -> Maybe (TreeItem m) -> TreeMonad m ()
modifyItem AnchoredPath
to Maybe (TreeItem m)
item

findM' :: forall m a . Monad m
       => (Tree m -> AnchoredPath -> a) -> Tree m -> AnchoredPath -> m a
findM' :: forall (m :: * -> *) a.
Monad m =>
(Tree m -> AnchoredPath -> a) -> Tree m -> AnchoredPath -> m a
findM' Tree m -> AnchoredPath -> a
what Tree m
t AnchoredPath
path = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Monad m =>
TreeMonad m a -> Tree m -> m (a, Tree m)
virtualTreeMonad (AnchoredPath -> TreeMonad m a
look AnchoredPath
path) Tree m
t
  where look :: AnchoredPath -> TreeMonad m a
        look :: AnchoredPath -> TreeMonad m a
look AnchoredPath
p = forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m ()
expandTo AnchoredPath
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a b c. (a -> b -> c) -> b -> a -> c
flip Tree m -> AnchoredPath -> a
what AnchoredPath
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall (m :: * -> *). TreeState m -> Tree m
tree

findM :: Monad m => Tree m -> AnchoredPath -> m (Maybe (TreeItem m))
findM :: forall (m :: * -> *).
Monad m =>
Tree m -> AnchoredPath -> m (Maybe (TreeItem m))
findM = forall (m :: * -> *) a.
Monad m =>
(Tree m -> AnchoredPath -> a) -> Tree m -> AnchoredPath -> m a
findM' forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (TreeItem m)
find

findTreeM :: Monad m => Tree m -> AnchoredPath -> m (Maybe (Tree m))
findTreeM :: forall (m :: * -> *).
Monad m =>
Tree m -> AnchoredPath -> m (Maybe (Tree m))
findTreeM = forall (m :: * -> *) a.
Monad m =>
(Tree m -> AnchoredPath -> a) -> Tree m -> AnchoredPath -> m a
findM' forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (Tree m)
findTree

findFileM :: Monad m => Tree m -> AnchoredPath -> m (Maybe (Blob m))
findFileM :: forall (m :: * -> *).
Monad m =>
Tree m -> AnchoredPath -> m (Maybe (Blob m))
findFileM = forall (m :: * -> *) a.
Monad m =>
(Tree m -> AnchoredPath -> a) -> Tree m -> AnchoredPath -> m a
findM' forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (Blob m)
findFile