{-# LANGUAGE OverloadedStrings #-}

module System.Directory.Watchman.Expression
    ( Expression
    , renderExpression

    , true
    , false
    , System.Directory.Watchman.Expression.all
    , System.Directory.Watchman.Expression.any
    , (.&&)
    , (.||)
    , dirname
    , dirname'
    , empty
    , exists
    , match
    , match'
    , name
    , name'
    , System.Directory.Watchman.Expression.not
    , size
    , suffix
    , type_

    , caseSensitive
    , caseInsensitive
    , basename
    , wholename
    , depth
    , includeDotFiles
    , noEscape
    ) where

import Data.Foldable (foldl')
import Data.ByteString (ByteString)
import Data.Int
import qualified Data.Map.Strict as M
import qualified Data.Sequence as Seq

import System.Directory.Watchman.FileType
import System.Directory.Watchman.WFilePath
import System.Directory.Watchman.BSER

data CaseSensitivity
    = CaseSensitive
    | CaseInsensitive
    deriving (Int -> CaseSensitivity -> ShowS
[CaseSensitivity] -> ShowS
CaseSensitivity -> String
(Int -> CaseSensitivity -> ShowS)
-> (CaseSensitivity -> String)
-> ([CaseSensitivity] -> ShowS)
-> Show CaseSensitivity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CaseSensitivity] -> ShowS
$cshowList :: [CaseSensitivity] -> ShowS
show :: CaseSensitivity -> String
$cshow :: CaseSensitivity -> String
showsPrec :: Int -> CaseSensitivity -> ShowS
$cshowsPrec :: Int -> CaseSensitivity -> ShowS
Show, CaseSensitivity -> CaseSensitivity -> Bool
(CaseSensitivity -> CaseSensitivity -> Bool)
-> (CaseSensitivity -> CaseSensitivity -> Bool)
-> Eq CaseSensitivity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CaseSensitivity -> CaseSensitivity -> Bool
$c/= :: CaseSensitivity -> CaseSensitivity -> Bool
== :: CaseSensitivity -> CaseSensitivity -> Bool
$c== :: CaseSensitivity -> CaseSensitivity -> Bool
Eq, Eq CaseSensitivity
Eq CaseSensitivity
-> (CaseSensitivity -> CaseSensitivity -> Ordering)
-> (CaseSensitivity -> CaseSensitivity -> Bool)
-> (CaseSensitivity -> CaseSensitivity -> Bool)
-> (CaseSensitivity -> CaseSensitivity -> Bool)
-> (CaseSensitivity -> CaseSensitivity -> Bool)
-> (CaseSensitivity -> CaseSensitivity -> CaseSensitivity)
-> (CaseSensitivity -> CaseSensitivity -> CaseSensitivity)
-> Ord CaseSensitivity
CaseSensitivity -> CaseSensitivity -> Bool
CaseSensitivity -> CaseSensitivity -> Ordering
CaseSensitivity -> CaseSensitivity -> CaseSensitivity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CaseSensitivity -> CaseSensitivity -> CaseSensitivity
$cmin :: CaseSensitivity -> CaseSensitivity -> CaseSensitivity
max :: CaseSensitivity -> CaseSensitivity -> CaseSensitivity
$cmax :: CaseSensitivity -> CaseSensitivity -> CaseSensitivity
>= :: CaseSensitivity -> CaseSensitivity -> Bool
$c>= :: CaseSensitivity -> CaseSensitivity -> Bool
> :: CaseSensitivity -> CaseSensitivity -> Bool
$c> :: CaseSensitivity -> CaseSensitivity -> Bool
<= :: CaseSensitivity -> CaseSensitivity -> Bool
$c<= :: CaseSensitivity -> CaseSensitivity -> Bool
< :: CaseSensitivity -> CaseSensitivity -> Bool
$c< :: CaseSensitivity -> CaseSensitivity -> Bool
compare :: CaseSensitivity -> CaseSensitivity -> Ordering
$ccompare :: CaseSensitivity -> CaseSensitivity -> Ordering
$cp1Ord :: Eq CaseSensitivity
Ord)

class HasCaseSensitivityOption a where
    setCaseSensitivity :: CaseSensitivity -> a -> a

data PathScope
    = BaseName
    | WholeName
    deriving (Int -> PathScope -> ShowS
[PathScope] -> ShowS
PathScope -> String
(Int -> PathScope -> ShowS)
-> (PathScope -> String)
-> ([PathScope] -> ShowS)
-> Show PathScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathScope] -> ShowS
$cshowList :: [PathScope] -> ShowS
show :: PathScope -> String
$cshow :: PathScope -> String
showsPrec :: Int -> PathScope -> ShowS
$cshowsPrec :: Int -> PathScope -> ShowS
Show, PathScope -> PathScope -> Bool
(PathScope -> PathScope -> Bool)
-> (PathScope -> PathScope -> Bool) -> Eq PathScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathScope -> PathScope -> Bool
$c/= :: PathScope -> PathScope -> Bool
== :: PathScope -> PathScope -> Bool
$c== :: PathScope -> PathScope -> Bool
Eq, Eq PathScope
Eq PathScope
-> (PathScope -> PathScope -> Ordering)
-> (PathScope -> PathScope -> Bool)
-> (PathScope -> PathScope -> Bool)
-> (PathScope -> PathScope -> Bool)
-> (PathScope -> PathScope -> Bool)
-> (PathScope -> PathScope -> PathScope)
-> (PathScope -> PathScope -> PathScope)
-> Ord PathScope
PathScope -> PathScope -> Bool
PathScope -> PathScope -> Ordering
PathScope -> PathScope -> PathScope
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PathScope -> PathScope -> PathScope
$cmin :: PathScope -> PathScope -> PathScope
max :: PathScope -> PathScope -> PathScope
$cmax :: PathScope -> PathScope -> PathScope
>= :: PathScope -> PathScope -> Bool
$c>= :: PathScope -> PathScope -> Bool
> :: PathScope -> PathScope -> Bool
$c> :: PathScope -> PathScope -> Bool
<= :: PathScope -> PathScope -> Bool
$c<= :: PathScope -> PathScope -> Bool
< :: PathScope -> PathScope -> Bool
$c< :: PathScope -> PathScope -> Bool
compare :: PathScope -> PathScope -> Ordering
$ccompare :: PathScope -> PathScope -> Ordering
$cp1Ord :: Eq PathScope
Ord)

