-- Copyright (C) 2002-2004 David Roundy
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2, or (at your option)
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; see the file COPYING.  If not, write to
-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-- Boston, MA 02110-1301, USA.

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