--  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.UI.Commands.Util.Tree
    ( 
    -- * Tree lookup.
      treeHas
    , treeHasDir
    , treeHasFile
    , treeHasAnycase
    ) where

import Prelude ()
import Darcs.Prelude

import Control.Monad ( forM )
import Control.Monad.State.Strict( gets )
import Data.Maybe ( fromMaybe )

import qualified Darcs.Util.Tree.Monad as TM
    ( TreeMonad, withDirectory, fileExists, directoryExists
    , virtualTreeMonad, currentDirectory, exists, tree )
import Darcs.Util.Tree ( Tree, listImmediate, findTree )

import Darcs.Util.Path
    ( AnchoredPath(..), floatPath, eqAnycase )

treeHasAnycase :: Monad m
               => Tree m
               -> FilePath
               -> m Bool
treeHasAnycase :: Tree m -> FilePath -> m Bool
treeHasAnycase tree :: Tree m
tree path :: FilePath
path =
    (Bool, Tree m) -> Bool
forall a b. (a, b) -> a
fst ((Bool, Tree m) -> Bool) -> m (Bool, Tree m) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` TreeMonad m Bool -> Tree m -> m (Bool, Tree m)
forall (m :: * -> *) a.
Monad m =>
TreeMonad m a -> Tree m -> m (a, Tree m)
TM.virtualTreeMonad (AnchoredPath -> TreeMonad m Bool
forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m Bool
existsAnycase (AnchoredPath -> TreeMonad m Bool)
-> AnchoredPath -> TreeMonad m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> AnchoredPath
floatPath FilePath
path) Tree m
tree


existsAnycase :: Monad m
              => AnchoredPath
              -> TM.TreeMonad m Bool
existsAnycase :: AnchoredPath -> TreeMonad m Bool
existsAnycase (AnchoredPath []) = Bool -> TreeMonad m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
existsAnycase (AnchoredPath (x :: Name
x:xs :: [Name]
xs)) = do
     AnchoredPath
wd <- RWST AnchoredPath () (TreeState m) m AnchoredPath
forall (m :: * -> *). TreeRO m => m AnchoredPath
TM.currentDirectory
     Tree m
tree <- Tree m -> Maybe (Tree m) -> Tree m
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Tree m
forall a. FilePath -> a
bug "invalid path passed to existsAnycase") (Maybe (Tree m) -> Tree m)
-> RWST AnchoredPath () (TreeState m) m (Maybe (Tree m))
-> RWST AnchoredPath () (TreeState m) m (Tree m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             (TreeState m -> Maybe (Tree m))
-> RWST AnchoredPath () (TreeState m) m (Maybe (Tree m))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Tree m -> AnchoredPath -> Maybe (Tree m))
-> AnchoredPath -> Tree m -> Maybe (Tree m)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tree m -> AnchoredPath -> Maybe (Tree m)
forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (Tree m)
findTree AnchoredPath
wd (Tree m -> Maybe (Tree m))
-> (TreeState m -> Tree m) -> TreeState m -> Maybe (Tree m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeState m -> Tree m
forall (m :: * -> *). TreeState m -> Tree m
TM.tree)
     let subs :: [AnchoredPath]
subs = [ [Name] -> AnchoredPath
AnchoredPath [Name
n] | (n :: Name
n, _) <- Tree m -> [(Name, TreeItem m)]
forall (m :: * -> *). Tree m -> [(Name, TreeItem m)]
listImmediate Tree m
tree,
                                          Name -> Name -> Bool
eqAnycase Name
n Name
x ]
     [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool)
-> RWST AnchoredPath () (TreeState m) m [Bool] -> TreeMonad m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [AnchoredPath]
-> (AnchoredPath -> TreeMonad m Bool)
-> RWST AnchoredPath () (TreeState m) m [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [AnchoredPath]
subs (\path :: AnchoredPath
path -> do
       Bool
file <- AnchoredPath -> TreeMonad m Bool
forall (m :: * -> *). TreeRO m => AnchoredPath -> m Bool
TM.fileExists AnchoredPath
path
       if Bool
file then Bool -> TreeMonad m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
               else AnchoredPath -> TreeMonad m Bool -> TreeMonad m Bool
forall (m :: * -> *) a. TreeRO m => AnchoredPath -> m a -> m a
TM.withDirectory AnchoredPath
path (AnchoredPath -> TreeMonad m Bool
forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m Bool
existsAnycase (AnchoredPath -> TreeMonad m Bool)
-> AnchoredPath -> TreeMonad m Bool
forall a b. (a -> b) -> a -> b
$ [Name] -> AnchoredPath
AnchoredPath [Name]
xs))


treeHas :: Monad m => Tree m -> FilePath -> m Bool
treeHas :: Tree m -> FilePath -> m Bool
treeHas tree :: Tree m
tree path :: FilePath
path = (Bool, Tree m) -> Bool
forall a b. (a, b) -> a
fst ((Bool, Tree m) -> Bool) -> m (Bool, Tree m) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` TreeMonad m Bool -> Tree m -> m (Bool, Tree m)
forall (m :: * -> *) a.
Monad m =>
TreeMonad m a -> Tree m -> m (a, Tree m)
TM.virtualTreeMonad (AnchoredPath -> TreeMonad m Bool
forall (m :: * -> *). TreeRO m => AnchoredPath -> m Bool
TM.exists (AnchoredPath -> TreeMonad m Bool)
-> AnchoredPath -> TreeMonad m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> AnchoredPath
floatPath FilePath
path) Tree m
tree

treeHasDir :: Monad m => Tree m -> FilePath -> m Bool
treeHasDir :: Tree m -> FilePath -> m Bool
treeHasDir tree :: Tree m
tree path :: FilePath
path = (Bool, Tree m) -> Bool
forall a b. (a, b) -> a
fst ((Bool, Tree m) -> Bool) -> m (Bool, Tree m) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` TreeMonad m Bool -> Tree m -> m (Bool, Tree m)
forall (m :: * -> *) a.
Monad m =>
TreeMonad m a -> Tree m -> m (a, Tree m)
TM.virtualTreeMonad (AnchoredPath -> TreeMonad m Bool
forall (m :: * -> *). TreeRO m => AnchoredPath -> m Bool
TM.directoryExists (AnchoredPath -> TreeMonad m Bool)
-> AnchoredPath -> TreeMonad m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> AnchoredPath
floatPath FilePath
path) Tree m
tree

treeHasFile :: Monad m => Tree m -> FilePath -> m Bool
treeHasFile :: Tree m -> FilePath -> m Bool
treeHasFile tree :: Tree m
tree path :: FilePath
path = (Bool, Tree m) -> Bool
forall a b. (a, b) -> a
fst ((Bool, Tree m) -> Bool) -> m (Bool, Tree m) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` TreeMonad m Bool -> Tree m -> m (Bool, Tree m)
forall (m :: * -> *) a.
Monad m =>
TreeMonad m a -> Tree m -> m (a, Tree m)
TM.virtualTreeMonad (AnchoredPath -> TreeMonad m Bool
forall (m :: * -> *). TreeRO m => AnchoredPath -> m Bool
TM.fileExists (AnchoredPath -> TreeMonad m Bool)
-> AnchoredPath -> TreeMonad m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> AnchoredPath
floatPath FilePath
path) Tree m
tree