{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoFieldSelectors #-}

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

import           Control.Applicative
import           Control.Monad
import           Data.Aeson
import qualified Data.Aeson as A
import qualified Data.Aeson.KeyMap as M
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
  , Component -> [Component]
components :: [Component]
  }
  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 -> do
      Maybe Text
componentName <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"component-name"
      Maybe Text
binFile <- Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"bin-file"
      [(Key, Object)]
componentsTuples <- [[(Key, Object)]] -> [(Key, Object)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(Key, Object)]] -> [(Key, Object)])
-> (Maybe (KeyMap Object) -> [[(Key, Object)]])
-> Maybe (KeyMap Object)
-> [(Key, Object)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [(Key, Object)] -> [[(Key, Object)]]
forall a. Maybe a -> [a]
maybeToList (Maybe [(Key, Object)] -> [[(Key, Object)]])
-> (Maybe (KeyMap Object) -> Maybe [(Key, Object)])
-> Maybe (KeyMap Object)
-> [[(Key, Object)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyMap Object -> [(Key, Object)])
-> Maybe (KeyMap Object) -> Maybe [(Key, Object)]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyMap Object -> [(Key, Object)]
forall v. KeyMap v -> [(Key, v)]
M.toAscList (Maybe (KeyMap Object) -> [(Key, Object)])
-> Parser (Maybe (KeyMap Object)) -> Parser [(Key, Object)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe (KeyMap Object))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"components"
      -- sub-components are an object with components name as a key
      [Component]
components <- [(Key, Object)]
-> ((Key, Object) -> Parser Component) -> Parser [Component]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Key, Object)]
componentsTuples (((Key, Object) -> Parser Component) -> Parser [Component])
-> ((Key, Object) -> Parser Component) -> Parser [Component]
forall a b. (a -> b) -> a -> b
$ \(Key
subComponentName, Object
subComponent) ->
        Value -> Parser Component
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser Component) -> Value -> Parser Component
forall a b. (a -> b) -> a -> b
$
          Object -> Value
A.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$
            Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
M.insert Key
"component-name" (Key -> Value
forall a. ToJSON a => a -> Value
toJSON Key
subComponentName) Object
subComponent
      Component -> Parser Component
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Component{[Component]
Maybe Text
componentName :: Maybe Text
binFile :: Maybe Text
components :: [Component]
componentName :: Maybe Text
binFile :: Maybe Text
components :: [Component]
..}