-- File created: 2009-01-30 14:54:14


module System.FilePath.Glob.Simplify (simplify) where

import System.FilePath.Glob.Base (Pattern(..), Token(..), liftP)

-- |Simplifies a 'Pattern' object: removes redundant @\"./\"@, for instance.

-- The resulting 'Pattern' matches the exact same input as the original one,

-- with some differences:

--

-- * The output of 'globDir' will differ: for example, globbing for @\"./\*\"@

--   gives @\"./foo\"@, but after simplification this'll be only @\"foo\"@.

--

-- * Decompiling the simplified 'Pattern' will obviously not give the original.

--

-- * The simplified 'Pattern' is a bit faster to match with and uses less

--   memory, since some redundant data is removed.

--

-- For the last of the above reasons, if you're performance-conscious and not

-- using 'globDir', you should always 'simplify' after calling 'compile'.

simplify :: Pattern -> Pattern
simplify :: Pattern -> Pattern
simplify = ([Token] -> [Token]) -> Pattern -> Pattern
liftP ([Token] -> [Token]
go ([Token] -> [Token]) -> ([Token] -> [Token]) -> [Token] -> [Token]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> [Token]
pre)
 where
   -- ./ at beginning -> nothing (any number of /'s)

   pre :: [Token] -> [Token]
pre (Token
ExtSeparator:Token
PathSeparator:[Token]
xs) = [Token] -> [Token]
pre ((Token -> Bool) -> [Token] -> [Token]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Token -> Bool
isSlash [Token]
xs)
   pre                             [Token]
xs  = [Token]
xs

   go :: [Token] -> [Token]
go [] = []

   -- /./ -> /

   go (Token
PathSeparator:Token
ExtSeparator:xs :: [Token]
xs@(Token
PathSeparator:[Token]
_)) = [Token] -> [Token]
go [Token]
xs

   go (Token
x:[Token]
xs) =
      if Token -> Bool
isSlash Token
x
         then let ([Token]
compressed,[Token]
ys) = (Token -> Bool) -> [Token] -> ([Token], [Token])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Token -> Bool
isSlash [Token]
xs
               in if [Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
compressed
                     then Token
x Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token] -> [Token]
go [Token]
ys
                     else [Token] -> [Token]
go (Token
x Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
ys)
         else Token
x Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token] -> [Token]
go [Token]
xs

   isSlash :: Token -> Bool
isSlash Token
PathSeparator = Bool
True
   isSlash Token
_             = Bool
False