module Darcs.Util.Tree.Plain
(
readPlainTree
, writePlainTree
) where
import Control.Monad ( forM )
import Data.Maybe( catMaybes )
import qualified Data.ByteString.Lazy as BL
import System.FilePath( (</>) )
import System.Directory ( listDirectory, createDirectoryIfMissing )
import System.Posix.Files
( getSymbolicLinkStatus, isDirectory, isRegularFile, FileStatus )
import Darcs.Prelude
import Darcs.Util.Path
import Darcs.Util.File ( withCurrentDirectory )
import Darcs.Util.ByteString ( readSegment )
import Darcs.Util.Hash( Hash( NoHash) )
import Darcs.Util.Tree( Tree(), TreeItem(..)
, Blob(..), makeTree
, list, readBlob, expand )
readPlainDir :: FilePath -> IO [(FilePath, FileStatus)]
readPlainDir :: FilePath -> IO [(FilePath, FileStatus)]
readPlainDir FilePath
dir =
forall p a. FilePathLike p => p -> IO a -> IO a
withCurrentDirectory FilePath
dir forall a b. (a -> b) -> a -> b
$ do
[FilePath]
items <- FilePath -> IO [FilePath]
listDirectory FilePath
"."
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
items forall a b. (a -> b) -> a -> b
$ \FilePath
s -> do
FileStatus
st <- FilePath -> IO FileStatus
getSymbolicLinkStatus FilePath
s
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
s, FileStatus
st)
readPlainTree :: FilePath -> IO (Tree IO)
readPlainTree :: FilePath -> IO (Tree IO)
readPlainTree FilePath
dir = do
[(FilePath, FileStatus)]
items <- FilePath -> IO [(FilePath, FileStatus)]
readPlainDir FilePath
dir
let subs :: [(Name, TreeItem IO)]
subs = forall a. [Maybe a] -> [a]
catMaybes [
let name :: Name
name = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => FilePath -> a
error forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath Name
makeName FilePath
name'
in case FileStatus
status of
FileStatus
_ | FileStatus -> Bool
isDirectory FileStatus
status -> forall a. a -> Maybe a
Just (Name
name, forall (m :: * -> *). m (Tree m) -> Hash -> TreeItem m
Stub (FilePath -> IO (Tree IO)
readPlainTree (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
name')) Hash
NoHash)
FileStatus
_ | FileStatus -> Bool
isRegularFile FileStatus
status -> forall a. a -> Maybe a
Just (Name
name, forall (m :: * -> *). Blob m -> TreeItem m
File forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). m ByteString -> Hash -> Blob m
Blob (FilePath -> IO ByteString
readBlob' FilePath
name') Hash
NoHash)
FileStatus
_ -> forall a. Maybe a
Nothing
| (FilePath
name', FileStatus
status) <- [(FilePath, FileStatus)]
items ]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). [(Name, TreeItem m)] -> Tree m
makeTree [(Name, TreeItem IO)]
subs
where readBlob' :: FilePath -> IO ByteString
readBlob' FilePath
name = FileSegment -> IO ByteString
readSegment (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
name, forall a. Maybe a
Nothing)
writePlainTree :: Tree IO -> FilePath -> IO ()
writePlainTree :: Tree IO -> FilePath -> IO ()
writePlainTree Tree IO
t FilePath
dir = do
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
expand Tree IO
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (AnchoredPath, TreeItem IO) -> IO ()
write forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
list
where write :: (AnchoredPath, TreeItem IO) -> IO ()
write (AnchoredPath
p, File Blob IO
b) = AnchoredPath -> Blob IO -> IO ()
write' AnchoredPath
p Blob IO
b
write (AnchoredPath
p, SubTree Tree IO
_) =
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> AnchoredPath -> FilePath
anchorPath FilePath
dir AnchoredPath
p)
write (AnchoredPath, TreeItem IO)
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
write' :: AnchoredPath -> Blob IO -> IO ()
write' AnchoredPath
p Blob IO
b = forall (m :: * -> *). Blob m -> m ByteString
readBlob Blob IO
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ByteString -> IO ()
BL.writeFile (FilePath -> AnchoredPath -> FilePath
anchorPath FilePath
dir AnchoredPath
p)