{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module Hedgehog.Extras.Internal.Plan
  ( Plan(..)
  , Component(..)
  ) where

import           Control.Applicative
import           Data.Aeson
import           Data.Eq
import           Data.Function
import           Data.Maybe
import           Data.Text (Text)
import           GHC.Generics
import           Text.Show

data Component = Component
  { Component -> Maybe Text
componentName :: Maybe Text
  , Component -> Maybe Text
binFile :: Maybe Text
  }
  deriving ((forall x. Component -> Rep Component x)
-> (forall x. Rep Component x -> Component) -> Generic Component
forall x. Rep Component x -> Component
forall x. Component -> Rep Component x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Component -> Rep Component x
from :: forall x. Component -> Rep Component x
$cto :: forall x. Rep Component x -> Component
to :: forall x. Rep Component x -> Component
Generic, Component -> Component -> Bool
(Component -> Component -> Bool)
-> (Component -> Component -> Bool) -> Eq Component
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Component -> Component -> Bool
== :: Component -> Component -> Bool
$c/= :: Component -> Component -> Bool
/= :: Component -> Component -> Bool
Eq, Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
(Int -> Component -> ShowS)
-> (Component -> String)
-> ([Component] -> ShowS)
-> Show Component
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Component -> ShowS
showsPrec :: Int -> Component -> ShowS
$cshow :: Component -> String
show :: Component -> String
$cshowList :: [Component] -> ShowS
showList :: [Component] -> ShowS
Show)

newtype Plan = Plan
  { Plan -> [Component]
installPlan :: [Component]
  }
  deriving ((forall x. Plan -> Rep Plan x)
-> (forall x. Rep Plan x -> Plan) -> Generic Plan
forall x. Rep Plan x -> Plan
forall x. Plan -> Rep Plan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Plan -> Rep Plan x
from :: forall x. Plan -> Rep Plan x
$cto :: forall x. Rep Plan x -> Plan
to :: forall x. Rep Plan x -> Plan
Generic, Plan -> Plan -> Bool
(Plan -> Plan -> Bool) -> (Plan -> Plan -> Bool) -> Eq Plan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Plan -> Plan -> Bool
== :: Plan -> Plan -> Bool
$c/= :: Plan -> Plan -> Bool
/= :: Plan -> Plan -> Bool
Eq, Int -> Plan -> ShowS
[Plan] -> ShowS
Plan -> String
(Int -> Plan -> ShowS)
-> (Plan -> String) -> ([Plan] -> ShowS) -> Show Plan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Plan -> ShowS
showsPrec :: Int -> Plan -> ShowS
$cshow :: Plan -> String
show :: Plan -> String
$cshowList :: [Plan] -> ShowS
showList :: [Plan] -> ShowS
Show)

instance FromJSON Plan where
    parseJSON :: Value -> Parser Plan
parseJSON = String -> (Object -> Parser Plan) -> Value -> Parser Plan
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Plan" ((Object -> Parser Plan) -> Value -> Parser Plan)
-> (Object -> Parser Plan) -> Value -> Parser Plan
forall a b. (a -> b) -> a -> b
$ \Object
v -> [Component] -> Plan
Plan
        ([Component] -> Plan) -> Parser [Component] -> Parser Plan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser [Component]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"install-plan"

instance FromJSON Component where
    parseJSON :: Value -> Parser Component
parseJSON = String -> (Object -> Parser Component) -> Value -> Parser Component
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Plan" ((Object -> Parser Component) -> Value -> Parser Component)
-> (Object -> Parser Component) -> Value -> Parser Component
forall a b. (a -> b) -> a -> b
$ \Object
v -> Maybe Text -> Maybe Text -> Component
Component
        (Maybe Text -> Maybe Text -> Component)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Component)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"component-name"
        Parser (Maybe Text -> Component)
-> Parser (Maybe Text) -> Parser Component
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"bin-file"