{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LiberalTypeSynonyms #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Hpack.Config (
-- | /__NOTE:__/ This module is exposed to allow integration of Hpack into
-- other tools.  It is not meant for general use by end users.  The following
-- caveats apply:
--
-- * The API is undocumented, consult the source instead.
--
-- * The exposed types and functions primarily serve Hpack's own needs, not
-- that of a public API.  Breaking changes can happen as Hpack evolves.
--
-- As an Hpack user you either want to use the @hpack@ executable or a build
-- tool that supports Hpack (e.g. @stack@ or @cabal2nix@).

  DecodeOptions(..)
, ProgramName(..)
, defaultDecodeOptions
, packageConfig
, DecodeResult(..)
, readPackageConfig
, readPackageConfigWithError

, renamePackage
, packageDependencies
, package
, section
, Package(..)
, Dependencies(..)
, DependencyInfo(..)
, VersionConstraint(..)
, DependencyVersion(..)
, SourceDependency(..)
, GitRef
, GitUrl
, BuildTool(..)
, SystemBuildTools(..)
, GhcOption
, Verbatim(..)
, VerbatimValue(..)
, verbatimValueToString
, CustomSetup(..)
, Section(..)
, Library(..)
, Executable(..)
, Conditional(..)
, Cond(..)
, Flag(..)
, SourceRepository(..)
, Language(..)
, BuildType(..)
, GhcProfOption
, GhcjsOption
, CppOption
, AsmOption
, CcOption
, LdOption
, Path(..)
, Module(..)
#ifdef TEST
, renameDependencies
, Empty(..)
, pathsModuleFromPackageName

, LibrarySection(..)
, fromLibrarySectionInConditional
, formatOrList

, toBuildTool
#endif
) where

import           Imports

import           Data.Either
import           Data.Bitraversable
import           Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as Map
import qualified Data.Aeson.Config.KeyMap as KeyMap
import           Data.Maybe
import           Data.Monoid (Last(..))
import           Data.Ord
import qualified Data.Text as T
import           Data.Text.Encoding (decodeUtf8)
import           Data.Scientific (Scientific)
import           System.Directory
import           System.FilePath
import           Control.Monad.State (MonadState, StateT, evalStateT)
import qualified Control.Monad.State as State
import           Control.Monad.Writer (MonadWriter, WriterT, runWriterT, tell)
import           Control.Monad.Except
import           Data.Version (Version, makeVersion, showVersion)

import           Distribution.Pretty (prettyShow)
import qualified Distribution.SPDX.License as SPDX

import qualified Data.Yaml.Pretty as Yaml
import           Data.Aeson (object, (.=))
import           Data.Aeson.Config.Types
import           Data.Aeson.Config.FromValue hiding (decodeValue)
import qualified Data.Aeson.Config.FromValue as Config

import           Hpack.Error
import           Hpack.Syntax.Defaults
import           Hpack.Util hiding (expandGlobs)
import qualified Hpack.Util as Util
import           Hpack.Defaults
import qualified Hpack.Yaml as Yaml
import           Hpack.Syntax.DependencyVersion
import           Hpack.Syntax.Dependencies
import           Hpack.Syntax.BuildTools
import           Hpack.License
import           Hpack.CabalFile (parseVersion)
import           Hpack.Module

import qualified Path

import qualified Paths_hpack as Hpack (version)

package :: String -> String -> Package
package :: [Char] -> [Char] -> Package
package [Char]
name [Char]
version = Package {
    packageName :: [Char]
packageName = [Char]
name
  , packageVersion :: [Char]
packageVersion = [Char]
version
  , packageSynopsis :: Maybe [Char]
packageSynopsis = Maybe [Char]
forall a. Maybe a
Nothing
  , packageDescription :: Maybe [Char]
packageDescription = Maybe [Char]
forall a. Maybe a
Nothing
  , packageHomepage :: Maybe [Char]
packageHomepage = Maybe [Char]
forall a. Maybe a
Nothing
  , packageBugReports :: Maybe [Char]
packageBugReports = Maybe [Char]
forall a. Maybe a
Nothing
  , packageCategory :: Maybe [Char]
packageCategory = Maybe [Char]
forall a. Maybe a
Nothing
  , packageStability :: Maybe [Char]
packageStability = Maybe [Char]
forall a. Maybe a
Nothing
  , packageAuthor :: [[Char]]
packageAuthor = []
  , packageMaintainer :: [[Char]]
packageMaintainer = []
  , packageCopyright :: [[Char]]
packageCopyright = []
  , packageBuildType :: BuildType
packageBuildType = BuildType
Simple
  , packageLicense :: Maybe [Char]
packageLicense = Maybe [Char]
forall a. Maybe a
Nothing
  , packageLicenseFile :: [[Char]]
packageLicenseFile = []
  , packageTestedWith :: [[Char]]
packageTestedWith = []
  , packageFlags :: [Flag]
packageFlags = []
  , packageExtraSourceFiles :: [Path]
packageExtraSourceFiles = []
  , packageExtraDocFiles :: [Path]
packageExtraDocFiles = []
  , packageDataFiles :: [Path]
packageDataFiles = []
  , packageDataDir :: Maybe [Char]
packageDataDir = Maybe [Char]
forall a. Maybe a
Nothing
  , packageSourceRepository :: Maybe SourceRepository
packageSourceRepository = Maybe SourceRepository
forall a. Maybe a
Nothing
  , packageCustomSetup :: Maybe CustomSetup
packageCustomSetup = Maybe CustomSetup
forall a. Maybe a
Nothing
  , packageLibrary :: Maybe (Section Library)
packageLibrary = Maybe (Section Library)
forall a. Maybe a
Nothing
  , packageInternalLibraries :: Map [Char] (Section Library)
packageInternalLibraries = Map [Char] (Section Library)
forall a. Monoid a => a
mempty
  , packageExecutables :: Map [Char] (Section Executable)
packageExecutables = Map [Char] (Section Executable)
forall a. Monoid a => a
mempty
  , packageTests :: Map [Char] (Section Executable)
packageTests = Map [Char] (Section Executable)
forall a. Monoid a => a
mempty
  , packageBenchmarks :: Map [Char] (Section Executable)
packageBenchmarks = Map [Char] (Section Executable)
forall a. Monoid a => a
mempty
  , packageVerbatim :: [Verbatim]
packageVerbatim = []
  }

renamePackage :: String -> Package -> Package
renamePackage :: [Char] -> Package -> Package
renamePackage [Char]
name p :: Package
p@Package{[Char]
[[Char]]
[Path]
[Flag]
[Verbatim]
Maybe [Char]
Maybe SourceRepository
Maybe (Section Library)
Maybe CustomSetup
Map [Char] (Section Executable)
Map [Char] (Section Library)
BuildType
packageName :: Package -> [Char]
packageVersion :: Package -> [Char]
packageSynopsis :: Package -> Maybe [Char]
packageDescription :: Package -> Maybe [Char]
packageHomepage :: Package -> Maybe [Char]
packageBugReports :: Package -> Maybe [Char]
packageCategory :: Package -> Maybe [Char]
packageStability :: Package -> Maybe [Char]
packageAuthor :: Package -> [[Char]]
packageMaintainer :: Package -> [[Char]]
packageCopyright :: Package -> [[Char]]
packageBuildType :: Package -> BuildType
packageLicense :: Package -> Maybe [Char]
packageLicenseFile :: Package -> [[Char]]
packageTestedWith :: Package -> [[Char]]
packageFlags :: Package -> [Flag]
packageExtraSourceFiles :: Package -> [Path]
packageExtraDocFiles :: Package -> [Path]
packageDataFiles :: Package -> [Path]
packageDataDir :: Package -> Maybe [Char]
packageSourceRepository :: Package -> Maybe SourceRepository
packageCustomSetup :: Package -> Maybe CustomSetup
packageLibrary :: Package -> Maybe (Section Library)
packageInternalLibraries :: Package -> Map [Char] (Section Library)
packageExecutables :: Package -> Map [Char] (Section Executable)
packageTests :: Package -> Map [Char] (Section Executable)
packageBenchmarks :: Package -> Map [Char] (Section Executable)
packageVerbatim :: Package -> [Verbatim]
packageName :: [Char]
packageVersion :: [Char]
packageSynopsis :: Maybe [Char]
packageDescription :: Maybe [Char]
packageHomepage :: Maybe [Char]
packageBugReports :: Maybe [Char]
packageCategory :: Maybe [Char]
packageStability :: Maybe [Char]
packageAuthor :: [[Char]]
packageMaintainer :: [[Char]]
packageCopyright :: [[Char]]
packageBuildType :: BuildType
packageLicense :: Maybe [Char]
packageLicenseFile :: [[Char]]
packageTestedWith :: [[Char]]
packageFlags :: [Flag]
packageExtraSourceFiles :: [Path]
packageExtraDocFiles :: [Path]
packageDataFiles :: [Path]
packageDataDir :: Maybe [Char]
packageSourceRepository :: Maybe SourceRepository
packageCustomSetup :: Maybe CustomSetup
packageLibrary :: Maybe (Section Library)
packageInternalLibraries :: Map [Char] (Section Library)
packageExecutables :: Map [Char] (Section Executable)
packageTests :: Map [Char] (Section Executable)
packageBenchmarks :: Map [Char] (Section Executable)
packageVerbatim :: [Verbatim]
..} = Package
p {
    packageName = name
  , packageExecutables = fmap (renameDependencies packageName name) packageExecutables
  , packageTests = fmap (renameDependencies packageName name) packageTests
  , packageBenchmarks = fmap (renameDependencies packageName name) packageBenchmarks
  }

renameDependencies :: String -> String -> Section a -> Section a
renameDependencies :: forall a. [Char] -> [Char] -> Section a -> Section a
renameDependencies [Char]
old [Char]
new sect :: Section a
sect@Section{a
[[Char]]
[Path]
[Conditional (Section a)]
[Verbatim]
Maybe Bool
Maybe Language
Map BuildTool DependencyVersion
Dependencies
SystemBuildTools
sectionData :: a
sectionSourceDirs :: [[Char]]
sectionDependencies :: Dependencies
sectionPkgConfigDependencies :: [[Char]]
sectionDefaultExtensions :: [[Char]]
sectionOtherExtensions :: [[Char]]
sectionLanguage :: Maybe Language
sectionGhcOptions :: [[Char]]
sectionGhcProfOptions :: [[Char]]
sectionGhcSharedOptions :: [[Char]]
sectionGhcjsOptions :: [[Char]]
sectionCppOptions :: [[Char]]
sectionAsmOptions :: [[Char]]
sectionAsmSources :: [Path]
sectionCcOptions :: [[Char]]
sectionCSources :: [Path]
sectionCxxOptions :: [[Char]]
sectionCxxSources :: [Path]
sectionJsSources :: [Path]
sectionExtraLibDirs :: [[Char]]
sectionExtraLibraries :: [[Char]]
sectionExtraFrameworksDirs :: [[Char]]
sectionFrameworks :: [[Char]]
sectionIncludeDirs :: [[Char]]
sectionInstallIncludes :: [[Char]]
sectionLdOptions :: [[Char]]
sectionBuildable :: Maybe Bool
sectionConditionals :: [Conditional (Section a)]
sectionBuildTools :: Map BuildTool DependencyVersion
sectionSystemBuildTools :: SystemBuildTools
sectionVerbatim :: [Verbatim]
sectionVerbatim :: forall a. Section a -> [Verbatim]
sectionSystemBuildTools :: forall a. Section a -> SystemBuildTools
sectionBuildTools :: forall a. Section a -> Map BuildTool DependencyVersion
sectionConditionals :: forall a. Section a -> [Conditional (Section a)]
sectionBuildable :: forall a. Section a -> Maybe Bool
sectionLdOptions :: forall a. Section a -> [[Char]]
sectionInstallIncludes :: forall a. Section a -> [[Char]]
sectionIncludeDirs :: forall a. Section a -> [[Char]]
sectionFrameworks :: forall a. Section a -> [[Char]]
sectionExtraFrameworksDirs :: forall a. Section a -> [[Char]]
sectionExtraLibraries :: forall a. Section a -> [[Char]]
sectionExtraLibDirs :: forall a. Section a -> [[Char]]
sectionJsSources :: forall a. Section a -> [Path]
sectionCxxSources :: forall a. Section a -> [Path]
sectionCxxOptions :: forall a. Section a -> [[Char]]
sectionCSources :: forall a. Section a -> [Path]
sectionCcOptions :: forall a. Section a -> [[Char]]
sectionAsmSources :: forall a. Section a -> [Path]
sectionAsmOptions :: forall a. Section a -> [[Char]]
sectionCppOptions :: forall a. Section a -> [[Char]]
sectionGhcjsOptions :: forall a. Section a -> [[Char]]
sectionGhcSharedOptions :: forall a. Section a -> [[Char]]
sectionGhcProfOptions :: forall a. Section a -> [[Char]]
sectionGhcOptions :: forall a. Section a -> [[Char]]
sectionLanguage :: forall a. Section a -> Maybe Language
sectionOtherExtensions :: forall a. Section a -> [[Char]]
sectionDefaultExtensions :: forall a. Section a -> [[Char]]
sectionPkgConfigDependencies :: forall a. Section a -> [[Char]]
sectionDependencies :: forall a. Section a -> Dependencies
sectionSourceDirs :: forall a. Section a -> [[Char]]
sectionData :: forall a. Section a -> a
..} = Section a
sect {sectionDependencies = (Dependencies . Map.fromList . map rename . Map.toList . unDependencies) sectionDependencies, sectionConditionals = map renameConditional sectionConditionals}
  where
    rename :: ([Char], b) -> ([Char], b)
rename dep :: ([Char], b)
dep@([Char]
name, b
version)
      | [Char]
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
old = ([Char]
new, b
version)
      | Bool
otherwise = ([Char], b)
dep

    renameConditional :: Conditional (Section a) -> Conditional (Section a)
    renameConditional :: forall a. Conditional (Section a) -> Conditional (Section a)
renameConditional (Conditional Cond
condition Section a
then_ Maybe (Section a)
else_) = Cond -> Section a -> Maybe (Section a) -> Conditional (Section a)
forall a. Cond -> a -> Maybe a -> Conditional a
Conditional Cond
condition ([Char] -> [Char] -> Section a -> Section a
forall a. [Char] -> [Char] -> Section a -> Section a
renameDependencies [Char]
old [Char]
new Section a
then_) ([Char] -> [Char] -> Section a -> Section a
forall a. [Char] -> [Char] -> Section a -> Section a
renameDependencies [Char]
old [Char]
new (Section a -> Section a) -> Maybe (Section a) -> Maybe (Section a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Section a)
else_)

