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 :: Repository rt p wR wU wT
-> Verbosity
-> FL (PrimOf p) wU wY
-> IO (Repository rt p wR wY wT)
applyToWorking repo :: Repository rt p wR wU wT
repo verb :: Verbosity
verb patch :: FL (PrimOf p) wU wY
patch =
  do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
NoWorkingDir (Repository rt p wR wU wT -> RepoFormat
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> RepoFormat
repoFormat Repository rt p wR wU wT
repo)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> IO () -> IO ()
forall p a. FilePathLike p => p -> IO a -> IO a
withCurrentDirectory (Repository rt p wR wU wT -> String
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
Repository rt p wR wU wT -> String
repoLocation Repository rt p wR wU wT
repo) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        if Verbosity
verb Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Quiet
          then TolerantWrapper SilentIO () -> IO ()
forall a. TolerantWrapper SilentIO a -> IO a
runSilently (TolerantWrapper SilentIO () -> IO ())
-> TolerantWrapper SilentIO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wU wY -> TolerantWrapper SilentIO ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply FL (PrimOf p) wU wY
patch
          else TolerantWrapper TolerantIO () -> IO ()
forall a. TolerantWrapper TolerantIO a -> IO a
runTolerantly (TolerantWrapper TolerantIO () -> IO ())
-> TolerantWrapper TolerantIO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FL (PrimOf p) wU wY -> TolerantWrapper TolerantIO ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply FL (PrimOf p) wU wY
patch
    Repository rt p wR wY wT -> IO (Repository rt p wR wY wT)
forall (m :: * -> *) a. Monad m => a -> m a
return (Repository rt p wR wY wT -> IO (Repository rt p wR wY wT))
-> Repository rt p wR wY wT -> IO (Repository rt p wR wY wT)
forall a b. (a -> b) -> a -> b
$ Repository rt p wR wU wT -> Repository rt p wR wY wT
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT wU'.
Repository rt p wR wU wT -> Repository rt p wR wU' wT
coerceU Repository rt p wR wU wT
repo

-- | Sets scripts in or below the current directory executable.
--   A script is any file that starts with the bytes '#!'.
--   This is used for --set-scripts-executable.
setScriptsExecutable_ :: PatchInspect p => Maybe (p wX wY) -> IO ()
setScriptsExecutable_ :: Maybe (p wX wY) -> IO ()
setScriptsExecutable_ pw :: Maybe (p wX wY)
pw = do
    String -> IO ()
debugMessage "Making scripts executable"
    Tree IO
tree <- IO (Tree IO)
readWorking
    [String]
paths <- case Maybe (p wX wY)
pw of
          Just ps :: p wX wY
ps -> (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ p wX wY -> [String]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [String]
listTouchedFiles p wX wY
ps
          Nothing -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [ String -> AnchoredPath -> String
anchorPath "." AnchoredPath
p | (p :: AnchoredPath
p, Tree.File _) <- Tree IO -> [(AnchoredPath, TreeItem IO)]
forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
Tree.list Tree IO
tree ]
    let setExecutableIfScript :: String -> IO ()
setExecutableIfScript f :: String
f =
              do ByteString
contents <- String -> IO ByteString
B.readFile String
f
                 Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> ByteString
BC.pack "#!" ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
contents) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                   String -> IO ()
debugMessage ("Making executable: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f)
                   String -> Bool -> IO ()
setExecutable String
f Bool
True
    (String -> IO ()) -> [String] -> IO ()
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 = Maybe (FL DummyPatch Any Any) -> IO ()
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
Maybe (p wX wY) -> IO ()
setScriptsExecutable_ (forall a. Maybe a
forall wX wY. Maybe (FL DummyPatch wX wY)
Nothing :: Maybe (FL DummyPatch wX wY))

setScriptsExecutablePatches :: PatchInspect p => p wX wY -> IO ()
setScriptsExecutablePatches :: p wX wY -> IO ()
setScriptsExecutablePatches = Maybe (p wX wY) -> IO ()
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
Maybe (p wX wY) -> IO ()
setScriptsExecutable_ (Maybe (p wX wY) -> IO ())
-> (p wX wY -> Maybe (p wX wY)) -> p wX wY -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p wX wY -> Maybe (p wX wY)
forall a. a -> Maybe a
Just