module Ormolu.Utils.Glob
  ( Glob,
    mkGlob,
    matchesGlob,
  )
where

import Data.List (elemIndex, stripPrefix)
import Data.Maybe (fromMaybe)

newtype Glob = Glob [GlobPart]
  deriving (Glob -> Glob -> Bool
(Glob -> Glob -> Bool) -> (Glob -> Glob -> Bool) -> Eq Glob
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Glob -> Glob -> Bool
== :: Glob -> Glob -> Bool
$c/= :: Glob -> Glob -> Bool
/= :: Glob -> Glob -> Bool
Eq, Int -> Glob -> ShowS
[Glob] -> ShowS
Glob -> String
(Int -> Glob -> ShowS)
-> (Glob -> String) -> ([Glob] -> ShowS) -> Show Glob
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Glob -> ShowS
showsPrec :: Int -> Glob -> ShowS
$cshow :: Glob -> String
show :: Glob -> String
$cshowList :: [Glob] -> ShowS
showList :: [Glob] -> ShowS
Show)

data GlobPart
  = MatchExactly !String
  | SingleWildcard
  | DoubleWildcard
  deriving (GlobPart -> GlobPart -> Bool
(GlobPart -> GlobPart -> Bool)
-> (GlobPart -> GlobPart -> Bool) -> Eq GlobPart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GlobPart -> GlobPart -> Bool
== :: GlobPart -> GlobPart -> Bool
$c/= :: GlobPart -> GlobPart -> Bool
/= :: GlobPart -> GlobPart -> Bool
Eq, Int -> GlobPart -> ShowS
[GlobPart] -> ShowS
GlobPart -> String
(Int -> GlobPart -> ShowS)
-> (GlobPart -> String) -> ([GlobPart] -> ShowS) -> Show GlobPart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GlobPart -> ShowS
showsPrec :: Int -> GlobPart -> ShowS
$cshow :: GlobPart -> String
show :: GlobPart -> String
$cshowList :: [GlobPart] -> ShowS
showList :: [GlobPart] -> ShowS
Show)

mkGlob :: String -> Glob
mkGlob :: String -> Glob
mkGlob = [GlobPart] -> Glob
Glob ([GlobPart] -> Glob) -> (String -> [GlobPart]) -> String -> Glob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [GlobPart]
parsePart
  where
    parsePart :: String -> [GlobPart]
    parsePart :: String -> [GlobPart]
parsePart String
s = case String
s of
      [] ->
        []
      Char
'*' : Char
'*' : String
t ->
        GlobPart
DoubleWildcard GlobPart -> [GlobPart] -> [GlobPart]
forall a. a -> [a] -> [a]
: String -> [GlobPart]
parsePart String
t
      Char
'*' : String
t ->
        GlobPart
SingleWildcard GlobPart -> [GlobPart] -> [GlobPart]
forall a. a -> [a] -> [a]
: String -> [GlobPart]
parsePart String
t
      String
t ->
        let (String
m, String
t') = (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
t
         in String -> GlobPart
MatchExactly String
m GlobPart -> [GlobPart] -> [GlobPart]
forall a. a -> [a] -> [a]
: String -> [GlobPart]
parsePart String
t'

matchesGlob :: String -> Glob -> Bool
matchesGlob :: String -> Glob -> Bool
matchesGlob String
s (Glob [GlobPart]
ps) = String
s String -> [GlobPart] -> Bool
`matchesGlobParts` [GlobPart]
ps

matchesGlobParts :: String -> [GlobPart] -> Bool
matchesGlobParts :: String -> [GlobPart] -> Bool
matchesGlobParts String
s [GlobPart]
g = case [GlobPart]
g of
  [] ->
    String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s
  MatchExactly String
p : [GlobPart]
g' ->
    case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
p String
s of
      Maybe String
Nothing -> Bool
False
      Just String
s' -> String
s' String -> [GlobPart] -> Bool
`matchesGlobParts` [GlobPart]
g'
  GlobPart
SingleWildcard : [GlobPart]
g' ->
    let l :: Int
l = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) (Char -> String -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Char
'.' String
s)
     in [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [String
s' String -> [GlobPart] -> Bool
`matchesGlobParts` [GlobPart]
g' | Int
i <- [Int
0 .. Int
l], let s' :: String
s' = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
i String
s]
  GlobPart
DoubleWildcard : [GlobPart]
g' ->
    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [String
s' String -> [GlobPart] -> Bool
`matchesGlobParts` [GlobPart]
g' | Int
i <- [Int
0 .. String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s], let s' :: String
s' = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
i String
s]