{-# LANGUAGE OverloadedStrings #-}

module System.Directory.Watchman.State
    ( StateName(..)
    , StateParams
    , renderStateEnter
    , renderStateLeave

    , setMetadata
    ) where

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

import System.Directory.Watchman.BSER
import System.Directory.Watchman.SyncTimeout
import System.Directory.Watchman.WFilePath

newtype StateName = StateName ByteString
    deriving (Int -> StateName -> ShowS
[StateName] -> ShowS
StateName -> String
(Int -> StateName -> ShowS)
-> (StateName -> String)
-> ([StateName] -> ShowS)
-> Show StateName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StateName] -> ShowS
$cshowList :: [StateName] -> ShowS
show :: StateName -> String
$cshow :: StateName -> String
showsPrec :: Int -> StateName -> ShowS
$cshowsPrec :: Int -> StateName -> ShowS
Show, StateName -> StateName -> Bool
(StateName -> StateName -> Bool)
-> (StateName -> StateName -> Bool) -> Eq StateName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StateName -> StateName -> Bool
$c/= :: StateName -> StateName -> Bool
== :: StateName -> StateName -> Bool
$c== :: StateName -> StateName -> Bool
Eq, Eq StateName
Eq StateName
-> (StateName -> StateName -> Ordering)
-> (StateName -> StateName -> Bool)
-> (StateName -> StateName -> Bool)
-> (StateName -> StateName -> Bool)
-> (StateName -> StateName -> Bool)
-> (StateName -> StateName -> StateName)
-> (StateName -> StateName -> StateName)
-> Ord StateName
StateName -> StateName -> Bool
StateName -> StateName -> Ordering
StateName -> StateName -> StateName
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 :: StateName -> StateName -> StateName
$cmin :: StateName -> StateName -> StateName
max :: StateName -> StateName -> StateName
$cmax :: StateName -> StateName -> StateName
>= :: StateName -> StateName -> Bool
$c>= :: StateName -> StateName -> Bool
> :: StateName -> StateName -> Bool
$c> :: StateName -> StateName -> Bool
<= :: StateName -> StateName -> Bool
$c<= :: StateName -> StateName -> Bool
< :: StateName -> StateName -> Bool
$c< :: StateName -> StateName -> Bool
compare :: StateName -> StateName -> Ordering
$ccompare :: StateName -> StateName -> Ordering
$cp1Ord :: Eq StateName
Ord)

data StateParams = StateParams
    { StateParams -> Maybe Int
_StateParams_SyncTimeout :: !(Maybe Int)
    , StateParams -> Maybe BSERValue
_StateParams_Metadata :: !(Maybe BSERValue)
    }

defaultStateParams :: StateParams
defaultStateParams :: StateParams
defaultStateParams = StateParams :: Maybe Int -> Maybe BSERValue -> StateParams
StateParams
    { _StateParams_SyncTimeout :: Maybe Int
_StateParams_SyncTimeout = Maybe Int
forall a. Maybe a
Nothing
    , _StateParams_Metadata :: Maybe BSERValue
_StateParams_Metadata = Maybe BSERValue
forall a. Maybe a
Nothing
    }

instance HasSyncTimeoutOption StateParams where
    setSyncTimeout :: Maybe Int -> StateParams -> StateParams
setSyncTimeout Maybe Int
n StateParams
x = StateParams
x { _StateParams_SyncTimeout :: Maybe Int
_StateParams_SyncTimeout = Maybe Int
n }

setMetadata :: BSERValue -> (StateParams -> StateParams)
setMetadata :: BSERValue -> StateParams -> StateParams
setMetadata BSERValue
v StateParams
x = StateParams
x { _StateParams_Metadata :: Maybe BSERValue
_StateParams_Metadata = BSERValue -> Maybe BSERValue
forall a. a -> Maybe a
Just BSERValue
v }

renderStateEnter :: WFilePath -> StateName -> [StateParams -> StateParams] -> BSERValue
renderStateEnter :: WFilePath -> StateName -> [StateParams -> StateParams] -> BSERValue
renderStateEnter (WFilePath ByteString
filepath) (StateName ByteString
stateName) [StateParams -> StateParams]
params =
    case StateParams
params' of
        StateParams Maybe Int
Nothing Maybe BSERValue
Nothing -> 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
"state-enter"
            , ByteString -> BSERValue
BSERString ByteString
filepath
            , ByteString -> BSERValue
BSERString ByteString
stateName
            ]
        StateParams
_ -> 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
"state-enter"
            , ByteString -> BSERValue
BSERString ByteString
filepath
            , StateParams -> BSERValue
renderStateParams StateParams
params'
            ]
    where
    params' :: StateParams
params' = [StateParams -> StateParams] -> StateParams
applyStateParams [StateParams -> StateParams]
params

renderStateLeave :: WFilePath -> StateName -> [StateParams -> StateParams] -> BSERValue
renderStateLeave :: WFilePath -> StateName -> [StateParams -> StateParams] -> BSERValue
renderStateLeave (WFilePath ByteString
filepath) (StateName ByteString
stateName) [StateParams -> StateParams]
params =
    case StateParams
params' of
        StateParams Maybe Int
Nothing Maybe BSERValue
Nothing -> 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
"state-leave"
            , ByteString -> BSERValue
BSERString ByteString
filepath
            , ByteString -> BSERValue
BSERString ByteString
stateName
            ]
        StateParams
_ -> 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
"state-leave"
            , ByteString -> BSERValue
BSERString ByteString
filepath
            , StateParams -> BSERValue
renderStateParams StateParams
params'
            ]
    where
    params' :: StateParams
params' = [StateParams -> StateParams] -> StateParams
applyStateParams [StateParams -> StateParams]
params

applyStateParams :: [StateParams -> StateParams] -> StateParams
applyStateParams :: [StateParams -> StateParams] -> StateParams
applyStateParams = (StateParams -> (StateParams -> StateParams) -> StateParams)
-> StateParams -> [StateParams -> StateParams] -> StateParams
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\StateParams
x StateParams -> StateParams
f -> StateParams -> StateParams
f StateParams
x) StateParams
defaultStateParams

renderStateParams :: StateParams -> BSERValue
renderStateParams :: StateParams -> BSERValue
renderStateParams StateParams
params = 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
    [ case StateParams -> Maybe Int
_StateParams_SyncTimeout StateParams
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 StateParams -> Maybe BSERValue
_StateParams_Metadata StateParams
params of
        Maybe BSERValue
Nothing -> Map ByteString BSERValue
forall k a. Map k a
M.empty
        Just BSERValue
v -> ByteString -> BSERValue -> Map ByteString BSERValue
forall k a. k -> a -> Map k a
M.singleton ByteString
"metadata" BSERValue
v
    ]