packageDependencies :: Package -> [(String, DependencyInfo)]
packageDependencies :: Package -> [([Char], DependencyInfo)]
packageDependencies Package{[Char]
[[Char]]
[Path]
[Flag]
[Verbatim]
Maybe [Char]
Maybe SourceRepository
Maybe (Section Library)
Maybe CustomSetup
Map [Char] (Section Executable)
Map [Char] (Section Library)
BuildType
packageName :: Package -> [Char]
packageVersion :: Package -> [Char]
packageSynopsis :: Package -> Maybe [Char]
packageDescription :: Package -> Maybe [Char]
packageHomepage :: Package -> Maybe [Char]
packageBugReports :: Package -> Maybe [Char]
packageCategory :: Package -> Maybe [Char]
packageStability :: Package -> Maybe [Char]
packageAuthor :: Package -> [[Char]]
packageMaintainer :: Package -> [[Char]]
packageCopyright :: Package -> [[Char]]
packageBuildType :: Package -> BuildType
packageLicense :: Package -> Maybe [Char]
packageLicenseFile :: Package -> [[Char]]
packageTestedWith :: Package -> [[Char]]
packageFlags :: Package -> [Flag]
packageExtraSourceFiles :: Package -> [Path]
packageExtraDocFiles :: Package -> [Path]
packageDataFiles :: Package -> [Path]
packageDataDir :: Package -> Maybe [Char]
packageSourceRepository :: Package -> Maybe SourceRepository
packageCustomSetup :: Package -> Maybe CustomSetup
packageLibrary :: Package -> Maybe (Section Library)
packageInternalLibraries :: Package -> Map [Char] (Section Library)
packageExecutables :: Package -> Map [Char] (Section Executable)
packageTests :: Package -> Map [Char] (Section Executable)
packageBenchmarks :: Package -> Map [Char] (Section Executable)
packageVerbatim :: Package -> [Verbatim]
packageName :: [Char]
packageVersion :: [Char]
packageSynopsis :: Maybe [Char]
packageDescription :: Maybe [Char]
packageHomepage :: Maybe [Char]
packageBugReports :: Maybe [Char]
packageCategory :: Maybe [Char]
packageStability :: Maybe [Char]
packageAuthor :: [[Char]]
packageMaintainer :: [[Char]]
packageCopyright :: [[Char]]
packageBuildType :: BuildType
packageLicense :: Maybe [Char]
packageLicenseFile :: [[Char]]
packageTestedWith :: [[Char]]
packageFlags :: [Flag]
packageExtraSourceFiles :: [Path]
packageExtraDocFiles :: [Path]
packageDataFiles :: [Path]
packageDataDir :: Maybe [Char]
packageSourceRepository :: Maybe SourceRepository
packageCustomSetup :: Maybe CustomSetup
packageLibrary :: Maybe (Section Library)
packageInternalLibraries :: Map [Char] (Section Library)
packageExecutables :: Map [Char] (Section Executable)
packageTests :: Map [Char] (Section Executable)
packageBenchmarks :: Map [Char] (Section Executable)
packageVerbatim :: [Verbatim]
..} = [([Char], DependencyInfo)] -> [([Char], DependencyInfo)]
forall a. Ord a => [a] -> [a]
nub ([([Char], DependencyInfo)] -> [([Char], DependencyInfo)])
-> ([([Char], DependencyInfo)] -> [([Char], DependencyInfo)])
-> [([Char], DependencyInfo)]
-> [([Char], DependencyInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], DependencyInfo) -> ([Char], DependencyInfo) -> Ordering)
-> [([Char], DependencyInfo)] -> [([Char], DependencyInfo)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((([Char], DependencyInfo) -> ([Char], [Char]))
-> ([Char], DependencyInfo) -> ([Char], DependencyInfo) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ([Char] -> ([Char], [Char])
lexicographically ([Char] -> ([Char], [Char]))
-> (([Char], DependencyInfo) -> [Char])
-> ([Char], DependencyInfo)
-> ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], DependencyInfo) -> [Char]
forall a b. (a, b) -> a
fst)) ([([Char], DependencyInfo)] -> [([Char], DependencyInfo)])
-> [([Char], DependencyInfo)] -> [([Char], DependencyInfo)]
forall a b. (a -> b) -> a -> b
$
     ((Section Executable -> [([Char], DependencyInfo)])
-> Map [Char] (Section Executable) -> [([Char], DependencyInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section Executable -> [([Char], DependencyInfo)]
forall {a}. Section a -> [([Char], DependencyInfo)]
deps Map [Char] (Section Executable)
packageExecutables)
  [([Char], DependencyInfo)]
-> [([Char], DependencyInfo)] -> [([Char], DependencyInfo)]
forall a. [a] -> [a] -> [a]
++ ((Section Executable -> [([Char], DependencyInfo)])
-> Map [Char] (Section Executable) -> [([Char], DependencyInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section Executable -> [([Char], DependencyInfo)]
forall {a}. Section a -> [([Char], DependencyInfo)]
deps Map [Char] (Section Executable)
packageTests)
  [([Char], DependencyInfo)]
-> [([Char], DependencyInfo)] -> [([Char], DependencyInfo)]
forall a. [a] -> [a] -> [a]
++ ((Section Executable -> [([Char], DependencyInfo)])
-> Map [Char] (Section Executable) -> [([Char], DependencyInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section Executable -> [([Char], DependencyInfo)]
forall {a}. Section a -> [([Char], DependencyInfo)]
deps Map [Char] (Section Executable)
packageBenchmarks)
  [([Char], DependencyInfo)]
-> [([Char], DependencyInfo)] -> [([Char], DependencyInfo)]
forall a. [a] -> [a] -> [a]
++ [([Char], DependencyInfo)]
-> (Section Library -> [([Char], DependencyInfo)])
-> Maybe (Section Library)
-> [([Char], DependencyInfo)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Section Library -> [([Char], DependencyInfo)]
forall {a}. Section a -> [([Char], DependencyInfo)]
deps Maybe (Section Library)
packageLibrary
  where
    deps :: Section a -> [([Char], DependencyInfo)]
deps Section a
xs = [([Char]
name, DependencyInfo
info) | ([Char]
name, DependencyInfo
info) <- (Map [Char] DependencyInfo -> [([Char], DependencyInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map [Char] DependencyInfo -> [([Char], DependencyInfo)])
-> (Section a -> Map [Char] DependencyInfo)
-> Section a
-> [([Char], DependencyInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> Map [Char] DependencyInfo
unDependencies (Dependencies -> Map [Char] DependencyInfo)
-> (Section a -> Dependencies)
-> Section a
-> Map [Char] DependencyInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section a -> Dependencies
forall a. Section a -> Dependencies
sectionDependencies) Section a
xs]

section :: a -> Section a
section :: forall a. a -> Section a
section a
a = a
-> [[Char]]
-> Dependencies
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> Maybe Language
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [Path]
-> [[Char]]
-> [Path]
-> [[Char]]
-> [Path]
-> [Path]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> Maybe Bool
-> [Conditional (Section a)]
-> Map BuildTool DependencyVersion
-> SystemBuildTools
-> [Verbatim]
-> Section a
forall a.
a
-> [[Char]]
-> Dependencies
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> Maybe Language
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [Path]
-> [[Char]]
-> [Path]
-> [[Char]]
-> [Path]
-> [Path]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> Maybe Bool
-> [Conditional (Section a)]
-> Map BuildTool DependencyVersion
-> SystemBuildTools
-> [Verbatim]
-> Section a
Section a
a [] Dependencies
forall a. Monoid a => a
mempty [] [] [] Maybe Language
forall a. Maybe a
Nothing [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] Maybe Bool
forall a. Maybe a
Nothing [] Map BuildTool DependencyVersion
forall a. Monoid a => a
mempty SystemBuildTools
forall a. Monoid a => a
mempty []

packageConfig :: FilePath
packageConfig :: [Char]
packageConfig = [Char]
"package.yaml"

data CustomSetupSection = CustomSetupSection {
  CustomSetupSection -> Maybe Dependencies
customSetupSectionDependencies :: Maybe Dependencies
} deriving (CustomSetupSection -> CustomSetupSection -> Bool
(CustomSetupSection -> CustomSetupSection -> Bool)
-> (CustomSetupSection -> CustomSetupSection -> Bool)
-> Eq CustomSetupSection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomSetupSection -> CustomSetupSection -> Bool
== :: CustomSetupSection -> CustomSetupSection -> Bool
$c/= :: CustomSetupSection -> CustomSetupSection -> Bool
/= :: CustomSetupSection -> CustomSetupSection -> Bool
Eq, Int -> CustomSetupSection -> ShowS
[CustomSetupSection] -> ShowS
CustomSetupSection -> [Char]
(Int -> CustomSetupSection -> ShowS)
-> (CustomSetupSection -> [Char])
-> ([CustomSetupSection] -> ShowS)
-> Show CustomSetupSection
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomSetupSection -> ShowS
showsPrec :: Int -> CustomSetupSection -> ShowS
$cshow :: CustomSetupSection -> [Char]
show :: CustomSetupSection -> [Char]
$cshowList :: [CustomSetupSection] -> ShowS
showList :: [CustomSetupSection] -> ShowS
Show, (forall x. CustomSetupSection -> Rep CustomSetupSection x)
-> (forall x. Rep CustomSetupSection x -> CustomSetupSection)
-> Generic CustomSetupSection
forall x. Rep CustomSetupSection x -> CustomSetupSection
forall x. CustomSetupSection -> Rep CustomSetupSection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CustomSetupSection -> Rep CustomSetupSection x
from :: forall x. CustomSetupSection -> Rep CustomSetupSection x
$cto :: forall x. Rep CustomSetupSection x -> CustomSetupSection
to :: forall x. Rep CustomSetupSection x -> CustomSetupSection
Generic, Value -> Parser CustomSetupSection
(Value -> Parser CustomSetupSection)
-> FromValue CustomSetupSection
forall a. (Value -> Parser a) -> FromValue a
$cfromValue :: Value -> Parser CustomSetupSection
fromValue :: Value -> Parser CustomSetupSection
FromValue)

data LibrarySection = LibrarySection {
  LibrarySection -> Maybe Bool
librarySectionExposed :: Maybe Bool
, LibrarySection -> Maybe [Char]
librarySectionVisibility :: Maybe String
, LibrarySection -> Maybe (List Module)
librarySectionExposedModules :: Maybe (List Module)
, LibrarySection -> Maybe (List Module)
librarySectionGeneratedExposedModules :: Maybe (List Module)
, LibrarySection -> Maybe (List Module)
librarySectionOtherModules :: Maybe (List Module)
, LibrarySection -> Maybe (List Module)
librarySectionGeneratedOtherModules :: Maybe (List Module)
, LibrarySection -> ParseAsmSources
librarySectionReexportedModules :: Maybe (List String)
, LibrarySection -> ParseAsmSources
librarySectionSignatures :: Maybe (List String)
} deriving (LibrarySection -> LibrarySection -> Bool
(LibrarySection -> LibrarySection -> Bool)
-> (LibrarySection -> LibrarySection -> Bool) -> Eq LibrarySection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LibrarySection -> LibrarySection -> Bool
== :: LibrarySection -> LibrarySection -> Bool
$c/= :: LibrarySection -> LibrarySection -> Bool
/= :: LibrarySection -> LibrarySection -> Bool
Eq, Int -> LibrarySection -> ShowS
[LibrarySection] -> ShowS
LibrarySection -> [Char]
(Int -> LibrarySection -> ShowS)
-> (LibrarySection -> [Char])
-> ([LibrarySection] -> ShowS)
-> Show LibrarySection
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LibrarySection -> ShowS
showsPrec :: Int -> LibrarySection -> ShowS
$cshow :: LibrarySection -> [Char]
show :: LibrarySection -> [Char]
$cshowList :: [LibrarySection] -> ShowS
showList :: [LibrarySection] -> ShowS
Show, (forall x. LibrarySection -> Rep LibrarySection x)
-> (forall x. Rep LibrarySection x -> LibrarySection)
-> Generic LibrarySection
forall x. Rep LibrarySection x -> LibrarySection
forall x. LibrarySection -> Rep LibrarySection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LibrarySection -> Rep LibrarySection x
from :: forall x. LibrarySection -> Rep LibrarySection x
$cto :: forall x. Rep LibrarySection x -> LibrarySection
to :: forall x. Rep LibrarySection x -> LibrarySection
Generic, Value -> Parser LibrarySection
(Value -> Parser LibrarySection) -> FromValue LibrarySection
forall a. (Value -> Parser a) -> FromValue a
$cfromValue :: Value -> Parser LibrarySection
fromValue :: Value -> Parser LibrarySection
FromValue)

instance Monoid LibrarySection where
  mempty :: LibrarySection
mempty = Maybe Bool
-> Maybe [Char]
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List Module)
-> ParseAsmSources
-> ParseAsmSources
-> LibrarySection
LibrarySection Maybe Bool
forall a. Maybe a
Nothing Maybe [Char]
forall a. Maybe a
Nothing Maybe (List Module)
forall a. Maybe a
Nothing Maybe (List Module)
forall a. Maybe a
Nothing Maybe (List Module)
forall a. Maybe a
Nothing Maybe (List Module)
forall a. Maybe a
Nothing ParseAsmSources
forall a. Maybe a
Nothing ParseAsmSources
forall a. Maybe a
Nothing
  mappend :: LibrarySection -> LibrarySection -> LibrarySection
mappend = LibrarySection -> LibrarySection -> LibrarySection
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup LibrarySection where
  LibrarySection
a <> :: LibrarySection -> LibrarySection -> LibrarySection
<> LibrarySection
b = LibrarySection {
      librarySectionExposed :: Maybe Bool
librarySectionExposed = LibrarySection -> Maybe Bool
librarySectionExposed LibrarySection
b Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LibrarySection -> Maybe Bool
librarySectionExposed LibrarySection
a
    , librarySectionVisibility :: Maybe [Char]
librarySectionVisibility = LibrarySection -> Maybe [Char]
librarySectionVisibility LibrarySection
b Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LibrarySection -> Maybe [Char]
librarySectionVisibility LibrarySection
a
    , librarySectionExposedModules :: Maybe (List Module)
librarySectionExposedModules = LibrarySection -> Maybe (List Module)
librarySectionExposedModules LibrarySection
a Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> LibrarySection -> Maybe (List Module)
librarySectionExposedModules LibrarySection
b
    , librarySectionGeneratedExposedModules :: Maybe (List Module)
librarySectionGeneratedExposedModules = LibrarySection -> Maybe (List Module)
librarySectionGeneratedExposedModules LibrarySection
a Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> LibrarySection -> Maybe (List Module)
librarySectionGeneratedExposedModules LibrarySection
b
    , librarySectionOtherModules :: Maybe (List Module)
librarySectionOtherModules = LibrarySection -> Maybe (List Module)
librarySectionOtherModules LibrarySection
a Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> LibrarySection -> Maybe (List Module)
librarySectionOtherModules LibrarySection
b
    , librarySectionGeneratedOtherModules :: Maybe (List Module)
librarySectionGeneratedOtherModules = LibrarySection -> Maybe (List Module)
librarySectionGeneratedOtherModules LibrarySection
a Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> LibrarySection -> Maybe (List Module)
librarySectionGeneratedOtherModules LibrarySection
b
    , librarySectionReexportedModules :: ParseAsmSources
librarySectionReexportedModules = LibrarySection -> ParseAsmSources
librarySectionReexportedModules LibrarySection
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> LibrarySection -> ParseAsmSources
librarySectionReexportedModules LibrarySection
b
    , librarySectionSignatures :: ParseAsmSources
librarySectionSignatures = LibrarySection -> ParseAsmSources
librarySectionSignatures LibrarySection
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> LibrarySection -> ParseAsmSources
librarySectionSignatures LibrarySection
b
    }

data ExecutableSection = ExecutableSection {
  ExecutableSection -> Alias 'True "main-is" (Last [Char])
executableSectionMain :: Alias 'True "main-is" (Last FilePath)
, ExecutableSection -> Maybe (List Module)
executableSectionOtherModules :: Maybe (List Module)
, ExecutableSection -> Maybe (List Module)
executableSectionGeneratedOtherModules :: Maybe (List Module)
} deriving (ExecutableSection -> ExecutableSection -> Bool
(ExecutableSection -> ExecutableSection -> Bool)
-> (ExecutableSection -> ExecutableSection -> Bool)
-> Eq ExecutableSection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExecutableSection -> ExecutableSection -> Bool
== :: ExecutableSection -> ExecutableSection -> Bool
$c/= :: ExecutableSection -> ExecutableSection -> Bool
/= :: ExecutableSection -> ExecutableSection -> Bool
Eq, Int -> ExecutableSection -> ShowS
[ExecutableSection] -> ShowS
ExecutableSection -> [Char]
(Int -> ExecutableSection -> ShowS)
-> (ExecutableSection -> [Char])
-> ([ExecutableSection] -> ShowS)
-> Show ExecutableSection
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecutableSection -> ShowS
showsPrec :: Int -> ExecutableSection -> ShowS
$cshow :: ExecutableSection -> [Char]
show :: ExecutableSection -> [Char]
$cshowList :: [ExecutableSection] -> ShowS
showList :: [ExecutableSection] -> ShowS
Show, (forall x. ExecutableSection -> Rep ExecutableSection x)
-> (forall x. Rep ExecutableSection x -> ExecutableSection)
-> Generic ExecutableSection
forall x. Rep ExecutableSection x -> ExecutableSection
forall x. ExecutableSection -> Rep ExecutableSection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExecutableSection -> Rep ExecutableSection x
from :: forall x. ExecutableSection -> Rep ExecutableSection x
$cto :: forall x. Rep ExecutableSection x -> ExecutableSection
to :: forall x. Rep ExecutableSection x -> ExecutableSection
Generic, Value -> Parser ExecutableSection
(Value -> Parser ExecutableSection) -> FromValue ExecutableSection
forall a. (Value -> Parser a) -> FromValue a
$cfromValue :: Value -> Parser ExecutableSection
fromValue :: Value -> Parser ExecutableSection
FromValue)

instance Monoid ExecutableSection where
  mempty :: ExecutableSection
mempty = Alias 'True "main-is" (Last [Char])
-> Maybe (List Module) -> Maybe (List Module) -> ExecutableSection
ExecutableSection Alias 'True "main-is" (Last [Char])
forall a. Monoid a => a
mempty Maybe (List Module)
forall a. Maybe a
Nothing Maybe (List Module)
forall a. Maybe a
Nothing
  mappend :: ExecutableSection -> ExecutableSection -> ExecutableSection
mappend = ExecutableSection -> ExecutableSection -> ExecutableSection
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup ExecutableSection where
  ExecutableSection
a <> :: ExecutableSection -> ExecutableSection -> ExecutableSection
<> ExecutableSection
b = ExecutableSection {
      executableSectionMain :: Alias 'True "main-is" (Last [Char])
executableSectionMain = ExecutableSection -> Alias 'True "main-is" (Last [Char])
executableSectionMain ExecutableSection
a Alias 'True "main-is" (Last [Char])
-> Alias 'True "main-is" (Last [Char])
-> Alias 'True "main-is" (Last [Char])
forall a. Semigroup a => a -> a -> a
<> ExecutableSection -> Alias 'True "main-is" (Last [Char])
executableSectionMain ExecutableSection
b
    , executableSectionOtherModules :: Maybe (List Module)
executableSectionOtherModules = ExecutableSection -> Maybe (List Module)
executableSectionOtherModules ExecutableSection
a Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> ExecutableSection -> Maybe (List Module)
executableSectionOtherModules ExecutableSection
b
    , executableSectionGeneratedOtherModules :: Maybe (List Module)
executableSectionGeneratedOtherModules = ExecutableSection -> Maybe (List Module)
executableSectionGeneratedOtherModules ExecutableSection
a Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> ExecutableSection -> Maybe (List Module)
executableSectionGeneratedOtherModules ExecutableSection
b
    }

data VerbatimValue =
    VerbatimString String
  | VerbatimNumber Scientific
  | VerbatimBool Bool
  | VerbatimNull
  deriving (VerbatimValue -> VerbatimValue -> Bool
(VerbatimValue -> VerbatimValue -> Bool)
-> (VerbatimValue -> VerbatimValue -> Bool) -> Eq VerbatimValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerbatimValue -> VerbatimValue -> Bool
== :: VerbatimValue -> VerbatimValue -> Bool
$c/= :: VerbatimValue -> VerbatimValue -> Bool
/= :: VerbatimValue -> VerbatimValue -> Bool
Eq, Int -> VerbatimValue -> ShowS
[VerbatimValue] -> ShowS
VerbatimValue -> [Char]
(Int -> VerbatimValue -> ShowS)
-> (VerbatimValue -> [Char])
-> ([VerbatimValue] -> ShowS)
-> Show VerbatimValue
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerbatimValue -> ShowS
showsPrec :: Int -> VerbatimValue -> ShowS
$cshow :: VerbatimValue -> [Char]
show :: VerbatimValue -> [Char]
$cshowList :: [VerbatimValue] -> ShowS
showList :: [VerbatimValue] -> ShowS
Show)

instance FromValue VerbatimValue where
  fromValue :: Value -> Parser VerbatimValue
fromValue Value
v = case Value
v of
    String Text
s -> VerbatimValue -> Parser VerbatimValue
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> VerbatimValue
VerbatimString ([Char] -> VerbatimValue) -> [Char] -> VerbatimValue
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
s)
    Number Scientific
n -> VerbatimValue -> Parser VerbatimValue
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Scientific -> VerbatimValue
VerbatimNumber Scientific
n)
    Bool Bool
b -> VerbatimValue -> Parser VerbatimValue
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> VerbatimValue
VerbatimBool Bool
b)
    Value
Null -> VerbatimValue -> Parser VerbatimValue
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return VerbatimValue
VerbatimNull
    Object Object
_ -> Parser VerbatimValue
forall {a}. Parser a
err
    Array Array
_ -> Parser VerbatimValue
forall {a}. Parser a
err
    where
      err :: Parser a
err = [Char] -> Value -> Parser a
forall a. [Char] -> Value -> Parser a
typeMismatch ([[Char]] -> [Char]
formatOrList [[Char]
"String", [Char]
"Number", [Char]
"Bool", [Char]
"Null"]) Value
v

data Verbatim = VerbatimLiteral String | VerbatimObject (Map String VerbatimValue)
  deriving (Verbatim -> Verbatim -> Bool
(Verbatim -> Verbatim -> Bool)
-> (Verbatim -> Verbatim -> Bool) -> Eq Verbatim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Verbatim -> Verbatim -> Bool
== :: Verbatim -> Verbatim -> Bool
$c/= :: Verbatim -> Verbatim -> Bool
/= :: Verbatim -> Verbatim -> Bool
Eq, Int -> Verbatim -> ShowS
[Verbatim] -> ShowS
Verbatim -> [Char]
(Int -> Verbatim -> ShowS)
-> (Verbatim -> [Char]) -> ([Verbatim] -> ShowS) -> Show Verbatim
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Verbatim -> ShowS
showsPrec :: Int -> Verbatim -> ShowS
$cshow :: Verbatim -> [Char]
show :: Verbatim -> [Char]
$cshowList :: [Verbatim] -> ShowS
showList :: [Verbatim] -> ShowS
Show)

instance FromValue Verbatim where
  fromValue :: Value -> Parser Verbatim
fromValue Value
v = case Value
v of
    String Text
s -> Verbatim -> Parser Verbatim
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Verbatim
VerbatimLiteral ([Char] -> Verbatim) -> [Char] -> Verbatim
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
s)
    Object Object
_ -> Map [Char] VerbatimValue -> Verbatim
VerbatimObject (Map [Char] VerbatimValue -> Verbatim)
-> Parser (Map [Char] VerbatimValue) -> Parser Verbatim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Map [Char] VerbatimValue)
forall a. FromValue a => Value -> Parser a
fromValue Value
v
    Value
_ -> [Char] -> Value -> Parser Verbatim
forall a. [Char] -> Value -> Parser a
typeMismatch ([[Char]] -> [Char]
formatOrList [[Char]
"String", [Char]
"Object"]) Value
v

data CommonOptions asmSources cSources cxxSources jsSources a = CommonOptions {
  forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "hs-source-dirs" ParseAsmSources
commonOptionsSourceDirs :: Alias 'True "hs-source-dirs" (Maybe (List FilePath))
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsDependencies :: Alias 'True "build-depends" (Maybe Dependencies)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'False "pkgconfig-depends" ParseAsmSources
commonOptionsPkgConfigDependencies :: Alias 'False "pkgconfig-depends" (Maybe (List String))
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsDefaultExtensions :: Maybe (List String)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsOtherExtensions :: Maybe (List String)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "default-language" (Last (Maybe Language))
commonOptionsLanguage :: Alias 'True "default-language" (Last (Maybe Language))
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcOptions :: Maybe (List GhcOption)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcProfOptions :: Maybe (List GhcProfOption)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcSharedOptions :: Maybe (List GhcOption)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcjsOptions :: Maybe (List GhcjsOption)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsCppOptions :: Maybe (List CppOption)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsCcOptions :: Maybe (List CcOption)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsAsmOptions :: Maybe (List AsmOption)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> asmSources
commonOptionsAsmSources :: asmSources
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> cSources
commonOptionsCSources :: cSources
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsCxxOptions :: Maybe (List CxxOption)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> cxxSources
commonOptionsCxxSources :: cxxSources
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> jsSources
commonOptionsJsSources :: jsSources
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsExtraLibDirs :: Maybe (List FilePath)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsExtraLibraries :: Maybe (List FilePath)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsExtraFrameworksDirs :: Maybe (List FilePath)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsFrameworks :: Maybe (List String)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsIncludeDirs :: Maybe (List FilePath)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsInstallIncludes :: Maybe (List FilePath)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsLdOptions :: Maybe (List LdOption)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Last Bool
commonOptionsBuildable :: Last Bool
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe
     (List
        (ConditionalSection asmSources cSources cxxSources jsSources a))
commonOptionsWhen :: Maybe (List (ConditionalSection asmSources cSources cxxSources jsSources a))
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsBuildTools :: Alias 'True "build-tool-depends" (Maybe BuildTools)
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe SystemBuildTools
commonOptionsSystemBuildTools :: Maybe SystemBuildTools
, forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe (List Verbatim)
commonOptionsVerbatim :: Maybe (List Verbatim)
} deriving ((forall a b.
 (a -> b)
 -> CommonOptions asmSources cSources cxxSources jsSources a
 -> CommonOptions asmSources cSources cxxSources jsSources b)
-> (forall a b.
    a
    -> CommonOptions asmSources cSources cxxSources jsSources b
    -> CommonOptions asmSources cSources cxxSources jsSources a)
-> Functor (CommonOptions asmSources cSources cxxSources jsSources)
forall a b.
a
-> CommonOptions asmSources cSources cxxSources jsSources b
-> CommonOptions asmSources cSources cxxSources jsSources a
forall a b.
(a -> b)
-> CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources b
forall asmSources cSources cxxSources jsSources a b.
a
-> CommonOptions asmSources cSources cxxSources jsSources b
-> CommonOptions asmSources cSources cxxSources jsSources a
forall asmSources cSources cxxSources jsSources a b.
(a -> b)
-> CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall asmSources cSources cxxSources jsSources a b.
(a -> b)
-> CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources b
fmap :: forall a b.
(a -> b)
-> CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources b
$c<$ :: forall asmSources cSources cxxSources jsSources a b.
a
-> CommonOptions asmSources cSources cxxSources jsSources b
-> CommonOptions asmSources cSources cxxSources jsSources a
<$ :: forall a b.
a
-> CommonOptions asmSources cSources cxxSources jsSources b
-> CommonOptions asmSources cSources cxxSources jsSources a
Functor, (forall x.
 CommonOptions asmSources cSources cxxSources jsSources a
 -> Rep
      (CommonOptions asmSources cSources cxxSources jsSources a) x)
-> (forall x.
    Rep (CommonOptions asmSources cSources cxxSources jsSources a) x
    -> CommonOptions asmSources cSources cxxSources jsSources a)
-> Generic
     (CommonOptions asmSources cSources cxxSources jsSources a)
forall x.
Rep (CommonOptions asmSources cSources cxxSources jsSources a) x
-> CommonOptions asmSources cSources cxxSources jsSources a
forall x.
CommonOptions asmSources cSources cxxSources jsSources a
-> Rep (CommonOptions asmSources cSources cxxSources jsSources a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall asmSources cSources cxxSources jsSources a x.
Rep (CommonOptions asmSources cSources cxxSources jsSources a) x
-> CommonOptions asmSources cSources cxxSources jsSources a
forall asmSources cSources cxxSources jsSources a x.
CommonOptions asmSources cSources cxxSources jsSources a
-> Rep (CommonOptions asmSources cSources cxxSources jsSources a) x
$cfrom :: forall asmSources cSources cxxSources jsSources a x.
CommonOptions asmSources cSources cxxSources jsSources a
-> Rep (CommonOptions asmSources cSources cxxSources jsSources a) x
from :: forall x.
CommonOptions asmSources cSources cxxSources jsSources a
-> Rep (CommonOptions asmSources cSources cxxSources jsSources a) x
$cto :: forall asmSources cSources cxxSources jsSources a x.
Rep (CommonOptions asmSources cSources cxxSources jsSources a) x
-> CommonOptions asmSources cSources cxxSources jsSources a
to :: forall x.
Rep (CommonOptions asmSources cSources cxxSources jsSources a) x
-> CommonOptions asmSources cSources cxxSources jsSources a
Generic)

type ParseCommonOptions = CommonOptions ParseAsmSources ParseCSources ParseCxxSources ParseJsSources
instance FromValue a => FromValue (ParseCommonOptions a)

instance (Semigroup asmSources, Semigroup cSources, Semigroup cxxSources, Semigroup jsSources, Monoid asmSources, Monoid cSources, Monoid cxxSources, Monoid jsSources) => Monoid (CommonOptions asmSources cSources cxxSources jsSources a) where
  mempty :: CommonOptions asmSources cSources cxxSources jsSources a
mempty = CommonOptions {
    commonOptionsSourceDirs :: Alias 'True "hs-source-dirs" ParseAsmSources
commonOptionsSourceDirs = ParseAsmSources -> Alias 'True "hs-source-dirs" ParseAsmSources
forall (deprecated :: Bool) (alias :: Symbol) a.
a -> Alias deprecated alias a
Alias ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsDependencies :: Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsDependencies = Maybe Dependencies
-> Alias 'True "build-depends" (Maybe Dependencies)
forall (deprecated :: Bool) (alias :: Symbol) a.
a -> Alias deprecated alias a
Alias Maybe Dependencies
forall a. Maybe a
Nothing
  , commonOptionsPkgConfigDependencies :: Alias 'False "pkgconfig-depends" ParseAsmSources
commonOptionsPkgConfigDependencies = ParseAsmSources -> Alias 'False "pkgconfig-depends" ParseAsmSources
forall (deprecated :: Bool) (alias :: Symbol) a.
a -> Alias deprecated alias a
Alias ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsDefaultExtensions :: ParseAsmSources
commonOptionsDefaultExtensions = ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsOtherExtensions :: ParseAsmSources
commonOptionsOtherExtensions = ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsLanguage :: Alias 'True "default-language" (Last (Maybe Language))
commonOptionsLanguage = Alias 'True "default-language" (Last (Maybe Language))
forall a. Monoid a => a
mempty
  , commonOptionsGhcOptions :: ParseAsmSources
commonOptionsGhcOptions = ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsGhcProfOptions :: ParseAsmSources
commonOptionsGhcProfOptions = ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsGhcSharedOptions :: ParseAsmSources
commonOptionsGhcSharedOptions = ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsGhcjsOptions :: ParseAsmSources
commonOptionsGhcjsOptions = ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsCppOptions :: ParseAsmSources
commonOptionsCppOptions = ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsAsmOptions :: ParseAsmSources
commonOptionsAsmOptions = ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsAsmSources :: asmSources
commonOptionsAsmSources = asmSources
forall a. Monoid a => a
mempty
  , commonOptionsCcOptions :: ParseAsmSources
commonOptionsCcOptions = ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsCSources :: cSources
commonOptionsCSources = cSources
forall a. Monoid a => a
mempty
  , commonOptionsCxxOptions :: ParseAsmSources
commonOptionsCxxOptions = ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsCxxSources :: cxxSources
commonOptionsCxxSources = cxxSources
forall a. Monoid a => a
mempty
  , commonOptionsJsSources :: jsSources
commonOptionsJsSources = jsSources
forall a. Monoid a => a
mempty
  , commonOptionsExtraLibDirs :: ParseAsmSources
commonOptionsExtraLibDirs = ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsExtraLibraries :: ParseAsmSources
commonOptionsExtraLibraries = ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsExtraFrameworksDirs :: ParseAsmSources
commonOptionsExtraFrameworksDirs = ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsFrameworks :: ParseAsmSources
commonOptionsFrameworks = ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsIncludeDirs :: ParseAsmSources
commonOptionsIncludeDirs = ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsInstallIncludes :: ParseAsmSources
commonOptionsInstallIncludes = ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsLdOptions :: ParseAsmSources
commonOptionsLdOptions = ParseAsmSources
forall a. Maybe a
Nothing
  , commonOptionsBuildable :: Last Bool
commonOptionsBuildable = Last Bool
forall a. Monoid a => a
mempty
  , commonOptionsWhen :: Maybe
  (List
     (ConditionalSection asmSources cSources cxxSources jsSources a))
commonOptionsWhen = Maybe
  (List
     (ConditionalSection asmSources cSources cxxSources jsSources a))
forall a. Maybe a
Nothing
  , commonOptionsBuildTools :: Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsBuildTools = Maybe BuildTools
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
forall (deprecated :: Bool) (alias :: Symbol) a.
a -> Alias deprecated alias a
Alias Maybe BuildTools
forall a. Maybe a
Nothing
  , commonOptionsSystemBuildTools :: Maybe SystemBuildTools
commonOptionsSystemBuildTools = Maybe SystemBuildTools
forall a. Maybe a
Nothing
  , commonOptionsVerbatim :: Maybe (List Verbatim)
commonOptionsVerbatim = Maybe (List Verbatim)
forall a. Maybe a
Nothing
  }
  mappend :: CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources a
mappend = CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources a
forall a. Semigroup a => a -> a -> a
(<>)

instance (Semigroup asmSources, Semigroup cSources, Semigroup cxxSources, Semigroup jsSources) => Semigroup (CommonOptions asmSources cSources cxxSources jsSources a) where
  CommonOptions asmSources cSources cxxSources jsSources a
a <> :: CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources a
<> CommonOptions asmSources cSources cxxSources jsSources a
b = CommonOptions {
    commonOptionsSourceDirs :: Alias 'True "hs-source-dirs" ParseAsmSources
commonOptionsSourceDirs = CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "hs-source-dirs" ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "hs-source-dirs" ParseAsmSources
commonOptionsSourceDirs CommonOptions asmSources cSources cxxSources jsSources a
a Alias 'True "hs-source-dirs" ParseAsmSources
-> Alias 'True "hs-source-dirs" ParseAsmSources
-> Alias 'True "hs-source-dirs" ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "hs-source-dirs" ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "hs-source-dirs" ParseAsmSources
commonOptionsSourceDirs CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsDependencies :: Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsDependencies = CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "build-depends" (Maybe Dependencies)
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsDependencies CommonOptions asmSources cSources cxxSources jsSources a
b Alias 'True "build-depends" (Maybe Dependencies)
-> Alias 'True "build-depends" (Maybe Dependencies)
-> Alias 'True "build-depends" (Maybe Dependencies)
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "build-depends" (Maybe Dependencies)
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsDependencies CommonOptions asmSources cSources cxxSources jsSources a
a
  , commonOptionsPkgConfigDependencies :: Alias 'False "pkgconfig-depends" ParseAsmSources
commonOptionsPkgConfigDependencies = CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'False "pkgconfig-depends" ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'False "pkgconfig-depends" ParseAsmSources
commonOptionsPkgConfigDependencies CommonOptions asmSources cSources cxxSources jsSources a
a Alias 'False "pkgconfig-depends" ParseAsmSources
-> Alias 'False "pkgconfig-depends" ParseAsmSources
-> Alias 'False "pkgconfig-depends" ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'False "pkgconfig-depends" ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'False "pkgconfig-depends" ParseAsmSources
commonOptionsPkgConfigDependencies CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsDefaultExtensions :: ParseAsmSources
commonOptionsDefaultExtensions = CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsDefaultExtensions CommonOptions asmSources cSources cxxSources jsSources a
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsDefaultExtensions CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsOtherExtensions :: ParseAsmSources
commonOptionsOtherExtensions = CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsOtherExtensions CommonOptions asmSources cSources cxxSources jsSources a
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsOtherExtensions CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsLanguage :: Alias 'True "default-language" (Last (Maybe Language))
commonOptionsLanguage = CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "default-language" (Last (Maybe Language))
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "default-language" (Last (Maybe Language))
commonOptionsLanguage CommonOptions asmSources cSources cxxSources jsSources a
a Alias 'True "default-language" (Last (Maybe Language))
-> Alias 'True "default-language" (Last (Maybe Language))
-> Alias 'True "default-language" (Last (Maybe Language))
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "default-language" (Last (Maybe Language))
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "default-language" (Last (Maybe Language))
commonOptionsLanguage CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsGhcOptions :: ParseAsmSources
commonOptionsGhcOptions = CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcOptions CommonOptions asmSources cSources cxxSources jsSources a
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcOptions CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsGhcProfOptions :: ParseAsmSources
commonOptionsGhcProfOptions = CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcProfOptions CommonOptions asmSources cSources cxxSources jsSources a
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcProfOptions CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsGhcSharedOptions :: ParseAsmSources
commonOptionsGhcSharedOptions = CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcSharedOptions CommonOptions asmSources cSources cxxSources jsSources a
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcSharedOptions CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsGhcjsOptions :: ParseAsmSources
commonOptionsGhcjsOptions = CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcjsOptions CommonOptions asmSources cSources cxxSources jsSources a
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcjsOptions CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsCppOptions :: ParseAsmSources
commonOptionsCppOptions = CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsCppOptions CommonOptions asmSources cSources cxxSources jsSources a
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsCppOptions CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsAsmOptions :: ParseAsmSources
commonOptionsAsmOptions = CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsAsmOptions CommonOptions asmSources cSources cxxSources jsSources a
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsAsmOptions CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsAsmSources :: asmSources
commonOptionsAsmSources = CommonOptions asmSources cSources cxxSources jsSources a
-> asmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> asmSources
commonOptionsAsmSources CommonOptions asmSources cSources cxxSources jsSources a
a asmSources -> asmSources -> asmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> asmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> asmSources
commonOptionsAsmSources CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsCcOptions :: ParseAsmSources
commonOptionsCcOptions = CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsCcOptions CommonOptions asmSources cSources cxxSources jsSources a
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsCcOptions CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsCSources :: cSources
commonOptionsCSources = CommonOptions asmSources cSources cxxSources jsSources a
-> cSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> cSources
commonOptionsCSources CommonOptions asmSources cSources cxxSources jsSources a
a cSources -> cSources -> cSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> cSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> cSources
commonOptionsCSources CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsCxxOptions :: ParseAsmSources
commonOptionsCxxOptions = CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsCxxOptions CommonOptions asmSources cSources cxxSources jsSources a
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsCxxOptions CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsCxxSources :: cxxSources
commonOptionsCxxSources = CommonOptions asmSources cSources cxxSources jsSources a
-> cxxSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> cxxSources
commonOptionsCxxSources CommonOptions asmSources cSources cxxSources jsSources a
a cxxSources -> cxxSources -> cxxSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> cxxSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> cxxSources
commonOptionsCxxSources CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsJsSources :: jsSources
commonOptionsJsSources = CommonOptions asmSources cSources cxxSources jsSources a
-> jsSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> jsSources
commonOptionsJsSources CommonOptions asmSources cSources cxxSources jsSources a
a jsSources -> jsSources -> jsSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> jsSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> jsSources
commonOptionsJsSources CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsExtraLibDirs :: ParseAsmSources
commonOptionsExtraLibDirs = CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsExtraLibDirs CommonOptions asmSources cSources cxxSources jsSources a
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsExtraLibDirs CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsExtraLibraries :: ParseAsmSources
commonOptionsExtraLibraries = CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsExtraLibraries CommonOptions asmSources cSources cxxSources jsSources a
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsExtraLibraries CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsExtraFrameworksDirs :: ParseAsmSources
commonOptionsExtraFrameworksDirs = CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsExtraFrameworksDirs CommonOptions asmSources cSources cxxSources jsSources a
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsExtraFrameworksDirs CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsFrameworks :: ParseAsmSources
commonOptionsFrameworks = CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsFrameworks CommonOptions asmSources cSources cxxSources jsSources a
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsFrameworks CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsIncludeDirs :: ParseAsmSources
commonOptionsIncludeDirs = CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsIncludeDirs CommonOptions asmSources cSources cxxSources jsSources a
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsIncludeDirs CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsInstallIncludes :: ParseAsmSources
commonOptionsInstallIncludes = CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsInstallIncludes CommonOptions asmSources cSources cxxSources jsSources a
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsInstallIncludes CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsLdOptions :: ParseAsmSources
commonOptionsLdOptions = CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsLdOptions CommonOptions asmSources cSources cxxSources jsSources a
a ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsLdOptions CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsBuildable :: Last Bool
commonOptionsBuildable = CommonOptions asmSources cSources cxxSources jsSources a
-> Last Bool
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Last Bool
commonOptionsBuildable CommonOptions asmSources cSources cxxSources jsSources a
a Last Bool -> Last Bool -> Last Bool
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> Last Bool
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Last Bool
commonOptionsBuildable CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsWhen :: Maybe
  (List
     (ConditionalSection asmSources cSources cxxSources jsSources a))
commonOptionsWhen = CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe
     (List
        (ConditionalSection asmSources cSources cxxSources jsSources a))
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe
     (List
        (ConditionalSection asmSources cSources cxxSources jsSources a))
commonOptionsWhen CommonOptions asmSources cSources cxxSources jsSources a
a Maybe
  (List
     (ConditionalSection asmSources cSources cxxSources jsSources a))
-> Maybe
     (List
        (ConditionalSection asmSources cSources cxxSources jsSources a))
-> Maybe
     (List
        (ConditionalSection asmSources cSources cxxSources jsSources a))
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe
     (List
        (ConditionalSection asmSources cSources cxxSources jsSources a))
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe
     (List
        (ConditionalSection asmSources cSources cxxSources jsSources a))
commonOptionsWhen CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsBuildTools :: Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsBuildTools = CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsBuildTools CommonOptions asmSources cSources cxxSources jsSources a
a Alias 'True "build-tool-depends" (Maybe BuildTools)
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsBuildTools CommonOptions asmSources cSources cxxSources jsSources a
b
  , commonOptionsSystemBuildTools :: Maybe SystemBuildTools
commonOptionsSystemBuildTools = CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe SystemBuildTools
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe SystemBuildTools
commonOptionsSystemBuildTools CommonOptions asmSources cSources cxxSources jsSources a
b Maybe SystemBuildTools
-> Maybe SystemBuildTools -> Maybe SystemBuildTools
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe SystemBuildTools
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe SystemBuildTools
commonOptionsSystemBuildTools CommonOptions asmSources cSources cxxSources jsSources a
a
  , commonOptionsVerbatim :: Maybe (List Verbatim)
commonOptionsVerbatim = CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe (List Verbatim)
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe (List Verbatim)
commonOptionsVerbatim CommonOptions asmSources cSources cxxSources jsSources a
a Maybe (List Verbatim)
-> Maybe (List Verbatim) -> Maybe (List Verbatim)
forall a. Semigroup a => a -> a -> a
<> CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe (List Verbatim)
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe (List Verbatim)
commonOptionsVerbatim CommonOptions asmSources cSources cxxSources jsSources a
b
  }

type ParseAsmSources = Maybe (List FilePath)
type ParseCSources = Maybe (List FilePath)
type ParseCxxSources = Maybe (List FilePath)
type ParseJsSources = Maybe (List FilePath)

type AsmSources = [Path]
type CSources = [Path]
type CxxSources = [Path]
type JsSources = [Path]

type WithCommonOptions asmSources cSources cxxSources jsSources a = Product (CommonOptions asmSources cSources cxxSources jsSources a) a

data Traverse m asmSources asmSources_ cSources cSources_ cxxSources cxxSources_ jsSources jsSources_ = Traverse {
  forall (m :: * -> *) asmSources asmSources_ cSources cSources_
       cxxSources cxxSources_ jsSources jsSources_.
Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> asmSources -> m asmSources_
traverseAsmSources :: asmSources -> m asmSources_
, forall (m :: * -> *) asmSources asmSources_ cSources cSources_
       cxxSources cxxSources_ jsSources jsSources_.
Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> cSources -> m cSources_
traverseCSources :: cSources -> m cSources_
, forall (m :: * -> *) asmSources asmSources_ cSources cSources_
       cxxSources cxxSources_ jsSources jsSources_.
Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> cxxSources -> m cxxSources_
traverseCxxSources :: cxxSources -> m cxxSources_
, forall (m :: * -> *) asmSources asmSources_ cSources cSources_
       cxxSources cxxSources_ jsSources jsSources_.
Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> jsSources -> m jsSources_
traverseJsSources :: jsSources -> m jsSources_
}

type Traversal t = forall m asmSources asmSources_ cSources cSources_ cxxSources cxxSources_ jsSources jsSources_. Monad m
  => Traverse m asmSources asmSources_ cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
  -> t asmSources cSources cxxSources jsSources
  -> m (t asmSources_ cSources_ cxxSources_ jsSources_)

type Traversal_ t = forall m asmSources asmSources_ cSources cSources_ cxxSources cxxSources_ jsSources jsSources_ a. Monad m
  => Traverse m asmSources asmSources_ cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
  -> t asmSources cSources cxxSources jsSources a
  -> m (t asmSources_ cSources_ cxxSources_ jsSources_ a)

traverseCommonOptions :: Traversal_ CommonOptions
traverseCommonOptions :: Traversal_ CommonOptions
traverseCommonOptions t :: Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t@Traverse{asmSources -> m asmSources_
cSources -> m cSources_
cxxSources -> m cxxSources_
jsSources -> m jsSources_
traverseAsmSources :: forall (m :: * -> *) asmSources asmSources_ cSources cSources_
       cxxSources cxxSources_ jsSources jsSources_.
Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> asmSources -> m asmSources_
traverseCSources :: forall (m :: * -> *) asmSources asmSources_ cSources cSources_
       cxxSources cxxSources_ jsSources jsSources_.
Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> cSources -> m cSources_
traverseCxxSources :: forall (m :: * -> *) asmSources asmSources_ cSources cSources_
       cxxSources cxxSources_ jsSources jsSources_.
Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> cxxSources -> m cxxSources_
traverseJsSources :: forall (m :: * -> *) asmSources asmSources_ cSources cSources_
       cxxSources cxxSources_ jsSources jsSources_.
Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> jsSources -> m jsSources_
traverseAsmSources :: asmSources -> m asmSources_
traverseCSources :: cSources -> m cSources_
traverseCxxSources :: cxxSources -> m cxxSources_
traverseJsSources :: jsSources -> m jsSources_
..} c :: CommonOptions asmSources cSources cxxSources jsSources a
c@CommonOptions{asmSources
cSources
cxxSources
jsSources
ParseAsmSources
Maybe
  (List
     (ConditionalSection asmSources cSources cxxSources jsSources a))
Maybe (List Verbatim)
Maybe SystemBuildTools
Last Bool
Alias 'False "pkgconfig-depends" ParseAsmSources
Alias 'True "hs-source-dirs" ParseAsmSources
Alias 'True "build-depends" (Maybe Dependencies)
Alias 'True "default-language" (Last (Maybe Language))
Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsSourceDirs :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "hs-source-dirs" ParseAsmSources
commonOptionsDependencies :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsPkgConfigDependencies :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'False "pkgconfig-depends" ParseAsmSources
commonOptionsDefaultExtensions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsOtherExtensions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsLanguage :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "default-language" (Last (Maybe Language))
commonOptionsGhcOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcProfOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcSharedOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcjsOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsCppOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsCcOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsAsmOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsAsmSources :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> asmSources
commonOptionsCSources :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> cSources
commonOptionsCxxOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsCxxSources :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> cxxSources
commonOptionsJsSources :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> jsSources
commonOptionsExtraLibDirs :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsExtraLibraries :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsExtraFrameworksDirs :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsFrameworks :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsIncludeDirs :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsInstallIncludes :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsLdOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsBuildable :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Last Bool
commonOptionsWhen :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe
     (List
        (ConditionalSection asmSources cSources cxxSources jsSources a))
commonOptionsBuildTools :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsSystemBuildTools :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe SystemBuildTools
commonOptionsVerbatim :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe (List Verbatim)
commonOptionsSourceDirs :: Alias 'True "hs-source-dirs" ParseAsmSources
commonOptionsDependencies :: Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsPkgConfigDependencies :: Alias 'False "pkgconfig-depends" ParseAsmSources
commonOptionsDefaultExtensions :: ParseAsmSources
commonOptionsOtherExtensions :: ParseAsmSources
commonOptionsLanguage :: Alias 'True "default-language" (Last (Maybe Language))
commonOptionsGhcOptions :: ParseAsmSources
commonOptionsGhcProfOptions :: ParseAsmSources
commonOptionsGhcSharedOptions :: ParseAsmSources
commonOptionsGhcjsOptions :: ParseAsmSources
commonOptionsCppOptions :: ParseAsmSources
commonOptionsCcOptions :: ParseAsmSources
commonOptionsAsmOptions :: ParseAsmSources
commonOptionsAsmSources :: asmSources
commonOptionsCSources :: cSources
commonOptionsCxxOptions :: ParseAsmSources
commonOptionsCxxSources :: cxxSources
commonOptionsJsSources :: jsSources
commonOptionsExtraLibDirs :: ParseAsmSources
commonOptionsExtraLibraries :: ParseAsmSources
commonOptionsExtraFrameworksDirs :: ParseAsmSources
commonOptionsFrameworks :: ParseAsmSources
commonOptionsIncludeDirs :: ParseAsmSources
commonOptionsInstallIncludes :: ParseAsmSources
commonOptionsLdOptions :: ParseAsmSources
commonOptionsBuildable :: Last Bool
commonOptionsWhen :: Maybe
  (List
     (ConditionalSection asmSources cSources cxxSources jsSources a))
commonOptionsBuildTools :: Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsSystemBuildTools :: Maybe SystemBuildTools
commonOptionsVerbatim :: Maybe (List Verbatim)
..} = do
  asmSources_
asmSources <- asmSources -> m asmSources_
traverseAsmSources asmSources
commonOptionsAsmSources
  cSources_
cSources <- cSources -> m cSources_
traverseCSources cSources
commonOptionsCSources
  cxxSources_
cxxSources <- cxxSources -> m cxxSources_
traverseCxxSources cxxSources
commonOptionsCxxSources
  jsSources_
jsSources <- jsSources -> m jsSources_
traverseJsSources jsSources
commonOptionsJsSources
  Maybe
  (List
     (ConditionalSection
        asmSources_ cSources_ cxxSources_ jsSources_ a))
xs <- (List
   (ConditionalSection asmSources cSources cxxSources jsSources a)
 -> m (List
         (ConditionalSection
            asmSources_ cSources_ cxxSources_ jsSources_ a)))
-> Maybe
     (List
        (ConditionalSection asmSources cSources cxxSources jsSources a))
-> m (Maybe
        (List
           (ConditionalSection
              asmSources_ cSources_ cxxSources_ jsSources_ a)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((ConditionalSection asmSources cSources cxxSources jsSources a
 -> m (ConditionalSection
         asmSources_ cSources_ cxxSources_ jsSources_ a))
-> List
     (ConditionalSection asmSources cSources cxxSources jsSources a)
-> m (List
        (ConditionalSection
           asmSources_ cSources_ cxxSources_ jsSources_ a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> List a -> f (List b)
traverse (Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> ConditionalSection asmSources cSources cxxSources jsSources a
-> m (ConditionalSection
        asmSources_ cSources_ cxxSources_ jsSources_ a)
Traversal_ ConditionalSection
traverseConditionalSection Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t)) Maybe
  (List
     (ConditionalSection asmSources cSources cxxSources jsSources a))
commonOptionsWhen
  CommonOptions asmSources_ cSources_ cxxSources_ jsSources_ a
-> m (CommonOptions asmSources_ cSources_ cxxSources_ jsSources_ a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CommonOptions asmSources cSources cxxSources jsSources a
c {
      commonOptionsAsmSources = asmSources
    , commonOptionsCSources = cSources
    , commonOptionsCxxSources = cxxSources
    , commonOptionsJsSources = jsSources
    , commonOptionsWhen = xs
    }

traverseConditionalSection :: Traversal_ ConditionalSection
traverseConditionalSection :: Traversal_ ConditionalSection
traverseConditionalSection Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t = \ case
  ThenElseConditional Product
  (ThenElse asmSources cSources cxxSources jsSources a) Condition
c -> Product
  (ThenElse asmSources_ cSources_ cxxSources_ jsSources_ a) Condition
-> ConditionalSection
     asmSources_ cSources_ cxxSources_ jsSources_ a
forall asmSources cSources cxxSources jsSources a.
Product
  (ThenElse asmSources cSources cxxSources jsSources a) Condition
-> ConditionalSection asmSources cSources cxxSources jsSources a
ThenElseConditional (Product
   (ThenElse asmSources_ cSources_ cxxSources_ jsSources_ a) Condition
 -> ConditionalSection
      asmSources_ cSources_ cxxSources_ jsSources_ a)
-> m (Product
        (ThenElse asmSources_ cSources_ cxxSources_ jsSources_ a)
        Condition)
-> m (ConditionalSection
        asmSources_ cSources_ cxxSources_ jsSources_ a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ThenElse asmSources cSources cxxSources jsSources a
 -> m (ThenElse asmSources_ cSources_ cxxSources_ jsSources_ a))
-> (Condition -> m Condition)
-> Product
     (ThenElse asmSources cSources cxxSources jsSources a) Condition
-> m (Product
        (ThenElse asmSources_ cSources_ cxxSources_ jsSources_ a)
        Condition)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Product a b -> f (Product c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> ThenElse asmSources cSources cxxSources jsSources a
-> m (ThenElse asmSources_ cSources_ cxxSources_ jsSources_ a)
Traversal_ ThenElse
traverseThenElse Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t) Condition -> m Condition
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Product
  (ThenElse asmSources cSources cxxSources jsSources a) Condition
c
  FlatConditional Product
  (WithCommonOptions asmSources cSources cxxSources jsSources a)
  Condition
c -> Product
  (WithCommonOptions asmSources_ cSources_ cxxSources_ jsSources_ a)
  Condition
-> ConditionalSection
     asmSources_ cSources_ cxxSources_ jsSources_ a
forall asmSources cSources cxxSources jsSources a.
Product
  (WithCommonOptions asmSources cSources cxxSources jsSources a)
  Condition
-> ConditionalSection asmSources cSources cxxSources jsSources a
FlatConditional (Product
   (WithCommonOptions asmSources_ cSources_ cxxSources_ jsSources_ a)
   Condition
 -> ConditionalSection
      asmSources_ cSources_ cxxSources_ jsSources_ a)
-> m (Product
        (WithCommonOptions asmSources_ cSources_ cxxSources_ jsSources_ a)
        Condition)
-> m (ConditionalSection
        asmSources_ cSources_ cxxSources_ jsSources_ a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WithCommonOptions asmSources cSources cxxSources jsSources a
 -> m (WithCommonOptions
         asmSources_ cSources_ cxxSources_ jsSources_ a))
-> (Condition -> m Condition)
-> Product
     (WithCommonOptions asmSources cSources cxxSources jsSources a)
     Condition
-> m (Product
        (WithCommonOptions asmSources_ cSources_ cxxSources_ jsSources_ a)
        Condition)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Product a b -> f (Product c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> WithCommonOptions asmSources cSources cxxSources jsSources a
-> m (WithCommonOptions
        asmSources_ cSources_ cxxSources_ jsSources_ a)
Traversal_ WithCommonOptions
traverseWithCommonOptions Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t) Condition -> m Condition
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Product
  (WithCommonOptions asmSources cSources cxxSources jsSources a)
  Condition
c

traverseThenElse :: Traversal_ ThenElse
traverseThenElse :: Traversal_ ThenElse
traverseThenElse Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t c :: ThenElse asmSources cSources cxxSources jsSources a
c@ThenElse{WithCommonOptions asmSources cSources cxxSources jsSources a
thenElseThen :: WithCommonOptions asmSources cSources cxxSources jsSources a
thenElseElse :: WithCommonOptions asmSources cSources cxxSources jsSources a
thenElseElse :: forall asmSources cSources cxxSources jsSources a.
ThenElse asmSources cSources cxxSources jsSources a
-> WithCommonOptions asmSources cSources cxxSources jsSources a
thenElseThen :: forall asmSources cSources cxxSources jsSources a.
ThenElse asmSources cSources cxxSources jsSources a
-> WithCommonOptions asmSources cSources cxxSources jsSources a
..} = do
  WithCommonOptions asmSources_ cSources_ cxxSources_ jsSources_ a
then_ <- Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> WithCommonOptions asmSources cSources cxxSources jsSources a
-> m (WithCommonOptions
        asmSources_ cSources_ cxxSources_ jsSources_ a)
Traversal_ WithCommonOptions
traverseWithCommonOptions Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t WithCommonOptions asmSources cSources cxxSources jsSources a
thenElseThen
  WithCommonOptions asmSources_ cSources_ cxxSources_ jsSources_ a
else_ <- Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> WithCommonOptions asmSources cSources cxxSources jsSources a
-> m (WithCommonOptions
        asmSources_ cSources_ cxxSources_ jsSources_ a)
Traversal_ WithCommonOptions
traverseWithCommonOptions Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t WithCommonOptions asmSources cSources cxxSources jsSources a
thenElseElse
  ThenElse asmSources_ cSources_ cxxSources_ jsSources_ a
-> m (ThenElse asmSources_ cSources_ cxxSources_ jsSources_ a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ThenElse asmSources cSources cxxSources jsSources a
c{thenElseThen = then_, thenElseElse = else_}

traverseWithCommonOptions :: Traversal_ WithCommonOptions
traverseWithCommonOptions :: Traversal_ WithCommonOptions
traverseWithCommonOptions Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t = (CommonOptions asmSources cSources cxxSources jsSources a
 -> m (CommonOptions
         asmSources_ cSources_ cxxSources_ jsSources_ a))
-> (a -> m a)
-> Product
     (CommonOptions asmSources cSources cxxSources jsSources a) a
-> m (Product
        (CommonOptions asmSources_ cSources_ cxxSources_ jsSources_ a) a)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Product a b -> f (Product c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> CommonOptions asmSources cSources cxxSources jsSources a
-> m (CommonOptions asmSources_ cSources_ cxxSources_ jsSources_ a)
Traversal_ CommonOptions
traverseCommonOptions Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t) a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

data ConditionalSection asmSources cSources cxxSources jsSources a =
    ThenElseConditional (Product (ThenElse asmSources cSources cxxSources jsSources a) Condition)
  | FlatConditional (Product (WithCommonOptions asmSources cSources cxxSources jsSources a) Condition)

instance Functor (ConditionalSection asmSources cSources cxxSources jsSources) where
  fmap :: forall a b.
(a -> b)
-> ConditionalSection asmSources cSources cxxSources jsSources a
-> ConditionalSection asmSources cSources cxxSources jsSources b
fmap a -> b
f = \ case
    ThenElseConditional Product
  (ThenElse asmSources cSources cxxSources jsSources a) Condition
c -> Product
  (ThenElse asmSources cSources cxxSources jsSources b) Condition
-> ConditionalSection asmSources cSources cxxSources jsSources b
forall asmSources cSources cxxSources jsSources a.
Product
  (ThenElse asmSources cSources cxxSources jsSources a) Condition
-> ConditionalSection asmSources cSources cxxSources jsSources a
ThenElseConditional ((ThenElse asmSources cSources cxxSources jsSources a
 -> ThenElse asmSources cSources cxxSources jsSources b)
-> Product
     (ThenElse asmSources cSources cxxSources jsSources a) Condition
-> Product
     (ThenElse asmSources cSources cxxSources jsSources b) Condition
forall a b c. (a -> b) -> Product a c -> Product b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((a -> b)
-> ThenElse asmSources cSources cxxSources jsSources a
-> ThenElse asmSources cSources cxxSources jsSources b
forall a b.
(a -> b)
-> ThenElse asmSources cSources cxxSources jsSources a
-> ThenElse asmSources cSources cxxSources jsSources b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Product
  (ThenElse asmSources cSources cxxSources jsSources a) Condition
c)
    FlatConditional Product
  (WithCommonOptions asmSources cSources cxxSources jsSources a)
  Condition
c -> Product
  (WithCommonOptions asmSources cSources cxxSources jsSources b)
  Condition
-> ConditionalSection asmSources cSources cxxSources jsSources b
forall asmSources cSources cxxSources jsSources a.
Product
  (WithCommonOptions asmSources cSources cxxSources jsSources a)
  Condition
-> ConditionalSection asmSources cSources cxxSources jsSources a
FlatConditional ((WithCommonOptions asmSources cSources cxxSources jsSources a
 -> WithCommonOptions asmSources cSources cxxSources jsSources b)
-> Product
     (WithCommonOptions asmSources cSources cxxSources jsSources a)
     Condition
-> Product
     (WithCommonOptions asmSources cSources cxxSources jsSources b)
     Condition
forall a b c. (a -> b) -> Product a c -> Product b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((CommonOptions asmSources cSources cxxSources jsSources a
 -> CommonOptions asmSources cSources cxxSources jsSources b)
-> (a -> b)
-> WithCommonOptions asmSources cSources cxxSources jsSources a
-> WithCommonOptions asmSources cSources cxxSources jsSources b
forall a b c d. (a -> b) -> (c -> d) -> Product a c -> Product b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((a -> b)
-> CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources b
forall a b.
(a -> b)
-> CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) a -> b
f) Product
  (WithCommonOptions asmSources cSources cxxSources jsSources a)
  Condition
c)

type ParseConditionalSection = ConditionalSection ParseAsmSources ParseCSources ParseCxxSources ParseJsSources

instance FromValue a => FromValue (ParseConditionalSection a) where
  fromValue :: Value -> Parser (ParseConditionalSection a)
fromValue Value
v
    | Key -> Value -> Bool
hasKey Key
"then" Value
v Bool -> Bool -> Bool
|| Key -> Value -> Bool
hasKey Key
"else" Value
v = Product
  (ThenElse
     ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
  Condition
-> ParseConditionalSection a
forall asmSources cSources cxxSources jsSources a.
Product
  (ThenElse asmSources cSources cxxSources jsSources a) Condition
-> ConditionalSection asmSources cSources cxxSources jsSources a
ThenElseConditional (Product
   (ThenElse
      ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
   Condition
 -> ParseConditionalSection a)
-> Parser
     (Product
        (ThenElse
           ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
        Condition)
-> Parser (ParseConditionalSection a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
-> Parser
     (Product
        (ThenElse
           ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
        Condition)
forall a. FromValue a => Value -> Parser a
fromValue Value
v Parser (ParseConditionalSection a)
-> Parser () -> Parser (ParseConditionalSection a)
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
giveHint
    | Bool
otherwise = Product
  (WithCommonOptions
     ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
  Condition
-> ParseConditionalSection a
forall asmSources cSources cxxSources jsSources a.
Product
  (WithCommonOptions asmSources cSources cxxSources jsSources a)
  Condition
-> ConditionalSection asmSources cSources cxxSources jsSources a
FlatConditional (Product
   (WithCommonOptions
      ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
   Condition
 -> ParseConditionalSection a)
-> Parser
     (Product
        (WithCommonOptions
           ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
        Condition)
-> Parser (ParseConditionalSection a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
-> Parser
     (Product
        (WithCommonOptions
           ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
        Condition)
forall a. FromValue a => Value -> Parser a
fromValue Value
v
    where
      giveHint :: Parser ()
giveHint = case Value
v of
        Object Object
o -> case (,,) (Value -> Value -> Value -> (Value, Value, Value))
-> Maybe Value -> Maybe (Value -> Value -> (Value, Value, Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"then" Object
o Maybe (Value -> Value -> (Value, Value, Value))
-> Maybe Value -> Maybe (Value -> (Value, Value, Value))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"else" Object
o Maybe (Value -> (Value, Value, Value))
-> Maybe Value -> Maybe (Value, Value, Value)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"condition" Object
o of
          Just (Object Object
then_, Object Object
else_, String Text
condition) -> do
            Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Object -> Bool
forall v. KeyMap v -> Bool
KeyMap.null Object
then_) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ [Char]
"then" [Char] -> Value -> Parser ()
`emptyTryInstead` Value
flatElse
            Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Object -> Bool
forall v. KeyMap v -> Bool
KeyMap.null Object
else_) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ [Char]
"else" [Char] -> Value -> Parser ()
`emptyTryInstead` Value
flatThen
            where
              flatThen :: Value
flatThen = Text -> Object -> Value
flatConditional Text
condition Object
then_
              flatElse :: Value
flatElse = Text -> Object -> Value
flatConditional (Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
negate_ Text
condition) Object
else_
          Maybe (Value, Value, Value)
_ -> () -> Parser ()
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Value
_ -> () -> Parser ()
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

      negate_ :: a -> a
negate_ a
condition = a
"!(" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
condition a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"

      flatConditional :: Text -> Object -> Value
flatConditional Text
condition Object
sect = [Pair] -> Value
object [(Key
"when" Key -> Object -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert Key
"condition" (Text -> Value
String Text
condition) Object
sect)]

      emptyTryInstead :: String -> Value -> Parser ()
      emptyTryInstead :: [Char] -> Value -> Parser ()
emptyTryInstead [Char]
name Value
sect = do
        [Char] -> Parser ()
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser ()) -> [Char] -> Parser ()
forall a b. (a -> b) -> a -> b
$ [Char]
"an empty " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> [Char]
show [Char]
name [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" section is not allowed, try the following instead:\n\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
encodePretty Value
sect

      encodePretty :: Value -> [Char]
encodePretty = Text -> [Char]
T.unpack (Text -> [Char]) -> (Value -> Text) -> Value -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (Value -> ByteString) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Value -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
Yaml.encodePretty Config
c
        where
          c :: Yaml.Config
          c :: Config
c = (Text -> Text -> Ordering) -> Config -> Config
Yaml.setConfCompare Text -> Text -> Ordering
forall {a}. (IsString a, Ord a) => a -> a -> Ordering
f Config
Yaml.defConfig
            where
              f :: a -> a -> Ordering
f a
a a
b = case (a
a, a
b) of
                (a
"condition", a
"condition") -> Ordering
EQ
                (a
"condition", a
_) -> Ordering
LT
                (a
_, a
"condition") -> Ordering
GT
                (a, a)
_ -> a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b

hasKey :: Key -> Value -> Bool
hasKey :: Key -> Value -> Bool
hasKey Key
key (Object Object
o) = Key -> Object -> Bool
forall a. Key -> KeyMap a -> Bool
KeyMap.member Key
key Object
o
hasKey Key
_ Value
_ = Bool
False

newtype Condition = Condition {
  Condition -> Cond
conditionCondition :: Cond
} deriving (Condition -> Condition -> Bool
(Condition -> Condition -> Bool)
-> (Condition -> Condition -> Bool) -> Eq Condition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Condition -> Condition -> Bool
== :: Condition -> Condition -> Bool
$c/= :: Condition -> Condition -> Bool
/= :: Condition -> Condition -> Bool
Eq, Int -> Condition -> ShowS
[Condition] -> ShowS
Condition -> [Char]
(Int -> Condition -> ShowS)
-> (Condition -> [Char])
-> ([Condition] -> ShowS)
-> Show Condition
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Condition -> ShowS
showsPrec :: Int -> Condition -> ShowS
$cshow :: Condition -> [Char]
show :: Condition -> [Char]
$cshowList :: [Condition] -> ShowS
showList :: [Condition] -> ShowS
Show, (forall x. Condition -> Rep Condition x)
-> (forall x. Rep Condition x -> Condition) -> Generic Condition
forall x. Rep Condition x -> Condition
forall x. Condition -> Rep Condition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Condition -> Rep Condition x
from :: forall x. Condition -> Rep Condition x
$cto :: forall x. Rep Condition x -> Condition
to :: forall x. Rep Condition x -> Condition
Generic, Value -> Parser Condition
(Value -> Parser Condition) -> FromValue Condition
forall a. (Value -> Parser a) -> FromValue a
$cfromValue :: Value -> Parser Condition
fromValue :: Value -> Parser Condition
FromValue)

data Cond = CondBool Bool | CondExpression String
  deriving (Cond -> Cond -> Bool
(Cond -> Cond -> Bool) -> (Cond -> Cond -> Bool) -> Eq Cond
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cond -> Cond -> Bool
== :: Cond -> Cond -> Bool
$c/= :: Cond -> Cond -> Bool
/= :: Cond -> Cond -> Bool
Eq, Int -> Cond -> ShowS
[Cond] -> ShowS
Cond -> [Char]
(Int -> Cond -> ShowS)
-> (Cond -> [Char]) -> ([Cond] -> ShowS) -> Show Cond
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cond -> ShowS
showsPrec :: Int -> Cond -> ShowS
$cshow :: Cond -> [Char]
show :: Cond -> [Char]
$cshowList :: [Cond] -> ShowS
showList :: [Cond] -> ShowS
Show)

instance FromValue Cond where
  fromValue :: Value -> Parser Cond
fromValue Value
v = case Value
v of
    String Text
c -> Cond -> Parser Cond
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Cond
CondExpression ([Char] -> Cond) -> [Char] -> Cond
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
c)
    Bool Bool
c -> Cond -> Parser Cond
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Cond
CondBool Bool
c)
    Value
_ -> [Char] -> Value -> Parser Cond
forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
"Boolean or String" Value
v

data ThenElse asmSources cSources cxxSources jsSources a = ThenElse {
  forall asmSources cSources cxxSources jsSources a.
ThenElse asmSources cSources cxxSources jsSources a
-> WithCommonOptions asmSources cSources cxxSources jsSources a
thenElseThen :: WithCommonOptions asmSources cSources cxxSources jsSources a
, forall asmSources cSources cxxSources jsSources a.
ThenElse asmSources cSources cxxSources jsSources a
-> WithCommonOptions asmSources cSources cxxSources jsSources a
thenElseElse :: WithCommonOptions asmSources cSources cxxSources jsSources a
} deriving (forall x.
 ThenElse asmSources cSources cxxSources jsSources a
 -> Rep (ThenElse asmSources cSources cxxSources jsSources a) x)
-> (forall x.
    Rep (ThenElse asmSources cSources cxxSources jsSources a) x
    -> ThenElse asmSources cSources cxxSources jsSources a)
-> Generic (ThenElse asmSources cSources cxxSources jsSources a)
forall x.
Rep (ThenElse asmSources cSources cxxSources jsSources a) x
-> ThenElse asmSources cSources cxxSources jsSources a
forall x.
ThenElse asmSources cSources cxxSources jsSources a
-> Rep (ThenElse asmSources cSources cxxSources jsSources a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall asmSources cSources cxxSources jsSources a x.
Rep (ThenElse asmSources cSources cxxSources jsSources a) x
-> ThenElse asmSources cSources cxxSources jsSources a
forall asmSources cSources cxxSources jsSources a x.
ThenElse asmSources cSources cxxSources jsSources a
-> Rep (ThenElse asmSources cSources cxxSources jsSources a) x
$cfrom :: forall asmSources cSources cxxSources jsSources a x.
ThenElse asmSources cSources cxxSources jsSources a
-> Rep (ThenElse asmSources cSources cxxSources jsSources a) x
from :: forall x.
ThenElse asmSources cSources cxxSources jsSources a
-> Rep (ThenElse asmSources cSources cxxSources jsSources a) x
$cto :: forall asmSources cSources cxxSources jsSources a x.
Rep (ThenElse asmSources cSources cxxSources jsSources a) x
-> ThenElse asmSources cSources cxxSources jsSources a
to :: forall x.
Rep (ThenElse asmSources cSources cxxSources jsSources a) x
-> ThenElse asmSources cSources cxxSources jsSources a
Generic

instance Functor (ThenElse asmSources cSources cxxSources jsSources) where
  fmap :: forall a b.
(a -> b)
-> ThenElse asmSources cSources cxxSources jsSources a
-> ThenElse asmSources cSources cxxSources jsSources b
fmap a -> b
f c :: ThenElse asmSources cSources cxxSources jsSources a
c@ThenElse{WithCommonOptions asmSources cSources cxxSources jsSources a
thenElseElse :: forall asmSources cSources cxxSources jsSources a.
ThenElse asmSources cSources cxxSources jsSources a
-> WithCommonOptions asmSources cSources cxxSources jsSources a
thenElseThen :: forall asmSources cSources cxxSources jsSources a.
ThenElse asmSources cSources cxxSources jsSources a
-> WithCommonOptions asmSources cSources cxxSources jsSources a
thenElseThen :: WithCommonOptions asmSources cSources cxxSources jsSources a
thenElseElse :: WithCommonOptions asmSources cSources cxxSources jsSources a
..} = ThenElse asmSources cSources cxxSources jsSources a
c{thenElseThen = map_ thenElseThen, thenElseElse = map_ thenElseElse}
    where
      map_ :: WithCommonOptions asmSources cSources cxxSources jsSources a
-> Product
     (CommonOptions asmSources cSources cxxSources jsSources b) b
map_ = (CommonOptions asmSources cSources cxxSources jsSources a
 -> CommonOptions asmSources cSources cxxSources jsSources b)
-> (a -> b)
-> WithCommonOptions asmSources cSources cxxSources jsSources a
-> Product
     (CommonOptions asmSources cSources cxxSources jsSources b) b
forall a b c d. (a -> b) -> (c -> d) -> Product a c -> Product b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((a -> b)
-> CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources b
forall a b.
(a -> b)
-> CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) a -> b
f

type ParseThenElse = ThenElse ParseAsmSources ParseCSources ParseCxxSources ParseJsSources

instance FromValue a => FromValue (ParseThenElse a)

data Empty = Empty
  deriving (Empty -> Empty -> Bool
(Empty -> Empty -> Bool) -> (Empty -> Empty -> Bool) -> Eq Empty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Empty -> Empty -> Bool
== :: Empty -> Empty -> Bool
$c/= :: Empty -> Empty -> Bool
/= :: Empty -> Empty -> Bool
Eq, Int -> Empty -> ShowS
[Empty] -> ShowS
Empty -> [Char]
(Int -> Empty -> ShowS)
-> (Empty -> [Char]) -> ([Empty] -> ShowS) -> Show Empty
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Empty -> ShowS
showsPrec :: Int -> Empty -> ShowS
$cshow :: Empty -> [Char]
show :: Empty -> [Char]
$cshowList :: [Empty] -> ShowS
showList :: [Empty] -> ShowS
Show)

instance Monoid Empty where
  mempty :: Empty
mempty = Empty
Empty
  mappend :: Empty -> Empty -> Empty
mappend = Empty -> Empty -> Empty
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup Empty where
  Empty
Empty <> :: Empty -> Empty -> Empty
<> Empty
Empty = Empty
Empty

instance FromValue Empty where
  fromValue :: Value -> Parser Empty
fromValue Value
_ = Empty -> Parser Empty
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Empty
Empty

newtype Language = Language String
  deriving (Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
/= :: Language -> Language -> Bool
Eq, Int -> Language -> ShowS
[Language] -> ShowS
Language -> [Char]
(Int -> Language -> ShowS)
-> (Language -> [Char]) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Language -> ShowS
showsPrec :: Int -> Language -> ShowS
$cshow :: Language -> [Char]
show :: Language -> [Char]
$cshowList :: [Language] -> ShowS
showList :: [Language] -> ShowS
Show)

instance IsString Language where
  fromString :: [Char] -> Language
fromString = [Char] -> Language
Language

instance FromValue Language where
  fromValue :: Value -> Parser Language
fromValue = ([Char] -> Language) -> Parser [Char] -> Parser Language
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Language
Language (Parser [Char] -> Parser Language)
-> (Value -> Parser [Char]) -> Value -> Parser Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser [Char]
forall a. FromValue a => Value -> Parser a
fromValue

data BuildType =
    Simple
  | Configure
  | Make
  | Custom
  deriving (BuildType -> BuildType -> Bool
(BuildType -> BuildType -> Bool)
-> (BuildType -> BuildType -> Bool) -> Eq BuildType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildType -> BuildType -> Bool
== :: BuildType -> BuildType -> Bool
$c/= :: BuildType -> BuildType -> Bool
/= :: BuildType -> BuildType -> Bool
Eq, Int -> BuildType -> ShowS
[BuildType] -> ShowS
BuildType -> [Char]
(Int -> BuildType -> ShowS)
-> (BuildType -> [Char])
-> ([BuildType] -> ShowS)
-> Show BuildType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildType -> ShowS
showsPrec :: Int -> BuildType -> ShowS
$cshow :: BuildType -> [Char]
show :: BuildType -> [Char]
$cshowList :: [BuildType] -> ShowS
showList :: [BuildType] -> ShowS
Show, Int -> BuildType
BuildType -> Int
BuildType -> [BuildType]
BuildType -> BuildType
BuildType -> BuildType -> [BuildType]
BuildType -> BuildType -> BuildType -> [BuildType]
(BuildType -> BuildType)
-> (BuildType -> BuildType)
-> (Int -> BuildType)
-> (BuildType -> Int)
-> (BuildType -> [BuildType])
-> (BuildType -> BuildType -> [BuildType])
-> (BuildType -> BuildType -> [BuildType])
-> (BuildType -> BuildType -> BuildType -> [BuildType])
-> Enum BuildType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BuildType -> BuildType
succ :: BuildType -> BuildType
$cpred :: BuildType -> BuildType
pred :: BuildType -> BuildType
$ctoEnum :: Int -> BuildType
toEnum :: Int -> BuildType
$cfromEnum :: BuildType -> Int
fromEnum :: BuildType -> Int
$cenumFrom :: BuildType -> [BuildType]
enumFrom :: BuildType -> [BuildType]
$cenumFromThen :: BuildType -> BuildType -> [BuildType]
enumFromThen :: BuildType -> BuildType -> [BuildType]
$cenumFromTo :: BuildType -> BuildType -> [BuildType]
enumFromTo :: BuildType -> BuildType -> [BuildType]
$cenumFromThenTo :: BuildType -> BuildType -> BuildType -> [BuildType]
enumFromThenTo :: BuildType -> BuildType -> BuildType -> [BuildType]
Enum, BuildType
BuildType -> BuildType -> Bounded BuildType
forall a. a -> a -> Bounded a
$cminBound :: BuildType
minBound :: BuildType
$cmaxBound :: BuildType
maxBound :: BuildType
Bounded)

instance FromValue BuildType where
  fromValue :: Value -> Parser BuildType
fromValue = (Text -> Parser BuildType) -> Value -> Parser BuildType
forall a. (Text -> Parser a) -> Value -> Parser a
withText ((Text -> Parser BuildType) -> Value -> Parser BuildType)
-> (Text -> Parser BuildType) -> Value -> Parser BuildType
forall a b. (a -> b) -> a -> b
$ \ (Text -> [Char]
T.unpack -> [Char]
t) -> do
    Parser BuildType
-> (BuildType -> Parser BuildType)
-> Maybe BuildType
-> Parser BuildType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser BuildType
forall {a}. Parser a
err BuildType -> Parser BuildType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> [([Char], BuildType)] -> Maybe BuildType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
t [([Char], BuildType)]
options)
    where
      err :: Parser a
err = [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"expected one of " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
formatOrList [[Char]]
buildTypesAsString)
      buildTypes :: [BuildType]
buildTypes = [BuildType
forall a. Bounded a => a
minBound .. BuildType
forall a. Bounded a => a
maxBound]
      buildTypesAsString :: [[Char]]
buildTypesAsString = (BuildType -> [Char]) -> [BuildType] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map BuildType -> [Char]
forall a. Show a => a -> [Char]
show [BuildType]
buildTypes
      options :: [([Char], BuildType)]
options = [[Char]] -> [BuildType] -> [([Char], BuildType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
buildTypesAsString [BuildType]
buildTypes

formatOrList :: [String] -> String
formatOrList :: [[Char]] -> [Char]
formatOrList [[Char]]
xs = case [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
xs of
  [] -> [Char]
""
  [Char]
x : [] -> [Char]
x
  [Char]
y : [Char]
x : [] -> [Char]
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" or " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
y
  [Char]
x : ys :: [[Char]]
ys@([Char]
_:[Char]
_:[[Char]]
_) -> [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([Char]
"or " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
ys

type SectionConfigWithDefaults asmSources cSources cxxSources jsSources a = Product DefaultsConfig (WithCommonOptions asmSources cSources cxxSources jsSources a)

type PackageConfigWithDefaults asmSources cSources cxxSources jsSources = PackageConfig_
  (SectionConfigWithDefaults asmSources cSources cxxSources jsSources LibrarySection)
  (SectionConfigWithDefaults asmSources cSources cxxSources jsSources ExecutableSection)

type PackageConfig asmSources cSources cxxSources jsSources = PackageConfig_
  (WithCommonOptions asmSources cSources cxxSources jsSources LibrarySection)
  (WithCommonOptions asmSources cSources cxxSources jsSources ExecutableSection)

data PackageVersion = PackageVersion {PackageVersion -> [Char]
unPackageVersion :: String}

instance FromValue PackageVersion where
  fromValue :: Value -> Parser PackageVersion
fromValue Value
v = [Char] -> PackageVersion
PackageVersion ([Char] -> PackageVersion)
-> Parser [Char] -> Parser PackageVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Value
v of
    Number Scientific
n -> [Char] -> Parser [Char]
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Scientific -> [Char]
scientificToVersion Scientific
n)
    String Text
s -> [Char] -> Parser [Char]
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [Char]
T.unpack Text
s)
    Value
_ -> [Char] -> Value -> Parser [Char]
forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
"Number or String" Value
v

data PackageConfig_ library executable = PackageConfig {
  forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigName :: Maybe String
, forall library executable.
PackageConfig_ library executable -> Maybe PackageVersion
packageConfigVersion :: Maybe PackageVersion
, forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigSynopsis :: Maybe String
, forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigDescription :: Maybe String
, forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigHomepage :: Maybe (Maybe String)
, forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigBugReports :: Maybe (Maybe String)
, forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigCategory :: Maybe String
, forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigStability :: Maybe String
, forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigAuthor :: Maybe (List String)
, forall library executable.
PackageConfig_ library executable -> Maybe ParseAsmSources
packageConfigMaintainer :: Maybe (Maybe (List String))
, forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigCopyright :: Maybe (List String)
, forall library executable.
PackageConfig_ library executable -> Maybe BuildType
packageConfigBuildType :: Maybe BuildType
, forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigLicense :: Maybe (Maybe String)
, forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigLicenseFile :: Maybe (List String)
, forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigTestedWith :: Maybe (List String)
, forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] FlagSection)
packageConfigFlags :: Maybe (Map String FlagSection)
, forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigExtraSourceFiles :: Maybe (List FilePath)
, forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigExtraDocFiles :: Maybe (List FilePath)
, forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigDataFiles :: Maybe (List FilePath)
, forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigDataDir :: Maybe FilePath
, forall library executable.
PackageConfig_ library executable -> Maybe GitHub
packageConfigGithub :: Maybe GitHub
, forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigGit :: Maybe String
, forall library executable.
PackageConfig_ library executable -> Maybe CustomSetupSection
packageConfigCustomSetup :: Maybe CustomSetupSection
, forall library executable.
PackageConfig_ library executable -> Maybe library
packageConfigLibrary :: Maybe library
, forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] library)
packageConfigInternalLibraries :: Maybe (Map String library)
, forall library executable.
PackageConfig_ library executable -> Maybe executable
packageConfigExecutable :: Maybe executable
, forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigExecutables :: Maybe (Map String executable)
, forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigTests :: Maybe (Map String executable)
, forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigBenchmarks :: Maybe (Map String executable)
} deriving (forall x.
 PackageConfig_ library executable
 -> Rep (PackageConfig_ library executable) x)
-> (forall x.
    Rep (PackageConfig_ library executable) x
    -> PackageConfig_ library executable)
-> Generic (PackageConfig_ library executable)
forall x.
Rep (PackageConfig_ library executable) x
-> PackageConfig_ library executable
forall x.
PackageConfig_ library executable
-> Rep (PackageConfig_ library executable) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall library executable x.
Rep (PackageConfig_ library executable) x
-> PackageConfig_ library executable
forall library executable x.
PackageConfig_ library executable
-> Rep (PackageConfig_ library executable) x
$cfrom :: forall library executable x.
PackageConfig_ library executable
-> Rep (PackageConfig_ library executable) x
from :: forall x.
PackageConfig_ library executable
-> Rep (PackageConfig_ library executable) x
$cto :: forall library executable x.
Rep (PackageConfig_ library executable) x
-> PackageConfig_ library executable
to :: forall x.
Rep (PackageConfig_ library executable) x
-> PackageConfig_ library executable
Generic

data GitHub = GitHub {
  GitHub -> [Char]
_gitHubOwner :: String
, GitHub -> [Char]
_gitHubRepo :: String
, GitHub -> Maybe [Char]
_gitHubSubdir :: Maybe String
}

instance FromValue GitHub where
  fromValue :: Value -> Parser GitHub
fromValue Value
v = do
    Text
input <- Value -> Parser Text
forall a. FromValue a => Value -> Parser a
fromValue Value
v
    case (Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack ([Text] -> [[Char]]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"/" Text
input of
      [[Char]
owner, [Char]
repo, [Char]
subdir] -> GitHub -> Parser GitHub
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (GitHub -> Parser GitHub) -> GitHub -> Parser GitHub
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Maybe [Char] -> GitHub
GitHub [Char]
owner [Char]
repo ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
subdir)
      [[Char]
owner, [Char]
repo] -> GitHub -> Parser GitHub
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (GitHub -> Parser GitHub) -> GitHub -> Parser GitHub
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Maybe [Char] -> GitHub
GitHub [Char]
owner [Char]
repo Maybe [Char]
forall a. Maybe a
Nothing
      [[Char]]
_ -> [Char] -> Parser GitHub
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser GitHub) -> [Char] -> Parser GitHub
forall a b. (a -> b) -> a -> b
$ [Char]
"expected owner/repo or owner/repo/subdir, but encountered " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
input

data DefaultsConfig = DefaultsConfig {
  DefaultsConfig -> Maybe (List Defaults)
defaultsConfigDefaults :: Maybe (List Defaults)
} deriving ((forall x. DefaultsConfig -> Rep DefaultsConfig x)
-> (forall x. Rep DefaultsConfig x -> DefaultsConfig)
-> Generic DefaultsConfig
forall x. Rep DefaultsConfig x -> DefaultsConfig
forall x. DefaultsConfig -> Rep DefaultsConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DefaultsConfig -> Rep DefaultsConfig x
from :: forall x. DefaultsConfig -> Rep DefaultsConfig x
$cto :: forall x. Rep DefaultsConfig x -> DefaultsConfig
to :: forall x. Rep DefaultsConfig x -> DefaultsConfig
Generic, Value -> Parser DefaultsConfig
(Value -> Parser DefaultsConfig) -> FromValue DefaultsConfig
forall a. (Value -> Parser a) -> FromValue a
$cfromValue :: Value -> Parser DefaultsConfig
fromValue :: Value -> Parser DefaultsConfig
FromValue)

traversePackageConfig :: Traversal PackageConfig
traversePackageConfig :: Traversal PackageConfig
traversePackageConfig Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t p :: PackageConfig asmSources cSources cxxSources jsSources
p@PackageConfig{Maybe [Char]
Maybe (Maybe [Char])
Maybe ParseAsmSources
Maybe
  (Map
     [Char]
     (WithCommonOptions
        asmSources cSources cxxSources jsSources ExecutableSection))
Maybe
  (Map
     [Char]
     (WithCommonOptions
        asmSources cSources cxxSources jsSources LibrarySection))
Maybe (Map [Char] FlagSection)
Maybe
  (WithCommonOptions
     asmSources cSources cxxSources jsSources ExecutableSection)
Maybe
  (WithCommonOptions
     asmSources cSources cxxSources jsSources LibrarySection)
ParseAsmSources
Maybe GitHub
Maybe PackageVersion
Maybe BuildType
Maybe CustomSetupSection
packageConfigName :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigVersion :: forall library executable.
PackageConfig_ library executable -> Maybe PackageVersion
packageConfigSynopsis :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigDescription :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigHomepage :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigBugReports :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigCategory :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigStability :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigAuthor :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigMaintainer :: forall library executable.
PackageConfig_ library executable -> Maybe ParseAsmSources
packageConfigCopyright :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigBuildType :: forall library executable.
PackageConfig_ library executable -> Maybe BuildType
packageConfigLicense :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigLicenseFile :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigTestedWith :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigFlags :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] FlagSection)
packageConfigExtraSourceFiles :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigExtraDocFiles :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigDataFiles :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigDataDir :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigGithub :: forall library executable.
PackageConfig_ library executable -> Maybe GitHub
packageConfigGit :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigCustomSetup :: forall library executable.
PackageConfig_ library executable -> Maybe CustomSetupSection
packageConfigLibrary :: forall library executable.
PackageConfig_ library executable -> Maybe library
packageConfigInternalLibraries :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] library)
packageConfigExecutable :: forall library executable.
PackageConfig_ library executable -> Maybe executable
packageConfigExecutables :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigTests :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigBenchmarks :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigName :: Maybe [Char]
packageConfigVersion :: Maybe PackageVersion
packageConfigSynopsis :: Maybe [Char]
packageConfigDescription :: Maybe [Char]
packageConfigHomepage :: Maybe (Maybe [Char])
packageConfigBugReports :: Maybe (Maybe [Char])
packageConfigCategory :: Maybe [Char]
packageConfigStability :: Maybe [Char]
packageConfigAuthor :: ParseAsmSources
packageConfigMaintainer :: Maybe ParseAsmSources
packageConfigCopyright :: ParseAsmSources
packageConfigBuildType :: Maybe BuildType
packageConfigLicense :: Maybe (Maybe [Char])
packageConfigLicenseFile :: ParseAsmSources
packageConfigTestedWith :: ParseAsmSources
packageConfigFlags :: Maybe (Map [Char] FlagSection)
packageConfigExtraSourceFiles :: ParseAsmSources
packageConfigExtraDocFiles :: ParseAsmSources
packageConfigDataFiles :: ParseAsmSources
packageConfigDataDir :: Maybe [Char]
packageConfigGithub :: Maybe GitHub
packageConfigGit :: Maybe [Char]
packageConfigCustomSetup :: Maybe CustomSetupSection
packageConfigLibrary :: Maybe
  (WithCommonOptions
     asmSources cSources cxxSources jsSources LibrarySection)
packageConfigInternalLibraries :: Maybe
  (Map
     [Char]
     (WithCommonOptions
        asmSources cSources cxxSources jsSources LibrarySection))
packageConfigExecutable :: Maybe
  (WithCommonOptions
     asmSources cSources cxxSources jsSources ExecutableSection)
packageConfigExecutables :: Maybe
  (Map
     [Char]
     (WithCommonOptions
        asmSources cSources cxxSources jsSources ExecutableSection))
packageConfigTests :: Maybe
  (Map
     [Char]
     (WithCommonOptions
        asmSources cSources cxxSources jsSources ExecutableSection))
packageConfigBenchmarks :: Maybe
  (Map
     [Char]
     (WithCommonOptions
        asmSources cSources cxxSources jsSources ExecutableSection))
..} = do
  Maybe
  (WithCommonOptions
     asmSources_ cSources_ cxxSources_ jsSources_ LibrarySection)
library <- (WithCommonOptions
   asmSources cSources cxxSources jsSources LibrarySection
 -> m (WithCommonOptions
         asmSources_ cSources_ cxxSources_ jsSources_ LibrarySection))
-> Maybe
     (WithCommonOptions
        asmSources cSources cxxSources jsSources LibrarySection)
-> m (Maybe
        (WithCommonOptions
           asmSources_ cSources_ cxxSources_ jsSources_ LibrarySection))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> WithCommonOptions
     asmSources cSources cxxSources jsSources LibrarySection
-> m (WithCommonOptions
        asmSources_ cSources_ cxxSources_ jsSources_ LibrarySection)
Traversal_ WithCommonOptions
traverseWithCommonOptions Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t) Maybe
  (WithCommonOptions
     asmSources cSources cxxSources jsSources LibrarySection)
packageConfigLibrary
  Maybe
  (Map
     [Char]
     (WithCommonOptions
        asmSources_ cSources_ cxxSources_ jsSources_ LibrarySection))
internalLibraries <- Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> Maybe
     (Map
        [Char]
        (WithCommonOptions
           asmSources cSources cxxSources jsSources LibrarySection))
-> m (Maybe
        (Map
           [Char]
           (WithCommonOptions
              asmSources_ cSources_ cxxSources_ jsSources_ LibrarySection)))
forall {asmSources} {asmSources_} {cSources} {cSources_}
       {cxxSources} {cxxSources_} {jsSources} {jsSources_} {a}.
Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> Maybe
     (Map
        [Char]
        (WithCommonOptions asmSources cSources cxxSources jsSources a))
-> m (Maybe
        (Map
           [Char]
           (WithCommonOptions
              asmSources_ cSources_ cxxSources_ jsSources_ a)))
traverseNamedConfigs Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t Maybe
  (Map
     [Char]
     (WithCommonOptions
        asmSources cSources cxxSources jsSources LibrarySection))
packageConfigInternalLibraries
  Maybe
  (WithCommonOptions
     asmSources_ cSources_ cxxSources_ jsSources_ ExecutableSection)
executable <- (WithCommonOptions
   asmSources cSources cxxSources jsSources ExecutableSection
 -> m (WithCommonOptions
         asmSources_ cSources_ cxxSources_ jsSources_ ExecutableSection))
-> Maybe
     (WithCommonOptions
        asmSources cSources cxxSources jsSources ExecutableSection)
-> m (Maybe
        (WithCommonOptions
           asmSources_ cSources_ cxxSources_ jsSources_ ExecutableSection))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> WithCommonOptions
     asmSources cSources cxxSources jsSources ExecutableSection
-> m (WithCommonOptions
        asmSources_ cSources_ cxxSources_ jsSources_ ExecutableSection)
Traversal_ WithCommonOptions
traverseWithCommonOptions Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t) Maybe
  (WithCommonOptions
     asmSources cSources cxxSources jsSources ExecutableSection)
packageConfigExecutable
  Maybe
  (Map
     [Char]
     (WithCommonOptions
        asmSources_ cSources_ cxxSources_ jsSources_ ExecutableSection))
executables <- Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> Maybe
     (Map
        [Char]
        (WithCommonOptions
           asmSources cSources cxxSources jsSources ExecutableSection))
-> m (Maybe
        (Map
           [Char]
           (WithCommonOptions
              asmSources_ cSources_ cxxSources_ jsSources_ ExecutableSection)))
forall {asmSources} {asmSources_} {cSources} {cSources_}
       {cxxSources} {cxxSources_} {jsSources} {jsSources_} {a}.
Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> Maybe
     (Map
        [Char]
        (WithCommonOptions asmSources cSources cxxSources jsSources a))
-> m (Maybe
        (Map
           [Char]
           (WithCommonOptions
              asmSources_ cSources_ cxxSources_ jsSources_ a)))
traverseNamedConfigs Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t Maybe
  (Map
     [Char]
     (WithCommonOptions
        asmSources cSources cxxSources jsSources ExecutableSection))
packageConfigExecutables
  Maybe
  (Map
     [Char]
     (WithCommonOptions
        asmSources_ cSources_ cxxSources_ jsSources_ ExecutableSection))
tests <- Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> Maybe
     (Map
        [Char]
        (WithCommonOptions
           asmSources cSources cxxSources jsSources ExecutableSection))
-> m (Maybe
        (Map
           [Char]
           (WithCommonOptions
              asmSources_ cSources_ cxxSources_ jsSources_ ExecutableSection)))
forall {asmSources} {asmSources_} {cSources} {cSources_}
       {cxxSources} {cxxSources_} {jsSources} {jsSources_} {a}.
Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> Maybe
     (Map
        [Char]
        (WithCommonOptions asmSources cSources cxxSources jsSources a))
-> m (Maybe
        (Map
           [Char]
           (WithCommonOptions
              asmSources_ cSources_ cxxSources_ jsSources_ a)))
traverseNamedConfigs Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t Maybe
  (Map
     [Char]
     (WithCommonOptions
        asmSources cSources cxxSources jsSources ExecutableSection))
packageConfigTests
  Maybe
  (Map
     [Char]
     (WithCommonOptions
        asmSources_ cSources_ cxxSources_ jsSources_ ExecutableSection))
benchmarks <- Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> Maybe
     (Map
        [Char]
        (WithCommonOptions
           asmSources cSources cxxSources jsSources ExecutableSection))
-> m (Maybe
        (Map
           [Char]
           (WithCommonOptions
              asmSources_ cSources_ cxxSources_ jsSources_ ExecutableSection)))
forall {asmSources} {asmSources_} {cSources} {cSources_}
       {cxxSources} {cxxSources_} {jsSources} {jsSources_} {a}.
Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> Maybe
     (Map
        [Char]
        (WithCommonOptions asmSources cSources cxxSources jsSources a))
-> m (Maybe
        (Map
           [Char]
           (WithCommonOptions
              asmSources_ cSources_ cxxSources_ jsSources_ a)))
traverseNamedConfigs Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t Maybe
  (Map
     [Char]
     (WithCommonOptions
        asmSources cSources cxxSources jsSources ExecutableSection))
packageConfigBenchmarks
  PackageConfig asmSources_ cSources_ cxxSources_ jsSources_
-> m (PackageConfig asmSources_ cSources_ cxxSources_ jsSources_)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return PackageConfig asmSources cSources cxxSources jsSources
p {
      packageConfigLibrary = library
    , packageConfigInternalLibraries = internalLibraries
    , packageConfigExecutable = executable
    , packageConfigExecutables = executables
    , packageConfigTests = tests
    , packageConfigBenchmarks = benchmarks
    }
  where
    traverseNamedConfigs :: Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> Maybe
     (Map
        [Char]
        (WithCommonOptions asmSources cSources cxxSources jsSources a))
-> m (Maybe
        (Map
           [Char]
           (WithCommonOptions
              asmSources_ cSources_ cxxSources_ jsSources_ a)))
traverseNamedConfigs = (Map
   [Char]
   (WithCommonOptions asmSources cSources cxxSources jsSources a)
 -> m (Map
         [Char]
         (WithCommonOptions
            asmSources_ cSources_ cxxSources_ jsSources_ a)))
-> Maybe
     (Map
        [Char]
        (WithCommonOptions asmSources cSources cxxSources jsSources a))
-> m (Maybe
        (Map
           [Char]
           (WithCommonOptions
              asmSources_ cSources_ cxxSources_ jsSources_ a)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((Map
    [Char]
    (WithCommonOptions asmSources cSources cxxSources jsSources a)
  -> m (Map
          [Char]
          (WithCommonOptions
             asmSources_ cSources_ cxxSources_ jsSources_ a)))
 -> Maybe
      (Map
         [Char]
         (WithCommonOptions asmSources cSources cxxSources jsSources a))
 -> m (Maybe
         (Map
            [Char]
            (WithCommonOptions
               asmSources_ cSources_ cxxSources_ jsSources_ a))))
-> (Traverse
      m
      asmSources
      asmSources_
      cSources
      cSources_
      cxxSources
      cxxSources_
      jsSources
      jsSources_
    -> Map
         [Char]
         (WithCommonOptions asmSources cSources cxxSources jsSources a)
    -> m (Map
            [Char]
            (WithCommonOptions
               asmSources_ cSources_ cxxSources_ jsSources_ a)))
-> Traverse
     m
     asmSources
     asmSources_
     cSources
     cSources_
     cxxSources
     cxxSources_
     jsSources
     jsSources_
-> Maybe
     (Map
        [Char]
        (WithCommonOptions asmSources cSources cxxSources jsSources a))
-> m (Maybe
        (Map
           [Char]
           (WithCommonOptions
              asmSources_ cSources_ cxxSources_ jsSources_ a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithCommonOptions asmSources cSources cxxSources jsSources a
 -> m (WithCommonOptions
         asmSources_ cSources_ cxxSources_ jsSources_ a))
-> Map
     [Char]
     (WithCommonOptions asmSources cSources cxxSources jsSources a)
-> m (Map
        [Char]
        (WithCommonOptions asmSources_ cSources_ cxxSources_ jsSources_ a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map [Char] a -> f (Map [Char] b)
traverse ((WithCommonOptions asmSources cSources cxxSources jsSources a
  -> m (WithCommonOptions
          asmSources_ cSources_ cxxSources_ jsSources_ a))
 -> Map
      [Char]
      (WithCommonOptions asmSources cSources cxxSources jsSources a)
 -> m (Map
         [Char]
         (WithCommonOptions
            asmSources_ cSources_ cxxSources_ jsSources_ a)))
-> (Traverse
      m
      asmSources
      asmSources_
      cSources
      cSources_
      cxxSources
      cxxSources_
      jsSources
      jsSources_
    -> WithCommonOptions asmSources cSources cxxSources jsSources a
    -> m (WithCommonOptions
            asmSources_ cSources_ cxxSources_ jsSources_ a))
-> Traverse
     m
     asmSources
     asmSources_
     cSources
     cSources_
     cxxSources
     cxxSources_
     jsSources
     jsSources_
-> Map
     [Char]
     (WithCommonOptions asmSources cSources cxxSources jsSources a)
-> m (Map
        [Char]
        (WithCommonOptions asmSources_ cSources_ cxxSources_ jsSources_ a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> WithCommonOptions asmSources cSources cxxSources jsSources a
-> m (WithCommonOptions
        asmSources_ cSources_ cxxSources_ jsSources_ a)
Traversal_ WithCommonOptions
traverseWithCommonOptions

type ParsePackageConfig = PackageConfigWithDefaults ParseAsmSources ParseCSources ParseCxxSources ParseJsSources

instance FromValue ParsePackageConfig

liftIOEither :: (MonadIO m, Errors m) => IO (Either HpackError a) -> m a
liftIOEither :: forall (m :: * -> *) a.
(MonadIO m, Errors m) =>
IO (Either HpackError a) -> m a
liftIOEither IO (Either HpackError a)
action = IO (Either HpackError a) -> m (Either HpackError a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Either HpackError a)
action m (Either HpackError a) -> (Either HpackError a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either HpackError a -> m a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither

type FormatYamlParseError = FilePath -> Yaml.ParseException -> String

decodeYaml :: (FromValue a, MonadIO m, Warnings m, Errors m, State m) => FormatYamlParseError -> FilePath -> m a
decodeYaml :: forall a (m :: * -> *).
(FromValue a, MonadIO m, Warnings m, Errors m, State m) =>
FormatYamlParseError -> [Char] -> m a
decodeYaml FormatYamlParseError
formatYamlParseError [Char]
file = do
  ([[Char]]
warnings, Value
a) <- IO (Either HpackError ([[Char]], Value)) -> m ([[Char]], Value)
forall (m :: * -> *) a.
(MonadIO m, Errors m) =>
IO (Either HpackError a) -> m a
liftIOEither (IO (Either HpackError ([[Char]], Value)) -> m ([[Char]], Value))
-> IO (Either HpackError ([[Char]], Value)) -> m ([[Char]], Value)
forall a b. (a -> b) -> a -> b
$ (ParseException -> HpackError)
-> Either ParseException ([[Char]], Value)
-> Either HpackError ([[Char]], Value)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Char] -> HpackError
ParseError ([Char] -> HpackError)
-> (ParseException -> [Char]) -> ParseException -> HpackError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormatYamlParseError
formatYamlParseError [Char]
file) (Either ParseException ([[Char]], Value)
 -> Either HpackError ([[Char]], Value))
-> IO (Either ParseException ([[Char]], Value))
-> IO (Either HpackError ([[Char]], Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Either ParseException ([[Char]], Value))
Yaml.decodeYamlWithParseError [Char]
file
  [[Char]] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[Char]]
warnings
  [Char] -> Value -> m a
forall a (m :: * -> *).
(FromValue a, State m, Warnings m, Errors m) =>
[Char] -> Value -> m a
decodeValue [Char]
file Value
a

data DecodeOptions = DecodeOptions {
  DecodeOptions -> ProgramName
decodeOptionsProgramName :: ProgramName
, DecodeOptions -> [Char]
decodeOptionsTarget :: FilePath
, DecodeOptions -> Maybe [Char]
decodeOptionsUserDataDir :: Maybe FilePath
, DecodeOptions -> [Char] -> IO (Either [Char] ([[Char]], Value))
decodeOptionsDecode :: FilePath -> IO (Either String ([String], Value))
, DecodeOptions -> FormatYamlParseError
decodeOptionsFormatYamlParseError :: FilePath -> Yaml.ParseException -> String
}

defaultDecodeOptions :: DecodeOptions
defaultDecodeOptions :: DecodeOptions
defaultDecodeOptions = ProgramName
-> [Char]
-> Maybe [Char]
-> ([Char] -> IO (Either [Char] ([[Char]], Value)))
-> FormatYamlParseError
-> DecodeOptions
DecodeOptions ProgramName
"hpack" [Char]
packageConfig Maybe [Char]
forall a. Maybe a
Nothing [Char] -> IO (Either [Char] ([[Char]], Value))
Yaml.decodeYaml FormatYamlParseError
Yaml.formatYamlParseError

data DecodeResult = DecodeResult {
  DecodeResult -> Package
decodeResultPackage :: Package
, DecodeResult -> [Char]
decodeResultCabalVersion :: String
, DecodeResult -> [Char]
decodeResultCabalFile :: FilePath
, DecodeResult -> [[Char]]
decodeResultWarnings :: [String]
} deriving (DecodeResult -> DecodeResult -> Bool
(DecodeResult -> DecodeResult -> Bool)
-> (DecodeResult -> DecodeResult -> Bool) -> Eq DecodeResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecodeResult -> DecodeResult -> Bool
== :: DecodeResult -> DecodeResult -> Bool
$c/= :: DecodeResult -> DecodeResult -> Bool
/= :: DecodeResult -> DecodeResult -> Bool
Eq, Int -> DecodeResult -> ShowS
[DecodeResult] -> ShowS
DecodeResult -> [Char]
(Int -> DecodeResult -> ShowS)
-> (DecodeResult -> [Char])
-> ([DecodeResult] -> ShowS)
-> Show DecodeResult
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodeResult -> ShowS
showsPrec :: Int -> DecodeResult -> ShowS
$cshow :: DecodeResult -> [Char]
show :: DecodeResult -> [Char]
$cshowList :: [DecodeResult] -> ShowS
showList :: [DecodeResult] -> ShowS
Show)

readPackageConfig :: DecodeOptions -> IO (Either String DecodeResult)
readPackageConfig :: DecodeOptions -> IO (Either [Char] DecodeResult)
readPackageConfig DecodeOptions
options = (HpackError -> [Char])
-> Either HpackError DecodeResult -> Either [Char] DecodeResult
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ProgramName -> HpackError -> [Char]
formatHpackError (ProgramName -> HpackError -> [Char])
-> ProgramName -> HpackError -> [Char]
forall a b. (a -> b) -> a -> b
$ DecodeOptions -> ProgramName
decodeOptionsProgramName DecodeOptions
options) (Either HpackError DecodeResult -> Either [Char] DecodeResult)
-> IO (Either HpackError DecodeResult)
-> IO (Either [Char] DecodeResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeOptions -> IO (Either HpackError DecodeResult)
readPackageConfigWithError DecodeOptions
options

type Errors = MonadError HpackError
type Warnings = MonadWriter [String]
type State = MonadState SpecVersion

type ConfigM m = StateT SpecVersion (WriterT [String] (ExceptT HpackError m))

runConfigM :: Monad m => ConfigM m a -> m (Either HpackError (a, [String]))
runConfigM :: forall (m :: * -> *) a.
Monad m =>
ConfigM m a -> m (Either HpackError (a, [[Char]]))
runConfigM = ExceptT HpackError m (a, [[Char]])
-> m (Either HpackError (a, [[Char]]))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT HpackError m (a, [[Char]])
 -> m (Either HpackError (a, [[Char]])))
-> (ConfigM m a -> ExceptT HpackError m (a, [[Char]]))
-> ConfigM m a
-> m (Either HpackError (a, [[Char]]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [[Char]] (ExceptT HpackError m) a
-> ExceptT HpackError m (a, [[Char]])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [[Char]] (ExceptT HpackError m) a
 -> ExceptT HpackError m (a, [[Char]]))
-> (ConfigM m a -> WriterT [[Char]] (ExceptT HpackError m) a)
-> ConfigM m a
-> ExceptT HpackError m (a, [[Char]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConfigM m a
-> SpecVersion -> WriterT [[Char]] (ExceptT HpackError m) a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
`evalStateT` SpecVersion
NoSpecVersion)

readPackageConfigWithError :: DecodeOptions -> IO (Either HpackError DecodeResult)
readPackageConfigWithError :: DecodeOptions -> IO (Either HpackError DecodeResult)
readPackageConfigWithError (DecodeOptions ProgramName
_ [Char]
file Maybe [Char]
mUserDataDir [Char] -> IO (Either [Char] ([[Char]], Value))
readValue FormatYamlParseError
formatYamlParseError) = (Either HpackError ((Package, [Char]), [[Char]])
 -> Either HpackError DecodeResult)
-> IO (Either HpackError ((Package, [Char]), [[Char]]))
-> IO (Either HpackError DecodeResult)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((((Package, [Char]), [[Char]]) -> DecodeResult)
-> Either HpackError ((Package, [Char]), [[Char]])
-> Either HpackError DecodeResult
forall a b. (a -> b) -> Either HpackError a -> Either HpackError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Package, [Char]), [[Char]]) -> DecodeResult
addCabalFile) (IO (Either HpackError ((Package, [Char]), [[Char]]))
 -> IO (Either HpackError DecodeResult))
-> (ConfigM IO (Package, [Char])
    -> IO (Either HpackError ((Package, [Char]), [[Char]])))
-> ConfigM IO (Package, [Char])
-> IO (Either HpackError DecodeResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigM IO (Package, [Char])
-> IO (Either HpackError ((Package, [Char]), [[Char]]))
forall (m :: * -> *) a.
Monad m =>
ConfigM m a -> m (Either HpackError (a, [[Char]]))
runConfigM (ConfigM IO (Package, [Char])
 -> IO (Either HpackError DecodeResult))
-> ConfigM IO (Package, [Char])
-> IO (Either HpackError DecodeResult)
forall a b. (a -> b) -> a -> b
$ do
  ([[Char]]
warnings, Value
value) <- IO (Either HpackError ([[Char]], Value))
-> StateT
     SpecVersion
     (WriterT [[Char]] (ExceptT HpackError IO))
     ([[Char]], Value)
forall (m :: * -> *) a.
(MonadIO m, Errors m) =>
IO (Either HpackError a) -> m a
liftIOEither (IO (Either HpackError ([[Char]], Value))
 -> StateT
      SpecVersion
      (WriterT [[Char]] (ExceptT HpackError IO))
      ([[Char]], Value))
-> IO (Either HpackError ([[Char]], Value))
-> StateT
     SpecVersion
     (WriterT [[Char]] (ExceptT HpackError IO))
     ([[Char]], Value)
forall a b. (a -> b) -> a -> b
$ ([Char] -> HpackError)
-> Either [Char] ([[Char]], Value)
-> Either HpackError ([[Char]], Value)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Char] -> HpackError
ParseError (Either [Char] ([[Char]], Value)
 -> Either HpackError ([[Char]], Value))
-> IO (Either [Char] ([[Char]], Value))
-> IO (Either HpackError ([[Char]], Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Either [Char] ([[Char]], Value))
readValue [Char]
file
  [[Char]]
-> StateT SpecVersion (WriterT [[Char]] (ExceptT HpackError IO)) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[Char]]
warnings
  ConfigWithDefaults
config <- [Char]
-> Value
-> StateT
     SpecVersion
     (WriterT [[Char]] (ExceptT HpackError IO))
     ConfigWithDefaults
forall a (m :: * -> *).
(FromValue a, State m, Warnings m, Errors m) =>
[Char] -> Value -> m a
decodeValue [Char]
file Value
value
  [Char]
dir <- IO [Char]
-> StateT
     SpecVersion (WriterT [[Char]] (ExceptT HpackError IO)) [Char]
forall a.
IO a
-> StateT SpecVersion (WriterT [[Char]] (ExceptT HpackError IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char]
 -> StateT
      SpecVersion (WriterT [[Char]] (ExceptT HpackError IO)) [Char])
-> IO [Char]
-> StateT
     SpecVersion (WriterT [[Char]] (ExceptT HpackError IO)) [Char]
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory ShowS -> IO [Char] -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
canonicalizePath [Char]
file
  [Char]
userDataDir <- IO [Char]
-> StateT
     SpecVersion (WriterT [[Char]] (ExceptT HpackError IO)) [Char]
forall a.
IO a
-> StateT SpecVersion (WriterT [[Char]] (ExceptT HpackError IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char]
 -> StateT
      SpecVersion (WriterT [[Char]] (ExceptT HpackError IO)) [Char])
-> IO [Char]
-> StateT
     SpecVersion (WriterT [[Char]] (ExceptT HpackError IO)) [Char]
forall a b. (a -> b) -> a -> b
$ IO [Char] -> ([Char] -> IO [Char]) -> Maybe [Char] -> IO [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> IO [Char]
getAppUserDataDirectory [Char]
"hpack") [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
mUserDataDir
  FormatYamlParseError
-> [Char]
-> [Char]
-> ConfigWithDefaults
-> ConfigM IO (Package, [Char])
toPackage FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir ConfigWithDefaults
config
  where
    addCabalFile :: ((Package, String), [String]) -> DecodeResult
    addCabalFile :: ((Package, [Char]), [[Char]]) -> DecodeResult
addCabalFile ((Package
pkg, [Char]
cabalVersion), [[Char]]
warnings) = Package -> [Char] -> [Char] -> [[Char]] -> DecodeResult
DecodeResult Package
pkg [Char]
cabalVersion (ShowS
takeDirectory_ [Char]
file [Char] -> ShowS
</> (Package -> [Char]
packageName Package
pkg [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".cabal")) [[Char]]
warnings

    takeDirectory_ :: FilePath -> FilePath
    takeDirectory_ :: ShowS
takeDirectory_ [Char]
p
      | ShowS
takeFileName [Char]
p [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
p = [Char]
""
      | Bool
otherwise = ShowS
takeDirectory [Char]
p

deleteVerbatimField :: String -> [Verbatim] -> [Verbatim]
deleteVerbatimField :: [Char] -> [Verbatim] -> [Verbatim]
deleteVerbatimField [Char]
name = (Verbatim -> Verbatim) -> [Verbatim] -> [Verbatim]
forall a b. (a -> b) -> [a] -> [b]
map ((Verbatim -> Verbatim) -> [Verbatim] -> [Verbatim])
-> (Verbatim -> Verbatim) -> [Verbatim] -> [Verbatim]
forall a b. (a -> b) -> a -> b
$ \ case
  literal :: Verbatim
literal@VerbatimLiteral {} -> Verbatim
literal
  VerbatimObject Map [Char] VerbatimValue
o -> Map [Char] VerbatimValue -> Verbatim
VerbatimObject ([Char] -> Map [Char] VerbatimValue -> Map [Char] VerbatimValue
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete [Char]
name Map [Char] VerbatimValue
o)

verbatimValueToString :: VerbatimValue -> String
verbatimValueToString :: VerbatimValue -> [Char]
verbatimValueToString = \ case
  VerbatimString [Char]
s -> [Char]
s
  VerbatimNumber Scientific
n -> Scientific -> [Char]
scientificToVersion Scientific
n
  VerbatimBool Bool
b -> Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
b
  VerbatimValue
VerbatimNull -> [Char]
""

addPathsModuleToGeneratedModules  :: Package -> Version -> Package
addPathsModuleToGeneratedModules :: Package -> Version -> Package
addPathsModuleToGeneratedModules Package
pkg Version
cabalVersion
  | Version
cabalVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
makeVersion [Int
2] = Package
pkg
  | Bool
otherwise = Package
pkg {
      packageLibrary = fmap mapLibrary <$> packageLibrary pkg
    , packageInternalLibraries = fmap mapLibrary <$> packageInternalLibraries pkg
    , packageExecutables = fmap mapExecutable <$> packageExecutables pkg
    , packageTests = fmap mapExecutable <$> packageTests pkg
    , packageBenchmarks = fmap mapExecutable <$> packageBenchmarks pkg
    }
  where
    pathsModule :: Module
pathsModule = [Char] -> Module
pathsModuleFromPackageName (Package -> [Char]
packageName Package
pkg)

    mapLibrary :: Library -> Library
    mapLibrary :: Library -> Library
mapLibrary Library
lib
      | Module
pathsModule Module -> [Module] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Library -> [Module]
getLibraryModules Library
lib = Library
lib {
          libraryGeneratedModules = if pathsModule `elem` generatedModules then generatedModules else pathsModule : generatedModules
        }
      | Bool
otherwise = Library
lib
      where
        generatedModules :: [Module]
generatedModules = Library -> [Module]
libraryGeneratedModules Library
lib

    mapExecutable :: Executable -> Executable
    mapExecutable :: Executable -> Executable
mapExecutable Executable
executable
      | Module
pathsModule Module -> [Module] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Executable -> [Module]
executableOtherModules Executable
executable = Executable
executable {
          executableGeneratedModules = if pathsModule `elem` generatedModules then generatedModules else pathsModule : generatedModules
        }
      | Bool
otherwise = Executable
executable
      where
        generatedModules :: [Module]
generatedModules = Executable -> [Module]
executableGeneratedModules Executable
executable

determineCabalVersion :: Maybe (License SPDX.License) -> Package -> (Package, String, Maybe Version)
determineCabalVersion :: Maybe (License License)
-> Package -> (Package, [Char], Maybe Version)
determineCabalVersion Maybe (License License)
inferredLicense pkg :: Package
pkg@Package{[Char]
[[Char]]
[Path]
[Flag]
[Verbatim]
Maybe [Char]
Maybe SourceRepository
Maybe (Section Library)
Maybe CustomSetup
Map [Char] (Section Executable)
Map [Char] (Section Library)
BuildType
packageName :: Package -> [Char]
packageVersion :: Package -> [Char]
packageSynopsis :: Package -> Maybe [Char]
packageDescription :: Package -> Maybe [Char]
packageHomepage :: Package -> Maybe [Char]
packageBugReports :: Package -> Maybe [Char]
packageCategory :: Package -> Maybe [Char]
packageStability :: Package -> Maybe [Char]
packageAuthor :: Package -> [[Char]]
packageMaintainer :: Package -> [[Char]]
packageCopyright :: Package -> [[Char]]
packageBuildType :: Package -> BuildType
packageLicense :: Package -> Maybe [Char]
packageLicenseFile :: Package -> [[Char]]
packageTestedWith :: Package -> [[Char]]
packageFlags :: Package -> [Flag]
packageExtraSourceFiles :: Package -> [Path]
packageExtraDocFiles :: Package -> [Path]
packageDataFiles :: Package -> [Path]
packageDataDir :: Package -> Maybe [Char]
packageSourceRepository :: Package -> Maybe SourceRepository
packageCustomSetup :: Package -> Maybe CustomSetup
packageLibrary :: Package -> Maybe (Section Library)
packageInternalLibraries :: Package -> Map [Char] (Section Library)
packageExecutables :: Package -> Map [Char] (Section Executable)
packageTests :: Package -> Map [Char] (Section Executable)
packageBenchmarks :: Package -> Map [Char] (Section Executable)
packageVerbatim :: Package -> [Verbatim]
packageName :: [Char]
packageVersion :: [Char]
packageSynopsis :: Maybe [Char]
packageDescription :: Maybe [Char]
packageHomepage :: Maybe [Char]
packageBugReports :: Maybe [Char]
packageCategory :: Maybe [Char]
packageStability :: Maybe [Char]
packageAuthor :: [[Char]]
packageMaintainer :: [[Char]]
packageCopyright :: [[Char]]
packageBuildType :: BuildType
packageLicense :: Maybe [Char]
packageLicenseFile :: [[Char]]
packageTestedWith :: [[Char]]
packageFlags :: [Flag]
packageExtraSourceFiles :: [Path]
packageExtraDocFiles :: [Path]
packageDataFiles :: [Path]
packageDataDir :: Maybe [Char]
packageSourceRepository :: Maybe SourceRepository
packageCustomSetup :: Maybe CustomSetup
packageLibrary :: Maybe (Section Library)
packageInternalLibraries :: Map [Char] (Section Library)
packageExecutables :: Map [Char] (Section Executable)
packageTests :: Map [Char] (Section Executable)
packageBenchmarks :: Map [Char] (Section Executable)
packageVerbatim :: [Verbatim]
..} = (
    Package
pkg {
        packageVerbatim = deleteVerbatimField "cabal-version" packageVerbatim
      , packageLicense = formatLicense <$> license
      }
  , [Char]
"cabal-version: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
effectiveCabalVersion [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n\n"
  , [Char] -> Maybe Version
parseVersion [Char]
effectiveCabalVersion
  )
  where
    effectiveCabalVersion :: [Char]
effectiveCabalVersion = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
inferredCabalVersion Maybe [Char]
verbatimCabalVersion

    license :: Maybe (License [Char])
license = (License -> [Char]) -> License License -> License [Char]
forall a b. (a -> b) -> License a -> License b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap License -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (License License -> License [Char])
-> Maybe (License License) -> Maybe (License [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (License License)
parsedLicense Maybe (License License)
-> Maybe (License License) -> Maybe (License License)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (License License)
inferredLicense)

    parsedLicense :: Maybe (License License)
parsedLicense = [Char] -> License License
parseLicense ([Char] -> License License)
-> Maybe [Char] -> Maybe (License License)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
packageLicense

    formatLicense :: License [Char] -> [Char]
formatLicense = \ case
      MustSPDX [Char]
spdx -> [Char]
spdx
      CanSPDX License
_ [Char]
spdx | Version
version Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
makeVersion [Int
2,Int
2] -> [Char]
spdx
      CanSPDX License
cabal [Char]
_ -> License -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow License
cabal
      DontTouch [Char]
original -> [Char]
original

    mustSPDX :: Bool
    mustSPDX :: Bool
mustSPDX = Bool -> (License [Char] -> Bool) -> Maybe (License [Char]) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False License [Char] -> Bool
forall {a}. License a -> Bool
f Maybe (License [Char])
license
      where
        f :: License a -> Bool
f = \case
          DontTouch [Char]
_ -> Bool
False
          CanSPDX License
_ a
_ -> Bool
False
          MustSPDX a
_ -> Bool
True

    verbatimCabalVersion :: Maybe String
    verbatimCabalVersion :: Maybe [Char]
verbatimCabalVersion = [[Char]] -> Maybe [Char]
forall a. [a] -> Maybe a
listToMaybe ((Verbatim -> Maybe [Char]) -> [Verbatim] -> [[Char]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Verbatim -> Maybe [Char]
f [Verbatim]
packageVerbatim)
      where
        f :: Verbatim -> Maybe String
        f :: Verbatim -> Maybe [Char]
f = \ case
          VerbatimLiteral [Char]
_ -> Maybe [Char]
forall a. Maybe a
Nothing
          VerbatimObject Map [Char] VerbatimValue
o -> case [Char] -> Map [Char] VerbatimValue -> Maybe VerbatimValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
"cabal-version" Map [Char] VerbatimValue
o of
            Just VerbatimValue
v -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (VerbatimValue -> [Char]
verbatimValueToString VerbatimValue
v)
            Maybe VerbatimValue
Nothing -> Maybe [Char]
forall a. Maybe a
Nothing

    inferredCabalVersion :: String
    inferredCabalVersion :: [Char]
inferredCabalVersion = Version -> [Char]
showVersion Version
version

    version :: Version
version = Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe ([Int] -> Version
makeVersion [Int
1,Int
12]) (Maybe Version -> Version) -> Maybe Version -> Version
forall a b. (a -> b) -> a -> b
$ [Maybe Version] -> Maybe Version
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [
        Maybe Version
packageCabalVersion
      , Maybe (Section Library)
packageLibrary Maybe (Section Library)
-> (Section Library -> Maybe Version) -> Maybe Version
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Section Library -> Maybe Version
libraryCabalVersion
      , Map [Char] (Section Library) -> Maybe Version
internalLibsCabalVersion Map [Char] (Section Library)
packageInternalLibraries
      , Map [Char] (Section Executable) -> Maybe Version
executablesCabalVersion Map [Char] (Section Executable)
packageExecutables
      , Map [Char] (Section Executable) -> Maybe Version
executablesCabalVersion Map [Char] (Section Executable)
packageTests
      , Map [Char] (Section Executable) -> Maybe Version
executablesCabalVersion Map [Char] (Section Executable)
packageBenchmarks
      ]

    packageCabalVersion :: Maybe Version
    packageCabalVersion :: Maybe Version
packageCabalVersion = [Maybe Version] -> Maybe Version
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [
        Maybe Version
forall a. Maybe a
Nothing
      , [Int] -> Version
makeVersion [Int
2,Int
2] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
mustSPDX
      , [Int] -> Version
makeVersion [Int
1,Int
24] Version -> Maybe CustomSetup -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe CustomSetup
packageCustomSetup
      , [Int] -> Version
makeVersion [Int
1,Int
18] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not ([Path] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path]
packageExtraDocFiles))
      ]

    libraryCabalVersion :: Section Library -> Maybe Version
    libraryCabalVersion :: Section Library -> Maybe Version
libraryCabalVersion Section Library
sect = [Maybe Version] -> Maybe Version
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [
        [Int] -> Version
makeVersion [Int
1,Int
22] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Library -> [[Char]]) -> Bool
forall {t :: * -> *} {a}. Foldable t => (Library -> t a) -> Bool
has Library -> [[Char]]
libraryReexportedModules)
      , [Int] -> Version
makeVersion [Int
2,Int
0]  Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Library -> [[Char]]) -> Bool
forall {t :: * -> *} {a}. Foldable t => (Library -> t a) -> Bool
has Library -> [[Char]]
librarySignatures)
      , [Int] -> Version
makeVersion [Int
2,Int
0] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Library -> [Module]) -> Bool
forall {t :: * -> *} {a}. Foldable t => (Library -> t a) -> Bool
has Library -> [Module]
libraryGeneratedModules)
      , [Int] -> Version
makeVersion [Int
3,Int
0] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Library -> Maybe [Char]) -> Bool
forall {t :: * -> *} {a}. Foldable t => (Library -> t a) -> Bool
has Library -> Maybe [Char]
libraryVisibility)
      , (Section Library -> [Module]) -> Section Library -> Maybe Version
forall a. (Section a -> [Module]) -> Section a -> Maybe Version
sectionCabalVersion ((Library -> [Module]) -> Section Library -> [Module]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Library -> [Module]
getLibraryModules) Section Library
sect
      ]
      where
        has :: (Library -> t a) -> Bool
has Library -> t a
field = (Library -> Bool) -> Section Library -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Library -> Bool) -> Library -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (t a -> Bool) -> (Library -> t a) -> Library -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> t a
field) Section Library
sect

    internalLibsCabalVersion :: Map String (Section Library) -> Maybe Version
    internalLibsCabalVersion :: Map [Char] (Section Library) -> Maybe Version
internalLibsCabalVersion Map [Char] (Section Library)
internalLibraries
      | Map [Char] (Section Library) -> Bool
forall k a. Map k a -> Bool
Map.null Map [Char] (Section Library)
internalLibraries = Maybe Version
forall a. Maybe a
Nothing
      | Bool
otherwise = (Maybe Version -> Maybe Version -> Maybe Version)
-> Maybe Version -> [Maybe Version] -> Maybe Version
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe Version -> Maybe Version -> Maybe Version
forall a. Ord a => a -> a -> a
max (Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Int] -> Version
makeVersion [Int
2,Int
0]) [Maybe Version]
versions
      where
        versions :: [Maybe Version]
versions = Section Library -> Maybe Version
libraryCabalVersion (Section Library -> Maybe Version)
-> [Section Library] -> [Maybe Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Char] (Section Library) -> [Section Library]
forall k a. Map k a -> [a]
Map.elems Map [Char] (Section Library)
internalLibraries

    executablesCabalVersion :: Map String (Section Executable) -> Maybe Version
    executablesCabalVersion :: Map [Char] (Section Executable) -> Maybe Version
executablesCabalVersion = (Maybe Version -> Maybe Version -> Maybe Version)
-> Maybe Version -> [Maybe Version] -> Maybe Version
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe Version -> Maybe Version -> Maybe Version
forall a. Ord a => a -> a -> a
max Maybe Version
forall a. Maybe a
Nothing ([Maybe Version] -> Maybe Version)
-> (Map [Char] (Section Executable) -> [Maybe Version])
-> Map [Char] (Section Executable)
-> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Section Executable -> Maybe Version)
-> [Section Executable] -> [Maybe Version]
forall a b. (a -> b) -> [a] -> [b]
map Section Executable -> Maybe Version
executableCabalVersion ([Section Executable] -> [Maybe Version])
-> (Map [Char] (Section Executable) -> [Section Executable])
-> Map [Char] (Section Executable)
-> [Maybe Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map [Char] (Section Executable) -> [Section Executable]
forall k a. Map k a -> [a]
Map.elems

    executableCabalVersion :: Section Executable -> Maybe Version
    executableCabalVersion :: Section Executable -> Maybe Version
executableCabalVersion Section Executable
sect = [Maybe Version] -> Maybe Version
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [
        [Int] -> Version
makeVersion [Int
2,Int
0] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Section Executable -> Bool
executableHasGeneratedModules Section Executable
sect)
      , (Section Executable -> [Module])
-> Section Executable -> Maybe Version
forall a. (Section a -> [Module]) -> Section a -> Maybe Version
sectionCabalVersion ((Executable -> [Module]) -> Section Executable -> [Module]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Executable -> [Module]
getExecutableModules) Section Executable
sect
      ]

    executableHasGeneratedModules :: Section Executable -> Bool
    executableHasGeneratedModules :: Section Executable -> Bool
executableHasGeneratedModules = (Executable -> Bool) -> Section Executable -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Executable -> Bool) -> Executable -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Module] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Module] -> Bool)
-> (Executable -> [Module]) -> Executable -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> [Module]
executableGeneratedModules)

    sectionCabalVersion :: (Section a -> [Module]) -> Section a -> Maybe Version
    sectionCabalVersion :: forall a. (Section a -> [Module]) -> Section a -> Maybe Version
sectionCabalVersion Section a -> [Module]
getMentionedModules Section a
sect = [Maybe Version] -> Maybe Version
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Maybe Version] -> Maybe Version)
-> [Maybe Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [
        [Int] -> Version
makeVersion [Int
2,Int
2] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Section a -> Bool) -> Section a -> Bool
forall a. (Section a -> Bool) -> Section a -> Bool
sectionSatisfies (Bool -> Bool
not (Bool -> Bool) -> (Section a -> Bool) -> Section a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Path] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Path] -> Bool) -> (Section a -> [Path]) -> Section a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section a -> [Path]
forall a. Section a -> [Path]
sectionCxxSources) Section a
sect)
      , [Int] -> Version
makeVersion [Int
2,Int
2] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Section a -> Bool) -> Section a -> Bool
forall a. (Section a -> Bool) -> Section a -> Bool
sectionSatisfies (Bool -> Bool
not (Bool -> Bool) -> (Section a -> Bool) -> Section a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[Char]] -> Bool) -> (Section a -> [[Char]]) -> Section a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section a -> [[Char]]
forall a. Section a -> [[Char]]
sectionCxxOptions) Section a
sect)
      , [Int] -> Version
