{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE TypeOperators       #-}
{-# LANGUAGE DeriveGeneric       #-}

module CDP.Definition where
import           System.Exit        (exitFailure, exitSuccess)
import           System.IO          (stderr, hPutStrLn)
import qualified Data.ByteString.Lazy.Char8 as BSL
import           System.Environment (getArgs)
import           Control.Monad      (forM_, mzero, join)
import           Control.Applicative
import           Data.Aeson(eitherDecode, Value(..), FromJSON(..), ToJSON(..),pairs,(.:), (.:?), (.=), (.!=), object)
import           Data.Monoid((<>))
import           Data.Text (Text)
import qualified GHC.Generics

data Version = Version { 
    Version -> Text
versionMinor :: Text,
    Version -> Text
versionMajor :: Text
  } deriving (Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show,Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq,(forall x. Version -> Rep Version x)
-> (forall x. Rep Version x -> Version) -> Generic Version
forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Version x -> Version
$cfrom :: forall x. Version -> Rep Version x
GHC.Generics.Generic)


instance FromJSON Version where
  parseJSON :: Value -> Parser Version
parseJSON (Object Object
v) = Text -> Text -> Version
Version (Text -> Text -> Version)
-> Parser Text -> Parser (Text -> Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"minor" Parser (Text -> Version) -> Parser Text -> Parser Version
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"major"
  parseJSON Value
_          = Parser Version
forall (m :: * -> *) a. MonadPlus m => m a
mzero


data Items = Items { 
    Items -> Maybe Text
itemsType :: Maybe Text,
    Items -> Maybe Text
itemsRef :: Maybe Text
  } deriving (Int -> Items -> ShowS
[Items] -> ShowS
Items -> String
(Int -> Items -> ShowS)
-> (Items -> String) -> ([Items] -> ShowS) -> Show Items
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Items] -> ShowS
$cshowList :: [Items] -> ShowS
show :: Items -> String
$cshow :: Items -> String
showsPrec :: Int -> Items -> ShowS
$cshowsPrec :: Int -> Items -> ShowS
Show,Items -> Items -> Bool
(Items -> Items -> Bool) -> (Items -> Items -> Bool) -> Eq Items
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Items -> Items -> Bool
$c/= :: Items -> Items -> Bool
== :: Items -> Items -> Bool
$c== :: Items -> Items -> Bool
Eq,(forall x. Items -> Rep Items x)
-> (forall x. Rep Items x -> Items) -> Generic Items
forall x. Rep Items x -> Items
forall x. Items -> Rep Items x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Items x -> Items
$cfrom :: forall x. Items -> Rep Items x
GHC.Generics.Generic)


instance FromJSON Items where
  parseJSON :: Value -> Parser Items
parseJSON (Object Object
v) = Maybe Text -> Maybe Text -> Items
Items (Maybe Text -> Maybe Text -> Items)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Items)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"type" Parser (Maybe Text -> Items) -> Parser (Maybe Text) -> Parser Items
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"$ref"
  parseJSON Value
_          = Parser Items
forall (m :: * -> *) a. MonadPlus m => m a
mzero


data Property = Property {
    Property -> Maybe Items
propertyItems :: Maybe Items,
    Property -> Bool
propertyExperimental :: Bool,
    Property -> Text
propertyName :: Text,
    Property -> Maybe Text
propertyType :: Maybe Text,
    Property -> Maybe [Text]
propertyEnum :: Maybe [Text],
    Property -> Bool
propertyOptional :: Bool,
    Property -> Maybe Text
propertyRef :: Maybe Text,
    Property -> Maybe Text
propertyDescription :: Maybe Text,
    Property -> Bool
propertyDeprecated :: Bool
  } deriving (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
showList :: [Property] -> ShowS
$cshowList :: [Property] -> ShowS
show :: Property -> String
$cshow :: Property -> String
showsPrec :: Int -> Property -> ShowS
$cshowsPrec :: Int -> Property -> ShowS
Show,Property -> Property -> Bool
(Property -> Property -> Bool)
-> (Property -> Property -> Bool) -> Eq Property
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c== :: Property -> Property -> Bool
Eq,(forall x. Property -> Rep Property x)
-> (forall x. Rep Property x -> Property) -> Generic Property
forall x. Rep Property x -> Property
forall x. Property -> Rep Property x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Property x -> Property
$cfrom :: forall x. Property -> Rep Property x
GHC.Generics.Generic)


instance FromJSON Property where
  parseJSON :: Value -> Parser Property
parseJSON (Object Object
v) = Maybe Items
-> Bool
-> Text
-> Maybe Text
-> Maybe [Text]
-> Bool
-> Maybe Text
-> Maybe Text
-> Bool
-> Property
Property
    (Maybe Items
 -> Bool
 -> Text
 -> Maybe Text
 -> Maybe [Text]
 -> Bool
 -> Maybe Text
 -> Maybe Text
 -> Bool
 -> Property)
-> Parser (Maybe Items)
-> Parser
     (Bool
      -> Text
      -> Maybe Text
      -> Maybe [Text]
      -> Bool
      -> Maybe Text
      -> Maybe Text
      -> Bool
      -> Property)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe Items)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"items"
    Parser
  (Bool
   -> Text
   -> Maybe Text
   -> Maybe [Text]
   -> Bool
   -> Maybe Text
   -> Maybe Text
   -> Bool
   -> Property)
