module Darcs.Patch.TouchesFiles
( lookTouch
, chooseTouching
, choosePreTouching
, selectTouching
, deselectNotTouching
, selectNotTouching
) where
import Darcs.Prelude
import Prelude ()
import Data.List (isSuffixOf, nub)
import Darcs.Patch.Apply
(Apply, ApplyState, applyToFilePaths, effectOnFilePaths)
import Darcs.Patch.Choices
(PatchChoices, Label, LabelledPatch, patchChoices, label,
getChoices, forceFirsts, forceLasts, unLabel)
import Darcs.Patch.Commute (Commute)
import Darcs.Patch.Inspect (PatchInspect)
import Darcs.Patch.Invert (invert, Invert)
import Darcs.Patch.Witnesses.Ordered
(FL(..), (:>)(..), mapFL_FL, (+>+))
import Darcs.Patch.Witnesses.Sealed (Sealed, seal)
import Darcs.Util.Tree (Tree)
labelTouching
:: (Apply p, PatchInspect p, ApplyState p ~ Tree)
=> Bool -> [FilePath] -> FL (LabelledPatch p) wX wY -> [Label]
labelTouching :: Bool -> [FilePath] -> FL (LabelledPatch p) wX wY -> [Label]
labelTouching _ _ NilFL = []
labelTouching wantTouching :: Bool
wantTouching fs :: [FilePath]
fs (lp :: LabelledPatch p wX wY
lp :>: lps :: FL (LabelledPatch p) wY wY
lps) =
case [FilePath] -> p wX wY -> (Bool, [FilePath])
forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
[FilePath] -> p wX wY -> (Bool, [FilePath])
lookTouchOnlyEffect [FilePath]
fs (LabelledPatch p wX wY -> p wX wY
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> p wX wY
unLabel LabelledPatch p wX wY
lp) of
(doesTouch :: Bool
doesTouch, fs' :: [FilePath]
fs') ->
let rest :: [Label]
rest = Bool -> [FilePath] -> FL (LabelledPatch p) wY wY -> [Label]
forall (p :: * -> * -> *) wX wY.
(Apply p, PatchInspect p, ApplyState p ~ Tree) =>
Bool -> [FilePath] -> FL (LabelledPatch p) wX wY -> [Label]
labelTouching Bool
wantTouching [FilePath]
fs' FL (LabelledPatch p) wY wY
lps
in (if Bool
doesTouch Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
wantTouching
then (LabelledPatch p wX wY -> Label
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> Label
label LabelledPatch p wX wY
lp Label -> [Label] -> [Label]
forall a. a -> [a] -> [a]
:)
else [Label] -> [Label]
forall a. a -> a
id)
[Label]
rest
labelNotTouchingFM
:: (Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree)
=> [FilePath] -> PatchChoices p wX wY -> [Label]
labelNotTouchingFM :: [FilePath] -> PatchChoices p wX wY -> [Label]
labelNotTouchingFM files :: [FilePath]
files pc :: PatchChoices p wX wY
pc =
case PatchChoices p wX wY
-> (:>)
(FL (LabelledPatch p))
(FL (LabelledPatch p) :> FL (LabelledPatch p))
wX
wY
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchChoices p wX wY
-> (:>)
(FL (LabelledPatch p))
(FL (LabelledPatch p) :> FL (LabelledPatch p))
wX
wY
getChoices PatchChoices p wX wY
pc of
fc :: FL (LabelledPatch p) wX wZ
fc :> mc :: FL (LabelledPatch p) wZ wZ
mc :> _ -> Bool -> [FilePath] -> FL (LabelledPatch p) wX wZ -> [Label]
forall (p :: * -> * -> *) wX wY.
(Apply p, PatchInspect p, ApplyState p ~ Tree) =>
Bool -> [FilePath] -> FL (LabelledPatch p) wX wY -> [Label]
labelTouching Bool
False ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
fix [FilePath]
files) (FL (LabelledPatch p) wX wZ
fc FL (LabelledPatch p) wX wZ
-> FL (LabelledPatch p) wZ wZ -> FL (LabelledPatch p) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (LabelledPatch p) wZ wZ
mc)
selectTouching
:: (Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree)
=> Maybe [FilePath] -> PatchChoices p wX wY -> PatchChoices p wX wY
selectTouching :: Maybe [FilePath] -> PatchChoices p wX wY -> PatchChoices p wX wY
selectTouching Nothing pc :: PatchChoices p wX wY
pc = PatchChoices p wX wY
pc
selectTouching (Just files :: [FilePath]
files) pc :: PatchChoices p wX wY
pc = [Label] -> PatchChoices p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wA wB.
Commute p =>
[Label] -> PatchChoices p wA wB -> PatchChoices p wA wB
forceFirsts [Label]
xs PatchChoices p wX wY
pc
where
xs :: [Label]
xs =
case PatchChoices p wX wY
-> (:>)
(FL (LabelledPatch p))
(FL (LabelledPatch p) :> FL (LabelledPatch p))
wX
wY
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchChoices p wX wY
-> (:>)
(FL (LabelledPatch p))
(FL (LabelledPatch p) :> FL (LabelledPatch p))
wX
wY
getChoices PatchChoices p wX wY
pc of
_ :> mc :: FL (LabelledPatch p) wZ wZ
mc :> lc :: FL (LabelledPatch p) wZ wY
lc -> Bool -> [FilePath] -> FL (LabelledPatch p) wZ wY -> [Label]
forall (p :: * -> * -> *) wX wY.
(Apply p, PatchInspect p, ApplyState p ~ Tree) =>
Bool -> [FilePath] -> FL (LabelledPatch p) wX wY -> [Label]
labelTouching Bool
True ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
fix [FilePath]
files) (FL (LabelledPatch p) wZ wZ
mc FL (LabelledPatch p) wZ wZ
-> FL (LabelledPatch p) wZ wY -> FL (LabelledPatch p) wZ wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (LabelledPatch p) wZ wY
lc)
deselectNotTouching
:: (Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree)
=> Maybe [FilePath] -> PatchChoices p wX wY -> PatchChoices p wX wY
deselectNotTouching :: Maybe [FilePath] -> PatchChoices p wX wY -> PatchChoices p wX wY
deselectNotTouching Nothing pc :: PatchChoices p wX wY
pc = PatchChoices p wX wY
pc
deselectNotTouching (Just files :: [FilePath]
files) pc :: PatchChoices p wX wY
pc =
[Label] -> PatchChoices p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wA wB.
Commute p =>
[Label] -> PatchChoices p wA wB -> PatchChoices p wA wB
forceLasts ([FilePath] -> PatchChoices p wX wY -> [Label]
forall (p :: * -> * -> *) wX wY.
(Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree) =>
[FilePath] -> PatchChoices p wX wY -> [Label]
labelNotTouchingFM [FilePath]
files PatchChoices p wX wY
pc) PatchChoices p wX wY
pc
selectNotTouching
:: (Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree)
=> Maybe [FilePath] -> PatchChoices p wX wY -> PatchChoices p wX wY
selectNotTouching :: Maybe [FilePath] -> PatchChoices p wX wY -> PatchChoices p wX wY
selectNotTouching Nothing pc :: PatchChoices p wX wY
pc = PatchChoices p wX wY
pc
selectNotTouching (Just files :: [FilePath]
files) pc :: PatchChoices p wX wY
pc = [Label] -> PatchChoices p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wA wB.
Commute p =>
[Label] -> PatchChoices p wA wB -> PatchChoices p wA wB
forceFirsts ([FilePath] -> PatchChoices p wX wY -> [Label]
forall (p :: * -> * -> *) wX wY.
(Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree) =>
[FilePath] -> PatchChoices p wX wY -> [Label]
labelNotTouchingFM [FilePath]
files PatchChoices p wX wY
pc) PatchChoices p wX wY
pc
fix :: FilePath -> FilePath
fix :: FilePath -> FilePath
fix f :: FilePath
f
| "/" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
f = FilePath -> FilePath
fix (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. [a] -> [a]
init FilePath
f
fix "" = "."
fix "." = "."
fix f :: FilePath
f = "./" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f
chooseTouching
:: (Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree)
=> Maybe [FilePath] -> FL p wX wY -> Sealed (FL p wX)
chooseTouching :: Maybe [FilePath] -> FL p wX wY -> Sealed (FL p wX)
chooseTouching Nothing p :: FL p wX wY
p = FL p wX wY -> Sealed (FL p wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal FL p wX wY
p
chooseTouching files :: Maybe [FilePath]
files p :: FL p wX wY
p =
case PatchChoices p wX wY
-> (:>)
(FL (LabelledPatch p))
(FL (LabelledPatch p) :> FL (LabelledPatch p))
wX
wY
forall (p :: * -> * -> *) wX wY.
Commute p =>
PatchChoices p wX wY
-> (:>)
(FL (LabelledPatch p))
(FL (LabelledPatch p) :> FL (LabelledPatch p))
wX
wY
getChoices (PatchChoices p wX wY
-> (:>)
(FL (LabelledPatch p))
(FL (LabelledPatch p) :> FL (LabelledPatch p))
wX
wY)
-> PatchChoices p wX wY
-> (:>)
(FL (LabelledPatch p))
(FL (LabelledPatch p) :> FL (LabelledPatch p))
wX
wY
forall a b. (a -> b) -> a -> b
$ Maybe [FilePath] -> PatchChoices p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wX wY.
(Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree) =>
Maybe [FilePath] -> PatchChoices p wX wY -> PatchChoices p wX wY
selectTouching Maybe [FilePath]
files (PatchChoices p wX wY -> PatchChoices p wX wY)
-> PatchChoices p wX wY -> PatchChoices p wX wY
forall a b. (a -> b) -> a -> b
$ FL p wX wY -> PatchChoices p wX wY
forall (p :: * -> * -> *) wX wY. FL p wX wY -> PatchChoices p wX wY
patchChoices FL p wX wY
p of
fc :: FL (LabelledPatch p) wX wZ
fc :> _ :> _ -> FL p wX wZ -> Sealed (FL p wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (FL p wX wZ -> Sealed (FL p wX)) -> FL p wX wZ -> Sealed (FL p wX)
forall a b. (a -> b) -> a -> b
$ (forall wW wY. LabelledPatch p wW wY -> p wW wY)
-> FL (LabelledPatch p) wX wZ -> FL p wX wZ
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall wW wY. LabelledPatch p wW wY -> p wW wY
forall (p :: * -> * -> *) wX wY. LabelledPatch p wX wY -> p wX wY
unLabel FL (LabelledPatch p) wX wZ
fc
choosePreTouching
:: (Apply p, Commute p, Invert p, PatchInspect p, ApplyState p ~ Tree)
=> Maybe [FilePath] -> FL p wX wY -> Sealed (FL p wX)
choosePreTouching :: Maybe [FilePath] -> FL p wX wY -> Sealed (FL p wX)
choosePreTouching files :: Maybe [FilePath]
files patch :: FL p wX wY
patch = Maybe [FilePath] -> FL p wX wY -> Sealed (FL p wX)
forall (p :: * -> * -> *) wX wY.
(Apply p, Commute p, PatchInspect p, ApplyState p ~ Tree) =>
Maybe [FilePath] -> FL p wX wY -> Sealed (FL p wX)
chooseTouching Maybe [FilePath]
filesBeforePatch FL p wX wY
patch
where
filesBeforePatch :: Maybe [FilePath]
filesBeforePatch = FL p wY wX -> [FilePath] -> [FilePath]
forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY -> [FilePath] -> [FilePath]
effectOnFilePaths (FL p wX wY -> FL p wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL p wX wY
patch) ([FilePath] -> [FilePath]) -> Maybe [FilePath] -> Maybe [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [FilePath]
files
lookTouchOnlyEffect
:: (Apply p, ApplyState p ~ Tree)
=> [FilePath] -> p wX wY -> (Bool, [FilePath])
lookTouchOnlyEffect :: [FilePath] -> p wX wY -> (Bool, [FilePath])
lookTouchOnlyEffect fs :: [FilePath]
fs p :: p wX wY
p = (Bool
wasTouched, [FilePath]
fs')
where
(wasTouched :: Bool
wasTouched, _, fs' :: [FilePath]
fs', _) = Maybe [(FilePath, FilePath)]
-> [FilePath]
-> p wX wY
-> (Bool, [FilePath], [FilePath], [(FilePath, FilePath)])
forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
Maybe [(FilePath, FilePath)]
-> [FilePath]
-> p wX wY
-> (Bool, [FilePath], [FilePath], [(FilePath, FilePath)])
lookTouch Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing [FilePath]
fs p wX wY
p
lookTouch
:: (Apply p, ApplyState p ~ Tree)
=> Maybe [(FilePath, FilePath)]
-> [FilePath]
-> p wX wY
-> (Bool, [FilePath], [FilePath], [(FilePath, FilePath)])
lookTouch :: Maybe [(FilePath, FilePath)]
-> [FilePath]
-> p wX wY
-> (Bool, [FilePath], [FilePath], [(FilePath, FilePath)])
lookTouch renames :: Maybe [(FilePath, FilePath)]
renames fs :: [FilePath]
fs p :: p wX wY
p = (Bool
anyTouched, [FilePath]
touchedFs, [FilePath]
fs', [(FilePath, FilePath)]
renames')
where
touchedFs :: [FilePath]
touchedFs = [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> [FilePath]
fsAffectedBy ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
affected
fsAffectedBy :: FilePath -> [FilePath]
fsAffectedBy af :: FilePath
af = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
affectedBy FilePath
af) [FilePath]
fs
anyTouched :: Bool
anyTouched = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
touchedFs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
affectedBy :: FilePath -> FilePath -> Bool
touched :: FilePath
touched affectedBy :: FilePath -> FilePath -> Bool
`affectedBy` f :: FilePath
f =
FilePath
touched FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
f Bool -> Bool -> Bool
|| FilePath
touched FilePath -> FilePath -> Bool
`isSubPathOf` FilePath
f Bool -> Bool -> Bool
|| FilePath
f FilePath -> FilePath -> Bool
`isSubPathOf` FilePath
touched
isSubPathOf :: FilePath -> FilePath -> Bool
path :: FilePath
path isSubPathOf :: FilePath -> FilePath -> Bool
`isSubPathOf` parent :: FilePath
parent =
case Int -> FilePath -> (FilePath, FilePath)
forall a. Int -> [a] -> ([a], [a])
splitAt (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
parent) FilePath
path of
(path' :: FilePath
path', '/':_) -> FilePath
path' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
parent
_ -> Bool
False
(affected :: [FilePath]
affected, fs' :: [FilePath]
fs', renames' :: [(FilePath, FilePath)]
renames') = p wX wY
-> Maybe [(FilePath, FilePath)]
-> [FilePath]
-> ([FilePath], [FilePath], [(FilePath, FilePath)])
forall (p :: * -> * -> *) wX wY.
(Apply p, ApplyState p ~ Tree) =>
p wX wY
-> Maybe [(FilePath, FilePath)]
-> [FilePath]
-> ([FilePath], [FilePath], [(FilePath, FilePath)])
applyToFilePaths p wX wY
p Maybe [(FilePath, FilePath)]
renames [FilePath]
fs