makeVersion [Int
3,Int
0] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Section a -> Bool) -> Section a -> Bool
forall a. (Section a -> Bool) -> Section a -> Bool
sectionSatisfies (Bool -> Bool
not (Bool -> Bool) -> (Section a -> Bool) -> Section a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[Char]] -> Bool) -> (Section a -> [[Char]]) -> Section a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section a -> [[Char]]
forall a. Section a -> [[Char]]
sectionAsmOptions) Section a
sect)
      , [Int] -> Version
makeVersion [Int
3,Int
0] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Section a -> Bool) -> Section a -> Bool
forall a. (Section a -> Bool) -> Section a -> Bool
sectionSatisfies (Bool -> Bool
not (Bool -> Bool) -> (Section a -> Bool) -> Section a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Path] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Path] -> Bool) -> (Section a -> [Path]) -> Section a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section a -> [Path]
forall a. Section a -> [Path]
sectionAsmSources) Section a
sect)
      , [Int] -> Version
makeVersion [Int
2,Int
0] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Section a -> Bool) -> Section a -> Bool
forall a. (Section a -> Bool) -> Section a -> Bool
sectionSatisfies ((DependencyInfo -> Bool) -> Map [Char] DependencyInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any DependencyInfo -> Bool
hasMixins (Map [Char] DependencyInfo -> Bool)
-> (Section a -> Map [Char] DependencyInfo) -> Section a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> Map [Char] DependencyInfo
unDependencies (Dependencies -> Map [Char] DependencyInfo)
-> (Section a -> Dependencies)
-> Section a
-> Map [Char] DependencyInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section a -> Dependencies
forall a. Section a -> Dependencies
sectionDependencies) Section a
sect)
      , [Int] -> Version
