{-# 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)]

-- | If none are set, then the default "all" generator is used
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"