module Darcs.Util.Tree.Hashed
(
readDarcsHashed
, writeDarcsHashed
, hashedTreeIO
, readDarcsHashedDir
, readDarcsHashedNosize
, darcsAddMissingHashes
, darcsLocation
, darcsTreeHash
, decodeDarcsHash
, decodeDarcsSize
, darcsUpdateHashes
) where
import System.FilePath ( (</>) )
import System.Directory( doesFileExist )
import Codec.Compression.GZip( decompress, compress )
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString as B
import Data.List( sortBy )
import Data.Maybe( fromJust, isJust )
import Control.Monad.State.Strict (liftIO,when,unless)
import Darcs.Prelude
import Darcs.Util.ByteString (FileSegment, readSegment)
import Darcs.Util.Hash (Hash(..), decodeBase16, encodeBase16, sha256)
import Darcs.Util.Path (Name, decodeWhiteName, encodeWhiteName)
import Darcs.Util.Progress (debugMessage)
import Darcs.Util.Tree
( Blob(..)
, ItemType(..)
, Tree(..)
, TreeItem(..)
, addMissingHashes
, expand
, itemHash
, list
, listImmediate
, makeTreeWithHash
, readBlob
, updateSubtrees
, updateTree
)
import Darcs.Util.Tree.Monad (TreeIO, runTreeMonad)
decodeDarcsHash :: BC.ByteString -> Hash
decodeDarcsHash :: ByteString -> Hash
decodeDarcsHash ByteString
bs = case Char -> ByteString -> [ByteString]
BC.split Char
'-' ByteString
bs of
[ByteString
s, ByteString
h] | ByteString -> Int
BC.length ByteString
s forall a. Eq a => a -> a -> Bool
== Int
10 -> ByteString -> Hash
decodeBase16 ByteString
h
[ByteString]
_ -> ByteString -> Hash
decodeBase16 ByteString
bs
decodeDarcsSize :: BC.ByteString -> Maybe Int
decodeDarcsSize :: ByteString -> Maybe Int
decodeDarcsSize ByteString
bs = case Char -> ByteString -> [ByteString]
BC.split Char
'-' ByteString
bs of
[ByteString
s, ByteString
_] | ByteString -> Int
BC.length ByteString
s forall a. Eq a => a -> a -> Bool
== Int
10 ->
case forall a. Read a => ReadS a
reads (ByteString -> [Char]
BC.unpack ByteString
s) of
[(Int
x, [Char]
_)] -> forall a. a -> Maybe a
Just Int
x
[(Int, [Char])]
_ -> forall a. Maybe a
Nothing
[ByteString]
_ -> forall a. Maybe a
Nothing
darcsLocation :: FilePath -> (Maybe Int, Hash) -> FileSegment
darcsLocation :: [Char] -> (Maybe Int, Hash) -> FileSegment
darcsLocation [Char]
dir (Maybe Int
s,Hash
h) = case [Char]
hash of
[Char]
"" -> forall a. HasCallStack => [Char] -> a
error [Char]
"darcsLocation: invalid hash"
[Char]
_ -> ([Char]
dir [Char] -> [Char] -> [Char]
</> forall {p}. Show p => Maybe p -> [Char]
prefix Maybe Int
s forall a. [a] -> [a] -> [a]
++ [Char]
hash, forall a. Maybe a
Nothing)
where prefix :: Maybe p -> [Char]
prefix Maybe p
Nothing = [Char]
""
prefix (Just p
s') = forall {p}. Show p => p -> [Char]
formatSize p
s' forall a. [a] -> [a] -> [a]
++ [Char]
"-"
formatSize :: p -> [Char]
formatSize p
s' = let n :: [Char]
n = forall {p}. Show p => p -> [Char]
show p
s' in forall a. Int -> a -> [a]
replicate (Int
10 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
n) Char
'0' forall a. [a] -> [a] -> [a]
++ [Char]
n
hash :: [Char]
hash = Hash -> [Char]
showHash Hash
h
darcsFormatDir :: Tree m -> Maybe BLC.ByteString
darcsFormatDir :: forall (m :: * -> *). Tree m -> Maybe ByteString
darcsFormatDir Tree m
t = [ByteString] -> ByteString
BLC.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}. (Name, TreeItem m) -> Maybe [ByteString]
string (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall {a} {b} {b}. Ord a => (a, b) -> (a, b) -> Ordering
cmp forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Tree m -> [(Name, TreeItem m)]
listImmediate Tree m
t)
where cmp :: (a, b) -> (a, b) -> Ordering
cmp (a
a, b
_) (a
b, b
_) = forall a. Ord a => a -> a -> Ordering
compare a
a a
b
string :: (Name, TreeItem m) -> Maybe [ByteString]
string (Name
name, TreeItem m
item) =
do ByteString
header <- case TreeItem m
item of
File Blob m
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
BC.pack [Char]
"file:\n"
TreeItem m
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
BC.pack [Char]
"directory:\n"
ByteString
hash <- case forall (m :: * -> *). TreeItem m -> Hash
itemHash TreeItem m
item of
Hash
NoHash -> forall a. Maybe a
Nothing
Hash
x -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Hash -> ByteString
encodeBase16 Hash
x
forall (m :: * -> *) a. Monad m => a -> m a
return [ ByteString
header
, Name -> ByteString
encodeWhiteName Name
name
, Char -> ByteString
BC.singleton Char
'\n'
, ByteString
hash, Char -> ByteString
BC.singleton Char
'\n' ]
darcsParseDir :: BLC.ByteString -> [(ItemType, Name, Maybe Int, Hash)]
darcsParseDir :: ByteString -> [(ItemType, Name, Maybe Int, Hash)]
darcsParseDir ByteString
content = [ByteString] -> [(ItemType, Name, Maybe Int, Hash)]
parse (Char -> ByteString -> [ByteString]
BLC.split Char
'\n' ByteString
content)
where
parse :: [ByteString] -> [(ItemType, Name, Maybe Int, Hash)]
parse (ByteString
t:ByteString
n:ByteString
h':[ByteString]
r) = (ByteString -> ItemType
header ByteString
t,
ByteString -> Name
decodeWhiteName forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BL.toChunks ByteString
n,
ByteString -> Maybe Int
decodeDarcsSize ByteString
hash,
ByteString -> Hash
decodeDarcsHash ByteString
hash) forall a. a -> [a] -> [a]
: [ByteString] -> [(ItemType, Name, Maybe Int, Hash)]
parse [ByteString]
r
where hash :: ByteString
hash = [ByteString] -> ByteString
BC.concat forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BLC.toChunks ByteString
h'
parse [ByteString]
_ = []
header :: ByteString -> ItemType
header ByteString
x
| ByteString
x forall a. Eq a => a -> a -> Bool
== [Char] -> ByteString
BLC.pack [Char]
"file:" = ItemType
BlobType
| ByteString
x forall a. Eq a => a -> a -> Bool
== [Char] -> ByteString
BLC.pack [Char]
"directory:" = ItemType
TreeType
| Bool
otherwise = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Error parsing darcs hashed dir: " forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BLC.unpack ByteString
x
darcsTreeHash :: Tree m -> Hash
darcsTreeHash :: forall (m :: * -> *). Tree m -> Hash
darcsTreeHash Tree m
t = case forall (m :: * -> *). Tree m -> Maybe ByteString
darcsFormatDir Tree m
t of
Maybe ByteString
Nothing -> Hash
NoHash
Just ByteString
x -> ByteString -> Hash
sha256 ByteString
x
darcsUpdateDirHashes :: Tree m -> Tree m
darcsUpdateDirHashes :: forall (m :: * -> *). Tree m -> Tree m
darcsUpdateDirHashes = forall (m :: * -> *). (Tree m -> Tree m) -> Tree m -> Tree m
updateSubtrees forall (m :: * -> *). Tree m -> Tree m
update
where update :: Tree m -> Tree m
update Tree m
t = Tree m
t { treeHash :: Hash
treeHash = forall (m :: * -> *). Tree m -> Hash
darcsTreeHash Tree m
t }
darcsUpdateHashes :: (Monad m) => Tree m -> m (Tree m)
darcsUpdateHashes :: forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
darcsUpdateHashes = forall (m :: * -> *).
Monad m =>
(TreeItem m -> m (TreeItem m)) -> Tree m -> m (Tree m)
updateTree forall {m :: * -> *}. Monad m => TreeItem m -> m (TreeItem m)
update
where update :: TreeItem m -> m (TreeItem m)
update (SubTree Tree m
t) = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Tree m -> TreeItem m
SubTree forall a b. (a -> b) -> a -> b
$ Tree m
t { treeHash :: Hash
treeHash = forall (m :: * -> *). Tree m -> Hash
darcsTreeHash Tree m
t }
update (File blob :: Blob m
blob@(Blob m ByteString
con Hash
_)) =
do Hash
hash <- ByteString -> Hash
sha256 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Blob m -> m ByteString
readBlob Blob m
blob
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Blob m -> TreeItem m
File (forall (m :: * -> *). m ByteString -> Hash -> Blob m
Blob m ByteString
con Hash
hash)
update TreeItem m
stub = forall (m :: * -> *) a. Monad m => a -> m a
return TreeItem m
stub
darcsHash :: (Monad m) => TreeItem m -> m Hash
darcsHash :: forall (m :: * -> *). Monad m => TreeItem m -> m Hash
darcsHash (SubTree Tree m
t) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Tree m -> Hash
darcsTreeHash Tree m
t
darcsHash (File Blob m
blob) = ByteString -> Hash
sha256 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Blob m -> m ByteString
readBlob Blob m
blob
darcsHash TreeItem m
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Hash
NoHash
darcsAddMissingHashes :: (Monad m) => Tree m -> m (Tree m)
darcsAddMissingHashes :: forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
darcsAddMissingHashes = forall (m :: * -> *).
Monad m =>
(TreeItem m -> m Hash) -> Tree m -> m (Tree m)
addMissingHashes forall (m :: * -> *). Monad m => TreeItem m -> m Hash
darcsHash
readDarcsHashedDir :: FilePath -> (Maybe Int, Hash) -> IO [(ItemType, Name, Maybe Int, Hash)]
readDarcsHashedDir :: [Char]
-> (Maybe Int, Hash) -> IO [(ItemType, Name, Maybe Int, Hash)]
readDarcsHashedDir [Char]
dir (Maybe Int, Hash)
h = do
[Char] -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ [Char]
"readDarcsHashedDir: " forall a. [a] -> [a] -> [a]
++ [Char]
dir forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ Hash -> [Char]
showHash (forall a b. (a, b) -> b
snd (Maybe Int, Hash)
h)
Bool
exist <- [Char] -> IO Bool
doesFileExist forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst ([Char] -> (Maybe Int, Hash) -> FileSegment
darcsLocation [Char]
dir (Maybe Int, Hash)
h)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exist forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"error opening " forall a. [a] -> [a] -> [a]
++ forall a b. (a, b) -> a
fst ([Char] -> (Maybe Int, Hash) -> FileSegment
darcsLocation [Char]
dir (Maybe Int, Hash)
h)
ByteString
compressed <- FileSegment -> IO ByteString
readSegment forall a b. (a -> b) -> a -> b
$ [Char] -> (Maybe Int, Hash) -> FileSegment
darcsLocation [Char]
dir (Maybe Int, Hash)
h
let content :: ByteString
content = ByteString -> ByteString
decompress ByteString
compressed
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if ByteString -> Bool
BLC.null ByteString
compressed
then []
else ByteString -> [(ItemType, Name, Maybe Int, Hash)]
darcsParseDir ByteString
content
readDarcsHashed' :: Bool -> FilePath -> (Maybe Int, Hash) -> IO (Tree IO)
readDarcsHashed' :: Bool -> [Char] -> (Maybe Int, Hash) -> IO (Tree IO)
readDarcsHashed' Bool
_ [Char]
_ (Maybe Int
_, Hash
NoHash) = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Cannot readDarcsHashed NoHash"
readDarcsHashed' Bool
sizefail [Char]
dir root :: (Maybe Int, Hash)
root@(Maybe Int
_, Hash
hash) = do
[(ItemType, Name, Maybe Int, Hash)]
items' <- [Char]
-> (Maybe Int, Hash) -> IO [(ItemType, Name, Maybe Int, Hash)]
readDarcsHashedDir [Char]
dir (Maybe Int, Hash)
root
[(Name, TreeItem IO)]
subs <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [
do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
sizefail Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe Int
s) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Unexpectedly encountered size-prefixed hash in " forall a. [a] -> [a] -> [a]
++ [Char]
dir)
case ItemType
tp of
ItemType
BlobType -> forall (m :: * -> *) a. Monad m => a -> m a
return (Name
d, forall (m :: * -> *). Blob m -> TreeItem m
File forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *). m ByteString -> Hash -> Blob m
Blob ((Maybe Int, Hash) -> IO ByteString
readBlob' (Maybe Int
s, Hash
h)) Hash
h)
ItemType
TreeType ->
do let t :: IO (Tree IO)
t = [Char] -> (Maybe Int, Hash) -> IO (Tree IO)
readDarcsHashed [Char]
dir (Maybe Int
s, Hash
h)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
d, forall (m :: * -> *). m (Tree m) -> Hash -> TreeItem m
Stub IO (Tree IO)
t Hash
h)
| (ItemType
tp, Name
d, Maybe Int
s, Hash
h) <- [(ItemType, Name, Maybe Int, Hash)]
items' ]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). [(Name, TreeItem m)] -> Hash -> Tree m
makeTreeWithHash [(Name, TreeItem IO)]
subs Hash
hash
where readBlob' :: (Maybe Int, Hash) -> IO ByteString
readBlob' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
decompress forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileSegment -> IO ByteString
readSegment forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> (Maybe Int, Hash) -> FileSegment
darcsLocation [Char]
dir
readDarcsHashed :: FilePath -> (Maybe Int, Hash) -> IO (Tree IO)
readDarcsHashed :: [Char] -> (Maybe Int, Hash) -> IO (Tree IO)
readDarcsHashed = Bool -> [Char] -> (Maybe Int, Hash) -> IO (Tree IO)
readDarcsHashed' Bool
False
readDarcsHashedNosize :: FilePath -> Hash -> IO (Tree IO)
readDarcsHashedNosize :: [Char] -> Hash -> IO (Tree IO)
readDarcsHashedNosize [Char]
dir Hash
hash = Bool -> [Char] -> (Maybe Int, Hash) -> IO (Tree IO)
readDarcsHashed' Bool
True [Char]
dir (forall a. Maybe a
Nothing, Hash
hash)
writeDarcsHashed :: Tree IO -> FilePath -> IO Hash
writeDarcsHashed :: Tree IO -> [Char] -> IO Hash
writeDarcsHashed Tree IO
tree' [Char]
dir =
do [Char] -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ [Char]
"writeDarcsHashed " forall a. [a] -> [a] -> [a]
++ [Char]
dir
Tree IO
t <- forall (m :: * -> *). Tree m -> Tree m
darcsUpdateDirHashes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
expand Tree IO
tree'
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ ByteString -> IO ()
dump forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). Blob m -> m ByteString
readBlob Blob IO
b | (AnchoredPath
_, File Blob IO
b) <- forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
list Tree IO
t ]
let dirs :: [Maybe ByteString]
dirs = forall (m :: * -> *). Tree m -> Maybe ByteString
darcsFormatDir Tree IO
t forall a. a -> [a] -> [a]
: [ forall (m :: * -> *). Tree m -> Maybe ByteString
darcsFormatDir Tree IO
d | (AnchoredPath
_, SubTree Tree IO
d) <- forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
list Tree IO
t ]
[()]
_ <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ByteString -> IO ()
dump forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust) [Maybe ByteString]
dirs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Tree m -> Hash
darcsTreeHash Tree IO
t
where dump :: ByteString -> IO ()
dump ByteString
bits =
do let name :: [Char]
name = [Char]
dir [Char] -> [Char] -> [Char]
</> ByteString -> [Char]
BC.unpack (Hash -> ByteString
encodeBase16 forall a b. (a -> b) -> a -> b
$ ByteString -> Hash
sha256 ByteString
bits)
Bool
exist <- [Char] -> IO Bool
doesFileExist [Char]
name
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exist forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString -> IO ()
BL.writeFile [Char]
name (ByteString -> ByteString
compress ByteString
bits)
fsCreateHashedFile :: FilePath -> BLC.ByteString -> TreeIO ()
fsCreateHashedFile :: [Char] -> ByteString -> TreeIO ()
fsCreateHashedFile [Char]
fn ByteString
content =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
[Char] -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ [Char]
"fsCreateHashedFile " forall a. [a] -> [a] -> [a]
++ [Char]
fn
Bool
exist <- [Char] -> IO Bool
doesFileExist [Char]
fn
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exist forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString -> IO ()
BL.writeFile [Char]
fn ByteString
content
hashedTreeIO :: TreeIO a
-> Tree IO
-> FilePath
-> IO (a, Tree IO)
hashedTreeIO :: forall a. TreeIO a -> Tree IO -> [Char] -> IO (a, Tree IO)
hashedTreeIO TreeIO a
action Tree IO
t [Char]
dir =
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 TreeIO a
action Tree IO
t forall (m :: * -> *). Monad m => TreeItem m -> m Hash
darcsHash forall {p}.
p
-> TreeItem IO
-> RWST (TreeEnv IO) () (TreeState IO) IO (TreeItem IO)
updateItem
where updateItem :: p
-> TreeItem IO
-> RWST (TreeEnv IO) () (TreeState IO) IO (TreeItem IO)
updateItem p
_ (File Blob IO
b) = forall (m :: * -> *). Blob m -> TreeItem m
File forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blob IO -> RWST (TreeEnv IO) () (TreeState IO) IO (Blob IO)
updateFile Blob IO
b
updateItem p
_ (SubTree Tree IO
s) = forall (m :: * -> *). Tree m -> TreeItem m
SubTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *}.
Tree m -> RWST (TreeEnv IO) () (TreeState IO) IO (Tree m)
updateSub Tree IO
s
updateItem p
_ TreeItem IO
x = forall (m :: * -> *) a. Monad m => a -> m a
return TreeItem IO
x
updateFile :: Blob IO -> RWST (TreeEnv IO) () (TreeState IO) IO (Blob IO)
updateFile b :: Blob IO
b@(Blob IO ByteString
_ !Hash
h) = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ [Char]
"hashedTreeIO.updateFile: " forall a. [a] -> [a] -> [a]
++ Hash -> [Char]
showHash Hash
h
ByteString
content <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Blob m -> m ByteString
readBlob Blob IO
b
let fn :: [Char]
fn = [Char]
dir [Char] -> [Char] -> [Char]
</> Hash -> [Char]
showHash Hash
h
nblob :: Blob IO
nblob = forall (m :: * -> *). m ByteString -> Hash -> Blob m
Blob (ByteString -> ByteString
decompress forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
rblob) Hash
h
rblob :: IO ByteString
rblob = [ByteString] -> ByteString
BL.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO ByteString
B.readFile [Char]
fn
newcontent :: ByteString
newcontent = ByteString -> ByteString
compress ByteString
content
[Char] -> ByteString -> TreeIO ()
fsCreateHashedFile [Char]
fn ByteString
newcontent
forall (m :: * -> *) a. Monad m => a -> m a
return Blob IO
nblob
updateSub :: Tree m -> RWST (TreeEnv IO) () (TreeState IO) IO (Tree m)
updateSub Tree m
s = do
let !hash :: Hash
hash = forall (m :: * -> *). Tree m -> Hash
treeHash Tree m
s
Just ByteString
dirdata = forall (m :: * -> *). Tree m -> Maybe ByteString
darcsFormatDir Tree m
s
fn :: [Char]
fn = [Char]
dir [Char] -> [Char] -> [Char]
</> Hash -> [Char]
showHash Hash
hash
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
debugMessage forall a b. (a -> b) -> a -> b
$ [Char]
"hashedTreeIO.updateSub: " forall a. [a] -> [a] -> [a]
++ Hash -> [Char]
showHash Hash
hash
[Char] -> ByteString -> TreeIO ()
fsCreateHashedFile [Char]
fn (ByteString -> ByteString
compress ByteString
dirdata)
forall (m :: * -> *) a. Monad m => a -> m a
return Tree m
s
showHash :: Hash -> String
showHash :: Hash -> [Char]
showHash = ByteString -> [Char]
BC.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> ByteString
encodeBase16