class HasPathScopeOption a where
    setPathScope :: PathScope -> a -> a

data Expression
    = EAllOf ![Expression]
    | EAnyOf ![Expression]
    | EDirName !WFilePath !DirNameParams
    | ETrue
    | EFalse
    | EEmpty
    | EExists
    | EMatch !ByteString !MatchParams
    | EName ![WFilePath] !NameParams
    | ESince () -- TODO !!!
    | ENot !Expression
    | ESize !(Comparison Int64)
    | ESuffix !ByteString
    | EType !FileType
    deriving (Int -> Expression -> ShowS
[Expression] -> ShowS
Expression -> String
(Int -> Expression -> ShowS)
-> (Expression -> String)
-> ([Expression] -> ShowS)
-> Show Expression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression] -> ShowS
$cshowList :: [Expression] -> ShowS
show :: Expression -> String
$cshow :: Expression -> String
showsPrec :: Int -> Expression -> ShowS
$cshowsPrec :: Int -> Expression -> ShowS
Show, Expression -> Expression -> Bool
(Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool) -> Eq Expression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression -> Expression -> Bool
$c/= :: Expression -> Expression -> Bool
== :: Expression -> Expression -> Bool
$c== :: Expression -> Expression -> Bool
Eq, Eq Expression
Eq Expression
-> (Expression -> Expression -> Ordering)
-> (Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool)
-> (Expression -> Expression -> Expression)
-> (Expression -> Expression -> Expression)
-> Ord Expression
Expression -> Expression -> Bool
Expression -> Expression -> Ordering
Expression -> Expression -> Expression
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Expression -> Expression -> Expression
$cmin :: Expression -> Expression -> Expression
max :: Expression -> Expression -> Expression
$cmax :: Expression -> Expression -> Expression
>= :: Expression -> Expression -> Bool
$c>= :: Expression -> Expression -> Bool
> :: Expression -> Expression -> Bool
$c> :: Expression -> Expression -> Bool
<= :: Expression -> Expression -> Bool
$c<= :: Expression -> Expression -> Bool
< :: Expression -> Expression -> Bool
$c< :: Expression -> Expression -> Bool
compare :: Expression -> Expression -> Ordering
$ccompare :: Expression -> Expression -> Ordering
$cp1Ord :: Eq Expression
Ord)

