{-# LANGUAGE TemplateHaskell            #-}
module Language.LSP.Types.DocumentFilter where

import           Data.Aeson.TH
import           Data.Text                      ( Text )
import           Language.LSP.Types.Common
import           Language.LSP.Types.Utils

-- ---------------------------------------------------------------------

data DocumentFilter =
  DocumentFilter
    { -- | A language id, like `typescript`.
      DocumentFilter -> Maybe Text
_language :: Maybe Text
      -- | A Uri scheme, like @file@ or @untitled@.
    , DocumentFilter -> Maybe Text
_scheme   :: Maybe Text
    , -- | A glob pattern, like `*.{ts,js}`.
      --
      -- Glob patterns can have the following syntax:
      -- - @*@ to match one or more characters in a path segment
      -- - @?@ to match on one character in a path segment
      -- - @**@ to match any number of path segments, including none
      -- - @{}@ to group conditions (e.g. @**​/*.{ts,js}@ matches all TypeScript and JavaScript files)
      -- - @[]@ to declare a range of characters to match in a path segment (e.g., @example.[0-9]@ to match on @example.0@, @example.1@, …)
      -- - @[!...]@ to negate a range of characters to match in a path segment (e.g., @example.[!0-9]@ to match on @example.a@, @example.b@, but not @example.0@)
      DocumentFilter -> Maybe Text
_pattern  :: Maybe Text
    } deriving (Int -> DocumentFilter -> ShowS
[DocumentFilter] -> ShowS
DocumentFilter -> String
(Int -> DocumentFilter -> ShowS)
-> (DocumentFilter -> String)
-> ([DocumentFilter] -> ShowS)
-> Show DocumentFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocumentFilter] -> ShowS
$cshowList :: [DocumentFilter] -> ShowS
show :: DocumentFilter -> String
$cshow :: DocumentFilter -> String
showsPrec :: Int -> DocumentFilter -> ShowS
$cshowsPrec :: Int -> DocumentFilter -> ShowS
Show, ReadPrec [DocumentFilter]
ReadPrec DocumentFilter
Int -> ReadS DocumentFilter
ReadS [DocumentFilter]
(Int -> ReadS DocumentFilter)
-> ReadS [DocumentFilter]
-> ReadPrec DocumentFilter
-> ReadPrec [DocumentFilter]
-> Read DocumentFilter
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DocumentFilter]
$creadListPrec :: ReadPrec [DocumentFilter]
readPrec :: ReadPrec DocumentFilter
$creadPrec :: ReadPrec DocumentFilter
readList :: ReadS [DocumentFilter]
$creadList :: ReadS [DocumentFilter]
readsPrec :: Int -> ReadS DocumentFilter
$creadsPrec :: Int -> ReadS DocumentFilter
Read, DocumentFilter -> DocumentFilter -> Bool
(DocumentFilter -> DocumentFilter -> Bool)
-> (DocumentFilter -> DocumentFilter -> Bool) -> Eq DocumentFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocumentFilter -> DocumentFilter -> Bool
$c/= :: DocumentFilter -> DocumentFilter -> Bool
== :: DocumentFilter -> DocumentFilter -> Bool
$c== :: DocumentFilter -> DocumentFilter -> Bool
Eq)

deriveJSON lspOptions ''DocumentFilter

{-
A document selector is the combination of one or many document filters.

export type DocumentSelector = DocumentFilter[];
-}
type DocumentSelector = List DocumentFilter