{-# LANGUAGE OverloadedStrings #-}
module System.Directory.Watchman.Query
( Generators
, QueryParams
, QueryResult(..)
, renderQuery
, parseQueryResult
, since
, suffix
, path
, relativeRoot
, lockTimeout
) where
import Data.Foldable (foldl')
import Control.Monad (unless)
import Data.ByteString (ByteString)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import qualified Data.Map.Strict as M
import Data.Map.Strict (Map)
import qualified Data.ByteString.Char8 as BC8
import System.Directory.Watchman.WFilePath
import System.Directory.Watchman.Fields
import System.Directory.Watchman.Expression (Expression, renderExpression)
import System.Directory.Watchman.BSER
import System.Directory.Watchman.BSER.Parser
import System.Directory.Watchman.Clockspec
import System.Directory.Watchman.SyncTimeout
data Since = Since Clockspec
data Suffix = Suffix [ByteString]
data Path = Path [(WFilePath, Maybe Int)]
data Generators = Generators (Maybe Since) (Maybe Suffix) (Maybe Path)
since :: Clockspec -> (Generators -> Generators)
since :: Clockspec -> Generators -> Generators
since Clockspec
clockSpec (Generators Maybe Since
_ Maybe Suffix
a Maybe Path
b) = Maybe Since -> Maybe Suffix -> Maybe Path -> Generators
Generators (Since -> Maybe Since
forall a. a -> Maybe a
Just (Clockspec -> Since
Since Clockspec
clockSpec)) Maybe Suffix
a Maybe Path
b
suffix :: [ByteString] -> Generators -> Generators
suffix :: [ByteString] -> Generators -> Generators
suffix [ByteString]
suffixes (Generators Maybe Since
a Maybe Suffix
_ Maybe Path
b) = Maybe Since -> Maybe Suffix -> Maybe Path -> Generators
Generators Maybe Since
a (Suffix -> Maybe Suffix
forall a. a -> Maybe a
Just ([ByteString] -> Suffix
Suffix [ByteString]
suffixes)) Maybe Path
b
path :: [(WFilePath, Maybe Int)] -> Generators -> Generators
path :: [(WFilePath, Maybe Int)] -> Generators -> Generators
path [(WFilePath, Maybe Int)]
paths (Generators Maybe Since
a Maybe Suffix
b Maybe Path
_) = Maybe Since -> Maybe Suffix -> Maybe Path -> Generators
Generators Maybe Since
a Maybe Suffix
b (Path -> Maybe Path
forall a. a -> Maybe a
Just ([(WFilePath, Maybe Int)] -> Path
Path [(WFilePath, Maybe Int)]
paths))
relativeRoot :: WFilePath -> (QueryParams -> QueryParams)
relativeRoot :: WFilePath -> QueryParams -> QueryParams
relativeRoot WFilePath
p QueryParams
x = QueryParams
x { _QueryParams_RelativeRoot :: Maybe WFilePath
_QueryParams_RelativeRoot = WFilePath -> Maybe WFilePath
forall a. a -> Maybe a
Just WFilePath
p }
lockTimeout :: Int -> (QueryParams -> QueryParams)
lockTimeout :: Int -> QueryParams -> QueryParams
lockTimeout Int
n QueryParams
x = QueryParams
x { _QueryParams_LockTimeout :: Maybe Int
_QueryParams_LockTimeout = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n }
applyGenerators :: [Generators -> Generators] -> Generators
applyGenerators :: [Generators -> Generators] -> Generators
applyGenerators = (Generators -> (Generators -> Generators) -> Generators)
-> Generators -> [Generators -> Generators] -> Generators
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Generators
x Generators -> Generators
f -> Generators -> Generators
f Generators
x) (Maybe Since -> Maybe Suffix -> Maybe Path -> Generators
Generators Maybe Since
forall a. Maybe a
Nothing Maybe Suffix
forall a. Maybe a
Nothing Maybe Path
forall a. Maybe a
Nothing)
applyParams :: [QueryParams -> QueryParams] -> QueryParams
applyParams :: [QueryParams -> QueryParams] -> QueryParams
applyParams = (QueryParams -> (QueryParams -> QueryParams) -> QueryParams)
-> QueryParams -> [QueryParams -> QueryParams] -> QueryParams
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\QueryParams
x QueryParams -> QueryParams
f -> QueryParams -> QueryParams
f QueryParams
x) (Maybe WFilePath -> Maybe Int -> Maybe Int -> QueryParams
QueryParams Maybe WFilePath
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing)
data QueryParams = QueryParams
{ QueryParams -> Maybe WFilePath
_QueryParams_RelativeRoot :: !(Maybe WFilePath)
, QueryParams -> Maybe Int
_QueryParams_SyncTimeout :: !(Maybe Int)
, QueryParams -> Maybe Int
_QueryParams_LockTimeout :: !(Maybe Int)
}
instance HasSyncTimeoutOption QueryParams where
setSyncTimeout :: Maybe Int -> QueryParams -> QueryParams
setSyncTimeout Maybe Int
n QueryParams
x = QueryParams
x { _QueryParams_SyncTimeout :: Maybe Int
_QueryParams_SyncTimeout = Maybe Int
n }
renderQuery :: WFilePath -> [Generators -> Generators] -> Expression -> [QueryParams -> QueryParams] -> [FileFieldLabel] -> BSERValue
renderQuery :: WFilePath
-> [Generators -> Generators]
-> Expression
-> [QueryParams -> QueryParams]
-> [FileFieldLabel]
-> BSERValue
renderQuery WFilePath
rootPath [Generators -> Generators]
generators Expression
expr [QueryParams -> QueryParams]
params [FileFieldLabel]
fileFieldLabels =
Seq BSERValue -> BSERValue
BSERArray (Seq BSERValue -> BSERValue) -> Seq BSERValue -> BSERValue
forall a b. (a -> b) -> a -> b
$ [BSERValue] -> Seq BSERValue
forall a. [a] -> Seq a
Seq.fromList
[ ByteString -> BSERValue
BSERString ByteString
"query"
, ByteString -> BSERValue
BSERString (WFilePath -> ByteString
toByteString WFilePath
rootPath)
, Map ByteString BSERValue -> BSERValue
BSERObject (Map ByteString BSERValue -> BSERValue)
-> Map ByteString BSERValue -> BSERValue
forall a b. (a -> b) -> a -> b
$ [Map ByteString BSERValue] -> Map ByteString BSERValue
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions
[ Generators -> Map ByteString BSERValue
renderGenerators Generators
generators'
, [FileFieldLabel] -> Map ByteString BSERValue
renderFieldLabels [FileFieldLabel]
fileFieldLabels
, ByteString -> BSERValue -> Map ByteString BSERValue
forall k a. k -> a -> Map k a
M.singleton ByteString
"expression" (Expression -> BSERValue
renderExpression Expression
expr)
, QueryParams -> Map ByteString BSERValue
renderQueryParams QueryParams
params'
]
]
where
generators' :: Generators
generators' = [Generators -> Generators] -> Generators
applyGenerators [Generators -> Generators]
generators
params' :: QueryParams
params' = [QueryParams -> QueryParams] -> QueryParams
applyParams [QueryParams -> QueryParams]
params
renderGenerators :: Generators -> Map ByteString BSERValue
renderGenerators :: Generators -> Map ByteString BSERValue
renderGenerators (Generators Maybe Since
mbSince Maybe Suffix
mbSuffix Maybe Path
mbPath) =
[Map ByteString BSERValue] -> Map ByteString BSERValue
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions [Map ByteString BSERValue
renderedSince, Map ByteString BSERValue
renderedSuffix, Map ByteString BSERValue
renderedPath]
where
renderedSince :: Map ByteString BSERValue
renderedSince = Map ByteString BSERValue
-> (Since -> Map ByteString BSERValue)
-> Maybe Since
-> Map ByteString BSERValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
Map ByteString BSERValue
forall k a. Map k a
M.empty
(\(Since Clockspec
clockspec) -> ByteString -> BSERValue -> Map ByteString BSERValue
forall k a. k -> a -> Map k a
M.singleton ByteString
"since" (Clockspec -> BSERValue
renderClockspec Clockspec
clockspec))
Maybe Since
mbSince
renderedSuffix :: Map ByteString BSERValue
renderedSuffix = Map ByteString BSERValue
-> (Suffix -> Map ByteString BSERValue)
-> Maybe Suffix
-> Map ByteString BSERValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
Map ByteString BSERValue
forall k a. Map k a
M.empty
(\(Suffix [ByteString]
suffixes) -> ByteString -> BSERValue -> Map ByteString BSERValue
forall k a. k -> a -> Map k a
M.singleton ByteString
"suffix" (Seq BSERValue -> BSERValue
BSERArray ((ByteString -> BSERValue) -> Seq ByteString -> Seq BSERValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> BSERValue
BSERString ([ByteString] -> Seq ByteString
forall a. [a] -> Seq a
Seq.fromList [ByteString]
suffixes))))
Maybe Suffix
mbSuffix
renderedPath :: Map ByteString BSERValue
renderedPath = Map ByteString BSERValue
-> (Path -> Map ByteString BSERValue)
-> Maybe Path
-> Map ByteString BSERValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
Map ByteString BSERValue
forall k a. Map k a
M.empty
(\(Path [(WFilePath, Maybe Int)]
paths) -> ByteString -> BSERValue -> Map ByteString BSERValue
forall k a. k -> a -> Map k a
M.singleton ByteString
"path" (Seq BSERValue -> BSERValue
BSERArray (((WFilePath, Maybe Int) -> BSERValue)
-> Seq (WFilePath, Maybe Int) -> Seq BSERValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WFilePath, Maybe Int) -> BSERValue
renderPathElement ([(WFilePath, Maybe Int)] -> Seq (WFilePath, Maybe Int)
forall a. [a] -> Seq a
Seq.fromList [(WFilePath, Maybe Int)]
paths))))
Maybe Path
mbPath
renderPathElement :: (WFilePath, Maybe Int) -> BSERValue
renderPathElement :: (WFilePath, Maybe Int) -> BSERValue
renderPathElement (WFilePath
path_, Maybe Int
Nothing) = ByteString -> BSERValue
BSERString (WFilePath -> ByteString
toByteString WFilePath
path_)
renderPathElement (WFilePath
path_, Just Int
depth)
| Int
depth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> BSERValue
forall a. HasCallStack => [Char] -> a
error ([Char] -> BSERValue) -> [Char] -> BSERValue
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid depth value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
depth
| Bool
otherwise =
Map ByteString BSERValue -> BSERValue
BSERObject (Map ByteString BSERValue -> BSERValue)
-> Map ByteString BSERValue -> BSERValue
forall a b. (a -> b) -> a -> b
$ [(ByteString, BSERValue)] -> Map ByteString BSERValue
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ (ByteString
"path", ByteString -> BSERValue
BSERString (WFilePath -> ByteString
toByteString WFilePath
path_))
, (ByteString
"depth", Int -> BSERValue
forall n. Integral n => n -> BSERValue
compactBSERInt Int
depth)
]
renderQueryParams :: QueryParams -> Map ByteString BSERValue
renderQueryParams :: QueryParams -> Map ByteString BSERValue
renderQueryParams QueryParams
params =
[Map ByteString BSERValue] -> Map ByteString BSERValue
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions
[ case QueryParams -> Maybe WFilePath
_QueryParams_RelativeRoot QueryParams
params of
Maybe WFilePath
Nothing -> Map ByteString BSERValue
forall k a. Map k a
M.empty
Just (WFilePath ByteString
p) -> ByteString -> BSERValue -> Map ByteString BSERValue
forall k a. k -> a -> Map k a
M.singleton ByteString
"relative_root" (ByteString -> BSERValue
BSERString ByteString
p)
, case QueryParams -> Maybe Int
_QueryParams_SyncTimeout QueryParams
params of
Maybe Int
Nothing -> Map ByteString BSERValue
forall k a. Map k a
M.empty
Just Int
n -> ByteString -> BSERValue -> Map ByteString BSERValue
forall k a. k -> a -> Map k a
M.singleton ByteString
"sync_timeout" (Int -> BSERValue
forall n. Integral n => n -> BSERValue
compactBSERInt Int
n)
, case QueryParams -> Maybe Int
_QueryParams_LockTimeout QueryParams
params of
Maybe Int
Nothing -> Map ByteString BSERValue
forall k a. Map k a
M.empty
Just Int
n -> ByteString -> BSERValue -> Map ByteString BSERValue
forall k a. k -> a -> Map k a
M.singleton ByteString
"lock_timeout" (Int -> BSERValue
forall n. Integral n => n -> BSERValue
compactBSERInt Int
n)
]
data QueryResult = QueryResult
{ QueryResult -> ClockId
_QueryResult_Clock :: !ClockId
, QueryResult -> Seq [FileField]
_QueryResult_Files :: !(Seq [FileField])
, QueryResult -> Bool
_QueryResult_IsFreshInstance :: !Bool
}
deriving (Int -> QueryResult -> [Char] -> [Char]
[QueryResult] -> [Char] -> [Char]
QueryResult -> [Char]
(Int -> QueryResult -> [Char] -> [Char])
-> (QueryResult -> [Char])
-> ([QueryResult] -> [Char] -> [Char])
-> Show QueryResult
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [QueryResult] -> [Char] -> [Char]
$cshowList :: [QueryResult] -> [Char] -> [Char]
show :: QueryResult -> [Char]
$cshow :: QueryResult -> [Char]
showsPrec :: Int -> QueryResult -> [Char] -> [Char]
$cshowsPrec :: Int -> QueryResult -> [Char] -> [Char]
Show, QueryResult -> QueryResult -> Bool
(QueryResult -> QueryResult -> Bool)
-> (QueryResult -> QueryResult -> Bool) -> Eq QueryResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryResult -> QueryResult -> Bool
$c/= :: QueryResult -> QueryResult -> Bool
== :: QueryResult -> QueryResult -> Bool
$c== :: QueryResult -> QueryResult -> Bool
Eq, Eq QueryResult
Eq QueryResult
-> (QueryResult -> QueryResult -> Ordering)
-> (QueryResult -> QueryResult -> Bool)
-> (QueryResult -> QueryResult -> Bool)
-> (QueryResult -> QueryResult -> Bool)
-> (QueryResult -> QueryResult -> Bool)
-> (QueryResult -> QueryResult -> QueryResult)
-> (QueryResult -> QueryResult -> QueryResult)
-> Ord QueryResult
QueryResult -> QueryResult -> Bool
QueryResult -> QueryResult -> Ordering
QueryResult -> QueryResult -> QueryResult
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 :: QueryResult -> QueryResult -> QueryResult
$cmin :: QueryResult -> QueryResult -> QueryResult
max :: QueryResult -> QueryResult -> QueryResult
$cmax :: QueryResult -> QueryResult -> QueryResult
>= :: QueryResult -> QueryResult -> Bool
$c>= :: QueryResult -> QueryResult -> Bool
> :: QueryResult -> QueryResult -> Bool
$c> :: QueryResult -> QueryResult -> Bool
<= :: QueryResult -> QueryResult -> Bool
$c<= :: QueryResult -> QueryResult -> Bool
< :: QueryResult -> QueryResult -> Bool
$c< :: QueryResult -> QueryResult -> Bool
compare :: QueryResult -> QueryResult -> Ordering
$ccompare :: QueryResult -> QueryResult -> Ordering
$cp1Ord :: Eq QueryResult
Ord)
parseQueryResult :: [FileFieldLabel] -> BSERValue -> Parser QueryResult
parseQueryResult :: [FileFieldLabel] -> BSERValue -> Parser QueryResult
parseQueryResult [FileFieldLabel]
fileFieldLabels (BSERObject Map ByteString BSERValue
o) = do
ByteString
clockId <- Map ByteString BSERValue
o Map ByteString BSERValue -> ByteString -> Parser ByteString
forall a.
FromBSER a =>
Map ByteString BSERValue -> ByteString -> Parser a
.: ByteString
"clock"
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
"c:" ByteString -> ByteString -> Bool
`BC8.isPrefixOf` ByteString
clockId) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
[Char] -> Parser ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser ()) -> [Char] -> Parser ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid clock id: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BC8.unpack ByteString
clockId
Bool
isFreshInstance <- Map ByteString BSERValue
o Map ByteString BSERValue -> ByteString -> Parser Bool
forall a.
FromBSER a =>
Map ByteString BSERValue -> ByteString -> Parser a
.: ByteString
"is_fresh_instance"
Seq BSERValue
files <- Map ByteString BSERValue
o Map ByteString BSERValue -> ByteString -> Parser (Seq BSERValue)
forall a.
FromBSER a =>
Map ByteString BSERValue -> ByteString -> Parser a
.: ByteString
"files"
Seq [FileField]
files' <- (BSERValue -> Parser [FileField])
-> Seq BSERValue -> Parser (Seq [FileField])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([FileFieldLabel] -> BSERValue -> Parser [FileField]
parseFileFields [FileFieldLabel]
fileFieldLabels) Seq BSERValue
files
QueryResult -> Parser QueryResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure QueryResult :: ClockId -> Seq [FileField] -> Bool -> QueryResult
QueryResult
{ _QueryResult_Clock :: ClockId
_QueryResult_Clock = ByteString -> ClockId
ClockId ByteString
clockId
, _QueryResult_Files :: Seq [FileField]
_QueryResult_Files = Seq [FileField]
files'
, _QueryResult_IsFreshInstance :: Bool
_QueryResult_IsFreshInstance = Bool
isFreshInstance
}
parseQueryResult [FileFieldLabel]
_ BSERValue
_ = [Char] -> Parser QueryResult
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Not an Object"