data DirNameParams = DirNameParams
    { DirNameParams -> Comparison Int
_DirNameParams_Depth :: !(Comparison Int)
    , DirNameParams -> CaseSensitivity
_DirNameParams_CaseSensitivity :: !CaseSensitivity
    }
    deriving (Int -> DirNameParams -> ShowS
[DirNameParams] -> ShowS
DirNameParams -> String
(Int -> DirNameParams -> ShowS)
-> (DirNameParams -> String)
-> ([DirNameParams] -> ShowS)
-> Show DirNameParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DirNameParams] -> ShowS
$cshowList :: [DirNameParams] -> ShowS
show :: DirNameParams -> String
$cshow :: DirNameParams -> String
showsPrec :: Int -> DirNameParams -> ShowS
$cshowsPrec :: Int -> DirNameParams -> ShowS
Show, DirNameParams -> DirNameParams -> Bool
(DirNameParams -> DirNameParams -> Bool)
-> (DirNameParams -> DirNameParams -> Bool) -> Eq DirNameParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DirNameParams -> DirNameParams -> Bool
$c/= :: DirNameParams -> DirNameParams -> Bool
== :: DirNameParams -> DirNameParams -> Bool
$c== :: DirNameParams -> DirNameParams -> Bool
Eq, Eq DirNameParams
Eq DirNameParams
-> (DirNameParams -> DirNameParams -> Ordering)
-> (DirNameParams -> DirNameParams -> Bool)
-> (DirNameParams -> DirNameParams -> Bool)
-> (DirNameParams -> DirNameParams -> Bool)
-> (DirNameParams -> DirNameParams -> Bool)
-> (DirNameParams -> DirNameParams -> DirNameParams)
-> (DirNameParams -> DirNameParams -> DirNameParams)
-> Ord DirNameParams
DirNameParams -> DirNameParams -> Bool
DirNameParams -> DirNameParams -> Ordering
DirNameParams -> DirNameParams -> DirNameParams
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DirNameParams -> DirNameParams -> DirNameParams
$cmin :: DirNameParams -> DirNameParams -> DirNameParams
max :: DirNameParams -> DirNameParams -> DirNameParams
$cmax :: DirNameParams -> DirNameParams -> DirNameParams
>= :: DirNameParams -> DirNameParams -> Bool
$c>= :: DirNameParams -> DirNameParams -> Bool
> :: DirNameParams -> DirNameParams -> Bool
$c> :: DirNameParams -> DirNameParams -> Bool
<= :: DirNameParams -> DirNameParams -> Bool
$c<= :: DirNameParams -> DirNameParams -> Bool
< :: DirNameParams -> DirNameParams -> Bool
$c< :: DirNameParams -> DirNameParams -> Bool
compare :: DirNameParams -> DirNameParams -> Ordering
$ccompare :: DirNameParams -> DirNameParams -> Ordering
$cp1Ord :: Eq DirNameParams
Ord)

defaultDirNameParams :: DirNameParams
defaultDirNameParams :: DirNameParams
defaultDirNameParams = DirNameParams :: Comparison Int -> CaseSensitivity -> DirNameParams
DirNameParams
    { _DirNameParams_Depth :: Comparison Int
_DirNameParams_Depth = Int -> Comparison Int
forall a. a -> Comparison a
Ge Int
0
    , _DirNameParams_CaseSensitivity :: CaseSensitivity
_DirNameParams_CaseSensitivity = CaseSensitivity
CaseSensitive
    }

instance HasCaseSensitivityOption DirNameParams where
    setCaseSensitivity :: CaseSensitivity -> DirNameParams -> DirNameParams
setCaseSensitivity CaseSensitivity
c DirNameParams
x = DirNameParams
x { _DirNameParams_CaseSensitivity :: CaseSensitivity
_DirNameParams_CaseSensitivity = CaseSensitivity
c }

data MatchParams = MatchParams
    { MatchParams -> CaseSensitivity
_MatchParams_CaseSensitivity :: !CaseSensitivity
    , MatchParams -> PathScope
_MatchParams_PathScope :: !PathScope
    , MatchParams -> Bool
_MatchParams_IncludeDotFiles :: !Bool
    , MatchParams -> Bool
_MatchParams_NoEscape :: !Bool
    }
    deriving (Int -> MatchParams -> ShowS
[MatchParams] -> ShowS
MatchParams -> String
(Int -> MatchParams -> ShowS)
-> (MatchParams -> String)
-> ([MatchParams] -> ShowS)
-> Show MatchParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatchParams] -> ShowS
$cshowList :: [MatchParams] -> ShowS
show :: MatchParams -> String
$cshow :: MatchParams -> String
showsPrec :: Int -> MatchParams -> ShowS
$cshowsPrec :: Int -> MatchParams -> ShowS
Show, MatchParams -> MatchParams -> Bool
(MatchParams -> MatchParams -> Bool)
-> (MatchParams -> MatchParams -> Bool) -> Eq MatchParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatchParams -> MatchParams -> Bool
$c/= :: MatchParams -> MatchParams -> Bool
== :: MatchParams -> MatchParams -> Bool
$c== :: MatchParams -> MatchParams -> Bool
Eq, Eq MatchParams
Eq MatchParams
-> (MatchParams -> MatchParams -> Ordering)
-> (MatchParams -> MatchParams -> Bool)
-> (MatchParams -> MatchParams -> Bool)
-> (MatchParams -> MatchParams -> Bool)
-> (MatchParams -> MatchParams -> Bool)
-> (MatchParams -> MatchParams -> MatchParams)
-> (MatchParams -> MatchParams -> MatchParams)
-> Ord MatchParams
MatchParams -> MatchParams -> Bool
MatchParams -> MatchParams -> Ordering
MatchParams -> MatchParams -> MatchParams
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MatchParams -> MatchParams -> MatchParams
$cmin :: MatchParams -> MatchParams -> MatchParams
max :: MatchParams -> MatchParams -> MatchParams
$cmax :: MatchParams -> MatchParams -> MatchParams
>= :: MatchParams -> MatchParams -> Bool
$c>= :: MatchParams -> MatchParams -> Bool
> :: MatchParams -> MatchParams -> Bool
$c> :: MatchParams -> MatchParams -> Bool
<= :: MatchParams -> MatchParams -> Bool
$c<= :: MatchParams -> MatchParams -> Bool
< :: MatchParams -> MatchParams -> Bool
$c< :: MatchParams -> MatchParams -> Bool
compare :: MatchParams -> MatchParams -> Ordering
$ccompare :: MatchParams -> MatchParams -> Ordering
$cp1Ord :: Eq MatchParams
Ord)