makeVersion [Int
3,Int
0] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Section a -> Bool) -> Section a -> Bool
forall a. (Section a -> Bool) -> Section a -> Bool
sectionSatisfies (([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [Char] -> Bool
hasSubcomponents ([[Char]] -> Bool) -> (Section a -> [[Char]]) -> Section a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map [Char] DependencyInfo -> [[Char]]
forall k a. Map k a -> [k]
Map.keys (Map [Char] DependencyInfo -> [[Char]])
-> (Section a -> Map [Char] DependencyInfo)
-> Section a
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> Map [Char] DependencyInfo
unDependencies (Dependencies -> Map [Char] DependencyInfo)
-> (Section a -> Dependencies)
-> Section a
-> Map [Char] DependencyInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section a -> Dependencies
forall a. Section a -> Dependencies
sectionDependencies) Section a
sect)
      , [Int] -> Version
makeVersion [Int
2,Int
2] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (
              [Char] -> Bool
uses [Char]
"RebindableSyntax"
          Bool -> Bool -> Bool
&& ([Char] -> Bool
uses [Char]
"OverloadedStrings" Bool -> Bool -> Bool
|| [Char] -> Bool
uses [Char]
"OverloadedLists")
          Bool -> Bool -> Bool
&& Module
pathsModule Module -> [Module] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Section a -> [Module]
getMentionedModules Section a
sect)
      ] [Maybe Version] -> [Maybe Version] -> [Maybe Version]
forall a. [a] -> [a] -> [a]
++ ([Char] -> Maybe Version) -> [[Char]] -> [Maybe Version]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Maybe Version
versionFromSystemBuildTool [[Char]]
systemBuildTools
      where
        defaultExtensions :: [[Char]]
defaultExtensions = (Section a -> [[Char]]) -> Section a -> [[Char]]
forall b a. Monoid b => (Section a -> b) -> Section a -> b
sectionAll Section a -> [[Char]]
forall a. Section a -> [[Char]]
sectionDefaultExtensions Section a
sect
        uses :: [Char] -> Bool
uses = ([Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
defaultExtensions)

        pathsModule :: Module
pathsModule = [Char] -> Module
pathsModuleFromPackageName [Char]
packageName

        versionFromSystemBuildTool :: [Char] -> Maybe Version
versionFromSystemBuildTool [Char]
name
          | [Char]
name [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
known_1_10 = Maybe Version
forall a. Maybe a
Nothing
          | [Char]
name [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
known_1_14 = Version -> Maybe Version
forall a. a -> Maybe a
Just ([Int] -> Version
makeVersion [Int
1,Int
14])
          | [Char]
name [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
known_1_22 = Version -> Maybe Version
forall a. a -> Maybe a
Just ([Int] -> Version
makeVersion [Int
1,Int
22])
          | Bool
otherwise = Version -> Maybe Version
forall a. a -> Maybe a
Just ([Int] -> Version
makeVersion [Int
2,Int
0])

        known_1_10 :: [[Char]]
known_1_10 = [
            [Char]
"ghc"
          , [Char]
"ghc-pkg"
          , [Char]
"hugs"
          , [Char]
"ffihugs"
          , [Char]
"nhc98"
          , [Char]
"hmake"
          , [Char]
"jhc"
          , [Char]
"lhc"
          , [Char]
"lhc-pkg"
          , [Char]
"uhc"
          , [Char]
"gcc"
          , [Char]
"ranlib"
          , [Char]
"ar"
          , [Char]
"strip"
          , [Char]
"ld"
          , [Char]
"tar"
          , [Char]
"pkg-config"
          ] [[Char]] -> [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [a]
\\ [
          -- Support for these build tools has been removed from Cabal at some point
            [Char]
"hugs"
          , [Char]
"ffihugs"
          , [Char]
"nhc98"
          , [Char]
"ranlib"
          , [Char]
"lhc"
          , [Char]
"lhc-pkg"
          ]
        known_1_14 :: [[Char]]
known_1_14 = [
            [Char]
"hpc"
          ]
        known_1_22 :: [[Char]]
known_1_22 = [
            [Char]
"ghcjs"
          , [Char]
"ghcjs-pkg"
          -- , "haskell-suite" // not a real build tool
          -- , "haskell-suite-pkg" // not a real build tool
          ]

        systemBuildTools :: [String]
        systemBuildTools :: [[Char]]
systemBuildTools = Map [Char] VersionConstraint -> [[Char]]
forall k a. Map k a -> [k]
Map.keys (Map [Char] VersionConstraint -> [[Char]])
-> Map [Char] VersionConstraint -> [[Char]]
forall a b. (a -> b) -> a -> b
$ SystemBuildTools -> Map [Char] VersionConstraint
unSystemBuildTools (SystemBuildTools -> Map [Char] VersionConstraint)
-> SystemBuildTools -> Map [Char] VersionConstraint
forall a b. (a -> b) -> a -> b
$ (Section a -> SystemBuildTools) -> Section a -> SystemBuildTools
forall b a. Monoid b => (Section a -> b) -> Section a -> b
sectionAll Section a -> SystemBuildTools
forall a. Section a -> SystemBuildTools
sectionSystemBuildTools Section a
sect

    sectionSatisfies :: (Section a -> Bool) -> Section a -> Bool
    sectionSatisfies :: forall a. (Section a -> Bool) -> Section a -> Bool
sectionSatisfies Section a -> Bool
p Section a
sect = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [
        Section a -> Bool
p Section a
sect
      , (Conditional (Section a) -> Bool)
-> [Conditional (Section a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Section a -> Bool) -> Conditional (Section a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Section a -> Bool) -> Section a -> Bool
forall a. (Section a -> Bool) -> Section a -> Bool
sectionSatisfies Section a -> Bool
p)) (Section a -> [Conditional (Section a)]
forall a. Section a -> [Conditional (Section a)]
sectionConditionals Section a
sect)
      ]

    hasMixins :: DependencyInfo -> Bool
    hasMixins :: DependencyInfo -> Bool
hasMixins (DependencyInfo [[Char]]
mixins DependencyVersion
_) = Bool -> Bool
not ([[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
mixins)

    hasSubcomponents :: String -> Bool
    hasSubcomponents :: [Char] -> Bool
hasSubcomponents = Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
':'

sectionAll :: Monoid b => (Section a -> b) -> Section a -> b
sectionAll :: forall b a. Monoid b => (Section a -> b) -> Section a -> b
sectionAll Section a -> b
f Section a
sect = Section a -> b
f Section a
sect b -> b -> b
forall a. Semigroup a => a -> a -> a
<> (Conditional (Section a) -> b) -> [Conditional (Section a)] -> b
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Section a -> b) -> Conditional (Section a) -> b
forall m a. Monoid m => (a -> m) -> Conditional a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Section a -> b) -> Conditional (Section a) -> b)
-> (Section a -> b) -> Conditional (Section a) -> b
forall a b. (a -> b) -> a -> b
$ (Section a -> b) -> Section a -> b
forall b a. Monoid b => (Section a -> b) -> Section a -> b
sectionAll Section a -> b
f) (Section a -> [Conditional (Section a)]
forall a. Section a -> [Conditional (Section a)]
sectionConditionals Section a
sect)

decodeValue :: (FromValue a, State m, Warnings m, Errors m) => FilePath -> Value -> m a
decodeValue :: forall a (m :: * -> *).
(FromValue a, State m, Warnings m, Errors m) =>
[Char] -> Value -> m a
decodeValue [Char]
file Value
value = do
  (CheckSpecVersion a
r, [[Char]]
unknown, [([Char], [Char])]
deprecated) <- Either
  HpackError (CheckSpecVersion a, [[Char]], [([Char], [Char])])
-> m (CheckSpecVersion a, [[Char]], [([Char], [Char])])
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either
   HpackError (CheckSpecVersion a, [[Char]], [([Char], [Char])])
 -> m (CheckSpecVersion a, [[Char]], [([Char], [Char])]))
-> Either
     HpackError (CheckSpecVersion a, [[Char]], [([Char], [Char])])
-> m (CheckSpecVersion a, [[Char]], [([Char], [Char])])
forall a b. (a -> b) -> a -> b
$ ([Char] -> HpackError)
-> Either [Char] (CheckSpecVersion a, [[Char]], [([Char], [Char])])
-> Either
     HpackError (CheckSpecVersion a, [[Char]], [([Char], [Char])])
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Char] -> [Char] -> HpackError
DecodeValueError [Char]
file) (Value
-> Either [Char] (CheckSpecVersion a, [[Char]], [([Char], [Char])])
forall a. FromValue a => Value -> Result a
Config.decodeValue Value
value)
  case CheckSpecVersion a
r of
    UnsupportedSpecVersion Version
v -> do
      HpackError -> m a
forall a. HpackError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (HpackError -> m a) -> HpackError -> m a
forall a b. (a -> b) -> a -> b
$ [Char] -> Version -> Version -> HpackError
HpackVersionNotSupported [Char]
file Version
v Version
Hpack.version
    SupportedSpecVersion SpecVersion
v a
a -> do
      [[Char]] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