-> Parser Bool
-> Parser
     (Text
      -> Maybe Text
      -> Maybe [Text]
      -> Bool
      -> Maybe Text
      -> Maybe Text
      -> Bool
      -> Property)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"experimental" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    Parser
  (Text
   -> Maybe Text
   -> Maybe [Text]
   -> Bool
   -> Maybe Text
   -> Maybe Text
   -> Bool
   -> Property)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Bool
      -> Maybe Text
      -> Maybe Text
      -> Bool
      -> Property)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name"
    Parser
  (Maybe Text
   -> Maybe [Text]
   -> Bool
   -> Maybe Text
   -> Maybe Text
   -> Bool
   -> Property)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Bool -> Maybe Text -> Maybe Text -> Bool -> Property)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"type"
    Parser
  (Maybe [Text]
   -> Bool -> Maybe Text -> Maybe Text -> Bool -> Property)
-> Parser (Maybe [Text])
-> Parser (Bool -> Maybe Text -> Maybe Text -> Bool -> Property)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"enum"
    Parser (Bool -> Maybe Text -> Maybe Text -> Bool -> Property)
-> Parser Bool
-> Parser (Maybe Text -> Maybe Text -> Bool -> Property)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"optional" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    Parser (Maybe Text -> Maybe Text -> Bool -> Property)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Bool -> Property)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"$ref"
    Parser (Maybe Text -> Bool -> Property)
-> Parser (Maybe Text) -> Parser (Bool -> Property)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"description"
    Parser (Bool -> Property) -> Parser Bool -> Parser Property
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"deprecated" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
  parseJSON Value
_          = Parser Property
forall (m :: * -> *) a. MonadPlus m => m a
mzero


data Command = Command {
    Command -> Bool
commandExperimental :: Bool,
    Command -> Text
commandName :: Text,
    Command -> [Property]
commandReturns :: [Property],
    Command -> [Property]
commandParameters :: [Property],
    Command -> Maybe Text
commandRedirect :: Maybe Text,
    Command -> Maybe Text
commandDescription :: Maybe Text,
    Command -> Bool
commandDeprecated ::  Bool
  } deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show,Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq,(forall x. Command -> Rep Command x)
-> (forall x. Rep Command x -> Command) -> Generic Command
forall x. Rep Command x -> Command
forall x. Command -> Rep Command x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Command x -> Command
$cfrom :: forall x. Command -> Rep Command x
GHC.Generics.Generic)


instance FromJSON Command where
  parseJSON :: Value -> Parser Command
parseJSON (Object Object
v) = Bool
-> Text
-> [Property]
-> [Property]
-> Maybe Text
-> Maybe Text
-> Bool
-> Command
Command
    (Bool
 -> Text
 -> [Property]
 -> [Property]
 -> Maybe Text
 -> Maybe Text
 -> Bool
 -> Command)
