\begin{code}
{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE CPP                        #-}
#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
#endif

module Text.RE.Tools.Find
  (
  -- * Find
  -- $tutorial
    FindMethods(..)
  , findMatches_
  , findMatches_'
  -- * IsRegex
  , IsRegex(..)
  , SearchReplace(..)
  , searchReplaceAll
  , searchReplaceFirst
  -- * Replace
  , module Text.RE.Replace
  ) where

import qualified Data.List                      as L
import           Prelude.Compat
import           Text.RE.Replace
import           Text.RE.Tools.IsRegex
\end{code}


\begin{code}
-- | as we don't want the @directory@ and FilePath dependencies
-- we will abstract the three calls we need into this record type
data FindMethods s =
  FindMethods
    { FindMethods s -> s -> IO Bool
doesDirectoryExistDM :: s -> IO Bool    -- ^ doesDirectoryExist from
                                              -- System.Directory
    , FindMethods s -> s -> IO [s]
listDirectoryDM      :: s -> IO [s]     -- ^ either getDirectoryContents
                                              -- or listDirectory from
                                              -- System.Directory
    , FindMethods s -> s -> s -> s
combineDM            :: s -> s -> s     -- ^ </> from System.FilePath
    }
\end{code}


\begin{code}
-- | recursively list all files whose filename matches given RE,
-- sorting the list into ascending order; if the argument path has a
-- trailing '/' then it will be removed
findMatches_ :: IsRegex re s => FindMethods s -> re -> s -> IO [s]
findMatches_ :: FindMethods s -> re -> s -> IO [s]
findMatches_ FindMethods s
fm = FindMethods s
-> ([s] -> [s]) -> (Match s -> Bool) -> re -> s -> IO [s]
forall re s.
IsRegex re s =>
FindMethods s
-> ([s] -> [s]) -> (Match s -> Bool) -> re -> s -> IO [s]
findMatches_' FindMethods s
fm [s] -> [s]
forall a. Ord a => [a] -> [a]
L.sort Match s -> Bool
forall a. Match a -> Bool
matched

-- | recursively list all files whose filename matches given RE,
-- using the given function to determine which matches to accept
findMatches_' :: IsRegex re s
              => FindMethods s         -- ^ the directory and filepath methods
              -> ([s]->[s])            -- ^ result post-processing function
              -> (Match s->Bool)       -- ^ filtering function
              -> re                    -- ^ re to be matched against the leaf filename
              -> s                     -- ^ root directory of the search
              -> IO [s]
findMatches_' :: FindMethods s
-> ([s] -> [s]) -> (Match s -> Bool) -> re -> s -> IO [s]
findMatches_' FindMethods s
fm [s] -> [s]
srt Match s -> Bool
tst re
re s
fp = [s] -> [s]
srt ([s] -> [s]) -> IO [s] -> IO [s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FindMethods s -> (Match s -> Bool) -> re -> s -> s -> IO [s]
forall re s.
IsRegex re s =>
FindMethods s -> (Match s -> Bool) -> re -> s -> s -> IO [s]
find_ FindMethods s
fm Match s -> Bool
tst re
re (String -> s
forall a. Replace a => String -> a
packR String
"") s
fp

find_ :: IsRegex re s
      => FindMethods s
      -> (Match s->Bool)
      -> re
      -> s
      -> s
      -> IO [s]
find_ :: FindMethods s -> (Match s -> Bool) -> re -> s -> s -> IO [s]
find_ fm :: FindMethods s
fm@FindMethods{s -> IO Bool
s -> IO [s]
s -> s -> s
combineDM :: s -> s -> s
listDirectoryDM :: s -> IO [s]
doesDirectoryExistDM :: s -> IO Bool
combineDM :: forall s. FindMethods s -> s -> s -> s
listDirectoryDM :: forall s. FindMethods s -> s -> IO [s]
doesDirectoryExistDM :: forall s. FindMethods s -> s -> IO Bool
..} Match s -> Bool
tst re
re s
fn s
fp = do
  Bool
is_dir <- s -> IO Bool
doesDirectoryExistDM s
fp
  case Bool
is_dir of
    Bool
True  -> do
      [s]
fns <- (s -> Bool) -> [s] -> [s]
forall a. (a -> Bool) -> [a] -> [a]
filter s -> Bool
forall a. Replace a => a -> Bool
ordinary ([s] -> [s]) -> IO [s] -> IO [s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> IO [s]
listDirectoryDM s
fp
      [[s]] -> [s]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[s]] -> [s]) -> IO [[s]] -> IO [s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ((s, s) -> IO [s]) -> [(s, s)] -> IO [[s]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((s -> s -> IO [s]) -> (s, s) -> IO [s]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((s -> s -> IO [s]) -> (s, s) -> IO [s])
-> (s -> s -> IO [s]) -> (s, s) -> IO [s]
forall a b. (a -> b) -> a -> b
$ FindMethods s -> (Match s -> Bool) -> re -> s -> s -> IO [s]
forall re s.
IsRegex re s =>
FindMethods s -> (Match s -> Bool) -> re -> s -> s -> IO [s]
find_ FindMethods s
fm Match s -> Bool
tst re
re) [ (s
fn_,s -> s
abs_path s
fn_) | s
fn_<-[s]
fns ]
    Bool
False -> [s] -> IO [s]
forall (m :: * -> *) a. Monad m => a -> m a
return [ s
fp | s -> Int
forall a. Replace a => a -> Int
lengthR s
fp Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
&& Match s -> Bool
tst (re -> s -> Match s
forall re s. IsRegex re s => re -> s -> Match s
matchOnce re
re s
fn) ]
  where
    abs_path :: s -> s
abs_path s
fn_ = s
fp s -> s -> s
`combineDM` s
fn_
    ordinary :: a -> Bool
ordinary a
fn_ = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a
fn_ a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String -> a
forall a. Replace a => String -> a
packR String
".",String -> a
forall a. Replace a => String -> a
packR String
".."]
\end{code}

\begin{code}
-- $tutorial
-- The Find toolkit traverses directory trees invoking actions for each
-- file that matches a RE.
--
-- See the Regex Tools tutorial at http://re-tutorial-tools.regex.uk
\end{code}