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

    {-# LANGUAGE CPP #-}

    module System.FilePath.Glob.Match (match, matchWith) where

    import Control.Exception (assert)
    import Data.Char         (isDigit, toLower, toUpper)
    import Data.List         (findIndex)
    import Data.Maybe        (fromMaybe, isJust)
    #if !MIN_VERSION_base(4,8,0)
    import Data.Monoid       (mappend)
    #endif
    import System.FilePath   (isPathSeparator, isExtSeparator)

    import System.FilePath.Glob.Base  ( Pattern(..), Token(..)
                                      , MatchOptions(..), matchDefault
                                      , isLiteral, tokToLower
                                      )
    import System.FilePath.Glob.Utils (dropLeadingZeroes, inRange, pathParts)

    -- |Matches the given 'Pattern' against the given 'FilePath', returning 'True'

    -- if the pattern matches and 'False' otherwise.

    match :: Pattern -> FilePath -> Bool
    match :: Pattern -> [Char] -> Bool
    match = MatchOptions -> Pattern -> [Char] -> Bool
    matchWith MatchOptions
    matchDefault

    -- |Like 'match', but applies the given 'MatchOptions' instead of the defaults.

    matchWith :: MatchOptions -> Pattern -> FilePath -> Bool
    matchWith :: MatchOptions -> Pattern -> [Char] -> Bool
    matchWith MatchOptions
    opts Pattern
    p [Char]
    f = MatchOptions -> [Token] -> [Char] -> Bool
    begMatch MatchOptions
    opts ([Token] -> [Token]
    lcPat ([Token] -> [Token]) -> [Token] -> [Token]
    forall a b. (a -> b) -> a -> b
    $ Pattern -> [Token]
    unPattern Pattern
    p) ([Char] -> [Char]
    lcPath [Char]
    f)
     where
       lcPath :: [Char] -> [Char]
    lcPath = if MatchOptions -> Bool
    ignoreCase MatchOptions
    opts then (Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map    Char -> Char
    toLower else [Char] -> [Char]
    forall a. a -> a
    id
       lcPat :: [Token] -> [Token]
    lcPat  = if MatchOptions -> Bool
    ignoreCase MatchOptions
    opts then (Token -> Token) -> [Token] -> [Token]
    forall a b. (a -> b) -> [a] -> [b]
    map Token -> Token
    tokToLower else [Token] -> [Token]
    forall a. a -> a
    id

    -- begMatch takes care of some things at the beginning of a pattern or after /:

    --    - . needs to be matched explicitly

    --    - ./foo is equivalent to foo (for any number of /)

    --

    -- .*/foo still needs to match ./foo though, and it won't match plain foo;

    -- special case that one

    --

    -- and .**/foo should /not/ match ../foo; more special casing

    --

    -- (All of the above is modulo options, of course)

    begMatch, match' :: MatchOptions -> [Token] -> FilePath -> Bool
    begMatch :: MatchOptions -> [Token] -> [Char] -> Bool
    begMatch MatchOptions
    _ (Literal Char
    '.' : Token
    AnyDirectory : [Token]
    _) (Char
    x:Char
    y:[Char]
    _)
       | Char -> Bool
    isExtSeparator Char
    x Bool -> Bool -> Bool
    && Char -> Bool
    isExtSeparator Char
    y = Bool
    False

    begMatch MatchOptions
    opts (Literal Char
    '.' : Token
    PathSeparator : [Token]
    pat) [Char]
    s | MatchOptions -> Bool
    ignoreDotSlash MatchOptions
    opts =
       MatchOptions -> [Token] -> [Char] -> Bool
    begMatch MatchOptions
    opts ((Token -> Bool) -> [Token] -> [Token]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Token -> Bool
    isSlash [Token]
    pat) ([Char] -> [Char]
    dropDotSlash [Char]
    s)
     where
       isSlash :: Token -> Bool
    isSlash Token
    PathSeparator = Bool
    True
       isSlash Token
    _             = Bool
    False

       dropDotSlash :: [Char] -> [Char]
    dropDotSlash (Char
    x:Char
    y:[Char]
    ys) | Char -> Bool
    isExtSeparator Char
    x Bool -> Bool -> Bool
    && Char -> Bool
    isPathSeparator Char
    y =
          (Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isPathSeparator [Char]
    ys
       dropDotSlash [Char]
    xs = [Char]
    xs

    begMatch MatchOptions
    opts [Token]
    pat (Char
    x:Char
    y:[Char]
    s)
       | Bool
    dotSlash Bool -> Bool -> Bool
    && Bool
    dotStarSlash        = MatchOptions -> [Token] -> [Char] -> Bool
    match' MatchOptions
    opts [Token]
    pat' [Char]
    s
       | MatchOptions -> Bool
    ignoreDotSlash MatchOptions
    opts Bool -> Bool -> Bool
    && Bool
    dotSlash =
            MatchOptions -> [Token] -> [Char] -> Bool
    begMatch MatchOptions
    opts [Token]
    pat ((Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isPathSeparator [Char]
    s)
     where
       dotSlash :: Bool
    dotSlash = Char -> Bool
    isExtSeparator Char
    x Bool -> Bool -> Bool
    && Char -> Bool
    isPathSeparator Char
    y
       (Bool
    dotStarSlash, [Token]
    pat') =
          case [Token]
    pat of
            Literal Char
    '.': Token
    AnyNonPathSeparator : Token
    PathSeparator : [Token]
    rest -> (Bool
    True, [Token]
    rest)
            [Token]
    _                                                       -> (Bool
    False, [Token]
    pat)

    begMatch MatchOptions
    opts [Token]
    pat (Char
    e:[Char]
    _)
       | Char -> Bool
    isExtSeparator Char
    e
         Bool -> Bool -> Bool
    && Bool -> Bool
    not (MatchOptions -> Bool
    matchDotsImplicitly MatchOptions
    opts)
         Bool -> Bool -> Bool
    && Bool -> Bool
    not (Pattern -> Bool
    isLiteral (Pattern -> Bool) -> ([Token] -> Pattern) -> [Token] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Token] -> Pattern
    Pattern ([Token] -> Bool) -> [Token] -> Bool
    forall a b. (a -> b) -> a -> b
    $ Int -> [Token] -> [Token]
    forall a. Int -> [a] -> [a]
    take Int
    1 [Token]
    pat) = Bool
    False

    begMatch MatchOptions
    opts [Token]
    pat [Char]
    s = MatchOptions -> [Token] -> [Char] -> Bool
    match' MatchOptions
    opts [Token]
    pat [Char]
    s

    match' :: MatchOptions -> [Token] -> [Char] -> Bool
    match' MatchOptions
    _ []                        [Char]
    s  = [Char] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Char]
    s
    match' MatchOptions
    _ (Token
    AnyNonPathSeparator:[Token]
    s)   [Char]
    "" = [Token] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Token]
    s
    match' MatchOptions
    _ [Token]
    _                         [Char]
    "" = Bool
    False
    match' MatchOptions
    o (Literal Char
    l       :[Token]
    xs) (Char
    c:[Char]
    cs) = Char
    l Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c Bool -> Bool -> Bool
    && MatchOptions -> [Token] -> [Char] -> Bool
    match' MatchOptions
    o [Token]
    xs [Char]
    cs
    match' MatchOptions
    o (Token
    NonPathSeparator:[Token]
    xs) (Char
    c:[Char]
    cs) =
       Bool -> Bool
    not (Char -> Bool
    isPathSeparator Char
    c) Bool -> Bool -> Bool
    && MatchOptions -> [Token] -> [Char] -> Bool
    match' MatchOptions
    o [Token]
    xs [Char]
    cs

    match' MatchOptions
    o (Token
    PathSeparator   :[Token]
    xs) (Char
    c:[Char]
    cs) =
       Char -> Bool
    isPathSeparator Char
    c Bool -> Bool -> Bool
    && MatchOptions -> [Token] -> [Char] -> Bool
    begMatch MatchOptions
    o ((Token -> Bool) -> [Token] -> [Token]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Token -> Token -> Bool
    forall a. Eq a => a -> a -> Bool
    == Token
    PathSeparator) [Token]
    xs)
                                       ((Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isPathSeparator [Char]
    cs)

    match' MatchOptions
    o (CharRange Bool
    b [Either Char (Char, Char)]
    rng :[Token]
    xs) (Char
    c:[Char]
    cs) =
       let rangeMatch :: Either Char (Char, Char) -> Bool
    rangeMatch Either Char (Char, Char)
    r =
              (Char -> Bool)
    -> ((Char, Char) -> Bool) -> Either Char (Char, Char) -> Bool
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c) ((Char, Char) -> Char -> Bool
    forall a. Ord a => (a, a) -> a -> Bool
    `inRange` Char
    c) Either Char (Char, Char)
    r Bool -> Bool -> Bool
    ||
                 -- See comment near Base.tokToLower for an explanation of why we

                 -- do this

                 MatchOptions -> Bool
    ignoreCase MatchOptions
    o Bool -> Bool -> Bool
    && (Char -> Bool)
    -> ((Char, Char) -> Bool) -> Either Char (Char, Char) -> Bool
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Char
    toUpper Char
    c) ((Char, Char) -> Char -> Bool
    forall a. Ord a => (a, a) -> a -> Bool
    `inRange` Char -> Char
    toUpper Char
    c) Either Char (Char, Char)
    r
        in Bool -> Bool
    not (Char -> Bool
    isPathSeparator Char
    c) Bool -> Bool -> Bool
    &&
           (Either Char (Char, Char) -> Bool)
    -> [Either Char (Char, Char)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Either Char (Char, Char) -> Bool
    rangeMatch [Either Char (Char, Char)]
    rng Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    b Bool -> Bool -> Bool
    &&
           MatchOptions -> [Token] -> [Char] -> Bool
    match' MatchOptions
    o [Token]
    xs [Char]
    cs

    match' MatchOptions
    o (OpenRange Maybe [Char]
    lo Maybe [Char]
    hi :[Token]
    xs) [Char]
    path =
       let getNumChoices :: [a] -> [([a], [a])]
    getNumChoices [a]
    n =
              [([a], [a])] -> [([a], [a])]
    forall a. (?callStack::CallStack) => [a] -> [a]
    tail ([([a], [a])] -> [([a], [a])])
    -> ([Int] -> [([a], [a])]) -> [Int] -> [([a], [a])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([a], [a]) -> Bool) -> [([a], [a])] -> [([a], [a])]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Bool -> Bool
    not(Bool -> Bool) -> (([a], [a]) -> Bool) -> ([a], [a]) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .[a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null([a] -> Bool) -> (([a], [a]) -> [a]) -> ([a], [a]) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .([a], [a]) -> [a]
    forall a b. (a, b) -> b
    snd) ([([a], [a])] -> [([a], [a])])
    -> ([Int] -> [([a], [a])]) -> [Int] -> [([a], [a])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> ([a], [a])) -> [Int] -> [([a], [a])]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    `splitAt` [a]
    n) ([Int] -> [([a], [a])]) -> [Int] -> [([a], [a])]
    forall a b. (a -> b) -> a -> b
    $ [Int
    0..]
           ([Char]
    lzNum,[Char]
    cs) = (Char -> Bool) -> [Char] -> ([Char], [Char])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Char -> Bool
    isDigit [Char]
    path
           num :: [Char]
    num        = [Char] -> [Char]
    dropLeadingZeroes [Char]
    lzNum
           numChoices :: [([Char], [Char])]
    numChoices = [Char] -> [([Char], [Char])]
    forall {a}. [a] -> [([a], [a])]
    getNumChoices [Char]
    num
           zeroChoices :: [([Char], [Char])]
    zeroChoices = (([Char], [Char]) -> Bool)
    -> [([Char], [Char])] -> [([Char], [Char])]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile ((Char -> Bool) -> [Char] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '0') ([Char] -> Bool)
    -> (([Char], [Char]) -> [Char]) -> ([Char], [Char]) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char], [Char]) -> [Char]
    forall a b. (a, b) -> a
    fst) ([Char] -> [([Char], [Char])]
    forall {a}. [a] -> [([a], [a])]
    getNumChoices [Char]
    lzNum)
        in -- null lzNum means no digits: definitely not a match

           Bool -> Bool
    not ([Char] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Char]
    lzNum) Bool -> Bool -> Bool
    &&
              -- So, given the path "00123foo" what we've got is:

              --    lzNum       = "00123"

              --    cs          = "foo"

              --    num         = "123"

              --    numChoices  = [("1","23"),("12","3")]

              --    zeroChoices = [("0", "0123"), ("00", "123")]

              --

              -- We want to try matching x against each of 123, 12, and 1.

              -- 12 and 1 are in numChoices already, but we need to add (num,"")

              -- manually.

              --

              -- It's also possible that we only want to match the zeroes. Handle

              -- that separately since inOpenRange doesn't like leading zeroes.

              ((([Char], [Char]) -> Bool) -> [([Char], [Char])] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (\([Char]
    n,[Char]
    rest) -> Maybe [Char] -> Maybe [Char] -> [Char] -> Bool
    inOpenRange Maybe [Char]
    lo Maybe [Char]
    hi [Char]
    n Bool -> Bool -> Bool
    && MatchOptions -> [Token] -> [Char] -> Bool
    match' MatchOptions
    o [Token]
    xs ([Char]
    rest [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    cs))
                   (([Char]
    num,[Char]
    "") ([Char], [Char]) -> [([Char], [Char])] -> [([Char], [Char])]
    forall a. a -> [a] -> [a]
    : [([Char], [Char])]
    numChoices)
               Bool -> Bool -> Bool
    || (Bool -> Bool
    not ([([Char], [Char])] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [([Char], [Char])]
    zeroChoices) Bool -> Bool -> Bool
    && Maybe [Char] -> Maybe [Char] -> [Char] -> Bool
    inOpenRange Maybe [Char]
    lo Maybe [Char]
    hi [Char]
    "0"
                   Bool -> Bool -> Bool
    && (([Char], [Char]) -> Bool) -> [([Char], [Char])] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (\([Char]
    _,[Char]
    rest) -> MatchOptions -> [Token] -> [Char] -> Bool
    match' MatchOptions
    o [Token]
    xs ([Char]
    rest [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    cs)) [([Char], [Char])]
    zeroChoices))

    match' MatchOptions
    o again :: [Token]
    again@(Token
    AnyNonPathSeparator:[Token]
    xs) path :: [Char]
    path@(Char
    c:[Char]
    cs) =
       MatchOptions -> [Token] -> [Char] -> Bool
    match' MatchOptions
    o [Token]
    xs [Char]
    path Bool -> Bool -> Bool
    || (Bool -> Bool
    not (Char -> Bool
    isPathSeparator Char
    c) Bool -> Bool -> Bool
    && MatchOptions -> [Token] -> [Char] -> Bool
    match' MatchOptions
    o [Token]
    again [Char]
    cs)

    match' MatchOptions
    o (Token
    AnyDirectory:[Token]
    xs) [Char]
    path =
       if MatchOptions -> Bool
    matchDotsImplicitly MatchOptions
    o
          then Bool
    hasMatch
          --  **/baz shouldn't match foo/.bar/baz, so check that none of the

          -- directories matched by **/ start with .

          else Bool
    hasMatch Bool -> Bool -> Bool
    && ([Char] -> Bool) -> [[Char]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Bool -> Bool
    not(Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> Bool
    isExtSeparator(Char -> Bool) -> ([Char] -> Char) -> [Char] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .[Char] -> Char
    forall a. (?callStack::CallStack) => [a] -> a
    head) [[Char]]
    matchedDirs
     where parts :: [[Char]]
    parts   = [Char] -> [[Char]]
    pathParts ((Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isPathSeparator [Char]
    path)
           matchIndex :: Maybe Int
    matchIndex = ([Char] -> Bool) -> [[Char]] -> Maybe Int
    forall a. (a -> Bool) -> [a] -> Maybe Int
    findIndex (MatchOptions -> [Token] -> [Char] -> Bool
    match' MatchOptions
    o [Token]
    xs) [[Char]]
    parts
           hasMatch :: Bool
    hasMatch = Maybe Int -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Int
    matchIndex
           matchedDirs :: [[Char]]
    matchedDirs = Int -> [[Char]] -> [[Char]]
    forall a. Int -> [a] -> [a]
    take (Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 Maybe Int
    matchIndex) [[Char]]
    parts

    match' MatchOptions
    o (LongLiteral Int
    len [Char]
    s:[Token]
    xs) [Char]
    path =
       let ([Char]
    pre,[Char]
    cs) = Int -> [Char] -> ([Char], [Char])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    len [Char]
    path
        in [Char]
    pre [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    s Bool -> Bool -> Bool
    && MatchOptions -> [Token] -> [Char] -> Bool
    match' MatchOptions
    o [Token]
    xs [Char]
    cs

    match' MatchOptions
    _ (Token
    Unmatchable:[Token]
    _) [Char]
    _ = Bool
    False
    match' MatchOptions
    _ (Token
    ExtSeparator:[Token]
    _) [Char]
    _ = [Char] -> Bool
    forall a. (?callStack::CallStack) => [Char] -> a
    error [Char]
    "ExtSeparator survived optimization?"

    -- Does the actual open range matching: finds whether the third parameter

    -- is between the first two or not.

    --

    -- It does this by keeping track of the Ordering so far (e.g. having

    -- looked at "12" and "34" the Ordering of the two would be LT: 12 < 34)

    -- and aborting if a String "runs out": a longer string is automatically

    -- greater.

    --

    -- Assumes that the input strings contain only digits, and no leading zeroes.

    inOpenRange :: Maybe String -> Maybe String -> String -> Bool
    inOpenRange :: Maybe [Char] -> Maybe [Char] -> [Char] -> Bool
    inOpenRange Maybe [Char]
    l_ Maybe [Char]
    h_ [Char]
    s_ = Bool -> Bool -> Bool
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert ((Char -> Bool) -> [Char] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isDigit [Char]
    s_) (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Maybe [Char]
    -> Maybe [Char] -> [Char] -> Ordering -> Ordering -> Bool
    forall {a}.
    Ord a =>
    Maybe [a] -> Maybe [a] -> [a] -> Ordering -> Ordering -> Bool
    go Maybe [Char]
    l_ Maybe [Char]
    h_ [Char]
    s_ Ordering
    EQ Ordering
    EQ
     where
       go :: Maybe [a] -> Maybe [a] -> [a] -> Ordering -> Ordering -> Bool
    go Maybe [a]
    Nothing      Maybe [a]
    Nothing   [a]
    _     Ordering
    _ Ordering
    _  = Bool
    True  -- no bounds

       go (Just [])    Maybe [a]
    _         []    Ordering
    LT Ordering
    _ = Bool
    False --  lesser than lower bound

       go Maybe [a]
    _            (Just []) [a]
    _     Ordering
    _ Ordering
    GT = Bool
    False -- greater than upper bound

       go Maybe [a]
    _            (Just []) (a
    _:[a]
    _) Ordering
    _ Ordering
    _  = Bool
    False --  longer than upper bound

       go (Just (a
    _:[a]
    _)) Maybe [a]
    _         []    Ordering
    _ Ordering
    _  = Bool
    False -- shorter than lower bound

       go Maybe [a]
    _            Maybe [a]
    _         []    Ordering
    _ Ordering
    _  = Bool
    True

       go (Just (a
    l:[a]
    ls)) (Just (a
    h:[a]
    hs)) (a
    c:[a]
    cs) Ordering
    ordl Ordering
    ordh =
          let ordl' :: Ordering
    ordl' = Ordering
    ordl Ordering -> Ordering -> Ordering
    forall a. Monoid a => a -> a -> a
    `mappend` a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    c a
    l
              ordh' :: Ordering
    ordh' = Ordering
    ordh Ordering -> Ordering -> Ordering
    forall a. Monoid a => a -> a -> a
    `mappend` a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    c a
    h
           in Maybe [a] -> Maybe [a] -> [a] -> Ordering -> Ordering -> Bool
    go ([a] -> Maybe [a]
    forall a. a -> Maybe a
    Just [a]
    ls) ([a] -> Maybe [a]
    forall a. a -> Maybe a
    Just [a]
    hs) [a]
    cs Ordering
    ordl' Ordering
    ordh'

       go Maybe [a]
    Nothing (Just (a
    h:[a]
    hs)) (a
    c:[a]
    cs) Ordering
    _ Ordering
    ordh =
          let ordh' :: Ordering
    ordh' = Ordering
    ordh Ordering -> Ordering -> Ordering
    forall a. Monoid a => a -> a -> a
    `mappend` a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    c a
    h
           in Maybe [a] -> Maybe [a] -> [a] -> Ordering -> Ordering -> Bool
    go Maybe [a]
    forall a. Maybe a
    Nothing ([a] -> Maybe [a]
    forall a. a -> Maybe a
    Just [a]
    hs) [a]
    cs Ordering
    GT Ordering
    ordh'

       go (Just (a
    l:[a]
    ls)) Maybe [a]
    Nothing (a
    c:[a]
    cs) Ordering
    ordl Ordering
    _ =
          let ordl' :: Ordering
    ordl' = Ordering
    ordl Ordering -> Ordering -> Ordering
    forall a. Monoid a => a -> a -> a
    `mappend` a -> a -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare a
    c a
    l
           in Maybe [a] -> Maybe [a] -> [a] -> Ordering -> Ordering -> Bool
    go ([a] -> Maybe [a]
    forall a. a -> Maybe a
    Just [a]
    ls) Maybe [a]
    forall a. Maybe a
    Nothing [a]
    cs Ordering
    ordl' Ordering
    LT

       -- lower bound is shorter: s is greater

       go (Just []) Maybe [a]
    hi [a]
    s Ordering
    _ Ordering
    ordh = Maybe [a] -> Maybe [a] -> [a] -> Ordering -> Ordering -> Bool
    go Maybe [a]
    forall a. Maybe a
    Nothing Maybe [a]
    hi [a]
    s Ordering
    GT Ordering
    ordh