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 _ a b) = Generators (Just (Since clockSpec)) a b
suffix :: [ByteString] -> Generators -> Generators
suffix suffixes (Generators a _ b) = Generators a (Just (Suffix suffixes)) b
path :: [(WFilePath, Maybe Int)] -> Generators -> Generators
path paths (Generators a b _) = Generators a b (Just (Path paths))
relativeRoot :: WFilePath -> (QueryParams -> QueryParams)
relativeRoot p x = x { _QueryParams_RelativeRoot = Just p }
lockTimeout :: Int -> (QueryParams -> QueryParams)
lockTimeout n x = x { _QueryParams_LockTimeout = Just n }
applyGenerators :: [Generators -> Generators] -> Generators
applyGenerators = foldl' (\x f -> f x) (Generators Nothing Nothing Nothing)
applyParams :: [QueryParams -> QueryParams] -> QueryParams
applyParams = foldl' (\x f -> f x) (QueryParams Nothing Nothing Nothing)
data QueryParams = QueryParams
{ _QueryParams_RelativeRoot :: !(Maybe WFilePath)
, _QueryParams_SyncTimeout :: !(Maybe Int)
, _QueryParams_LockTimeout :: !(Maybe Int)
}
instance HasSyncTimeoutOption QueryParams where
setSyncTimeout n x = x { _QueryParams_SyncTimeout = n }
renderQuery :: WFilePath -> [Generators -> Generators] -> Expression -> [QueryParams -> QueryParams] -> [FileFieldLabel] -> BSERValue
renderQuery rootPath generators expr params fileFieldLabels =
BSERArray $ Seq.fromList
[ BSERString "query"
, BSERString (toByteString rootPath)
, BSERObject $ M.unions
[ renderGenerators generators'
, renderFieldLabels fileFieldLabels
, M.singleton "expression" (renderExpression expr)
, renderQueryParams params'
]
]
where
generators' = applyGenerators generators
params' = applyParams params
renderGenerators :: Generators -> Map ByteString BSERValue
renderGenerators (Generators mbSince mbSuffix mbPath) =
M.unions [renderedSince, renderedSuffix, renderedPath]
where
renderedSince = maybe
M.empty
(\(Since clockspec) -> M.singleton "since" (renderClockspec clockspec))
mbSince
renderedSuffix = maybe
M.empty
(\(Suffix suffixes) -> M.singleton "suffix" (BSERArray (fmap BSERString (Seq.fromList suffixes))))
mbSuffix
renderedPath = maybe
M.empty
(\(Path paths) -> M.singleton "path" (BSERArray (fmap renderPathElement (Seq.fromList paths))))
mbPath
renderPathElement :: (WFilePath, Maybe Int) -> BSERValue
renderPathElement (path_, Nothing) = BSERString (toByteString path_)
renderPathElement (path_, Just depth)
| depth < 0 = error $ "Invalid depth value: " ++ show depth
| otherwise =
BSERObject $ M.fromList
[ ("path", BSERString (toByteString path_))
, ("depth", compactBSERInt depth)
]
renderQueryParams :: QueryParams -> Map ByteString BSERValue
renderQueryParams params =
M.unions
[ case _QueryParams_RelativeRoot params of
Nothing -> M.empty
Just (WFilePath p) -> M.singleton "relative_root" (BSERString p)
, case _QueryParams_SyncTimeout params of
Nothing -> M.empty
Just n -> M.singleton "sync_timeout" (compactBSERInt n)
, case _QueryParams_LockTimeout params of
Nothing -> M.empty
Just n -> M.singleton "lock_timeout" (compactBSERInt n)
]
data QueryResult = QueryResult
{ _QueryResult_Clock :: !ClockId
, _QueryResult_Files :: !(Seq [FileField])
, _QueryResult_IsFreshInstance :: !Bool
}
deriving (Show, Eq, Ord)
parseQueryResult :: [FileFieldLabel] -> BSERValue -> Parser QueryResult
parseQueryResult fileFieldLabels (BSERObject o) = do
clockId <- o .: "clock"
unless ("c:" `BC8.isPrefixOf` clockId) $
fail $ "Invalid clock id: " ++ BC8.unpack clockId
isFreshInstance <- o .: "is_fresh_instance"
files <- o .: "files"
files' <- mapM (parseFileFields fileFieldLabels) files
pure QueryResult
{ _QueryResult_Clock = ClockId clockId
, _QueryResult_Files = files'
, _QueryResult_IsFreshInstance = isFreshInstance
}
parseQueryResult _ _ = fail "Not an Object"