module Darcs.Repository.Working
( applyToWorking
, setScriptsExecutable
, setScriptsExecutablePatches
) where
import Control.Monad ( when, unless, filterM )
import System.Directory ( doesFileExist )
import qualified Data.ByteString as B ( readFile
, isPrefixOf
)
import qualified Data.ByteString.Char8 as BC (pack)
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, apply, listTouchedFiles )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Prim ( PrimOf )
import Darcs.Patch.Witnesses.Ordered
( FL(..) )
import Darcs.Patch.Dummy ( DummyPatch )
import Darcs.Patch.Inspect ( PatchInspect )
import Darcs.Repository.Format ( RepoProperty( NoWorkingDir ), formatHas )
import Darcs.Repository.Flags ( Verbosity(..) )
import Darcs.Repository.InternalTypes
( Repository
, repoFormat
, repoLocation
, coerceU )
import Darcs.Repository.ApplyPatches ( runTolerantly, runSilently )
import Darcs.Repository.State ( readWorking )
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 repo verb patch =
do
unless (formatHas NoWorkingDir (repoFormat repo)) $
withCurrentDirectory (repoLocation repo) $
if verb == Quiet
then runSilently $ apply patch
else runTolerantly $ apply patch
return $ coerceU repo
setScriptsExecutable_ :: PatchInspect p => Maybe (p wX wY) -> IO ()
setScriptsExecutable_ pw = do
debugMessage "Making scripts executable"
tree <- readWorking
paths <- case pw of
Just ps -> filterM doesFileExist $ listTouchedFiles ps
Nothing -> return [ anchorPath "." p | (p, Tree.File _) <- Tree.list tree ]
let setExecutableIfScript f =
do contents <- B.readFile f
when (BC.pack "#!" `B.isPrefixOf` contents) $ do
debugMessage ("Making executable: " ++ f)
setExecutable f True
mapM_ setExecutableIfScript paths
setScriptsExecutable :: IO ()
setScriptsExecutable = setScriptsExecutable_ (Nothing :: Maybe (FL DummyPatch wX wY))
setScriptsExecutablePatches :: PatchInspect p => p wX wY -> IO ()
setScriptsExecutablePatches = setScriptsExecutable_ . Just