formatUnknownField [[Char]]
unknown)
      [[Char]] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ((([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
formatDeprecatedField [([Char], [Char])]
deprecated)
      (SpecVersion -> SpecVersion) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify ((SpecVersion -> SpecVersion) -> m ())
-> (SpecVersion -> SpecVersion) -> m ()
forall a b. (a -> b) -> a -> b
$ SpecVersion -> SpecVersion -> SpecVersion
forall a. Ord a => a -> a -> a
max SpecVersion
v
      a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  where
    prefix :: String
    prefix :: [Char]
prefix = [Char]
file [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": "

    formatUnknownField :: String -> String
    formatUnknownField :: ShowS
formatUnknownField [Char]
name = [Char]
prefix [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"Ignoring unrecognized field " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
name

    formatDeprecatedField :: (String, String) -> String
    formatDeprecatedField :: ([Char], [Char]) -> [Char]
formatDeprecatedField ([Char]
name, [Char]
substitute) = [Char]
prefix [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
name [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" is deprecated, use " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
substitute [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" instead"

data SpecVersion = NoSpecVersion | SpecVersion Version
  deriving (SpecVersion -> SpecVersion -> Bool
(SpecVersion -> SpecVersion -> Bool)
-> (SpecVersion -> SpecVersion -> Bool) -> Eq SpecVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpecVersion -> SpecVersion -> Bool
== :: SpecVersion -> SpecVersion -> Bool
$c/= :: SpecVersion -> SpecVersion -> Bool
/= :: SpecVersion -> SpecVersion -> Bool
Eq, Int -> SpecVersion -> ShowS
[SpecVersion] -> ShowS
SpecVersion -> [Char]
(Int -> SpecVersion -> ShowS)
-> (SpecVersion -> [Char])
-> ([SpecVersion] -> ShowS)
-> Show SpecVersion
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpecVersion -> ShowS
showsPrec :: Int -> SpecVersion -> ShowS
$cshow :: SpecVersion -> [Char]
show :: SpecVersion -> [Char]
$cshowList :: [SpecVersion] -> ShowS
showList :: [SpecVersion] -> ShowS
Show, Eq SpecVersion
Eq SpecVersion =>
(SpecVersion -> SpecVersion -> Ordering)
-> (SpecVersion -> SpecVersion -> Bool)
-> (SpecVersion -> SpecVersion -> Bool)
-> (SpecVersion -> SpecVersion -> Bool)
-> (SpecVersion -> SpecVersion -> Bool)
-> (SpecVersion -> SpecVersion -> SpecVersion)
-> (SpecVersion -> SpecVersion -> SpecVersion)
-> Ord SpecVersion
SpecVersion -> SpecVersion -> Bool
SpecVersion -> SpecVersion -> Ordering
SpecVersion -> SpecVersion -> SpecVersion
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SpecVersion -> SpecVersion -> Ordering
compare :: SpecVersion -> SpecVersion -> Ordering
$c< :: SpecVersion -> SpecVersion -> Bool
< :: SpecVersion -> SpecVersion -> Bool
$c<= :: SpecVersion -> SpecVersion -> Bool
<= :: SpecVersion -> SpecVersion -> Bool
$c> :: SpecVersion -> SpecVersion -> Bool
> :: SpecVersion -> SpecVersion -> Bool
$c>= :: SpecVersion -> SpecVersion -> Bool
>= :: SpecVersion -> SpecVersion -> Bool
$cmax :: SpecVersion -> SpecVersion -> SpecVersion
max :: SpecVersion -> SpecVersion -> SpecVersion
$cmin :: SpecVersion -> SpecVersion -> SpecVersion
min :: SpecVersion -> SpecVersion -> SpecVersion
Ord)

toSpecVersion :: Maybe ParseSpecVersion -> SpecVersion
toSpecVersion :: Maybe ParseSpecVersion -> SpecVersion
toSpecVersion = SpecVersion
-> (ParseSpecVersion -> SpecVersion)
-> Maybe ParseSpecVersion
-> SpecVersion
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SpecVersion
NoSpecVersion (Version -> SpecVersion
SpecVersion (Version -> SpecVersion)
-> (ParseSpecVersion -> Version) -> ParseSpecVersion -> SpecVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseSpecVersion -> Version
unParseSpecVersion)

data CheckSpecVersion a = SupportedSpecVersion SpecVersion a | UnsupportedSpecVersion Version

instance FromValue a => FromValue (CheckSpecVersion a) where
  fromValue :: Value -> Parser (CheckSpecVersion a)
fromValue = (Object -> Parser (CheckSpecVersion a))
-> Value -> Parser (CheckSpecVersion a)
forall a. (Object -> Parser a) -> Value -> Parser a
withObject ((Object -> Parser (CheckSpecVersion a))
 -> Value -> Parser (CheckSpecVersion a))
-> (Object -> Parser (CheckSpecVersion a))
-> Value
-> Parser (CheckSpecVersion a)
forall a b. (a -> b) -> a -> b
$ \ Object
o -> Object
o Object -> Key -> Parser (Maybe ParseSpecVersion)
forall a. FromValue a => Object -> Key -> Parser (Maybe a)
.:? Key
"spec-version" Parser (Maybe ParseSpecVersion)
-> (Maybe ParseSpecVersion -> Parser (CheckSpecVersion a))
-> Parser (CheckSpecVersion a)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
    Just (ParseSpecVersion Version
v) | Version
Hpack.version Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
v -> CheckSpecVersion a -> Parser (CheckSpecVersion a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (CheckSpecVersion a -> Parser (CheckSpecVersion a))
-> CheckSpecVersion a -> Parser (CheckSpecVersion a)
forall a b. (a -> b) -> a -> b
$ Version -> CheckSpecVersion a
forall a. Version -> CheckSpecVersion a
UnsupportedSpecVersion Version
v
    Maybe ParseSpecVersion
v -> SpecVersion -> a -> CheckSpecVersion a
forall a. SpecVersion -> a -> CheckSpecVersion a
SupportedSpecVersion (Maybe ParseSpecVersion -> SpecVersion
toSpecVersion Maybe ParseSpecVersion
v) (a -> CheckSpecVersion a)
-> Parser a -> Parser (CheckSpecVersion a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromValue a => Value -> Parser a
fromValue (Object -> Value
Object Object
o)

newtype ParseSpecVersion = ParseSpecVersion {ParseSpecVersion -> Version
unParseSpecVersion :: Version}

instance FromValue ParseSpecVersion where
  fromValue :: Value -> Parser ParseSpecVersion
fromValue Value
value = do
    [Char]
s <- case Value
value of
      Number Scientific
n -> [Char] -> Parser [Char]
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Scientific -> [Char]
scientificToVersion Scientific
n)
      String Text
s -> [Char] -> Parser [Char]
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [Char]
T.unpack Text
s)
      Value
_ -> [Char] -> Value -> Parser [Char]
forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
"Number or String" Value
value
    case [Char] -> Maybe Version
parseVersion [Char]
s of
      Just Version
v -> ParseSpecVersion -> Parser ParseSpecVersion
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Version -> ParseSpecVersion
ParseSpecVersion Version
v)
      Maybe Version
Nothing -> [Char] -> Parser ParseSpecVersion
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"invalid value " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
s)

data Package = Package {
  Package -> [Char]
packageName :: String
, Package -> [Char]
packageVersion :: String
, Package -> Maybe [Char]
packageSynopsis :: Maybe String
, Package -> Maybe [Char]
packageDescription :: Maybe String
, Package -> Maybe [Char]
packageHomepage :: Maybe String
, Package -> Maybe [Char]
packageBugReports :: Maybe String
, Package -> Maybe [Char]
packageCategory :: Maybe String
, Package -> Maybe [Char]
packageStability :: Maybe String
, Package -> [[Char]]
packageAuthor :: [String]
, Package -> [[Char]]
packageMaintainer :: [String]
, Package -> [[Char]]
packageCopyright :: [String]
, Package -> BuildType
packageBuildType :: BuildType
, Package -> Maybe [Char]
packageLicense :: Maybe String
, Package -> [[Char]]
packageLicenseFile :: [FilePath]
, Package -> [[Char]]
packageTestedWith :: [String]
, Package -> [Flag]
packageFlags :: [Flag]
, Package -> [Path]
packageExtraSourceFiles :: [Path]
, Package -> [Path]
packageExtraDocFiles :: [Path]
, Package -> [Path]
packageDataFiles :: [Path]
, Package -> Maybe [Char]
packageDataDir :: Maybe FilePath
, Package -> Maybe SourceRepository
packageSourceRepository :: Maybe SourceRepository
, Package -> Maybe CustomSetup
packageCustomSetup :: Maybe CustomSetup
, Package -> Maybe (Section Library)
packageLibrary :: Maybe (Section Library)
, Package -> Map [Char] (Section Library)
packageInternalLibraries :: Map String (Section Library)
, Package -> Map [Char] (Section Executable)
packageExecutables :: Map String (Section Executable)
, Package -> Map [Char] (Section Executable)
packageTests :: Map String (Section Executable)
, Package -> Map [Char] (Section Executable)
packageBenchmarks :: Map String (Section Executable)
, Package -> [Verbatim]
packageVerbatim :: [Verbatim]
} deriving (Package -> Package -> Bool
(Package -> Package -> Bool)
-> (Package -> Package -> Bool) -> Eq Package
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Package -> Package -> Bool
== :: Package -> Package -> Bool
$c/= :: Package -> Package -> Bool
/= :: Package -> Package -> Bool
Eq, Int -> Package -> ShowS
[Package] -> ShowS
Package -> [Char]
(Int -> Package -> ShowS)
-> (Package -> [Char]) -> ([Package] -> ShowS) -> Show Package
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Package -> ShowS
showsPrec :: Int -> Package -> ShowS
$cshow :: Package -> [Char]
show :: Package -> [Char]
$cshowList :: [Package] -> ShowS
showList :: [Package] -> ShowS
Show)

data CustomSetup = CustomSetup {
  CustomSetup -> Dependencies
customSetupDependencies :: Dependencies
} deriving (CustomSetup -> CustomSetup -> Bool
(CustomSetup -> CustomSetup -> Bool)
-> (CustomSetup -> CustomSetup -> Bool) -> Eq CustomSetup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomSetup -> CustomSetup -> Bool
== :: CustomSetup -> CustomSetup -> Bool
$c/= :: CustomSetup -> CustomSetup -> Bool
/= :: CustomSetup -> CustomSetup -> Bool
Eq, Int -> CustomSetup -> ShowS
[CustomSetup] -> ShowS
CustomSetup -> [Char]
(Int -> CustomSetup -> ShowS)
-> (CustomSetup -> [Char])
-> ([CustomSetup] -> ShowS)
-> Show CustomSetup
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomSetup -> ShowS
showsPrec :: Int -> CustomSetup -> ShowS
$cshow :: CustomSetup -> [Char]
show :: CustomSetup -> [Char]
$cshowList :: [CustomSetup] -> ShowS
showList :: [CustomSetup] -> ShowS
Show)

data Library = Library {
  Library -> Maybe Bool
libraryExposed :: Maybe Bool
, Library -> Maybe [Char]
libraryVisibility :: Maybe String
, Library -> [Module]
libraryExposedModules :: [Module]
, Library -> [Module]
libraryOtherModules :: [Module]
, Library -> [Module]
libraryGeneratedModules :: [Module]
, Library -> [[Char]]
libraryReexportedModules :: [String]
, Library -> [[Char]]
librarySignatures :: [String]
} deriving (Library -> Library -> Bool
(Library -> Library -> Bool)
-> (Library -> Library -> Bool) -> Eq Library
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Library -> Library -> Bool
== :: Library -> Library -> Bool
$c/= :: Library -> Library -> Bool
/= :: Library -> Library -> Bool
Eq, Int -> Library -> ShowS
[Library] -> ShowS
Library -> [Char]
(Int -> Library -> ShowS)
-> (Library -> [Char]) -> ([Library] -> ShowS) -> Show Library
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Library -> ShowS
showsPrec :: Int -> Library -> ShowS
$cshow :: Library -> [Char]
show :: Library -> [Char]
$cshowList :: [Library] -> ShowS
showList :: [Library] -> ShowS
Show)

data Executable = Executable {
  Executable -> Maybe [Char]
executableMain :: Maybe FilePath
, Executable -> [Module]
executableOtherModules :: [Module]
, Executable -> [Module]
executableGeneratedModules :: [Module]
} deriving (Executable -> Executable -> Bool
(Executable -> Executable -> Bool)
-> (Executable -> Executable -> Bool) -> Eq Executable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Executable -> Executable -> Bool
== :: Executable -> Executable -> Bool
$c/= :: Executable -> Executable -> Bool
/= :: Executable -> Executable -> Bool
Eq, Int -> Executable -> ShowS
[Executable] -> ShowS
Executable -> [Char]
(Int -> Executable -> ShowS)
-> (Executable -> [Char])
-> ([Executable] -> ShowS)
-> Show Executable
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Executable -> ShowS
showsPrec :: Int -> Executable -> ShowS
$cshow :: Executable -> [Char]
show :: Executable -> [Char]
$cshowList :: [Executable] -> ShowS
showList :: [Executable] -> ShowS
Show)

data BuildTool = BuildTool String String | LocalBuildTool String
  deriving (Int -> BuildTool -> ShowS
[BuildTool] -> ShowS
BuildTool -> [Char]
(Int -> BuildTool -> ShowS)
-> (BuildTool -> [Char])
-> ([BuildTool] -> ShowS)
-> Show BuildTool
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildTool -> ShowS
showsPrec :: Int -> BuildTool -> ShowS
$cshow :: BuildTool -> [Char]
show :: BuildTool -> [Char]
$cshowList :: [BuildTool] -> ShowS
showList :: [BuildTool] -> ShowS
Show, BuildTool -> BuildTool -> Bool
(BuildTool -> BuildTool -> Bool)
-> (BuildTool -> BuildTool -> Bool) -> Eq BuildTool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildTool -> BuildTool -> Bool
== :: BuildTool -> BuildTool -> Bool
$c/= :: BuildTool -> BuildTool -> Bool
/= :: BuildTool -> BuildTool -> Bool
Eq, Eq BuildTool
Eq BuildTool =>
(BuildTool -> BuildTool -> Ordering)
-> (BuildTool -> BuildTool -> Bool)
-> (BuildTool -> BuildTool -> Bool)
-> (BuildTool -> BuildTool -> Bool)
-> (BuildTool -> BuildTool -> Bool)
-> (BuildTool -> BuildTool -> BuildTool)
-> (BuildTool -> BuildTool -> BuildTool)
-> Ord BuildTool
BuildTool -> BuildTool -> Bool
BuildTool -> BuildTool -> Ordering
BuildTool -> BuildTool -> BuildTool
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BuildTool -> BuildTool -> Ordering
compare :: BuildTool -> BuildTool -> Ordering
$c< :: BuildTool -> BuildTool -> Bool
< :: BuildTool -> BuildTool -> Bool
$c<= :: BuildTool -> BuildTool -> Bool
<= :: BuildTool -> BuildTool -> Bool
$c> :: BuildTool -> BuildTool -> Bool
> :: BuildTool -> BuildTool -> Bool
$c>= :: BuildTool -> BuildTool -> Bool
>= :: BuildTool -> BuildTool -> Bool
$cmax :: BuildTool -> BuildTool -> BuildTool
max :: BuildTool -> BuildTool -> BuildTool
$cmin :: BuildTool -> BuildTool -> BuildTool
min :: BuildTool -> BuildTool -> BuildTool
Ord)

data Section a = Section {
  forall a. Section a -> a
sectionData :: a
, forall a. Section a -> [[Char]]
sectionSourceDirs :: [FilePath]
, forall a. Section a -> Dependencies
sectionDependencies :: Dependencies
, forall a. Section a -> [[Char]]
sectionPkgConfigDependencies :: [String]
, forall a. Section a -> [[Char]]
sectionDefaultExtensions :: [String]
, forall a. Section a -> [[Char]]
sectionOtherExtensions :: [String]
, forall a. Section a -> Maybe Language
sectionLanguage :: Maybe Language
, forall a. Section a -> [[Char]]
sectionGhcOptions :: [GhcOption]
, forall a. Section a -> [[Char]]
sectionGhcProfOptions :: [GhcProfOption]
, forall a. Section a -> [[Char]]
sectionGhcSharedOptions :: [GhcOption]
, forall a. Section a -> [[Char]]
sectionGhcjsOptions :: [GhcjsOption]
, forall a. Section a -> [[Char]]
sectionCppOptions :: [CppOption]
, forall a. Section a -> [[Char]]
sectionAsmOptions :: [AsmOption]
, forall a. Section a -> [Path]
sectionAsmSources :: [Path]
, forall a. Section a -> [[Char]]
sectionCcOptions :: [CcOption]
, forall a. Section a -> [Path]
sectionCSources :: [Path]
, forall a. Section a -> [[Char]]
sectionCxxOptions :: [CxxOption]
, forall a. Section a -> [Path]
sectionCxxSources :: [Path]
, forall a. Section a -> [Path]
sectionJsSources :: [Path]
, forall a. Section a -> [[Char]]
sectionExtraLibDirs :: [FilePath]
, forall a. Section a -> [[Char]]
sectionExtraLibraries :: [FilePath]
, forall a. Section a -> [[Char]]
sectionExtraFrameworksDirs :: [FilePath]
, forall a. Section a -> [[Char]]
sectionFrameworks :: [FilePath]
, forall a. Section a -> [[Char]]
sectionIncludeDirs :: [FilePath]
, forall a. Section a -> [[Char]]
sectionInstallIncludes :: [FilePath]
, forall a. Section a -> [[Char]]
sectionLdOptions :: [LdOption]
, forall a. Section a -> Maybe Bool
sectionBuildable :: Maybe Bool
, forall a. Section a -> [Conditional (Section a)]
sectionConditionals :: [Conditional (Section a)]
, forall a. Section a -> Map BuildTool DependencyVersion
sectionBuildTools :: Map BuildTool DependencyVersion
, forall a. Section a -> SystemBuildTools
sectionSystemBuildTools :: SystemBuildTools
, forall a. Section a -> [Verbatim]
sectionVerbatim :: [Verbatim]
} deriving (Section a -> Section a -> Bool
(Section a -> Section a -> Bool)
-> (Section a -> Section a -> Bool) -> Eq (Section a)
forall a. Eq a => Section a -> Section a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Section a -> Section a -> Bool
== :: Section a -> Section a -> Bool
$c/= :: forall a. Eq a => Section a -> Section a -> Bool
/= :: Section a -> Section a -> Bool
Eq, Int -> Section a -> ShowS
[Section a] -> ShowS
Section a -> [Char]
(Int -> Section a -> ShowS)
-> (Section a -> [Char])
-> ([Section a] -> ShowS)
-> Show (Section a)
forall a. Show a => Int -> Section a -> ShowS
forall a. Show a => [Section a] -> ShowS
forall a. Show a => Section a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Section a -> ShowS
showsPrec :: Int -> Section a -> ShowS
$cshow :: forall a. Show a => Section a -> [Char]
show :: Section a -> [Char]
$cshowList :: forall a. Show a => [Section a] -> ShowS
showList :: [Section a] -> ShowS
Show, (forall a b. (a -> b) -> Section a -> Section b)
-> (forall a b. a -> Section b -> Section a) -> Functor Section
forall a b. a -> Section b -> Section a
forall a b. (a -> b) -> Section a -> Section b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Section a -> Section b
fmap :: forall a b. (a -> b) -> Section a -> Section b
$c<$ :: forall a b. a -> Section b -> Section a
<$ :: forall a b. a -> Section b -> Section a
Functor, (forall m. Monoid m => Section m -> m)
-> (forall m a. Monoid m => (a -> m) -> Section a -> m)
-> (forall m a. Monoid m => (a -> m) -> Section a -> m)
-> (forall a b. (a -> b -> b) -> b -> Section a -> b)
-> (forall a b. (a -> b -> b) -> b -> Section a -> b)
-> (forall b a. (b -> a -> b) -> b -> Section a -> b)
-> (forall b a. (b -> a -> b) -> b -> Section a -> b)
-> (forall a. (a -> a -> a) -> Section a -> a)
-> (forall a. (a -> a -> a) -> Section a -> a)
-> (forall a. Section a -> [a])
-> (forall a. Section a -> Bool)
-> (forall a. Section a -> Int)
-> (forall a. Eq a => a -> Section a -> Bool)
-> (forall a. Ord a => Section a -> a)
-> (forall a. Ord a => Section a -> a)
-> (forall a. Num a => Section a -> a)
-> (forall a. Num a => Section a -> a)
-> Foldable Section
forall a. Eq a => a -> Section a -> Bool
forall a. Num a => Section a -> a
forall a. Ord a => Section a -> a
forall m. Monoid m => Section m -> m
forall a. Section a -> Bool
forall a. Section a -> Int
forall a. Section a -> [a]
forall a. (a -> a -> a) -> Section a -> a
forall m a. Monoid m => (a -> m) -> Section a -> m
forall b a. (b -> a -> b) -> b -> Section a -> b
forall a b. (a -> b -> b) -> b -> Section a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Section m -> m
fold :: forall m. Monoid m => Section m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Section a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Section a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Section a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Section a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Section a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Section a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Section a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Section a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Section a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Section a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Section a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Section a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Section a -> a
foldr1 :: forall a. (a -> a -> a) -> Section a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Section a -> a
foldl1 :: forall a. (a -> a -> a) -> Section a -> a
$ctoList :: forall a. Section a -> [a]
toList :: forall a. Section a -> [a]
$cnull :: forall a. Section a -> Bool
null :: forall a. Section a -> Bool
$clength :: forall a. Section a -> Int
length :: forall a. Section a -> Int
$celem :: forall a. Eq a => a -> Section a -> Bool
elem :: forall a. Eq a => a -> Section a -> Bool
$cmaximum :: forall a. Ord a => Section a -> a
maximum :: forall a. Ord a => Section a -> a
$cminimum :: forall a. Ord a => Section a -> a
minimum :: forall a. Ord a => Section a -> a
$csum :: forall a. Num a => Section a -> a
sum :: forall a. Num a => Section a -> a
$cproduct :: forall a. Num a => Section a -> a
product :: forall a. Num a => Section a -> a
Foldable, Functor Section
Foldable Section
(Functor Section, Foldable Section) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Section a -> f (Section b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Section (f a) -> f (Section a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Section a -> m (Section b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Section (m a) -> m (Section a))
-> Traversable Section
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Section (m a) -> m (Section a)
forall (f :: * -> *) a.
Applicative f =>
Section (f a) -> f (Section a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Section a -> m (Section b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Section a -> f (Section b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Section a -> f (Section b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Section a -> f (Section b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Section (f a) -> f (Section a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Section (f a) -> f (Section a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Section a -> m (Section b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Section a -> m (Section b)
$csequence :: forall (m :: * -> *) a. Monad m => Section (m a) -> m (Section a)
sequence :: forall (m :: * -> *) a. Monad m => Section (m a) -> m (Section a)
Traversable)

data Conditional a = Conditional {
  forall a. Conditional a -> Cond
conditionalCondition :: Cond
, forall a. Conditional a -> a
conditionalThen :: a
, forall a. Conditional a -> Maybe a
conditionalElse :: Maybe a
} deriving (Conditional a -> Conditional a -> Bool
(Conditional a -> Conditional a -> Bool)
-> (Conditional a -> Conditional a -> Bool) -> Eq (Conditional a)
forall a. Eq a => Conditional a -> Conditional a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Conditional a -> Conditional a -> Bool
== :: Conditional a -> Conditional a -> Bool
$c/= :: forall a. Eq a => Conditional a -> Conditional a -> Bool
/= :: Conditional a -> Conditional a -> Bool
Eq, Int -> Conditional a -> ShowS
[Conditional a] -> ShowS
Conditional a -> [Char]
(Int -> Conditional a -> ShowS)
-> (Conditional a -> [Char])
-> ([Conditional a] -> ShowS)
-> Show (Conditional a)
forall a. Show a => Int -> Conditional a -> ShowS
forall a. Show a => [Conditional a] -> ShowS
forall a. Show a => Conditional a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Conditional a -> ShowS
showsPrec :: Int -> Conditional a -> ShowS
$cshow :: forall a. Show a => Conditional a -> [Char]
show :: Conditional a -> [Char]
$cshowList :: forall a. Show a => [Conditional a] -> ShowS
showList :: [Conditional a] -> ShowS
Show, (forall a b. (a -> b) -> Conditional a -> Conditional b)
-> (forall a b. a -> Conditional b -> Conditional a)
-> Functor Conditional
forall a b. a -> Conditional b -> Conditional a
forall a b. (a -> b) -> Conditional a -> Conditional b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Conditional a -> Conditional b
fmap :: forall a b. (a -> b) -> Conditional a -> Conditional b
$c<$ :: forall a b. a -> Conditional b -> Conditional a
<$ :: forall a b. a -> Conditional b -> Conditional a
Functor, (forall m. Monoid m => Conditional m -> m)
-> (forall m a. Monoid m => (a -> m) -> Conditional a -> m)
-> (forall m a. Monoid m => (a -> m) -> Conditional a -> m)
-> (forall a b. (a -> b -> b) -> b -> Conditional a -> b)
-> (forall a b. (a -> b -> b) -> b -> Conditional a -> b)
-> (forall b a. (b -> a -> b) -> b -> Conditional a -> b)
-> (forall b a. (b -> a -> b) -> b -> Conditional a -> b)
-> (forall a. (a -> a -> a) -> Conditional a -> a)
-> (forall a. (a -> a -> a) -> Conditional a -> a)
-> (forall a. Conditional a -> [a])
-> (forall a. Conditional a -> Bool)
-> (forall a. Conditional a -> Int)
-> (forall a. Eq a => a -> Conditional a -> Bool)
-> (forall a. Ord a => Conditional a -> a)
-> (forall a. Ord a => Conditional a -> a)
-> (forall a. Num a => Conditional a -> a)
-> (forall a. Num a => Conditional a -> a)
-> Foldable Conditional
forall a. Eq a => a -> Conditional a -> Bool
forall a. Num a => Conditional a -> a
forall a. Ord a => Conditional a -> a
forall m. Monoid m => Conditional m -> m
forall a. Conditional a -> Bool
forall a. Conditional a -> Int
forall a. Conditional a -> [a]
forall a. (a -> a -> a) -> Conditional a -> a
forall m a. Monoid m => (a -> m) -> Conditional a -> m
forall b a. (b -> a -> b) -> b -> Conditional a -> b
forall a b. (a -> b -> b) -> b -> Conditional a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Conditional m -> m
fold :: forall m. Monoid m => Conditional m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Conditional a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Conditional a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Conditional a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Conditional a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Conditional a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Conditional a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Conditional a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Conditional a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Conditional a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Conditional a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Conditional a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Conditional a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Conditional a -> a
foldr1 :: forall a. (a -> a -> a) -> Conditional a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Conditional a -> a
foldl1 :: forall a. (a -> a -> a) -> Conditional a -> a
$ctoList :: forall a. Conditional a -> [a]
toList :: forall a. Conditional a -> [a]
$cnull :: forall a. Conditional a -> Bool
null :: forall a. Conditional a -> Bool
$clength :: forall a. Conditional a -> Int
length :: forall a. Conditional a -> Int
$celem :: forall a. Eq a => a -> Conditional a -> Bool
elem :: forall a. Eq a => a -> Conditional a -> Bool
$cmaximum :: forall a. Ord a => Conditional a -> a
maximum :: forall a. Ord a => Conditional a -> a
$cminimum :: forall a. Ord a => Conditional a -> a
minimum :: forall a. Ord a => Conditional a -> a
$csum :: forall a. Num a => Conditional a -> a
sum :: forall a. Num a => Conditional a -> a
$cproduct :: forall a. Num a => Conditional a -> a
product :: forall a. Num a => Conditional a -> a
Foldable, Functor Conditional
Foldable Conditional
(Functor Conditional, Foldable Conditional) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Conditional a -> f (Conditional b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Conditional (f a) -> f (Conditional a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Conditional a -> m (Conditional b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Conditional (m a) -> m (Conditional a))
-> Traversable Conditional
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Conditional (m a) -> m (Conditional a)
forall (f :: * -> *) a.
Applicative f =>
Conditional (f a) -> f (Conditional a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Conditional a -> m (Conditional b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Conditional a -> f (Conditional b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Conditional a -> f (Conditional b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Conditional a -> f (Conditional b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Conditional (f a) -> f (Conditional a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Conditional (f a) -> f (Conditional a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Conditional a -> m (Conditional b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Conditional a -> m (Conditional b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Conditional (m a) -> m (Conditional a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Conditional (m a) -> m (Conditional a)
Traversable)

data FlagSection = FlagSection {
  FlagSection -> Maybe [Char]
_flagSectionDescription :: Maybe String
, FlagSection -> Bool
_flagSectionManual :: Bool
, FlagSection -> Bool
_flagSectionDefault :: Bool
} deriving (FlagSection -> FlagSection -> Bool
(FlagSection -> FlagSection -> Bool)
-> (FlagSection -> FlagSection -> Bool) -> Eq FlagSection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FlagSection -> FlagSection -> Bool
== :: FlagSection -> FlagSection -> Bool
$c/= :: FlagSection -> FlagSection -> Bool
/= :: FlagSection -> FlagSection -> Bool
Eq, Int -> FlagSection -> ShowS
[FlagSection] -> ShowS
FlagSection -> [Char]
(Int -> FlagSection -> ShowS)
-> (FlagSection -> [Char])
-> ([FlagSection] -> ShowS)
-> Show FlagSection
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FlagSection -> ShowS
showsPrec :: Int -> FlagSection -> ShowS
$cshow :: FlagSection -> [Char]
show :: FlagSection -> [Char]
$cshowList :: [FlagSection] -> ShowS
showList :: [FlagSection] -> ShowS
Show, (forall x. FlagSection -> Rep FlagSection x)
-> (forall x. Rep FlagSection x -> FlagSection)
-> Generic FlagSection
forall x. Rep FlagSection x -> FlagSection
forall x. FlagSection -> Rep FlagSection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FlagSection -> Rep FlagSection x
from :: forall x. FlagSection -> Rep FlagSection x
$cto :: forall x. Rep FlagSection x -> FlagSection
to :: forall x. Rep FlagSection x -> FlagSection
Generic, Value -> Parser FlagSection
(Value -> Parser FlagSection) -> FromValue FlagSection
forall a. (Value -> Parser a) -> FromValue a
$cfromValue :: Value -> Parser FlagSection
fromValue :: Value -> Parser FlagSection
FromValue)

data Flag = Flag {
  Flag -> [Char]
flagName :: String
, Flag -> Maybe [Char]
flagDescription :: Maybe String
, Flag -> Bool
flagManual :: Bool
, Flag -> Bool
flagDefault :: Bool
} deriving (Flag -> Flag -> Bool
(Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> Eq Flag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
/= :: Flag -> Flag -> Bool
Eq, Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> [Char]
(Int -> Flag -> ShowS)
-> (Flag -> [Char]) -> ([Flag] -> ShowS) -> Show Flag
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Flag -> ShowS
showsPrec :: Int -> Flag -> ShowS
$cshow :: Flag -> [Char]
show :: Flag -> [Char]
$cshowList :: [Flag] -> ShowS
showList :: [Flag] -> ShowS
Show)

toFlag :: (String, FlagSection) -> Flag
toFlag :: ([Char], FlagSection) -> Flag
toFlag ([Char]
name, FlagSection Maybe [Char]
description Bool
manual Bool
def) = [Char] -> Maybe [Char] -> Bool -> Bool -> Flag
Flag [Char]
name Maybe [Char]
description Bool
manual Bool
def

data SourceRepository = SourceRepository {
  SourceRepository -> [Char]
sourceRepositoryUrl :: String
, SourceRepository -> Maybe [Char]
sourceRepositorySubdir :: Maybe String
} deriving (SourceRepository -> SourceRepository -> Bool
(SourceRepository -> SourceRepository -> Bool)
-> (SourceRepository -> SourceRepository -> Bool)
-> Eq SourceRepository
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceRepository -> SourceRepository -> Bool
== :: SourceRepository -> SourceRepository -> Bool
$c/= :: SourceRepository -> SourceRepository -> Bool
/= :: SourceRepository -> SourceRepository -> Bool
Eq, Int -> SourceRepository -> ShowS
[SourceRepository] -> ShowS
SourceRepository -> [Char]
(Int -> SourceRepository -> ShowS)
-> (SourceRepository -> [Char])
-> ([SourceRepository] -> ShowS)
-> Show SourceRepository
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceRepository -> ShowS
showsPrec :: Int -> SourceRepository -> ShowS
$cshow :: SourceRepository -> [Char]
show :: SourceRepository -> [Char]
$cshowList :: [SourceRepository] -> ShowS
showList :: [SourceRepository] -> ShowS
Show)

type Config asmSources cSources cxxSources jsSources =
  Product (CommonOptions asmSources cSources cxxSources jsSources Empty) (PackageConfig asmSources cSources cxxSources jsSources)

traverseConfig :: Traversal Config
traverseConfig :: Traversal Config
traverseConfig Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t = (CommonOptions asmSources cSources cxxSources jsSources Empty
 -> m (CommonOptions
         asmSources_ cSources_ cxxSources_ jsSources_ Empty))
-> (PackageConfig asmSources cSources cxxSources jsSources
    -> m (PackageConfig asmSources_ cSources_ cxxSources_ jsSources_))
-> Product
     (CommonOptions asmSources cSources cxxSources jsSources Empty)
     (PackageConfig asmSources cSources cxxSources jsSources)
-> m (Product
        (CommonOptions asmSources_ cSources_ cxxSources_ jsSources_ Empty)
        (PackageConfig asmSources_ cSources_ cxxSources_ jsSources_))
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Product a b -> f (Product c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> CommonOptions asmSources cSources cxxSources jsSources Empty
-> m (CommonOptions
        asmSources_ cSources_ cxxSources_ jsSources_ Empty)
Traversal_ CommonOptions
traverseCommonOptions Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t) (Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
-> PackageConfig asmSources cSources cxxSources jsSources
-> m (PackageConfig asmSources_ cSources_ cxxSources_ jsSources_)
Traversal PackageConfig
traversePackageConfig Traverse
  m
  asmSources
  asmSources_
  cSources
  cSources_
  cxxSources
  cxxSources_
  jsSources
  jsSources_
t)

type ConfigWithDefaults = Product
  (CommonOptionsWithDefaults Empty)
  (PackageConfigWithDefaults ParseAsmSources ParseCSources ParseCxxSources ParseJsSources)

type CommonOptionsWithDefaults a = Product DefaultsConfig (CommonOptions ParseAsmSources ParseCSources ParseCxxSources ParseJsSources a)
type WithCommonOptionsWithDefaults a = Product DefaultsConfig (WithCommonOptions ParseAsmSources ParseCSources ParseCxxSources ParseJsSources a)

toPackage :: FormatYamlParseError -> FilePath -> FilePath -> ConfigWithDefaults -> ConfigM IO (Package, String)
toPackage :: FormatYamlParseError
-> [Char]
-> [Char]
-> ConfigWithDefaults
-> ConfigM IO (Package, [Char])
toPackage FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir =
      FormatYamlParseError
-> [Char]
-> [Char]
-> ConfigWithDefaults
-> StateT
     SpecVersion
     (WriterT [[Char]] (ExceptT HpackError IO))
     (Config
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources)
forall (m :: * -> *).
(MonadIO m, Warnings m, Errors m, State m) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> ConfigWithDefaults
-> m (Config
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources)
expandDefaultsInConfig FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir
  (ConfigWithDefaults
 -> StateT
      SpecVersion
      (WriterT [[Char]] (ExceptT HpackError IO))
      (Config
         ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources))
-> (Config
      ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources
    -> ConfigM IO (Package, [Char]))
-> ConfigWithDefaults
-> ConfigM IO (Package, [Char])
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Language
-> Config
     ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources
-> Config
     ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources
forall {p :: * -> * -> *} {asmSources} {cSources} {cxxSources}
       {jsSources} {a} {c}.
(Bifunctor p, Monoid asmSources, Monoid cSources,
 Monoid cxxSources, Monoid jsSources) =>
Language
-> p (CommonOptions asmSources cSources cxxSources jsSources a) c
-> p (CommonOptions asmSources cSources cxxSources jsSources a) c
setDefaultLanguage Language
"Haskell2010"
  (Config
   ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources
 -> Config
      ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources)
-> (Config
      ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources
    -> ConfigM IO (Package, [Char]))
-> Config
     ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources
-> ConfigM IO (Package, [Char])
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Traverse
  (StateT SpecVersion (WriterT [[Char]] (ExceptT HpackError IO)))
  ParseAsmSources
  [Path]
  ParseAsmSources
  [Path]
  ParseAsmSources
  [Path]
  ParseAsmSources
  [Path]
-> Config
     ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources
-> StateT
     SpecVersion
     (WriterT [[Char]] (ExceptT HpackError IO))
     (Config [Path] [Path] [Path] [Path])
Traversal Config
traverseConfig ([Char]
-> Traverse
     (StateT SpecVersion (WriterT [[Char]] (ExceptT HpackError IO)))
     ParseAsmSources
     [Path]
     ParseAsmSources
     [Path]
     ParseAsmSources
     [Path]
     ParseAsmSources
     [Path]
forall (m :: * -> *).
(MonadIO m, Warnings m) =>
[Char]
-> Traverse
     m
     ParseAsmSources
     [Path]
     ParseAsmSources
     [Path]
     ParseAsmSources
     [Path]
     ParseAsmSources
     [Path]
expandForeignSources [Char]
dir)
  (Config
   ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources
 -> StateT
      SpecVersion
      (WriterT [[Char]] (ExceptT HpackError IO))
      (Config [Path] [Path] [Path] [Path]))
-> (Config [Path] [Path] [Path] [Path]
    -> ConfigM IO (Package, [Char]))
-> Config
     ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources
-> ConfigM IO (Package, [Char])
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Char]
-> Config [Path] [Path] [Path] [Path]
-> ConfigM IO (Package, [Char])
forall (m :: * -> *).
(MonadIO m, Warnings m, State m) =>
[Char] -> Config [Path] [Path] [Path] [Path] -> m (Package, [Char])
toPackage_ [Char]
dir
  where
    setDefaultLanguage :: Language
-> p (CommonOptions asmSources cSources cxxSources jsSources a) c
-> p (CommonOptions asmSources cSources cxxSources jsSources a) c
setDefaultLanguage Language
language p (CommonOptions asmSources cSources cxxSources jsSources a) c
config = (CommonOptions asmSources cSources cxxSources jsSources a
 -> CommonOptions asmSources cSources cxxSources jsSources a)
-> p (CommonOptions asmSources cSources cxxSources jsSources a) c
-> p (CommonOptions asmSources cSources cxxSources jsSources a) c
forall a b c. (a -> b) -> p a c -> p b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources a
forall {a}.
CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources a
setLanguage p (CommonOptions asmSources cSources cxxSources jsSources a) c
config
      where
        setLanguage :: CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources a
setLanguage = (CommonOptions asmSources cSources cxxSources jsSources a
forall a. Monoid a => a
mempty { commonOptionsLanguage = Alias . Last $ Just (Just language) } CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources a
-> CommonOptions asmSources cSources cxxSources jsSources a
forall a. Semigroup a => a -> a -> a
<>)

expandDefaultsInConfig
  :: (MonadIO m, Warnings m, Errors m, State m) =>
     FormatYamlParseError
  -> FilePath
  -> FilePath
  -> ConfigWithDefaults
  -> m (Config ParseAsmSources ParseCSources ParseCxxSources ParseJsSources)
expandDefaultsInConfig :: forall (m :: * -> *).
(MonadIO m, Warnings m, Errors m, State m) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> ConfigWithDefaults
-> m (Config
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources)
expandDefaultsInConfig FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir = (Product
   DefaultsConfig
   (CommonOptions
      ParseAsmSources
      ParseAsmSources
      ParseAsmSources
      ParseAsmSources
      Empty)
 -> m (CommonOptions
         ParseAsmSources
         ParseAsmSources
         ParseAsmSources
         ParseAsmSources
         Empty))
-> (PackageConfig_
      (SectionConfigWithDefaults
         ParseAsmSources
         ParseAsmSources
         ParseAsmSources
         ParseAsmSources
         LibrarySection)
      (SectionConfigWithDefaults
         ParseAsmSources
         ParseAsmSources
         ParseAsmSources
         ParseAsmSources
         ExecutableSection)
    -> m (PackageConfig
            ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources))
-> ConfigWithDefaults
-> m (Config
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Product a b -> f (Product c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (FormatYamlParseError
-> [Char]
-> [Char]
-> Product
     DefaultsConfig
     (CommonOptions
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        Empty)
-> m (CommonOptions
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        Empty)
forall (m :: * -> *).
(MonadIO m, Warnings m, Errors m, State m) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> Product
     DefaultsConfig
     (CommonOptions
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        Empty)
-> m (CommonOptions
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        Empty)
expandGlobalDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir) (FormatYamlParseError
-> [Char]
-> [Char]
-> PackageConfig_
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        LibrarySection)
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ExecutableSection)
-> m (PackageConfig
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources)
forall (m :: * -> *).
(MonadIO m, Warnings m, Errors m, State m) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> PackageConfig_
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        LibrarySection)
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ExecutableSection)
-> m (PackageConfig
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources)
expandSectionDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir)

expandGlobalDefaults
  :: (MonadIO m, Warnings m, Errors m, State m) =>
     FormatYamlParseError
  -> FilePath
  -> FilePath
  -> CommonOptionsWithDefaults Empty
  -> m (CommonOptions ParseAsmSources ParseCSources ParseCxxSources ParseJsSources Empty)
expandGlobalDefaults :: forall (m :: * -> *).
(MonadIO m, Warnings m, Errors m, State m) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> Product
     DefaultsConfig
     (CommonOptions
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        Empty)
-> m (CommonOptions
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        Empty)
expandGlobalDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir = do
  (CommonOptions
   ParseAsmSources
   ParseAsmSources
   ParseAsmSources
   ParseAsmSources
   Empty
 -> Product
      (CommonOptions
         ParseAsmSources
         ParseAsmSources
         ParseAsmSources
         ParseAsmSources
         Empty)
      Empty)
-> Product
     DefaultsConfig
     (CommonOptions
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        Empty)
-> Product
     DefaultsConfig
     (Product
        (CommonOptions
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           Empty)
        Empty)
forall a b.
(a -> b) -> Product DefaultsConfig a -> Product DefaultsConfig b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CommonOptions
  ParseAsmSources
  ParseAsmSources
  ParseAsmSources
  ParseAsmSources
  Empty
-> Empty
-> Product
     (CommonOptions
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        Empty)
     Empty
forall a b. a -> b -> Product a b
`Product` Empty
Empty) (Product
   DefaultsConfig
   (CommonOptions
      ParseAsmSources
      ParseAsmSources
      ParseAsmSources
      ParseAsmSources
      Empty)
 -> Product
      DefaultsConfig
      (Product
         (CommonOptions
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            Empty)
         Empty))
-> (Product
      DefaultsConfig
      (Product
         (CommonOptions
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            Empty)
         Empty)
    -> m (CommonOptions
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            Empty))
-> Product
     DefaultsConfig
     (CommonOptions
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        Empty)
-> m (CommonOptions
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        Empty)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> FormatYamlParseError
-> [Char]
-> [Char]
-> Product
     DefaultsConfig
     (Product
        (CommonOptions
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           Empty)
        Empty)
-> m (Product
        (CommonOptions
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           Empty)
        Empty)
forall a (m :: * -> *).
(MonadIO m, Warnings m, Errors m, State m, FromValue a,
 Monoid a) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> m (WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
expandDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir (Product
   DefaultsConfig
   (Product
      (CommonOptions
         ParseAsmSources
         ParseAsmSources
         ParseAsmSources
         ParseAsmSources
         Empty)
      Empty)
 -> m (Product
         (CommonOptions
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            Empty)
         Empty))
-> (Product
      (CommonOptions
         ParseAsmSources
         ParseAsmSources
         ParseAsmSources
         ParseAsmSources
         Empty)
      Empty
    -> m (CommonOptions
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            Empty))
-> Product
     DefaultsConfig
     (Product
        (CommonOptions
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           Empty)
        Empty)
-> m (CommonOptions
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        Empty)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \ (Product CommonOptions
  ParseAsmSources
  ParseAsmSources
  ParseAsmSources
  ParseAsmSources
  Empty
c Empty
Empty) -> CommonOptions
  ParseAsmSources
  ParseAsmSources
  ParseAsmSources
  ParseAsmSources
  Empty
-> m (CommonOptions
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        Empty)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CommonOptions
  ParseAsmSources
  ParseAsmSources
  ParseAsmSources
  ParseAsmSources
  Empty
c

expandSectionDefaults
  :: (MonadIO m, Warnings m, Errors m, State m) =>
     FormatYamlParseError
  -> FilePath
  -> FilePath
  -> PackageConfigWithDefaults ParseAsmSources ParseCSources ParseCxxSources ParseJsSources
  -> m (PackageConfig ParseAsmSources ParseCSources ParseCxxSources ParseJsSources)
expandSectionDefaults :: forall (m :: * -> *).
(MonadIO m, Warnings m, Errors m, State m) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> PackageConfig_
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        LibrarySection)
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ExecutableSection)
-> m (PackageConfig
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources)
expandSectionDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir p :: PackageConfig_
  (SectionConfigWithDefaults
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     LibrarySection)
  (SectionConfigWithDefaults
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ExecutableSection)
p@PackageConfig{Maybe [Char]
Maybe (Maybe [Char])
Maybe ParseAsmSources
Maybe
  (Map
     [Char]
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ExecutableSection))
Maybe
  (Map
     [Char]
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        LibrarySection))
Maybe (Map [Char] FlagSection)
Maybe
  (SectionConfigWithDefaults
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ExecutableSection)
Maybe
  (SectionConfigWithDefaults
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     LibrarySection)
ParseAsmSources
Maybe GitHub
Maybe PackageVersion
Maybe BuildType
Maybe CustomSetupSection
packageConfigName :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigVersion :: forall library executable.
PackageConfig_ library executable -> Maybe PackageVersion
packageConfigSynopsis :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigDescription :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigHomepage :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigBugReports :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigCategory :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigStability :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigAuthor :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigMaintainer :: forall library executable.
PackageConfig_ library executable -> Maybe ParseAsmSources
packageConfigCopyright :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigBuildType :: forall library executable.
PackageConfig_ library executable -> Maybe BuildType
packageConfigLicense :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigLicenseFile :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigTestedWith :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigFlags :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] FlagSection)
packageConfigExtraSourceFiles :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigExtraDocFiles :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigDataFiles :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigDataDir :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigGithub :: forall library executable.
PackageConfig_ library executable -> Maybe GitHub
packageConfigGit :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigCustomSetup :: forall library executable.
PackageConfig_ library executable -> Maybe CustomSetupSection
packageConfigLibrary :: forall library executable.
PackageConfig_ library executable -> Maybe library
packageConfigInternalLibraries :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] library)
packageConfigExecutable :: forall library executable.
PackageConfig_ library executable -> Maybe executable
packageConfigExecutables :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigTests :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigBenchmarks :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigName :: Maybe [Char]
packageConfigVersion :: Maybe PackageVersion
packageConfigSynopsis :: Maybe [Char]
packageConfigDescription :: Maybe [Char]
packageConfigHomepage :: Maybe (Maybe [Char])
packageConfigBugReports :: Maybe (Maybe [Char])
packageConfigCategory :: Maybe [Char]
packageConfigStability :: Maybe [Char]
packageConfigAuthor :: ParseAsmSources
packageConfigMaintainer :: Maybe ParseAsmSources
packageConfigCopyright :: ParseAsmSources
packageConfigBuildType :: Maybe BuildType
packageConfigLicense :: Maybe (Maybe [Char])
packageConfigLicenseFile :: ParseAsmSources
packageConfigTestedWith :: ParseAsmSources
packageConfigFlags :: Maybe (Map [Char] FlagSection)
packageConfigExtraSourceFiles :: ParseAsmSources
packageConfigExtraDocFiles :: ParseAsmSources
packageConfigDataFiles :: ParseAsmSources
packageConfigDataDir :: Maybe [Char]
packageConfigGithub :: Maybe GitHub
packageConfigGit :: Maybe [Char]
packageConfigCustomSetup :: Maybe CustomSetupSection
packageConfigLibrary :: Maybe
  (SectionConfigWithDefaults
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     LibrarySection)
packageConfigInternalLibraries :: Maybe
  (Map
     [Char]
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        LibrarySection))
packageConfigExecutable :: Maybe
  (SectionConfigWithDefaults
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ExecutableSection)
packageConfigExecutables :: Maybe
  (Map
     [Char]
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ExecutableSection))
packageConfigTests :: Maybe
  (Map
     [Char]
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ExecutableSection))
packageConfigBenchmarks :: Maybe
  (Map
     [Char]
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ExecutableSection))
..} = do
  Maybe
  (Product
     (CommonOptions
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        LibrarySection)
     LibrarySection)
library <- (SectionConfigWithDefaults
   ParseAsmSources
   ParseAsmSources
   ParseAsmSources
   ParseAsmSources
   LibrarySection
 -> m (Product
         (CommonOptions
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            LibrarySection)
         LibrarySection))
-> Maybe
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        LibrarySection)
-> m (Maybe
        (Product
           (CommonOptions
              ParseAsmSources
              ParseAsmSources
              ParseAsmSources
              ParseAsmSources
              LibrarySection)
           LibrarySection))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (FormatYamlParseError
-> [Char]
-> [Char]
-> SectionConfigWithDefaults
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     LibrarySection
-> m (Product
        (CommonOptions
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           LibrarySection)
        LibrarySection)
forall a (m :: * -> *).
(MonadIO m, Warnings m, Errors m, State m, FromValue a,
 Monoid a) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> m (WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
expandDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir) Maybe
  (SectionConfigWithDefaults
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     LibrarySection)
packageConfigLibrary
  Maybe
  (Map
     [Char]
     (Product
        (CommonOptions
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           LibrarySection)
        LibrarySection))
internalLibraries <- (Map
   [Char]
   (SectionConfigWithDefaults
      ParseAsmSources
      ParseAsmSources
      ParseAsmSources
      ParseAsmSources
      LibrarySection)
 -> m (Map
         [Char]
         (Product
            (CommonOptions
               ParseAsmSources
               ParseAsmSources
               ParseAsmSources
               ParseAsmSources
               LibrarySection)
            LibrarySection)))
-> Maybe
     (Map
        [Char]
        (SectionConfigWithDefaults
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           LibrarySection))
-> m (Maybe
        (Map
           [Char]
           (Product
              (CommonOptions
                 ParseAsmSources
                 ParseAsmSources
                 ParseAsmSources
                 ParseAsmSources
                 LibrarySection)
              LibrarySection)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((SectionConfigWithDefaults
   ParseAsmSources
   ParseAsmSources
   ParseAsmSources
   ParseAsmSources
   LibrarySection
 -> m (Product
         (CommonOptions
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            LibrarySection)
         LibrarySection))
-> Map
     [Char]
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        LibrarySection)
-> m (Map
        [Char]
        (Product
           (CommonOptions
              ParseAsmSources
              ParseAsmSources
              ParseAsmSources
              ParseAsmSources
              LibrarySection)
           LibrarySection))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map [Char] a -> f (Map [Char] b)
traverse (FormatYamlParseError
-> [Char]
-> [Char]
-> SectionConfigWithDefaults
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     LibrarySection
-> m (Product
        (CommonOptions
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           LibrarySection)
        LibrarySection)
forall a (m :: * -> *).
(MonadIO m, Warnings m, Errors m, State m, FromValue a,
 Monoid a) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> m (WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
expandDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir)) Maybe
  (Map
     [Char]
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        LibrarySection))
packageConfigInternalLibraries
  Maybe
  (Product
     (CommonOptions
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ExecutableSection)
     ExecutableSection)
executable <- (SectionConfigWithDefaults
   ParseAsmSources
   ParseAsmSources
   ParseAsmSources
   ParseAsmSources
   ExecutableSection
 -> m (Product
         (CommonOptions
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            ExecutableSection)
         ExecutableSection))
-> Maybe
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ExecutableSection)
-> m (Maybe
        (Product
           (CommonOptions
              ParseAsmSources
              ParseAsmSources
              ParseAsmSources
              ParseAsmSources
              ExecutableSection)
           ExecutableSection))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (FormatYamlParseError
-> [Char]
-> [Char]
-> SectionConfigWithDefaults
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ExecutableSection
-> m (Product
        (CommonOptions
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ExecutableSection)
        ExecutableSection)
forall a (m :: * -> *).
(MonadIO m, Warnings m, Errors m, State m, FromValue a,
 Monoid a) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> m (WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
expandDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir) Maybe
  (SectionConfigWithDefaults
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ExecutableSection)
packageConfigExecutable
  Maybe
  (Map
     [Char]
     (Product
        (CommonOptions
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ExecutableSection)
        ExecutableSection))
executables <- (Map
   [Char]
   (SectionConfigWithDefaults
      ParseAsmSources
      ParseAsmSources
      ParseAsmSources
      ParseAsmSources
      ExecutableSection)
 -> m (Map
         [Char]
         (Product
            (CommonOptions
               ParseAsmSources
               ParseAsmSources
               ParseAsmSources
               ParseAsmSources
               ExecutableSection)
            ExecutableSection)))
-> Maybe
     (Map
        [Char]
        (SectionConfigWithDefaults
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ExecutableSection))
-> m (Maybe
        (Map
           [Char]
           (Product
              (CommonOptions
                 ParseAsmSources
                 ParseAsmSources
                 ParseAsmSources
                 ParseAsmSources
                 ExecutableSection)
              ExecutableSection)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((SectionConfigWithDefaults
   ParseAsmSources
   ParseAsmSources
   ParseAsmSources
   ParseAsmSources
   ExecutableSection
 -> m (Product
         (CommonOptions
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            ExecutableSection)
         ExecutableSection))
-> Map
     [Char]
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ExecutableSection)
-> m (Map
        [Char]
        (Product
           (CommonOptions
              ParseAsmSources
              ParseAsmSources
              ParseAsmSources
              ParseAsmSources
              ExecutableSection)
           ExecutableSection))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map [Char] a -> f (Map [Char] b)
traverse (FormatYamlParseError
-> [Char]
-> [Char]
-> SectionConfigWithDefaults
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ExecutableSection
-> m (Product
        (CommonOptions
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ExecutableSection)
        ExecutableSection)
forall a (m :: * -> *).
(MonadIO m, Warnings m, Errors m, State m, FromValue a,
 Monoid a) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> m (WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
expandDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir)) Maybe
  (Map
     [Char]
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ExecutableSection))
packageConfigExecutables
  Maybe
  (Map
     [Char]
     (Product
        (CommonOptions
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ExecutableSection)
        ExecutableSection))
tests <- (Map
   [Char]
   (SectionConfigWithDefaults
      ParseAsmSources
      ParseAsmSources
      ParseAsmSources
      ParseAsmSources
      ExecutableSection)
 -> m (Map
         [Char]
         (Product
            (CommonOptions
               ParseAsmSources
               ParseAsmSources
               ParseAsmSources
               ParseAsmSources
               ExecutableSection)
            ExecutableSection)))
-> Maybe
     (Map
        [Char]
        (SectionConfigWithDefaults
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ExecutableSection))
-> m (Maybe
        (Map
           [Char]
           (Product
              (CommonOptions
                 ParseAsmSources
                 ParseAsmSources
                 ParseAsmSources
                 ParseAsmSources
                 ExecutableSection)
              ExecutableSection)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((SectionConfigWithDefaults
   ParseAsmSources
   ParseAsmSources
   ParseAsmSources
   ParseAsmSources
   ExecutableSection
 -> m (Product
         (CommonOptions
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            ExecutableSection)
         ExecutableSection))
-> Map
     [Char]
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ExecutableSection)
-> m (Map
        [Char]
        (Product
           (CommonOptions
              ParseAsmSources
              ParseAsmSources
              ParseAsmSources
              ParseAsmSources
              ExecutableSection)
           ExecutableSection))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map [Char] a -> f (Map [Char] b)
traverse (FormatYamlParseError
-> [Char]
-> [Char]
-> SectionConfigWithDefaults
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ExecutableSection
-> m (Product
        (CommonOptions
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ExecutableSection)
        ExecutableSection)
forall a (m :: * -> *).
(MonadIO m, Warnings m, Errors m, State m, FromValue a,
 Monoid a) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> m (WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
expandDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir)) Maybe
  (Map
     [Char]
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ExecutableSection))
packageConfigTests
  Maybe
  (Map
     [Char]
     (Product
        (CommonOptions
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ExecutableSection)
        ExecutableSection))
benchmarks <- (Map
   [Char]
   (SectionConfigWithDefaults
      ParseAsmSources
      ParseAsmSources
      ParseAsmSources
      ParseAsmSources
      ExecutableSection)
 -> m (Map
         [Char]
         (Product
            (CommonOptions
               ParseAsmSources
               ParseAsmSources
               ParseAsmSources
               ParseAsmSources
               ExecutableSection)
            ExecutableSection)))
-> Maybe
     (Map
        [Char]
        (SectionConfigWithDefaults
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ExecutableSection))
-> m (Maybe
        (Map
           [Char]
           (Product
              (CommonOptions
                 ParseAsmSources
                 ParseAsmSources
                 ParseAsmSources
                 ParseAsmSources
                 ExecutableSection)
              ExecutableSection)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((SectionConfigWithDefaults
   ParseAsmSources
   ParseAsmSources
   ParseAsmSources
   ParseAsmSources
   ExecutableSection
 -> m (Product
         (CommonOptions
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            ParseAsmSources
            ExecutableSection)
         ExecutableSection))
-> Map
     [Char]
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ExecutableSection)
-> m (Map
        [Char]
        (Product
           (CommonOptions
              ParseAsmSources
              ParseAsmSources
              ParseAsmSources
              ParseAsmSources
              ExecutableSection)
           ExecutableSection))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map [Char] a -> f (Map [Char] b)
traverse (FormatYamlParseError
-> [Char]
-> [Char]
-> SectionConfigWithDefaults
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ExecutableSection
-> m (Product
        (CommonOptions
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ParseAsmSources
           ExecutableSection)
        ExecutableSection)
forall a (m :: * -> *).
(MonadIO m, Warnings m, Errors m, State m, FromValue a,
 Monoid a) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> m (WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
expandDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir)) Maybe
  (Map
     [Char]
     (SectionConfigWithDefaults
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ParseAsmSources
        ExecutableSection))
packageConfigBenchmarks
  PackageConfig
  ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources
-> m (PackageConfig
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return PackageConfig_
  (SectionConfigWithDefaults
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     LibrarySection)
  (SectionConfigWithDefaults
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ParseAsmSources
     ExecutableSection)
p{
      packageConfigLibrary = library
    , packageConfigInternalLibraries = internalLibraries
    , packageConfigExecutable = executable
    , packageConfigExecutables = executables
    , packageConfigTests = tests
    , packageConfigBenchmarks = benchmarks
    }

expandDefaults
  :: forall a m. (MonadIO m, Warnings m, Errors m, State m) =>
     (FromValue a, Monoid a)
  => FormatYamlParseError
  -> FilePath
  -> FilePath
  -> WithCommonOptionsWithDefaults a
  -> m (WithCommonOptions ParseAsmSources ParseCSources ParseCxxSources ParseJsSources a)
expandDefaults :: forall a (m :: * -> *).
(MonadIO m, Warnings m, Errors m, State m, FromValue a,
 Monoid a) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> m (WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
expandDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir = [[Char]]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> m (WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
expand []
  where
    expand ::
         [FilePath]
      -> FilePath
      -> WithCommonOptionsWithDefaults a
      -> m (WithCommonOptions ParseAsmSources ParseCSources ParseCxxSources ParseJsSources a)
    expand :: [[Char]]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> m (WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
expand [[Char]]
seen [Char]
dir (Product DefaultsConfig{Maybe (List Defaults)
defaultsConfigDefaults :: DefaultsConfig -> Maybe (List Defaults)
defaultsConfigDefaults :: Maybe (List Defaults)
..} WithCommonOptions
  ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a
c) = do
      WithCommonOptions
  ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a
d <- [WithCommonOptions
   ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a]
-> WithCommonOptions
     ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a
forall a. Monoid a => [a] -> a
mconcat ([WithCommonOptions
    ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a]
 -> WithCommonOptions
      ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
-> m [WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a]
-> m (WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Defaults
 -> m (WithCommonOptions
         ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a))
-> [Defaults]
-> m [WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([[Char]]
-> [Char]
-> Defaults
-> m (WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
get [[Char]]
seen [Char]
dir) (Maybe (List Defaults) -> [Defaults]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List Defaults)
defaultsConfigDefaults)
      WithCommonOptions
  ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a
-> m (WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (WithCommonOptions
  ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a
d WithCommonOptions
  ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a
-> WithCommonOptions
     ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a
-> WithCommonOptions
     ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a
forall a. Semigroup a => a -> a -> a
<> WithCommonOptions
  ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a
c)

    get ::
         [FilePath]
      -> FilePath
      -> Defaults
      -> m (WithCommonOptions ParseAsmSources ParseCSources ParseCxxSources ParseJsSources a)
    get :: [[Char]]
-> [Char]
-> Defaults
-> m (WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
get [[Char]]
seen [Char]
dir Defaults
defaults = do
      [Char]
file <- IO (Either HpackError [Char]) -> m [Char]
forall (m :: * -> *) a.
(MonadIO m, Errors m) =>
IO (Either HpackError a) -> m a
liftIOEither ([Char] -> [Char] -> Defaults -> IO (Either HpackError [Char])
ensure [Char]
userDataDir [Char]
dir Defaults
defaults)
      [[Char]]
seen_ <- [[Char]] -> [Char] -> m [[Char]]
checkCycle [[Char]]
seen [Char]
file
      let dir_ :: [Char]
dir_ = ShowS
takeDirectory [Char]
file
      FormatYamlParseError
-> [Char] -> m (WithCommonOptionsWithDefaults a)
forall a (m :: * -> *).
(FromValue a, MonadIO m, Warnings m, Errors m, State m) =>
FormatYamlParseError -> [Char] -> m a
decodeYaml FormatYamlParseError
formatYamlParseError [Char]
file m (WithCommonOptionsWithDefaults a)
-> (WithCommonOptionsWithDefaults a
    -> m (WithCommonOptions
            ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a))
-> m (WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [[Char]]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> m (WithCommonOptions
        ParseAsmSources ParseAsmSources ParseAsmSources ParseAsmSources a)
expand [[Char]]
seen_ [Char]
dir_

    checkCycle :: [FilePath] -> FilePath -> m [FilePath]
    checkCycle :: [[Char]] -> [Char] -> m [[Char]]
checkCycle [[Char]]
seen [Char]
file = do
      [Char]
canonic <- IO [Char] -> m [Char]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
canonicalizePath [Char]
file
      let seen_ :: [[Char]]
seen_ = [Char]
canonic [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
seen
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
canonic [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
seen) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        HpackError -> m ()
forall a. HpackError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (HpackError -> m ()) -> HpackError -> m ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> HpackError
CycleInDefaults ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
seen_)
      [[Char]] -> m [[Char]]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]]
seen_

toExecutableMap :: Warnings m => String -> Maybe (Map String a) -> Maybe a -> m (Maybe (Map String a))
toExecutableMap :: forall (m :: * -> *) a.
Warnings m =>
[Char]
-> Maybe (Map [Char] a) -> Maybe a -> m (Maybe (Map [Char] a))
toExecutableMap [Char]
name Maybe (Map [Char] a)
executables Maybe a
mExecutable = do
  case Maybe a
mExecutable of
    Just a
executable -> do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Map [Char] a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Map [Char] a)
executables) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        [[Char]] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[Char]
"Ignoring field \"executables\" in favor of \"executable\""]
      Maybe (Map [Char] a) -> m (Maybe (Map [Char] a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Map [Char] a) -> m (Maybe (Map [Char] a)))
-> Maybe (Map [Char] a) -> m (Maybe (Map [Char] a))
forall a b. (a -> b) -> a -> b
$ Map [Char] a -> Maybe (Map [Char] a)
forall a. a -> Maybe a
Just ([([Char], a)] -> Map [Char] a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [([Char]
name, a
executable)])
    Maybe a
Nothing -> Maybe (Map [Char] a) -> m (Maybe (Map [Char] a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map [Char] a)
executables

type GlobalOptions = CommonOptions AsmSources CSources CxxSources JsSources Empty

toPackage_ :: (MonadIO m, Warnings m, State m) => FilePath -> Product GlobalOptions (PackageConfig AsmSources CSources CxxSources JsSources) -> m (Package, String)
toPackage_ :: forall (m :: * -> *).
(MonadIO m, Warnings m, State m) =>
[Char] -> Config [Path] [Path] [Path] [Path] -> m (Package, [Char])
toPackage_ [Char]
dir (Product GlobalOptions
g PackageConfig{Maybe [Char]
Maybe (Maybe [Char])
Maybe ParseAsmSources
Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] LibrarySection))
Maybe (Map [Char] FlagSection)
Maybe
  (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection)
Maybe
  (WithCommonOptions [Path] [Path] [Path] [Path] LibrarySection)
ParseAsmSources
Maybe GitHub
Maybe PackageVersion
Maybe BuildType
Maybe CustomSetupSection
packageConfigName :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigVersion :: forall library executable.
PackageConfig_ library executable -> Maybe PackageVersion
packageConfigSynopsis :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigDescription :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigHomepage :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigBugReports :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigCategory :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigStability :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigAuthor :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigMaintainer :: forall library executable.
PackageConfig_ library executable -> Maybe ParseAsmSources
packageConfigCopyright :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigBuildType :: forall library executable.
PackageConfig_ library executable -> Maybe BuildType
packageConfigLicense :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigLicenseFile :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigTestedWith :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigFlags :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] FlagSection)
packageConfigExtraSourceFiles :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigExtraDocFiles :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigDataFiles :: forall library executable.
PackageConfig_ library executable -> ParseAsmSources
packageConfigDataDir :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigGithub :: forall library executable.
PackageConfig_ library executable -> Maybe GitHub
packageConfigGit :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigCustomSetup :: forall library executable.
PackageConfig_ library executable -> Maybe CustomSetupSection
packageConfigLibrary :: forall library executable.
PackageConfig_ library executable -> Maybe library
packageConfigInternalLibraries :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] library)
packageConfigExecutable :: forall library executable.
PackageConfig_ library executable -> Maybe executable
packageConfigExecutables :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigTests :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigBenchmarks :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigName :: Maybe [Char]
packageConfigVersion :: Maybe PackageVersion
packageConfigSynopsis :: Maybe [Char]
packageConfigDescription :: Maybe [Char]
packageConfigHomepage :: Maybe (Maybe [Char])
packageConfigBugReports :: Maybe (Maybe [Char])
packageConfigCategory :: Maybe [Char]
packageConfigStability :: Maybe [Char]
packageConfigAuthor :: ParseAsmSources
packageConfigMaintainer :: Maybe ParseAsmSources
packageConfigCopyright :: ParseAsmSources
packageConfigBuildType :: Maybe BuildType
packageConfigLicense :: Maybe (Maybe [Char])
packageConfigLicenseFile :: ParseAsmSources
packageConfigTestedWith :: ParseAsmSources
packageConfigFlags :: Maybe (Map [Char] FlagSection)
packageConfigExtraSourceFiles :: ParseAsmSources
packageConfigExtraDocFiles :: ParseAsmSources
packageConfigDataFiles :: ParseAsmSources
packageConfigDataDir :: Maybe [Char]
packageConfigGithub :: Maybe GitHub
packageConfigGit :: Maybe [Char]
packageConfigCustomSetup :: Maybe CustomSetupSection
packageConfigLibrary :: Maybe
  (WithCommonOptions [Path] [Path] [Path] [Path] LibrarySection)
packageConfigInternalLibraries :: Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] LibrarySection))
packageConfigExecutable :: Maybe
  (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection)
packageConfigExecutables :: Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
packageConfigTests :: Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
packageConfigBenchmarks :: Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
..}) = do
  Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
executableMap <- [Char]
-> Maybe
     (Map
        [Char]
        (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
-> Maybe
     (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection)
-> m (Maybe
        (Map
           [Char]
           (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection)))
forall (m :: * -> *) a.
Warnings m =>
[Char]
-> Maybe (Map [Char] a) -> Maybe a -> m (Maybe (Map [Char] a))
toExecutableMap [Char]
packageName_ Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
packageConfigExecutables Maybe
  (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection)
packageConfigExecutable
  let
    globalVerbatim :: Maybe (List Verbatim)
globalVerbatim = GlobalOptions -> Maybe (List Verbatim)
forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe (List Verbatim)
commonOptionsVerbatim GlobalOptions
g
    globalOptions :: GlobalOptions
globalOptions = GlobalOptions
g {commonOptionsVerbatim = Nothing}

    executableNames :: [[Char]]
executableNames = [[Char]]
-> (Map
      [Char]
      (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection)
    -> [[Char]])
-> Maybe
     (Map
        [Char]
        (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
-> [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Map
  [Char]
  (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection)
-> [[Char]]
forall k a. Map k a -> [k]
Map.keys Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
executableMap

    toSect :: (Warnings m, Monoid a) => WithCommonOptions AsmSources CSources CxxSources JsSources a -> m (Section a)
    toSect :: forall (m :: * -> *) a.
(Warnings m, Monoid a) =>
WithCommonOptions [Path] [Path] [Path] [Path] a -> m (Section a)
toSect = [Char]
-> [[Char]]
-> WithCommonOptions [Path] [Path] [Path] [Path] a
-> m (Section a)
forall a (m :: * -> *).
Warnings m =>
[Char]
-> [[Char]]
-> WithCommonOptions [Path] [Path] [Path] [Path] a
-> m (Section a)
toSection [Char]
packageName_ [[Char]]
executableNames (WithCommonOptions [Path] [Path] [Path] [Path] a -> m (Section a))
-> (WithCommonOptions [Path] [Path] [Path] [Path] a
    -> WithCommonOptions [Path] [Path] [Path] [Path] a)
-> WithCommonOptions [Path] [Path] [Path] [Path] a
-> m (Section a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommonOptions [Path] [Path] [Path] [Path] a
 -> CommonOptions [Path] [Path] [Path] [Path] a)
-> WithCommonOptions [Path] [Path] [Path] [Path] a
-> WithCommonOptions [Path] [Path] [Path] [Path] a
forall a b c. (a -> b) -> Product a c -> Product b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((a
forall a. Monoid a => a
mempty a -> GlobalOptions -> CommonOptions [Path] [Path] [Path] [Path] a
forall a b.
a
-> CommonOptions [Path] [Path] [Path] [Path] b
-> CommonOptions [Path] [Path] [Path] [Path] a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ GlobalOptions
globalOptions) CommonOptions [Path] [Path] [Path] [Path] a
-> CommonOptions [Path] [Path] [Path] [Path] a
-> CommonOptions [Path] [Path] [Path] [Path] a
forall a. Semigroup a => a -> a -> a
<>)

    toSections :: (Warnings m, Monoid a) => Maybe (Map String (WithCommonOptions AsmSources CSources CxxSources JsSources a)) -> m (Map String (Section a))
    toSections :: forall (m :: * -> *) a.
(Warnings m, Monoid a) =>
Maybe
  (Map [Char] (WithCommonOptions [Path] [Path] [Path] [Path] a))
-> m (Map [Char] (Section a))
toSections = m (Map [Char] (Section a))
-> (Map [Char] (WithCommonOptions [Path] [Path] [Path] [Path] a)
    -> m (Map [Char] (Section a)))
-> Maybe
     (Map [Char] (WithCommonOptions [Path] [Path] [Path] [Path] a))
-> m (Map [Char] (Section a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Map [Char] (Section a) -> m (Map [Char] (Section a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Map [Char] (Section a)
forall a. Monoid a => a
mempty) ((WithCommonOptions [Path] [Path] [Path] [Path] a -> m (Section a))
-> Map [Char] (WithCommonOptions [Path] [Path] [Path] [Path] a)
-> m (Map [Char] (Section a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map [Char] a -> f (Map [Char] b)
traverse WithCommonOptions [Path] [Path] [Path] [Path] a -> m (Section a)
forall (m :: * -> *) a.
(Warnings m, Monoid a) =>
WithCommonOptions [Path] [Path] [Path] [Path] a -> m (Section a)
toSect)

    toLib :: Section LibrarySection -> m (Section Library)
toLib = [Char] -> [Char] -> Section LibrarySection -> m (Section Library)
forall (m :: * -> *).
(MonadIO m, State m) =>
[Char] -> [Char] -> Section LibrarySection -> m (Section Library)
toLibrary [Char]
dir [Char]
packageName_
    toExecutables :: Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
-> m (Map [Char] (Section Executable))
toExecutables = Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
-> m (Map [Char] (Section ExecutableSection))
forall (m :: * -> *) a.
(Warnings m, Monoid a) =>
Maybe
  (Map [Char] (WithCommonOptions [Path] [Path] [Path] [Path] a))
-> m (Map [Char] (Section a))
toSections (Maybe
   (Map
      [Char]
      (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
 -> m (Map [Char] (Section ExecutableSection)))
-> (Map [Char] (Section ExecutableSection)
    -> m (Map [Char] (Section Executable)))
-> Maybe
     (Map
        [Char]
        (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
-> m (Map [Char] (Section Executable))
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Section ExecutableSection -> m (Section Executable))
-> Map [Char] (Section ExecutableSection)
-> m (Map [Char] (Section Executable))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map [Char] a -> f (Map [Char] b)
traverse ([Char]
-> [Char] -> Section ExecutableSection -> m (Section Executable)
forall (m :: * -> *).
(MonadIO m, State m) =>
[Char]
-> [Char] -> Section ExecutableSection -> m (Section Executable)
toExecutable [Char]
dir [Char]
packageName_)

  Maybe (Section Library)
mLibrary <- (WithCommonOptions [Path] [Path] [Path] [Path] LibrarySection
 -> m (Section Library))
-> Maybe
     (WithCommonOptions [Path] [Path] [Path] [Path] LibrarySection)
-> m (Maybe (Section Library))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (WithCommonOptions [Path] [Path] [Path] [Path] LibrarySection
-> m (Section LibrarySection)
forall (m :: * -> *) a.
(Warnings m, Monoid a) =>
WithCommonOptions [Path] [Path] [Path] [Path] a -> m (Section a)
toSect (WithCommonOptions [Path] [Path] [Path] [Path] LibrarySection
 -> m (Section LibrarySection))
-> (Section LibrarySection -> m (Section Library))
-> WithCommonOptions [Path] [Path] [Path] [Path] LibrarySection
-> m (Section Library)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Section LibrarySection -> m (Section Library)
toLib) Maybe
  (WithCommonOptions [Path] [Path] [Path] [Path] LibrarySection)
packageConfigLibrary
  Map [Char] (Section Library)
internalLibraries <- Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] LibrarySection))
-> m (Map [Char] (Section LibrarySection))
forall (m :: * -> *) a.
(Warnings m, Monoid a) =>
Maybe
  (Map [Char] (WithCommonOptions [Path] [Path] [Path] [Path] a))
-> m (Map [Char] (Section a))
toSections Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] LibrarySection))
packageConfigInternalLibraries m (Map [Char] (Section LibrarySection))
-> (Map [Char] (Section LibrarySection)
    -> m (Map [Char] (Section Library)))
-> m (Map [Char] (Section Library))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Section LibrarySection -> m (Section Library))
-> Map [Char] (Section LibrarySection)
-> m (Map [Char] (Section Library))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map [Char] a -> f (Map [Char] b)
traverse Section LibrarySection -> m (Section Library)
toLib

  Map [Char] (Section Executable)
executables <- Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
-> m (Map [Char] (Section Executable))
toExecutables Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
executableMap
  Map [Char] (Section Executable)
tests <- Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
-> m (Map [Char] (Section Executable))
toExecutables Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
packageConfigTests
  Map [Char] (Section Executable)
benchmarks <- Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
-> m (Map [Char] (Section Executable))
toExecutables Maybe
  (Map
     [Char]
     (WithCommonOptions [Path] [Path] [Path] [Path] ExecutableSection))
packageConfigBenchmarks

  Bool
licenseFileExists <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist ([Char]
dir [Char] -> ShowS
</> [Char]
"LICENSE")

  [[Char]]
missingSourceDirs <- IO [[Char]] -> m [[Char]]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[Char]] -> m [[Char]]) -> IO [[Char]] -> m [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
nub ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
sort ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Bool -> Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (IO Bool -> IO Bool) -> ([Char] -> IO Bool) -> [Char] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Bool
doesDirectoryExist ([Char] -> IO Bool) -> ShowS -> [Char] -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
dir [Char] -> ShowS
</>)) (
       [[Char]]
-> (Section Library -> [[Char]])
-> Maybe (Section Library)
-> [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Section Library -> [[Char]]
forall a. Section a -> [[Char]]
sectionSourceDirs Maybe (Section Library)
mLibrary
    [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (Section Library -> [[Char]])
-> Map [Char] (Section Library) -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section Library -> [[Char]]
forall a. Section a -> [[Char]]
sectionSourceDirs Map [Char] (Section Library)
internalLibraries
    [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (Section Executable -> [[Char]])
-> Map [Char] (Section Executable) -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section Executable -> [[Char]]
forall a. Section a -> [[Char]]
sectionSourceDirs Map [Char] (Section Executable)
executables
    [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (Section Executable -> [[Char]])
-> Map [Char] (Section Executable) -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section Executable -> [[Char]]
forall a. Section a -> [[Char]]
sectionSourceDirs Map [Char] (Section Executable)
tests
    [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (Section Executable -> [[Char]])
-> Map [Char] (Section Executable) -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section Executable -> [[Char]]
forall a. Section a -> [[Char]]
sectionSourceDirs Map [Char] (Section Executable)
benchmarks
    )

  [Path]
extraSourceFiles <- [Char] -> [Char] -> [[Char]] -> m [Path]
forall (m :: * -> *).
(MonadIO m, Warnings m) =>
[Char] -> [Char] -> [[Char]] -> m [Path]
expandGlobs [Char]
"extra-source-files" [Char]
dir (ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
packageConfigExtraSourceFiles)
  [Path]
extraDocFiles <- [Char] -> [Char] -> [[Char]] -> m [Path]
forall (m :: * -> *).
(MonadIO m, Warnings m) =>
[Char] -> [Char] -> [[Char]] -> m [Path]
expandGlobs [Char]
"extra-doc-files" [Char]
dir (ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
packageConfigExtraDocFiles)

  let dataBaseDir :: [Char]
dataBaseDir = [Char] -> ShowS -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
dir ([Char]
dir [Char] -> ShowS
</>) Maybe [Char]
packageConfigDataDir

  [Path]
dataFiles <- [Char] -> [Char] -> [[Char]] -> m [Path]
forall (m :: * -> *).
(MonadIO m, Warnings m) =>
[Char] -> [Char] -> [[Char]] -> m [Path]
expandGlobs [Char]
"data-files" [Char]
dataBaseDir (ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
packageConfigDataFiles)

  let
    licenseFiles :: [String]
    licenseFiles :: [[Char]]
licenseFiles = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList (ParseAsmSources -> [[Char]]) -> ParseAsmSources -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ParseAsmSources
packageConfigLicenseFile ParseAsmSources -> ParseAsmSources -> ParseAsmSources
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
licenseFileExists
      List [Char] -> ParseAsmSources
forall a. a -> Maybe a
Just ([[Char]] -> List [Char]
forall a. [a] -> List a
List [[Char]
"LICENSE"])

  Maybe (License License)
inferredLicense <- case (Maybe (Maybe [Char])
packageConfigLicense, [[Char]]
licenseFiles) of
    (Maybe (Maybe [Char])
Nothing, [[Char]
file]) -> do
      Maybe [Char]
input <- IO (Maybe [Char]) -> m (Maybe [Char])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO (Maybe [Char])
tryReadFile ([Char]
dir [Char] -> ShowS
</> [Char]
file))
      case Maybe [Char]
input Maybe [Char]
-> ([Char] -> Maybe (License License)) -> Maybe (License License)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe (License License)
inferLicense of
        Maybe (License License)
Nothing -> do
          [[Char]] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[Char]
"Inferring license from file " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" failed!"]
          Maybe (License License) -> m (Maybe (License License))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (License License)
forall a. Maybe a
Nothing
        Maybe (License License)
license -> Maybe (License License) -> m (Maybe (License License))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (License License)
license
    (Maybe (Maybe [Char]), [[Char]])
_ -> Maybe (License License) -> m (Maybe (License License))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (License License)
forall a. Maybe a
Nothing

  let defaultBuildType :: BuildType
      defaultBuildType :: BuildType
defaultBuildType = BuildType
-> (CustomSetup -> BuildType) -> Maybe CustomSetup -> BuildType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BuildType
Simple (BuildType -> CustomSetup -> BuildType
forall a b. a -> b -> a
const BuildType
Custom) Maybe CustomSetup
mCustomSetup

      pkg :: Package
pkg = Package {
        packageName :: [Char]
packageName = [Char]
packageName_
      , packageVersion :: [Char]
packageVersion = [Char]
-> (PackageVersion -> [Char]) -> Maybe PackageVersion -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"0.0.0" PackageVersion -> [Char]
unPackageVersion Maybe PackageVersion
packageConfigVersion
      , packageSynopsis :: Maybe [Char]
packageSynopsis = Maybe [Char]
packageConfigSynopsis
      , packageDescription :: Maybe [Char]
packageDescription = Maybe [Char]
packageConfigDescription
      , packageHomepage :: Maybe [Char]
packageHomepage = Maybe [Char]
homepage
      , packageBugReports :: Maybe [Char]
packageBugReports = Maybe [Char]
bugReports
      , packageCategory :: Maybe [Char]
packageCategory = Maybe [Char]
packageConfigCategory
      , packageStability :: Maybe [Char]
packageStability = Maybe [Char]
packageConfigStability
      , packageAuthor :: [[Char]]
packageAuthor = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
packageConfigAuthor
      , packageMaintainer :: [[Char]]
packageMaintainer = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
maintainer
      , packageCopyright :: [[Char]]
packageCopyright = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
packageConfigCopyright
      , packageBuildType :: BuildType
packageBuildType = BuildType -> Maybe BuildType -> BuildType
forall a. a -> Maybe a -> a
fromMaybe BuildType
defaultBuildType Maybe BuildType
packageConfigBuildType
      , packageLicense :: Maybe [Char]
packageLicense = Maybe (Maybe [Char]) -> Maybe [Char]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe [Char])
packageConfigLicense
      , packageLicenseFile :: [[Char]]
packageLicenseFile = [[Char]]
licenseFiles
      , packageTestedWith :: [[Char]]
packageTestedWith = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
packageConfigTestedWith
      , packageFlags :: [Flag]
packageFlags = [Flag]
flags
      , packageExtraSourceFiles :: [Path]
packageExtraSourceFiles = [Path]
extraSourceFiles
      , packageExtraDocFiles :: [Path]
packageExtraDocFiles = [Path]
extraDocFiles
      , packageDataFiles :: [Path]
packageDataFiles = [Path]
dataFiles
      , packageDataDir :: Maybe [Char]
packageDataDir = Maybe [Char]
packageConfigDataDir
      , packageSourceRepository :: Maybe SourceRepository
packageSourceRepository = Maybe SourceRepository
sourceRepository
      , packageCustomSetup :: Maybe CustomSetup
packageCustomSetup = Maybe CustomSetup
mCustomSetup
      , packageLibrary :: Maybe (Section Library)
packageLibrary = Maybe (Section Library)
mLibrary
      , packageInternalLibraries :: Map [Char] (Section Library)
packageInternalLibraries = Map [Char] (Section Library)
internalLibraries
      , packageExecutables :: Map [Char] (Section Executable)
packageExecutables = Map [Char] (Section Executable)
executables
      , packageTests :: Map [Char] (Section Executable)
packageTests = Map [Char] (Section Executable)
tests
      , packageBenchmarks :: Map [Char] (Section Executable)
packageBenchmarks = Map [Char] (Section Executable)
benchmarks
      , packageVerbatim :: [Verbatim]
packageVerbatim = Maybe (List Verbatim) -> [Verbatim]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List Verbatim)
globalVerbatim
      }

  [[Char]] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[Char]]
nameWarnings
  [[Char]] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([[Char]] -> [[Char]]
formatMissingSourceDirs [[Char]]
missingSourceDirs)

  let (Package
pkg_, [Char]
renderedCabalVersion, Maybe Version
cabalVersion) = Maybe (License License)
-> Package -> (Package, [Char], Maybe Version)
determineCabalVersion Maybe (License License)
inferredLicense Package
pkg
  (Package, [Char]) -> m (Package, [Char])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Package -> (Version -> Package) -> Maybe Version -> Package
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Package
pkg_ (Package -> Version -> Package
addPathsModuleToGeneratedModules Package
pkg_) Maybe Version
cabalVersion, [Char]
renderedCabalVersion)
  where
    nameWarnings :: [String]
    packageName_ :: String
    ([[Char]]
nameWarnings, [Char]
packageName_) = case Maybe [Char]
packageConfigName of
      Maybe [Char]
Nothing -> let inferredName :: [Char]
inferredName = ShowS
takeBaseName [Char]
dir in
        ([[Char]
"Package name not specified, inferred " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
inferredName], [Char]
inferredName)
      Just [Char]
n -> ([], [Char]
n)

    mCustomSetup :: Maybe CustomSetup
    mCustomSetup :: Maybe CustomSetup
mCustomSetup = CustomSetupSection -> CustomSetup
toCustomSetup (CustomSetupSection -> CustomSetup)
-> Maybe CustomSetupSection -> Maybe CustomSetup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CustomSetupSection
packageConfigCustomSetup

    flags :: [Flag]
flags = (([Char], FlagSection) -> Flag)
-> [([Char], FlagSection)] -> [Flag]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], FlagSection) -> Flag
toFlag ([([Char], FlagSection)] -> [Flag])
-> [([Char], FlagSection)] -> [Flag]
forall a b. (a -> b) -> a -> b
$ Maybe (Map [Char] FlagSection) -> [([Char], FlagSection)]
forall a. Maybe (Map [Char] a) -> [([Char], a)]
toList Maybe (Map [Char] FlagSection)
packageConfigFlags

    toList :: Maybe (Map String a) -> [(String, a)]
    toList :: forall a. Maybe (Map [Char] a) -> [([Char], a)]
toList = Map [Char] a -> [([Char], a)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map [Char] a -> [([Char], a)])
-> (Maybe (Map [Char] a) -> Map [Char] a)
-> Maybe (Map [Char] a)
-> [([Char], a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map [Char] a -> Maybe (Map [Char] a) -> Map [Char] a
forall a. a -> Maybe a -> a
fromMaybe Map [Char] a
forall a. Monoid a => a
mempty

    formatMissingSourceDirs :: [[Char]] -> [[Char]]
formatMissingSourceDirs = ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
forall a. Show a => a -> [Char]
f
      where
        f :: a -> [Char]
f a
name = [Char]
"Specified source-dir " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" does not exist"

    sourceRepository :: Maybe SourceRepository
    sourceRepository :: Maybe SourceRepository
sourceRepository = Maybe SourceRepository
github Maybe SourceRepository
-> Maybe SourceRepository -> Maybe SourceRepository
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Char] -> Maybe [Char] -> SourceRepository
`SourceRepository` Maybe [Char]
forall a. Maybe a
Nothing) ([Char] -> SourceRepository)
-> Maybe [Char] -> Maybe SourceRepository
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
packageConfigGit

    github :: Maybe SourceRepository
    github :: Maybe SourceRepository
github = GitHub -> SourceRepository
toSourceRepository (GitHub -> SourceRepository)
-> Maybe GitHub -> Maybe SourceRepository
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GitHub
packageConfigGithub
      where
        toSourceRepository :: GitHub -> SourceRepository
        toSourceRepository :: GitHub -> SourceRepository
toSourceRepository (GitHub [Char]
owner [Char]
repo Maybe [Char]
subdir) = [Char] -> Maybe [Char] -> SourceRepository
SourceRepository ([Char]
githubBaseUrl [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
owner [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"/" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
repo) Maybe [Char]
subdir

    homepage :: Maybe String
    homepage :: Maybe [Char]
homepage = case Maybe (Maybe [Char])
packageConfigHomepage of
      Just Maybe [Char]
Nothing -> Maybe [Char]
forall a. Maybe a
Nothing
      Maybe (Maybe [Char])
_ -> Maybe (Maybe [Char]) -> Maybe [Char]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe [Char])
packageConfigHomepage Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [Char]
fromGithub
      where
        fromGithub :: Maybe [Char]
fromGithub = ([Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"#readme") ShowS -> (SourceRepository -> [Char]) -> SourceRepository -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceRepository -> [Char]
sourceRepositoryUrl (SourceRepository -> [Char])
-> Maybe SourceRepository -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SourceRepository
github

    bugReports :: Maybe String
    bugReports :: Maybe [Char]
bugReports = case Maybe (Maybe [Char])
packageConfigBugReports of
      Just Maybe [Char]
Nothing -> Maybe [Char]
forall a. Maybe a
Nothing
      Maybe (Maybe [Char])
_ -> Maybe (Maybe [Char]) -> Maybe [Char]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe [Char])
packageConfigBugReports Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [Char]
fromGithub
      where
        fromGithub :: Maybe [Char]
fromGithub = ([Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"/issues") ShowS -> (SourceRepository -> [Char]) -> SourceRepository -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceRepository -> [Char]
sourceRepositoryUrl (SourceRepository -> [Char])
-> Maybe SourceRepository -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SourceRepository
github

    maintainer :: Maybe (List String)
    maintainer :: ParseAsmSources
maintainer = case (ParseAsmSources
packageConfigAuthor, Maybe ParseAsmSources
packageConfigMaintainer) of
      (Just List [Char]
_, Maybe ParseAsmSources
Nothing) -> ParseAsmSources
packageConfigAuthor
      (ParseAsmSources
_, Just ParseAsmSources
m) -> ParseAsmSources
m
      (ParseAsmSources, Maybe ParseAsmSources)
_            -> ParseAsmSources
forall a. Maybe a
Nothing

expandForeignSources
  :: (MonadIO m, Warnings m)
  => FilePath
  -> Traverse m ParseAsmSources AsmSources ParseCSources CSources ParseCxxSources CxxSources ParseJsSources JsSources
expandForeignSources :: forall (m :: * -> *).
(MonadIO m, Warnings m) =>
[Char]
-> Traverse
     m
     ParseAsmSources
     [Path]
     ParseAsmSources
     [Path]
     ParseAsmSources
     [Path]
     ParseAsmSources
     [Path]
expandForeignSources [Char]
dir = Traverse {
    traverseAsmSources :: ParseAsmSources -> m [Path]
traverseAsmSources = [Char] -> ParseAsmSources -> m [Path]
forall {m :: * -> *}.
(MonadIO m, Warnings m) =>
[Char] -> ParseAsmSources -> m [Path]
expand [Char]
"asm-sources"
  , traverseCSources :: ParseAsmSources -> m [Path]
traverseCSources = [Char] -> ParseAsmSources -> m [Path]
forall {m :: * -> *}.
(MonadIO m, Warnings m) =>
[Char] -> ParseAsmSources -> m [Path]
expand [Char]
"c-sources"
  , traverseCxxSources :: ParseAsmSources -> m [Path]
traverseCxxSources = [Char] -> ParseAsmSources -> m [Path]
forall {m :: * -> *}.
(MonadIO m, Warnings m) =>
[Char] -> ParseAsmSources -> m [Path]
expand [Char]
"cxx-sources"
  , traverseJsSources :: ParseAsmSources -> m [Path]
traverseJsSources = [Char] -> ParseAsmSources -> m [Path]
forall {m :: * -> *}.
(MonadIO m, Warnings m) =>
[Char] -> ParseAsmSources -> m [Path]
expand [Char]
"js-sources"
  }
  where
    expand :: [Char] -> ParseAsmSources -> m [Path]
expand [Char]
fieldName ParseAsmSources
xs = do
      [Char] -> [Char] -> [[Char]] -> m [Path]
forall (m :: * -> *).
(MonadIO m, Warnings m) =>
[Char] -> [Char] -> [[Char]] -> m [Path]
expandGlobs [Char]
fieldName [Char]
dir (ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
xs)

newtype Path = Path { Path -> [Char]
unPath :: FilePath }
  deriving (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
/= :: Path -> Path -> Bool
Eq, Int -> Path -> ShowS
[Path] -> ShowS
Path -> [Char]
(Int -> Path -> ShowS)
-> (Path -> [Char]) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Path -> ShowS
showsPrec :: Int -> Path -> ShowS
$cshow :: Path -> [Char]
show :: Path -> [Char]
$cshowList :: [Path] -> ShowS
showList :: [Path] -> ShowS
Show, Eq Path
Eq Path =>
(Path -> Path -> Ordering)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Path)
-> (Path -> Path -> Path)
-> Ord Path
Path -> Path -> Bool
Path -> Path -> Ordering
Path -> Path -> Path
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Path -> Path -> Ordering
compare :: Path -> Path -> Ordering
$c< :: Path -> Path -> Bool
< :: Path -> Path -> Bool
$c<= :: Path -> Path -> Bool
<= :: Path -> Path -> Bool
$c> :: Path -> Path -> Bool
> :: Path -> Path -> Bool
$c>= :: Path -> Path -> Bool
>= :: Path -> Path -> Bool
$cmax :: Path -> Path -> Path
max :: Path -> Path -> Path
$cmin :: Path -> Path -> Path
min :: Path -> Path -> Path
Ord)

instance IsString Path where
  fromString :: [Char] -> Path
fromString = [Char] -> Path
Path

expandGlobs :: (MonadIO m, Warnings m) => String -> FilePath -> [String] -> m [Path]
expandGlobs :: forall (m :: * -> *).
(MonadIO m, Warnings m) =>
[Char] -> [Char] -> [[Char]] -> m [Path]
expandGlobs [Char]
name [Char]
dir [[Char]]
patterns = ([Char] -> Path) -> [[Char]] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Path
Path ([[Char]] -> [Path]) -> m [[Char]] -> m [Path]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  ([[Char]]
warnings, [[Char]]
files) <- IO ([[Char]], [[Char]]) -> m ([[Char]], [[Char]])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([[Char]], [[Char]]) -> m ([[Char]], [[Char]]))
-> IO ([[Char]], [[Char]]) -> m ([[Char]], [[Char]])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]] -> IO ([[Char]], [[Char]])
Util.expandGlobs [Char]
name [Char]
dir [[Char]]
patterns
  [[Char]] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[Char]]
warnings
  [[Char]] -> m [[Char]]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]]
files

toCustomSetup :: CustomSetupSection -> CustomSetup
toCustomSetup :: CustomSetupSection -> CustomSetup
toCustomSetup CustomSetupSection{Maybe Dependencies
customSetupSectionDependencies :: CustomSetupSection -> Maybe Dependencies
customSetupSectionDependencies :: Maybe Dependencies
..} = CustomSetup
  { customSetupDependencies :: Dependencies
customSetupDependencies = Dependencies -> Maybe Dependencies -> Dependencies
forall a. a -> Maybe a -> a
fromMaybe Dependencies
forall a. Monoid a => a
mempty Maybe Dependencies
customSetupSectionDependencies }

traverseSectionAndConditionals :: Monad m
  => (acc -> Section a -> m (acc, b))
  -> (acc -> Section a -> m (acc, b))
  -> acc
  -> Section a
  -> m (Section b)
traverseSectionAndConditionals :: forall (m :: * -> *) acc a b.
Monad m =>
(acc -> Section a -> m (acc, b))
-> (acc -> Section a -> m (acc, b))
-> acc
-> Section a
-> m (Section b)
traverseSectionAndConditionals acc -> Section a -> m (acc, b)
fData acc -> Section a -> m (acc, b)
fConditionals acc
acc0 sect :: Section a
sect@Section{a
[[Char]]
[Path]
[Conditional (Section a)]
[Verbatim]
Maybe Bool
Maybe Language
Map BuildTool DependencyVersion
Dependencies
SystemBuildTools
sectionVerbatim :: forall a. Section a -> [Verbatim]
sectionSystemBuildTools :: forall a. Section a -> SystemBuildTools
sectionBuildTools :: forall a. Section a -> Map BuildTool DependencyVersion
sectionConditionals :: forall a. Section a -> [Conditional (Section a)]
sectionBuildable :: forall a. Section a -> Maybe Bool
sectionLdOptions :: forall a. Section a -> [[Char]]
sectionInstallIncludes :: forall a. Section a -> [[Char]]
sectionIncludeDirs :: forall a. Section a -> [[Char]]
sectionFrameworks :: forall a. Section a -> [[Char]]
sectionExtraFrameworksDirs :: forall a. Section a -> [[Char]]
sectionExtraLibraries :: forall a. Section a -> [[Char]]
sectionExtraLibDirs :: forall a. Section a -> [[Char]]
sectionJsSources :: forall a. Section a -> [Path]
sectionCxxSources :: forall a. Section a -> [Path]
sectionCxxOptions :: forall a. Section a -> [[Char]]
sectionCSources :: forall a. Section a -> [Path]
sectionCcOptions :: forall a. Section a -> [[Char]]
sectionAsmSources :: forall a. Section a -> [Path]
sectionAsmOptions :: forall a. Section a -> [[Char]]
sectionCppOptions :: forall a. Section a -> [[Char]]
sectionGhcjsOptions :: forall a. Section a -> [[Char]]
sectionGhcSharedOptions :: forall a. Section a -> [[Char]]
sectionGhcProfOptions :: forall a. Section a -> [[Char]]
sectionGhcOptions :: forall a. Section a -> [[Char]]
sectionLanguage :: forall a. Section a -> Maybe Language
sectionOtherExtensions :: forall a. Section a -> [[Char]]
sectionDefaultExtensions :: forall a. Section a -> [[Char]]
sectionPkgConfigDependencies :: forall a. Section a -> [[Char]]
sectionDependencies :: forall a. Section a -> Dependencies
sectionSourceDirs :: forall a. Section a -> [[Char]]
sectionData :: forall a. Section a -> a
sectionData :: a
sectionSourceDirs :: [[Char]]
sectionDependencies :: Dependencies
sectionPkgConfigDependencies :: [[Char]]
sectionDefaultExtensions :: [[Char]]
sectionOtherExtensions :: [[Char]]
sectionLanguage :: Maybe Language
sectionGhcOptions :: [[Char]]
sectionGhcProfOptions :: [[Char]]
sectionGhcSharedOptions :: [[Char]]
sectionGhcjsOptions :: [[Char]]
sectionCppOptions :: [[Char]]
sectionAsmOptions :: [[Char]]
sectionAsmSources :: [Path]
sectionCcOptions :: [[Char]]
sectionCSources :: [Path]
sectionCxxOptions :: [[Char]]
sectionCxxSources :: [Path]
sectionJsSources :: [Path]
sectionExtraLibDirs :: [[Char]]
sectionExtraLibraries :: [[Char]]
sectionExtraFrameworksDirs :: [[Char]]
sectionFrameworks :: [[Char]]
sectionIncludeDirs :: [[Char]]
sectionInstallIncludes :: [[Char]]
sectionLdOptions :: [[Char]]
sectionBuildable :: Maybe Bool
sectionConditionals :: [Conditional (Section a)]
sectionBuildTools :: Map BuildTool DependencyVersion
sectionSystemBuildTools :: SystemBuildTools
sectionVerbatim :: [Verbatim]
..} = do
  (acc
acc1, b
x) <- acc -> Section a -> m (acc, b)
fData acc
acc0 Section a
sect
  [Conditional (Section b)]
xs <- acc -> [Conditional (Section a)] -> m [Conditional (Section b)]
traverseConditionals acc
acc1 [Conditional (Section a)]
sectionConditionals
  Section b -> m (Section b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Section a
sect{sectionData = x, sectionConditionals = xs}
  where
    traverseConditionals :: acc -> [Conditional (Section a)] -> m [Conditional (Section b)]
traverseConditionals = (Conditional (Section a) -> m (Conditional (Section b)))
-> [Conditional (Section a)] -> m [Conditional (Section b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Conditional (Section a) -> m (Conditional (Section b)))
 -> [Conditional (Section a)] -> m [Conditional (Section b)])
-> (acc -> Conditional (Section a) -> m (Conditional (Section b)))
-> acc
-> [Conditional (Section a)]
-> m [Conditional (Section b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Section a -> m (Section b))
-> Conditional (Section a) -> m (Conditional (Section b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Conditional a -> f (Conditional b)
traverse ((Section a -> m (Section b))
 -> Conditional (Section a) -> m (Conditional (Section b)))
-> (acc -> Section a -> m (Section b))
-> acc
-> Conditional (Section a)
-> m (Conditional (Section b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (acc -> Section a -> m (acc, b))
-> (acc -> Section a -> m (acc, b))
-> acc
-> Section a
-> m (Section b)
forall (m :: * -> *) acc a b.
Monad m =>
(acc -> Section a -> m (acc, b))
-> (acc -> Section a -> m (acc, b))
-> acc
-> Section a
-> m (Section b)
traverseSectionAndConditionals acc -> Section a -> m (acc, b)
fConditionals acc -> Section a -> m (acc, b)
fConditionals

getMentionedLibraryModules :: LibrarySection -> [Module]
getMentionedLibraryModules :: LibrarySection -> [Module]
getMentionedLibraryModules (LibrarySection Maybe Bool
_ Maybe [Char]
_ Maybe (List Module)
exposedModules Maybe (List Module)
generatedExposedModules Maybe (List Module)
otherModules Maybe (List Module)
generatedOtherModules ParseAsmSources
_ ParseAsmSources
_)
  = Maybe (List Module) -> [Module]
forall a. Maybe (List a) -> [a]
fromMaybeList (Maybe (List Module)
exposedModules Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> Maybe (List Module)
generatedExposedModules Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> Maybe (List Module)
otherModules Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> Maybe (List Module)
generatedOtherModules)

getLibraryModules :: Library -> [Module]
getLibraryModules :: Library -> [Module]
getLibraryModules Library{[[Char]]
[Module]
Maybe Bool
Maybe [Char]
libraryGeneratedModules :: Library -> [Module]
libraryReexportedModules :: Library -> [[Char]]
librarySignatures :: Library -> [[Char]]
libraryVisibility :: Library -> Maybe [Char]
libraryExposed :: Library -> Maybe Bool
libraryExposedModules :: Library -> [Module]
libraryOtherModules :: Library -> [Module]
libraryExposed :: Maybe Bool
libraryVisibility :: Maybe [Char]
libraryExposedModules :: [Module]
libraryOtherModules :: [Module]
libraryGeneratedModules :: [Module]
libraryReexportedModules :: [[Char]]
librarySignatures :: [[Char]]
..} = [Module]
libraryExposedModules [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ [Module]
libraryOtherModules

getExecutableModules :: Executable -> [Module]
getExecutableModules :: Executable -> [Module]
getExecutableModules Executable{[Module]
Maybe [Char]
executableOtherModules :: Executable -> [Module]
executableGeneratedModules :: Executable -> [Module]
executableMain :: Executable -> Maybe [Char]
executableMain :: Maybe [Char]
executableOtherModules :: [Module]
executableGeneratedModules :: [Module]
..} = [Module]
executableOtherModules

listModules :: FilePath -> Section a -> IO [Module]
listModules :: forall a. [Char] -> Section a -> IO [Module]
listModules [Char]
dir Section{a
[[Char]]
[Path]
[Conditional (Section a)]
[Verbatim]
Maybe Bool
Maybe Language
Map BuildTool DependencyVersion
Dependencies
SystemBuildTools
sectionVerbatim :: forall a. Section a -> [Verbatim]
sectionSystemBuildTools :: forall a. Section a -> SystemBuildTools
sectionBuildTools :: forall a. Section a -> Map BuildTool DependencyVersion
sectionConditionals :: forall a. Section a -> [Conditional (Section a)]
sectionBuildable :: forall a. Section a -> Maybe Bool
sectionLdOptions :: forall a. Section a -> [[Char]]
sectionInstallIncludes :: forall a. Section a -> [[Char]]
sectionIncludeDirs :: forall a. Section a -> [[Char]]
sectionFrameworks :: forall a. Section a -> [[Char]]
sectionExtraFrameworksDirs :: forall a. Section a -> [[Char]]
sectionExtraLibraries :: forall a. Section a -> [[Char]]
sectionExtraLibDirs :: forall a. Section a -> [[Char]]
sectionJsSources :: forall a. Section a -> [Path]
sectionCxxSources :: forall a. Section a -> [Path]
sectionCxxOptions :: forall a. Section a -> [[Char]]
sectionCSources :: forall a. Section a -> [Path]
sectionCcOptions :: forall a. Section a -> [[Char]]
sectionAsmSources :: forall a. Section a -> [Path]
sectionAsmOptions :: forall a. Section a -> [[Char]]
sectionCppOptions :: forall a. Section a -> [[Char]]
sectionGhcjsOptions :: forall a. Section a -> [[Char]]
sectionGhcSharedOptions :: forall a. Section a -> [[Char]]
sectionGhcProfOptions :: forall a. Section a -> [[Char]]
sectionGhcOptions :: forall a. Section a -> [[Char]]
sectionLanguage :: forall a. Section a -> Maybe Language
sectionOtherExtensions :: forall a. Section a -> [[Char]]
sectionDefaultExtensions :: forall a. Section a -> [[Char]]
sectionPkgConfigDependencies :: forall a. Section a -> [[Char]]
sectionDependencies :: forall a. Section a -> Dependencies
sectionSourceDirs :: forall a. Section a -> [[Char]]
sectionData :: forall a. Section a -> a
sectionData :: a
sectionSourceDirs :: [[Char]]
sectionDependencies :: Dependencies
sectionPkgConfigDependencies :: [[Char]]
sectionDefaultExtensions :: [[Char]]
sectionOtherExtensions :: [[Char]]
sectionLanguage :: Maybe Language
sectionGhcOptions :: [[Char]]
sectionGhcProfOptions :: [[Char]]
sectionGhcSharedOptions :: [[Char]]
sectionGhcjsOptions :: [[Char]]
sectionCppOptions :: [[Char]]
sectionAsmOptions :: [[Char]]
sectionAsmSources :: [Path]
sectionCcOptions :: [[Char]]
sectionCSources :: [Path]
sectionCxxOptions :: [[Char]]
sectionCxxSources :: [Path]
sectionJsSources :: [Path]
sectionExtraLibDirs :: [[Char]]
sectionExtraLibraries :: [[Char]]
sectionExtraFrameworksDirs :: [[Char]]
sectionFrameworks :: [[Char]]
sectionIncludeDirs :: [[Char]]
sectionInstallIncludes :: [[Char]]
sectionLdOptions :: [[Char]]
sectionBuildable :: Maybe Bool
sectionConditionals :: [Conditional (Section a)]
sectionBuildTools :: Map BuildTool DependencyVersion
sectionSystemBuildTools :: SystemBuildTools
sectionVerbatim :: [Verbatim]
..} = [[Module]] -> [Module]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Module]] -> [Module]) -> IO [[Module]] -> IO [Module]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> IO [Module]) -> [[Char]] -> IO [[Module]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Char] -> [Char] -> IO [Module]
getModules [Char]
dir) [[Char]]
sectionSourceDirs

removeConditionalsThatAreAlwaysFalse :: Section a -> Section a
removeConditionalsThatAreAlwaysFalse :: forall a. Section a -> Section a
removeConditionalsThatAreAlwaysFalse Section a
sect = Section a
sect {
    sectionConditionals = filter p $ sectionConditionals sect
  }
  where
    p :: Conditional a -> Bool
p = (Cond -> Cond -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Cond
CondBool Bool
False) (Cond -> Bool) -> (Conditional a -> Cond) -> Conditional a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conditional a -> Cond
forall a. Conditional a -> Cond
conditionalCondition

inferModules :: (MonadIO m, State m) =>
     FilePath
  -> String
  -> (a -> [Module])
  -> (b -> [Module])
  -> ([Module] -> [Module] -> a -> b)
  -> ([Module] -> a -> b)
  -> Section a
  -> m (Section b)
inferModules :: forall (m :: * -> *) a b.
(MonadIO m, State m) =>
[Char]
-> [Char]
-> (a -> [Module])
-> (b -> [Module])
-> ([Module] -> [Module] -> a -> b)
-> ([Module] -> a -> b)
-> Section a
-> m (Section b)
inferModules [Char]
dir [Char]
packageName_ a -> [Module]
getMentionedModules b -> [Module]
getInferredModules [Module] -> [Module] -> a -> b
fromData [Module] -> a -> b
fromConditionals Section a
sect_ = do
  SpecVersion
specVersion <- m SpecVersion
forall s (m :: * -> *). MonadState s m => m s
State.get
  let
    pathsModule :: [Module]
    pathsModule :: [Module]
pathsModule = case SpecVersion
specVersion of
      SpecVersion Version
v | Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
makeVersion [Int
0,Int
36,Int
0] -> []
      SpecVersion
_ -> [[Char] -> Module
pathsModuleFromPackageName [Char]
packageName_]

  Section b -> Section b
forall a. Section a -> Section a
removeConditionalsThatAreAlwaysFalse (Section b -> Section b) -> m (Section b) -> m (Section b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Module] -> Section a -> m ([Module], b))
-> ([Module] -> Section a -> m ([Module], b))
-> [Module]
-> Section a
-> m (Section b)
forall (m :: * -> *) acc a b.
Monad m =>
(acc -> Section a -> m (acc, b))
-> (acc -> Section a -> m (acc, b))
-> acc
-> Section a
-> m (Section b)
traverseSectionAndConditionals
    (([Module] -> [Module] -> a -> b)
-> [Module] -> [Module] -> Section a -> m ([Module], b)
forall {m :: * -> *}.
MonadIO m =>
([Module] -> [Module] -> a -> b)
-> [Module] -> [Module] -> Section a -> m ([Module], b)
fromConfigSection [Module] -> [Module] -> a -> b
fromData [Module]
pathsModule)
    (([Module] -> [Module] -> a -> b)
-> [Module] -> [Module] -> Section a -> m ([Module], b)
forall {m :: * -> *}.
MonadIO m =>
([Module] -> [Module] -> a -> b)
-> [Module] -> [Module] -> Section a -> m ([Module], b)
fromConfigSection (\ [] -> [Module] -> a -> b
fromConditionals) [])
    []
    Section a
sect_
  where
    fromConfigSection :: ([Module] -> [Module] -> a -> b)
-> [Module] -> [Module] -> Section a -> m ([Module], b)
fromConfigSection [Module] -> [Module] -> a -> b
fromConfig [Module]
pathsModule_ [Module]
outerModules sect :: Section a
sect@Section{sectionData :: forall a. Section a -> a
sectionData = a
conf} = do
      [Module]
modules <- IO [Module] -> m [Module]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Module] -> m [Module]) -> IO [Module] -> m [Module]
forall a b. (a -> b) -> a -> b
$ [Char] -> Section a -> IO [Module]
forall a. [Char] -> Section a -> IO [Module]
listModules [Char]
dir Section a
sect
      let
        mentionedModules :: [Module]
mentionedModules = (a -> [Module]) -> Section a -> [Module]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap a -> [Module]
getMentionedModules Section a
sect
        inferableModules :: [Module]
inferableModules = ([Module]
modules [Module] -> [Module] -> [Module]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Module]
outerModules) [Module] -> [Module] -> [Module]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Module]
mentionedModules
        pathsModule :: [Module]
pathsModule = ([Module]
pathsModule_ [Module] -> [Module] -> [Module]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Module]
outerModules) [Module] -> [Module] -> [Module]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Module]
mentionedModules
        r :: b
r = [Module] -> [Module] -> a -> b
fromConfig [Module]
pathsModule [Module]
inferableModules a
conf
      ([Module], b) -> m ([Module], b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Module]
outerModules [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ b -> [Module]
getInferredModules b
r, b
r)

toLibrary :: (MonadIO m, State m) => FilePath -> String -> Section LibrarySection -> m (Section Library)
toLibrary :: forall (m :: * -> *).
(MonadIO m, State m) =>
[Char] -> [Char] -> Section LibrarySection -> m (Section Library)
toLibrary [Char]
dir [Char]
name =
    [Char]
-> [Char]
-> (LibrarySection -> [Module])
-> (Library -> [Module])
-> ([Module] -> [Module] -> LibrarySection -> Library)
-> ([Module] -> LibrarySection -> Library)
-> Section LibrarySection
-> m (Section Library)
forall (m :: * -> *) a b.
(MonadIO m, State m) =>
[Char]
-> [Char]
-> (a -> [Module])
-> (b -> [Module])
-> ([Module] -> [Module] -> a -> b)
-> ([Module] -> a -> b)
-> Section a
-> m (Section b)
inferModules [Char]
dir [Char]
name LibrarySection -> [Module]
getMentionedLibraryModules Library -> [Module]
getLibraryModules [Module] -> [Module] -> LibrarySection -> Library
fromLibrarySectionTopLevel [Module] -> LibrarySection -> Library
fromLibrarySectionInConditional
  where
    fromLibrarySectionTopLevel :: [Module] -> [Module] -> LibrarySection -> Library
    fromLibrarySectionTopLevel :: [Module] -> [Module] -> LibrarySection -> Library
fromLibrarySectionTopLevel [Module]
pathsModule [Module]
inferableModules LibrarySection{Maybe Bool
Maybe [Char]
ParseAsmSources
Maybe (List Module)
librarySectionExposed :: LibrarySection -> Maybe Bool
librarySectionVisibility :: LibrarySection -> Maybe [Char]
librarySectionExposedModules :: LibrarySection -> Maybe (List Module)
librarySectionGeneratedExposedModules :: LibrarySection -> Maybe (List Module)
librarySectionOtherModules :: LibrarySection -> Maybe (List Module)
librarySectionGeneratedOtherModules :: LibrarySection -> Maybe (List Module)
librarySectionReexportedModules :: LibrarySection -> ParseAsmSources
librarySectionSignatures :: LibrarySection -> ParseAsmSources
librarySectionExposed :: Maybe Bool
librarySectionVisibility :: Maybe [Char]
librarySectionExposedModules :: Maybe (List Module)
librarySectionGeneratedExposedModules :: Maybe (List Module)
librarySectionOtherModules :: Maybe (List Module)
librarySectionGeneratedOtherModules :: Maybe (List Module)
librarySectionReexportedModules :: ParseAsmSources
librarySectionSignatures :: ParseAsmSources
..} =
      Maybe Bool
-> Maybe [Char]
-> [Module]
-> [Module]
-> [Module]
-> [[Char]]
-> [[Char]]
-> Library
Library Maybe Bool
librarySectionExposed Maybe [Char]
librarySectionVisibility [Module]
exposedModules [Module]
otherModules [Module]
generatedModules [[Char]]
reexportedModules [[Char]]
signatures
      where
        ([Module]
exposedModules, [Module]
otherModules, [Module]
generatedModules) =
          [Module]
-> [Module]
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List Module)
-> ([Module], [Module], [Module])
determineModules [Module]
pathsModule [Module]
inferableModules Maybe (List Module)
librarySectionExposedModules Maybe (List Module)
librarySectionGeneratedExposedModules Maybe (List Module)
librarySectionOtherModules Maybe (List Module)
librarySectionGeneratedOtherModules
        reexportedModules :: [[Char]]
reexportedModules = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
librarySectionReexportedModules
        signatures :: [[Char]]
signatures = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
librarySectionSignatures

determineModules :: [Module] -> [Module] -> Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module) -> ([Module], [Module], [Module])
determineModules :: [Module]
-> [Module]
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List Module)
-> ([Module], [Module], [Module])
determineModules [Module]
pathsModule [Module]
inferable Maybe (List Module)
mExposed Maybe (List Module)
mGeneratedExposed Maybe (List Module)
mOther Maybe (List Module)
mGeneratedOther =
  ([Module]
exposed, [Module]
others, [Module]
generated)
  where
    generated :: [Module]
generated = Maybe (List Module) -> [Module]
forall a. Maybe (List a) -> [a]
fromMaybeList (Maybe (List Module)
mGeneratedExposed Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> Maybe (List Module)
mGeneratedOther)
    exposed :: [Module]
exposed = [Module]
-> (List Module -> [Module]) -> Maybe (List Module) -> [Module]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Module]
inferable List Module -> [Module]
forall a. List a -> [a]
fromList Maybe (List Module)
mExposed [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ Maybe (List Module) -> [Module]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List Module)
mGeneratedExposed
    others :: [Module]
