{-# LANGUAGE Safe #-}

{-
Copyright (c) 2006-2011 John Goerzen <jgoerzen@complete.org>

All rights reserved.

For license and copyright information, see the file LICENSE
-}

{- |
   Module     : System.Path.WildMatch
   Copyright  : Copyright (C) 2006-2011 John Goerzen
   SPDX-License-Identifier: BSD-3-Clause

   Stability  : stable
   Portability: portable

Matching filenames with wildcards.  See also "System.Path.Glob" for
support for generating lists of files based on wildcards.

Inspired by fnmatch.py, part of the Python standard library.

Written by John Goerzen, jgoerzen\@complete.org

The input wildcard for functions in this module is expected to be in
the standard style of Posix shells.

That is:

>? matches exactly one character
>\* matches zero or more characters
>[list] matches any character in list
>[!list] matches any character not in the list

The returned regular expression will always end in \$ but never begins
with ^, making it suitable for appending to the end of paths.  If you want to
match a given filename directly, you should prepend the ^ character to the
returned value from this function.

Please note:

* Neither the path separator (the slash or backslash) nor the period carry
any special meaning for the functions in this module.  That is, @*@ will
match @\/@ in a filename.  If this is not the behavior you want, you probably
want "System.Path.Glob" instead of this module.

* Unlike the Unix shell, filenames that begin with a period are not ignored
by this module.  That is, @*.txt@ will match @.test.txt@.

* This module does not current permit escaping of special characters.
-}

module System.Path.WildMatch (-- * Wildcard matching
                                wildCheckCase,
                                wildToRegex)
    where

import Data.String.Utils ( escapeRe )
import Text.Regex ( matchRegex, mkRegex )

{- | Convert a wildcard to an (uncompiled) regular expression.

-}
wildToRegex :: String -> String
wildToRegex :: String -> String
wildToRegex String
i = String -> String
convwild String
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$"

{- | Check the given name against the given pattern, being case-sensitive.

The given pattern is forced to match the given name starting at the beginning.
 -}
wildCheckCase :: String         -- ^ The wildcard pattern to use as the base
              -> String         -- ^ The filename to check against it
              -> Bool           -- ^ Result
wildCheckCase :: String -> String -> Bool
wildCheckCase String
patt String
name =
    case Regex -> String -> Maybe [String]
matchRegex (String -> Regex
mkRegex (String -> Regex) -> String -> Regex
forall a b. (a -> b) -> a -> b
$ String
"^" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
wildToRegex String
patt) String
name of
      Maybe [String]
Nothing -> Bool
False
      Just [String]
_  -> Bool
True

-- This is SO MUCH CLEANER than the python implementation!
convwild :: String -> String
convwild :: String -> String
convwild []           = []
convwild (Char
'*':String
xs)     = String
".*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
convwild String
xs
convwild (Char
'?':String
xs)     = String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
convwild String
xs
convwild (Char
'[':Char
'!':String
xs) = String
"[^" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
convpat String
xs
convwild (Char
'[':String
xs)     = Char
'[' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
convpat String
xs
convwild (Char
'.':String
xs)     = String
"\\." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
convwild String
xs
convwild (Char
x:String
xs)       = String -> String
escapeRe [Char
x] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
convwild String
xs

convpat :: String -> String
convpat :: String -> String
convpat (Char
'\\':String
xs) = String
"\\\\" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
convpat String
xs
convpat (Char
']':String
xs)  = Char
']' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
convwild String
xs
convpat (Char
x:String
xs)    = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
convpat String
xs
convpat []        = []