module Darcs.Repository.Working
( applyToWorking
, setScriptsExecutable
, setScriptsExecutablePatches
) where
import Control.Monad ( when, unless, filterM )
import System.Directory ( doesFileExist )
import System.IO.Error ( catchIOError )
import qualified Data.ByteString as B ( readFile
, isPrefixOf
)
import qualified Data.ByteString.Char8 as BC (pack)
import Darcs.Prelude
import Darcs.Util.File ( withCurrentDirectory )
import Darcs.Util.Progress ( debugMessage )
import Darcs.Util.Workaround ( setExecutable )
import Darcs.Util.Tree ( Tree )
import Darcs.Util.Path ( anchorPath )
import qualified Darcs.Util.Tree as Tree
import Darcs.Patch ( RepoPatch, PrimOf, apply, listTouchedFiles )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Witnesses.Ordered
( FL(..) )
import Darcs.Patch.Inspect ( PatchInspect )
import Darcs.Repository.Format ( RepoProperty( NoWorkingDir ), formatHas )
import Darcs.Repository.Flags ( Verbosity(..) )
import Darcs.Repository.InternalTypes
( Repository
, repoFormat
, repoLocation
, unsafeCoerceU )
import Darcs.Repository.ApplyPatches ( runTolerantly, runSilently )
import Darcs.Repository.State ( readWorking, TreeFilter(..) )
applyToWorking :: (ApplyState p ~ Tree, RepoPatch p)
=> Repository rt p wR wU wT
-> Verbosity
-> FL (PrimOf p) wU wY
-> IO (Repository rt p wR wY wT)
applyToWorking :: forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Repository rt p wR wU wT
-> Verbosity
-> FL (PrimOf p) wU wY
-> IO (Repository rt p wR wY wT)
applyToWorking Repository rt p wR wU wT
repo Verbosity
verb FL (PrimOf p) wU wY
patch =
do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
NoWorkingDir (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
repo)) forall a b. (a -> b) -> a -> b
$
forall p a. FilePathLike p => p -> IO a -> IO a
withCurrentDirectory (forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
repo) forall a b. (a -> b) -> a -> b
$
if Verbosity
verb forall a. Eq a => a -> a -> Bool
== Verbosity
Quiet
then forall a. TolerantWrapper SilentIO a -> IO a
runSilently forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply FL (PrimOf p) wU wY
patch
else forall a. TolerantWrapper TolerantIO a -> IO a
runTolerantly forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply FL (PrimOf p) wU wY
patch
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wU'.
Repository rt p wR wU wT -> Repository rt p wR wU' wT
unsafeCoerceU Repository rt p wR wU wT
repo
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` (\IOError
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Error applying changes to working tree:\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IOError
e)
setScriptsExecutable_ :: [FilePath] -> IO ()
setScriptsExecutable_ :: [String] -> IO ()
setScriptsExecutable_ [String]
paths = do
String -> IO ()
debugMessage String
"Making scripts executable"
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
setExecutableIfScript [String]
paths
setScriptsExecutable :: IO ()
setScriptsExecutable :: IO ()
setScriptsExecutable = do
Tree IO
tree <- TreeFilter IO -> IO (Tree IO)
readWorking (forall (m :: * -> *).
(forall (tr :: (* -> *) -> *). FilterTree tr m => tr m -> tr m)
-> TreeFilter m
TreeFilter forall a. a -> a
id)
[String] -> IO ()
setScriptsExecutable_ [String -> AnchoredPath -> String
anchorPath String
"." AnchoredPath
p | (AnchoredPath
p, Tree.File Blob IO
_) <- forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
Tree.list Tree IO
tree]
setScriptsExecutablePatches :: PatchInspect p => p wX wY -> IO ()
setScriptsExecutablePatches :: forall (p :: * -> * -> *) wX wY. PatchInspect p => p wX wY -> IO ()
setScriptsExecutablePatches p wX wY
pw = do
[String]
paths <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> AnchoredPath -> String
anchorPath String
".") forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles p wX wY
pw
[String] -> IO ()
setScriptsExecutable_ [String]
paths
setExecutableIfScript :: FilePath -> IO ()
setExecutableIfScript :: String -> IO ()
setExecutableIfScript String
f = do
ByteString
contents <- String -> IO ByteString
B.readFile String
f
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> ByteString
BC.pack String
"#!" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
contents) forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
debugMessage (String
"Making executable: " forall a. [a] -> [a] -> [a]
++ String
f)
String -> Bool -> IO ()
setExecutable String
f Bool
True