others = [Module]
-> (List Module -> [Module]) -> Maybe (List Module) -> [Module]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (([Module]
inferable [Module] -> [Module] -> [Module]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Module]
exposed) [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ [Module]
pathsModule) List Module -> [Module]
forall a. List a -> [a]
fromList Maybe (List Module)
mOther [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ Maybe (List Module) -> [Module]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List Module)
mGeneratedOther

fromLibrarySectionInConditional :: [Module] -> LibrarySection -> Library
fromLibrarySectionInConditional :: [Module] -> LibrarySection -> Library
fromLibrarySectionInConditional [Module]
inferableModules lib :: LibrarySection
lib@(LibrarySection Maybe Bool
_ Maybe [Char]
_ Maybe (List Module)
exposedModules Maybe (List Module)
_ Maybe (List Module)
otherModules Maybe (List Module)
_ ParseAsmSources
_ ParseAsmSources
_) =
  case (Maybe (List Module)
exposedModules, Maybe (List Module)
otherModules) of
    (Maybe (List Module)
Nothing, Maybe (List Module)
Nothing) -> [Module] -> Library -> Library
addToOtherModules [Module]
inferableModules (LibrarySection -> Library
fromLibrarySectionPlain LibrarySection
lib)
    (Maybe (List Module), Maybe (List Module))
