module Darcs.Util.Tree.Monad
(
TreeMonad
, TreeState(tree)
, runTreeMonad
, virtualTreeMonad
, TreeIO
, virtualTreeIO
, readFile
, exists
, directoryExists
, fileExists
, writeFile
, createDirectory
, unlink
, rename
, copy
, 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
type Changed = M.Map AnchoredPath (Int64, Int64)
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)
}
type TreeMonad m = RWST (TreeEnv m) () (TreeState m) m
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)
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)
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
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
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 ()
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
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
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' }
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
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
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
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)
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
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
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 :: 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 :: 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