defaultMatchParams :: MatchParams
defaultMatchParams :: MatchParams
defaultMatchParams = MatchParams :: CaseSensitivity -> PathScope -> Bool -> Bool -> MatchParams
MatchParams
    { _MatchParams_CaseSensitivity :: CaseSensitivity
_MatchParams_CaseSensitivity = CaseSensitivity
CaseSensitive
    , _MatchParams_PathScope :: PathScope
_MatchParams_PathScope = PathScope
BaseName
    , _MatchParams_IncludeDotFiles :: Bool
_MatchParams_IncludeDotFiles = Bool
False
    , _MatchParams_NoEscape :: Bool
_MatchParams_NoEscape = Bool
False
    }

instance HasCaseSensitivityOption MatchParams where
    setCaseSensitivity :: CaseSensitivity -> MatchParams -> MatchParams
setCaseSensitivity CaseSensitivity
c MatchParams
x = MatchParams
x { _MatchParams_CaseSensitivity :: CaseSensitivity
_MatchParams_CaseSensitivity = CaseSensitivity
c }

instance HasPathScopeOption MatchParams where
    setPathScope :: PathScope -> MatchParams -> MatchParams
setPathScope PathScope
c MatchParams
x = MatchParams
x { _MatchParams_PathScope :: PathScope
_MatchParams_PathScope = PathScope
c }

data NameParams = NameParams
    { NameParams -> CaseSensitivity
_NameParams_CaseSensitivity :: !CaseSensitivity
    , NameParams -> PathScope
_NameParams_PathScope :: !PathScope
    }
    deriving (Int -> NameParams -> ShowS
[NameParams] -> ShowS
NameParams -> String
(Int -> NameParams -> ShowS)
-> (NameParams -> String)
-> ([NameParams] -> ShowS)
-> Show NameParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameParams] -> ShowS
$cshowList :: [NameParams] -> ShowS
show :: NameParams -> String
$cshow :: NameParams -> String
showsPrec :: Int -> NameParams -> ShowS
$cshowsPrec :: Int -> NameParams -> ShowS
Show, NameParams -> NameParams -> Bool
(NameParams -> NameParams -> Bool)
-> (NameParams -> NameParams -> Bool) -> Eq NameParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameParams -> NameParams -> Bool
$c/= :: NameParams -> NameParams -> Bool
== :: NameParams -> NameParams -> Bool
$c== :: NameParams -> NameParams -> Bool
Eq, Eq NameParams
Eq NameParams
-> (NameParams -> NameParams -> Ordering)
-> (NameParams -> NameParams -> Bool)
-> (NameParams -> NameParams -> Bool)
-> (NameParams -> NameParams -> Bool)
-> (NameParams -> NameParams -> Bool)
-> (NameParams -> NameParams -> NameParams)
-> (NameParams -> NameParams -> NameParams)
-> Ord NameParams
NameParams -> NameParams -> Bool
NameParams -> NameParams -> Ordering
NameParams -> NameParams -> NameParams
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NameParams -> NameParams -> NameParams
$cmin :: NameParams -> NameParams -> NameParams
max :: NameParams -> NameParams -> NameParams
$cmax :: NameParams -> NameParams -> NameParams
>= :: NameParams -> NameParams -> Bool
$c>= :: NameParams -> NameParams -> Bool
> :: NameParams -> NameParams -> Bool
$c> :: NameParams -> NameParams -> Bool
<= :: NameParams -> NameParams -> Bool
$c<= :: NameParams -> NameParams -> Bool
< :: NameParams -> NameParams -> Bool
$c< :: NameParams -> NameParams -> Bool
compare :: NameParams -> NameParams -> Ordering
$ccompare :: NameParams -> NameParams -> Ordering
$cp1Ord :: Eq NameParams
Ord)

defaultNameParams :: NameParams
defaultNameParams :: NameParams
defaultNameParams = NameParams :: CaseSensitivity -> PathScope -> NameParams
NameParams
    { _NameParams_CaseSensitivity :: CaseSensitivity
_NameParams_CaseSensitivity = CaseSensitivity
CaseSensitive
    , _NameParams_PathScope :: PathScope
_NameParams_PathScope = PathScope
BaseName
    }

