{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Language.LSP.MetaModel.Types where
import Data.Aeson hiding (Null, String)
import Data.Aeson qualified as JSON
import Data.Aeson.TH qualified as JSON
import Data.Char qualified as Char
import Data.Text (Text)
import Control.Lens
import Control.Monad.IO.Class
import Data.List.NonEmpty qualified as NE
import Language.Haskell.TH.Syntax (Exp, Lift (..), Q, addDependentFile)
data MessageDirection = ServerToClient | ClientToServer | Both
deriving stock (Int -> MessageDirection -> ShowS
[MessageDirection] -> ShowS
MessageDirection -> String
(Int -> MessageDirection -> ShowS)
-> (MessageDirection -> String)
-> ([MessageDirection] -> ShowS)
-> Show MessageDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageDirection -> ShowS
showsPrec :: Int -> MessageDirection -> ShowS
$cshow :: MessageDirection -> String
show :: MessageDirection -> String
$cshowList :: [MessageDirection] -> ShowS
showList :: [MessageDirection] -> ShowS
Show, MessageDirection -> MessageDirection -> Bool
(MessageDirection -> MessageDirection -> Bool)
-> (MessageDirection -> MessageDirection -> Bool)
-> Eq MessageDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageDirection -> MessageDirection -> Bool
== :: MessageDirection -> MessageDirection -> Bool
$c/= :: MessageDirection -> MessageDirection -> Bool
/= :: MessageDirection -> MessageDirection -> Bool
Eq, Eq MessageDirection
Eq MessageDirection =>
(MessageDirection -> MessageDirection -> Ordering)
-> (MessageDirection -> MessageDirection -> Bool)
-> (MessageDirection -> MessageDirection -> Bool)
-> (MessageDirection -> MessageDirection -> Bool)
-> (MessageDirection -> MessageDirection -> Bool)
-> (MessageDirection -> MessageDirection -> MessageDirection)
-> (MessageDirection -> MessageDirection -> MessageDirection)
-> Ord MessageDirection
MessageDirection -> MessageDirection -> Bool
MessageDirection -> MessageDirection -> Ordering
MessageDirection -> MessageDirection -> MessageDirection
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
$ccompare :: MessageDirection -> MessageDirection -> Ordering
compare :: MessageDirection -> MessageDirection -> Ordering
$c< :: MessageDirection -> MessageDirection -> Bool
< :: MessageDirection -> MessageDirection -> Bool
$c<= :: MessageDirection -> MessageDirection -> Bool
<= :: MessageDirection -> MessageDirection -> Bool
$c> :: MessageDirection -> MessageDirection -> Bool
> :: MessageDirection -> MessageDirection -> Bool
$c>= :: MessageDirection -> MessageDirection -> Bool
>= :: MessageDirection -> MessageDirection -> Bool
$cmax :: MessageDirection -> MessageDirection -> MessageDirection
max :: MessageDirection -> MessageDirection -> MessageDirection
$cmin :: MessageDirection -> MessageDirection -> MessageDirection
min :: MessageDirection -> MessageDirection -> MessageDirection
Ord, (forall (m :: * -> *). Quote m => MessageDirection -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
MessageDirection -> Code m MessageDirection)
-> Lift MessageDirection
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => MessageDirection -> m Exp
forall (m :: * -> *).
Quote m =>
MessageDirection -> Code m MessageDirection
$clift :: forall (m :: * -> *). Quote m => MessageDirection -> m Exp
lift :: forall (m :: * -> *). Quote m => MessageDirection -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
MessageDirection -> Code m MessageDirection
liftTyped :: forall (m :: * -> *).
Quote m =>
MessageDirection -> Code m MessageDirection
Lift)
instance ToJSON MessageDirection where
toJSON :: MessageDirection -> Value
toJSON MessageDirection
ServerToClient = forall a. ToJSON a => a -> Value
toJSON @String String
"serverToClient"
toJSON MessageDirection
ClientToServer = forall a. ToJSON a => a -> Value
toJSON @String String
"clientToServer"
toJSON MessageDirection
Both = forall a. ToJSON a => a -> Value
toJSON @String String
"both"
instance FromJSON MessageDirection where
parseJSON :: Value -> Parser MessageDirection
parseJSON = String
-> (Text -> Parser MessageDirection)
-> Value
-> Parser MessageDirection
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"MessageDirection" ((Text -> Parser MessageDirection)
-> Value -> Parser MessageDirection)
-> (Text -> Parser MessageDirection)
-> Value
-> Parser MessageDirection
forall a b. (a -> b) -> a -> b
$ \case
Text
"serverToClient" -> MessageDirection -> Parser MessageDirection
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MessageDirection
ServerToClient
Text
"clientToServer" -> MessageDirection -> Parser MessageDirection
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MessageDirection
ClientToServer
Text
"both" -> MessageDirection -> Parser MessageDirection
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MessageDirection
Both
Text
t -> String -> Parser MessageDirection
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser MessageDirection)
-> String -> Parser MessageDirection
forall a b. (a -> b) -> a -> b
$ String
"unknown message direction " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t
data BaseTypeName = URI | DocumentUri | Integer | UInteger | Decimal | RegExp | String | Boolean | Null
deriving stock (Int -> BaseTypeName -> ShowS
[BaseTypeName] -> ShowS
BaseTypeName -> String
(Int -> BaseTypeName -> ShowS)
-> (BaseTypeName -> String)
-> ([BaseTypeName] -> ShowS)
-> Show BaseTypeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BaseTypeName -> ShowS
showsPrec :: Int -> BaseTypeName -> ShowS
$cshow :: BaseTypeName -> String
show :: BaseTypeName -> String
$cshowList :: [BaseTypeName] -> ShowS
showList :: [BaseTypeName] -> ShowS
Show, BaseTypeName -> BaseTypeName -> Bool
(BaseTypeName -> BaseTypeName -> Bool)
-> (BaseTypeName -> BaseTypeName -> Bool) -> Eq BaseTypeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BaseTypeName -> BaseTypeName -> Bool
== :: BaseTypeName -> BaseTypeName -> Bool
$c/= :: BaseTypeName -> BaseTypeName -> Bool
/= :: BaseTypeName -> BaseTypeName -> Bool
Eq, Eq BaseTypeName
Eq BaseTypeName =>
(BaseTypeName -> BaseTypeName -> Ordering)
-> (BaseTypeName -> BaseTypeName -> Bool)
-> (BaseTypeName -> BaseTypeName -> Bool)
-> (BaseTypeName -> BaseTypeName -> Bool)
-> (BaseTypeName -> BaseTypeName -> Bool)
-> (BaseTypeName -> BaseTypeName -> BaseTypeName)
-> (BaseTypeName -> BaseTypeName -> BaseTypeName)
-> Ord BaseTypeName
BaseTypeName -> BaseTypeName -> Bool
BaseTypeName -> BaseTypeName -> Ordering
BaseTypeName -> BaseTypeName -> BaseTypeName
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
$ccompare :: BaseTypeName -> BaseTypeName -> Ordering
compare :: BaseTypeName -> BaseTypeName -> Ordering
$c< :: BaseTypeName -> BaseTypeName -> Bool
< :: BaseTypeName -> BaseTypeName -> Bool
$c<= :: BaseTypeName -> BaseTypeName -> Bool
<= :: BaseTypeName -> BaseTypeName -> Bool
$c> :: BaseTypeName -> BaseTypeName -> Bool
> :: BaseTypeName -> BaseTypeName -> Bool
$c>= :: BaseTypeName -> BaseTypeName -> Bool
>= :: BaseTypeName -> BaseTypeName -> Bool
$cmax :: BaseTypeName -> BaseTypeName -> BaseTypeName
max :: BaseTypeName -> BaseTypeName -> BaseTypeName
$cmin :: BaseTypeName -> BaseTypeName -> BaseTypeName
min :: BaseTypeName -> BaseTypeName -> BaseTypeName
Ord, (forall (m :: * -> *). Quote m => BaseTypeName -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
BaseTypeName -> Code m BaseTypeName)
-> Lift BaseTypeName
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => BaseTypeName -> m Exp
forall (m :: * -> *).
Quote m =>
BaseTypeName -> Code m BaseTypeName
$clift :: forall (m :: * -> *). Quote m => BaseTypeName -> m Exp
lift :: forall (m :: * -> *). Quote m => BaseTypeName -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
BaseTypeName -> Code m BaseTypeName
liftTyped :: forall (m :: * -> *).
Quote m =>
BaseTypeName -> Code m BaseTypeName
Lift)
data Property = Property
{ Property -> Text
name :: Text
, Property -> Type
type_ :: Type
, Property -> Maybe Bool
optional :: Maybe Bool
, Property -> Maybe Text
documentation :: Maybe Text
, Property -> Maybe Text
since :: Maybe Text
, Property -> Maybe Bool
proposed :: Maybe Bool
, Property -> Maybe Text
deprecated :: Maybe Text
}
deriving stock (Int -> Property -> ShowS
[Property] -> ShowS
Property -> String
(Int -> Property -> ShowS)
-> (Property -> String) -> ([Property] -> ShowS) -> Show Property
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Property -> ShowS
showsPrec :: Int -> Property -> ShowS
$cshow :: Property -> String
show :: Property -> String
$cshowList :: [Property] -> ShowS
showList :: [Property] -> ShowS
Show, Property -> Property -> Bool
(Property -> Property -> Bool)
-> (Property -> Property -> Bool) -> Eq Property
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
/= :: Property -> Property -> Bool
Eq, Eq Property
Eq Property =>
(Property -> Property -> Ordering)
-> (Property -> Property -> Bool)
-> (Property -> Property -> Bool)
-> (Property -> Property -> Bool)
-> (Property -> Property -> Bool)
-> (Property -> Property -> Property)
-> (Property -> Property -> Property)
-> Ord Property
Property -> Property -> Bool
Property -> Property -> Ordering
Property -> Property -> Property
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
$ccompare :: Property -> Property -> Ordering
compare :: Property -> Property -> Ordering
$c< :: Property -> Property -> Bool
< :: Property -> Property -> Bool
$c<= :: Property -> Property -> Bool
<= :: Property -> Property -> Bool
$c> :: Property -> Property -> Bool
> :: Property -> Property -> Bool
$c>= :: Property -> Property -> Bool
>= :: Property -> Property -> Bool
$cmax :: Property -> Property -> Property
max :: Property -> Property -> Property
$cmin :: Property -> Property -> Property
min :: Property -> Property -> Property
Ord, (forall (m :: * -> *). Quote m => Property -> m Exp)
-> (forall (m :: * -> *). Quote m => Property -> Code m Property)
-> Lift Property
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Property -> m Exp
forall (m :: * -> *). Quote m => Property -> Code m Property
$clift :: forall (m :: * -> *). Quote m => Property -> m Exp
lift :: forall (m :: * -> *). Quote m => Property -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Property -> Code m Property
liftTyped :: forall (m :: * -> *). Quote m => Property -> Code m Property
Lift)
data StructureLiteral = StructureLiteral
{ StructureLiteral -> [Property]
properties :: [Property]
, StructureLiteral -> Maybe Text
documentation :: Maybe Text
, StructureLiteral -> Maybe Text
since :: Maybe Text
, StructureLiteral -> Maybe Bool
proposed :: Maybe Bool
, StructureLiteral -> Maybe Text
deprecated :: Maybe Text
}
deriving stock (Int -> StructureLiteral -> ShowS
[StructureLiteral] -> ShowS
StructureLiteral -> String
(Int -> StructureLiteral -> ShowS)
-> (StructureLiteral -> String)
-> ([StructureLiteral] -> ShowS)
-> Show StructureLiteral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StructureLiteral -> ShowS
showsPrec :: Int -> StructureLiteral -> ShowS
$cshow :: StructureLiteral -> String
show :: StructureLiteral -> String
$cshowList :: [StructureLiteral] -> ShowS
showList :: [StructureLiteral] -> ShowS
Show, StructureLiteral -> StructureLiteral -> Bool
(StructureLiteral -> StructureLiteral -> Bool)
-> (StructureLiteral -> StructureLiteral -> Bool)
-> Eq StructureLiteral
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StructureLiteral -> StructureLiteral -> Bool
== :: StructureLiteral -> StructureLiteral -> Bool
$c/= :: StructureLiteral -> StructureLiteral -> Bool
/= :: StructureLiteral -> StructureLiteral -> Bool
Eq, Eq StructureLiteral
Eq StructureLiteral =>
(StructureLiteral -> StructureLiteral -> Ordering)
-> (StructureLiteral -> StructureLiteral -> Bool)
-> (StructureLiteral -> StructureLiteral -> Bool)
-> (StructureLiteral -> StructureLiteral -> Bool)
-> (StructureLiteral -> StructureLiteral -> Bool)
-> (StructureLiteral -> StructureLiteral -> StructureLiteral)
-> (StructureLiteral -> StructureLiteral -> StructureLiteral)
-> Ord StructureLiteral
StructureLiteral -> StructureLiteral -> Bool
StructureLiteral -> StructureLiteral -> Ordering
StructureLiteral -> StructureLiteral -> StructureLiteral
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
$ccompare :: StructureLiteral -> StructureLiteral -> Ordering
compare :: StructureLiteral -> StructureLiteral -> Ordering
$c< :: StructureLiteral -> StructureLiteral -> Bool
< :: StructureLiteral -> StructureLiteral -> Bool
$c<= :: StructureLiteral -> StructureLiteral -> Bool
<= :: StructureLiteral -> StructureLiteral -> Bool
$c> :: StructureLiteral -> StructureLiteral -> Bool
> :: StructureLiteral -> StructureLiteral -> Bool
$c>= :: StructureLiteral -> StructureLiteral -> Bool
>= :: StructureLiteral -> StructureLiteral -> Bool
$cmax :: StructureLiteral -> StructureLiteral -> StructureLiteral
max :: StructureLiteral -> StructureLiteral -> StructureLiteral
$cmin :: StructureLiteral -> StructureLiteral -> StructureLiteral
min :: StructureLiteral -> StructureLiteral -> StructureLiteral
Ord, (forall (m :: * -> *). Quote m => StructureLiteral -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
StructureLiteral -> Code m StructureLiteral)
-> Lift StructureLiteral
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => StructureLiteral -> m Exp
forall (m :: * -> *).
Quote m =>
StructureLiteral -> Code m StructureLiteral
$clift :: forall (m :: * -> *). Quote m => StructureLiteral -> m Exp
lift :: forall (m :: * -> *). Quote m => StructureLiteral -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
StructureLiteral -> Code m StructureLiteral
liftTyped :: forall (m :: * -> *).
Quote m =>
StructureLiteral -> Code m StructureLiteral
Lift)
data Type
= BaseType {Type -> BaseTypeName
btName :: BaseTypeName}
| ReferenceType {Type -> Text
rtName :: Text}
| ArrayType {Type -> Type
atElement :: Type}
| MapType {Type -> Type
mKey :: Type, Type -> Type
mValue :: Type}
| AndType {Type -> NonEmpty Type
aItems :: NE.NonEmpty Type}
| OrType {Type -> NonEmpty Type
oItems :: NE.NonEmpty Type}
| TupleType {Type -> [Type]
tItems :: [Type]}
| StructureLiteralType {Type -> StructureLiteral
stlValue :: StructureLiteral}
| StringLiteralType {Type -> Text
slValue :: Text}
| IntegerLiteralType {Type -> Integer
ilValue :: Integer}
| BooleanLiteralType {Type -> Bool
blValue :: Bool}
deriving stock (Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Type -> ShowS
showsPrec :: Int -> Type -> ShowS
$cshow :: Type -> String
show :: Type -> String
$cshowList :: [Type] -> ShowS
showList :: [Type] -> ShowS
Show, Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
/= :: Type -> Type -> Bool
Eq, Eq Type
Eq Type =>
(Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
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
$ccompare :: Type -> Type -> Ordering
compare :: Type -> Type -> Ordering
$c< :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
>= :: Type -> Type -> Bool
$cmax :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
min :: Type -> Type -> Type
Ord, (forall (m :: * -> *). Quote m => Type -> m Exp)
-> (forall (m :: * -> *). Quote m => Type -> Code m Type)
-> Lift Type
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Type -> m Exp
forall (m :: * -> *). Quote m => Type -> Code m Type
$clift :: forall (m :: * -> *). Quote m => Type -> m Exp
lift :: forall (m :: * -> *). Quote m => Type -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Type -> Code m Type
liftTyped :: forall (m :: * -> *). Quote m => Type -> Code m Type
Lift)
data Request = Request
{ Request -> Text
method :: Text
, Request -> Maybe Type
params :: Maybe Type
, Request -> Type
result :: Type
, Request -> Maybe Type
partialResult :: Maybe Type
, Request -> Maybe Type
errorData :: Maybe Type
, Request -> Maybe Type
registrationOptions :: Maybe Type
, Request -> MessageDirection
messageDirection :: MessageDirection
, Request -> Maybe Text
documentation :: Maybe Text
, Request -> Maybe Text
since :: Maybe Text
, Request -> Maybe Bool
proposed :: Maybe Bool
, Request -> Maybe Text
deprecated :: Maybe Text
}
deriving stock (Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
(Int -> Request -> ShowS)
-> (Request -> String) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Request -> ShowS
showsPrec :: Int -> Request -> ShowS
$cshow :: Request -> String
show :: Request -> String
$cshowList :: [Request] -> ShowS
showList :: [Request] -> ShowS
Show, Request -> Request -> Bool
(Request -> Request -> Bool)
-> (Request -> Request -> Bool) -> Eq Request
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Request -> Request -> Bool
== :: Request -> Request -> Bool
$c/= :: Request -> Request -> Bool
/= :: Request -> Request -> Bool
Eq, Eq Request
Eq Request =>
(Request -> Request -> Ordering)
-> (Request -> Request -> Bool)
-> (Request -> Request -> Bool)
-> (Request -> Request -> Bool)
-> (Request -> Request -> Bool)
-> (Request -> Request -> Request)
-> (Request -> Request -> Request)
-> Ord Request
Request -> Request -> Bool
Request -> Request -> Ordering
Request -> Request -> Request
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
$ccompare :: Request -> Request -> Ordering
compare :: Request -> Request -> Ordering
$c< :: Request -> Request -> Bool
< :: Request -> Request -> Bool
$c<= :: Request -> Request -> Bool
<= :: Request -> Request -> Bool
$c> :: Request -> Request -> Bool
> :: Request -> Request -> Bool
$c>= :: Request -> Request -> Bool
>= :: Request -> Request -> Bool
$cmax :: Request -> Request -> Request
max :: Request -> Request -> Request
$cmin :: Request -> Request -> Request
min :: Request -> Request -> Request
Ord, (forall (m :: * -> *). Quote m => Request -> m Exp)
-> (forall (m :: * -> *). Quote m => Request -> Code m Request)
-> Lift Request
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Request -> m Exp
forall (m :: * -> *). Quote m => Request -> Code m Request
$clift :: forall (m :: * -> *). Quote m => Request -> m Exp
lift :: forall (m :: * -> *). Quote m => Request -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Request -> Code m Request
liftTyped :: forall (m :: * -> *). Quote m => Request -> Code m Request
Lift)
data Notification = Notification
{ Notification -> Text
method :: Text
, Notification -> Maybe Type
params :: Maybe Type
, Notification -> Maybe Type
registrationOptions :: Maybe Type
, Notification -> MessageDirection
messageDirection :: MessageDirection
, Notification -> Maybe Text
documentation :: Maybe Text
, Notification -> Maybe Text
since :: Maybe Text
, Notification -> Maybe Bool
proposed :: Maybe Bool
, Notification -> Maybe Text
deprecated :: Maybe Text
}
deriving stock (Int -> Notification -> ShowS
[Notification] -> ShowS
Notification -> String
(Int -> Notification -> ShowS)
-> (Notification -> String)
-> ([Notification] -> ShowS)
-> Show Notification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Notification -> ShowS
showsPrec :: Int -> Notification -> ShowS
$cshow :: Notification -> String
show :: Notification -> String
$cshowList :: [Notification] -> ShowS
showList :: [Notification] -> ShowS
Show, Notification -> Notification -> Bool
(Notification -> Notification -> Bool)
-> (Notification -> Notification -> Bool) -> Eq Notification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Notification -> Notification -> Bool
== :: Notification -> Notification -> Bool
$c/= :: Notification -> Notification -> Bool
/= :: Notification -> Notification -> Bool
Eq, Eq Notification
Eq Notification =>
(Notification -> Notification -> Ordering)
-> (Notification -> Notification -> Bool)
-> (Notification -> Notification -> Bool)
-> (Notification -> Notification -> Bool)
-> (Notification -> Notification -> Bool)
-> (Notification -> Notification -> Notification)
-> (Notification -> Notification -> Notification)
-> Ord Notification
Notification -> Notification -> Bool
Notification -> Notification -> Ordering
Notification -> Notification -> Notification
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
$ccompare :: Notification -> Notification -> Ordering
compare :: Notification -> Notification -> Ordering
$c< :: Notification -> Notification -> Bool
< :: Notification -> Notification -> Bool
$c<= :: Notification -> Notification -> Bool
<= :: Notification -> Notification -> Bool
$c> :: Notification -> Notification -> Bool
> :: Notification -> Notification -> Bool
$c>= :: Notification -> Notification -> Bool
>= :: Notification -> Notification -> Bool
$cmax :: Notification -> Notification -> Notification
max :: Notification -> Notification -> Notification
$cmin :: Notification -> Notification -> Notification
min :: Notification -> Notification -> Notification
Ord, (forall (m :: * -> *). Quote m => Notification -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
Notification -> Code m Notification)
-> Lift Notification
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Notification -> m Exp
forall (m :: * -> *).
Quote m =>
Notification -> Code m Notification
$clift :: forall (m :: * -> *). Quote m => Notification -> m Exp
lift :: forall (m :: * -> *). Quote m => Notification -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
Notification -> Code m Notification
liftTyped :: forall (m :: * -> *).
Quote m =>
Notification -> Code m Notification
Lift)
data Structure = Structure
{ Structure -> Text
name :: Text
, Structure -> Maybe [Type]
extends :: Maybe [Type]
, Structure -> Maybe [Type]
mixins :: Maybe [Type]
, Structure -> [Property]
properties :: [Property]
, Structure -> Maybe Text
documentation :: Maybe Text
, Structure -> Maybe Text
since :: Maybe Text
, Structure -> Maybe Bool
proposed :: Maybe Bool
, Structure -> Maybe Text
deprecated :: Maybe Text
}
deriving stock (Int -> Structure -> ShowS
[Structure] -> ShowS
Structure -> String
(Int -> Structure -> ShowS)
-> (Structure -> String)
-> ([Structure] -> ShowS)
-> Show Structure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Structure -> ShowS
showsPrec :: Int -> Structure -> ShowS
$cshow :: Structure -> String
show :: Structure -> String
$cshowList :: [Structure] -> ShowS
showList :: [Structure] -> ShowS
Show, Structure -> Structure -> Bool
(Structure -> Structure -> Bool)
-> (Structure -> Structure -> Bool) -> Eq Structure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Structure -> Structure -> Bool
== :: Structure -> Structure -> Bool
$c/= :: Structure -> Structure -> Bool
/= :: Structure -> Structure -> Bool
Eq, Eq Structure
Eq Structure =>
(Structure -> Structure -> Ordering)
-> (Structure -> Structure -> Bool)
-> (Structure -> Structure -> Bool)
-> (Structure -> Structure -> Bool)
-> (Structure -> Structure -> Bool)
-> (Structure -> Structure -> Structure)
-> (Structure -> Structure -> Structure)
-> Ord Structure
Structure -> Structure -> Bool
Structure -> Structure -> Ordering
Structure -> Structure -> Structure
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
$ccompare :: Structure -> Structure -> Ordering
compare :: Structure -> Structure -> Ordering
$c< :: Structure -> Structure -> Bool
< :: Structure -> Structure -> Bool
$c<= :: Structure -> Structure -> Bool
<= :: Structure -> Structure -> Bool
$c> :: Structure -> Structure -> Bool
> :: Structure -> Structure -> Bool
$c>= :: Structure -> Structure -> Bool
>= :: Structure -> Structure -> Bool
$cmax :: Structure -> Structure -> Structure
max :: Structure -> Structure -> Structure
$cmin :: Structure -> Structure -> Structure
min :: Structure -> Structure -> Structure
Ord, (forall (m :: * -> *). Quote m => Structure -> m Exp)
-> (forall (m :: * -> *). Quote m => Structure -> Code m Structure)
-> Lift Structure
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Structure -> m Exp
forall (m :: * -> *). Quote m => Structure -> Code m Structure
$clift :: forall (m :: * -> *). Quote m => Structure -> m Exp
lift :: forall (m :: * -> *). Quote m => Structure -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Structure -> Code m Structure
liftTyped :: forall (m :: * -> *). Quote m => Structure -> Code m Structure
Lift)
data TypeAlias = TypeAlias
{ TypeAlias -> Text
name :: Text
, TypeAlias -> Type
type_ :: Type
, TypeAlias -> Maybe Text
documentation :: Maybe Text
, TypeAlias -> Maybe Text
since :: Maybe Text
, TypeAlias -> Maybe Bool
proposed :: Maybe Bool
, TypeAlias -> Maybe Text
deprecated :: Maybe Text
}
deriving stock (Int -> TypeAlias -> ShowS
[TypeAlias] -> ShowS
TypeAlias -> String
(Int -> TypeAlias -> ShowS)
-> (TypeAlias -> String)
-> ([TypeAlias] -> ShowS)
-> Show TypeAlias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeAlias -> ShowS
showsPrec :: Int -> TypeAlias -> ShowS
$cshow :: TypeAlias -> String
show :: TypeAlias -> String
$cshowList :: [TypeAlias] -> ShowS
showList :: [TypeAlias] -> ShowS
Show, TypeAlias -> TypeAlias -> Bool
(TypeAlias -> TypeAlias -> Bool)
-> (TypeAlias -> TypeAlias -> Bool) -> Eq TypeAlias
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeAlias -> TypeAlias -> Bool
== :: TypeAlias -> TypeAlias -> Bool
$c/= :: TypeAlias -> TypeAlias -> Bool
/= :: TypeAlias -> TypeAlias -> Bool
Eq, Eq TypeAlias
Eq TypeAlias =>
(TypeAlias -> TypeAlias -> Ordering)
-> (TypeAlias -> TypeAlias -> Bool)
-> (TypeAlias -> TypeAlias -> Bool)
-> (TypeAlias -> TypeAlias -> Bool)
-> (TypeAlias -> TypeAlias -> Bool)
-> (TypeAlias -> TypeAlias -> TypeAlias)
-> (TypeAlias -> TypeAlias -> TypeAlias)
-> Ord TypeAlias
TypeAlias -> TypeAlias -> Bool
TypeAlias -> TypeAlias -> Ordering
TypeAlias -> TypeAlias -> TypeAlias
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
$ccompare :: TypeAlias -> TypeAlias -> Ordering
compare :: TypeAlias -> TypeAlias -> Ordering
$c< :: TypeAlias -> TypeAlias -> Bool
< :: TypeAlias -> TypeAlias -> Bool
$c<= :: TypeAlias -> TypeAlias -> Bool
<= :: TypeAlias -> TypeAlias -> Bool
$c> :: TypeAlias -> TypeAlias -> Bool
> :: TypeAlias -> TypeAlias -> Bool
$c>= :: TypeAlias -> TypeAlias -> Bool
>= :: TypeAlias -> TypeAlias -> Bool
$cmax :: TypeAlias -> TypeAlias -> TypeAlias
max :: TypeAlias -> TypeAlias -> TypeAlias
$cmin :: TypeAlias -> TypeAlias -> TypeAlias
min :: TypeAlias -> TypeAlias -> TypeAlias
Ord, (forall (m :: * -> *). Quote m => TypeAlias -> m Exp)
-> (forall (m :: * -> *). Quote m => TypeAlias -> Code m TypeAlias)
-> Lift TypeAlias
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => TypeAlias -> m Exp
forall (m :: * -> *). Quote m => TypeAlias -> Code m TypeAlias
$clift :: forall (m :: * -> *). Quote m => TypeAlias -> m Exp
lift :: forall (m :: * -> *). Quote m => TypeAlias -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => TypeAlias -> Code m TypeAlias
liftTyped :: forall (m :: * -> *). Quote m => TypeAlias -> Code m TypeAlias
Lift)
data TextOrInteger = T Text | I Integer
deriving stock (Int -> TextOrInteger -> ShowS
[TextOrInteger] -> ShowS
TextOrInteger -> String
(Int -> TextOrInteger -> ShowS)
-> (TextOrInteger -> String)
-> ([TextOrInteger] -> ShowS)
-> Show TextOrInteger
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextOrInteger -> ShowS
showsPrec :: Int -> TextOrInteger -> ShowS
$cshow :: TextOrInteger -> String
show :: TextOrInteger -> String
$cshowList :: [TextOrInteger] -> ShowS
showList :: [TextOrInteger] -> ShowS
Show, TextOrInteger -> TextOrInteger -> Bool
(TextOrInteger -> TextOrInteger -> Bool)
-> (TextOrInteger -> TextOrInteger -> Bool) -> Eq TextOrInteger
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextOrInteger -> TextOrInteger -> Bool
== :: TextOrInteger -> TextOrInteger -> Bool
$c/= :: TextOrInteger -> TextOrInteger -> Bool
/= :: TextOrInteger -> TextOrInteger -> Bool
Eq, Eq TextOrInteger
Eq TextOrInteger =>
(TextOrInteger -> TextOrInteger -> Ordering)
-> (TextOrInteger -> TextOrInteger -> Bool)
-> (TextOrInteger -> TextOrInteger -> Bool)
-> (TextOrInteger -> TextOrInteger -> Bool)
-> (TextOrInteger -> TextOrInteger -> Bool)
-> (TextOrInteger -> TextOrInteger -> TextOrInteger)
-> (TextOrInteger -> TextOrInteger -> TextOrInteger)
-> Ord TextOrInteger
TextOrInteger -> TextOrInteger -> Bool
TextOrInteger -> TextOrInteger -> Ordering
TextOrInteger -> TextOrInteger -> TextOrInteger
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
$ccompare :: TextOrInteger -> TextOrInteger -> Ordering
compare :: TextOrInteger -> TextOrInteger -> Ordering
$c< :: TextOrInteger -> TextOrInteger -> Bool
< :: TextOrInteger -> TextOrInteger -> Bool
$c<= :: TextOrInteger -> TextOrInteger -> Bool
<= :: TextOrInteger -> TextOrInteger -> Bool
$c> :: TextOrInteger -> TextOrInteger -> Bool
> :: TextOrInteger -> TextOrInteger -> Bool
$c>= :: TextOrInteger -> TextOrInteger -> Bool
>= :: TextOrInteger -> TextOrInteger -> Bool
$cmax :: TextOrInteger -> TextOrInteger -> TextOrInteger
max :: TextOrInteger -> TextOrInteger -> TextOrInteger
$cmin :: TextOrInteger -> TextOrInteger -> TextOrInteger
min :: TextOrInteger -> TextOrInteger -> TextOrInteger
Ord, (forall (m :: * -> *). Quote m => TextOrInteger -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
TextOrInteger -> Code m TextOrInteger)
-> Lift TextOrInteger
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => TextOrInteger -> m Exp
forall (m :: * -> *).
Quote m =>
TextOrInteger -> Code m TextOrInteger
$clift :: forall (m :: * -> *). Quote m => TextOrInteger -> m Exp
lift :: forall (m :: * -> *). Quote m => TextOrInteger -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
TextOrInteger -> Code m TextOrInteger
liftTyped :: forall (m :: * -> *).
Quote m =>
TextOrInteger -> Code m TextOrInteger
Lift)
data EnumerationEntry = EnumerationEntry
{ EnumerationEntry -> Text
name :: Text
, EnumerationEntry -> TextOrInteger
value :: TextOrInteger
, EnumerationEntry -> Maybe Text
documentation :: Maybe Text
, EnumerationEntry -> Maybe Text
since :: Maybe Text
, EnumerationEntry -> Maybe Bool
proposed :: Maybe Bool
, EnumerationEntry -> Maybe Text
deprecated :: Maybe Text
}
deriving stock (Int -> EnumerationEntry -> ShowS
[EnumerationEntry] -> ShowS
EnumerationEntry -> String
(Int -> EnumerationEntry -> ShowS)
-> (EnumerationEntry -> String)
-> ([EnumerationEntry] -> ShowS)
-> Show EnumerationEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnumerationEntry -> ShowS
showsPrec :: Int -> EnumerationEntry -> ShowS
$cshow :: EnumerationEntry -> String
show :: EnumerationEntry -> String
$cshowList :: [EnumerationEntry] -> ShowS
showList :: [EnumerationEntry] -> ShowS
Show, EnumerationEntry -> EnumerationEntry -> Bool
(EnumerationEntry -> EnumerationEntry -> Bool)
-> (EnumerationEntry -> EnumerationEntry -> Bool)
-> Eq EnumerationEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnumerationEntry -> EnumerationEntry -> Bool
== :: EnumerationEntry -> EnumerationEntry -> Bool
$c/= :: EnumerationEntry -> EnumerationEntry -> Bool
/= :: EnumerationEntry -> EnumerationEntry -> Bool
Eq, Eq EnumerationEntry
Eq EnumerationEntry =>
(EnumerationEntry -> EnumerationEntry -> Ordering)
-> (EnumerationEntry -> EnumerationEntry -> Bool)
-> (EnumerationEntry -> EnumerationEntry -> Bool)
-> (EnumerationEntry -> EnumerationEntry -> Bool)
-> (EnumerationEntry -> EnumerationEntry -> Bool)
-> (EnumerationEntry -> EnumerationEntry -> EnumerationEntry)
-> (EnumerationEntry -> EnumerationEntry -> EnumerationEntry)
-> Ord EnumerationEntry
EnumerationEntry -> EnumerationEntry -> Bool
EnumerationEntry -> EnumerationEntry -> Ordering
EnumerationEntry -> EnumerationEntry -> EnumerationEntry
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
$ccompare :: EnumerationEntry -> EnumerationEntry -> Ordering
compare :: EnumerationEntry -> EnumerationEntry -> Ordering
$c< :: EnumerationEntry -> EnumerationEntry -> Bool
< :: EnumerationEntry -> EnumerationEntry -> Bool
$c<= :: EnumerationEntry -> EnumerationEntry -> Bool
<= :: EnumerationEntry -> EnumerationEntry -> Bool
$c> :: EnumerationEntry -> EnumerationEntry -> Bool
> :: EnumerationEntry -> EnumerationEntry -> Bool
$c>= :: EnumerationEntry -> EnumerationEntry -> Bool
>= :: EnumerationEntry -> EnumerationEntry -> Bool
$cmax :: EnumerationEntry -> EnumerationEntry -> EnumerationEntry
max :: EnumerationEntry -> EnumerationEntry -> EnumerationEntry
$cmin :: EnumerationEntry -> EnumerationEntry -> EnumerationEntry
min :: EnumerationEntry -> EnumerationEntry -> EnumerationEntry
Ord, (forall (m :: * -> *). Quote m => EnumerationEntry -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
EnumerationEntry -> Code m EnumerationEntry)
-> Lift EnumerationEntry
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => EnumerationEntry -> m Exp
forall (m :: * -> *).
Quote m =>
EnumerationEntry -> Code m EnumerationEntry
$clift :: forall (m :: * -> *). Quote m => EnumerationEntry -> m Exp
lift :: forall (m :: * -> *). Quote m => EnumerationEntry -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
EnumerationEntry -> Code m EnumerationEntry
liftTyped :: forall (m :: * -> *).
Quote m =>
EnumerationEntry -> Code m EnumerationEntry
Lift)
data Enumeration = Enumeration
{ Enumeration -> Text
name :: Text
, Enumeration -> Type
type_ :: Type
, Enumeration -> [EnumerationEntry]
values :: [EnumerationEntry]
, Enumeration -> Maybe Bool
supportsCustomValues :: Maybe Bool
, Enumeration -> Maybe Text
documentation :: Maybe Text
, Enumeration -> Maybe Text
since :: Maybe Text
, Enumeration -> Maybe Bool
proposed :: Maybe Bool
, Enumeration -> Maybe Text
deprecated :: Maybe Text
}
deriving stock (Int -> Enumeration -> ShowS
[Enumeration] -> ShowS
Enumeration -> String
(Int -> Enumeration -> ShowS)
-> (Enumeration -> String)
-> ([Enumeration] -> ShowS)
-> Show Enumeration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Enumeration -> ShowS
showsPrec :: Int -> Enumeration -> ShowS
$cshow :: Enumeration -> String
show :: Enumeration -> String
$cshowList :: [Enumeration] -> ShowS
showList :: [Enumeration] -> ShowS
Show, Enumeration -> Enumeration -> Bool
(Enumeration -> Enumeration -> Bool)
-> (Enumeration -> Enumeration -> Bool) -> Eq Enumeration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Enumeration -> Enumeration -> Bool
== :: Enumeration -> Enumeration -> Bool
$c/= :: Enumeration -> Enumeration -> Bool
/= :: Enumeration -> Enumeration -> Bool
Eq, Eq Enumeration
Eq Enumeration =>
(Enumeration -> Enumeration -> Ordering)
-> (Enumeration -> Enumeration -> Bool)
-> (Enumeration -> Enumeration -> Bool)
-> (Enumeration -> Enumeration -> Bool)
-> (Enumeration -> Enumeration -> Bool)
-> (Enumeration -> Enumeration -> Enumeration)
-> (Enumeration -> Enumeration -> Enumeration)
-> Ord Enumeration
Enumeration -> Enumeration -> Bool
Enumeration -> Enumeration -> Ordering
Enumeration -> Enumeration -> Enumeration
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
$ccompare :: Enumeration -> Enumeration -> Ordering
compare :: Enumeration -> Enumeration -> Ordering
$c< :: Enumeration -> Enumeration -> Bool
< :: Enumeration -> Enumeration -> Bool
$c<= :: Enumeration -> Enumeration -> Bool
<= :: Enumeration -> Enumeration -> Bool
$c> :: Enumeration -> Enumeration -> Bool
> :: Enumeration -> Enumeration -> Bool
$c>= :: Enumeration -> Enumeration -> Bool
>= :: Enumeration -> Enumeration -> Bool
$cmax :: Enumeration -> Enumeration -> Enumeration
max :: Enumeration -> Enumeration -> Enumeration
$cmin :: Enumeration -> Enumeration -> Enumeration
min :: Enumeration -> Enumeration -> Enumeration
Ord, (forall (m :: * -> *). Quote m => Enumeration -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
Enumeration -> Code m Enumeration)
-> Lift Enumeration
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Enumeration -> m Exp
forall (m :: * -> *). Quote m => Enumeration -> Code m Enumeration
$clift :: forall (m :: * -> *). Quote m => Enumeration -> m Exp
lift :: forall (m :: * -> *). Quote m => Enumeration -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Enumeration -> Code m Enumeration
liftTyped :: forall (m :: * -> *). Quote m => Enumeration -> Code m Enumeration
Lift)
data MetaData = MetaData
{ MetaData -> Text
version :: Text
}
deriving stock (Int -> MetaData -> ShowS
[MetaData] -> ShowS
MetaData -> String
(Int -> MetaData -> ShowS)
-> (MetaData -> String) -> ([MetaData] -> ShowS) -> Show MetaData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetaData -> ShowS
showsPrec :: Int -> MetaData -> ShowS
$cshow :: MetaData -> String
show :: MetaData -> String
$cshowList :: [MetaData] -> ShowS
showList :: [MetaData] -> ShowS
Show, MetaData -> MetaData -> Bool
(MetaData -> MetaData -> Bool)
-> (MetaData -> MetaData -> Bool) -> Eq MetaData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetaData -> MetaData -> Bool
== :: MetaData -> MetaData -> Bool
$c/= :: MetaData -> MetaData -> Bool
/= :: MetaData -> MetaData -> Bool
Eq, Eq MetaData
Eq MetaData =>
(MetaData -> MetaData -> Ordering)
-> (MetaData -> MetaData -> Bool)
-> (MetaData -> MetaData -> Bool)
-> (MetaData -> MetaData -> Bool)
-> (MetaData -> MetaData -> Bool)
-> (MetaData -> MetaData -> MetaData)
-> (MetaData -> MetaData -> MetaData)
-> Ord MetaData
MetaData -> MetaData -> Bool
MetaData -> MetaData -> Ordering
MetaData -> MetaData -> MetaData
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
$ccompare :: MetaData -> MetaData -> Ordering
compare :: MetaData -> MetaData -> Ordering
$c< :: MetaData -> MetaData -> Bool
< :: MetaData -> MetaData -> Bool
$c<= :: MetaData -> MetaData -> Bool
<= :: MetaData -> MetaData -> Bool
$c> :: MetaData -> MetaData -> Bool
> :: MetaData -> MetaData -> Bool
$c>= :: MetaData -> MetaData -> Bool
>= :: MetaData -> MetaData -> Bool
$cmax :: MetaData -> MetaData -> MetaData
max :: MetaData -> MetaData -> MetaData
$cmin :: MetaData -> MetaData -> MetaData
min :: MetaData -> MetaData -> MetaData
Ord, (forall (m :: * -> *). Quote m => MetaData -> m Exp)
-> (forall (m :: * -> *). Quote m => MetaData -> Code m MetaData)
-> Lift MetaData
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => MetaData -> m Exp
forall (m :: * -> *). Quote m => MetaData -> Code m MetaData
$clift :: forall (m :: * -> *). Quote m => MetaData -> m Exp
lift :: forall (m :: * -> *). Quote m => MetaData -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => MetaData -> Code m MetaData
liftTyped :: forall (m :: * -> *). Quote m => MetaData -> Code m MetaData
Lift)
data MetaModel = MetaModel
{ MetaModel -> MetaData
metaData :: MetaData
, MetaModel -> [Request]
requests :: [Request]
, MetaModel -> [Notification]
notifications :: [Notification]
, MetaModel -> [Structure]
structures :: [Structure]
, MetaModel -> [Enumeration]
enumerations :: [Enumeration]
, MetaModel -> [TypeAlias]
typeAliases :: [TypeAlias]
}
deriving stock (Int -> MetaModel -> ShowS
[MetaModel] -> ShowS
MetaModel -> String
(Int -> MetaModel -> ShowS)
-> (MetaModel -> String)
-> ([MetaModel] -> ShowS)
-> Show MetaModel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetaModel -> ShowS
showsPrec :: Int -> MetaModel -> ShowS
$cshow :: MetaModel -> String
show :: MetaModel -> String
$cshowList :: [MetaModel] -> ShowS
showList :: [MetaModel] -> ShowS
Show, MetaModel -> MetaModel -> Bool
(MetaModel -> MetaModel -> Bool)
-> (MetaModel -> MetaModel -> Bool) -> Eq MetaModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetaModel -> MetaModel -> Bool
== :: MetaModel -> MetaModel -> Bool
$c/= :: MetaModel -> MetaModel -> Bool
/= :: MetaModel -> MetaModel -> Bool
Eq, Eq MetaModel
Eq MetaModel =>
(MetaModel -> MetaModel -> Ordering)
-> (MetaModel -> MetaModel -> Bool)
-> (MetaModel -> MetaModel -> Bool)
-> (MetaModel -> MetaModel -> Bool)
-> (MetaModel -> MetaModel -> Bool)
-> (MetaModel -> MetaModel -> MetaModel)
-> (MetaModel -> MetaModel -> MetaModel)
-> Ord MetaModel
MetaModel -> MetaModel -> Bool
MetaModel -> MetaModel -> Ordering
MetaModel -> MetaModel -> MetaModel
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
$ccompare :: MetaModel -> MetaModel -> Ordering
compare :: MetaModel -> MetaModel -> Ordering
$c< :: MetaModel -> MetaModel -> Bool
< :: MetaModel -> MetaModel -> Bool
$c<= :: MetaModel -> MetaModel -> Bool
<= :: MetaModel -> MetaModel -> Bool
$c> :: MetaModel -> MetaModel -> Bool
> :: MetaModel -> MetaModel -> Bool
$c>= :: MetaModel -> MetaModel -> Bool
>= :: MetaModel -> MetaModel -> Bool
$cmax :: MetaModel -> MetaModel -> MetaModel
max :: MetaModel -> MetaModel -> MetaModel
$cmin :: MetaModel -> MetaModel -> MetaModel
min :: MetaModel -> MetaModel -> MetaModel
Ord, (forall (m :: * -> *). Quote m => MetaModel -> m Exp)
-> (forall (m :: * -> *). Quote m => MetaModel -> Code m MetaModel)
-> Lift MetaModel
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => MetaModel -> m Exp
forall (m :: * -> *). Quote m => MetaModel -> Code m MetaModel
$clift :: forall (m :: * -> *). Quote m => MetaModel -> m Exp
lift :: forall (m :: * -> *). Quote m => MetaModel -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => MetaModel -> Code m MetaModel
liftTyped :: forall (m :: * -> *). Quote m => MetaModel -> Code m MetaModel
Lift)
$( let
defOpts = defaultOptions{fieldLabelModifier = \case "type_" -> "type"; x -> x}
propertyInst = JSON.deriveJSON defOpts ''Property
slInst = JSON.deriveJSON defOpts ''StructureLiteral
baseTyNameToTag :: String -> String
baseTyNameToTag = \case
"Integer" -> "integer"
"UInteger" -> "uinteger"
"Decimal" -> "decimal"
"String" -> "string"
"Boolean" -> "boolean"
"Null" -> "null"
x -> x
baseTyNameInst = JSON.deriveJSON (defOpts{sumEncoding = JSON.UntaggedValue, constructorTagModifier = baseTyNameToTag}) ''BaseTypeName
typeToTag :: String -> String
typeToTag = \case
"BaseType" -> "base"
"ReferenceType" -> "reference"
"ArrayType" -> "array"
"MapType" -> "map"
"AndType" -> "and"
"OrType" -> "or"
"TupleType" -> "tuple"
"StructureLiteralType" -> "literal"
"StringLiteralType" -> "stringLiteral"
"IntegerLiteralType" -> "integerLiteral"
"BooleanLiteralType" -> "booleanLiteral"
x -> x
typeOpts =
defOpts
{ sumEncoding = JSON.defaultTaggedObject{tagFieldName = "kind"}
, constructorTagModifier = typeToTag
, fieldLabelModifier = \s -> over _head Char.toLower $ Prelude.dropWhile Char.isLower s
}
typeInst = JSON.deriveJSON typeOpts ''Type
reqInst = JSON.deriveJSON defOpts ''Request
notInst = JSON.deriveJSON defOpts ''Notification
sInst = JSON.deriveJSON defOpts ''Structure
taInst = JSON.deriveJSON defOpts ''TypeAlias
tiInst = JSON.deriveJSON (defOpts{sumEncoding = UntaggedValue}) ''TextOrInteger
eeInst = JSON.deriveJSON defOpts ''EnumerationEntry
eInst = JSON.deriveJSON defOpts ''Enumeration
mdInst = JSON.deriveJSON defOpts ''MetaData
mmInst = JSON.deriveJSON defOpts ''MetaModel
in
mconcat <$> sequence [propertyInst, slInst, baseTyNameInst, typeInst, reqInst, notInst, sInst, taInst, tiInst, eeInst, eInst, mdInst, mmInst]
)
loadMetaModelFromFile :: FilePath -> Q Exp
loadMetaModelFromFile :: String -> Q Exp
loadMetaModelFromFile String
fp = do
String -> Q ()
addDependentFile String
fp
Either String MetaModel
res <- IO (Either String MetaModel) -> Q (Either String MetaModel)
forall a. IO a -> Q a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String MetaModel) -> Q (Either String MetaModel))
-> IO (Either String MetaModel) -> Q (Either String MetaModel)
forall a b. (a -> b) -> a -> b
$ String -> IO (Either String MetaModel)
forall a. FromJSON a => String -> IO (Either String a)
JSON.eitherDecodeFileStrict' String
fp
case Either String MetaModel
res of
Left String
e -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
Right (MetaModel
mm :: MetaModel) -> MetaModel -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => MetaModel -> m Exp
lift MetaModel
mm