{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module Stack.Types.GHCDownloadInfo
  ( GHCDownloadInfo (..)
  ) where

import           Pantry.Internal.AesonExtended
                   ( FromJSON (..), WithJSONWarnings (..), (..:?), (..!=)
                   , withObjectWarnings
                   )
import           Stack.Prelude
import           Stack.Types.DownloadInfo
                   ( DownloadInfo, parseDownloadInfoFromObject )

data GHCDownloadInfo = GHCDownloadInfo
  { GHCDownloadInfo -> [Text]
gdiConfigureOpts :: [Text]
  , GHCDownloadInfo -> Map Text Text
gdiConfigureEnv :: Map Text Text
  , GHCDownloadInfo -> DownloadInfo
gdiDownloadInfo :: DownloadInfo
  }
  deriving Int -> GHCDownloadInfo -> ShowS
[GHCDownloadInfo] -> ShowS
GHCDownloadInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GHCDownloadInfo] -> ShowS
$cshowList :: [GHCDownloadInfo] -> ShowS
show :: GHCDownloadInfo -> String
$cshow :: GHCDownloadInfo -> String
showsPrec :: Int -> GHCDownloadInfo -> ShowS
$cshowsPrec :: Int -> GHCDownloadInfo -> ShowS
Show

instance FromJSON (WithJSONWarnings GHCDownloadInfo) where
  parseJSON :: Value -> Parser (WithJSONWarnings GHCDownloadInfo)
parseJSON = forall a.
String
-> (Object -> WarningParser a)
-> Value
-> Parser (WithJSONWarnings a)
withObjectWarnings String
"GHCDownloadInfo" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [Text]
configureOpts <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"configure-opts" forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= forall a. Monoid a => a
mempty
    Map Text Text
configureEnv <- Object
o forall a. FromJSON a => Object -> Text -> WarningParser (Maybe a)
..:? Text
"configure-env" forall a. WarningParser (Maybe a) -> a -> WarningParser a
..!= forall a. Monoid a => a
mempty
    DownloadInfo
downloadInfo <- Object -> WarningParser DownloadInfo
parseDownloadInfoFromObject Object
o
    forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCDownloadInfo
      { gdiConfigureOpts :: [Text]
gdiConfigureOpts = [Text]
configureOpts
      , gdiConfigureEnv :: Map Text Text
gdiConfigureEnv = Map Text Text
configureEnv
      , gdiDownloadInfo :: DownloadInfo
gdiDownloadInfo = DownloadInfo
downloadInfo
      }