--  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 Darcs.Prelude

import Data.List ( find )

import Darcs.Util.Path ( AnchoredPath(..), eqAnycase )
import Darcs.Util.Tree ( Tree, TreeItem(..), listImmediate )
import qualified Darcs.Util.Tree.Monad as TM
    ( directoryExists
    , exists
    , fileExists
    , virtualTreeMonad
    )

treeHasAnycase :: Monad m
               => Tree m
               -> AnchoredPath
               -> m Bool
treeHasAnycase :: Tree m -> AnchoredPath -> m Bool
treeHasAnycase Tree m
tree (AnchoredPath [Name]
names) = [Name] -> TreeItem m -> m Bool
forall (m :: * -> *). Monad m => [Name] -> TreeItem m -> m Bool
go [Name]
names (Tree m -> TreeItem m
forall (m :: * -> *). Tree m -> TreeItem m
SubTree Tree m
tree)
  where
    go :: [Name] -> TreeItem m -> m Bool
go [] TreeItem m
_ = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    go [Name]
ns (Stub m (Tree m)
mkTree Hash
_) = m (Tree m)
mkTree m (Tree m) -> (Tree m -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Name] -> TreeItem m -> m Bool
go [Name]
ns (TreeItem m -> m Bool)
-> (Tree m -> TreeItem m) -> Tree m -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree m -> TreeItem m
forall (m :: * -> *). Tree m -> TreeItem m
SubTree
    go [Name]
_ (File Blob m
_) = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    go (Name
n:[Name]
ns) (SubTree Tree m
t) =
      case ((Name, TreeItem m) -> Bool)
-> [(Name, TreeItem m)] -> Maybe (Name, TreeItem m)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Name -> Name -> Bool
eqAnycase Name
n (Name -> Bool)
-> ((Name, TreeItem m) -> Name) -> (Name, TreeItem m) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, TreeItem m) -> Name
forall a b. (a, b) -> a
fst) (Tree m -> [(Name, TreeItem m)]
forall (m :: * -> *). Tree m -> [(Name, TreeItem m)]
listImmediate Tree m
t) of
        Maybe (Name, TreeItem m)
Nothing -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Just (Name
_,TreeItem m
i) -> [Name] -> TreeItem m -> m Bool
go [Name]
ns TreeItem m
i

treeHas :: Monad m => Tree m -> AnchoredPath -> m Bool
treeHas :: Tree m -> AnchoredPath -> m Bool
treeHas Tree m
tree AnchoredPath
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
TM.exists AnchoredPath
path) Tree m
tree

treeHasDir :: Monad m => Tree m -> AnchoredPath -> m Bool
treeHasDir :: Tree m -> AnchoredPath -> m Bool
treeHasDir Tree m
tree AnchoredPath
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
TM.directoryExists AnchoredPath
path) Tree m
tree

treeHasFile :: Monad m => Tree m -> AnchoredPath -> m Bool
treeHasFile :: Tree m -> AnchoredPath -> m Bool
treeHasFile Tree m
tree AnchoredPath
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
TM.fileExists AnchoredPath
path) Tree m
tree