_ -> LibrarySection -> Library
fromLibrarySectionPlain LibrarySection
lib
  where
    addToOtherModules :: [Module] -> Library -> Library
addToOtherModules [Module]
xs Library
r = Library
r {libraryOtherModules = xs ++ libraryOtherModules r}

fromLibrarySectionPlain :: LibrarySection -> Library
fromLibrarySectionPlain :: LibrarySection -> Library
fromLibrarySectionPlain LibrarySection{Maybe Bool
Maybe [Char]
ParseAsmSources
Maybe (List Module)
librarySectionExposed :: LibrarySection -> Maybe Bool
librarySectionVisibility :: LibrarySection -> Maybe [Char]
librarySectionExposedModules :: LibrarySection -> Maybe (List Module)
librarySectionGeneratedExposedModules :: LibrarySection -> Maybe (List Module)
librarySectionOtherModules :: LibrarySection -> Maybe (List Module)
librarySectionGeneratedOtherModules :: LibrarySection -> Maybe (List Module)
librarySectionReexportedModules :: LibrarySection -> ParseAsmSources
librarySectionSignatures :: LibrarySection -> ParseAsmSources
librarySectionExposed :: Maybe Bool
librarySectionVisibility :: Maybe [Char]
librarySectionExposedModules :: Maybe (List Module)
librarySectionGeneratedExposedModules :: Maybe (List Module)
librarySectionOtherModules :: Maybe (List Module)
librarySectionGeneratedOtherModules :: Maybe (List Module)
librarySectionReexportedModules :: ParseAsmSources
librarySectionSignatures :: ParseAsmSources
..} = Library {
    libraryExposed :: Maybe Bool
libraryExposed = Maybe Bool
librarySectionExposed
  , libraryVisibility :: Maybe [Char]
libraryVisibility = Maybe [Char]
librarySectionVisibility
  , libraryExposedModules :: [Module]
libraryExposedModules = Maybe (List Module) -> [Module]
forall a. Maybe (List a) -> [a]
fromMaybeList (Maybe (List Module)
librarySectionExposedModules Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> Maybe (List Module)
librarySectionGeneratedExposedModules)
  , libraryOtherModules :: [Module]
libraryOtherModules = Maybe (List Module) -> [Module]
forall a. Maybe (List a) -> [a]
fromMaybeList (Maybe (List Module)
librarySectionOtherModules Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> Maybe (List Module)
librarySectionGeneratedOtherModules)
  , libraryGeneratedModules :: [Module]
libraryGeneratedModules = Maybe (List Module) -> [Module]
forall a. Maybe (List a) -> [a]
fromMaybeList (Maybe (List Module)
librarySectionGeneratedOtherModules Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> Maybe (List Module)
librarySectionGeneratedExposedModules)
  , libraryReexportedModules :: [[Char]]
libraryReexportedModules = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
librarySectionReexportedModules
  , librarySignatures :: [[Char]]
librarySignatures = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
librarySectionSignatures
  }

