module Language.LSP.Protocol.Types.WatchKinds where

import Data.Set (Set, toList)
import Language.LSP.Protocol.Internal.Types (WatchKind (..))
import Language.LSP.Protocol.Types.LspEnum (fromOpenEnumBaseType, toEnumBaseType)

-- WatchKind is better represented as a Set than as enum. As the lsp spec
-- defines them as an enum, these helper functions help bridge the difference.

-- |Tests whether `WatchKind_Create` is contained in the provided WatchKind enum
containsCreate :: WatchKind -> Bool
containsCreate :: WatchKind -> Bool
containsCreate WatchKind
WatchKind_Create = Bool
True
containsCreate (WatchKind_Custom UInt
3) = Bool
True
containsCreate (WatchKind_Custom UInt
5) = Bool
True
containsCreate (WatchKind_Custom UInt
7) = Bool
True
containsCreate WatchKind
_ = Bool
False

-- |Tests whether `WatchKind_Change` is contained in the provided WatchKind enum
containsChange :: WatchKind -> Bool
containsChange :: WatchKind -> Bool
containsChange WatchKind
WatchKind_Change = Bool
True
containsChange (WatchKind_Custom UInt
3) = Bool
True
containsChange (WatchKind_Custom UInt
6) = Bool
True
containsChange (WatchKind_Custom UInt
7) = Bool
True
containsChange WatchKind
_ = Bool
False

-- |Tests whether `WatchKind_Delete` is contained in the provided WatchKind enum
containsDelete :: WatchKind -> Bool
containsDelete :: WatchKind -> Bool
containsDelete WatchKind
WatchKind_Delete = Bool
True
containsDelete (WatchKind_Custom UInt
5) = Bool
True
containsDelete (WatchKind_Custom UInt
6) = Bool
True
containsDelete (WatchKind_Custom UInt
7) = Bool
True
containsDelete WatchKind
_ = Bool
False

{- |Combine a set of WatchKind types into a new WatchKind type that accurately
 represents the set
-}
combineWatchKinds :: Set WatchKind -> WatchKind
combineWatchKinds :: Set WatchKind -> WatchKind
combineWatchKinds Set WatchKind
s = forall a. LspOpenEnum a => EnumBaseType a -> a
fromOpenEnumBaseType forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a. LspEnum a => a -> EnumBaseType a
toEnumBaseType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Set a -> [a]
toList Set WatchKind
s