    {-# 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 :: forall s. StringLike s => s -> GenRegex s
    parseRegex
        = (Char -> Char -> GenRegex s) -> String -> GenRegex s
    forall s.
    StringLike s =>
    (Char -> Char -> GenRegex s) -> String -> GenRegex s
    parseRegex' Char -> Char -> GenRegex s
    forall s. StringLike s => Char -> Char -> GenRegex s
    mkSymRng (String -> GenRegex s) -> (s -> String) -> s -> GenRegex s
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . s -> String
    forall a. StringLike a => a -> String
    toString

    parseRegexNoCase :: StringLike s => s -> GenRegex s
    parseRegexNoCase :: forall s. StringLike s => s -> GenRegex s
    parseRegexNoCase
        = (Char -> Char -> GenRegex s) -> String -> GenRegex s
    forall s.
    StringLike s =>
    (Char -> Char -> GenRegex s) -> String -> GenRegex s
    parseRegex' Char -> Char -> GenRegex s
    forall s. StringLike s => Char -> Char -> GenRegex s
    mkNoCaseSymRng (String -> GenRegex s) -> (s -> String) -> s -> GenRegex s
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . s -> String
    forall a. StringLike a => a -> String
    toString

    parseRegex' :: StringLike s => (Char -> Char -> GenRegex s) -> String -> GenRegex s
    parseRegex' :: forall s.
    StringLike s =>
    (Char -> Char -> GenRegex s) -> String -> GenRegex s
    parseRegex' Char -> Char -> GenRegex s
    mkS
        = (ParseError -> GenRegex s)
    -> (GenRegex s -> GenRegex s)
    -> Either ParseError (GenRegex s)
    -> GenRegex s
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (String -> GenRegex s
    forall s. StringLike s => String -> GenRegex s
    mkZero' (String -> GenRegex s)
    -> (ParseError -> String) -> ParseError -> GenRegex s
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    "syntax error: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String)
    -> (ParseError -> String) -> ParseError -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseError -> String
    forall a. Show a => a -> String
    show) GenRegex s -> GenRegex s
    forall a. a -> a
    id
          (Either ParseError (GenRegex s) -> GenRegex s)
    -> (String -> Either ParseError (GenRegex s))
    -> String
    -> GenRegex s
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          Parsec String () (GenRegex s)
    -> String -> String -> Either ParseError (GenRegex s)
    forall s t a.
    Stream s Identity t =>
    Parsec s () a -> String -> s -> Either ParseError a
    parse ( do
                  r <- (Char -> Char -> GenRegex s) -> Parsec String () (GenRegex s)
    forall s.
    StringLike s =>
    (Char -> Char -> GenRegex s) -> Parser (GenRegex s)
    pattern Char -> Char -> GenRegex s
    mkS
                  eof
                  return r
                ) String
    ""

    -- ------------------------------------------------------------

    pattern  :: StringLike s => (Char -> Char -> GenRegex s) -> Parser (GenRegex s)
    pattern :: forall s.
    StringLike s =>
    (Char -> Char -> GenRegex s) -> Parser (GenRegex s)
    pattern Char -> Char -> GenRegex s
    mkS
        = ParsecT String () Identity (GenRegex s)
    -> ParsecT String () Identity [GenRegex s]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many ParsecT String () Identity (GenRegex s)
    forall {u}. ParsecT String u Identity (GenRegex s)
    part ParsecT String () Identity [GenRegex s]
    -> ([GenRegex s] -> ParsecT String () Identity (GenRegex s))
    -> ParsecT String () Identity (GenRegex s)
    forall a b.
    ParsecT String () Identity a
    -> (a -> ParsecT String () Identity b)
    -> ParsecT String () Identity b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= GenRegex s -> ParsecT String () Identity (GenRegex s)
    forall a. a -> ParsecT String () Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenRegex s -> ParsecT String () Identity (GenRegex s))
    -> ([GenRegex s] -> GenRegex s)
    -> [GenRegex s]
    -> ParsecT String () Identity (GenRegex s)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [GenRegex s] -> GenRegex s
    forall s. [GenRegex s] -> GenRegex s
    mkSeqs
        where
          -- part :: Parser (GenRegex s)
          part :: ParsecT String u Identity (GenRegex s)
    part
              = ( ParsecT String u Identity Char -> ParsecT String u Identity String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many1 (String -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    noneOf String
    "\\?*[{") ParsecT String u Identity String
    -> (String -> ParsecT String u Identity (GenRegex s))
    -> ParsecT String u Identity (GenRegex s)
    forall a b.
    ParsecT String u Identity a
    -> (a -> ParsecT String u Identity b)
    -> ParsecT String u Identity b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= GenRegex s -> ParsecT String u Identity (GenRegex s)
    forall a. a -> ParsecT String u Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenRegex s -> ParsecT String u Identity (GenRegex s))
    -> (String -> GenRegex s)
    -> String
    -> ParsecT String u Identity (GenRegex s)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> GenRegex s
    mkWord' )
                ParsecT String u Identity (GenRegex s)
    -> ParsecT String u Identity (GenRegex s)
    -> ParsecT String u Identity (GenRegex s)
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|>
                ( Char -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '?' ParsecT String u Identity Char
    -> ParsecT String u Identity (GenRegex s)
    -> ParsecT String u Identity (GenRegex s)
    forall a b.
    ParsecT String u Identity a
    -> ParsecT String u Identity b -> ParsecT String u Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> GenRegex s -> ParsecT String u Identity (GenRegex s)
    forall a. a -> ParsecT String u Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return GenRegex s
    forall s. GenRegex s
    mkDot )
                ParsecT String u Identity (GenRegex s)
    -> ParsecT String u Identity (GenRegex s)
    -> ParsecT String u Identity (GenRegex s)
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|>
                ( Char -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '*' ParsecT String u Identity Char
    -> ParsecT String u Identity (GenRegex s)
    -> ParsecT String u Identity (GenRegex s)
    forall a b.
    ParsecT String u Identity a
    -> ParsecT String u Identity b -> ParsecT String u Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> GenRegex s -> ParsecT String u Identity (GenRegex s)
    forall a. a -> ParsecT String u Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return GenRegex s
    forall s. StringLike s => GenRegex s
    mkAll )
                ParsecT String u Identity (GenRegex s)
    -> ParsecT String u Identity (GenRegex s)
    -> ParsecT String u Identity (GenRegex s)
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|>
                ( ParsecT String u Identity Char
    -> ParsecT String u Identity Char
    -> ParsecT String u Identity (GenRegex s)
    -> ParsecT String u Identity (GenRegex s)
    forall s (m :: * -> *) t u open close a.
    Stream s m t =>
    ParsecT s u m open
    -> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
    between (Char -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '{') (Char -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '}') ParsecT String u Identity (GenRegex s)
    forall {u}. ParsecT String u Identity (GenRegex s)
    wordList )
                ParsecT String u Identity (GenRegex s)
    -> ParsecT String u Identity (GenRegex s)
    -> ParsecT String u Identity (GenRegex s)
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|>
                ( ParsecT String u Identity Char
    -> ParsecT String u Identity Char
    -> ParsecT String u Identity (GenRegex s)
    -> ParsecT String u Identity (GenRegex s)
    forall s (m :: * -> *) t u open close a.
    Stream s m t =>
    ParsecT s u m open
    -> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
    between (Char -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '[') (Char -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    ']') ParsecT String u Identity (GenRegex s)
    forall {u}. ParsecT String u Identity (GenRegex s)
    charSet )
                ParsecT String u Identity (GenRegex s)
    -> ParsecT String u Identity (GenRegex s)
    -> ParsecT String u Identity (GenRegex s)
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|>
                ( do c <- Char -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '\\' ParsecT String u Identity Char
    -> ParsecT String u Identity Char -> ParsecT String u Identity Char
    forall a b.
    ParsecT String u Identity a
    -> ParsecT String u Identity b -> ParsecT String u Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ParsecT String u Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    anyChar
                     return $ mkS c c
                )
          mkWord' :: String -> GenRegex s
    mkWord'
              = [GenRegex s] -> GenRegex s
    forall s. [GenRegex s] -> GenRegex s
    mkSeqs ([GenRegex s] -> GenRegex s)
    -> (String -> [GenRegex s]) -> String -> GenRegex s
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> GenRegex s) -> String -> [GenRegex s]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ Char
    c -> Char -> Char -> GenRegex s
    mkS Char
    c Char
    c)

          -- wordList :: Parser (GenRegex s)
          wordList :: ParsecT String u Identity (GenRegex s)
    wordList
              = ParsecT String u Identity String
    -> ParsecT String u Identity Char
    -> ParsecT String u Identity [String]
    forall s (m :: * -> *) t u a sep.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
    sepBy (ParsecT String u Identity Char -> ParsecT String u Identity String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many1 (String -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    noneOf String
    ",}")) (Char -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    ',')
                ParsecT String u Identity [String]
    -> ([String] -> ParsecT String u Identity (GenRegex s))
    -> ParsecT String u Identity (GenRegex s)
    forall a b.
    ParsecT String u Identity a
    -> (a -> ParsecT String u Identity b)
    -> ParsecT String u Identity b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= GenRegex s -> ParsecT String u Identity (GenRegex s)
    forall a. a -> ParsecT String u Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenRegex s -> ParsecT String u Identity (GenRegex s))
    -> ([String] -> GenRegex s)
    -> [String]
    -> ParsecT String u Identity (GenRegex s)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GenRegex s -> GenRegex s -> GenRegex s)
    -> GenRegex s -> [GenRegex s] -> GenRegex s
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr GenRegex s -> GenRegex s -> GenRegex s
    forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
    mkAlt (String -> GenRegex s
    forall s. StringLike s => String -> GenRegex s
    mkZero' String
    "") ([GenRegex s] -> GenRegex s)
    -> ([String] -> [GenRegex s]) -> [String] -> GenRegex s
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> GenRegex s) -> [String] -> [GenRegex s]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> GenRegex s
    mkWord'

          -- charSet :: Parser (GenRegex s)
          charSet :: ParsecT String u Identity (GenRegex s)
    charSet
              = ( do p1 <- ParsecT String u Identity Char
    -> ParsecT String u Identity (GenRegex s)
    forall {s} {m :: * -> *} {u}.
    Stream s m Char =>
    ParsecT s u m Char -> ParsecT s u m (GenRegex s)
    charSet' ParsecT String u Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    anyChar
                     ps <- many $ charSet' (noneOf "]")
                     return $ foldr mkAlt (mkZero' "") (p1 : ps)
                )
              where
                charSet' :: ParsecT s u m Char -> ParsecT s u m (GenRegex s)
    charSet' ParsecT s u m Char
    cp
                    = do c1 <- ParsecT s u m Char
    cp
                         c2 <- rest c1
                         return $ mkS c1 c2
                rest :: Char -> ParsecT s u m Char
    rest Char
    c1
                    = Char -> ParsecT s u m Char -> ParsecT s u m Char
    forall s (m :: * -> *) t a u.
    Stream s m t =>
    a -> ParsecT s u m a -> ParsecT s u m a
    option Char
    c1 (Char -> ParsecT s u m Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '-' ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
    forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ParsecT s u m Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    anyChar)

    -- ------------------------------------------------------------

    mkNoCaseSymRng :: StringLike s => Char -> Char -> GenRegex s
    mkNoCaseSymRng :: forall s. StringLike s => Char -> Char -> GenRegex s
    mkNoCaseSymRng Char
    c1 Char
    c2
        | Char -> Bool
    isLower Char
    c1
          Bool -> Bool -> Bool
    &&
          Char -> Bool
    isLower Char
    c2
              = GenRegex s -> GenRegex s -> GenRegex s
    forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
    mkAlt (Char -> Char -> GenRegex s
    forall s. StringLike s => Char -> Char -> GenRegex s
    mkSymRng (Char -> Char
    toUpper Char
    c1) (Char -> Char
    toUpper Char
    c2)) (Char -> Char -> GenRegex s
    forall s. StringLike s => Char -> Char -> GenRegex s
    mkSymRng Char
    c1 Char
    c2)
        | Char -> Bool
    isUpper Char
    c1
          Bool -> Bool -> Bool
    &&
          Char -> Bool
    isUpper Char
    c2
              = GenRegex s -> GenRegex s -> GenRegex s
    forall s. StringLike s => GenRegex s -> GenRegex s -> GenRegex s
    mkAlt (Char -> Char -> GenRegex s
    forall s. StringLike s => Char -> Char -> GenRegex s
    mkSymRng (Char -> Char
    toLower Char
    c1) (Char -> Char
    toLower Char
    c2)) (Char -> Char -> GenRegex s
    forall s. StringLike s => Char -> Char -> GenRegex s
    mkSymRng Char
    c1 Char
    c2)
        | Bool
    otherwise
            = Char -> Char -> GenRegex s
    forall s. StringLike s => Char -> Char -> GenRegex s
    mkSymRng Char
    c1 Char
    c2

    -- ------------------------------------------------------------