-> Parser Bool
-> Parser
     (Text
      -> [Property]
      -> [Property]
      -> Maybe Text
      -> Maybe Text
      -> Bool
      -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"experimental" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    Parser
  (Text
   -> [Property]
   -> [Property]
   -> Maybe Text
   -> Maybe Text
   -> Bool
   -> Command)
-> Parser Text
-> Parser
     ([Property]
      -> [Property] -> Maybe Text -> Maybe Text -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name"
    Parser
  ([Property]
   -> [Property] -> Maybe Text -> Maybe Text -> Bool -> Command)
-> Parser [Property]
-> Parser
     ([Property] -> Maybe Text -> Maybe Text -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Property])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"returns" Parser (Maybe [Property]) -> [Property] -> Parser [Property]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    Parser ([Property] -> Maybe Text -> Maybe Text -> Bool -> Command)
-> Parser [Property]
-> Parser (Maybe Text -> Maybe Text -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Property])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"parameters" Parser (Maybe [Property]) -> [Property] -> Parser [Property]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    Parser (Maybe Text -> Maybe Text -> Bool -> Command)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"redirect"
    Parser (Maybe Text -> Bool -> Command)
-> Parser (Maybe Text) -> Parser (Bool -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"description"
    Parser (Bool -> Command) -> Parser Bool -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"deprecated" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
  parseJSON Value
_          = Parser Command
forall (m :: * -> *) a. MonadPlus m => m a
mzero


data Type = Type {
    Type -> Maybe Items
typeItems :: Maybe Items,
    Type -> Bool
typeExperimental :: Bool,
    Type -> Text
typeId :: Text,
    Type -> Text
typeType :: Text,
    Type -> Maybe [Text]
typeEnum :: Maybe [Text],
    Type -> Maybe [Property]
typeProperties :: Maybe [Property],
    Type -> Maybe Text
typeDescription :: Maybe Text,
    Type -> Bool
typeDeprecated :: Bool
  } deriving (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
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show,Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq,(forall x. Type -> Rep Type x)
-> (forall x. Rep Type x -> Type) -> Generic Type
forall x. Rep Type x -> Type
forall x. Type -> Rep Type x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Type x -> Type
$cfrom :: forall x. Type -> Rep Type x
GHC.Generics.Generic)


instance FromJSON Type where
  parseJSON :: Value -> Parser Type
parseJSON (Object Object
v) = Maybe Items
-> Bool
-> Text
-> Text
-> Maybe [Text]
-> Maybe [Property]
-> Maybe Text
-> Bool
-> Type
Type
    (Maybe Items
 -> Bool
 -> Text
 -> Text
 -> Maybe [Text]
 -> Maybe [Property]
 -> Maybe Text
 -> Bool
 -> Type)
-> Parser (Maybe Items)
-> Parser
     (Bool
      -> Text
      -> Text
      -> Maybe [Text]
      -> Maybe [Property]
      -> Maybe Text
      -> Bool
      -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe Items)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"items"
    Parser
  (Bool
   -> Text
   -> Text
   -> Maybe [Text]
   -> Maybe [Property]
   -> Maybe Text
   -> Bool
   -> Type)
-> Parser Bool
-> Parser
     (Text
      -> Text
      -> Maybe [Text]
      -> Maybe [Property]
      -> Maybe Text
      -> Bool
      -> Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"experimental" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    Parser
  (Text
   -> Text
   -> Maybe [Text]
   -> Maybe [Property]
   -> Maybe Text
   -> Bool
   -> Type)
-> Parser Text
-> Parser
     (Text
      -> Maybe [Text] -> Maybe [Property] -> Maybe Text -> Bool -> Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"id"
    Parser
  (Text
   -> Maybe [Text] -> Maybe [Property] -> Maybe Text -> Bool -> Type)
-> Parser Text
-> Parser
     (Maybe [Text] -> Maybe [Property] -> Maybe Text -> Bool -> Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"type"
    Parser
  (Maybe [Text] -> Maybe [Property] -> Maybe Text -> Bool -> Type)
-> Parser (Maybe [Text])
-> Parser (Maybe [Property] -> Maybe Text -> Bool -> Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"enum"
    Parser (Maybe [Property] -> Maybe Text -> Bool -> Type)
-> Parser (Maybe [Property]) -> Parser (Maybe Text -> Bool -> Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Property])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"properties"
    Parser (Maybe Text -> Bool -> Type)
-> Parser (Maybe Text) -> Parser (Bool -> Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"description"
    Parser (Bool -> Type) -> Parser Bool -> Parser Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"deprecated" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
  parseJSON Value
_          = Parser Type
forall (m :: * -> *) a. MonadPlus m => m a
mzero


data Event = Event {
    Event -> Bool
eventExperimental :: Bool,
    Event -> Text
eventName :: Text,
    Event -> [Property]
eventParameters :: [Property],
    Event -> Maybe Text
eventDescription :: Maybe Text,
    Event -> Bool
eventDeprecated :: Bool
  } deriving (Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show,Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq,(forall x. Event -> Rep Event x)
-> (forall x. Rep Event x -> Event) -> Generic Event
forall x. Rep Event x -> Event
forall x. Event -> Rep Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Event x -> Event
$cfrom :: forall x. Event -> Rep Event x
GHC.Generics.Generic)


instance FromJSON Event where
  parseJSON :: Value -> Parser Event
parseJSON (Object Object
v) = Bool -> Text -> [Property] -> Maybe Text -> Bool -> Event
Event
    (Bool -> Text -> [Property] -> Maybe Text -> Bool -> Event)
-> Parser Bool
-> Parser (Text -> [Property] -> Maybe Text -> Bool -> Event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"experimental" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    Parser (Text -> [Property] -> Maybe Text -> Bool -> Event)
-> Parser Text
-> Parser ([Property] -> Maybe Text -> Bool -> Event)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"name"
    Parser ([Property] -> Maybe Text -> Bool -> Event)
-> Parser [Property] -> Parser (Maybe Text -> Bool -> Event)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Property])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"parameters" Parser (Maybe [Property]) -> [Property] -> Parser [Property]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    Parser (Maybe Text -> Bool -> Event)
-> Parser (Maybe Text) -> Parser (Bool -> Event)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"description"
    Parser (Bool -> Event) -> Parser Bool -> Parser Event
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"deprecated" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
  parseJSON Value
_          = Parser Event
forall (m :: * -> *) a. MonadPlus m => m a
mzero


data Domain = Domain {
    Domain -> [Command]
domainCommands :: [Command],
    Domain -> Text
domainDomain :: Text,
    Domain -> [Text]
domainDependencies :: [Text],
    Domain -> Bool
domainExperimental :: Bool,
    Domain -> [Type]
domainTypes :: [Type],
    Domain -> [Event]
domainEvents :: [Event],
    Domain -> Maybe Text
domainDescription :: Maybe Text,
    Domain -> Bool
domainDeprecated :: Bool
  } deriving (Int -> Domain -> ShowS
[Domain] -> ShowS
Domain -> String
(Int -> Domain -> ShowS)
-> (Domain -> String) -> ([Domain] -> ShowS) -> Show Domain
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Domain] -> ShowS
$cshowList :: [Domain] -> ShowS
show :: Domain -> String
$cshow :: Domain -> String
showsPrec :: Int -> Domain -> ShowS
$cshowsPrec :: Int -> Domain -> ShowS
Show,Domain -> Domain -> Bool
(Domain -> Domain -> Bool)
-> (Domain -> Domain -> Bool) -> Eq Domain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Domain -> Domain -> Bool
$c/= :: Domain -> Domain -> Bool
== :: Domain -> Domain -> Bool
$c== :: Domain -> Domain -> Bool
Eq,(forall x. Domain -> Rep Domain x)
-> (forall x. Rep Domain x -> Domain) -> Generic Domain
forall x. Rep Domain x -> Domain
forall x. Domain -> Rep Domain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Domain x -> Domain
$cfrom :: forall x. Domain -> Rep Domain x
GHC.Generics.Generic)


instance FromJSON Domain where
  parseJSON :: Value -> Parser Domain
parseJSON (Object Object
v) = [Command]
-> Text
-> [Text]
-> Bool
-> [Type]
-> [Event]
-> Maybe Text
-> Bool
-> Domain
Domain
    ([Command]
 -> Text
 -> [Text]
 -> Bool
 -> [Type]
 -> [Event]
 -> Maybe Text
 -> Bool
 -> Domain)
-> Parser [Command]
-> Parser
     (Text
      -> [Text]
      -> Bool
      -> [Type]
      -> [Event]
      -> Maybe Text
      -> Bool
      -> Domain)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Command]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"commands"
    Parser
  (Text
   -> [Text]
   -> Bool
   -> [Type]
   -> [Event]
   -> Maybe Text
   -> Bool
   -> Domain)
-> Parser Text
-> Parser
     ([Text]
      -> Bool -> [Type] -> [Event] -> Maybe Text -> Bool -> Domain)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"domain"
    Parser
  ([Text]
   -> Bool -> [Type] -> [Event] -> Maybe Text -> Bool -> Domain)
-> Parser [Text]
-> Parser
     (Bool -> [Type] -> [Event] -> Maybe Text -> Bool -> Domain)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"dependencies" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    Parser (Bool -> [Type] -> [Event] -> Maybe Text -> Bool -> Domain)
-> Parser Bool
-> Parser ([Type] -> [Event] -> Maybe Text -> Bool -> Domain)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"experimental" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    Parser ([Type] -> [Event] -> Maybe Text -> Bool -> Domain)
-> Parser [Type]
-> Parser ([Event] -> Maybe Text -> Bool -> Domain)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Type])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"types" Parser (Maybe [Type]) -> [Type] -> Parser [Type]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    Parser ([Event] -> Maybe Text -> Bool -> Domain)
-> Parser [Event] -> Parser (Maybe Text -> Bool -> Domain)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Event])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"events" Parser (Maybe [Event]) -> [Event] -> Parser [Event]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    Parser (Maybe Text -> Bool -> Domain)
-> Parser (Maybe Text) -> Parser (Bool -> Domain)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"description"
    Parser (Bool -> Domain) -> Parser Bool -> Parser Domain
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"deprecated" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
  parseJSON Value