instance HasCaseSensitivityOption NameParams where
    setCaseSensitivity :: CaseSensitivity -> NameParams -> NameParams
setCaseSensitivity CaseSensitivity
c NameParams
x = NameParams
x { _NameParams_CaseSensitivity :: CaseSensitivity
_NameParams_CaseSensitivity = CaseSensitivity
c }

instance HasPathScopeOption NameParams where
    setPathScope :: PathScope -> NameParams -> NameParams
setPathScope PathScope
c NameParams
x = NameParams
x { _NameParams_PathScope :: PathScope
_NameParams_PathScope = PathScope
c }

true :: Expression
true :: Expression
true = Expression
ETrue

false :: Expression
false :: Expression
false = Expression
EFalse

all :: [Expression] -> Expression
all :: [Expression] -> Expression
all = [Expression] -> Expression
EAllOf

any :: [Expression] -> Expression
any :: [Expression] -> Expression
any = [Expression] -> Expression
EAnyOf

infixr 3 .&&
(.&&) :: Expression -> Expression -> Expression
Expression
lhs .&& :: Expression -> Expression -> Expression
.&& Expression
rhs = [Expression] -> Expression
EAllOf [Expression
lhs, Expression
rhs]

infixr 2 .||
(.||) :: Expression -> Expression -> Expression
Expression
lhs .|| :: Expression -> Expression -> Expression
.|| Expression
rhs = [Expression] -> Expression
EAnyOf [Expression
lhs, Expression
rhs]

dirname :: WFilePath -> Expression
dirname :: WFilePath -> Expression
dirname WFilePath
path = WFilePath -> DirNameParams -> Expression
EDirName WFilePath
path DirNameParams
defaultDirNameParams

dirname' :: WFilePath -> [DirNameParams -> DirNameParams] -> Expression
dirname' :: WFilePath -> [DirNameParams -> DirNameParams] -> Expression
dirname' WFilePath
path [DirNameParams -> DirNameParams]
modifiers = WFilePath -> DirNameParams -> Expression
EDirName WFilePath
path (DirNameParams -> [DirNameParams -> DirNameParams] -> DirNameParams
forall a. a -> [a -> a] -> a
applyModifiers DirNameParams
defaultDirNameParams [DirNameParams -> DirNameParams]
modifiers)

empty :: Expression
empty :: Expression
empty = Expression
EEmpty

exists :: Expression
exists :: Expression
exists = Expression
EExists

match :: ByteString -> Expression
match :: ByteString -> Expression
match ByteString
pattern = ByteString -> MatchParams -> Expression
EMatch ByteString
pattern MatchParams
defaultMatchParams

match' :: ByteString -> [MatchParams -> MatchParams] -> Expression
match' :: ByteString -> [MatchParams -> MatchParams] -> Expression
match' ByteString
pattern [MatchParams -> MatchParams]
modifiers = ByteString -> MatchParams -> Expression
EMatch ByteString
pattern (MatchParams -> [MatchParams -> MatchParams] -> MatchParams
forall a. a -> [a -> a] -> a
applyModifiers MatchParams
defaultMatchParams [MatchParams -> MatchParams]
modifiers)

name :: [WFilePath] -> Expression
name :: [WFilePath] -> Expression
name [WFilePath]
files = [WFilePath] -> NameParams -> Expression
EName [WFilePath]
files NameParams
defaultNameParams

name' :: [WFilePath] -> [NameParams -> NameParams] -> Expression
name' :: [WFilePath] -> [NameParams -> NameParams] -> Expression
name' [WFilePath]
files [NameParams -> NameParams]
modifiers = [WFilePath] -> NameParams -> Expression
EName [WFilePath]
files (NameParams -> [NameParams -> NameParams] -> NameParams
forall a. a -> [a -> a] -> a
applyModifiers NameParams
defaultNameParams [NameParams -> NameParams]
modifiers)

not :: Expression -> Expression
not :: Expression -> Expression
not = Expression -> Expression
ENot

size :: Comparison Int64 -> Expression
size :: Comparison Int64 -> Expression
size = Comparison Int64 -> Expression
ESize

suffix :: ByteString -> Expression
suffix :: ByteString -> Expression
suffix = ByteString -> Expression
ESuffix

type_ :: FileType -> Expression
type_ :: FileType -> Expression
type_ = FileType -> Expression
EType


applyModifiers :: a -> [a -> a] -> a
applyModifiers :: a -> [a -> a] -> a
applyModifiers a
def [a -> a]
modifiers = (a -> (a -> a) -> a) -> a -> [a -> a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\a
x a -> a
f -> a -> a
f a
x) a
def [a -> a]
modifiers

caseSensitive :: HasCaseSensitivityOption a => a -> a
caseSensitive :: a -> a
caseSensitive = CaseSensitivity -> a -> a
forall a. HasCaseSensitivityOption a => CaseSensitivity -> a -> a
setCaseSensitivity CaseSensitivity
CaseSensitive

