{-# LANGUAGE NamedFieldPuns #-}
module Darcs.UI.Completion
( fileArgs, knownFileArgs, unknownFileArgs, modifiedFileArgs
, noArgs, prefArgs
) where
import Darcs.Prelude
import Data.List ( (\\), stripPrefix )
import Data.List.Ordered ( nubSort, minus )
import Data.Maybe ( mapMaybe )
import Darcs.Patch ( listTouchedFiles )
import Darcs.Repository.Flags
( UseCache(..)
)
import Darcs.Repository.Prefs
( getPreflist
)
import Darcs.Repository.Job
( RepoJob(..)
, withRepository
)
import Darcs.Repository.State
( readRecordedAndPending
, readUnrecordedFiltered
, unrecordedChanges
, restrictDarcsdir
, applyTreeFilter
, TreeFilter(..)
)
import Darcs.UI.Flags ( DarcsFlag )
import qualified Darcs.UI.Flags as Flags
import qualified Darcs.UI.Options.All as O
import Darcs.Util.File
( doesDirectoryReallyExist
)
import Darcs.Util.Global
( darcsdir
)
import Darcs.Util.Path
( AnchoredPath, anchorPath
, AbsolutePath, toPath, floatSubPath, makeSubPathOf
)
import Darcs.Util.Tree as Tree
( Tree, ItemType(..)
, expand, expandPath, list, findTree, itemType, emptyTree
)
import Darcs.Util.Tree.Plain ( readPlainTree )
fileArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO [FilePath]
fileArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
fileArgs (AbsolutePath
_, AbsolutePath
orig) [DarcsFlag]
_flags [String]
args =
[String] -> IO [String] -> IO [String]
notYetListed [String]
args forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map (AnchoredPath, ItemType) -> String
anchoredToFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Tree m -> [(AnchoredPath, ItemType)]
listItems) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
Tree.expand forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
TreeFilter m
-> forall (tr :: (* -> *) -> *). FilterTree tr m => tr m -> tr m
applyTreeFilter forall (m :: * -> *). TreeFilter m
restrictDarcsdir forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO (Tree IO)
readPlainTree (forall a. FilePathOrURL a => a -> String
toPath AbsolutePath
orig)
unknownFileArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO [FilePath]
unknownFileArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
unknownFileArgs (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
flags [String]
args = [String] -> IO [String] -> IO [String]
notYetListed [String]
args forall a b. (a -> b) -> a -> b
$ do
let sk :: ScanKnown
sk = if [DarcsFlag] -> Bool
Flags.includeBoring [DarcsFlag]
flags then ScanKnown
O.ScanBoring else ScanKnown
O.ScanAll
lfm :: LookForMoves
lfm = [DarcsFlag] -> LookForMoves
Flags.lookForMoves [DarcsFlag]
flags
lfr :: LookForReplaces
lfr = [DarcsFlag] -> LookForReplaces
Flags.lookForReplaces [DarcsFlag]
flags
RepoTrees {Tree IO
have :: forall (m :: * -> *). RepoTrees m -> Tree m
have :: Tree IO
have, Tree IO
known :: forall (m :: * -> *). RepoTrees m -> Tree m
known :: Tree IO
known} <- UseIndex
-> ScanKnown
-> LookForMoves
-> LookForReplaces
-> IO (RepoTrees IO)
repoTrees UseIndex
O.UseIndex ScanKnown
sk LookForMoves
lfm LookForReplaces
lfr
[(AnchoredPath, ItemType)]
known_paths <- Tree IO
-> (AbsolutePath, AbsolutePath) -> IO [(AnchoredPath, ItemType)]
listHere Tree IO
known (AbsolutePath, AbsolutePath)
fps
[(AnchoredPath, ItemType)]
have_paths <- Tree IO
-> (AbsolutePath, AbsolutePath) -> IO [(AnchoredPath, ItemType)]
listHere Tree IO
have (AbsolutePath, AbsolutePath)
fps
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (AnchoredPath, ItemType) -> String
anchoredToFilePath forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
nubSort [(AnchoredPath, ItemType)]
have_paths forall a. Ord a => [a] -> [a] -> [a]
`minus` forall a. Ord a => [a] -> [a]
nubSort [(AnchoredPath, ItemType)]
known_paths
knownFileArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO [FilePath]
knownFileArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
knownFileArgs (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
flags [String]
args = [String] -> IO [String] -> IO [String]
notYetListed [String]
args forall a b. (a -> b) -> a -> b
$ do
let (UseIndex
ui, ScanKnown
sk, DiffAlgorithm
_) = [DarcsFlag] -> (UseIndex, ScanKnown, DiffAlgorithm)
Flags.diffingOpts [DarcsFlag]
flags
lfm :: LookForMoves
lfm = [DarcsFlag] -> LookForMoves
Flags.lookForMoves [DarcsFlag]
flags
lfr :: LookForReplaces
lfr = [DarcsFlag] -> LookForReplaces
Flags.lookForReplaces [DarcsFlag]
flags
RepoTrees {Tree IO
known :: Tree IO
known :: forall (m :: * -> *). RepoTrees m -> Tree m
known} <- UseIndex
-> ScanKnown
-> LookForMoves
-> LookForReplaces
-> IO (RepoTrees IO)
repoTrees UseIndex
ui ScanKnown
sk LookForMoves
lfm LookForReplaces
lfr
forall a b. (a -> b) -> [a] -> [b]
map (AnchoredPath, ItemType) -> String
anchoredToFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree IO
-> (AbsolutePath, AbsolutePath) -> IO [(AnchoredPath, ItemType)]
listHere Tree IO
known (AbsolutePath, AbsolutePath)
fps
modifiedFileArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO [FilePath]
modifiedFileArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
modifiedFileArgs (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
flags [String]
args = [String] -> IO [String] -> IO [String]
notYetListed [String]
args forall a b. (a -> b) -> a -> b
$ do
let (UseIndex
ui, ScanKnown
sk, DiffAlgorithm
_) = [DarcsFlag] -> (UseIndex, ScanKnown, DiffAlgorithm)
Flags.diffingOpts [DarcsFlag]
flags
lfm :: LookForMoves
lfm = [DarcsFlag] -> LookForMoves
Flags.lookForMoves [DarcsFlag]
flags
lfr :: LookForReplaces
lfr = [DarcsFlag] -> LookForReplaces
Flags.lookForReplaces [DarcsFlag]
flags
RepoTrees {[AnchoredPath]
new :: forall (m :: * -> *). RepoTrees m -> [AnchoredPath]
new :: [AnchoredPath]
new} <- UseIndex
-> ScanKnown
-> LookForMoves
-> LookForReplaces
-> IO (RepoTrees IO)
repoTrees UseIndex
ui ScanKnown
sk LookForMoves
lfm LookForReplaces
lfr
case forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry AbsolutePath -> AbsolutePath -> Maybe SubPath
makeSubPathOf (AbsolutePath, AbsolutePath)
fps of
Maybe SubPath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Just SubPath
here ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> String -> Maybe String
stripPathPrefix (forall a. FilePathOrURL a => a -> String
toPath SubPath
here)) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> AnchoredPath -> String
anchorPath String
"") [AnchoredPath]
new
prefArgs :: String
-> (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO [String]
prefArgs :: String
-> (AbsolutePath, AbsolutePath)
-> [DarcsFlag]
-> [String]
-> IO [String]
prefArgs String
name (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
_ [String]
_ = String -> IO [String]
getPreflist String
name
noArgs :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO [String]
noArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
noArgs (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
_ [String]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []
data RepoTrees m = RepoTrees
{ forall (m :: * -> *). RepoTrees m -> Tree m
have :: Tree m
, forall (m :: * -> *). RepoTrees m -> Tree m
known :: Tree m
, forall (m :: * -> *). RepoTrees m -> [AnchoredPath]
new :: [AnchoredPath]
}
repoTrees :: O.UseIndex -> O.ScanKnown -> O.LookForMoves -> O.LookForReplaces
-> IO (RepoTrees IO)
repoTrees :: UseIndex
-> ScanKnown
-> LookForMoves
-> LookForReplaces
-> IO (RepoTrees IO)
repoTrees UseIndex
ui ScanKnown
sk LookForMoves
lfm LookForReplaces
lfr = do
Bool
inDarcsRepo <- String -> IO Bool
doesDirectoryReallyExist String
darcsdir
if Bool
inDarcsRepo then
forall a. UseCache -> RepoJob a -> IO a
withRepository UseCache
NoUseCache forall a b. (a -> b) -> a -> b
$ forall a.
(forall (rt :: RepoType) (p :: * -> * -> *) wR wU.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO a)
-> RepoJob a
RepoJob forall a b. (a -> b) -> a -> b
$ \Repository rt p wR wU wR
r -> do
Tree IO
known <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR -> IO (Tree IO)
readRecordedAndPending Repository rt p wR wU wR
r
Tree IO
have <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wR
-> UseIndex
-> ScanKnown
-> LookForMoves
-> Maybe [AnchoredPath]
-> IO (Tree IO)
readUnrecordedFiltered Repository rt p wR wU wR
r UseIndex
ui ScanKnown
sk LookForMoves
lfm forall a. Maybe a
Nothing
[AnchoredPath]
new <- forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (p :: * -> * -> *) (rt :: RepoType) wR wU.
(RepoPatch p, ApplyState p ~ Tree) =>
(UseIndex, ScanKnown, DiffAlgorithm)
-> LookForMoves
-> LookForReplaces
-> Repository rt p wR wU wR
-> Maybe [AnchoredPath]
-> IO (FL (PrimOf p) wR wU)
unrecordedChanges (UseIndex
ui, ScanKnown
sk, DiffAlgorithm
O.MyersDiff) LookForMoves
lfm LookForReplaces
lfr Repository rt p wR wU wR
r forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ RepoTrees {[AnchoredPath]
Tree IO
new :: [AnchoredPath]
have :: Tree IO
known :: Tree IO
new :: [AnchoredPath]
known :: Tree IO
have :: Tree IO
..}
else
forall (m :: * -> *) a. Monad m => a -> m a
return RepoTrees {have :: Tree IO
have = forall (m :: * -> *). Tree m
emptyTree, known :: Tree IO
known = forall (m :: * -> *). Tree m
emptyTree, new :: [AnchoredPath]
new = []}
subtreeHere :: Tree IO -> (AbsolutePath, AbsolutePath) -> IO (Maybe (Tree IO))
subtreeHere :: Tree IO -> (AbsolutePath, AbsolutePath) -> IO (Maybe (Tree IO))
subtreeHere Tree IO
tree (AbsolutePath, AbsolutePath)
fps =
case SubPath -> AnchoredPath
floatSubPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry AbsolutePath -> AbsolutePath -> Maybe SubPath
makeSubPathOf (AbsolutePath, AbsolutePath)
fps of
Maybe AnchoredPath
Nothing -> do
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just AnchoredPath
here -> do
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (Tree m)
findTree AnchoredPath
here forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Monad m =>
Tree m -> AnchoredPath -> m (Tree m)
expandPath Tree IO
tree AnchoredPath
here
listHere :: Tree IO
-> (AbsolutePath, AbsolutePath)
-> IO [(AnchoredPath, ItemType)]
listHere :: Tree IO
-> (AbsolutePath, AbsolutePath) -> IO [(AnchoredPath, ItemType)]
listHere Tree IO
tree (AbsolutePath, AbsolutePath)
fps = do
Maybe (Tree IO)
msubtree <- Tree IO -> (AbsolutePath, AbsolutePath) -> IO (Maybe (Tree IO))
subtreeHere Tree IO
tree (AbsolutePath, AbsolutePath)
fps
case Maybe (Tree IO)
msubtree of
Maybe (Tree IO)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Just Tree IO
subtree -> forall (m :: * -> *). Tree m -> [(AnchoredPath, ItemType)]
listItems forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
expand Tree IO
subtree
listItems :: Tree m -> [(AnchoredPath, ItemType)]
listItems :: forall (m :: * -> *). Tree m -> [(AnchoredPath, ItemType)]
listItems = forall a b. (a -> b) -> [a] -> [b]
map (\(AnchoredPath
p, TreeItem m
i) -> (AnchoredPath
p, forall (m :: * -> *). TreeItem m -> ItemType
itemType TreeItem m
i)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Tree m -> [(AnchoredPath, TreeItem m)]
Tree.list
anchoredToFilePath :: (AnchoredPath, ItemType) -> [Char]
anchoredToFilePath :: (AnchoredPath, ItemType) -> String
anchoredToFilePath (AnchoredPath
path, ItemType
TreeType) = String -> AnchoredPath -> String
anchorPath String
"" AnchoredPath
path
anchoredToFilePath (AnchoredPath
path, ItemType
BlobType) = String -> AnchoredPath -> String
anchorPath String
"" AnchoredPath
path
stripPathPrefix :: FilePath -> FilePath -> Maybe FilePath
stripPathPrefix :: String -> String -> Maybe String
stripPathPrefix = forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
addSlash where
addSlash :: String -> String
addSlash [] = []
addSlash String
xs = String
xs forall a. [a] -> [a] -> [a]
++ String
"/"
notYetListed :: [String] -> IO [String] -> IO [String]
notYetListed :: [String] -> IO [String] -> IO [String]
notYetListed [String]
already IO [String]
complete = do
[String]
possible <- IO [String]
complete
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String]
possible forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
already