module CabalFmt.Glob where

import Data.List             (isInfixOf)
import Data.List.NonEmpty    (NonEmpty (..))
import System.FilePath.Posix (splitDirectories)

import CabalFmt.Prelude

data Glob = Glob FilePath [GlobPiece]
  deriving 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
showList :: [Glob] -> ShowS
$cshowList :: [Glob] -> ShowS
show :: Glob -> String
$cshow :: Glob -> String
showsPrec :: Int -> Glob -> ShowS
$cshowsPrec :: Int -> Glob -> ShowS
Show

data GlobPiece
    = GlobStarStar
    | GlobPiece (NonEmpty GlobChar)
  deriving Int -> GlobPiece -> ShowS
[GlobPiece] -> ShowS
GlobPiece -> String
(Int -> GlobPiece -> ShowS)
-> (GlobPiece -> String)
-> ([GlobPiece] -> ShowS)
-> Show GlobPiece
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobPiece] -> ShowS
$cshowList :: [GlobPiece] -> ShowS
show :: GlobPiece -> String
$cshow :: GlobPiece -> String
showsPrec :: Int -> GlobPiece -> ShowS
$cshowsPrec :: Int -> GlobPiece -> ShowS
Show

data GlobChar
    = GlobStar
    | GlobChar Char
  deriving Int -> GlobChar -> ShowS
[GlobChar] -> ShowS
GlobChar -> String
(Int -> GlobChar -> ShowS)
-> (GlobChar -> String) -> ([GlobChar] -> ShowS) -> Show GlobChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobChar] -> ShowS
$cshowList :: [GlobChar] -> ShowS
show :: GlobChar -> String
$cshow :: GlobChar -> String
showsPrec :: Int -> GlobChar -> ShowS
$cshowsPrec :: Int -> GlobChar -> ShowS
Show

-- | Match glob
--
-- >>> let Right g = parseGlob "cbits/**/*.c"
--
-- >>> map (match g) ["foo", "cbits/header.h", "cbits/source.c", "cbits/dir/source.c"]
-- [False,False,True,True]
--
match :: Glob -> FilePath -> Bool
match :: Glob -> String -> Bool
match (Glob String
g1 [GlobPiece]
gs0) String
fp = [String] -> Bool
go0 (String -> [String]
splitDirectories String
fp) where
    go0 :: [String] -> Bool
go0 []     = Bool
False
    go0 (String
p:[String]
ps) = if String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
g1 then [String] -> [GlobPiece] -> Bool
go [String]
ps [GlobPiece]
gs0 else Bool
False

    go :: [FilePath] -> [GlobPiece] -> Bool
    go :: [String] -> [GlobPiece] -> Bool
go []     []                  = Bool
True
    go []     (GlobPiece
_:[GlobPiece]
_)               = Bool
False
    go (String
_:[String]
_)  []                  = Bool
False
    go (String
s:[String]
ss) (GlobPiece
GlobStarStar : [GlobPiece]
gs) = [String] -> [GlobPiece] -> Bool
go (String
sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ss) [GlobPiece]
gs Bool -> Bool -> Bool
|| [String] -> [GlobPiece] -> Bool
go [String]
ss (GlobPiece
GlobStarStar GlobPiece -> [GlobPiece] -> [GlobPiece]
forall a. a -> [a] -> [a]
: [GlobPiece]
gs)
    go (String
s:[String]
ss) (GlobPiece NonEmpty GlobChar
cs : [GlobPiece]
gs) = String -> [GlobChar] -> Bool
matches String
s (NonEmpty GlobChar -> [GlobChar]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty GlobChar
cs) Bool -> Bool -> Bool
&& [String] -> [GlobPiece] -> Bool
go [String]
ss [GlobPiece]
gs


    matches :: FilePath -> [GlobChar] -> Bool
    matches :: String -> [GlobChar] -> Bool
matches []     []                = Bool
True
    matches (Char
_:String
_)  []                = Bool
False
    matches []     (GlobChar
_:[GlobChar]
_)             = Bool
False
    matches (Char
x:String
xs) (GlobChar
GlobStar : [GlobChar]
cs)   = String -> [GlobChar] -> Bool
matches (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs) [GlobChar]
cs Bool -> Bool -> Bool
|| String -> [GlobChar] -> Bool
matches String
xs (GlobChar
GlobStar GlobChar -> [GlobChar] -> [GlobChar]
forall a. a -> [a] -> [a]
: [GlobChar]
cs)
    matches (Char
x:String
xs) (GlobChar Char
c : [GlobChar]
cs) = if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c then String -> [GlobChar] -> Bool
matches String
xs [GlobChar]
cs else Bool
False

parseGlob :: String -> Either String Glob
parseGlob :: String -> Either String Glob
parseGlob String
input = case String -> [String]
splitDirectories String
input of
    []     -> String -> Either String Glob
forall a b. a -> Either a b
Left String
"empty path"
    (String
x:[String]
xs) -> do
        String
p <- String -> Either String String
parseFirstPiece String
x
        [GlobPiece]
ps <- (String -> Either String GlobPiece)
-> [String] -> Either String [GlobPiece]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> Either String GlobPiece
parsePiece [String]
xs
        Glob -> Either String Glob
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [GlobPiece] -> Glob
Glob String
p [GlobPiece]
ps)
  where
    parseFirstPiece :: String -> Either String FilePath
    parseFirstPiece :: String -> Either String String
parseFirstPiece String
""                    = String -> Either String String
forall a b. a -> Either a b
Left String
"empty path segment"
    parseFirstPiece String
s | String
"*" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
s = String -> Either String String
forall a b. a -> Either a b
Left String
"wild card in first path segment"
    parseFirstPiece String
s                     = String -> Either String String
forall a b. b -> Either a b
Right String
s

    parsePiece :: String -> Either String GlobPiece
    parsePiece :: String -> Either String GlobPiece
parsePiece String
""                     = String -> Either String GlobPiece
forall a b. a -> Either a b
Left String
"empty path segment"
    parsePiece String
"**"                   = GlobPiece -> Either String GlobPiece
forall a b. b -> Either a b
Right GlobPiece
GlobStarStar
    parsePiece String
s | String
"**" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
s = String -> Either String GlobPiece
forall a b. a -> Either a b
Left (String -> Either String GlobPiece)
-> String -> Either String GlobPiece
forall a b. (a -> b) -> a -> b
$ String
"** inside path segment: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
    parsePiece (Char
c:String
cs)                 = GlobPiece -> Either String GlobPiece
forall a b. b -> Either a b
Right (NonEmpty GlobChar -> GlobPiece
GlobPiece (Char -> GlobChar
parseChar Char
c GlobChar -> [GlobChar] -> NonEmpty GlobChar
forall a. a -> [a] -> NonEmpty a
:| (Char -> GlobChar) -> String -> [GlobChar]
forall a b. (a -> b) -> [a] -> [b]
map Char -> GlobChar
parseChar String
cs))

    parseChar :: Char -> GlobChar
    parseChar :: Char -> GlobChar
parseChar Char
'*' = GlobChar
GlobStar
    parseChar Char
c   = Char -> GlobChar
GlobChar Char
c