caseInsensitive :: HasCaseSensitivityOption a => a -> a
caseInsensitive :: a -> a
caseInsensitive = CaseSensitivity -> a -> a
forall a. HasCaseSensitivityOption a => CaseSensitivity -> a -> a
setCaseSensitivity CaseSensitivity
CaseInsensitive

basename :: HasPathScopeOption a => a -> a
basename :: a -> a
basename = PathScope -> a -> a
forall a. HasPathScopeOption a => PathScope -> a -> a
setPathScope PathScope
BaseName

wholename :: HasPathScopeOption a => a -> a
wholename :: a -> a
wholename = PathScope -> a -> a
forall a. HasPathScopeOption a => PathScope -> a -> a
setPathScope PathScope
BaseName

depth :: Comparison Int -> DirNameParams -> DirNameParams
depth :: Comparison Int -> DirNameParams -> DirNameParams
depth Comparison Int
c DirNameParams
x = DirNameParams
x { _DirNameParams_Depth :: Comparison Int
_DirNameParams_Depth = Comparison Int
c }

includeDotFiles :: MatchParams -> MatchParams
includeDotFiles :: MatchParams -> MatchParams
includeDotFiles MatchParams
x = MatchParams
x { _MatchParams_IncludeDotFiles :: Bool
_MatchParams_IncludeDotFiles = Bool
True }

noEscape :: MatchParams -> MatchParams
noEscape :: MatchParams -> MatchParams
noEscape MatchParams
x = MatchParams
x { _MatchParams_NoEscape :: Bool
_MatchParams_NoEscape = Bool
True }

data Comparison a
    = Eq !a -- ^ Equal
    | Ne !a -- ^ Not Equal
    | Gt !a -- ^ Greater Than
    | Ge !a -- ^ Greater Than or Equal
    | Lt !a -- ^ Less Than
    | Le !a -- ^ Less Than or Equal
    deriving (Int -> Comparison a -> ShowS
[Comparison a] -> ShowS
Comparison a -> String
(Int -> Comparison a -> ShowS)
-> (Comparison a -> String)
-> ([Comparison a] -> ShowS)
-> Show (Comparison a)
forall a. Show a => Int -> Comparison a -> ShowS
forall a. Show a => [Comparison a] -> ShowS
forall a. Show a => Comparison a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Comparison a] -> ShowS
$cshowList :: forall a. Show a => [Comparison a] -> ShowS
show :: Comparison a -> String
$cshow :: forall a. Show a => Comparison a -> String
showsPrec :: Int -> Comparison a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Comparison a -> ShowS
Show, Comparison a -> Comparison a -> Bool
(Comparison a -> Comparison a -> Bool)
-> (Comparison a -> Comparison a -> Bool) -> Eq (Comparison a)
forall a. Eq a => Comparison a -> Comparison a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Comparison a -> Comparison a -> Bool
$c/= :: forall a. Eq a => Comparison a -> Comparison a -> Bool
== :: Comparison a -> Comparison a -> Bool
$c== :: forall a. Eq a => Comparison a -> Comparison a -> Bool
Eq, Eq (Comparison a)
Eq (Comparison a)
-> (Comparison a -> Comparison a -> Ordering)
-> (Comparison a -> Comparison a -> Bool)
-> (Comparison a -> Comparison a -> Bool)
-> (Comparison a -> Comparison a -> Bool)
-> (Comparison a -> Comparison a -> Bool)
-> (Comparison a -> Comparison a -> Comparison a)
-> (Comparison a -> Comparison a -> Comparison a)
-> Ord (Comparison a)
Comparison a -> Comparison a -> Bool
Comparison a -> Comparison a -> Ordering
Comparison a -> Comparison a -> Comparison a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Comparison a)
forall a. Ord a => Comparison a -> Comparison a -> Bool
forall a. Ord a => Comparison a -> Comparison a -> Ordering
forall a. Ord a => Comparison a -> Comparison a -> Comparison a
min :: Comparison a -> Comparison a -> Comparison a
$cmin :: forall a. Ord a => Comparison a -> Comparison a -> Comparison a
max :: Comparison a -> Comparison a -> Comparison a
$cmax :: forall a. Ord a => Comparison a -> Comparison a -> Comparison a
>= :: Comparison a -> Comparison a -> Bool
$c>= :: forall a. Ord a => Comparison a -> Comparison a -> Bool
> :: Comparison a -> Comparison a -> Bool
$c> :: forall a. Ord a => Comparison a -> Comparison a -> Bool
<= :: Comparison a -> Comparison a -> Bool
$c<= :: forall a. Ord a => Comparison a -> Comparison a -> Bool
< :: Comparison a -> Comparison a -> Bool
$c< :: forall a. Ord a => Comparison a -> Comparison a -> Bool
compare :: Comparison a -> Comparison a -> Ordering
$ccompare :: forall a. Ord a => Comparison a -> Comparison a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Comparison a)
Ord)

