{-# OPTIONS_HADDOCK hide #-}

-- | Match Glob patterns by convertng them to Regular Expressions.
-- Code is take from the book of "Real World Haskell".
module Language.Hanspell.Glob (matchGlob, matchGlobs) where

import Text.Regex
import Data.Maybe

-- | Checks if a string matches a glob pattern by converting that glob 
-- pattern to a regular expression and matching using that.
matchGlob :: String -> String -> Bool
matchGlob :: String -> String -> Bool
matchGlob String
glob String
string = Maybe [String] -> Bool
forall a. Maybe a -> Bool
isJust (Regex -> String -> Maybe [String]
matchRegex (String -> Regex
mkRegex (String -> String
globToRegex String
glob)) String
string)

-- | Checks if a string matches any of glob patterns.
matchGlobs :: [String] -> String -> Bool
matchGlobs :: [String] -> String -> Bool
matchGlobs [String]
globs String
string = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
`matchGlob` String
string) [String]
globs

-- Converts a Glob Expression into a Regular Expression, anchor it to the
-- beginning and end of the line
globToRegex :: String -> String
globToRegex :: String -> String
globToRegex String
globex = Char
'^' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
globToRegex' String
globex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$"

-- Finds glob specific characters, and convert them to regex specific
-- characters, escapes regex specific characters and verify that character
-- classes are properly terminated
globToRegex' :: String -> String
globToRegex' :: String -> String
globToRegex' String
""             = String
""
globToRegex' (Char
'*':String
cs)       = String
".*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
globToRegex' String
cs
globToRegex' (Char
'?':String
cs)       = Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
globToRegex' String
cs
globToRegex' (Char
'[':Char
'!':Char
c:String
cs) = String
"[^" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
charClass String
cs
globToRegex' (Char
'[':Char
c:String
cs)     = Char
'[' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
charClass String
cs
globToRegex' (Char
'[':String
_)        = String -> String
forall a. HasCallStack => String -> a
error String
"unterminated character class"
globToRegex' (Char
c:String
cs)         = Char -> String
escape Char
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
globToRegex' String
cs

-- Escapes regex characters.
escape :: Char -> String
escape :: Char -> String
escape Char
c | Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
regexChars = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: [Char
c]
         | Bool
otherwise           = [Char
c]
    where regexChars :: String
regexChars = String
"\\+()^$.{}]"

-- Verifies character classes are terminated.
charClass :: String -> String
charClass :: String -> String
charClass (Char
']':String
cs) = Char
']' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
globToRegex' String
cs
charClass (Char
c:String
cs)   = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
charClass String
cs
charClass []       = String -> String
forall a. HasCallStack => String -> a
error String
"unterminated character class"