{-# 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. 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
$cto :: forall x. Rep Component x -> Component
$cfrom :: forall x. Component -> Rep Component x
Generic, Component -> Component -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Component -> Component -> Bool
$c/= :: Component -> Component -> Bool
== :: Component -> Component -> Bool
$c== :: Component -> Component -> Bool
Eq, Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Component] -> ShowS
$cshowList :: [Component] -> ShowS
show :: Component -> String
$cshow :: Component -> String
showsPrec :: Int -> Component -> ShowS
$cshowsPrec :: Int -> Component -> ShowS
Show)

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

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

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