_          = Parser Domain
forall (m :: * -> *) a. MonadPlus m => m a
mzero


data TopLevel = TopLevel { 
    TopLevel -> Version
topLevelVersion :: Version,
    TopLevel -> [Domain]
topLevelDomains :: [Domain]
  } deriving (Int -> TopLevel -> ShowS
[TopLevel] -> ShowS
TopLevel -> String
(Int -> TopLevel -> ShowS)
-> (TopLevel -> String) -> ([TopLevel] -> ShowS) -> Show TopLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TopLevel] -> ShowS
$cshowList :: [TopLevel] -> ShowS
show :: TopLevel -> String
$cshow :: TopLevel -> String
showsPrec :: Int -> TopLevel -> ShowS
$cshowsPrec :: Int -> TopLevel -> ShowS
Show,TopLevel -> TopLevel -> Bool
(TopLevel -> TopLevel -> Bool)
-> (TopLevel -> TopLevel -> Bool) -> Eq TopLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TopLevel -> TopLevel -> Bool
$c/= :: TopLevel -> TopLevel -> Bool
== :: TopLevel -> TopLevel -> Bool
$c== :: TopLevel -> TopLevel -> Bool
Eq,(forall x. TopLevel -> Rep TopLevel x)
-> (forall x. Rep TopLevel x -> TopLevel) -> Generic TopLevel
forall x. Rep TopLevel x -> TopLevel
forall x. TopLevel -> Rep TopLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TopLevel x -> TopLevel
$cfrom :: forall x. TopLevel -> Rep TopLevel x
GHC.Generics.Generic)


