-- 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 -> FilePath -> Bool
match = MatchOptions -> Pattern -> FilePath -> Bool
matchWith MatchOptions
matchDefault

-- |Like 'match', but applies the given 'MatchOptions' instead of the defaults.
matchWith :: MatchOptions -> Pattern -> FilePath -> Bool
matchWith :: MatchOptions -> Pattern -> FilePath -> Bool
matchWith opts :: MatchOptions
opts p :: Pattern
p f :: FilePath
f = MatchOptions -> [Token] -> FilePath -> Bool
begMatch MatchOptions
opts ([Token] -> [Token]
lcPat ([Token] -> [Token]) -> [Token] -> [Token]
forall a b. (a -> b) -> a -> b
$ Pattern -> [Token]
unPattern Pattern
p) (FilePath -> FilePath
lcPath FilePath
f)
 where
   lcPath :: FilePath -> FilePath
lcPath = if MatchOptions -> Bool
ignoreCase MatchOptions
opts then (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map    Char -> Char
toLower else FilePath -> FilePath
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] -> FilePath -> Bool
begMatch _ (Literal '.' : AnyDirectory : _) (x :: Char
x:y :: Char
y:_)
   | Char -> Bool
isExtSeparator Char
x Bool -> Bool -> Bool
&& Char -> Bool
isExtSeparator Char
y = Bool
False

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

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

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

begMatch opts :: MatchOptions
opts pat :: [Token]
pat (e :: Char
e:_)
   | 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 1 [Token]
pat) = Bool
False

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

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

match' o :: MatchOptions
o (PathSeparator   :xs :: [Token]
xs) (c :: Char
c:cs :: FilePath
cs) =
   Char -> Bool
isPathSeparator Char
c Bool -> Bool -> Bool
&& MatchOptions -> [Token] -> FilePath -> 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) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isPathSeparator FilePath
cs)

match' o :: MatchOptions
o (CharRange b :: Bool
b rng :: [Either Char (Char, Char)]
rng :xs :: [Token]
xs) (c :: Char
c:cs :: FilePath
cs) =
   let rangeMatch :: Either Char (Char, Char) -> Bool
rangeMatch r :: 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] -> FilePath -> Bool
match' MatchOptions
o [Token]
xs FilePath
cs

match' o :: MatchOptions
o (OpenRange lo :: Maybe FilePath
lo hi :: Maybe FilePath
hi :xs :: [Token]
xs) path :: FilePath
path =
   let getNumChoices :: [a] -> [([a], [a])]
getNumChoices n :: [a]
n =
          [([a], [a])] -> [([a], [a])]
forall a. [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 (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
$ [0..]
       (lzNum :: FilePath
lzNum,cs :: FilePath
cs) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit FilePath
path
       num :: FilePath
num        = FilePath -> FilePath
dropLeadingZeroes FilePath
lzNum
       numChoices :: [(FilePath, FilePath)]
numChoices = FilePath -> [(FilePath, FilePath)]
forall a. [a] -> [([a], [a])]
getNumChoices FilePath
num
       zeroChoices :: [(FilePath, FilePath)]
zeroChoices = ((FilePath, FilePath) -> Bool)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='0') (FilePath -> Bool)
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst) (FilePath -> [(FilePath, FilePath)]
forall a. [a] -> [([a], [a])]
getNumChoices FilePath
lzNum)
    in -- null lzNum means no digits: definitely not a match
       Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
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.
          (((FilePath, FilePath) -> Bool) -> [(FilePath, FilePath)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(n :: FilePath
n,rest :: FilePath
rest) -> Maybe FilePath -> Maybe FilePath -> FilePath -> Bool
inOpenRange Maybe FilePath
lo Maybe FilePath
hi FilePath
n Bool -> Bool -> Bool
&& MatchOptions -> [Token] -> FilePath -> Bool
match' MatchOptions
o [Token]
xs (FilePath
rest FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cs))
               ((FilePath
num,"") (FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
: [(FilePath, FilePath)]
numChoices)
           Bool -> Bool -> Bool
|| (Bool -> Bool
not ([(FilePath, FilePath)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FilePath, FilePath)]
zeroChoices) Bool -> Bool -> Bool
&& Maybe FilePath -> Maybe FilePath -> FilePath -> Bool
inOpenRange Maybe FilePath
lo Maybe FilePath
hi "0"
               Bool -> Bool -> Bool
&& ((FilePath, FilePath) -> Bool) -> [(FilePath, FilePath)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(_,rest :: FilePath
rest) -> MatchOptions -> [Token] -> FilePath -> Bool
match' MatchOptions
o [Token]
xs (FilePath
rest FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cs)) [(FilePath, FilePath)]
zeroChoices))

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

match' o :: MatchOptions
o (AnyDirectory:xs :: [Token]
xs) path :: FilePath
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
&& (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not(Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isExtSeparator(Char -> Bool) -> (FilePath -> Char) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FilePath -> Char
forall a. [a] -> a
head) [FilePath]
matchedDirs
 where parts :: [FilePath]
parts   = FilePath -> [FilePath]
pathParts ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isPathSeparator FilePath
path)
       matchIndex :: Maybe Int
matchIndex = (FilePath -> Bool) -> [FilePath] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (MatchOptions -> [Token] -> FilePath -> Bool
match' MatchOptions
o [Token]
xs) [FilePath]
parts
       hasMatch :: Bool
hasMatch = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
matchIndex
       matchedDirs :: [FilePath]
matchedDirs = Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
take (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 Maybe Int
matchIndex) [FilePath]
parts

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

match' _ (Unmatchable:_) _ = Bool
False
match' _ (ExtSeparator:_) _ = FilePath -> Bool
forall a. HasCallStack => FilePath -> a
error "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 FilePath -> Maybe FilePath -> FilePath -> Bool
inOpenRange l_ :: Maybe FilePath
l_ h_ :: Maybe FilePath
h_ s_ :: FilePath
s_ = Bool -> Bool -> Bool
forall a. HasCallStack => Bool -> a -> a
assert ((Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit FilePath
s_) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe FilePath
-> Maybe FilePath -> FilePath -> Ordering -> Ordering -> Bool
forall a.
Ord a =>
Maybe [a] -> Maybe [a] -> [a] -> Ordering -> Ordering -> Bool
go Maybe FilePath
l_ Maybe FilePath
h_ FilePath
s_ Ordering
EQ Ordering
EQ
 where
   go :: Maybe [a] -> Maybe [a] -> [a] -> Ordering -> Ordering -> Bool
go Nothing      Nothing   _     _ _  = Bool
True  -- no bounds
   go (Just [])    _         []    LT _ = Bool
False --  lesser than lower bound
   go _            (Just []) _     _ GT = Bool
False -- greater than upper bound
   go _            (Just []) (_:_) _ _  = Bool
False --  longer than upper bound
   go (Just (_:_)) _         []    _ _  = Bool
False -- shorter than lower bound
   go _            _         []    _ _  = Bool
True

   go (Just (l :: a
l:ls :: [a]
ls)) (Just (h :: a
h:hs :: [a]
hs)) (c :: a
c:cs :: [a]
cs) ordl :: Ordering
ordl ordh :: 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 Nothing (Just (h :: a
h:hs :: [a]
hs)) (c :: a
c:cs :: [a]
cs) _ ordh :: 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 (l :: a
l:ls :: [a]
ls)) Nothing (c :: a
c:cs :: [a]
cs) ordl :: Ordering
ordl _ =
      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 []) hi :: Maybe [a]
hi s :: [a]
s _ ordh :: 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