module System.Directory.Watchman.Subscribe
( SubscriptionName(..)
, SubscribeParams
, SubscriptionNotification(..)
, SubscriptionFiles(..)
, SubscriptionStateEnter(..)
, SubscriptionStateLeave(..)
, renderSubscribe
, parseSubscriptionNotification
, since
, deferVcs
, defer
, System.Directory.Watchman.Subscribe.drop
) 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.State
data SubscribeParams = SubscribeParams
{ _SubscribeParams_Since :: !(Maybe Clockspec)
, _SubscribeParams_DeferVcs :: !Bool
, _SubscribeParams_Defer :: ![StateName]
, _SubscribeParams_Drop :: ![StateName]
}
deriving (Show, Eq)
defaultSubscribeParams :: SubscribeParams
defaultSubscribeParams = SubscribeParams
{ _SubscribeParams_Since = Nothing
, _SubscribeParams_DeferVcs = True
, _SubscribeParams_Defer = []
, _SubscribeParams_Drop = []
}
newtype SubscriptionName = SubscriptionName ByteString
deriving (Show, Eq, Ord)
since :: Clockspec -> (SubscribeParams -> SubscribeParams)
since s x = x { _SubscribeParams_Since = Just s }
deferVcs :: Bool -> (SubscribeParams -> SubscribeParams)
deferVcs s x = x { _SubscribeParams_DeferVcs = s }
defer :: [StateName] -> (SubscribeParams -> SubscribeParams)
defer [] _ = error "defer: List of StateNames must not be empty"
defer s x = x { _SubscribeParams_Defer = s }
drop :: [StateName] -> (SubscribeParams -> SubscribeParams)
drop [] _ = error "drop: List of StateNames must not be empty"
drop s x = x { _SubscribeParams_Drop = s }
renderSubscribe :: WFilePath -> SubscriptionName -> Expression -> [SubscribeParams -> SubscribeParams] -> [FileFieldLabel] -> BSERValue
renderSubscribe rootPath (SubscriptionName subscriptionName) expr params fileFieldLabels =
BSERArray $ Seq.fromList
[ BSERString "subscribe"
, BSERString (toByteString rootPath)
, BSERString subscriptionName
, BSERObject $ M.unions
[ renderFieldLabels fileFieldLabels
, M.singleton "expression" (renderExpression expr)
, renderSubscribeParams params'
]
]
where
params' = foldl' (\x f -> f x) defaultSubscribeParams params
renderSubscribeParams :: SubscribeParams -> Map ByteString BSERValue
renderSubscribeParams params = M.unions
[ case _SubscribeParams_Since params of
Nothing -> M.empty
Just c -> M.singleton "since" (renderClockspec c)
, case _SubscribeParams_DeferVcs params of
True -> M.empty
False -> M.singleton "defer_vcs" (BSERBool False)
, case _SubscribeParams_Defer params of
[] -> M.empty
xs -> M.singleton "defer" (BSERArray (Seq.fromList (map (\(StateName s) -> BSERString s) xs)))
, case _SubscribeParams_Drop params of
[] -> M.empty
xs -> M.singleton "drop" (BSERArray (Seq.fromList (map (\(StateName s) -> BSERString s) xs)))
]
data SubscriptionFiles = SubscriptionFiles
{ _SubscriptionFiles_Clock :: !ClockId
, _SubscriptionFiles_Root :: !WFilePath
, _SubscriptionFiles_Subscription :: !SubscriptionName
, _SubscriptionFiles_Files :: !(Seq [FileField])
, _SubscriptionFiles_IsFreshInstance :: !Bool
}
deriving (Show, Eq, Ord)
data SubscriptionStateEnter = SubscriptionStateEnter
{ _SubscriptionStateEnter_Clock :: !ClockId
, _SubscriptionStateEnter_Root :: !WFilePath
, _SubscriptionStateEnter_Subscription :: !SubscriptionName
, _SubscriptionStateEnter_State :: !StateName
, _SubscriptionStateEnter_Metadata :: !(Maybe BSERValue)
}
deriving (Show, Eq, Ord)
data SubscriptionStateLeave = SubscriptionStateLeave
{ _SubscriptionStateLeave_Clock :: !ClockId
, _SubscriptionStateLeave_Root :: !WFilePath
, _SubscriptionStateLeave_Subscription :: !SubscriptionName
, _SubscriptionStateLeave_State :: !StateName
, _SubscriptionStateLeave_Metadata :: !(Maybe BSERValue)
, _SubscriptionStateLeave_Abandoned :: !Bool
}
deriving (Show, Eq, Ord)
data SubscriptionNotification
= Subscription_Files !SubscriptionFiles
| Subscription_StateEnter SubscriptionStateEnter
| Subscription_StateLeave SubscriptionStateLeave
deriving (Show, Eq, Ord)
parseSubscriptionNotification :: [FileFieldLabel] -> BSERValue -> Parser SubscriptionNotification
parseSubscriptionNotification fileFieldLabels v@(BSERObject o) = do
case M.lookup "files" o of
Just _ -> do
f <- parseSubscriptionFiles fileFieldLabels v
pure $ Subscription_Files f
Nothing ->
case M.lookup "state-enter" o of
Just _ -> do
s <- parseSubscriptionStateEnter v
pure $ Subscription_StateEnter s
Nothing ->
case M.lookup "state-leave" o of
Just _ -> do
s <- parseSubscriptionStateLeave v
pure $ Subscription_StateLeave s
Nothing ->
fail "Unrecognized subscription notification"
parseSubscriptionNotification _ _ = fail "Not an Object"
parseSubscriptionFiles :: [FileFieldLabel] -> BSERValue -> Parser SubscriptionFiles
parseSubscriptionFiles fileFieldLabels (BSERObject o) = do
clockId <- parseClockId o
root <- o .: "root"
subscription <- o .: "subscription"
files <- o .: "files"
files' <- mapM (parseFileFields fileFieldLabels) files
isFreshInstance <- o .: "is_fresh_instance"
pure SubscriptionFiles
{ _SubscriptionFiles_Clock = clockId
, _SubscriptionFiles_Root = root
, _SubscriptionFiles_Subscription = SubscriptionName subscription
, _SubscriptionFiles_Files = files'
, _SubscriptionFiles_IsFreshInstance = isFreshInstance
}
parseSubscriptionFiles _ _ = fail "Not an Object"
parseSubscriptionStateEnter :: BSERValue -> Parser SubscriptionStateEnter
parseSubscriptionStateEnter (BSERObject o) = do
clockId <- parseClockId o
root <- o .: "root"
subscription <- o .: "subscription"
state <- o .: "state-enter"
let metadata = case M.lookup "metadata" o of
Nothing -> Nothing
Just v -> Just v
pure SubscriptionStateEnter
{ _SubscriptionStateEnter_Clock = clockId
, _SubscriptionStateEnter_Root = root
, _SubscriptionStateEnter_Subscription = SubscriptionName subscription
, _SubscriptionStateEnter_State = StateName state
, _SubscriptionStateEnter_Metadata = metadata
}
parseSubscriptionStateEnter _ = fail "Not an Object"
parseSubscriptionStateLeave :: BSERValue -> Parser SubscriptionStateLeave
parseSubscriptionStateLeave (BSERObject o) = do
clockId <- parseClockId o
root <- o .: "root"
subscription <- o .: "subscription"
state <- o .: "state-leave"
let metadata = case M.lookup "metadata" o of
Nothing -> Nothing
Just v -> Just v
let abandoned = case M.lookup "abandoned" o of
Just (BSERBool True) -> True
_ -> False
pure SubscriptionStateLeave
{ _SubscriptionStateLeave_Clock = clockId
, _SubscriptionStateLeave_Root = root
, _SubscriptionStateLeave_Subscription = SubscriptionName subscription
, _SubscriptionStateLeave_State = StateName state
, _SubscriptionStateLeave_Metadata = metadata
, _SubscriptionStateLeave_Abandoned = abandoned
}
parseSubscriptionStateLeave _ = fail "Not an Object"
parseClockId :: BSERObject -> Parser ClockId
parseClockId o = do
clockId <- o .: "clock"
unless ("c:" `BC8.isPrefixOf` clockId) $
fail $ "Invalid clock id: " ++ BC8.unpack clockId
pure (ClockId clockId)