instance FromJSON TopLevel where
  parseJSON :: Value -> Parser TopLevel
parseJSON (Object Object
v) = Version -> [Domain] -> TopLevel
TopLevel (Version -> [Domain] -> TopLevel)
-> Parser Version -> Parser ([Domain] -> TopLevel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Version
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"version" Parser ([Domain] -> TopLevel) -> Parser [Domain] -> Parser TopLevel
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [Domain]
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"domains"
  parseJSON Value
_          = Parser TopLevel
forall (m :: * -> *) a. MonadPlus m => m a
mzero




-- | Use parser to get TopLevel object
parse :: FilePath -> IO TopLevel
parse :: String -> IO TopLevel
parse String
filename = do
    ByteString
input <- String -> IO ByteString
BSL.readFile String
filename
    case ByteString -> Either String TopLevel
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
input of
      Left String
errTop -> String -> IO TopLevel
forall a. String -> IO a
fatal (String -> IO TopLevel) -> String -> IO TopLevel
forall a b. (a -> b) -> a -> b
$ case (ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
input :: Either String Value) of
                           Left  String
err -> String
"Invalid JSON file: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filename String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n   " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
                           Right Value
_   -> String
"Mismatched JSON value from file: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filename
                                     String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
errTop
      Right TopLevel
r     -> TopLevel -> IO TopLevel
forall (m :: * -> *) a. Monad m => a -> m a
return (TopLevel
r :: TopLevel)
  where
    fatal :: String -> IO a
    fatal :: String -> IO a
fatal String
msg = do Handle -> String -> IO ()
hPutStrLn Handle
stderr String
msg
                   IO a
forall a. IO a
exitFailure