renderPathScope :: PathScope -> BSERValue
renderPathScope :: PathScope -> BSERValue
renderPathScope PathScope
BaseName = ByteString -> BSERValue
BSERString ByteString
"basename"
renderPathScope PathScope
WholeName = ByteString -> BSERValue
BSERString ByteString
"wholename"

renderOperator :: Comparison a -> BSERValue
renderOperator :: Comparison a -> BSERValue
renderOperator (Eq a
_) = ByteString -> BSERValue
BSERString ByteString
"eq"
renderOperator (Ne a
_) = ByteString -> BSERValue
BSERString ByteString
"ne"
renderOperator (Gt a
_) = ByteString -> BSERValue
BSERString ByteString
"gt"
renderOperator (Ge a
_) = ByteString -> BSERValue
BSERString ByteString
"ge"
renderOperator (Lt a
_) = ByteString -> BSERValue
BSERString ByteString
"lt"
renderOperator (Le a
_) = ByteString -> BSERValue
BSERString ByteString
"le"

comparisonValue :: Integral n => Comparison n -> BSERValue
comparisonValue :: Comparison n -> BSERValue
comparisonValue (Eq n
v) = n -> BSERValue
forall n. Integral n => n -> BSERValue
compactBSERInt n
v
comparisonValue (Ne n
v) = n -> BSERValue
forall n. Integral n => n -> BSERValue
compactBSERInt n
v
comparisonValue (Gt n
v) = n -> BSERValue
forall n. Integral n => n -> BSERValue
compactBSERInt n
v
comparisonValue (Ge n
v) = n -> BSERValue
forall n. Integral n => n -> BSERValue
compactBSERInt n
v
comparisonValue (Lt n
v) = n -> BSERValue
forall n. Integral n => n -> BSERValue
compactBSERInt n
v
comparisonValue (Le n
v) = n -> BSERValue
forall n. Integral n => n -> BSERValue
compactBSERInt n
v

renderExpression :: Expression -> BSERValue
renderExpression :: Expression -> BSERValue
renderExpression (EAllOf [Expression]
exprs) =
    Seq BSERValue -> BSERValue
BSERArray (ByteString -> BSERValue
BSERString ByteString
"allof" BSERValue -> Seq BSERValue -> Seq BSERValue
forall a. a -> Seq a -> Seq a
Seq.<| [BSERValue] -> Seq BSERValue
forall a. [a] -> Seq a
Seq.fromList ((Expression -> BSERValue) -> [Expression] -> [BSERValue]
forall a b. (a -> b) -> [a] -> [b]
map Expression -> BSERValue
renderExpression [Expression]
exprs))
renderExpression (EAnyOf [Expression]
exprs) =
    Seq BSERValue -> BSERValue
BSERArray (ByteString -> BSERValue
BSERString ByteString
"anyof" BSERValue -> Seq BSERValue -> Seq BSERValue
forall a. a -> Seq a -> Seq a
Seq.<| [BSERValue] -> Seq BSERValue
forall a. [a] -> Seq a
Seq.fromList ((Expression -> BSERValue) -> [Expression] -> [BSERValue]
forall a b. (a -> b) -> [a] -> [b]
map Expression -> BSERValue
renderExpression [Expression]
exprs))
renderExpression (EDirName (WFilePath ByteString
p) (DirNameParams Comparison Int
d CaseSensitivity
caseSensitivity)) =
    Seq BSERValue -> BSERValue
BSERArray ([BSERValue] -> Seq BSERValue
forall a. [a] -> Seq a
Seq.fromList [ByteString -> BSERValue
BSERString ByteString
exprName, ByteString -> BSERValue
BSERString ByteString
p, Seq BSERValue -> BSERValue
BSERArray ([BSERValue] -> Seq BSERValue
forall a. [a] -> Seq a
Seq.fromList [ByteString -> BSERValue
BSERString ByteString
"depth", Comparison Int -> BSERValue
forall a. Comparison a -> BSERValue
renderOperator Comparison Int
d, Comparison Int -> BSERValue
forall n. Integral n => Comparison n -> BSERValue
comparisonValue Comparison Int
d])])
    where
    exprName :: ByteString
exprName = case CaseSensitivity
caseSensitivity of { CaseSensitivity
CaseSensitive -> ByteString
"dirname"; CaseSensitivity
CaseInsensitive -> ByteString
"idirname" }
renderExpression Expression
ETrue = ByteString -> BSERValue
BSERString ByteString
"true"
renderExpression Expression
EFalse = ByteString -> BSERValue
BSERString ByteString
"false"
renderExpression Expression
EEmpty = ByteString -> BSERValue
BSERString ByteString
"empty"
renderExpression Expression
EExists = ByteString -> BSERValue
BSERString ByteString
"exists"
renderExpression (EMatch ByteString
pattern (MatchParams CaseSensitivity
caseSensitivity PathScope
pathScope Bool
includeDotFiles_ Bool
noEscape_)) =
    Seq BSERValue -> BSERValue
