-- | Module for filtering out deprecated things.
{-# LANGUAGE RecordWildCards #-}
module CDP.Gen.Deprecated
    ( removeDeprecated
    ) where

import CDP.Definition

removeDeprecated :: TopLevel -> TopLevel
removeDeprecated :: TopLevel -> TopLevel
removeDeprecated topLevel :: TopLevel
topLevel@TopLevel {[Domain]
Version
topLevelDomains :: TopLevel -> [Domain]
topLevelVersion :: TopLevel -> Version
topLevelDomains :: [Domain]
topLevelVersion :: Version
..} = TopLevel
topLevel
    { topLevelDomains :: [Domain]
topLevelDomains =
        (Domain -> Domain) -> [Domain] -> [Domain]
forall a b. (a -> b) -> [a] -> [b]
map Domain -> Domain
goDomain ([Domain] -> [Domain])
-> ([Domain] -> [Domain]) -> [Domain] -> [Domain]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Domain -> Bool) -> [Domain] -> [Domain]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Domain -> Bool) -> Domain -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> Bool
domainDeprecated) ([Domain] -> [Domain]) -> [Domain] -> [Domain]
forall a b. (a -> b) -> a -> b
$ [Domain]
topLevelDomains
    }
  where
    goDomain :: Domain -> Domain
goDomain domain :: Domain
domain@Domain {Bool
[Text]
[Event]
[Type]
[Command]
Maybe Text
Text
domainDescription :: Domain -> Maybe Text
domainEvents :: Domain -> [Event]
domainTypes :: Domain -> [Type]
domainExperimental :: Domain -> Bool
domainDependencies :: Domain -> [Text]
domainDomain :: Domain -> Text
domainCommands :: Domain -> [Command]
domainDeprecated :: Bool
domainDescription :: Maybe Text
domainEvents :: [Event]
domainTypes :: [Type]
domainExperimental :: Bool
domainDependencies :: [Text]
domainDomain :: Text
domainCommands :: [Command]
domainDeprecated :: Domain -> Bool
..} = Domain
domain
        { domainCommands :: [Command]
domainCommands = (Command -> Command) -> [Command] -> [Command]
forall a b. (a -> b) -> [a] -> [b]
map Command -> Command
goCommand ([Command] -> [Command]) -> [Command] -> [Command]
forall a b. (a -> b) -> a -> b
$ (Command -> Bool) -> [Command] -> [Command]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Command -> Bool) -> Command -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command -> Bool
commandDeprecated) [Command]
domainCommands
        , domainTypes :: [Type]
domainTypes    = (Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Type
goType    ([Type] -> [Type]) -> [Type] -> [Type]
forall a b. (a -> b) -> a -> b
$ (Type -> Bool) -> [Type] -> [Type]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Type -> Bool) -> Type -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Bool
typeDeprecated)    [Type]
domainTypes
        , domainEvents :: [Event]
domainEvents   = (Event -> Event) -> [Event] -> [Event]
forall a b. (a -> b) -> [a] -> [b]
map Event -> Event
goEvent   ([Event] -> [Event]) -> [Event] -> [Event]
forall a b. (a -> b) -> a -> b
$ (Event -> Bool) -> [Event] -> [Event]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Event -> Bool) -> Event -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Bool
eventDeprecated)   [Event]
domainEvents
        }

    goCommand :: Command -> Command
goCommand command :: Command
command@Command {Bool
[Property]
Maybe Text
Text
commandDescription :: Command -> Maybe Text
commandRedirect :: Command -> Maybe Text
commandParameters :: Command -> [Property]
commandReturns :: Command -> [Property]
commandName :: Command -> Text
commandExperimental :: Command -> Bool
commandDeprecated :: Bool
commandDescription :: Maybe Text
commandRedirect :: Maybe Text
commandParameters :: [Property]
commandReturns :: [Property]
commandName :: Text
commandExperimental :: Bool
commandDeprecated :: Command -> Bool
..} = Command
command
        { commandReturns :: [Property]
commandReturns    = (Property -> Bool) -> [Property] -> [Property]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Property -> Bool) -> Property -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> Bool
propertyDeprecated) [Property]
commandReturns
        , commandParameters :: [Property]
commandParameters = (Property -> Bool) -> [Property] -> [Property]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Property -> Bool) -> Property -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> Bool
propertyDeprecated) [Property]
commandParameters
        }

    goType :: Type -> Type
goType ty :: Type
ty@Type {Bool
Maybe [Text]
Maybe [Property]
Maybe Text
Maybe Items
Text
typeDescription :: Type -> Maybe Text
typeProperties :: Type -> Maybe [Property]
typeEnum :: Type -> Maybe [Text]
typeType :: Type -> Text
typeId :: Type -> Text
typeExperimental :: Type -> Bool
typeItems :: Type -> Maybe Items
typeDeprecated :: Bool
typeDescription :: Maybe Text
typeProperties :: Maybe [Property]
typeEnum :: Maybe [Text]
typeType :: Text
typeId :: Text
typeExperimental :: Bool
typeItems :: Maybe Items
typeDeprecated :: Type -> Bool
..} = Type
ty
        { typeProperties :: Maybe [Property]
typeProperties = (Property -> Bool) -> [Property] -> [Property]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Property -> Bool) -> Property -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> Bool
propertyDeprecated) ([Property] -> [Property]) -> Maybe [Property] -> Maybe [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Property]
typeProperties
        }

    goEvent :: Event -> Event
goEvent event :: Event
event@Event {Bool
[Property]
Maybe Text
Text
eventDescription :: Event -> Maybe Text
eventParameters :: Event -> [Property]
eventName :: Event -> Text
eventExperimental :: Event -> Bool
eventDeprecated :: Bool
eventDescription :: Maybe Text
eventParameters :: [Property]
eventName :: Text
eventExperimental :: Bool
eventDeprecated :: Event -> Bool
..} = Event
event
        { eventParameters :: [Property]
eventParameters = (Property -> Bool) -> [Property] -> [Property]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Property -> Bool) -> Property -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> Bool
propertyDeprecated) [Property]
eventParameters
        }