content: {-# LANGUAGE FlexibleContexts #-}
  
  -- ------------------------------------------------------------
  
  {- |
     Copyright  : Copyright (C) 2014- Uwe Schmidt
     License    : MIT
  
     Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
     Stability  : stable
     Portability: portable
  
     csh style Glob Pattern Parser for Regular Expressions
  -}
  
  -- ------------------------------------------------------------
  
  module Text.Regex.Glob.Generic.RegexParser
      ( parseRegex
      , parseRegexNoCase
      )
  where
  
  import           Data.Char                               (isLower, isUpper,
                                                            toLower, toUpper)
  
  import           Text.ParserCombinators.Parsec
  import           Text.Regex.XMLSchema.Generic.Regex
  import           Text.Regex.XMLSchema.Generic.StringLike
  
  -- ------------------------------------------------------------
  
  -- | parse a glob pattern
  
  parseRegex :: StringLike s => s -> GenRegex s
  parseRegex
      = parseRegex' mkSymRng . toString
  
  parseRegexNoCase :: StringLike s => s -> GenRegex s
  parseRegexNoCase
      = parseRegex' mkNoCaseSymRng . toString
  
  parseRegex' :: StringLike s => (Char -> Char -> GenRegex s) -> String -> GenRegex s
  parseRegex' mkS
      = either (mkZero' . ("syntax error: " ++) . show) id
        .
        parse ( do
                r <- pattern mkS
                eof
                return r
              ) ""
  
  -- ------------------------------------------------------------
  
  pattern  :: StringLike s => (Char -> Char -> GenRegex s) -> Parser (GenRegex s)
  pattern mkS
      = many part >>= return . mkSeqs
      where
        -- part :: Parser (GenRegex s)
        part
            = ( many1 (noneOf "\\?*[{") >>= return . mkWord' )
              <|>
              ( char '?' >> return mkDot )
              <|>
              ( char '*' >> return mkAll )
              <|>
              ( between (char '{') (char '}') wordList )
              <|>
              ( between (char '[') (char ']') charSet )
              <|>
              ( do c <- char '\\' >> anyChar
                   return $ mkS c c
              )
        mkWord'
            = mkSeqs . map (\ c -> mkS c c)
  
        -- wordList :: Parser (GenRegex s)
        wordList
            = sepBy (many1 (noneOf ",}")) (char ',')
              >>= return . foldr mkAlt (mkZero' "") . map mkWord'
  
        -- charSet :: Parser (GenRegex s)
        charSet
            = ( do p1 <- charSet' anyChar
                   ps <- many $ charSet' (noneOf "]")
                   return $ foldr mkAlt (mkZero' "") (p1 : ps)
              )
            where
              charSet' cp
                  = do c1 <- cp
                       c2 <- rest c1
                       return $ mkS c1 c2
              rest c1
                  = option c1 (char '-' >> anyChar)
  
  -- ------------------------------------------------------------
  
  mkNoCaseSymRng :: StringLike s => Char -> Char -> GenRegex s
  mkNoCaseSymRng c1 c2
      | isLower c1
        &&
        isLower c2
            = mkAlt (mkSymRng (toUpper c1) (toUpper c2)) (mkSymRng c1 c2)
      | isUpper c1
        &&
        isUpper c2
            = mkAlt (mkSymRng (toLower c1) (toLower c2)) (mkSymRng c1 c2)
      | otherwise
          = mkSymRng c1 c2
  
  -- ------------------------------------------------------------
  