getMentionedExecutableModules :: ExecutableSection -> [Module]
getMentionedExecutableModules :: ExecutableSection -> [Module]
getMentionedExecutableModules (ExecutableSection (Alias (Last Maybe [Char]
main)) Maybe (List Module)
otherModules Maybe (List Module)
generatedModules)=
  ([Module] -> [Module])
-> (Module -> [Module] -> [Module])
-> Maybe Module
-> [Module]
-> [Module]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Module] -> [Module]
forall a. a -> a
id (:) (Path -> Module
toModule (Path -> Module) -> ([Char] -> Path) -> [Char] -> Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Path
Path.fromFilePath ([Char] -> Module) -> Maybe [Char] -> Maybe Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
main) ([Module] -> [Module]) -> [Module] -> [Module]
forall a b. (a -> b) -> a -> b
$ Maybe (List Module) -> [Module]
forall a. Maybe (List a) -> [a]
fromMaybeList (Maybe (List Module)
otherModules Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> Maybe (List Module)
generatedModules)

toExecutable :: (MonadIO m, State m) => FilePath -> String -> Section ExecutableSection -> m (Section Executable)
toExecutable :: forall (m :: * -> *).
(MonadIO m, State m) =>
[Char]
-> [Char] -> Section ExecutableSection -> m (Section Executable)
toExecutable [Char]
dir [Char]
packageName_ =
    [Char]
-> [Char]
-> (ExecutableSection -> [Module])
-> (Executable -> [Module])
-> ([Module] -> [Module] -> ExecutableSection -> Executable)
-> ([Module] -> ExecutableSection -> Executable)
-> Section ExecutableSection
-> m (Section Executable)
forall (m :: * -> *) a b.
(MonadIO m, State m) =>
[Char]
-> [Char]
-> (a -> [Module])
-> (b -> [Module])
-> ([Module] -> [Module] -> a -> b)
-> ([Module] -> a -> b)
-> Section a
-> m (Section b)
inferModules [Char]
dir [Char]
packageName_ ExecutableSection -> [Module]
getMentionedExecutableModules Executable -> [Module]
getExecutableModules [Module] -> [Module] -> ExecutableSection -> Executable
fromExecutableSection ([Module] -> [Module] -> ExecutableSection -> Executable
fromExecutableSection [])
  (Section ExecutableSection -> m (Section Executable))
-> (Section ExecutableSection -> Section ExecutableSection)
-> Section ExecutableSection
-> m (Section Executable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section ExecutableSection -> Section ExecutableSection
expandMain
  where
    fromExecutableSection :: [Module] -> [Module] -> ExecutableSection -> Executable
    fromExecutableSection :: [Module] -> [Module] -> ExecutableSection -> Executable
fromExecutableSection [Module]
pathsModule [Module]
inferableModules ExecutableSection{Maybe (List Module)
Alias 'True "main-is" (Last [Char])
executableSectionMain :: ExecutableSection -> Alias 'True "main-is" (Last [Char])
executableSectionOtherModules :: ExecutableSection -> Maybe (List Module)
executableSectionGeneratedOtherModules :: ExecutableSection -> Maybe (List Module)
executableSectionMain :: Alias 'True "main-is" (Last [Char])
executableSectionOtherModules :: Maybe (List Module)
executableSectionGeneratedOtherModules :: Maybe (List Module)
..} =
      (Maybe [Char] -> [Module] -> [Module] -> Executable
Executable (Last [Char] -> Maybe [Char]
forall a. Last a -> Maybe a
getLast (Last [Char] -> Maybe [Char]) -> Last [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Alias 'True "main-is" (Last [Char]) -> Last [Char]
forall (deprecated :: Bool) (alias :: Symbol) a.
Alias deprecated alias a -> a
unAlias Alias 'True "main-is" (Last [Char])
executableSectionMain) ([Module]
otherModules [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ [Module]
generatedModules) [Module]
generatedModules)
      where
        otherModules :: [Module]
otherModules = [Module]
-> (List Module -> [Module]) -> Maybe (List Module) -> [Module]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Module]
inferableModules [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ [Module]
pathsModule) List Module -> [Module]
forall a. List a -> [a]
fromList Maybe (List Module)
executableSectionOtherModules
        generatedModules :: [Module]
generatedModules = [Module]
-> (List Module -> [Module]) -> Maybe (List Module) -> [Module]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] List Module -> [Module]
forall a. List a -> [a]
fromList Maybe (List Module)
executableSectionGeneratedOtherModules

expandMain :: Section ExecutableSection -> Section ExecutableSection
expandMain :: Section ExecutableSection -> Section ExecutableSection
expandMain = Section ([[Char]], ExecutableSection) -> Section ExecutableSection
flatten (Section ([[Char]], ExecutableSection)
 -> Section ExecutableSection)
-> (Section ExecutableSection
    -> Section ([[Char]], ExecutableSection))
-> Section ExecutableSection
-> Section ExecutableSection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section ExecutableSection -> Section ([[Char]], ExecutableSection)
expand
  where
    expand :: Section ExecutableSection -> Section ([GhcOption], ExecutableSection)
    expand :: Section ExecutableSection -> Section ([[Char]], ExecutableSection)
expand = (ExecutableSection -> ([[Char]], ExecutableSection))
-> Section ExecutableSection
-> Section ([[Char]], ExecutableSection)
forall a b. (a -> b) -> Section a -> Section b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExecutableSection -> ([[Char]], ExecutableSection)
go
      where
        go :: ExecutableSection -> ([[Char]], ExecutableSection)
go exec :: ExecutableSection
exec@ExecutableSection{Maybe (List Module)
Alias 'True "main-is" (Last [Char])
executableSectionMain :: ExecutableSection -> Alias 'True "main-is" (Last [Char])
executableSectionOtherModules :: ExecutableSection -> Maybe (List Module)
executableSectionGeneratedOtherModules :: ExecutableSection -> Maybe (List Module)
executableSectionMain :: Alias 'True "main-is" (Last [Char])
executableSectionOtherModules :: Maybe (List Module)
executableSectionGeneratedOtherModules :: Maybe (List Module)
..} =
          let
            (Maybe [Char]
mainSrcFile, [[Char]]
ghcOptions) = (Maybe [Char], [[Char]])
-> ([Char] -> (Maybe [Char], [[Char]]))
-> Maybe [Char]
-> (Maybe [Char], [[Char]])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe [Char]
forall a. Maybe a
Nothing, []) (([Char] -> Maybe [Char])
-> ([Char], [[Char]]) -> (Maybe [Char], [[Char]])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (([Char], [[Char]]) -> (Maybe [Char], [[Char]]))
-> ([Char] -> ([Char], [[Char]]))
-> [Char]
-> (Maybe [Char], [[Char]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ([Char], [[Char]])
parseMain) (Last [Char] -> Maybe [Char]
forall a. Last a -> Maybe a
getLast (Last [Char] -> Maybe [Char]) -> Last [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Alias 'True "main-is" (Last [Char]) -> Last [Char]
forall (deprecated :: Bool) (alias :: Symbol) a.
Alias deprecated alias a -> a
unAlias Alias 'True "main-is" (Last [Char])
executableSectionMain)
          in
            ([[Char]]
ghcOptions, ExecutableSection
exec{executableSectionMain = Alias $ Last mainSrcFile})

    flatten :: Section ([GhcOption], ExecutableSection) -> Section ExecutableSection
    flatten :: Section ([[Char]], ExecutableSection) -> Section ExecutableSection
flatten sect :: Section ([[Char]], ExecutableSection)
sect@Section{sectionData :: forall a. Section a -> a
sectionData = ([[Char]]
ghcOptions, ExecutableSection
exec), [[Char]]
[Path]
[Conditional (Section ([[Char]], ExecutableSection))]
[Verbatim]
Maybe Bool
Maybe Language
Map BuildTool DependencyVersion
Dependencies
SystemBuildTools
sectionVerbatim :: forall a. Section a -> [Verbatim]
sectionSystemBuildTools :: forall a. Section a -> SystemBuildTools
sectionBuildTools :: forall a. Section a -> Map BuildTool DependencyVersion
sectionConditionals :: forall a. Section a -> [Conditional (Section a)]
sectionBuildable :: forall a. Section a -> Maybe Bool
sectionLdOptions :: forall a. Section a -> [[Char]]
sectionInstallIncludes :: forall a. Section a -> [[Char]]
sectionIncludeDirs :: forall a. Section a -> [[Char]]
sectionFrameworks :: forall a. Section a -> [[Char]]
sectionExtraFrameworksDirs :: forall a. Section a -> [[Char]]
sectionExtraLibraries :: forall a. Section a -> [[Char]]
sectionExtraLibDirs :: forall a. Section a -> [[Char]]
sectionJsSources :: forall a. Section a -> [Path]
sectionCxxSources :: forall a. Section a -> [Path]
sectionCxxOptions :: forall a. Section a -> [[Char]]
sectionCSources :: forall a. Section a -> [Path]
sectionCcOptions :: forall a. Section a -> [[Char]]
sectionAsmSources :: forall a. Section a -> [Path]
sectionAsmOptions :: forall a. Section a -> [[Char]]
sectionCppOptions :: forall a. Section a -> [[Char]]
sectionGhcjsOptions :: forall a. Section a -> [[Char]]
sectionGhcSharedOptions :: forall a. Section a -> [[Char]]
sectionGhcProfOptions :: forall a. Section a -> [[Char]]
sectionGhcOptions :: forall a. Section a -> [[Char]]
sectionLanguage :: forall a. Section a -> Maybe Language
sectionOtherExtensions :: forall a. Section a -> [[Char]]
sectionDefaultExtensions :: forall a. Section a -> [[Char]]
sectionPkgConfigDependencies :: forall a. Section a -> [[Char]]
sectionDependencies :: forall a. Section a -> Dependencies
sectionSourceDirs :: forall a. Section a -> [[Char]]
sectionSourceDirs :: [[Char]]
sectionDependencies :: Dependencies
sectionPkgConfigDependencies :: [[Char]]
sectionDefaultExtensions :: [[Char]]
sectionOtherExtensions :: [[Char]]
sectionLanguage :: Maybe Language
sectionGhcOptions :: [[Char]]
sectionGhcProfOptions :: [[Char]]
sectionGhcSharedOptions :: [[Char]]
sectionGhcjsOptions :: [[Char]]
sectionCppOptions :: [[Char]]
sectionAsmOptions :: [[Char]]
sectionAsmSources :: [Path]
sectionCcOptions :: [[Char]]
sectionCSources :: [Path]
sectionCxxOptions :: [[Char]]
sectionCxxSources :: [Path]
sectionJsSources :: [Path]
sectionExtraLibDirs :: [[Char]]
sectionExtraLibraries :: [[Char]]
sectionExtraFrameworksDirs :: [[Char]]
sectionFrameworks :: [[Char]]
sectionIncludeDirs :: [[Char]]
sectionInstallIncludes :: [[Char]]
sectionLdOptions :: [[Char]]
sectionBuildable :: Maybe Bool
sectionConditionals :: [Conditional (Section ([[Char]], ExecutableSection))]
sectionBuildTools :: Map BuildTool DependencyVersion
sectionSystemBuildTools :: SystemBuildTools
sectionVerbatim :: [Verbatim]
..} = Section ([[Char]], ExecutableSection)
sect{
        sectionData = exec
      , sectionGhcOptions = sectionGhcOptions ++ ghcOptions
      , sectionConditionals = map (fmap flatten) sectionConditionals
      }

toSection :: forall a m. Warnings m => String -> [String] -> WithCommonOptions AsmSources CSources CxxSources JsSources a -> m (Section a)
toSection :: forall a (m :: * -> *).
Warnings m =>
[Char]
-> [[Char]]
-> WithCommonOptions [Path] [Path] [Path] [Path] a
-> m (Section a)
toSection [Char]
packageName_ [[Char]]
executableNames = Product (CommonOptions [Path] [Path] [Path] [Path] a) a
-> m (Section a)
go
  where
    go :: Product (CommonOptions [Path] [Path] [Path] [Path] a) a
-> m (Section a)
go (Product CommonOptions{[Path]
ParseAsmSources
Maybe (List (ConditionalSection [Path] [Path] [Path] [Path] a))
Maybe (List Verbatim)
Maybe SystemBuildTools
Last Bool
Alias 'False "pkgconfig-depends" ParseAsmSources
Alias 'True "hs-source-dirs" ParseAsmSources
Alias 'True "build-depends" (Maybe Dependencies)
Alias 'True "default-language" (Last (Maybe Language))
Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsSourceDirs :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "hs-source-dirs" ParseAsmSources
commonOptionsDependencies :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsPkgConfigDependencies :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'False "pkgconfig-depends" ParseAsmSources
commonOptionsDefaultExtensions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsOtherExtensions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsLanguage :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "default-language" (Last (Maybe Language))
commonOptionsGhcOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcProfOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcSharedOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsGhcjsOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsCppOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsCcOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsAsmOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsAsmSources :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> asmSources
commonOptionsCSources :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> cSources
commonOptionsCxxOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsCxxSources :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> cxxSources
commonOptionsJsSources :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> jsSources
commonOptionsExtraLibDirs :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsExtraLibraries :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsExtraFrameworksDirs :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsFrameworks :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsIncludeDirs :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsInstallIncludes :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsLdOptions :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> ParseAsmSources
commonOptionsBuildable :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Last Bool
commonOptionsWhen :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe
     (List
        (ConditionalSection asmSources cSources cxxSources jsSources a))
commonOptionsBuildTools :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsSystemBuildTools :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe SystemBuildTools
commonOptionsVerbatim :: forall asmSources cSources cxxSources jsSources a.
CommonOptions asmSources cSources cxxSources jsSources a
-> Maybe (List Verbatim)
commonOptionsSourceDirs :: Alias 'True "hs-source-dirs" ParseAsmSources
commonOptionsDependencies :: Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsPkgConfigDependencies :: Alias 'False "pkgconfig-depends" ParseAsmSources
commonOptionsDefaultExtensions :: ParseAsmSources
commonOptionsOtherExtensions :: ParseAsmSources
commonOptionsLanguage :: Alias 'True "default-language" (Last (Maybe Language))
commonOptionsGhcOptions :: ParseAsmSources
commonOptionsGhcProfOptions :: ParseAsmSources
commonOptionsGhcSharedOptions :: ParseAsmSources
commonOptionsGhcjsOptions :: ParseAsmSources
commonOptionsCppOptions :: ParseAsmSources
commonOptionsCcOptions :: ParseAsmSources
commonOptionsAsmOptions :: ParseAsmSources
commonOptionsAsmSources :: [Path]
commonOptionsCSources :: [Path]
commonOptionsCxxOptions :: ParseAsmSources
commonOptionsCxxSources :: [Path]
commonOptionsJsSources :: [Path]
commonOptionsExtraLibDirs :: ParseAsmSources
commonOptionsExtraLibraries :: ParseAsmSources
commonOptionsExtraFrameworksDirs :: ParseAsmSources
commonOptionsFrameworks :: ParseAsmSources
commonOptionsIncludeDirs :: ParseAsmSources
commonOptionsInstallIncludes :: ParseAsmSources
commonOptionsLdOptions :: ParseAsmSources
commonOptionsBuildable :: Last Bool
commonOptionsWhen :: Maybe (List (ConditionalSection [Path] [Path] [Path] [Path] a))
commonOptionsBuildTools :: Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsSystemBuildTools :: Maybe SystemBuildTools
commonOptionsVerbatim :: Maybe (List Verbatim)
..} a
a) = do
      (SystemBuildTools
systemBuildTools, Map BuildTool DependencyVersion
buildTools) <- m (SystemBuildTools, Map BuildTool DependencyVersion)
-> (BuildTools
    -> m (SystemBuildTools, Map BuildTool DependencyVersion))
-> Maybe BuildTools
-> m (SystemBuildTools, Map BuildTool DependencyVersion)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((SystemBuildTools, Map BuildTool DependencyVersion)
-> m (SystemBuildTools, Map BuildTool DependencyVersion)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SystemBuildTools, Map BuildTool DependencyVersion)
forall a. Monoid a => a
mempty) BuildTools -> m (SystemBuildTools, Map BuildTool DependencyVersion)
toBuildTools (Alias 'True "build-tool-depends" (Maybe BuildTools)
-> Maybe BuildTools
forall (deprecated :: Bool) (alias :: Symbol) a.
Alias deprecated alias a -> a
unAlias Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsBuildTools)

      [Conditional (Section a)]
conditionals <- (ConditionalSection [Path] [Path] [Path] [Path] a
 -> m (Conditional (Section a)))
-> [ConditionalSection [Path] [Path] [Path] [Path] a]
-> m [Conditional (Section a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ConditionalSection [Path] [Path] [Path] [Path] a
-> m (Conditional (Section a))
toConditional (Maybe (List (ConditionalSection [Path] [Path] [Path] [Path] a))
-> [ConditionalSection [Path] [Path] [Path] [Path] a]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List (ConditionalSection [Path] [Path] [Path] [Path] a))
commonOptionsWhen)
      Section a -> m (Section a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Section {
        sectionData :: a
sectionData = a
a
      , sectionSourceDirs :: [[Char]]
sectionSourceDirs = [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList (Alias 'True "hs-source-dirs" ParseAsmSources -> ParseAsmSources
forall (deprecated :: Bool) (alias :: Symbol) a.
Alias deprecated alias a -> a
unAlias Alias 'True "hs-source-dirs" ParseAsmSources
commonOptionsSourceDirs)
      , sectionDependencies :: Dependencies
sectionDependencies = Dependencies -> Maybe Dependencies -> Dependencies
forall a. a -> Maybe a -> a
fromMaybe Dependencies
forall a. Monoid a => a
mempty (Alias 'True "build-depends" (Maybe Dependencies)
-> Maybe Dependencies
forall (deprecated :: Bool) (alias :: Symbol) a.
Alias deprecated alias a -> a
unAlias Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsDependencies)
      , sectionPkgConfigDependencies :: [[Char]]
sectionPkgConfigDependencies = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList (Alias 'False "pkgconfig-depends" ParseAsmSources -> ParseAsmSources
forall (deprecated :: Bool) (alias :: Symbol) a.
Alias deprecated alias a -> a
unAlias Alias 'False "pkgconfig-depends" ParseAsmSources
commonOptionsPkgConfigDependencies)
      , sectionDefaultExtensions :: [[Char]]
sectionDefaultExtensions = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
commonOptionsDefaultExtensions
      , sectionOtherExtensions :: [[Char]]
sectionOtherExtensions = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
commonOptionsOtherExtensions
      , sectionLanguage :: Maybe Language
sectionLanguage = Maybe (Maybe Language) -> Maybe Language
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Language) -> Maybe Language)
-> (Last (Maybe Language) -> Maybe (Maybe Language))
-> Last (Maybe Language)
-> Maybe Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last (Maybe Language) -> Maybe (Maybe Language)
forall a. Last a -> Maybe a
getLast (Last (Maybe Language) -> Maybe Language)
-> Last (Maybe Language) -> Maybe Language
forall a b. (a -> b) -> a -> b
$ Alias 'True "default-language" (Last (Maybe Language))
-> Last (Maybe Language)
forall (deprecated :: Bool) (alias :: Symbol) a.
Alias deprecated alias a -> a
unAlias Alias 'True "default-language" (Last (Maybe Language))
commonOptionsLanguage
      , sectionGhcOptions :: [[Char]]
sectionGhcOptions = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
commonOptionsGhcOptions
      , sectionGhcProfOptions :: [[Char]]
sectionGhcProfOptions = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
commonOptionsGhcProfOptions
      , sectionGhcSharedOptions :: [[Char]]
sectionGhcSharedOptions = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
commonOptionsGhcSharedOptions
      , sectionGhcjsOptions :: [[Char]]
sectionGhcjsOptions = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
commonOptionsGhcjsOptions
      , sectionCppOptions :: [[Char]]
sectionCppOptions = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
commonOptionsCppOptions
      , sectionAsmOptions :: [[Char]]
sectionAsmOptions = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
commonOptionsAsmOptions
      , sectionAsmSources :: [Path]
sectionAsmSources = [Path]
commonOptionsAsmSources
      , sectionCcOptions :: [[Char]]
sectionCcOptions = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
commonOptionsCcOptions
      , sectionCSources :: [Path]
sectionCSources = [Path]
commonOptionsCSources
      , sectionCxxOptions :: [[Char]]
sectionCxxOptions = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
commonOptionsCxxOptions
      , sectionCxxSources :: [Path]
sectionCxxSources = [Path]
commonOptionsCxxSources
      , sectionJsSources :: [Path]
sectionJsSources = [Path]
commonOptionsJsSources
      , sectionExtraLibDirs :: [[Char]]
sectionExtraLibDirs = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
commonOptionsExtraLibDirs
      , sectionExtraLibraries :: [[Char]]
sectionExtraLibraries = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
commonOptionsExtraLibraries
      , sectionExtraFrameworksDirs :: [[Char]]
sectionExtraFrameworksDirs = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
commonOptionsExtraFrameworksDirs
      , sectionFrameworks :: [[Char]]
sectionFrameworks = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
commonOptionsFrameworks
      , sectionIncludeDirs :: [[Char]]
sectionIncludeDirs = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
commonOptionsIncludeDirs
      , sectionInstallIncludes :: [[Char]]
sectionInstallIncludes = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
commonOptionsInstallIncludes
      , sectionLdOptions :: [[Char]]
sectionLdOptions = ParseAsmSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseAsmSources
commonOptionsLdOptions
      , sectionBuildable :: Maybe Bool
sectionBuildable = Last Bool -> Maybe Bool
forall a. Last a -> Maybe a
getLast Last Bool
commonOptionsBuildable
      , sectionConditionals :: [Conditional (Section a)]
sectionConditionals = [Conditional (Section a)]
conditionals
      , sectionBuildTools :: Map BuildTool DependencyVersion
sectionBuildTools = Map BuildTool DependencyVersion
buildTools
      , sectionSystemBuildTools :: SystemBuildTools
sectionSystemBuildTools = SystemBuildTools
systemBuildTools SystemBuildTools -> SystemBuildTools -> SystemBuildTools
forall a. Semigroup a => a -> a -> a
<> SystemBuildTools -> Maybe SystemBuildTools -> SystemBuildTools
forall a. a -> Maybe a -> a
fromMaybe SystemBuildTools
forall a. Monoid a => a
mempty Maybe SystemBuildTools
commonOptionsSystemBuildTools
      , sectionVerbatim :: [Verbatim]
sectionVerbatim = Maybe (List Verbatim) -> [Verbatim]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List Verbatim)
commonOptionsVerbatim
      }
    toBuildTools :: BuildTools -> m (SystemBuildTools, Map BuildTool DependencyVersion)
    toBuildTools :: BuildTools -> m (SystemBuildTools, Map BuildTool DependencyVersion)
toBuildTools = ([Either SystemBuildTool (BuildTool, DependencyVersion)]
 -> (SystemBuildTools, Map BuildTool DependencyVersion))
-> m [Either SystemBuildTool (BuildTool, DependencyVersion)]
-> m (SystemBuildTools, Map BuildTool DependencyVersion)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Either SystemBuildTool (BuildTool, DependencyVersion)]
-> SystemBuildTools
forall b. [Either SystemBuildTool b] -> SystemBuildTools
mkSystemBuildTools ([Either SystemBuildTool (BuildTool, DependencyVersion)]
 -> SystemBuildTools)
-> ([Either SystemBuildTool (BuildTool, DependencyVersion)]
    -> Map BuildTool DependencyVersion)
-> [Either SystemBuildTool (BuildTool, DependencyVersion)]
-> (SystemBuildTools, Map BuildTool DependencyVersion)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [Either SystemBuildTool (BuildTool, DependencyVersion)]
-> Map BuildTool DependencyVersion
forall {a} {a}. [Either a (BuildTool, a)] -> Map BuildTool a
mkBuildTools) (m [Either SystemBuildTool (BuildTool, DependencyVersion)]
 -> m (SystemBuildTools, Map BuildTool DependencyVersion))
-> (BuildTools
    -> m [Either SystemBuildTool (BuildTool, DependencyVersion)])
-> BuildTools
-> m (SystemBuildTools, Map BuildTool DependencyVersion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ParseBuildTool, DependencyVersion)
 -> m (Either SystemBuildTool (BuildTool, DependencyVersion)))
-> [(ParseBuildTool, DependencyVersion)]
-> m [Either SystemBuildTool (BuildTool, DependencyVersion)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Char]
-> [[Char]]
-> (ParseBuildTool, DependencyVersion)
-> m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall (m :: * -> *).
Warnings m =>
[Char]
-> [[Char]]
-> (ParseBuildTool, DependencyVersion)
-> m (Either SystemBuildTool (BuildTool, DependencyVersion))
toBuildTool [Char]
packageName_ [[Char]]
executableNames) ([(ParseBuildTool, DependencyVersion)]
 -> m [Either SystemBuildTool (BuildTool, DependencyVersion)])
-> (BuildTools -> [(ParseBuildTool, DependencyVersion)])
-> BuildTools
-> m [Either SystemBuildTool (BuildTool, DependencyVersion)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildTools -> [(ParseBuildTool, DependencyVersion)]
unBuildTools
      where
        mkSystemBuildTools :: [Either (String, VersionConstraint) b] -> SystemBuildTools
        mkSystemBuildTools :: forall b. [Either SystemBuildTool b] -> SystemBuildTools
mkSystemBuildTools = Map [Char] VersionConstraint -> SystemBuildTools
SystemBuildTools (Map [Char] VersionConstraint -> SystemBuildTools)
-> ([Either SystemBuildTool b] -> Map [Char] VersionConstraint)
-> [Either SystemBuildTool b]
-> SystemBuildTools
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SystemBuildTool] -> Map [Char] VersionConstraint
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([SystemBuildTool] -> Map [Char] VersionConstraint)
-> ([Either SystemBuildTool b] -> [SystemBuildTool])
-> [Either SystemBuildTool b]
-> Map [Char] VersionConstraint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either SystemBuildTool b] -> [SystemBuildTool]
forall a b. [Either a b] -> [a]
lefts

        mkBuildTools :: [Either a (BuildTool, a)] -> Map BuildTool a
mkBuildTools = [(BuildTool, a)] -> Map BuildTool a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(BuildTool, a)] -> Map BuildTool a)
-> ([Either a (BuildTool, a)] -> [(BuildTool, a)])
-> [Either a (BuildTool, a)]
-> Map BuildTool a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either a (BuildTool, a)] -> [(BuildTool, a)]
forall a b. [Either a b] -> [b]
rights

    toConditional :: ConditionalSection AsmSources CSources CxxSources JsSources a -> m (Conditional (Section a))
    toConditional :: ConditionalSection [Path] [Path] [Path] [Path] a
-> m (Conditional (Section a))
toConditional ConditionalSection [Path] [Path] [Path] [Path] a
x = case ConditionalSection [Path] [Path] [Path] [Path] a
x of
      ThenElseConditional (Product (ThenElse Product (CommonOptions [Path] [Path] [Path] [Path] a) a
then_ Product (CommonOptions [Path] [Path] [Path] [Path] a) a
else_) Condition
c) -> Condition
-> Section a -> Maybe (Section a) -> Conditional (Section a)
forall {a}. Condition -> a -> Maybe a -> Conditional a
conditional Condition
c (Section a -> Maybe (Section a) -> Conditional (Section a))
-> m (Section a)
-> m (Maybe (Section a) -> Conditional (Section a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Product (CommonOptions [Path] [Path] [Path] [Path] a) a
-> m (Section a)
go Product (CommonOptions [Path] [Path] [Path] [Path] a) a
then_ m (Maybe (Section a) -> Conditional (Section a))
-> m (Maybe (Section a)) -> m (Conditional (Section a))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Section a -> Maybe (Section a)
forall a. a -> Maybe a
Just (Section a -> Maybe (Section a))
-> m (Section a) -> m (Maybe (Section a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Product (CommonOptions [Path] [Path] [Path] [Path] a) a
-> m (Section a)
go Product (CommonOptions [Path] [Path] [Path] [Path] a) a
else_)
      FlatConditional (Product Product (CommonOptions [Path] [Path] [Path] [Path] a) a
sect Condition
c) -> Condition
-> Section a -> Maybe (Section a) -> Conditional (Section a)
forall {a}. Condition -> a -> Maybe a -> Conditional a
conditional Condition
c (Section a -> Maybe (Section a) -> Conditional (Section a))
-> m (Section a)
-> m (Maybe (Section a) -> Conditional (Section a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Product (CommonOptions [Path] [Path] [Path] [Path] a) a
-> m (Section a)
go Product (CommonOptions [Path] [Path] [Path] [Path] a) a
sect) m (Maybe (Section a) -> Conditional (Section a))
-> m (Maybe (Section a)) -> m (Conditional (Section a))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Section a) -> m (Maybe (Section a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Section a)
forall a. Maybe a
Nothing
      where
        conditional :: Condition -> a -> Maybe a -> Conditional a
conditional = Cond -> a -> Maybe a -> Conditional a
forall a. Cond -> a -> Maybe a -> Conditional a
Conditional (Cond -> a -> Maybe a -> Conditional a)
-> (Condition -> Cond)
-> Condition
-> a
-> Maybe a
-> Conditional a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Condition -> Cond
conditionCondition

type SystemBuildTool = (String, VersionConstraint)

toBuildTool :: Warnings m => String -> [String] -> (ParseBuildTool, DependencyVersion) -> m (Either SystemBuildTool (BuildTool, DependencyVersion))
toBuildTool :: forall (m :: * -> *).
Warnings m =>
[Char]
-> [[Char]]
-> (ParseBuildTool, DependencyVersion)
-> m (Either SystemBuildTool (BuildTool, DependencyVersion))
toBuildTool [Char]
packageName_ [[Char]]
executableNames = \ case
  (QualifiedBuildTool [Char]
pkg [Char]
executable, DependencyVersion
v)
    | [Char]
pkg [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
packageName_ Bool -> Bool -> Bool
&& [Char]
executable [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
executableNames -> [Char]
-> DependencyVersion
-> m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall {m :: * -> *} {b} {a}.
Monad m =>
[Char] -> b -> m (Either a (BuildTool, b))
localBuildTool [Char]
executable DependencyVersion
v
    | Bool
otherwise -> [Char]
-> [Char]
-> DependencyVersion
-> m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall {m :: * -> *} {b} {a}.
Monad m =>
[Char] -> [Char] -> b -> m (Either a (BuildTool, b))
buildTool [Char]
pkg [Char]
executable DependencyVersion
v
  (UnqualifiedBuildTool [Char]
executable, DependencyVersion
v)
    | [Char]
executable [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
executableNames -> [Char]
-> DependencyVersion
-> m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall {m :: * -> *} {b} {a}.
Monad m =>
[Char] -> b -> m (Either a (BuildTool, b))
localBuildTool [Char]
executable DependencyVersion
v
    | Just [Char]
pkg <- [Char] -> [([Char], [Char])] -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
executable [([Char], [Char])]
legacyTools -> [Char]
-> [Char]
-> DependencyVersion
-> m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall {m :: * -> *} {b} {a}.
MonadWriter [[Char]] m =>
[Char] -> [Char] -> b -> m (Either a (BuildTool, b))
legacyBuildTool [Char]
pkg [Char]
executable DependencyVersion
v
    | [Char]
executable [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
legacySystemTools, DependencyVersion Maybe SourceDependency
Nothing VersionConstraint
c <- DependencyVersion
v -> [Char]
-> VersionConstraint
-> m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall {a} {b} {b}. Show a => a -> b -> m (Either (a, b) b)
legacySystemBuildTool [Char]
executable VersionConstraint
c
    | Bool
otherwise -> [Char]
-> [Char]
-> DependencyVersion
-> m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall {m :: * -> *} {b} {a}.
Monad m =>
[Char] -> [Char] -> b -> m (Either a (BuildTool, b))
buildTool [Char]
executable [Char]
executable DependencyVersion
v
  where
    buildTool :: [Char] -> [Char] -> b -> m (Either a (BuildTool, b))
buildTool [Char]
pkg [Char]
executable b
v = Either a (BuildTool, b) -> m (Either a (BuildTool, b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (BuildTool, b) -> m (Either a (BuildTool, b)))
-> ((BuildTool, b) -> Either a (BuildTool, b))
-> (BuildTool, b)
-> m (Either a (BuildTool, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuildTool, b) -> Either a (BuildTool, b)
forall a b. b -> Either a b
Right ((BuildTool, b) -> m (Either a (BuildTool, b)))
-> (BuildTool, b) -> m (Either a (BuildTool, b))
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char] -> BuildTool
BuildTool [Char]
pkg [Char]
executable, b
v)

    systemBuildTool :: a -> m (Either a b)
systemBuildTool = Either a b -> m (Either a b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> m (Either a b))
-> (a -> Either a b) -> a -> m (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left

    localBuildTool :: [Char] -> b -> m (Either a (BuildTool, b))
localBuildTool [Char]
executable b
v = Either a (BuildTool, b) -> m (Either a (BuildTool, b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (BuildTool, b) -> m (Either a (BuildTool, b)))
-> ((BuildTool, b) -> Either a (BuildTool, b))
-> (BuildTool, b)
-> m (Either a (BuildTool, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuildTool, b) -> Either a (BuildTool, b)
forall a b. b -> Either a b
Right ((BuildTool, b) -> m (Either a (BuildTool, b)))
-> (BuildTool, b) -> m (Either a (BuildTool, b))
forall a b. (a -> b) -> a -> b
$ ([Char] -> BuildTool
LocalBuildTool [Char]
executable, b
v)
    legacyBuildTool :: [Char] -> [Char] -> b -> m (Either a (BuildTool, b))
legacyBuildTool [Char]
pkg [Char]
executable b
v = [Char] -> [Char] -> m ()
forall {m :: * -> *}.
MonadWriter [[Char]] m =>
[Char] -> [Char] -> m ()
warnLegacyTool [Char]
pkg [Char]
executable m () -> m (Either a (BuildTool, b)) -> m (Either a (BuildTool, b))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> [Char] -> b -> m (Either a (BuildTool, b))
forall {m :: * -> *} {b} {a}.
Monad m =>
[Char] -> [Char] -> b -> m (Either a (BuildTool, b))
buildTool [Char]
pkg [Char]
executable b
v
    legacySystemBuildTool :: a -> b -> m (Either (a, b) b)
legacySystemBuildTool a
executable b
c = a -> m ()
forall {m :: * -> *} {a}.
(MonadWriter [[Char]] m, Show a) =>
a -> m ()
warnLegacySystemTool a
executable m () -> m (Either (a, b) b) -> m (Either (a, b) b)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a, b) -> m (Either (a, b) b)
forall {a} {b}. a -> m (Either a b)
systemBuildTool (a
executable, b
c)

    legacyTools :: [([Char], [Char])]
legacyTools = [
        ([Char]
"gtk2hsTypeGen", [Char]
"gtk2hs-buildtools")
      , ([Char]
"gtk2hsHookGenerator", [Char]
"gtk2hs-buildtools")
      , ([Char]
"gtk2hsC2hs", [Char]
"gtk2hs-buildtools")
      , ([Char]
"cabal", [Char]
"cabal-install")
      , ([Char]
"grgen", [Char]
"cgen")
      , ([Char]
"cgen-hs", [Char]
"cgen")
      ]
    legacySystemTools :: [[Char]]
legacySystemTools = [
        [Char]
"ghc"
      , [Char]
"git"
      , [Char]
"llvm-config"
      , [Char]
"gfortran"
      , [Char]
"gcc"
      , [Char]
"couchdb"
      , [Char]
"mcc"
      , [Char]
"nix-store"
      , [Char]
"nix-instantiate"
      , [Char]
"nix-hash"
      , [Char]
"nix-env"
      , [Char]
"nix-build"
      ]
    warnLegacyTool :: [Char] -> [Char] -> m ()
warnLegacyTool [Char]
pkg [Char]
name = [[Char]] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[Char]
"Usage of the unqualified build-tool name " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" is deprecated! Please use the qualified name \"" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
pkg [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\" instead!"]
    warnLegacySystemTool :: a -> m ()
warnLegacySystemTool a
name = [[Char]] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[Char]
"Listing " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" under build-tools is deperecated! Please list system executables under system-build-tools instead!"]

pathsModuleFromPackageName :: String -> Module
pathsModuleFromPackageName :: [Char] -> Module
pathsModuleFromPackageName [Char]
name = [Char] -> Module
Module ([Char]
"Paths_" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f [Char]
name)
  where
    f :: Char -> Char
f Char
'-' = Char
'_'
    f Char
x = Char
x