    -- File created: 2008-10-10 13:29:26

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE PatternGuards #-}

    module System.FilePath.Glob.Base
       ( Token(..), Pattern(..)

       , CompOptions(..), MatchOptions(..)
       , compDefault, compPosix, matchDefault, matchPosix

       , decompile

       , compile
       , compileWith, tryCompileWith
       , tokenize -- for tests

       , optimize

       , liftP, tokToLower

       , isLiteral
       ) where

    import Control.Arrow                     (first)
    import Control.Monad.Trans.Class         (lift)
    import Control.Monad.Trans.Except        (ExceptT, runExceptT, throwE)
    import Control.Monad.Trans.Writer.Strict (Writer, runWriter, tell)
    import Control.Exception                 (assert)
    import Data.Char                         (isDigit, isAlpha, toLower)
    import Data.List                         (find, sortBy)
    import Data.List.NonEmpty                (toList)
    import Data.Maybe                        (fromMaybe)
    -- Monoid is re-exported from Prelude as of 4.8.0.0

    #if !MIN_VERSION_base(4,8,0)
    import Data.Monoid                       (Monoid, mappend, mempty, mconcat)
    #endif
    #if MIN_VERSION_base(4,11,0)
    import Data.Semigroup                    (sconcat, stimes)
    #else
    import Data.Semigroup                    (Semigroup, (<>), sconcat, stimes)
    #endif
    import Data.String                       (IsString(fromString))
    import System.FilePath                   ( pathSeparator, extSeparator
                                             , isExtSeparator, isPathSeparator
                                             )

    import System.FilePath.Glob.Utils ( dropLeadingZeroes
                                      , isLeft, fromLeft
                                      , increasingSeq
                                      , addToRange, overlap
                                      )

    #if __GLASGOW_HASKELL__
    import Text.Read (readPrec, lexP, parens, prec, Lexeme(Ident))
    #endif

    data Token
       -- primitives

       = Literal !Char
       | ExtSeparator                              --  .  optimized away to Literal

       | PathSeparator                             --  /

       | NonPathSeparator                          --  ?

       | CharRange !Bool [Either Char (Char,Char)] --  []

       | OpenRange (Maybe String) (Maybe String)   --  <>

       | AnyNonPathSeparator                       --  *

       | AnyDirectory                              --  **/

       -- after optimization only

       | LongLiteral !Int String
       | Unmatchable  -- [/], or [.] at the beginning or after a path separator

       deriving (Token -> Token -> Bool
    (Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Token -> Token -> Bool
    == :: Token -> Token -> Bool
    $c/= :: Token -> Token -> Bool
    /= :: Token -> Token -> Bool
    Eq)

    -- Note: CharRanges aren't converted, because this is tricky in general.

    -- Consider for instance [@-[], which includes the range A-Z. This would need

    -- to become [@[a-z]: so essentially we'd need to either:

    --

    --    1) Have a list of ranges of uppercase Unicode. Check if our range

    --       overlaps with any of them and if it does, take the non-overlapping

    --       part and combine it with the toLower of the overlapping part.

    --

    --    2) Simply expand the entire range to a list and map toLower over it.

    --

    -- In either case we'd need to re-optimize the CharRange—we can't assume that

    -- if the uppercase characters are consecutive, so are the lowercase.

    --

    -- 1) might be feasible if someone bothered to get the latest data.

    --

    -- 2) obviously isn't since you might have 'Right (minBound, maxBound)' in

    -- there somewhere.

    --

    -- The current solution is to just check both the toUpper of the character and

    -- the toLower.

    tokToLower :: Token -> Token
    tokToLower :: Token -> Token
    tokToLower (Literal     Char
    c)   = Char -> Token
    Literal       (Char -> Char
    toLower Char
    c)
    tokToLower (LongLiteral Int
    n String
    s) = Int -> String -> Token
    LongLiteral Int
    n ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    s)
    tokToLower Token
    tok               = Token
    tok

    -- |An abstract data type representing a compiled pattern.

    --

    -- Note that the 'Eq' instance cannot tell you whether two patterns behave in

    -- the same way; only whether they compile to the same 'Pattern'. For instance,

    -- @'compile' \"x\"@ and @'compile' \"[x]\"@ may or may not compare equal,

    -- though a @'match'@ will behave the exact same way no matter which 'Pattern'

    -- is used.

    newtype Pattern = Pattern { Pattern -> [Token]
    unPattern :: [Token] } deriving (Pattern -> Pattern -> Bool
    (Pattern -> Pattern -> Bool)
    -> (Pattern -> Pattern -> Bool) -> Eq Pattern
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Pattern -> Pattern -> Bool
    == :: Pattern -> Pattern -> Bool
    $c/= :: Pattern -> Pattern -> Bool
    /= :: Pattern -> Pattern -> Bool
    Eq)

    liftP :: ([Token] -> [Token]) -> Pattern -> Pattern
    liftP :: ([Token] -> [Token]) -> Pattern -> Pattern
    liftP [Token] -> [Token]
    f (Pattern [Token]
    pat) = [Token] -> Pattern
    Pattern ([Token] -> [Token]
    f [Token]
    pat)

    instance Show Token where
       show :: Token -> String
    show (Literal Char
    c)
          | Char
    c Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    "*?[<"     = [Char
    '[',Char
    c,Char
    ']']
          | Bool
    otherwise           = Bool -> String -> String
    forall a. HasCallStack => Bool -> a -> a
    assert (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Char -> Bool
    isPathSeparator Char
    c) [Char
    c]
       show Token
    ExtSeparator        = [ Char
    extSeparator]
       show Token
    PathSeparator       = [Char
    pathSeparator]
       show Token
    NonPathSeparator    = String
    "?"
       show Token
    AnyNonPathSeparator = String
    "*"
       show Token
    AnyDirectory        = String
    "**/"
       show (LongLiteral Int
    _ String
    s)   = (Char -> String) -> String -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Token -> String
    forall a. Show a => a -> String
    show (Token -> String) -> (Char -> Token) -> Char -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Token
    Literal) String
    s
       show (OpenRange Maybe String
    a Maybe String
    b)     =
          Char
    '<' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "" Maybe String
    a String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "" Maybe String
    b String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ">"

       -- We have to be careful here with ^ and ! lest [a!b] become [!ab]. So we

       -- just put them at the end.

       --

       -- Also, [^x-] was sorted and should not become [^-x].

       --

       -- Also, for something like [/!^] or /[.^!] that got optimized to have just ^

       -- and ! we need to add a dummy /.

       show (CharRange Bool
    b CharRange
    r)     =
          let f :: Either Char (Char, Char) -> String
    f = (Char -> String)
    -> ((Char, Char) -> String) -> Either Char (Char, Char) -> String
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Char -> String -> String
    forall a. a -> [a] -> [a]
    :[]) (\(Char
    x,Char
    y) -> [Char
    x,Char
    '-',Char
    y])
              (String
    caret,String
    exclamation,String -> String
    fs) =
                 (Either Char (Char, Char)
     -> (String, String, String -> String)
     -> (String, String, String -> String))
    -> (String, String, String -> String)
    -> CharRange
    -> (String, String, String -> String)
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\Either Char (Char, Char)
    c (String
    ca,String
    ex,String -> String
    ss) ->
                    case Either Char (Char, Char)
    c of
                         Left Char
    '^' -> (String
    "^",String
    ex,String -> String
    ss)
                         Left Char
    '!' -> (String
    ca,String
    "!",String -> String
    ss)
                         Either Char (Char, Char)
    _        -> (String
    ca,  String
    ex,(Either Char (Char, Char) -> String
    f Either Char (Char, Char)
    c String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    ss)
                       )
                       (String
    "", String
    "", String -> String
    forall a. a -> a
    id)
                       CharRange
    r
              (String
    beg,String
    rest) = let s' :: String
    s' = String -> String
    fs []
                               (String
    x,String
    y) = Int -> String -> (String, String)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    1 String
    s'
                               in if Bool -> Bool
    not Bool
    b Bool -> Bool -> Bool
    && String
    x String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "-"
                                     then (String
    y,String
    x)
                                     else (String
    s',String
    "")
           in [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ String
    "["
                     , if Bool
    b then String
    "" else String
    "^"
                     , if Bool
    b Bool -> Bool -> Bool
    && String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    beg Bool -> Bool -> Bool
    && Bool -> Bool
    not (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    caret Bool -> Bool -> Bool
    && String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    exclamation) then String
    "/" else String
    ""
                     , String
    beg, String
    caret, String
    exclamation, String
    rest
                     , String
    "]"
                     ]

       show Token
    Unmatchable = String
    "[.]"

    instance Show Pattern where
       showsPrec :: Int -> Pattern -> String -> String
    showsPrec Int
    d Pattern
    p = Bool -> (String -> String) -> String -> String
    showParen (Int
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    10) ((String -> String) -> String -> String)
    -> (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $
          String -> String -> String
    showString String
    "compile " (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String -> String
    forall a. Show a => Int -> a -> String -> String
    showsPrec (Int
    dInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) (Pattern -> String
    decompile Pattern
    p)

    instance Read Pattern where
    #if __GLASGOW_HASKELL__
       readPrec :: ReadPrec Pattern
    readPrec = ReadPrec Pattern -> ReadPrec Pattern
    forall a. ReadPrec a -> ReadPrec a
    parens (ReadPrec Pattern -> ReadPrec Pattern)
    -> (ReadPrec Pattern -> ReadPrec Pattern)
    -> ReadPrec Pattern
    -> ReadPrec Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ReadPrec Pattern -> ReadPrec Pattern
    forall a. Int -> ReadPrec a -> ReadPrec a
    prec Int
    10 (ReadPrec Pattern -> ReadPrec Pattern)
    -> ReadPrec Pattern -> ReadPrec Pattern
    forall a b. (a -> b) -> a -> b
    $ do
          Ident "compile" <- ReadPrec Lexeme
    lexP
          fmap compile readPrec
    #else
       readsPrec d = readParen (d > 10) $ \r -> do
          ("compile",string) <- lex r
          (xs,rest) <- readsPrec (d+1) string
          [(compile xs, rest)]
    #endif

    instance Semigroup Pattern where
       Pattern [Token]
    a <> :: Pattern -> Pattern -> Pattern
    <> Pattern [Token]
    b = Pattern -> Pattern
    optimize (Pattern -> Pattern) -> Pattern -> Pattern
    forall a b. (a -> b) -> a -> b
    $ [Token] -> Pattern
    Pattern ([Token]
    a [Token] -> [Token] -> [Token]
    forall a. Semigroup a => a -> a -> a
    <> [Token]
    b)
       sconcat :: NonEmpty Pattern -> Pattern
    sconcat = Pattern -> Pattern
    optimize (Pattern -> Pattern)
    -> (NonEmpty Pattern -> Pattern) -> NonEmpty Pattern -> Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Token] -> Pattern
    Pattern ([Token] -> Pattern)
    -> (NonEmpty Pattern -> [Token]) -> NonEmpty Pattern -> Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Pattern -> [Token]) -> [Pattern] -> [Token]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Pattern -> [Token]
    unPattern ([Pattern] -> [Token])
    -> (NonEmpty Pattern -> [Pattern]) -> NonEmpty Pattern -> [Token]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonEmpty Pattern -> [Pattern]
    forall a. NonEmpty a -> [a]
    toList
       stimes :: forall b. Integral b => b -> Pattern -> Pattern
    stimes b
    n (Pattern [Token]
    a) = Pattern -> Pattern
    optimize (Pattern -> Pattern) -> Pattern -> Pattern
    forall a b. (a -> b) -> a -> b
    $ [Token] -> Pattern
    Pattern (b -> [Token] -> [Token]
    forall b. Integral b => b -> [Token] -> [Token]
    forall a b. (Semigroup a, Integral b) => b -> a -> a
    stimes b
    n [Token]
    a)

    instance Monoid Pattern where
       mempty :: Pattern
    mempty  = [Token] -> Pattern
    Pattern []
       mappend :: Pattern -> Pattern -> Pattern
    mappend = Pattern -> Pattern -> Pattern
    forall a. Semigroup a => a -> a -> a
    (<>)
       mconcat :: [Pattern] -> Pattern
    mconcat = Pattern -> Pattern
    optimize (Pattern -> Pattern)
    -> ([Pattern] -> Pattern) -> [Pattern] -> Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Token] -> Pattern
    Pattern ([Token] -> Pattern)
    -> ([Pattern] -> [Token]) -> [Pattern] -> Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Pattern -> [Token]) -> [Pattern] -> [Token]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Pattern -> [Token]
    unPattern

    instance IsString Pattern where
        fromString :: String -> Pattern
    fromString = String -> Pattern
    compile

    -- |Options which can be passed to the 'tryCompileWith' or 'compileWith'

    -- functions: with these you can selectively toggle certain features at compile

    -- time.

    --

    -- Note that some of these options depend on each other: classes can never

    -- occur if ranges aren't allowed, for instance.

    -- We could presumably put locale information in here, too.

    data CompOptions = CompOptions
        { CompOptions -> Bool
    characterClasses   :: Bool -- ^Allow character classes, @[[:...:]]@.

        , CompOptions -> Bool
    characterRanges    :: Bool -- ^Allow character ranges, @[...]@.

        , CompOptions -> Bool
    numberRanges       :: Bool -- ^Allow open ranges, @\<...>@.

        , CompOptions -> Bool
    wildcards          :: Bool -- ^Allow wildcards, @*@ and @?@.

        , CompOptions -> Bool
    recursiveWildcards :: Bool -- ^Allow recursive wildcards, @**/@.

        , CompOptions -> Bool
    pathSepInRanges    :: Bool
          -- ^Allow path separators in character ranges.

          --

          -- If true, @a[/]b@ never matches anything (since character ranges can't

          -- match path separators); if false and 'errorRecovery' is enabled,

          -- @a[/]b@ matches itself, i.e. a file named @]b@ in the subdirectory

          -- @a[@.

        , CompOptions -> Bool
    errorRecovery      :: Bool
          -- ^If the input is invalid, recover by turning any invalid part into

          -- literals. For instance, with 'characterRanges' enabled, @[abc@ is an

          -- error by default (unclosed character range); with 'errorRecovery', the

          -- @[@ is turned into a literal match, as though 'characterRanges' were

          -- disabled.

        } deriving (Int -> CompOptions -> String -> String
    [CompOptions] -> String -> String
    CompOptions -> String
    (Int -> CompOptions -> String -> String)
    -> (CompOptions -> String)
    -> ([CompOptions] -> String -> String)
    -> Show CompOptions
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> CompOptions -> String -> String
    showsPrec :: Int -> CompOptions -> String -> String
    $cshow :: CompOptions -> String
    show :: CompOptions -> String
    $cshowList :: [CompOptions] -> String -> String
    showList :: [CompOptions] -> String -> String
    Show,ReadPrec [CompOptions]
    ReadPrec CompOptions
    Int -> ReadS CompOptions
    ReadS [CompOptions]
    (Int -> ReadS CompOptions)
    -> ReadS [CompOptions]
    -> ReadPrec CompOptions
    -> ReadPrec [CompOptions]
    -> Read CompOptions
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS CompOptions
    readsPrec :: Int -> ReadS CompOptions
    $creadList :: ReadS [CompOptions]
    readList :: ReadS [CompOptions]
    $creadPrec :: ReadPrec CompOptions
    readPrec :: ReadPrec CompOptions
    $creadListPrec :: ReadPrec [CompOptions]
    readListPrec :: ReadPrec [CompOptions]
    Read,CompOptions -> CompOptions -> Bool
    (CompOptions -> CompOptions -> Bool)
    -> (CompOptions -> CompOptions -> Bool) -> Eq CompOptions
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CompOptions -> CompOptions -> Bool
    == :: CompOptions -> CompOptions -> Bool
    $c/= :: CompOptions -> CompOptions -> Bool
    /= :: CompOptions -> CompOptions -> Bool
    Eq)

    -- |The default set of compilation options: closest to the behaviour of the

    -- @zsh@ shell, with 'errorRecovery' enabled.

    --

    -- All options are enabled.

    compDefault :: CompOptions
    compDefault :: CompOptions
    compDefault = CompOptions
       { characterClasses :: Bool
    characterClasses   = Bool
    True
       , characterRanges :: Bool
    characterRanges    = Bool
    True
       , numberRanges :: Bool
    numberRanges       = Bool
    True
       , wildcards :: Bool
    wildcards          = Bool
    True
       , recursiveWildcards :: Bool
    recursiveWildcards = Bool
    True
       , pathSepInRanges :: Bool
    pathSepInRanges    = Bool
    True
       , errorRecovery :: Bool
    errorRecovery      = Bool
    True
       }

    -- |Options for POSIX-compliance, as described in @man 7 glob@.

    --

    -- 'numberRanges', 'recursiveWildcards', and 'pathSepInRanges' are disabled.

    compPosix :: CompOptions
    compPosix :: CompOptions
    compPosix = CompOptions
       { characterClasses :: Bool
    characterClasses   = Bool
    True
       , characterRanges :: Bool
    characterRanges    = Bool
    True
       , numberRanges :: Bool
    numberRanges       = Bool
    False
       , wildcards :: Bool
    wildcards          = Bool
    True
       , recursiveWildcards :: Bool
    recursiveWildcards = Bool
    False
       , pathSepInRanges :: Bool
    pathSepInRanges    = Bool
    False
       , errorRecovery :: Bool
    errorRecovery      = Bool
    True
       }

    -- |Options which can be passed to the 'matchWith' or 'globDirWith' functions:

    -- with these you can selectively toggle certain features at matching time.

    data MatchOptions = MatchOptions
        { MatchOptions -> Bool
    matchDotsImplicitly :: Bool
          -- ^Allow @*@, @?@, and @**/@ to match @.@ at the beginning of paths.

        , MatchOptions -> Bool
    ignoreCase          :: Bool
          -- ^Case-independent matching.

        , MatchOptions -> Bool
    ignoreDotSlash      :: Bool
          -- ^Treat @./@ as a no-op in both paths and patterns.

          --

          -- (Of course e.g. @../@ means something different and will not be

          -- ignored.)

        }

    -- |The default set of execution options: closest to the behaviour of the @zsh@

    -- shell.

    --

    -- Currently identical to 'matchPosix'.

    matchDefault :: MatchOptions
    matchDefault :: MatchOptions
    matchDefault = MatchOptions
    matchPosix

    -- |Options for POSIX-compliance, as described in @man 7 glob@.

    --

    -- 'ignoreDotSlash' is enabled, the rest are disabled.

    matchPosix :: MatchOptions
    matchPosix :: MatchOptions
    matchPosix = MatchOptions
       { matchDotsImplicitly :: Bool
    matchDotsImplicitly = Bool
    False
       , ignoreCase :: Bool
    ignoreCase          = Bool
    False
       , ignoreDotSlash :: Bool
    ignoreDotSlash      = Bool
    True
       }

    -- |Decompiles a 'Pattern' object into its textual representation: essentially

    -- the inverse of 'compile'.

    --

    -- Note, however, that due to internal optimization, @decompile . compile@ is

    -- not the identity function. Instead, @compile . decompile@ is.

    --

    -- Be careful with 'CompOptions': 'decompile' always produces a 'String' which

    -- can be passed to 'compile' to get back the same 'Pattern'. @compileWith

    -- options . decompile@ is /not/ the identity function unless @options@ is

    -- 'compDefault'.

    decompile :: Pattern -> String
    decompile :: Pattern -> String
    decompile = (Token -> String) -> [Token] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Token -> String
    forall a. Show a => a -> String
    show ([Token] -> String) -> (Pattern -> [Token]) -> Pattern -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Pattern -> [Token]
    unPattern

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

    -- COMPILATION

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

    -- |Compiles a glob pattern from its textual representation into a 'Pattern'

    -- object.

    --

    -- For the most part, a character matches itself. Recognized operators are as

    -- follows:

    --

    -- [@?@]      Matches any character except path separators.

    --

    -- [@*@]      Matches any number of characters except path separators,

    --            including the empty string.

    --

    -- [@[..\]@]  Matches any of the enclosed characters. Ranges of characters can

    --            be specified by separating the endpoints with a @\'-'@. @\'-'@ or

    --            @']'@ can be matched by including them as the first character(s)

    --            in the list. Never matches path separators: @[\/]@ matches

    --            nothing at all. Named character classes can also be matched:

    --            @[:x:]@ within @[]@ specifies the class named @x@, which matches

    --            certain predefined characters. See below for a full list.

    --

    -- [@[^..\]@ or @[!..\]@] Like @[..]@, but matches any character /not/ listed.

    --                        Note that @[^-x]@ is not the inverse of @[-x]@, but

    --                        the range @[^-x]@.

    --

    -- [@\<m-n>@] Matches any integer in the range m to n, inclusive. The range may

    --            be open-ended by leaving out either number: @\"\<->\"@, for

    --            instance, matches any integer.

    --

    -- [@**/@]    Matches any number of characters, including path separators,

    --            excluding the empty string.

    --

    -- Supported character classes:

    --

    -- [@[:alnum:\]@]  Equivalent to @\"0-9A-Za-z\"@.

    --

    -- [@[:alpha:\]@]  Equivalent to @\"A-Za-z\"@.

    --

    -- [@[:blank:\]@]  Equivalent to @\"\\t \"@.

    --

    -- [@[:cntrl:\]@]  Equivalent to @\"\\0-\\x1f\\x7f\"@.

    --

    -- [@[:digit:\]@]  Equivalent to @\"0-9\"@.

    --

    -- [@[:graph:\]@]  Equivalent to @\"!-~\"@.

    --

    -- [@[:lower:\]@]  Equivalent to @\"a-z\"@.

    --

    -- [@[:print:\]@]  Equivalent to @\" -~\"@.

    --

    -- [@[:punct:\]@]  Equivalent to @\"!-\/:-\@[-`{-~\"@.

    --

    -- [@[:space:\]@]  Equivalent to @\"\\t-\\r \"@.

    --

    -- [@[:upper:\]@]  Equivalent to @\"A-Z\"@.

    --

    -- [@[:xdigit:\]@] Equivalent to @\"0-9A-Fa-f\"@.

    --

    -- Note that path separators (typically @\'/\'@) have to be matched explicitly

    -- or using the @**/@ pattern. In addition, extension separators (typically

    -- @\'.\'@) have to be matched explicitly at the beginning of the pattern or

    -- after any path separator.

    --

    -- If a system supports multiple path separators, any one of them will match

    -- any of them. For instance, on Windows, @\'/\'@ will match itself as well as

    -- @\'\\\'@.

    --

    -- Error recovery will be performed: erroneous operators will not be considered

    -- operators, but matched as literal strings. Such operators include:

    --

    -- * An empty @[]@ or @[^]@ or @[!]@

    --

    -- * A @[@ or @\<@ without a matching @]@ or @>@

    --

    -- * A malformed @\<>@: e.g. nonnumeric characters or no hyphen

    --

    -- So, e.g. @[]@ will match the string @\"[]\"@.

    compile :: String -> Pattern
    compile :: String -> Pattern
    compile = CompOptions -> String -> Pattern
    compileWith CompOptions
    compDefault

    -- |Like 'compile', but recognizes operators according to the given

    -- 'CompOptions' instead of the defaults.

    --

    -- If an error occurs and 'errorRecovery' is disabled, 'error' will be called.

    compileWith :: CompOptions -> String -> Pattern
    compileWith :: CompOptions -> String -> Pattern
    compileWith CompOptions
    opts = (String -> Pattern)
    -> (Pattern -> Pattern) -> Either String Pattern -> Pattern
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either String -> Pattern
    forall a. HasCallStack => String -> a
    error Pattern -> Pattern
    forall a. a -> a
    id (Either String Pattern -> Pattern)
    -> (String -> Either String Pattern) -> String -> Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CompOptions -> String -> Either String Pattern
    tryCompileWith CompOptions
    opts

    -- |A safe version of 'compileWith'.

    --

    -- If an error occurs and 'errorRecovery' is disabled, the error message will

    -- be returned in a 'Left'.

    tryCompileWith :: CompOptions -> String -> Either String Pattern
    tryCompileWith :: CompOptions -> String -> Either String Pattern
    tryCompileWith CompOptions
    opts = (Pattern -> Pattern)
    -> Either String Pattern -> Either String Pattern
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Pattern -> Pattern
    optimize (Either String Pattern -> Either String Pattern)
    -> (String -> Either String Pattern)
    -> String
    -> Either String Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CompOptions -> String -> Either String Pattern
    tokenize CompOptions
    opts

    tokenize :: CompOptions -> String -> Either String Pattern
    tokenize :: CompOptions -> String -> Either String Pattern
    tokenize CompOptions
    opts = ([Token] -> Pattern)
    -> Either String [Token] -> Either String Pattern
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Token] -> Pattern
    Pattern (Either String [Token] -> Either String Pattern)
    -> (String -> Either String [Token])
    -> String
    -> Either String Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Either String Token] -> Either String [Token]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence ([Either String Token] -> Either String [Token])
    -> (String -> [Either String Token])
    -> String
    -> Either String [Token]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [Either String Token]
    go
     where
       err :: String -> Char -> String -> [Either String Token]
    err String
    _ Char
    c String
    cs | CompOptions -> Bool
    errorRecovery CompOptions
    opts = Token -> Either String Token
    forall a b. b -> Either a b
    Right (Char -> Token
    Literal Char
    c) Either String Token
    -> [Either String Token] -> [Either String Token]
    forall a. a -> [a] -> [a]
    : String -> [Either String Token]
    go String
    cs
       err String
    s Char
    _ String
    _                       = [String -> Either String Token
    forall a b. a -> Either a b
    Left String
    s]

       go :: String -> [Either String Token]
       go :: String -> [Either String Token]
    go [] = []
       go (Char
    '?':String
    cs) | Bool
    wcs = Token -> Either String Token
    forall a b. b -> Either a b
    Right Token
    NonPathSeparator Either String Token
    -> [Either String Token] -> [Either String Token]
    forall a. a -> [a] -> [a]
    : String -> [Either String Token]
    go String
    cs
       go (Char
    '*':String
    cs) | Bool
    wcs =
          case String
    cs of
               Char
    '*':Char
    p:String
    xs | Bool
    rwcs Bool -> Bool -> Bool
    && Char -> Bool
    isPathSeparator Char
    p
                  -> Token -> Either String Token
    forall a b. b -> Either a b
    Right Token
    AnyDirectory        Either String Token
    -> [Either String Token] -> [Either String Token]
    forall a. a -> [a] -> [a]
    : String -> [Either String Token]
    go String
    xs
               String
    _  -> Token -> Either String Token
    forall a b. b -> Either a b
    Right Token
    AnyNonPathSeparator Either String Token
    -> [Either String Token] -> [Either String Token]
    forall a. a -> [a] -> [a]
    : String -> [Either String Token]
    go String
    cs

       go (Char
    '[':String
    cs) | Bool
    crs = let (Either String Token
    range,String
    rest) = CompOptions -> String -> (Either String Token, String)
    charRange CompOptions
    opts String
    cs
                            in case Either String Token
    range of
                                    Left String
    s -> String -> Char -> String -> [Either String Token]
    err String
    s Char
    '[' String
    cs
                                    Either String Token
    r      -> Either String Token
    r Either String Token
    -> [Either String Token] -> [Either String Token]
    forall a. a -> [a] -> [a]
    : String -> [Either String Token]
    go String
    rest

       go (Char
    '<':String
    cs) | Bool
    ors =
          let (String
    range, String
    rest) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '>') String
    cs
           in if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    rest
                 then String -> Char -> String -> [Either String Token]
    err String
    "compile :: unclosed <> in pattern" Char
    '<' String
    cs
                 else case String -> Either String Token
    openRange String
    range of
                           Left String
    s -> String -> Char -> String -> [Either String Token]
    err String
    s Char
    '<' String
    cs
                           Either String Token
    r      -> Either String Token
    r Either String Token
    -> [Either String Token] -> [Either String Token]
    forall a. a -> [a] -> [a]
    : String -> [Either String Token]
    go (String -> String
    forall a. HasCallStack => [a] -> [a]
    tail String
    rest)
       go (Char
    c:String
    cs)
          | Char -> Bool
    isPathSeparator Char
    c = Token -> Either String Token
    forall a b. b -> Either a b
    Right Token
    PathSeparator Either String Token
    -> [Either String Token] -> [Either String Token]
    forall a. a -> [a] -> [a]
    : String -> [Either String Token]
    go String
    cs
          | Char -> Bool
    isExtSeparator  Char
    c = Token -> Either String Token
    forall a b. b -> Either a b
    Right  Token
    ExtSeparator Either String Token
    -> [Either String Token] -> [Either String Token]
    forall a. a -> [a] -> [a]
    : String -> [Either String Token]
    go String
    cs
          | Bool
    otherwise         = Token -> Either String Token
    forall a b. b -> Either a b
    Right (Char -> Token
    Literal Char
    c)   Either String Token
    -> [Either String Token] -> [Either String Token]
    forall a. a -> [a] -> [a]
    : String -> [Either String Token]
    go String
    cs

       wcs :: Bool
    wcs  = CompOptions -> Bool
    wildcards          CompOptions
    opts
       rwcs :: Bool
    rwcs = CompOptions -> Bool
    recursiveWildcards CompOptions
    opts
       crs :: Bool
    crs  = CompOptions -> Bool
    characterRanges    CompOptions
    opts
       ors :: Bool
    ors  = CompOptions -> Bool
    numberRanges       CompOptions
    opts

    -- <a-b> where a > b can never match anything; this is not considered an error

    openRange :: String -> Either String Token
    openRange :: String -> Either String Token
    openRange [Char
    '-']   = Token -> Either String Token
    forall a b. b -> Either a b
    Right (Token -> Either String Token) -> Token -> Either String Token
    forall a b. (a -> b) -> a -> b
    $ Maybe String -> Maybe String -> Token
    OpenRange Maybe String
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing
    openRange (Char
    '-':String
    s) =
       case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Char -> Bool
    isDigit String
    s of
            (String
    b,String
    "") -> Token -> Either String Token
    forall a b. b -> Either a b
    Right (Token -> Either String Token) -> Token -> Either String Token
    forall a b. (a -> b) -> a -> b
    $ Maybe String -> Maybe String -> Token
    OpenRange Maybe String
    forall a. Maybe a
    Nothing (String -> Maybe String
    openRangeNum String
    b)
            (String, String)
    _      -> String -> Either String Token
    forall a b. a -> Either a b
    Left (String -> Either String Token) -> String -> Either String Token
    forall a b. (a -> b) -> a -> b
    $ String
    "compile :: bad <>, expected number, got " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s
    openRange String
    s =
       case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Char -> Bool
    isDigit String
    s of
            (String
    a,String
    "-")    -> Token -> Either String Token
    forall a b. b -> Either a b
    Right (Token -> Either String Token) -> Token -> Either String Token
    forall a b. (a -> b) -> a -> b
    $ Maybe String -> Maybe String -> Token
    OpenRange (String -> Maybe String
    openRangeNum String
    a) Maybe String
    forall a. Maybe a
    Nothing
            (String
    a,Char
    '-':String
    s') ->
               case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Char -> Bool
    isDigit String
    s' of
                    (String
    b,String
    "") -> Token -> Either String Token
    forall a b. b -> Either a b
    Right (Token -> Either String Token) -> Token -> Either String Token
    forall a b. (a -> b) -> a -> b
    $ Maybe String -> Maybe String -> Token
    OpenRange (String -> Maybe String
    openRangeNum String
    a) (String -> Maybe String
    openRangeNum String
    b)
                    (String, String)
    _ -> String -> Either String Token
    forall a b. a -> Either a b
    Left (String -> Either String Token) -> String -> Either String Token
    forall a b. (a -> b) -> a -> b
    $ String
    "compile :: bad <>, expected number, got " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s'
            (String, String)
    _ -> String -> Either String Token
    forall a b. a -> Either a b
    Left (String -> Either String Token) -> String -> Either String Token
    forall a b. (a -> b) -> a -> b
    $ String
    "compile :: bad <>, expected number followed by - in " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s

    openRangeNum :: String -> Maybe String
    openRangeNum :: String -> Maybe String
    openRangeNum = String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String)
    -> (String -> String) -> String -> Maybe String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    dropLeadingZeroes

    type CharRange = [Either Char (Char,Char)]

    charRange :: CompOptions -> String -> (Either String Token, String)
    charRange :: CompOptions -> String -> (Either String Token, String)
    charRange CompOptions
    opts String
    zs =
       case String
    zs of
            Char
    y:String
    ys | Char
    y Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    "^!" ->
               case String
    ys of
                    -- [!-#] is not the inverse of [-#], it is the range ! through

                    -- #

                    Char
    '-':Char
    ']':String
    xs -> (Token -> Either String Token
    forall a b. b -> Either a b
    Right (Bool -> CharRange -> Token
    CharRange Bool
    False [Char -> Either Char (Char, Char)
    forall a b. a -> Either a b
    Left Char
    '-']), String
    xs)
                    Char
    '-'    :String
    _  -> (Either String CharRange -> Either String Token)
    -> (Either String CharRange, String)
    -> (Either String Token, String)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((CharRange -> Token)
    -> Either String CharRange -> Either String Token
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Bool -> CharRange -> Token
    CharRange Bool
    True )) (String -> (Either String CharRange, String)
    start String
    zs)
                    String
    xs         -> (Either String CharRange -> Either String Token)
    -> (Either String CharRange, String)
    -> (Either String Token, String)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((CharRange -> Token)
    -> Either String CharRange -> Either String Token
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Bool -> CharRange -> Token
    CharRange Bool
    False)) (String -> (Either String CharRange, String)
    start String
    xs)
            String
    _                  -> (Either String CharRange -> Either String Token)
    -> (Either String CharRange, String)
    -> (Either String Token, String)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ((CharRange -> Token)
    -> Either String CharRange -> Either String Token
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Bool -> CharRange -> Token
    CharRange Bool
    True )) (String -> (Either String CharRange, String)
    start String
    zs)
     where
       start :: String -> (Either String CharRange, String)
       start :: String -> (Either String CharRange, String)
    start (Char
    ']':String
    xs) = ExceptT String (Writer CharRange) String
    -> (Either String CharRange, String)
    run (ExceptT String (Writer CharRange) String
     -> (Either String CharRange, String))
    -> ExceptT String (Writer CharRange) String
    -> (Either String CharRange, String)
    forall a b. (a -> b) -> a -> b
    $ Char -> String -> ExceptT String (Writer CharRange) String
    char Char
    ']' String
    xs
       start (Char
    '-':String
    xs) = ExceptT String (Writer CharRange) String
    -> (Either String CharRange, String)
    run (ExceptT String (Writer CharRange) String
     -> (Either String CharRange, String))
    -> ExceptT String (Writer CharRange) String
    -> (Either String CharRange, String)
    forall a b. (a -> b) -> a -> b
    $ Char -> String -> ExceptT String (Writer CharRange) String
    char Char
    '-' String
    xs
       start String
    xs       = ExceptT String (Writer CharRange) String
    -> (Either String CharRange, String)
    run (ExceptT String (Writer CharRange) String
     -> (Either String CharRange, String))
    -> ExceptT String (Writer CharRange) String
    -> (Either String CharRange, String)
    forall a b. (a -> b) -> a -> b
    $ String -> ExceptT String (Writer CharRange) String
    go String
    xs

       run :: ExceptT String (Writer CharRange) String
           -> (Either String CharRange, String)
       run :: ExceptT String (Writer CharRange) String
    -> (Either String CharRange, String)
    run ExceptT String (Writer CharRange) String
    m = case Writer CharRange (Either String String)
    -> (Either String String, CharRange)
    forall w a. Writer w a -> (a, w)
    runWriter(Writer CharRange (Either String String)
     -> (Either String String, CharRange))
    -> (ExceptT String (Writer CharRange) String
        -> Writer CharRange (Either String String))
    -> ExceptT String (Writer CharRange) String
    -> (Either String String, CharRange)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .ExceptT String (Writer CharRange) String
    -> Writer CharRange (Either String String)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT String (Writer CharRange) String
     -> (Either String String, CharRange))
    -> ExceptT String (Writer CharRange) String
    -> (Either String String, CharRange)
    forall a b. (a -> b) -> a -> b
    $ ExceptT String (Writer CharRange) String
    m of
                    (Left   String
    err,  CharRange
    _) -> (String -> Either String CharRange
    forall a b. a -> Either a b
    Left String
    err, [])
                    (Right String
    rest, CharRange
    cs) -> (CharRange -> Either String CharRange
    forall a b. b -> Either a b
    Right CharRange
    cs, String
    rest)

       go :: String -> ExceptT String (Writer CharRange) String
       go :: String -> ExceptT String (Writer CharRange) String
    go (Char
    '[':Char
    ':':String
    xs) | CompOptions -> Bool
    characterClasses CompOptions
    opts = String -> ExceptT String (Writer CharRange) String
    readClass String
    xs
       go (    Char
    ']':String
    xs) = String -> ExceptT String (Writer CharRange) String
    forall a. a -> ExceptT String (Writer CharRange) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    xs
       go (      Char
    c:String
    xs) =
          if Bool -> Bool
    not (CompOptions -> Bool
    pathSepInRanges CompOptions
    opts) Bool -> Bool -> Bool
    && Char -> Bool
    isPathSeparator Char
    c
             then String -> ExceptT String (Writer CharRange) String
    forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
    throwE String
    "compile :: path separator within []"
             else Char -> String -> ExceptT String (Writer CharRange) String
    char Char
    c String
    xs
       go []           = String -> ExceptT String (Writer CharRange) String
    forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
    throwE String
    "compile :: unclosed [] in pattern"

       char :: Char -> String -> ExceptT String (Writer CharRange) String
       char :: Char -> String -> ExceptT String (Writer CharRange) String
    char Char
    c (Char
    '-':Char
    x:String
    xs) =
          if Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ']'
             then CharRange -> ExceptT String (Writer CharRange) ()
    ltell [Char -> Either Char (Char, Char)
    forall a b. a -> Either a b
    Left Char
    c, Char -> Either Char (Char, Char)
    forall a b. a -> Either a b
    Left Char
    '-'] ExceptT String (Writer CharRange) ()
    -> ExceptT String (Writer CharRange) String
    -> ExceptT String (Writer CharRange) String
    forall a b.
    ExceptT String (Writer CharRange) a
    -> ExceptT String (Writer CharRange) b
    -> ExceptT String (Writer CharRange) b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> String -> ExceptT String (Writer CharRange) String
    forall a. a -> ExceptT String (Writer CharRange) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    xs
             else CharRange -> ExceptT String (Writer CharRange) ()
    ltell [(Char, Char) -> Either Char (Char, Char)
    forall a b. b -> Either a b
    Right (Char
    c,Char
    x)]      ExceptT String (Writer CharRange) ()
    -> ExceptT String (Writer CharRange) String
    -> ExceptT String (Writer CharRange) String
    forall a b.
    ExceptT String (Writer CharRange) a
    -> ExceptT String (Writer CharRange) b
    -> ExceptT String (Writer CharRange) b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>     String -> ExceptT String (Writer CharRange) String
    go String
    xs

       char Char
    c String
    xs = CharRange -> ExceptT String (Writer CharRange) ()
    ltell [Char -> Either Char (Char, Char)
    forall a b. a -> Either a b
    Left Char
    c] ExceptT String (Writer CharRange) ()
    -> ExceptT String (Writer CharRange) String
    -> ExceptT String (Writer CharRange) String
    forall a b.
    ExceptT String (Writer CharRange) a
    -> ExceptT String (Writer CharRange) b
    -> ExceptT String (Writer CharRange) b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> String -> ExceptT String (Writer CharRange) String
    go String
    xs

       readClass :: String -> ExceptT String (Writer CharRange) String
       readClass :: String -> ExceptT String (Writer CharRange) String
    readClass String
    xs = let (String
    name,String
    end) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Char -> Bool
    isAlpha String
    xs
                       in case String
    end of
                               Char
    ':':Char
    ']':String
    rest -> String -> ExceptT String (Writer CharRange) ()
    charClass String
    name            ExceptT String (Writer CharRange) ()
    -> ExceptT String (Writer CharRange) String
    -> ExceptT String (Writer CharRange) String
    forall a b.
    ExceptT String (Writer CharRange) a
    -> ExceptT String (Writer CharRange) b
    -> ExceptT String (Writer CharRange) b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> String -> ExceptT String (Writer CharRange) String
    go String
    rest
                               String
    _            -> CharRange -> ExceptT String (Writer CharRange) ()
    ltell [Char -> Either Char (Char, Char)
    forall a b. a -> Either a b
    Left Char
    '[',Char -> Either Char (Char, Char)
    forall a b. a -> Either a b
    Left Char
    ':'] ExceptT String (Writer CharRange) ()
    -> ExceptT String (Writer CharRange) String
    -> ExceptT String (Writer CharRange) String
    forall a b.
    ExceptT String (Writer CharRange) a
    -> ExceptT String (Writer CharRange) b
    -> ExceptT String (Writer CharRange) b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> String -> ExceptT String (Writer CharRange) String
    go String
    xs

       charClass :: String -> ExceptT String (Writer CharRange) ()
       charClass :: String -> ExceptT String (Writer CharRange) ()
    charClass String
    name =
          -- The POSIX classes

          --

          -- TODO: this is ASCII-only, not sure how this should be extended

          --       Unicode, or with a locale as input, or something else?

          case String
    name of
               String
    "alnum"  -> CharRange -> ExceptT String (Writer CharRange) ()
    ltell [Either Char (Char, Char)
    forall {a}. Either a (Char, Char)
    digit,Either Char (Char, Char)
    forall {a}. Either a (Char, Char)
    upper,Either Char (Char, Char)
    forall {a}. Either a (Char, Char)
    lower]
               String
    "alpha"  -> CharRange -> ExceptT String (Writer CharRange) ()
    ltell [Either Char (Char, Char)
    forall {a}. Either a (Char, Char)
    upper,Either Char (Char, Char)
    forall {a}. Either a (Char, Char)
    lower]
               String
    "blank"  -> CharRange -> ExceptT String (Writer CharRange) ()
    ltell CharRange
    forall {b}. [Either Char b]
    blanks
               String
    "cntrl"  -> CharRange -> ExceptT String (Writer CharRange) ()
    ltell [(Char, Char) -> Either Char (Char, Char)
    forall a b. b -> Either a b
    Right (Char
    '\0',Char
    '\x1f'), Char -> Either Char (Char, Char)
    forall a b. a -> Either a b
    Left Char
    '\x7f']
               String
    "digit"  -> CharRange -> ExceptT String (Writer CharRange) ()
    ltell [Either Char (Char, Char)
    forall {a}. Either a (Char, Char)
    digit]
               String
    "graph"  -> CharRange -> ExceptT String (Writer CharRange) ()
    ltell [(Char, Char) -> Either Char (Char, Char)
    forall a b. b -> Either a b
    Right (Char
    '!',Char
    '~')]
               String
    "lower"  -> CharRange -> ExceptT String (Writer CharRange) ()
    ltell [Either Char (Char, Char)
    forall {a}. Either a (Char, Char)
    lower]
               String
    "print"  -> CharRange -> ExceptT String (Writer CharRange) ()
    ltell [(Char, Char) -> Either Char (Char, Char)
    forall a b. b -> Either a b
    Right (Char
    ' ',Char
    '~')]
               String
    "punct"  -> CharRange -> ExceptT String (Writer CharRange) ()
    ltell CharRange
    forall {a}. [Either a (Char, Char)]
    punct
               String
    "space"  -> CharRange -> ExceptT String (Writer CharRange) ()
    ltell CharRange
    spaces
               String
    "upper"  -> CharRange -> ExceptT String (Writer CharRange) ()
    ltell [Either Char (Char, Char)
    forall {a}. Either a (Char, Char)
    upper]
               String
    "xdigit" -> CharRange -> ExceptT String (Writer CharRange) ()
    ltell [Either Char (Char, Char)
    forall {a}. Either a (Char, Char)
    digit, (Char, Char) -> Either Char (Char, Char)
    forall a b. b -> Either a b
    Right (Char
    'A',Char
    'F'), (Char, Char) -> Either Char (Char, Char)
    forall a b. b -> Either a b
    Right (Char
    'a',Char
    'f')]
               String
    _        ->
                  String -> ExceptT String (Writer CharRange) ()
    forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
    throwE (String
    "compile :: unknown character class '" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    nameString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "'")

       digit :: Either a (Char, Char)
    digit  = (Char, Char) -> Either a (Char, Char)
    forall a b. b -> Either a b
    Right (Char
    '0',Char
    '9')
       upper :: Either a (Char, Char)
    upper  = (Char, Char) -> Either a (Char, Char)
    forall a b. b -> Either a b
    Right (Char
    'A',Char
    'Z')
       lower :: Either a (Char, Char)
    lower  = (Char, Char) -> Either a (Char, Char)
    forall a b. b -> Either a b
    Right (Char
    'a',Char
    'z')
       punct :: [Either a (Char, Char)]
    punct  = ((Char, Char) -> Either a (Char, Char))
    -> [(Char, Char)] -> [Either a (Char, Char)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Char, Char) -> Either a (Char, Char)
    forall a b. b -> Either a b
    Right [(Char
    '!',Char
    '/'), (Char
    ':',Char
    '@'), (Char
    '[',Char
    '`'), (Char
    '{',Char
    '~')]
       blanks :: [Either Char b]
    blanks = [Char -> Either Char b
    forall a b. a -> Either a b
    Left Char
    '\t',         Char -> Either Char b
    forall a b. a -> Either a b
    Left Char
    ' ']
       spaces :: CharRange
    spaces = [(Char, Char) -> Either Char (Char, Char)
    forall a b. b -> Either a b
    Right (Char
    '\t',Char
    '\r'), Char -> Either Char (Char, Char)
    forall a b. a -> Either a b
    Left Char
    ' ']

       ltell :: CharRange -> ExceptT String (Writer CharRange) ()
    ltell = WriterT CharRange Identity ()
    -> ExceptT String (Writer CharRange) ()
    forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (WriterT CharRange Identity ()
     -> ExceptT String (Writer CharRange) ())
    -> (CharRange -> WriterT CharRange Identity ())
    -> CharRange
    -> ExceptT String (Writer CharRange) ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CharRange -> WriterT CharRange Identity ()
    forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
    tell

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

    -- OPTIMIZATION

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

    optimize :: Pattern -> Pattern
    optimize :: Pattern -> Pattern
    optimize (Pattern [Token]
    pat) =
       [Token] -> Pattern
    Pattern ([Token] -> Pattern) -> ([Token] -> [Token]) -> [Token] -> Pattern
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Token] -> [Token]
    fin ([Token] -> Pattern) -> [Token] -> Pattern
    forall a b. (a -> b) -> a -> b
    $
          case [Token]
    pat of
             Token
    e : [Token]
    ts | Token
    e Token -> Token -> Bool
    forall a. Eq a => a -> a -> Bool
    == Token
    ExtSeparator Bool -> Bool -> Bool
    || Token
    e Token -> Token -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Token
    Literal Char
    '.' ->
                ([Token] -> [Token]) -> [Token] -> [Token]
    forall {t :: * -> *}.
    Foldable t =>
    (t Token -> [Token]) -> t Token -> [Token]
    checkUnmatchable (Char -> Token
    Literal Char
    '.' Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :) ([Token] -> [Token]
    go [Token]
    ts)
             [Token]
    _ ->
                -- Handle the case where the whole pattern starts with a

                -- now-literalized [.]. LongLiterals haven't been created yet so

                -- checking for Literal suffices.

                case [Token] -> [Token]
    go [Token]
    pat of
                     Literal Char
    '.' : [Token]
    _ -> [Token
    Unmatchable]
                     [Token]
    opat -> ([Token] -> [Token]) -> [Token] -> [Token]
    forall {t :: * -> *}.
    Foldable t =>
    (t Token -> [Token]) -> t Token -> [Token]
    checkUnmatchable [Token] -> [Token]
    forall a. a -> a
    id [Token]
    opat
     where
       fin :: [Token] -> [Token]
    fin [] = []

       -- Literals to LongLiteral

       -- Has to be done here: we can't backtrack in go, but some cases might

       -- result in consecutive Literals being generated.

       -- E.g. "a[b]".

       fin (Token
    x:Token
    y:[Token]
    xs) | Just Char
    x' <- Token -> Maybe Char
    isCharLiteral Token
    x, Just Char
    y' <- Token -> Maybe Char
    isCharLiteral Token
    y =
          let (String
    ls,[Token]
    rest) = (Token -> Maybe Char) -> [Token] -> (String, [Token])
    forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
    spanMaybe Token -> Maybe Char
    isCharLiteral [Token]
    xs
           in [Token] -> [Token]
    fin ([Token] -> [Token]) -> [Token] -> [Token]
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> Token
    LongLiteral (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    ls Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2)
                                ((Char -> String -> String) -> String -> String -> String
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\Char
    a -> (Char
    aChar -> String -> String
    forall a. a -> [a] -> [a]
    :)) [] (Char
    x'Char -> String -> String
    forall a. a -> [a] -> [a]
    :Char
    y'Char -> String -> String
    forall a. a -> [a] -> [a]
    :String
    ls))
                    Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Token]
    rest

       -- concatenate LongLiterals

       -- Has to be done here because LongLiterals are generated above.

       --

       -- So one could say that we have one pass (go) which flattens everything as

       -- much as it can and one pass (fin) which concatenates what it can.

       fin (LongLiteral Int
    l1 String
    s1 : LongLiteral Int
    l2 String
    s2 : [Token]
    xs) =
          [Token] -> [Token]
    fin ([Token] -> [Token]) -> [Token] -> [Token]
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> Token
    LongLiteral (Int
    l1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    l2) (String
    s1String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    s2) Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Token]
    xs

       fin (LongLiteral Int
    l String
    s : Literal Char
    c : [Token]
    xs) =
          [Token] -> [Token]
    fin ([Token] -> [Token]) -> [Token] -> [Token]
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> Token
    LongLiteral (Int
    lInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) (String
    sString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++[Char
    c]) Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Token]
    xs

       fin (LongLiteral Int
    1 String
    s : [Token]
    xs) = Char -> Token
    Literal (String -> Char
    forall a. HasCallStack => [a] -> a
    head String
    s) Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Token] -> [Token]
    fin [Token]
    xs

       fin (Literal Char
    c : LongLiteral Int
    l String
    s : [Token]
    xs) =
          [Token] -> [Token]
    fin ([Token] -> [Token]) -> [Token] -> [Token]
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> Token
    LongLiteral (Int
    lInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) (Char
    cChar -> String -> String
    forall a. a -> [a] -> [a]
    :String
    s) Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Token]
    xs

       fin (Token
    x:[Token]
    xs) = Token
    x Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Token] -> [Token]
    fin [Token]
    xs

       go :: [Token] -> [Token]
    go [] = []

       -- Get rid of ExtSeparators, so that they can hopefully be combined into

       -- LongLiterals later.

       --

       -- /.                      -> fine

       -- . elsewhere             -> fine

       -- /[.]                    -> Unmatchable

       -- [.] at start of pattern -> handled outside 'go'

       go (p :: Token
    p@Token
    PathSeparator : Token
    ExtSeparator : [Token]
    xs) = Token
    p Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : Char -> Token
    Literal Char
    '.' Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Token] -> [Token]
    go [Token]
    xs
       go (Token
    ExtSeparator : [Token]
    xs) = Char -> Token
    Literal Char
    '.' Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Token] -> [Token]
    go [Token]
    xs
       go (p :: Token
    p@Token
    PathSeparator : x :: Token
    x@(CharRange Bool
    _ CharRange
    _) : [Token]
    xs) =
          Token
    p Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : case Bool -> Token -> Token
    optimizeCharRange Bool
    True Token
    x of
                 x' :: Token
    x'@(CharRange Bool
    _ CharRange
    _) -> Token
    x' Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Token] -> [Token]
    go [Token]
    xs
                 Literal Char
    '.'        -> [Token
    Unmatchable]
                 Token
    x'                 -> [Token] -> [Token]
    go (Token
    x'Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :[Token]
    xs)

       go (x :: Token
    x@(CharRange Bool
    _ CharRange
    _) : [Token]
    xs) =
          case Bool -> Token -> Token
    optimizeCharRange Bool
    False Token
    x of
               x' :: Token
    x'@(CharRange Bool
    _ CharRange
    _) -> Token
    x' Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Token] -> [Token]
    go [Token]
    xs
               Token
    x'                 -> [Token] -> [Token]
    go (Token
    x'Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :[Token]
    xs)

       -- Put [0-9] in front of <-> to allow compressing <->[0-9]<->. Handling the

       -- [0-9] first in matching should also be faster in general.

       go (o :: Token
    o@(OpenRange Maybe String
    Nothing Maybe String
    Nothing) : Token
    d : [Token]
    xs) | Token
    d Token -> Token -> Bool
    forall a. Eq a => a -> a -> Bool
    == Token
    anyDigit =
          Token
    d Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Token] -> [Token]
    go (Token
    o Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Token]
    xs)

       go (Token
    x:[Token]
    xs) =
          case ((Token, Int -> [Token]) -> Bool)
    -> [(Token, Int -> [Token])] -> Maybe (Token, Int -> [Token])
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find ((Token -> Token -> Bool
    forall a. Eq a => a -> a -> Bool
    == Token
    x) (Token -> Bool)
    -> ((Token, Int -> [Token]) -> Token)
    -> (Token, Int -> [Token])
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Token, Int -> [Token]) -> Token
    forall a b. (a, b) -> a
    fst) [(Token, Int -> [Token])]
    compressables of
               Just (Token
    _, Int -> [Token]
    f) -> let ([Token]
    compressed,[Token]
    ys) = (Token -> Bool) -> [Token] -> ([Token], [Token])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Token -> Token -> Bool
    forall a. Eq a => a -> a -> Bool
    == Token
    x) [Token]
    xs
                               in if [Token] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Token]
    compressed
                                     then Token
    x Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Token] -> [Token]
    go [Token]
    ys
                                     else Int -> [Token]
    f ([Token] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Token]
    compressed) [Token] -> [Token] -> [Token]
    forall a. [a] -> [a] -> [a]
    ++ [Token] -> [Token]
    go (Token
    x Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Token]
    ys)
               Maybe (Token, Int -> [Token])
    Nothing -> Token
    x Token -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    : [Token] -> [Token]
    go [Token]
    xs

       checkUnmatchable :: (t Token -> [Token]) -> t Token -> [Token]
    checkUnmatchable t Token -> [Token]
    f t Token
    ts = if Token
    Unmatchable Token -> t Token -> Bool
    forall a. Eq a => a -> t a -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` t Token
    ts then [Token
    Unmatchable] else t Token -> [Token]
    f t Token
    ts

       compressables :: [(Token, Int -> [Token])]
    compressables = [ (Token
    AnyNonPathSeparator, [Token] -> Int -> [Token]
    forall a b. a -> b -> a
    const [])
                       , (Token
    AnyDirectory, [Token] -> Int -> [Token]
    forall a b. a -> b -> a
    const [])
                       , (Maybe String -> Maybe String -> Token
    OpenRange Maybe String
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing, \Int
    n -> Int -> Token -> [Token]
    forall a. Int -> a -> [a]
    replicate Int
    n Token
    anyDigit)
                       ]

       isCharLiteral :: Token -> Maybe Char
    isCharLiteral (Literal Char
    x) = Char -> Maybe Char
    forall a. a -> Maybe a
    Just Char
    x
       isCharLiteral Token
    _           = Maybe Char
    forall a. Maybe a
    Nothing

       anyDigit :: Token
    anyDigit = Bool -> CharRange -> Token
    CharRange Bool
    True [(Char, Char) -> Either Char (Char, Char)
    forall a b. b -> Either a b
    Right (Char
    '0', Char
    '9')]

    -- | Like 'span', but let's use a -> Maybe b predicate

    spanMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
    spanMaybe :: forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
    spanMaybe a -> Maybe b
    f = [a] -> ([b], [a])
    go
     where
       go :: [a] -> ([b], [a])
    go xs :: [a]
    xs@[]        = ([], [a]
    xs)
       go xs :: [a]
    xs@(a
    x : [a]
    xs') = case a -> Maybe b
    f a
    x of
          Maybe b
    Nothing -> ([], [a]
    xs)
          Just b
    y  -> let ([b]
    ys, [a]
    zs) = [a] -> ([b], [a])
    go [a]
    xs' in (b
    y b -> [b] -> [b]
    forall a. a -> [a] -> [a]
    : [b]
    ys, [a]
    zs)

    optimizeCharRange :: Bool -> Token -> Token
    optimizeCharRange :: Bool -> Token -> Token
    optimizeCharRange Bool
    precededBySlash (CharRange Bool
    b CharRange
    rs) =
       CharRange -> Token
    fin (CharRange -> Token)
    -> (CharRange -> CharRange) -> CharRange -> Token
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CharRange -> CharRange
    forall {b}. Eq b => [Either Char b] -> [Either Char b]
    stripUnmatchable (CharRange -> CharRange)
    -> (CharRange -> CharRange) -> CharRange -> CharRange
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CharRange -> CharRange
    forall {a}.
    (Ord a, Enum a) =>
    [Either a (a, a)] -> [Either a (a, a)]
    go (CharRange -> CharRange)
    -> (CharRange -> CharRange) -> CharRange -> CharRange
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CharRange -> CharRange
    sortCharRange (CharRange -> Token) -> CharRange -> Token
    forall a b. (a -> b) -> a -> b
    $ CharRange
    rs
     where
       -- [/] is interesting, it actually matches nothing at all

       -- [.] can be Literalized though, just don't make it into an ExtSeparator so

       --     that it doesn't match a leading dot

       fin :: CharRange -> Token
    fin [Left  Char
    c] | Bool
    b = if Char -> Bool
    isPathSeparator Char
    c then Token
    Unmatchable else Char -> Token
    Literal Char
    c
       fin [Right (Char, Char)
    r] | Bool
    b Bool -> Bool -> Bool
    && (Char, Char)
    r (Char, Char) -> (Char, Char) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Char
    forall a. Bounded a => a
    minBound,Char
    forall a. Bounded a => a
    maxBound) = Token
    NonPathSeparator
       fin CharRange
    x = Bool -> CharRange -> Token
    CharRange Bool
    b CharRange
    x

       stripUnmatchable :: [Either Char b] -> [Either Char b]
    stripUnmatchable xs :: [Either Char b]
    xs@(Either Char b
    _:Either Char b
    _:[Either Char b]
    _) | Bool
    b =
          (Either Char b -> Bool) -> [Either Char b] -> [Either Char b]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\Either Char b
    x -> (Bool -> Bool
    not Bool
    precededBySlash Bool -> Bool -> Bool
    || Either Char b
    x Either Char b -> Either Char b -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char -> Either Char b
    forall a b. a -> Either a b
    Left Char
    '.') Bool -> Bool -> Bool
    && Either Char b
    x Either Char b -> Either Char b -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char -> Either Char b
    forall a b. a -> Either a b
    Left Char
    '/') [Either Char b]
    xs
       stripUnmatchable [Either Char b]
    xs = [Either Char b]
    xs

       go :: [Either a (a, a)] -> [Either a (a, a)]
    go [] = []

       go (x :: Either a (a, a)
    x@(Left a
    c) : [Either a (a, a)]
    xs) =
          case [Either a (a, a)]
    xs of
               [] -> [Either a (a, a)
    x]
               y :: Either a (a, a)
    y@(Left a
    d) : [Either a (a, a)]
    ys
                  -- [aaaaa] -> [a]

                  | a
    c a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    d      -> [Either a (a, a)] -> [Either a (a, a)]
    go([Either a (a, a)] -> [Either a (a, a)])
    -> [Either a (a, a)] -> [Either a (a, a)]
    forall a b. (a -> b) -> a -> b
    $ a -> Either a (a, a)
    forall a b. a -> Either a b
    Left a
    c Either a (a, a) -> [Either a (a, a)] -> [Either a (a, a)]
    forall a. a -> [a] -> [a]
    : [Either a (a, a)]
    ys
                  | a
    d a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a -> a
    forall a. Enum a => a -> a
    succ a
    c ->
                     let ([Either a (a, a)]
    ls,[Either a (a, a)]
    rest)        = (Either a (a, a) -> Bool)
    -> [Either a (a, a)] -> ([Either a (a, a)], [Either a (a, a)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Either a (a, a) -> Bool
    forall a b. Either a b -> Bool
    isLeft [Either a (a, a)]
    xs -- start from y

                         ([a]
    catable,[a]
    others) = [a] -> ([a], [a])
    forall a. (Eq a, Enum a) => [a] -> ([a], [a])
    increasingSeq ((Either a (a, a) -> a) -> [Either a (a, a)] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map Either a (a, a) -> a
    forall a b. Either a b -> a
    fromLeft [Either a (a, a)]
    ls)
                         range :: (a, a)
    range            = (a
    c, [a] -> a
    forall a. HasCallStack => [a] -> a
    head [a]
    catable)

                      in -- three (or more) Lefts make a Right

                         if [a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [a]
    catable Bool -> Bool -> Bool
    || [a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([a] -> [a]
    forall a. HasCallStack => [a] -> [a]
    tail [a]
    catable)
                            then Either a (a, a)
    x Either a (a, a) -> [Either a (a, a)] -> [Either a (a, a)]
    forall a. a -> [a] -> [a]
    : Either a (a, a)
    y Either a (a, a) -> [Either a (a, a)] -> [Either a (a, a)]
    forall a. a -> [a] -> [a]
    : [Either a (a, a)] -> [Either a (a, a)]
    go [Either a (a, a)]
    ys
                            -- [abcd] -> [a-d]

                            else [Either a (a, a)] -> [Either a (a, a)]
    go([Either a (a, a)] -> [Either a (a, a)])
    -> [Either a (a, a)] -> [Either a (a, a)]
    forall a b. (a -> b) -> a -> b
    $ (a, a) -> Either a (a, a)
    forall a b. b -> Either a b
    Right (a, a)
    range Either a (a, a) -> [Either a (a, a)] -> [Either a (a, a)]
    forall a. a -> [a] -> [a]
    : (a -> Either a (a, a)) -> [a] -> [Either a (a, a)]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> Either a (a, a)
    forall a b. a -> Either a b
    Left [a]
    others [Either a (a, a)] -> [Either a (a, a)] -> [Either a (a, a)]
    forall a. [a] -> [a] -> [a]
    ++ [Either a (a, a)]
    rest

                  | Bool
    otherwise -> Either a (a, a)
    x Either a (a, a) -> [Either a (a, a)] -> [Either a (a, a)]
    forall a. a -> [a] -> [a]
    : [Either a (a, a)] -> [Either a (a, a)]
    go [Either a (a, a)]
    xs

               Right (a, a)
    r : [Either a (a, a)]
    ys ->
                  case (a, a) -> a -> Maybe (a, a)
    forall a. (Ord a, Enum a) => (a, a) -> a -> Maybe (a, a)
    addToRange (a, a)
    r a
    c of
                       -- [da-c] -> [a-d]

                       Just (a, a)
    r' -> [Either a (a, a)] -> [Either a (a, a)]
    go([Either a (a, a)] -> [Either a (a, a)])
    -> [Either a (a, a)] -> [Either a (a, a)]
    forall a b. (a -> b) -> a -> b
    $ (a, a) -> Either a (a, a)
    forall a b. b -> Either a b
    Right (a, a)
    r' Either a (a, a) -> [Either a (a, a)] -> [Either a (a, a)]
    forall a. a -> [a] -> [a]
    : [Either a (a, a)]
    ys
                       Maybe (a, a)
    Nothing -> Either a (a, a)
    x Either a (a, a) -> [Either a (a, a)] -> [Either a (a, a)]
    forall a. a -> [a] -> [a]
    : [Either a (a, a)] -> [Either a (a, a)]
    go [Either a (a, a)]
    xs

       go (x :: Either a (a, a)
    x@(Right (a, a)
    r) : [Either a (a, a)]
    xs) =
          case [Either a (a, a)]
    xs of
               [] -> [Either a (a, a)
    x]
               Left a
    c : [Either a (a, a)]
    ys ->
                  case (a, a) -> a -> Maybe (a, a)
    forall a. (Ord a, Enum a) => (a, a) -> a -> Maybe (a, a)
    addToRange (a, a)
    r a
    c of
                       -- [a-cd] -> [a-d]

                       Just (a, a)
    r' -> [Either a (a, a)] -> [Either a (a, a)]
    go([Either a (a, a)] -> [Either a (a, a)])
    -> [Either a (a, a)] -> [Either a (a, a)]
    forall a b. (a -> b) -> a -> b
    $ (a, a) -> Either a (a, a)
    forall a b. b -> Either a b
    Right (a, a)
    r' Either a (a, a) -> [Either a (a, a)] -> [Either a (a, a)]
    forall a. a -> [a] -> [a]
    : [Either a (a, a)]
    ys
                       Maybe (a, a)
    Nothing -> Either a (a, a)
    x Either a (a, a) -> [Either a (a, a)] -> [Either a (a, a)]
    forall a. a -> [a] -> [a]
    : [Either a (a, a)] -> [Either a (a, a)]
    go [Either a (a, a)]
    xs

               Right (a, a)
    r' : [Either a (a, a)]
    ys ->
                  case (a, a) -> (a, a) -> Maybe (a, a)
    forall a. Ord a => (a, a) -> (a, a) -> Maybe (a, a)
    overlap (a, a)
    r (a, a)
    r' of
                       -- [a-cb-d] -> [a-d]

                       Just (a, a)
    o  -> [Either a (a, a)] -> [Either a (a, a)]
    go([Either a (a, a)] -> [Either a (a, a)])
    -> [Either a (a, a)] -> [Either a (a, a)]
    forall a b. (a -> b) -> a -> b
    $ (a, a) -> Either a (a, a)
    forall a b. b -> Either a b
    Right (a, a)
    o Either a (a, a) -> [Either a (a, a)] -> [Either a (a, a)]
    forall a. a -> [a] -> [a]
    : [Either a (a, a)]
    ys
                       Maybe (a, a)
    Nothing -> Either a (a, a)
    x Either a (a, a) -> [Either a (a, a)] -> [Either a (a, a)]
    forall a. a -> [a] -> [a]
    : [Either a (a, a)] -> [Either a (a, a)]
    go [Either a (a, a)]
    xs
    optimizeCharRange Bool
    _ Token
    _ = String -> Token
    forall a. HasCallStack => String -> a
    error String
    "Glob.optimizeCharRange :: internal error"

    sortCharRange :: [Either Char (Char,Char)] -> [Either Char (Char,Char)]
    sortCharRange :: CharRange -> CharRange
    sortCharRange = (Either Char (Char, Char) -> Either Char (Char, Char) -> Ordering)
    -> CharRange -> CharRange
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy Either Char (Char, Char) -> Either Char (Char, Char) -> Ordering
    forall {a} {b} {b}.
    Ord a =>
    Either a (a, b) -> Either a (a, b) -> Ordering
    cmp
     where
       cmp :: Either a (a, b) -> Either a (a, b) -> Ordering
    cmp (Left   a
    a)    (Left   a
    b)    = a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    a a
    b
       cmp (Left   a
    a)    (Right (a
    b,b
    _)) = a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    a a
    b
       cmp (Right (a
    a,b
    _)) (Left   a
    b)    = a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    a a
    b
       cmp (Right (a
    a,b
    _)) (Right (a
    b,b
    _)) = a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    a a
    b

    -- |Returns `True` iff the given `Pattern` is a literal file path, i.e. it has

    -- no wildcards, character ranges, etc.

    isLiteral :: Pattern -> Bool
    isLiteral :: Pattern -> Bool
    isLiteral = (Token -> Bool) -> [Token] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Token -> Bool
    lit ([Token] -> Bool) -> (Pattern -> [Token]) -> Pattern -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Pattern -> [Token]
    unPattern
     where
       lit :: Token -> Bool
    lit (Literal Char
    _) = Bool
    True
       lit (LongLiteral Int
    _ String
    _) = Bool
    True
       lit Token
    PathSeparator = Bool
    True
       lit Token
    _ = Bool
    False