BSERArray ([BSERValue] -> Seq BSERValue
forall a. [a] -> Seq a
Seq.fromList [ByteString -> BSERValue
BSERString ByteString
exprName, ByteString -> BSERValue
BSERString ByteString
pattern, PathScope -> BSERValue
renderPathScope PathScope
pathScope] Seq BSERValue -> Seq BSERValue -> Seq BSERValue
forall a. Seq a -> Seq a -> Seq a
Seq.>< Seq BSERValue
flags)
    where
    exprName :: ByteString
exprName = case CaseSensitivity
caseSensitivity of { CaseSensitivity
CaseSensitive -> ByteString
"match"; CaseSensitivity
CaseInsensitive -> ByteString
"imatch" }
    flagsMap :: Map ByteString BSERValue
flagsMap = [Map ByteString BSERValue] -> Map ByteString BSERValue
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions
        [ if Bool
includeDotFiles_ then ByteString -> BSERValue -> Map ByteString BSERValue
forall k a. k -> a -> Map k a
M.singleton ByteString
"includedotfiles" (Bool -> BSERValue
BSERBool Bool
True) else Map ByteString BSERValue
forall k a. Map k a
M.empty
        , if Bool
noEscape_ then ByteString -> BSERValue -> Map ByteString BSERValue
forall k a. k -> a -> Map k a
M.singleton ByteString
"noescape" (Bool -> BSERValue
BSERBool Bool
True) else Map ByteString BSERValue
forall k a. Map k a
M.empty
        ]
    flags :: Seq BSERValue
flags = if Map ByteString BSERValue -> Bool
forall k a. Map k a -> Bool
M.null Map ByteString BSERValue
flagsMap then Seq BSERValue
forall a. Seq a
Seq.empty else BSERValue -> Seq BSERValue
forall a. a -> Seq a
Seq.singleton (Map ByteString BSERValue -> BSERValue
BSERObject Map ByteString BSERValue
flagsMap)
renderExpression (EName [WFilePath]
files (NameParams CaseSensitivity
caseSensitivity PathScope
pathScope)) =
    Seq BSERValue -> BSERValue
BSERArray ([BSERValue] -> Seq BSERValue
forall a. [a] -> Seq a
Seq.fromList [ByteString -> BSERValue
BSERString ByteString
exprName, Seq BSERValue -> BSERValue
BSERArray ([BSERValue] -> Seq BSERValue
forall a. [a] -> Seq a
Seq.fromList ((WFilePath -> BSERValue) -> [WFilePath] -> [BSERValue]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> BSERValue
BSERString (ByteString -> BSERValue)
-> (WFilePath -> ByteString) -> WFilePath -> BSERValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WFilePath -> ByteString
toByteString) [WFilePath]
files)), PathScope -> BSERValue
renderPathScope PathScope
pathScope])
    where
    exprName :: ByteString
exprName = case CaseSensitivity
caseSensitivity of { CaseSensitivity
CaseSensitive -> ByteString
"name"; CaseSensitivity
CaseInsensitive -> ByteString
"iname" }
renderExpression (ESince ()
_) = String -> BSERValue
forall a. HasCallStack => String -> a
error String
"TODO 928352935423"
renderExpression (ENot Expression
expr) =
    Seq BSERValue -> BSERValue
BSERArray ([BSERValue] -> Seq BSERValue
forall a. [a] -> Seq a
Seq.fromList [ByteString -> BSERValue
BSERString ByteString
"not", Expression -> BSERValue
renderExpression Expression
expr])
renderExpression (ESize Comparison Int64
s) =
    Seq BSERValue -> BSERValue
BSERArray ([BSERValue] -> Seq BSERValue
forall a. [a] -> Seq a
Seq.fromList [ByteString -> BSERValue
BSERString ByteString
"size", Comparison Int64 -> BSERValue
forall a. Comparison a -> BSERValue
renderOperator Comparison Int64
s, Comparison Int64 -> BSERValue
forall n. Integral n => Comparison n -> BSERValue
comparisonValue Comparison Int64
s])
renderExpression (ESuffix ByteString
s) =
    Seq BSERValue -> BSERValue
BSERArray ([BSERValue] -> Seq BSERValue
forall a. [a] -> Seq a
Seq.fromList [ByteString -> BSERValue
BSERString ByteString
"suffix", ByteString -> BSERValue
BSERString ByteString
s])
renderExpression (EType FileType
t) =
    Seq BSERValue -> BSERValue
BSERArray ([BSERValue] -> Seq BSERValue
forall a. [a] -> Seq a
Seq.fromList [ByteString -> BSERValue
BSERString ByteString
"type", ByteString -> BSERValue
BSERString (FileType -> ByteString
fileTypeChar FileType
t)])