module System.FilePath.Glob.Compile
( compile, tryCompile
, tokenize
) where
import Control.Monad.Error ()
import Data.Char (isDigit)
import System.FilePath (isPathSeparator, isExtSeparator)
import System.FilePath.Glob.Base
import System.FilePath.Glob.Optimize (optimize)
import System.FilePath.Glob.Utils (dropLeadingZeroes)
compile :: String -> Pattern
compile = either error id . tryCompile
tryCompile :: String -> Either String Pattern
tryCompile = fmap optimize . tokenize
tokenize :: String -> Either String Pattern
tokenize = fmap Pattern . sequence . go
where
err s = [Left s]
go :: String -> [Either String Token]
go [] = []
go ('?':cs) = Right NonPathSeparator : go cs
go ('*':cs) =
case cs of
'*':p:xs | isPathSeparator p -> Right AnyDirectory : go xs
_ -> Right AnyNonPathSeparator : go cs
go ('[':cs) =
let (range, rest) = break (==']') cs
in if null rest
then err "compile :: unclosed [] in pattern"
else if null range
then let (range', rest') = break (==']') (tail rest)
in if null rest'
then err "compile :: empty [] in pattern"
else charRange (']':range') : go (tail rest')
else charRange range : go (tail rest)
go ('<':cs) =
let (range, rest) = break (=='>') cs
in if null rest
then err "compile :: unclosed <> in pattern"
else openRange range : go (tail rest)
go (c:cs)
| isPathSeparator c = Right PathSeparator : go cs
| isExtSeparator c = Right ExtSeparator : go cs
| otherwise = Right (Literal c) : go cs
openRange :: String -> Either String Token
openRange ['-'] = Right $ OpenRange Nothing Nothing
openRange ('-':s) =
case span isDigit s of
(b,"") -> Right $ OpenRange Nothing (openRangeNum b)
_ -> Left $ "compile :: bad <>, expected number, got " ++ s
openRange s =
case span isDigit s of
(a,"-") -> Right $ OpenRange (openRangeNum a) Nothing
(a,'-':s') ->
case span isDigit s' of
(b,"") -> Right $ OpenRange (openRangeNum a) (openRangeNum b)
_ -> Left $ "compile :: bad <>, expected number, got " ++ s'
_ -> Left $ "compile :: bad <>, expected number followed by - in " ++ s
openRangeNum :: String -> Maybe String
openRangeNum = Just . dropLeadingZeroes
charRange :: String -> Either String Token
charRange [x] | x `elem` "^!" = Left ("compile :: empty [" ++ [x]
++ "] in pattern")
charRange x =
if head x `elem` "^!"
then Right . CharRange False . f $ tail x
else Right . CharRange True . f $ x
where
f (']':s) = Left ']' : go s
f s = go s
go [] = []
go (a:'-':b:cs) = (if a == b then Left a else Right (a,b)) : go cs
go (c:cs) = Left c : go cs