{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LiberalTypeSynonyms #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
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

, 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(..)
, BuildType(..)
, GhcProfOption
, GhcjsOption
, CppOption
, CcOption
, LdOption
, Path(..)
, Module(..)
#ifdef TEST
, renameDependencies
, Empty(..)
, pathsModuleFromPackageName

, LibrarySection(..)
, fromLibrarySectionInConditional
, formatOrList

, toBuildTool
#endif
) where

import           Control.Applicative
import           Control.Arrow ((>>>), (&&&))
import           Control.Monad
import           Data.Either
import           Data.Bifunctor
import           Data.Bitraversable
import           Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as Map
import qualified Data.HashMap.Lazy as HashMap
import           Data.List ((\\), sortBy, intercalate)
import           Data.Maybe
import           Data.Semigroup (Semigroup(..))
import           Data.Ord
import           Data.String
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Text.Encoding (decodeUtf8)
import           Data.Scientific (Scientific)
import           System.Directory
import           System.FilePath
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Writer
import           Control.Monad.Trans.Except
import           Control.Monad.IO.Class
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.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 :: String -> String -> Package
package String
name String
version = Package :: String
-> String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> [String]
-> [String]
-> [String]
-> BuildType
-> Maybe String
-> [String]
-> [String]
-> [Flag]
-> [Path]
-> [Path]
-> [Path]
-> Maybe String
-> Maybe SourceRepository
-> Maybe CustomSetup
-> Maybe (Section Library)
-> Map String (Section Library)
-> Map String (Section Executable)
-> Map String (Section Executable)
-> Map String (Section Executable)
-> [Verbatim]
-> Package
Package {
    packageName :: String
packageName = String
name
  , packageVersion :: String
packageVersion = String
version
  , packageSynopsis :: Maybe String
packageSynopsis = Maybe String
forall a. Maybe a
Nothing
  , packageDescription :: Maybe String
packageDescription = Maybe String
forall a. Maybe a
Nothing
  , packageHomepage :: Maybe String
packageHomepage = Maybe String
forall a. Maybe a
Nothing
  , packageBugReports :: Maybe String
packageBugReports = Maybe String
forall a. Maybe a
Nothing
  , packageCategory :: Maybe String
packageCategory = Maybe String
forall a. Maybe a
Nothing
  , packageStability :: Maybe String
packageStability = Maybe String
forall a. Maybe a
Nothing
  , packageAuthor :: [String]
packageAuthor = []
  , packageMaintainer :: [String]
packageMaintainer = []
  , packageCopyright :: [String]
packageCopyright = []
  , packageBuildType :: BuildType
packageBuildType = BuildType
Simple
  , packageLicense :: Maybe String
packageLicense = Maybe String
forall a. Maybe a
Nothing
  , packageLicenseFile :: [String]
packageLicenseFile = []
  , packageTestedWith :: [String]
packageTestedWith = []
  , packageFlags :: [Flag]
packageFlags = []
  , packageExtraSourceFiles :: [Path]
packageExtraSourceFiles = []
  , packageExtraDocFiles :: [Path]
packageExtraDocFiles = []
  , packageDataFiles :: [Path]
packageDataFiles = []
  , packageDataDir :: Maybe String
packageDataDir = Maybe String
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 String (Section Library)
packageInternalLibraries = Map String (Section Library)
forall a. Monoid a => a
mempty
  , packageExecutables :: Map String (Section Executable)
packageExecutables = Map String (Section Executable)
forall a. Monoid a => a
mempty
  , packageTests :: Map String (Section Executable)
packageTests = Map String (Section Executable)
forall a. Monoid a => a
mempty
  , packageBenchmarks :: Map String (Section Executable)
packageBenchmarks = Map String (Section Executable)
forall a. Monoid a => a
mempty
  , packageVerbatim :: [Verbatim]
packageVerbatim = []
  }

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

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

    renameConditional :: Conditional (Section a) -> Conditional (Section a)
    renameConditional :: 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 (String -> String -> Section a -> Section a
forall a. String -> String -> Section a -> Section a
renameDependencies String
old String
new Section a
then_) (String -> String -> Section a -> Section a
forall a. String -> String -> Section a -> Section a
renameDependencies String
old String
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 -> [(String, DependencyInfo)]
packageDependencies Package{String
[String]
[Path]
[Flag]
[Verbatim]
Maybe String
Maybe SourceRepository
Maybe (Section Library)
Maybe CustomSetup
Map String (Section Executable)
Map String (Section Library)
BuildType
packageVerbatim :: [Verbatim]
packageBenchmarks :: Map String (Section Executable)
packageTests :: Map String (Section Executable)
packageExecutables :: Map String (Section Executable)
packageInternalLibraries :: Map String (Section Library)
packageLibrary :: Maybe (Section Library)
packageCustomSetup :: Maybe CustomSetup
packageSourceRepository :: Maybe SourceRepository
packageDataDir :: Maybe String
packageDataFiles :: [Path]
packageExtraDocFiles :: [Path]
packageExtraSourceFiles :: [Path]
packageFlags :: [Flag]
packageTestedWith :: [String]
packageLicenseFile :: [String]
packageLicense :: Maybe String
packageBuildType :: BuildType
packageCopyright :: [String]
packageMaintainer :: [String]
packageAuthor :: [String]
packageStability :: Maybe String
packageCategory :: Maybe String
packageBugReports :: Maybe String
packageHomepage :: Maybe String
packageDescription :: Maybe String
packageSynopsis :: Maybe String
packageVersion :: String
packageName :: String
packageVerbatim :: Package -> [Verbatim]
packageBenchmarks :: Package -> Map String (Section Executable)
packageTests :: Package -> Map String (Section Executable)
packageExecutables :: Package -> Map String (Section Executable)
packageInternalLibraries :: Package -> Map String (Section Library)
packageLibrary :: Package -> Maybe (Section Library)
packageCustomSetup :: Package -> Maybe CustomSetup
packageSourceRepository :: Package -> Maybe SourceRepository
packageDataDir :: Package -> Maybe String
packageDataFiles :: Package -> [Path]
packageExtraDocFiles :: Package -> [Path]
packageExtraSourceFiles :: Package -> [Path]
packageFlags :: Package -> [Flag]
packageTestedWith :: Package -> [String]
packageLicenseFile :: Package -> [String]
packageLicense :: Package -> Maybe String
packageBuildType :: Package -> BuildType
packageCopyright :: Package -> [String]
packageMaintainer :: Package -> [String]
packageAuthor :: Package -> [String]
packageStability :: Package -> Maybe String
packageCategory :: Package -> Maybe String
packageBugReports :: Package -> Maybe String
packageHomepage :: Package -> Maybe String
packageDescription :: Package -> Maybe String
packageSynopsis :: Package -> Maybe String
packageVersion :: Package -> String
packageName :: Package -> String
..} = [(String, DependencyInfo)] -> [(String, DependencyInfo)]
forall a. Ord a => [a] -> [a]
nub ([(String, DependencyInfo)] -> [(String, DependencyInfo)])
-> ([(String, DependencyInfo)] -> [(String, DependencyInfo)])
-> [(String, DependencyInfo)]
-> [(String, DependencyInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, DependencyInfo) -> (String, DependencyInfo) -> Ordering)
-> [(String, DependencyInfo)] -> [(String, DependencyInfo)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((String, DependencyInfo) -> (String, String))
-> (String, DependencyInfo) -> (String, DependencyInfo) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (String -> (String, String)
lexicographically (String -> (String, String))
-> ((String, DependencyInfo) -> String)
-> (String, DependencyInfo)
-> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, DependencyInfo) -> String
forall a b. (a, b) -> a
fst)) ([(String, DependencyInfo)] -> [(String, DependencyInfo)])
-> [(String, DependencyInfo)] -> [(String, DependencyInfo)]
forall a b. (a -> b) -> a -> b
$
     ((Section Executable -> [(String, DependencyInfo)])
-> Map String (Section Executable) -> [(String, DependencyInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section Executable -> [(String, DependencyInfo)]
forall a. Section a -> [(String, DependencyInfo)]
deps Map String (Section Executable)
packageExecutables)
  [(String, DependencyInfo)]
-> [(String, DependencyInfo)] -> [(String, DependencyInfo)]
forall a. [a] -> [a] -> [a]
++ ((Section Executable -> [(String, DependencyInfo)])
-> Map String (Section Executable) -> [(String, DependencyInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section Executable -> [(String, DependencyInfo)]
forall a. Section a -> [(String, DependencyInfo)]
deps Map String (Section Executable)
packageTests)
  [(String, DependencyInfo)]
-> [(String, DependencyInfo)] -> [(String, DependencyInfo)]
forall a. [a] -> [a] -> [a]
++ ((Section Executable -> [(String, DependencyInfo)])
-> Map String (Section Executable) -> [(String, DependencyInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section Executable -> [(String, DependencyInfo)]
forall a. Section a -> [(String, DependencyInfo)]
deps Map String (Section Executable)
packageBenchmarks)
  [(String, DependencyInfo)]
-> [(String, DependencyInfo)] -> [(String, DependencyInfo)]
forall a. [a] -> [a] -> [a]
++ [(String, DependencyInfo)]
-> (Section Library -> [(String, DependencyInfo)])
-> Maybe (Section Library)
-> [(String, DependencyInfo)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Section Library -> [(String, DependencyInfo)]
forall a. Section a -> [(String, DependencyInfo)]
deps Maybe (Section Library)
packageLibrary
  where
    deps :: Section a -> [(String, DependencyInfo)]
deps Section a
xs = [(String
name, DependencyInfo
info) | (String
name, DependencyInfo
info) <- (Map String DependencyInfo -> [(String, DependencyInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map String DependencyInfo -> [(String, DependencyInfo)])
-> (Section a -> Map String DependencyInfo)
-> Section a
-> [(String, DependencyInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> Map String DependencyInfo
unDependencies (Dependencies -> Map String DependencyInfo)
-> (Section a -> Dependencies)
-> Section a
-> Map String 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 :: a -> Section a
section a
a = a
-> [String]
-> Dependencies
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [Path]
-> [String]
-> [Path]
-> [Path]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe Bool
-> [Conditional (Section a)]
-> Map BuildTool DependencyVersion
-> SystemBuildTools
-> [Verbatim]
-> Section a
forall a.
a
-> [String]
-> Dependencies
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [Path]
-> [String]
-> [Path]
-> [Path]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe Bool
-> [Conditional (Section a)]
-> Map BuildTool DependencyVersion
-> SystemBuildTools
-> [Verbatim]
-> Section a
Section a
a [] Dependencies
forall a. Monoid a => a
mempty [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] 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 :: String
packageConfig = String
"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
/= :: CustomSetupSection -> CustomSetupSection -> Bool
$c/= :: CustomSetupSection -> CustomSetupSection -> Bool
== :: CustomSetupSection -> CustomSetupSection -> Bool
$c== :: CustomSetupSection -> CustomSetupSection -> Bool
Eq, Int -> CustomSetupSection -> ShowS
[CustomSetupSection] -> ShowS
CustomSetupSection -> String
(Int -> CustomSetupSection -> ShowS)
-> (CustomSetupSection -> String)
-> ([CustomSetupSection] -> ShowS)
-> Show CustomSetupSection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomSetupSection] -> ShowS
$cshowList :: [CustomSetupSection] -> ShowS
show :: CustomSetupSection -> String
$cshow :: CustomSetupSection -> String
showsPrec :: Int -> CustomSetupSection -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep CustomSetupSection x -> CustomSetupSection
$cfrom :: forall x. CustomSetupSection -> Rep CustomSetupSection x
Generic, Value -> Parser CustomSetupSection
(Value -> Parser CustomSetupSection)
-> FromValue CustomSetupSection
forall a. (Value -> Parser a) -> FromValue a
fromValue :: Value -> Parser CustomSetupSection
$cfromValue :: Value -> Parser CustomSetupSection
FromValue)

data LibrarySection = LibrarySection {
  LibrarySection -> Maybe Bool
librarySectionExposed :: Maybe Bool
, LibrarySection -> Maybe String
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 -> Maybe (List String)
librarySectionReexportedModules :: Maybe (List String)
, LibrarySection -> Maybe (List String)
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
/= :: LibrarySection -> LibrarySection -> Bool
$c/= :: LibrarySection -> LibrarySection -> Bool
== :: LibrarySection -> LibrarySection -> Bool
$c== :: LibrarySection -> LibrarySection -> Bool
Eq, Int -> LibrarySection -> ShowS
[LibrarySection] -> ShowS
LibrarySection -> String
(Int -> LibrarySection -> ShowS)
-> (LibrarySection -> String)
-> ([LibrarySection] -> ShowS)
-> Show LibrarySection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LibrarySection] -> ShowS
$cshowList :: [LibrarySection] -> ShowS
show :: LibrarySection -> String
$cshow :: LibrarySection -> String
showsPrec :: Int -> LibrarySection -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep LibrarySection x -> LibrarySection
$cfrom :: forall x. LibrarySection -> Rep LibrarySection x
Generic, Value -> Parser LibrarySection
(Value -> Parser LibrarySection) -> FromValue LibrarySection
forall a. (Value -> Parser a) -> FromValue a
fromValue :: Value -> Parser LibrarySection
$cfromValue :: Value -> Parser LibrarySection
FromValue)

instance Monoid LibrarySection where
  mempty :: LibrarySection
mempty = Maybe Bool
-> Maybe String
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List String)
-> Maybe (List String)
-> LibrarySection
LibrarySection Maybe Bool
forall a. Maybe a
Nothing Maybe String
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 Maybe (List String)
forall a. Maybe a
Nothing Maybe (List String)
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 :: Maybe Bool
-> Maybe String
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List String)
-> Maybe (List String)
-> LibrarySection
LibrarySection {
      librarySectionExposed :: Maybe Bool
librarySectionExposed = LibrarySection -> Maybe Bool
librarySectionExposed LibrarySection
b Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LibrarySection -> Maybe Bool
librarySectionExposed LibrarySection
a
    , librarySectionVisibility :: Maybe String
librarySectionVisibility = LibrarySection -> Maybe String
librarySectionVisibility LibrarySection
b Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LibrarySection -> Maybe String
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 :: Maybe (List String)
librarySectionReexportedModules = LibrarySection -> Maybe (List String)
librarySectionReexportedModules LibrarySection
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> LibrarySection -> Maybe (List String)
librarySectionReexportedModules LibrarySection
b
    , librarySectionSignatures :: Maybe (List String)
librarySectionSignatures = LibrarySection -> Maybe (List String)
librarySectionSignatures LibrarySection
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> LibrarySection -> Maybe (List String)
librarySectionSignatures LibrarySection
b
    }

data ExecutableSection = ExecutableSection {
  ExecutableSection -> Maybe String
executableSectionMain :: Maybe 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
/= :: ExecutableSection -> ExecutableSection -> Bool
$c/= :: ExecutableSection -> ExecutableSection -> Bool
== :: ExecutableSection -> ExecutableSection -> Bool
$c== :: ExecutableSection -> ExecutableSection -> Bool
Eq, Int -> ExecutableSection -> ShowS
[ExecutableSection] -> ShowS
ExecutableSection -> String
(Int -> ExecutableSection -> ShowS)
-> (ExecutableSection -> String)
-> ([ExecutableSection] -> ShowS)
-> Show ExecutableSection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecutableSection] -> ShowS
$cshowList :: [ExecutableSection] -> ShowS
show :: ExecutableSection -> String
$cshow :: ExecutableSection -> String
showsPrec :: Int -> ExecutableSection -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep ExecutableSection x -> ExecutableSection
$cfrom :: forall x. ExecutableSection -> Rep ExecutableSection x
Generic, Value -> Parser ExecutableSection
(Value -> Parser ExecutableSection) -> FromValue ExecutableSection
forall a. (Value -> Parser a) -> FromValue a
fromValue :: Value -> Parser ExecutableSection
$cfromValue :: Value -> Parser ExecutableSection
FromValue)

instance Monoid ExecutableSection where
  mempty :: ExecutableSection
mempty = Maybe String
-> Maybe (List Module) -> Maybe (List Module) -> ExecutableSection
ExecutableSection Maybe String
forall a. Maybe a
Nothing 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 :: Maybe String
-> Maybe (List Module) -> Maybe (List Module) -> ExecutableSection
ExecutableSection {
      executableSectionMain :: Maybe String
executableSectionMain = ExecutableSection -> Maybe String
executableSectionMain ExecutableSection
b Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ExecutableSection -> Maybe String
executableSectionMain ExecutableSection
a
    , 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
/= :: VerbatimValue -> VerbatimValue -> Bool
$c/= :: VerbatimValue -> VerbatimValue -> Bool
== :: VerbatimValue -> VerbatimValue -> Bool
$c== :: VerbatimValue -> VerbatimValue -> Bool
Eq, Int -> VerbatimValue -> ShowS
[VerbatimValue] -> ShowS
VerbatimValue -> String
(Int -> VerbatimValue -> ShowS)
-> (VerbatimValue -> String)
-> ([VerbatimValue] -> ShowS)
-> Show VerbatimValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerbatimValue] -> ShowS
$cshowList :: [VerbatimValue] -> ShowS
show :: VerbatimValue -> String
$cshow :: VerbatimValue -> String
showsPrec :: Int -> VerbatimValue -> ShowS
$cshowsPrec :: Int -> 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 (m :: * -> *) a. Monad m => a -> m a
return (String -> VerbatimValue
VerbatimString (String -> VerbatimValue) -> String -> VerbatimValue
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s)
    Number Scientific
n -> VerbatimValue -> Parser VerbatimValue
forall (m :: * -> *) a. Monad m => a -> m a
return (Scientific -> VerbatimValue
VerbatimNumber Scientific
n)
    Bool Bool
b -> VerbatimValue -> Parser VerbatimValue
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> VerbatimValue
VerbatimBool Bool
b)
    Value
Null -> VerbatimValue -> Parser VerbatimValue
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 = String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch ([String] -> String
formatOrList [String
"String", String
"Number", String
"Bool", String
"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
/= :: Verbatim -> Verbatim -> Bool
$c/= :: Verbatim -> Verbatim -> Bool
== :: Verbatim -> Verbatim -> Bool
$c== :: Verbatim -> Verbatim -> Bool
Eq, Int -> Verbatim -> ShowS
[Verbatim] -> ShowS
Verbatim -> String
(Int -> Verbatim -> ShowS)
-> (Verbatim -> String) -> ([Verbatim] -> ShowS) -> Show Verbatim
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verbatim] -> ShowS
$cshowList :: [Verbatim] -> ShowS
show :: Verbatim -> String
$cshow :: Verbatim -> String
showsPrec :: Int -> Verbatim -> ShowS
$cshowsPrec :: Int -> 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 (m :: * -> *) a. Monad m => a -> m a
return (String -> Verbatim
VerbatimLiteral (String -> Verbatim) -> String -> Verbatim
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s)
    Object Object
_ -> Map String VerbatimValue -> Verbatim
VerbatimObject (Map String VerbatimValue -> Verbatim)
-> Parser (Map String VerbatimValue) -> Parser Verbatim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Map String VerbatimValue)
forall a. FromValue a => Value -> Parser a
fromValue Value
v
    Value
_ -> String -> Value -> Parser Verbatim
forall a. String -> Value -> Parser a
typeMismatch ([String] -> String
formatOrList [String
"String", String
"Object"]) Value
v

data CommonOptions cSources cxxSources jsSources a = CommonOptions {
  CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsSourceDirs :: Maybe (List FilePath)
, CommonOptions cSources cxxSources jsSources a -> Maybe Dependencies
commonOptionsDependencies :: Maybe Dependencies
, CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsPkgConfigDependencies :: Maybe (List String)
, CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsDefaultExtensions :: Maybe (List String)
, CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsOtherExtensions :: Maybe (List String)
, CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsGhcOptions :: Maybe (List GhcOption)
, CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsGhcProfOptions :: Maybe (List GhcProfOption)
, CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsGhcjsOptions :: Maybe (List GhcjsOption)
, CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsCppOptions :: Maybe (List CppOption)
, CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsCcOptions :: Maybe (List CcOption)
, CommonOptions cSources cxxSources jsSources a -> cSources
commonOptionsCSources :: cSources
, CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsCxxOptions :: Maybe (List CxxOption)
, CommonOptions cSources cxxSources jsSources a -> cxxSources
commonOptionsCxxSources :: cxxSources
, CommonOptions cSources cxxSources jsSources a -> jsSources
commonOptionsJsSources :: jsSources
, CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsExtraLibDirs :: Maybe (List FilePath)
, CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsExtraLibraries :: Maybe (List FilePath)
, CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsExtraFrameworksDirs :: Maybe (List FilePath)
, CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsFrameworks :: Maybe (List String)
, CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsIncludeDirs :: Maybe (List FilePath)
, CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsInstallIncludes :: Maybe (List FilePath)
, CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsLdOptions :: Maybe (List LdOption)
, CommonOptions cSources cxxSources jsSources a -> Maybe Bool
commonOptionsBuildable :: Maybe Bool
, CommonOptions cSources cxxSources jsSources a
-> Maybe
     (List (ConditionalSection cSources cxxSources jsSources a))
commonOptionsWhen :: Maybe (List (ConditionalSection cSources cxxSources jsSources a))
, CommonOptions cSources cxxSources jsSources a -> Maybe BuildTools
commonOptionsBuildTools :: Maybe BuildTools
, CommonOptions cSources cxxSources jsSources a
-> Maybe SystemBuildTools
commonOptionsSystemBuildTools :: Maybe SystemBuildTools
, CommonOptions cSources cxxSources jsSources a
-> Maybe (List Verbatim)
commonOptionsVerbatim :: Maybe (List Verbatim)
} deriving (a
-> CommonOptions cSources cxxSources jsSources b
-> CommonOptions cSources cxxSources jsSources a
(a -> b)
-> CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources b
(forall a b.
 (a -> b)
 -> CommonOptions cSources cxxSources jsSources a
 -> CommonOptions cSources cxxSources jsSources b)
-> (forall a b.
    a
    -> CommonOptions cSources cxxSources jsSources b
    -> CommonOptions cSources cxxSources jsSources a)
-> Functor (CommonOptions cSources cxxSources jsSources)
forall a b.
a
-> CommonOptions cSources cxxSources jsSources b
-> CommonOptions cSources cxxSources jsSources a
forall a b.
(a -> b)
-> CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources b
forall cSources cxxSources jsSources a b.
a
-> CommonOptions cSources cxxSources jsSources b
-> CommonOptions cSources cxxSources jsSources a
forall cSources cxxSources jsSources a b.
(a -> b)
-> CommonOptions cSources cxxSources jsSources a
-> CommonOptions 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
<$ :: a
-> CommonOptions cSources cxxSources jsSources b
-> CommonOptions cSources cxxSources jsSources a
$c<$ :: forall cSources cxxSources jsSources a b.
a
-> CommonOptions cSources cxxSources jsSources b
-> CommonOptions cSources cxxSources jsSources a
fmap :: (a -> b)
-> CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources b
$cfmap :: forall cSources cxxSources jsSources a b.
(a -> b)
-> CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources b
Functor, (forall x.
 CommonOptions cSources cxxSources jsSources a
 -> Rep (CommonOptions cSources cxxSources jsSources a) x)
-> (forall x.
    Rep (CommonOptions cSources cxxSources jsSources a) x
    -> CommonOptions cSources cxxSources jsSources a)
-> Generic (CommonOptions cSources cxxSources jsSources a)
forall x.
Rep (CommonOptions cSources cxxSources jsSources a) x
-> CommonOptions cSources cxxSources jsSources a
forall x.
CommonOptions cSources cxxSources jsSources a
-> Rep (CommonOptions cSources cxxSources jsSources a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall cSources cxxSources jsSources a x.
Rep (CommonOptions cSources cxxSources jsSources a) x
-> CommonOptions cSources cxxSources jsSources a
forall cSources cxxSources jsSources a x.
CommonOptions cSources cxxSources jsSources a
-> Rep (CommonOptions cSources cxxSources jsSources a) x
$cto :: forall cSources cxxSources jsSources a x.
Rep (CommonOptions cSources cxxSources jsSources a) x
-> CommonOptions cSources cxxSources jsSources a
$cfrom :: forall cSources cxxSources jsSources a x.
CommonOptions cSources cxxSources jsSources a
-> Rep (CommonOptions cSources cxxSources jsSources a) x
Generic)

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

instance (Semigroup cSources, Semigroup cxxSources, Semigroup jsSources, Monoid cSources, Monoid cxxSources, Monoid jsSources) => Monoid (CommonOptions cSources cxxSources jsSources a) where
  mempty :: CommonOptions cSources cxxSources jsSources a
mempty = CommonOptions :: forall cSources cxxSources jsSources a.
Maybe (List String)
-> Maybe Dependencies
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> cSources
-> Maybe (List String)
-> cxxSources
-> jsSources
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe Bool
-> Maybe
     (List (ConditionalSection cSources cxxSources jsSources a))
-> Maybe BuildTools
-> Maybe SystemBuildTools
-> Maybe (List Verbatim)
-> CommonOptions cSources cxxSources jsSources a
CommonOptions {
    commonOptionsSourceDirs :: Maybe (List String)
commonOptionsSourceDirs = Maybe (List String)
forall a. Maybe a
Nothing
  , commonOptionsDependencies :: Maybe Dependencies
commonOptionsDependencies = Maybe Dependencies
forall a. Maybe a
Nothing
  , commonOptionsPkgConfigDependencies :: Maybe (List String)
commonOptionsPkgConfigDependencies = Maybe (List String)
forall a. Maybe a
Nothing
  , commonOptionsDefaultExtensions :: Maybe (List String)
commonOptionsDefaultExtensions = Maybe (List String)
forall a. Maybe a
Nothing
  , commonOptionsOtherExtensions :: Maybe (List String)
commonOptionsOtherExtensions = Maybe (List String)
forall a. Maybe a
Nothing
  , commonOptionsGhcOptions :: Maybe (List String)
commonOptionsGhcOptions = Maybe (List String)
forall a. Maybe a
Nothing
  , commonOptionsGhcProfOptions :: Maybe (List String)
commonOptionsGhcProfOptions = Maybe (List String)
forall a. Maybe a
Nothing
  , commonOptionsGhcjsOptions :: Maybe (List String)
commonOptionsGhcjsOptions = Maybe (List String)
forall a. Maybe a
Nothing
  , commonOptionsCppOptions :: Maybe (List String)
commonOptionsCppOptions = Maybe (List String)
forall a. Maybe a
Nothing
  , commonOptionsCcOptions :: Maybe (List String)
commonOptionsCcOptions = Maybe (List String)
forall a. Maybe a
Nothing
  , commonOptionsCSources :: cSources
commonOptionsCSources = cSources
forall a. Monoid a => a
mempty
  , commonOptionsCxxOptions :: Maybe (List String)
commonOptionsCxxOptions = Maybe (List String)
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 :: Maybe (List String)
commonOptionsExtraLibDirs = Maybe (List String)
forall a. Maybe a
Nothing
  , commonOptionsExtraLibraries :: Maybe (List String)
commonOptionsExtraLibraries = Maybe (List String)
forall a. Maybe a
Nothing
  , commonOptionsExtraFrameworksDirs :: Maybe (List String)
commonOptionsExtraFrameworksDirs = Maybe (List String)
forall a. Maybe a
Nothing
  , commonOptionsFrameworks :: Maybe (List String)
commonOptionsFrameworks = Maybe (List String)
forall a. Maybe a
Nothing
  , commonOptionsIncludeDirs :: Maybe (List String)
commonOptionsIncludeDirs = Maybe (List String)
forall a. Maybe a
Nothing
  , commonOptionsInstallIncludes :: Maybe (List String)
commonOptionsInstallIncludes = Maybe (List String)
forall a. Maybe a
Nothing
  , commonOptionsLdOptions :: Maybe (List String)
commonOptionsLdOptions = Maybe (List String)
forall a. Maybe a
Nothing
  , commonOptionsBuildable :: Maybe Bool
commonOptionsBuildable = Maybe Bool
forall a. Maybe a
Nothing
  , commonOptionsWhen :: Maybe (List (ConditionalSection cSources cxxSources jsSources a))
commonOptionsWhen = Maybe (List (ConditionalSection cSources cxxSources jsSources a))
forall a. Maybe a
Nothing
  , commonOptionsBuildTools :: Maybe BuildTools
commonOptionsBuildTools = 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 cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources a
mappend = CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources a
forall a. Semigroup a => a -> a -> a
(<>)

instance (Semigroup cSources, Semigroup cxxSources, Semigroup jsSources) => Semigroup (CommonOptions cSources cxxSources jsSources a) where
  CommonOptions cSources cxxSources jsSources a
a <> :: CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources a
<> CommonOptions cSources cxxSources jsSources a
b = CommonOptions :: forall cSources cxxSources jsSources a.
Maybe (List String)
-> Maybe Dependencies
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> cSources
-> Maybe (List String)
-> cxxSources
-> jsSources
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe (List String)
-> Maybe Bool
-> Maybe
     (List (ConditionalSection cSources cxxSources jsSources a))
-> Maybe BuildTools
-> Maybe SystemBuildTools
-> Maybe (List Verbatim)
-> CommonOptions cSources cxxSources jsSources a
CommonOptions {
    commonOptionsSourceDirs :: Maybe (List String)
commonOptionsSourceDirs = CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsSourceDirs CommonOptions cSources cxxSources jsSources a
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsSourceDirs CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsDependencies :: Maybe Dependencies
commonOptionsDependencies = CommonOptions cSources cxxSources jsSources a -> Maybe Dependencies
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> Maybe Dependencies
commonOptionsDependencies CommonOptions cSources cxxSources jsSources a
b Maybe Dependencies -> Maybe Dependencies -> Maybe Dependencies
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> Maybe Dependencies
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> Maybe Dependencies
commonOptionsDependencies CommonOptions cSources cxxSources jsSources a
a
  , commonOptionsPkgConfigDependencies :: Maybe (List String)
commonOptionsPkgConfigDependencies = CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsPkgConfigDependencies CommonOptions cSources cxxSources jsSources a
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsPkgConfigDependencies CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsDefaultExtensions :: Maybe (List String)
commonOptionsDefaultExtensions = CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsDefaultExtensions CommonOptions cSources cxxSources jsSources a
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsDefaultExtensions CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsOtherExtensions :: Maybe (List String)
commonOptionsOtherExtensions = CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsOtherExtensions CommonOptions cSources cxxSources jsSources a
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsOtherExtensions CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsGhcOptions :: Maybe (List String)
commonOptionsGhcOptions = CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsGhcOptions CommonOptions cSources cxxSources jsSources a
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsGhcOptions CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsGhcProfOptions :: Maybe (List String)
commonOptionsGhcProfOptions = CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsGhcProfOptions CommonOptions cSources cxxSources jsSources a
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsGhcProfOptions CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsGhcjsOptions :: Maybe (List String)
commonOptionsGhcjsOptions = CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsGhcjsOptions CommonOptions cSources cxxSources jsSources a
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsGhcjsOptions CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsCppOptions :: Maybe (List String)
commonOptionsCppOptions = CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsCppOptions CommonOptions cSources cxxSources jsSources a
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsCppOptions CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsCcOptions :: Maybe (List String)
commonOptionsCcOptions = CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsCcOptions CommonOptions cSources cxxSources jsSources a
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsCcOptions CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsCSources :: cSources
commonOptionsCSources = CommonOptions cSources cxxSources jsSources a -> cSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> cSources
commonOptionsCSources CommonOptions cSources cxxSources jsSources a
a cSources -> cSources -> cSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> cSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> cSources
commonOptionsCSources CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsCxxOptions :: Maybe (List String)
commonOptionsCxxOptions = CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsCxxOptions CommonOptions cSources cxxSources jsSources a
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsCxxOptions CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsCxxSources :: cxxSources
commonOptionsCxxSources = CommonOptions cSources cxxSources jsSources a -> cxxSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> cxxSources
commonOptionsCxxSources CommonOptions cSources cxxSources jsSources a
a cxxSources -> cxxSources -> cxxSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> cxxSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> cxxSources
commonOptionsCxxSources CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsJsSources :: jsSources
commonOptionsJsSources = CommonOptions cSources cxxSources jsSources a -> jsSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> jsSources
commonOptionsJsSources CommonOptions cSources cxxSources jsSources a
a jsSources -> jsSources -> jsSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> jsSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> jsSources
commonOptionsJsSources CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsExtraLibDirs :: Maybe (List String)
commonOptionsExtraLibDirs = CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsExtraLibDirs CommonOptions cSources cxxSources jsSources a
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsExtraLibDirs CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsExtraLibraries :: Maybe (List String)
commonOptionsExtraLibraries = CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsExtraLibraries CommonOptions cSources cxxSources jsSources a
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsExtraLibraries CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsExtraFrameworksDirs :: Maybe (List String)
commonOptionsExtraFrameworksDirs = CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsExtraFrameworksDirs CommonOptions cSources cxxSources jsSources a
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsExtraFrameworksDirs CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsFrameworks :: Maybe (List String)
commonOptionsFrameworks = CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsFrameworks CommonOptions cSources cxxSources jsSources a
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsFrameworks CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsIncludeDirs :: Maybe (List String)
commonOptionsIncludeDirs = CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsIncludeDirs CommonOptions cSources cxxSources jsSources a
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsIncludeDirs CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsInstallIncludes :: Maybe (List String)
commonOptionsInstallIncludes = CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsInstallIncludes CommonOptions cSources cxxSources jsSources a
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsInstallIncludes CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsLdOptions :: Maybe (List String)
commonOptionsLdOptions = CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsLdOptions CommonOptions cSources cxxSources jsSources a
a Maybe (List String) -> Maybe (List String) -> Maybe (List String)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsLdOptions CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsBuildable :: Maybe Bool
commonOptionsBuildable = CommonOptions cSources cxxSources jsSources a -> Maybe Bool
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> Maybe Bool
commonOptionsBuildable CommonOptions cSources cxxSources jsSources a
b Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CommonOptions cSources cxxSources jsSources a -> Maybe Bool
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> Maybe Bool
commonOptionsBuildable CommonOptions cSources cxxSources jsSources a
a
  , commonOptionsWhen :: Maybe (List (ConditionalSection cSources cxxSources jsSources a))
commonOptionsWhen = CommonOptions cSources cxxSources jsSources a
-> Maybe
     (List (ConditionalSection cSources cxxSources jsSources a))
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe
     (List (ConditionalSection cSources cxxSources jsSources a))
commonOptionsWhen CommonOptions cSources cxxSources jsSources a
a Maybe (List (ConditionalSection cSources cxxSources jsSources a))
-> Maybe
     (List (ConditionalSection cSources cxxSources jsSources a))
-> Maybe
     (List (ConditionalSection cSources cxxSources jsSources a))
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe
     (List (ConditionalSection cSources cxxSources jsSources a))
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe
     (List (ConditionalSection cSources cxxSources jsSources a))
commonOptionsWhen CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsBuildTools :: Maybe BuildTools
commonOptionsBuildTools = CommonOptions cSources cxxSources jsSources a -> Maybe BuildTools
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> Maybe BuildTools
commonOptionsBuildTools CommonOptions cSources cxxSources jsSources a
a Maybe BuildTools -> Maybe BuildTools -> Maybe BuildTools
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> Maybe BuildTools
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> Maybe BuildTools
commonOptionsBuildTools CommonOptions cSources cxxSources jsSources a
b
  , commonOptionsSystemBuildTools :: Maybe SystemBuildTools
commonOptionsSystemBuildTools = CommonOptions cSources cxxSources jsSources a
-> Maybe SystemBuildTools
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe SystemBuildTools
commonOptionsSystemBuildTools CommonOptions cSources cxxSources jsSources a
b Maybe SystemBuildTools
-> Maybe SystemBuildTools -> Maybe SystemBuildTools
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe SystemBuildTools
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe SystemBuildTools
commonOptionsSystemBuildTools CommonOptions cSources cxxSources jsSources a
a
  , commonOptionsVerbatim :: Maybe (List Verbatim)
commonOptionsVerbatim = CommonOptions cSources cxxSources jsSources a
-> Maybe (List Verbatim)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List Verbatim)
commonOptionsVerbatim CommonOptions cSources cxxSources jsSources a
a Maybe (List Verbatim)
-> Maybe (List Verbatim) -> Maybe (List Verbatim)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Maybe (List Verbatim)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List Verbatim)
commonOptionsVerbatim CommonOptions cSources cxxSources jsSources a
b
  }

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

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

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

data Traverse m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_ = Traverse {
  Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> cSources -> m cSources_
traverseCSources :: cSources -> m cSources_
, Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> cxxSources -> m cxxSources_
traverseCxxSources :: cxxSources -> m cxxSources_
, Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> jsSources -> m jsSources_
traverseJsSources :: jsSources -> m jsSources_
}

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

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

traverseCommonOptions :: Traversal_ CommonOptions
traverseCommonOptions :: Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> CommonOptions cSources cxxSources jsSources a
-> m (CommonOptions cSources_ cxxSources_ jsSources_ a)
traverseCommonOptions t :: Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t@Traverse{cSources -> m cSources_
cxxSources -> m cxxSources_
jsSources -> m jsSources_
traverseJsSources :: jsSources -> m jsSources_
traverseCxxSources :: cxxSources -> m cxxSources_
traverseCSources :: cSources -> m cSources_
traverseJsSources :: forall (m :: * -> *) cSources cSources_ cxxSources cxxSources_
       jsSources jsSources_.
Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> jsSources -> m jsSources_
traverseCxxSources :: forall (m :: * -> *) cSources cSources_ cxxSources cxxSources_
       jsSources jsSources_.
Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> cxxSources -> m cxxSources_
traverseCSources :: forall (m :: * -> *) cSources cSources_ cxxSources cxxSources_
       jsSources jsSources_.
Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> cSources -> m cSources_
..} c :: CommonOptions cSources cxxSources jsSources a
c@CommonOptions{cSources
cxxSources
jsSources
Maybe Bool
Maybe (List String)
Maybe (List (ConditionalSection cSources cxxSources jsSources a))
Maybe (List Verbatim)
Maybe Dependencies
Maybe SystemBuildTools
Maybe BuildTools
commonOptionsVerbatim :: Maybe (List Verbatim)
commonOptionsSystemBuildTools :: Maybe SystemBuildTools
commonOptionsBuildTools :: Maybe BuildTools
commonOptionsWhen :: Maybe (List (ConditionalSection cSources cxxSources jsSources a))
commonOptionsBuildable :: Maybe Bool
commonOptionsLdOptions :: Maybe (List String)
commonOptionsInstallIncludes :: Maybe (List String)
commonOptionsIncludeDirs :: Maybe (List String)
commonOptionsFrameworks :: Maybe (List String)
commonOptionsExtraFrameworksDirs :: Maybe (List String)
commonOptionsExtraLibraries :: Maybe (List String)
commonOptionsExtraLibDirs :: Maybe (List String)
commonOptionsJsSources :: jsSources
commonOptionsCxxSources :: cxxSources
commonOptionsCxxOptions :: Maybe (List String)
commonOptionsCSources :: cSources
commonOptionsCcOptions :: Maybe (List String)
commonOptionsCppOptions :: Maybe (List String)
commonOptionsGhcjsOptions :: Maybe (List String)
commonOptionsGhcProfOptions :: Maybe (List String)
commonOptionsGhcOptions :: Maybe (List String)
commonOptionsOtherExtensions :: Maybe (List String)
commonOptionsDefaultExtensions :: Maybe (List String)
commonOptionsPkgConfigDependencies :: Maybe (List String)
commonOptionsDependencies :: Maybe Dependencies
commonOptionsSourceDirs :: Maybe (List String)
commonOptionsVerbatim :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List Verbatim)
commonOptionsSystemBuildTools :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe SystemBuildTools
commonOptionsBuildTools :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> Maybe BuildTools
commonOptionsWhen :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe
     (List (ConditionalSection cSources cxxSources jsSources a))
commonOptionsBuildable :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> Maybe Bool
commonOptionsLdOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsInstallIncludes :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsIncludeDirs :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsFrameworks :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsExtraFrameworksDirs :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsExtraLibraries :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsExtraLibDirs :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsJsSources :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> jsSources
commonOptionsCxxSources :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> cxxSources
commonOptionsCxxOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsCSources :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> cSources
commonOptionsCcOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsCppOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsGhcjsOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsGhcProfOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsGhcOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsOtherExtensions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsDefaultExtensions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsPkgConfigDependencies :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsDependencies :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> Maybe Dependencies
commonOptionsSourceDirs :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
..} = do
  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 cSources_ cxxSources_ jsSources_ a))
xs <- (List (ConditionalSection cSources cxxSources jsSources a)
 -> m (List
         (ConditionalSection cSources_ cxxSources_ jsSources_ a)))
-> Maybe
     (List (ConditionalSection cSources cxxSources jsSources a))
-> m (Maybe
        (List (ConditionalSection cSources_ cxxSources_ jsSources_ a)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((ConditionalSection cSources cxxSources jsSources a
 -> m (ConditionalSection cSources_ cxxSources_ jsSources_ a))
-> List (ConditionalSection cSources cxxSources jsSources a)
-> m (List (ConditionalSection cSources_ cxxSources_ jsSources_ a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> ConditionalSection cSources cxxSources jsSources a
-> m (ConditionalSection cSources_ cxxSources_ jsSources_ a)
Traversal_ ConditionalSection
traverseConditionalSection Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t)) Maybe (List (ConditionalSection cSources cxxSources jsSources a))
commonOptionsWhen
  CommonOptions cSources_ cxxSources_ jsSources_ a
-> m (CommonOptions cSources_ cxxSources_ jsSources_ a)
forall (m :: * -> *) a. Monad m => a -> m a
return CommonOptions cSources cxxSources jsSources a
c {
      commonOptionsCSources :: cSources_
commonOptionsCSources = cSources_
cSources
    , commonOptionsCxxSources :: cxxSources_
commonOptionsCxxSources = cxxSources_
cxxSources
    , commonOptionsJsSources :: jsSources_
commonOptionsJsSources = jsSources_
jsSources
    , commonOptionsWhen :: Maybe
  (List (ConditionalSection cSources_ cxxSources_ jsSources_ a))
commonOptionsWhen = Maybe
  (List (ConditionalSection cSources_ cxxSources_ jsSources_ a))
xs
    }

traverseConditionalSection :: Traversal_ ConditionalSection
traverseConditionalSection :: Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> ConditionalSection cSources cxxSources jsSources a
-> m (ConditionalSection cSources_ cxxSources_ jsSources_ a)
traverseConditionalSection t :: Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t@Traverse{cSources -> m cSources_
cxxSources -> m cxxSources_
jsSources -> m jsSources_
traverseJsSources :: jsSources -> m jsSources_
traverseCxxSources :: cxxSources -> m cxxSources_
traverseCSources :: cSources -> m cSources_
traverseJsSources :: forall (m :: * -> *) cSources cSources_ cxxSources cxxSources_
       jsSources jsSources_.
Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> jsSources -> m jsSources_
traverseCxxSources :: forall (m :: * -> *) cSources cSources_ cxxSources cxxSources_
       jsSources jsSources_.
Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> cxxSources -> m cxxSources_
traverseCSources :: forall (m :: * -> *) cSources cSources_ cxxSources cxxSources_
       jsSources jsSources_.
Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> cSources -> m cSources_
..} = \ case
  ThenElseConditional Product (ThenElse cSources cxxSources jsSources a) Condition
c -> Product (ThenElse cSources_ cxxSources_ jsSources_ a) Condition
-> ConditionalSection cSources_ cxxSources_ jsSources_ a
forall cSources cxxSources jsSources a.
Product (ThenElse cSources cxxSources jsSources a) Condition
-> ConditionalSection cSources cxxSources jsSources a
ThenElseConditional (Product (ThenElse cSources_ cxxSources_ jsSources_ a) Condition
 -> ConditionalSection cSources_ cxxSources_ jsSources_ a)
-> m (Product
        (ThenElse cSources_ cxxSources_ jsSources_ a) Condition)
-> m (ConditionalSection cSources_ cxxSources_ jsSources_ a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ThenElse cSources cxxSources jsSources a
 -> m (ThenElse cSources_ cxxSources_ jsSources_ a))
-> (Condition -> m Condition)
-> Product (ThenElse cSources cxxSources jsSources a) Condition
-> m (Product
        (ThenElse cSources_ cxxSources_ jsSources_ a) Condition)
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 cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> ThenElse cSources cxxSources jsSources a
-> m (ThenElse cSources_ cxxSources_ jsSources_ a)
Traversal_ ThenElse
traverseThenElse Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t) Condition -> m Condition
forall (m :: * -> *) a. Monad m => a -> m a
return Product (ThenElse cSources cxxSources jsSources a) Condition
c
  FlatConditional Product
  (WithCommonOptions cSources cxxSources jsSources a) Condition
c -> Product
  (WithCommonOptions cSources_ cxxSources_ jsSources_ a) Condition
-> ConditionalSection cSources_ cxxSources_ jsSources_ a
forall cSources cxxSources jsSources a.
Product
  (WithCommonOptions cSources cxxSources jsSources a) Condition
-> ConditionalSection cSources cxxSources jsSources a
FlatConditional (Product
   (WithCommonOptions cSources_ cxxSources_ jsSources_ a) Condition
 -> ConditionalSection cSources_ cxxSources_ jsSources_ a)
-> m (Product
        (WithCommonOptions cSources_ cxxSources_ jsSources_ a) Condition)
-> m (ConditionalSection cSources_ cxxSources_ jsSources_ a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WithCommonOptions cSources cxxSources jsSources a
 -> m (WithCommonOptions cSources_ cxxSources_ jsSources_ a))
-> (Condition -> m Condition)
-> Product
     (WithCommonOptions cSources cxxSources jsSources a) Condition
-> m (Product
        (WithCommonOptions cSources_ cxxSources_ jsSources_ a) Condition)
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 cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> WithCommonOptions cSources cxxSources jsSources a
-> m (WithCommonOptions cSources_ cxxSources_ jsSources_ a)
Traversal_ WithCommonOptions
traverseWithCommonOptions Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t) Condition -> m Condition
forall (m :: * -> *) a. Monad m => a -> m a
return Product
  (WithCommonOptions cSources cxxSources jsSources a) Condition
c

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

traverseWithCommonOptions :: Traversal_ WithCommonOptions
traverseWithCommonOptions :: Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> WithCommonOptions cSources cxxSources jsSources a
-> m (WithCommonOptions cSources_ cxxSources_ jsSources_ a)
traverseWithCommonOptions Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t = (CommonOptions cSources cxxSources jsSources a
 -> m (CommonOptions cSources_ cxxSources_ jsSources_ a))
-> (a -> m a)
-> WithCommonOptions cSources cxxSources jsSources a
-> m (WithCommonOptions cSources_ cxxSources_ jsSources_ a)
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 cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> CommonOptions cSources cxxSources jsSources a
-> m (CommonOptions cSources_ cxxSources_ jsSources_ a)
Traversal_ CommonOptions
traverseCommonOptions Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t) a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

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

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

type ParseConditionalSection = ConditionalSection ParseCSources ParseCxxSources ParseJsSources

instance FromValue a => FromValue (ParseConditionalSection a) where
  fromValue :: Value -> Parser (ParseConditionalSection a)
fromValue Value
v
    | Text -> Value -> Bool
hasKey Text
"then" Value
v Bool -> Bool -> Bool
|| Text -> Value -> Bool
hasKey Text
"else" Value
v = Product
  (ThenElse
     (Maybe (List String))
     (Maybe (List String))
     (Maybe (List String))
     a)
  Condition
-> ParseConditionalSection a
forall cSources cxxSources jsSources a.
Product (ThenElse cSources cxxSources jsSources a) Condition
-> ConditionalSection cSources cxxSources jsSources a
ThenElseConditional (Product
   (ThenElse
      (Maybe (List String))
      (Maybe (List String))
      (Maybe (List String))
      a)
   Condition
 -> ParseConditionalSection a)
-> Parser
     (Product
        (ThenElse
           (Maybe (List String))
           (Maybe (List String))
           (Maybe (List String))
           a)
        Condition)
-> Parser (ParseConditionalSection a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
-> Parser
     (Product
        (ThenElse
           (Maybe (List String))
           (Maybe (List String))
           (Maybe (List String))
           a)
        Condition)
forall a. FromValue a => Value -> Parser a
fromValue Value
v Parser (ParseConditionalSection a)
-> Parser () -> Parser (ParseConditionalSection a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
giveHint
    | Bool
otherwise = Product
  (WithCommonOptions
     (Maybe (List String))
     (Maybe (List String))
     (Maybe (List String))
     a)
  Condition
-> ParseConditionalSection a
forall cSources cxxSources jsSources a.
Product
  (WithCommonOptions cSources cxxSources jsSources a) Condition
-> ConditionalSection cSources cxxSources jsSources a
FlatConditional (Product
   (WithCommonOptions
      (Maybe (List String))
      (Maybe (List String))
      (Maybe (List String))
      a)
   Condition
 -> ParseConditionalSection a)
-> Parser
     (Product
        (WithCommonOptions
           (Maybe (List String))
           (Maybe (List String))
           (Maybe (List String))
           a)
        Condition)
-> Parser (ParseConditionalSection a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
-> Parser
     (Product
        (WithCommonOptions
           (Maybe (List String))
           (Maybe (List String))
           (Maybe (List String))
           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
<$> Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"then" Object
o Maybe (Value -> Value -> (Value, Value, Value))
-> Maybe Value -> Maybe (Value -> (Value, Value, Value))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"else" Object
o Maybe (Value -> (Value, Value, Value))
-> Maybe Value -> Maybe (Value, Value, Value)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"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 k v. HashMap k v -> Bool
HashMap.null Object
then_) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"then" String -> Value -> Parser ()
`emptyTryInstead` Value
flatElse
            Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Object -> Bool
forall k v. HashMap k v -> Bool
HashMap.null Object
else_) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"else" String -> Value -> Parser ()
`emptyTryInstead` Value
flatThen
            where
              flatThen :: Value
flatThen = Text -> Object -> Value
forall k.
(ToJSONKey k, Eq k, Hashable k, IsString k) =>
Text -> HashMap k Value -> Value
flatConditional Text
condition Object
then_
              flatElse :: Value
flatElse = Text -> Object -> Value
forall k.
(ToJSONKey k, Eq k, Hashable k, IsString k) =>
Text -> HashMap k Value -> Value
flatConditional (Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
negate_ Text
condition) Object
else_
          Maybe (Value, Value, Value)
_ -> () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Value
_ -> () -> Parser ()
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 -> HashMap k Value -> Value
flatConditional Text
condition HashMap k Value
sect = [Pair] -> Value
object [(Text
"when" Text -> HashMap k Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= k -> Value -> HashMap k Value -> HashMap k Value
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert k
"condition" (Text -> Value
String Text
condition) HashMap k Value
sect)]

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

      encodePretty :: Value -> String
encodePretty = Text -> String
T.unpack (Text -> String) -> (Value -> Text) -> Value -> String
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 :: Text -> Value -> Bool
hasKey :: Text -> Value -> Bool
hasKey Text
key (Object Object
o) = Text -> Object -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Text
key Object
o
hasKey Text
_ 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
/= :: Condition -> Condition -> Bool
$c/= :: Condition -> Condition -> Bool
== :: Condition -> Condition -> Bool
$c== :: Condition -> Condition -> Bool
Eq, Int -> Condition -> ShowS
[Condition] -> ShowS
Condition -> String
(Int -> Condition -> ShowS)
-> (Condition -> String)
-> ([Condition] -> ShowS)
-> Show Condition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Condition] -> ShowS
$cshowList :: [Condition] -> ShowS
show :: Condition -> String
$cshow :: Condition -> String
showsPrec :: Int -> Condition -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep Condition x -> Condition
$cfrom :: forall x. Condition -> Rep Condition x
Generic, Value -> Parser Condition
(Value -> Parser Condition) -> FromValue Condition
forall a. (Value -> Parser a) -> FromValue a
fromValue :: Value -> Parser Condition
$cfromValue :: 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
/= :: Cond -> Cond -> Bool
$c/= :: Cond -> Cond -> Bool
== :: Cond -> Cond -> Bool
$c== :: Cond -> Cond -> Bool
Eq, Int -> Cond -> ShowS
[Cond] -> ShowS
Cond -> String
(Int -> Cond -> ShowS)
-> (Cond -> String) -> ([Cond] -> ShowS) -> Show Cond
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cond] -> ShowS
$cshowList :: [Cond] -> ShowS
show :: Cond -> String
$cshow :: Cond -> String
showsPrec :: Int -> Cond -> ShowS
$cshowsPrec :: Int -> 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 (m :: * -> *) a. Monad m => a -> m a
return (String -> Cond
CondExpression (String -> Cond) -> String -> Cond
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
c)
    Bool Bool
c -> Cond -> Parser Cond
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Cond
CondBool Bool
c)
    Value
_ -> String -> Value -> Parser Cond
forall a. String -> Value -> Parser a
typeMismatch String
"Boolean or String" Value
v

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

instance Functor (ThenElse cSources cxxSources jsSources) where
  fmap :: (a -> b)
-> ThenElse cSources cxxSources jsSources a
-> ThenElse cSources cxxSources jsSources b
fmap a -> b
f c :: ThenElse cSources cxxSources jsSources a
c@ThenElse{WithCommonOptions cSources cxxSources jsSources a
thenElseElse :: WithCommonOptions cSources cxxSources jsSources a
thenElseThen :: WithCommonOptions cSources cxxSources jsSources a
thenElseElse :: forall cSources cxxSources jsSources a.
ThenElse cSources cxxSources jsSources a
-> WithCommonOptions cSources cxxSources jsSources a
thenElseThen :: forall cSources cxxSources jsSources a.
ThenElse cSources cxxSources jsSources a
-> WithCommonOptions cSources cxxSources jsSources a
..} = ThenElse cSources cxxSources jsSources a
c{thenElseThen :: WithCommonOptions cSources cxxSources jsSources b
thenElseThen = WithCommonOptions cSources cxxSources jsSources a
-> WithCommonOptions cSources cxxSources jsSources b
map_ WithCommonOptions cSources cxxSources jsSources a
thenElseThen, thenElseElse :: WithCommonOptions cSources cxxSources jsSources b
thenElseElse = WithCommonOptions cSources cxxSources jsSources a
-> WithCommonOptions cSources cxxSources jsSources b
map_ WithCommonOptions cSources cxxSources jsSources a
thenElseElse}
    where
      map_ :: WithCommonOptions cSources cxxSources jsSources a
-> WithCommonOptions cSources cxxSources jsSources b
map_ = (CommonOptions cSources cxxSources jsSources a
 -> CommonOptions cSources cxxSources jsSources b)
-> (a -> b)
-> WithCommonOptions cSources cxxSources jsSources a
-> WithCommonOptions cSources cxxSources jsSources b
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((a -> b)
-> CommonOptions cSources cxxSources jsSources a
-> CommonOptions 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 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
/= :: Empty -> Empty -> Bool
$c/= :: Empty -> Empty -> Bool
== :: Empty -> Empty -> Bool
$c== :: Empty -> Empty -> Bool
Eq, Int -> Empty -> ShowS
[Empty] -> ShowS
Empty -> String
(Int -> Empty -> ShowS)
-> (Empty -> String) -> ([Empty] -> ShowS) -> Show Empty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Empty] -> ShowS
$cshowList :: [Empty] -> ShowS
show :: Empty -> String
$cshow :: Empty -> String
showsPrec :: Int -> Empty -> ShowS
$cshowsPrec :: Int -> 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 (m :: * -> *) a. Monad m => a -> m a
return Empty
Empty

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
/= :: BuildType -> BuildType -> Bool
$c/= :: BuildType -> BuildType -> Bool
== :: BuildType -> BuildType -> Bool
$c== :: BuildType -> BuildType -> Bool
Eq, Int -> BuildType -> ShowS
[BuildType] -> ShowS
BuildType -> String
(Int -> BuildType -> ShowS)
-> (BuildType -> String)
-> ([BuildType] -> ShowS)
-> Show BuildType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuildType] -> ShowS
$cshowList :: [BuildType] -> ShowS
show :: BuildType -> String
$cshow :: BuildType -> String
showsPrec :: Int -> BuildType -> ShowS
$cshowsPrec :: Int -> BuildType -> ShowS
Show, (forall x. BuildType -> Rep BuildType x)
-> (forall x. Rep BuildType x -> BuildType) -> Generic BuildType
forall x. Rep BuildType x -> BuildType
forall x. BuildType -> Rep BuildType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BuildType x -> BuildType
$cfrom :: forall x. BuildType -> Rep BuildType x
Generic, 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
enumFromThenTo :: BuildType -> BuildType -> BuildType -> [BuildType]
$cenumFromThenTo :: BuildType -> BuildType -> BuildType -> [BuildType]
enumFromTo :: BuildType -> BuildType -> [BuildType]
$cenumFromTo :: BuildType -> BuildType -> [BuildType]
enumFromThen :: BuildType -> BuildType -> [BuildType]
$cenumFromThen :: BuildType -> BuildType -> [BuildType]
enumFrom :: BuildType -> [BuildType]
$cenumFrom :: BuildType -> [BuildType]
fromEnum :: BuildType -> Int
$cfromEnum :: BuildType -> Int
toEnum :: Int -> BuildType
$ctoEnum :: Int -> BuildType
pred :: BuildType -> BuildType
$cpred :: BuildType -> BuildType
succ :: BuildType -> BuildType
$csucc :: BuildType -> BuildType
Enum, BuildType
BuildType -> BuildType -> Bounded BuildType
forall a. a -> a -> Bounded a
maxBound :: BuildType
$cmaxBound :: BuildType
minBound :: BuildType
$cminBound :: 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 -> String
T.unpack -> String
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 (m :: * -> *) a. Monad m => a -> m a
return (String -> [(String, BuildType)] -> Maybe BuildType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
t [(String, BuildType)]
options)
    where
      err :: Parser a
err = String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"expected one of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
formatOrList [String]
buildTypesAsString)
      buildTypes :: [BuildType]
buildTypes = [BuildType
forall a. Bounded a => a
minBound .. BuildType
forall a. Bounded a => a
maxBound]
      buildTypesAsString :: [String]
buildTypesAsString = (BuildType -> String) -> [BuildType] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map BuildType -> String
forall a. Show a => a -> String
show [BuildType]
buildTypes
      options :: [(String, BuildType)]
options = [String] -> [BuildType] -> [(String, BuildType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
buildTypesAsString [BuildType]
buildTypes

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

type SectionConfigWithDefaluts cSources cxxSources jsSources a = Product DefaultsConfig (WithCommonOptions cSources cxxSources jsSources a)

type PackageConfigWithDefaults cSources cxxSources jsSources = PackageConfig_
  (SectionConfigWithDefaluts cSources cxxSources jsSources LibrarySection)
  (SectionConfigWithDefaluts cSources cxxSources jsSources ExecutableSection)

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

data PackageVersion = PackageVersion {PackageVersion -> String
unPackageVersion :: String}

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

data PackageConfig_ library executable = PackageConfig {
  PackageConfig_ library executable -> Maybe String
packageConfigName :: Maybe String
, PackageConfig_ library executable -> Maybe PackageVersion
packageConfigVersion :: Maybe PackageVersion
, PackageConfig_ library executable -> Maybe String
packageConfigSynopsis :: Maybe String
, PackageConfig_ library executable -> Maybe String
packageConfigDescription :: Maybe String
, PackageConfig_ library executable -> Maybe (Maybe String)
packageConfigHomepage :: Maybe (Maybe String)
, PackageConfig_ library executable -> Maybe (Maybe String)
packageConfigBugReports :: Maybe (Maybe String)
, PackageConfig_ library executable -> Maybe String
packageConfigCategory :: Maybe String
, PackageConfig_ library executable -> Maybe String
packageConfigStability :: Maybe String
, PackageConfig_ library executable -> Maybe (List String)
packageConfigAuthor :: Maybe (List String)
, PackageConfig_ library executable -> Maybe (Maybe (List String))
packageConfigMaintainer :: Maybe (Maybe (List String))
, PackageConfig_ library executable -> Maybe (List String)
packageConfigCopyright :: Maybe (List String)
, PackageConfig_ library executable -> Maybe BuildType
packageConfigBuildType :: Maybe BuildType
, PackageConfig_ library executable -> Maybe (Maybe String)
packageConfigLicense :: Maybe (Maybe String)
, PackageConfig_ library executable -> Maybe (List String)
packageConfigLicenseFile :: Maybe (List String)
, PackageConfig_ library executable -> Maybe (List String)
packageConfigTestedWith :: Maybe (List String)
, PackageConfig_ library executable -> Maybe (Map String FlagSection)
packageConfigFlags :: Maybe (Map String FlagSection)
, PackageConfig_ library executable -> Maybe (List String)
packageConfigExtraSourceFiles :: Maybe (List FilePath)
, PackageConfig_ library executable -> Maybe (List String)
packageConfigExtraDocFiles :: Maybe (List FilePath)
, PackageConfig_ library executable -> Maybe (List String)
packageConfigDataFiles :: Maybe (List FilePath)
, PackageConfig_ library executable -> Maybe String
packageConfigDataDir :: Maybe FilePath
, PackageConfig_ library executable -> Maybe GitHub
packageConfigGithub :: Maybe GitHub
, PackageConfig_ library executable -> Maybe String
packageConfigGit :: Maybe String
, PackageConfig_ library executable -> Maybe CustomSetupSection
packageConfigCustomSetup :: Maybe CustomSetupSection
, PackageConfig_ library executable -> Maybe library
packageConfigLibrary :: Maybe library
, PackageConfig_ library executable -> Maybe (Map String library)
packageConfigInternalLibraries :: Maybe (Map String library)
, PackageConfig_ library executable -> Maybe executable
packageConfigExecutable :: Maybe executable
, PackageConfig_ library executable -> Maybe (Map String executable)
packageConfigExecutables :: Maybe (Map String executable)
, PackageConfig_ library executable -> Maybe (Map String executable)
packageConfigTests :: Maybe (Map String executable)
, PackageConfig_ library executable -> Maybe (Map String 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
$cto :: forall library executable x.
Rep (PackageConfig_ library executable) x
-> PackageConfig_ library executable
$cfrom :: forall library executable x.
PackageConfig_ library executable
-> Rep (PackageConfig_ library executable) x
Generic

data GitHub = GitHub {
  GitHub -> String
_gitHubOwner :: String
, GitHub -> String
_gitHubRepo :: String
, GitHub -> Maybe String
_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 -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ([Text] -> [String]) -> [Text] -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
"/" Text
input of
      [String
owner, String
repo, String
subdir] -> GitHub -> Parser GitHub
forall (m :: * -> *) a. Monad m => a -> m a
return (GitHub -> Parser GitHub) -> GitHub -> Parser GitHub
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe String -> GitHub
GitHub String
owner String
repo (String -> Maybe String
forall a. a -> Maybe a
Just String
subdir)
      [String
owner, String
repo] -> GitHub -> Parser GitHub
forall (m :: * -> *) a. Monad m => a -> m a
return (GitHub -> Parser GitHub) -> GitHub -> Parser GitHub
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe String -> GitHub
GitHub String
owner String
repo Maybe String
forall a. Maybe a
Nothing
      [String]
_ -> String -> Parser GitHub
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser GitHub) -> String -> Parser GitHub
forall a b. (a -> b) -> a -> b
$ String
"expected owner/repo or owner/repo/subdir, but encountered " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
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
$cto :: forall x. Rep DefaultsConfig x -> DefaultsConfig
$cfrom :: forall x. DefaultsConfig -> Rep DefaultsConfig x
Generic, Value -> Parser DefaultsConfig
(Value -> Parser DefaultsConfig) -> FromValue DefaultsConfig
forall a. (Value -> Parser a) -> FromValue a
fromValue :: Value -> Parser DefaultsConfig
$cfromValue :: Value -> Parser DefaultsConfig
FromValue)

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

type ParsePackageConfig = PackageConfigWithDefaults ParseCSources ParseCxxSources ParseJsSources

instance FromValue ParsePackageConfig

type Warnings m = WriterT [String] m
type Errors = ExceptT String

decodeYaml :: FromValue a => ProgramName -> FilePath -> Warnings (Errors IO) a
decodeYaml :: ProgramName -> String -> Warnings (Errors IO) a
decodeYaml ProgramName
programName String
file = do
  ([String]
warnings, Value
a) <- ExceptT String IO ([String], Value)
-> WriterT [String] (Errors IO) ([String], Value)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Either String ([String], Value))
-> ExceptT String IO ([String], Value)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String ([String], Value))
 -> ExceptT String IO ([String], Value))
-> IO (Either String ([String], Value))
-> ExceptT String IO ([String], Value)
forall a b. (a -> b) -> a -> b
$ String -> IO (Either String ([String], Value))
Yaml.decodeYaml String
file)
  [String] -> WriterT [String] (Errors IO) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [String]
warnings
  ProgramName -> String -> Value -> Warnings (Errors IO) a
forall a.
FromValue a =>
ProgramName -> String -> Value -> Warnings (Errors IO) a
decodeValue ProgramName
programName String
file Value
a

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

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

instance IsString ProgramName where
  fromString :: String -> ProgramName
fromString = String -> ProgramName
ProgramName

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

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

readPackageConfig :: DecodeOptions -> IO (Either String DecodeResult)
readPackageConfig :: DecodeOptions -> IO (Either String DecodeResult)
readPackageConfig (DecodeOptions ProgramName
programName String
file Maybe String
mUserDataDir String -> IO (Either String ([String], Value))
readValue) = ExceptT String IO DecodeResult -> IO (Either String DecodeResult)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO DecodeResult -> IO (Either String DecodeResult))
-> ExceptT String IO DecodeResult
-> IO (Either String DecodeResult)
forall a b. (a -> b) -> a -> b
$ (((Package, String), [String]) -> DecodeResult)
-> ExceptT String IO ((Package, String), [String])
-> ExceptT String IO DecodeResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Package, String), [String]) -> DecodeResult
addCabalFile (ExceptT String IO ((Package, String), [String])
 -> ExceptT String IO DecodeResult)
-> (WriterT [String] (Errors IO) (Package, String)
    -> ExceptT String IO ((Package, String), [String]))
-> WriterT [String] (Errors IO) (Package, String)
-> ExceptT String IO DecodeResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [String] (Errors IO) (Package, String)
-> ExceptT String IO ((Package, String), [String])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [String] (Errors IO) (Package, String)
 -> ExceptT String IO DecodeResult)
-> WriterT [String] (Errors IO) (Package, String)
-> ExceptT String IO DecodeResult
forall a b. (a -> b) -> a -> b
$ do
  ([String]
warnings, Value
value) <- ExceptT String IO ([String], Value)
-> WriterT [String] (Errors IO) ([String], Value)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT String IO ([String], Value)
 -> WriterT [String] (Errors IO) ([String], Value))
-> (IO (Either String ([String], Value))
    -> ExceptT String IO ([String], Value))
-> IO (Either String ([String], Value))
-> WriterT [String] (Errors IO) ([String], Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either String ([String], Value))
-> ExceptT String IO ([String], Value)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String ([String], Value))
 -> WriterT [String] (Errors IO) ([String], Value))
-> IO (Either String ([String], Value))
-> WriterT [String] (Errors IO) ([String], Value)
forall a b. (a -> b) -> a -> b
$ String -> IO (Either String ([String], Value))
readValue String
file
  [String] -> WriterT [String] (Errors IO) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [String]
warnings
  ConfigWithDefaults
config <- ProgramName
-> String -> Value -> Warnings (Errors IO) ConfigWithDefaults
forall a.
FromValue a =>
ProgramName -> String -> Value -> Warnings (Errors IO) a
decodeValue ProgramName
programName String
file Value
value
  String
dir <- IO String -> WriterT [String] (Errors IO) String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> WriterT [String] (Errors IO) String)
-> IO String -> WriterT [String] (Errors IO) String
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
canonicalizePath String
file
  String
userDataDir <- IO String -> WriterT [String] (Errors IO) String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> WriterT [String] (Errors IO) String)
-> IO String -> WriterT [String] (Errors IO) String
forall a b. (a -> b) -> a -> b
$ IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO String
getAppUserDataDirectory String
"hpack") String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
mUserDataDir
  ProgramName
-> String
-> String
-> ConfigWithDefaults
-> WriterT [String] (Errors IO) (Package, String)
toPackage ProgramName
programName String
userDataDir String
dir ConfigWithDefaults
config
  where
    addCabalFile :: ((Package, String), [String]) -> DecodeResult
    addCabalFile :: ((Package, String), [String]) -> DecodeResult
addCabalFile ((Package
pkg, String
cabalVersion), [String]
warnings) = Package -> String -> String -> [String] -> DecodeResult
DecodeResult Package
pkg String
cabalVersion (ShowS
takeDirectory_ String
file String -> ShowS
</> (Package -> String
packageName Package
pkg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".cabal")) [String]
warnings

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

deleteVerbatimField :: String -> [Verbatim] -> [Verbatim]
deleteVerbatimField :: String -> [Verbatim] -> [Verbatim]
deleteVerbatimField String
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 String VerbatimValue
o -> Map String VerbatimValue -> Verbatim
VerbatimObject (String -> Map String VerbatimValue -> Map String VerbatimValue
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete String
name Map String VerbatimValue
o)

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

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

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

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

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

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

    inferredCabalVersion :: String
    inferredCabalVersion :: String
inferredCabalVersion = Version -> String
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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Section Library -> Maybe Version
libraryCabalVersion
      , Map String (Section Library) -> Maybe Version
internalLibsCabalVersion Map String (Section Library)
packageInternalLibraries
      , Map String (Section Executable) -> Maybe Version
executablesCabalVersion Map String (Section Executable)
packageExecutables
      , Map String (Section Executable) -> Maybe Version
executablesCabalVersion Map String (Section Executable)
packageTests
      , Map String (Section Executable) -> Maybe Version
executablesCabalVersion Map String (Section Executable)
packageBenchmarks
      ]

    packageCabalVersion :: Maybe Version
    packageCabalVersion :: Maybe Version
packageCabalVersion = [Maybe Version] -> Maybe Version
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 (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 (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 (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 (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 (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [
        [Int] -> Version
makeVersion [Int
1,Int
22] Version -> Maybe () -> Maybe Version
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Library -> [String]) -> Bool
forall (t :: * -> *) a. Foldable t => (Library -> t a) -> Bool
has Library -> [String]
libraryReexportedModules)
      , [Int] -> Version
makeVersion [Int
2,Int
0]  Version -> Maybe () -> Maybe Version
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Library -> [String]) -> Bool
forall (t :: * -> *) a. Foldable t => (Library -> t a) -> Bool
has Library -> [String]
librarySignatures)
      , [Int] -> Version
makeVersion [Int
2,Int
0] Version -> Maybe () -> Maybe Version
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 (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Library -> Maybe String) -> Bool
forall (t :: * -> *) a. Foldable t => (Library -> t a) -> Bool
has Library -> Maybe String
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 (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 String (Section Library) -> Maybe Version
internalLibsCabalVersion Map String (Section Library)
internalLibraries
      | Map String (Section Library) -> Bool
forall k a. Map k a -> Bool
Map.null Map String (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 (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 String (Section Library) -> [Section Library]
forall k a. Map k a -> [a]
Map.elems Map String (Section Library)
internalLibraries

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

        pathsModule :: Module
pathsModule = String -> Module
pathsModuleFromPackageName String
packageName

        versionFromSystemBuildTool :: String -> Maybe Version
versionFromSystemBuildTool String
name
          | String
name String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
known_1_10 = Maybe Version
forall a. Maybe a
Nothing
          | String
name String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
known_1_14 = Version -> Maybe Version
forall a. a -> Maybe a
Just ([Int] -> Version
makeVersion [Int
1,Int
14])
          | String
name String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
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 :: [String]
known_1_10 = [
            String
"ghc"
          , String
"ghc-pkg"
          , String
"hugs"
          , String
"ffihugs"
          , String
"nhc98"
          , String
"hmake"
          , String
"jhc"
          , String
"lhc"
          , String
"lhc-pkg"
          , String
"uhc"
          , String
"gcc"
          , String
"ranlib"
          , String
"ar"
          , String
"strip"
          , String
"ld"
          , String
"tar"
          , String
"pkg-config"
          ] [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [
          -- Support for these build tools has been removed from Cabal at some point
            String
"hugs"
          , String
"ffihugs"
          , String
"nhc98"
          , String
"ranlib"
          , String
"lhc"
          , String
"lhc-pkg"
          ]
        known_1_14 :: [String]
known_1_14 = [
            String
"hpc"
          ]
        known_1_22 :: [String]
known_1_22 = [
            String
"ghcjs"
          , String
"ghcjs-pkg"
          -- , "haskell-suite" // not a real build tool
          -- , "haskell-suite-pkg" // not a real build tool
          ]

        systemBuildTools :: [String]
        systemBuildTools :: [String]
systemBuildTools = Map String VersionConstraint -> [String]
forall k a. Map k a -> [k]
Map.keys (Map String VersionConstraint -> [String])
-> Map String VersionConstraint -> [String]
forall a b. (a -> b) -> a -> b
$ SystemBuildTools -> Map String VersionConstraint
unSystemBuildTools (SystemBuildTools -> Map String VersionConstraint)
-> SystemBuildTools -> Map String VersionConstraint
forall a b. (a -> b) -> a -> b
$ (Section a -> SystemBuildTools) -> Section a -> SystemBuildTools
forall b a.
(Semigroup b, 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 :: (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 [String]
mixins DependencyVersion
_) = Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
mixins)

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

sectionAll :: (Semigroup b, Monoid b) => (Section a -> b) -> Section a -> b
sectionAll :: (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 (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Section a -> b) -> Conditional (Section a) -> b
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.
(Semigroup b, 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 => ProgramName -> FilePath -> Value -> Warnings (Errors IO) a
decodeValue :: ProgramName -> String -> Value -> Warnings (Errors IO) a
decodeValue (ProgramName String
programName) String
file Value
value = do
  (CheckSpecVersion a
r, [String]
unknown) <- ExceptT String IO (CheckSpecVersion a, [String])
-> WriterT [String] (Errors IO) (CheckSpecVersion a, [String])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT String IO (CheckSpecVersion a, [String])
 -> WriterT [String] (Errors IO) (CheckSpecVersion a, [String]))
-> (Either String (CheckSpecVersion a, [String])
    -> ExceptT String IO (CheckSpecVersion a, [String]))
-> Either String (CheckSpecVersion a, [String])
-> WriterT [String] (Errors IO) (CheckSpecVersion a, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either String (CheckSpecVersion a, [String]))
-> ExceptT String IO (CheckSpecVersion a, [String])
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String (CheckSpecVersion a, [String]))
 -> ExceptT String IO (CheckSpecVersion a, [String]))
-> (Either String (CheckSpecVersion a, [String])
    -> IO (Either String (CheckSpecVersion a, [String])))
-> Either String (CheckSpecVersion a, [String])
-> ExceptT String IO (CheckSpecVersion a, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String (CheckSpecVersion a, [String])
-> IO (Either String (CheckSpecVersion a, [String]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (CheckSpecVersion a, [String])
 -> WriterT [String] (Errors IO) (CheckSpecVersion a, [String]))
-> Either String (CheckSpecVersion a, [String])
-> WriterT [String] (Errors IO) (CheckSpecVersion a, [String])
forall a b. (a -> b) -> a -> b
$ ShowS
-> Either String (CheckSpecVersion a, [String])
-> Either String (CheckSpecVersion a, [String])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++) (Value -> Either String (CheckSpecVersion a, [String])
forall a. FromValue a => Value -> Result a
Config.decodeValue Value
value)
  case CheckSpecVersion a
r of
    UnsupportedSpecVersion Version
v -> do
      ExceptT String IO a -> Warnings (Errors IO) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT String IO a -> Warnings (Errors IO) a)
-> ExceptT String IO a -> Warnings (Errors IO) a
forall a b. (a -> b) -> a -> b
$ String -> ExceptT String IO a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (String
"The file " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" requires version " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" of the Hpack package specification, however this version of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
programName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" only supports versions up to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
Hpack.version String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Upgrading to the latest version of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
programName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" may resolve this issue.")
    SupportedSpecVersion a
a -> do
      [String] -> WriterT [String] (Errors IO) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
formatUnknownField [String]
unknown)
      a -> Warnings (Errors IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  where
    prefix :: String
prefix = String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": "
    formatUnknownField :: ShowS
formatUnknownField String
name = String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Ignoring unrecognized field " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name

data CheckSpecVersion a = SupportedSpecVersion 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 -> Text -> Parser (Maybe ParseSpecVersion)
forall a. FromValue a => Object -> Text -> Parser (Maybe a)
.:? Text
"spec-version" Parser (Maybe ParseSpecVersion)
-> (Maybe ParseSpecVersion -> Parser (CheckSpecVersion a))
-> Parser (CheckSpecVersion a)
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 (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
_ -> a -> CheckSpecVersion a
forall a. a -> CheckSpecVersion a
SupportedSpecVersion (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 Version

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

data Package = Package {
  Package -> String
packageName :: String
, Package -> String
packageVersion :: String
, Package -> Maybe String
packageSynopsis :: Maybe String
, Package -> Maybe String
packageDescription :: Maybe String
, Package -> Maybe String
packageHomepage :: Maybe String
, Package -> Maybe String
packageBugReports :: Maybe String
, Package -> Maybe String
packageCategory :: Maybe String
, Package -> Maybe String
packageStability :: Maybe String
, Package -> [String]
packageAuthor :: [String]
, Package -> [String]
packageMaintainer :: [String]
, Package -> [String]
packageCopyright :: [String]
, Package -> BuildType
packageBuildType :: BuildType
, Package -> Maybe String
packageLicense :: Maybe String
, Package -> [String]
packageLicenseFile :: [FilePath]
, Package -> [String]
packageTestedWith :: [String]
, Package -> [Flag]
packageFlags :: [Flag]
, Package -> [Path]
packageExtraSourceFiles :: [Path]
, Package -> [Path]
packageExtraDocFiles :: [Path]
, Package -> [Path]
packageDataFiles :: [Path]
, Package -> Maybe String
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 String (Section Library)
packageInternalLibraries :: Map String (Section Library)
, Package -> Map String (Section Executable)
packageExecutables :: Map String (Section Executable)
, Package -> Map String (Section Executable)
packageTests :: Map String (Section Executable)
, Package -> Map String (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
/= :: Package -> Package -> Bool
$c/= :: Package -> Package -> Bool
== :: Package -> Package -> Bool
$c== :: Package -> Package -> Bool
Eq, Int -> Package -> ShowS
[Package] -> ShowS
Package -> String
(Int -> Package -> ShowS)
-> (Package -> String) -> ([Package] -> ShowS) -> Show Package
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Package] -> ShowS
$cshowList :: [Package] -> ShowS
show :: Package -> String
$cshow :: Package -> String
showsPrec :: Int -> Package -> ShowS
$cshowsPrec :: Int -> 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
/= :: CustomSetup -> CustomSetup -> Bool
$c/= :: CustomSetup -> CustomSetup -> Bool
== :: CustomSetup -> CustomSetup -> Bool
$c== :: CustomSetup -> CustomSetup -> Bool
Eq, Int -> CustomSetup -> ShowS
[CustomSetup] -> ShowS
CustomSetup -> String
(Int -> CustomSetup -> ShowS)
-> (CustomSetup -> String)
-> ([CustomSetup] -> ShowS)
-> Show CustomSetup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomSetup] -> ShowS
$cshowList :: [CustomSetup] -> ShowS
show :: CustomSetup -> String
$cshow :: CustomSetup -> String
showsPrec :: Int -> CustomSetup -> ShowS
$cshowsPrec :: Int -> CustomSetup -> ShowS
Show)

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

data Executable = Executable {
  Executable -> Maybe String
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
/= :: Executable -> Executable -> Bool
$c/= :: Executable -> Executable -> Bool
== :: Executable -> Executable -> Bool
$c== :: Executable -> Executable -> Bool
Eq, Int -> Executable -> ShowS
[Executable] -> ShowS
Executable -> String
(Int -> Executable -> ShowS)
-> (Executable -> String)
-> ([Executable] -> ShowS)
-> Show Executable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Executable] -> ShowS
$cshowList :: [Executable] -> ShowS
show :: Executable -> String
$cshow :: Executable -> String
showsPrec :: Int -> Executable -> ShowS
$cshowsPrec :: Int -> Executable -> ShowS
Show)

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

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

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

data FlagSection = FlagSection {
  FlagSection -> Maybe String
_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
/= :: FlagSection -> FlagSection -> Bool
$c/= :: FlagSection -> FlagSection -> Bool
== :: FlagSection -> FlagSection -> Bool
$c== :: FlagSection -> FlagSection -> Bool
Eq, Int -> FlagSection -> ShowS
[FlagSection] -> ShowS
FlagSection -> String
(Int -> FlagSection -> ShowS)
-> (FlagSection -> String)
-> ([FlagSection] -> ShowS)
-> Show FlagSection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlagSection] -> ShowS
$cshowList :: [FlagSection] -> ShowS
show :: FlagSection -> String
$cshow :: FlagSection -> String
showsPrec :: Int -> FlagSection -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep FlagSection x -> FlagSection
$cfrom :: forall x. FlagSection -> Rep FlagSection x
Generic, Value -> Parser FlagSection
(Value -> Parser FlagSection) -> FromValue FlagSection
forall a. (Value -> Parser a) -> FromValue a
fromValue :: Value -> Parser FlagSection
$cfromValue :: Value -> Parser FlagSection
FromValue)

data Flag = Flag {
  Flag -> String
flagName :: String
, Flag -> Maybe String
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
/= :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c== :: Flag -> Flag -> Bool
Eq, Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> String
(Int -> Flag -> ShowS)
-> (Flag -> String) -> ([Flag] -> ShowS) -> Show Flag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flag] -> ShowS
$cshowList :: [Flag] -> ShowS
show :: Flag -> String
$cshow :: Flag -> String
showsPrec :: Int -> Flag -> ShowS
$cshowsPrec :: Int -> Flag -> ShowS
Show)

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

data SourceRepository = SourceRepository {
  SourceRepository -> String
sourceRepositoryUrl :: String
, SourceRepository -> Maybe String
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
/= :: SourceRepository -> SourceRepository -> Bool
$c/= :: SourceRepository -> SourceRepository -> Bool
== :: SourceRepository -> SourceRepository -> Bool
$c== :: SourceRepository -> SourceRepository -> Bool
Eq, Int -> SourceRepository -> ShowS
[SourceRepository] -> ShowS
SourceRepository -> String
(Int -> SourceRepository -> ShowS)
-> (SourceRepository -> String)
-> ([SourceRepository] -> ShowS)
-> Show SourceRepository
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceRepository] -> ShowS
$cshowList :: [SourceRepository] -> ShowS
show :: SourceRepository -> String
$cshow :: SourceRepository -> String
showsPrec :: Int -> SourceRepository -> ShowS
$cshowsPrec :: Int -> SourceRepository -> ShowS
Show)

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

traverseConfig :: Traversal Config
traverseConfig :: Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> Config cSources cxxSources jsSources
-> m (Config cSources_ cxxSources_ jsSources_)
traverseConfig Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t = (CommonOptions cSources cxxSources jsSources Empty
 -> m (CommonOptions cSources_ cxxSources_ jsSources_ Empty))
-> (PackageConfig cSources cxxSources jsSources
    -> m (PackageConfig cSources_ cxxSources_ jsSources_))
-> Config cSources cxxSources jsSources
-> m (Config cSources_ cxxSources_ jsSources_)
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 cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> CommonOptions cSources cxxSources jsSources Empty
-> m (CommonOptions cSources_ cxxSources_ jsSources_ Empty)
Traversal_ CommonOptions
traverseCommonOptions Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t) (Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> PackageConfig cSources cxxSources jsSources
-> m (PackageConfig cSources_ cxxSources_ jsSources_)
Traversal PackageConfig
traversePackageConfig Traverse
  m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t)

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

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

toPackage :: ProgramName -> FilePath -> FilePath -> ConfigWithDefaults -> Warnings (Errors IO) (Package, String)
toPackage :: ProgramName
-> String
-> String
-> ConfigWithDefaults
-> WriterT [String] (Errors IO) (Package, String)
toPackage ProgramName
programName String
userDataDir String
dir =
      ProgramName
-> String
-> String
-> ConfigWithDefaults
-> Warnings
     (Errors IO)
     (Config
        (Maybe (List String)) (Maybe (List String)) (Maybe (List String)))
expandDefaultsInConfig ProgramName
programName String
userDataDir String
dir
  (ConfigWithDefaults
 -> Warnings
      (Errors IO)
      (Config
         (Maybe (List String)) (Maybe (List String)) (Maybe (List String))))
-> (Config
      (Maybe (List String)) (Maybe (List String)) (Maybe (List String))
    -> WriterT [String] (Errors IO) (Package, String))
-> ConfigWithDefaults
-> WriterT [String] (Errors IO) (Package, String)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Traverse
  (Warnings (Errors IO))
  (Maybe (List String))
  [Path]
  (Maybe (List String))
  [Path]
  (Maybe (List String))
  [Path]
-> Config
     (Maybe (List String)) (Maybe (List String)) (Maybe (List String))
-> Warnings (Errors IO) (Config [Path] [Path] [Path])
Traversal Config
traverseConfig (String
-> Traverse
     (Warnings (Errors IO))
     (Maybe (List String))
     [Path]
     (Maybe (List String))
     [Path]
     (Maybe (List String))
     [Path]
forall (m :: * -> *).
MonadIO m =>
String
-> Traverse
     (Warnings m)
     (Maybe (List String))
     [Path]
     (Maybe (List String))
     [Path]
     (Maybe (List String))
     [Path]
expandForeignSources String
dir)
  (Config
   (Maybe (List String)) (Maybe (List String)) (Maybe (List String))
 -> Warnings (Errors IO) (Config [Path] [Path] [Path]))
-> (Config [Path] [Path] [Path]
    -> WriterT [String] (Errors IO) (Package, String))
-> Config
     (Maybe (List String)) (Maybe (List String)) (Maybe (List String))
-> WriterT [String] (Errors IO) (Package, String)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String
-> Config [Path] [Path] [Path]
-> WriterT [String] (Errors IO) (Package, String)
forall (m :: * -> *).
MonadIO m =>
String
-> Config [Path] [Path] [Path] -> Warnings m (Package, String)
toPackage_ String
dir

expandDefaultsInConfig
  :: ProgramName
  -> FilePath
  -> FilePath
  -> ConfigWithDefaults
  -> Warnings (Errors IO) (Config ParseCSources ParseCxxSources ParseJsSources)
expandDefaultsInConfig :: ProgramName
-> String
-> String
-> ConfigWithDefaults
-> Warnings
     (Errors IO)
     (Config
        (Maybe (List String)) (Maybe (List String)) (Maybe (List String)))
expandDefaultsInConfig ProgramName
programName String
userDataDir String
dir = (CommonOptionsWithDefaults Empty
 -> WriterT
      [String]
      (Errors IO)
      (CommonOptions
         (Maybe (List String))
         (Maybe (List String))
         (Maybe (List String))
         Empty))
-> (ParsePackageConfig
    -> WriterT
         [String]
         (Errors IO)
         (PackageConfig
            (Maybe (List String)) (Maybe (List String)) (Maybe (List String))))
-> ConfigWithDefaults
-> Warnings
     (Errors IO)
     (Config
        (Maybe (List String)) (Maybe (List String)) (Maybe (List String)))
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 (ProgramName
-> String
-> String
-> CommonOptionsWithDefaults Empty
-> WriterT
     [String]
     (Errors IO)
     (CommonOptions
        (Maybe (List String))
        (Maybe (List String))
        (Maybe (List String))
        Empty)
expandGlobalDefaults ProgramName
programName String
userDataDir String
dir) (ProgramName
-> String
-> String
-> ParsePackageConfig
-> WriterT
     [String]
     (Errors IO)
     (PackageConfig
        (Maybe (List String)) (Maybe (List String)) (Maybe (List String)))
expandSectionDefaults ProgramName
programName String
userDataDir String
dir)

expandGlobalDefaults
  :: ProgramName
  -> FilePath
  -> FilePath
  -> CommonOptionsWithDefaults Empty
  -> Warnings (Errors IO) (CommonOptions ParseCSources ParseCxxSources ParseJsSources Empty)
expandGlobalDefaults :: ProgramName
-> String
-> String
-> CommonOptionsWithDefaults Empty
-> WriterT
     [String]
     (Errors IO)
     (CommonOptions
        (Maybe (List String))
        (Maybe (List String))
        (Maybe (List String))
        Empty)
expandGlobalDefaults ProgramName
programName String
userDataDir String
dir = do
  (CommonOptions
   (Maybe (List String))
   (Maybe (List String))
   (Maybe (List String))
   Empty
 -> Product
      (CommonOptions
         (Maybe (List String))
         (Maybe (List String))
         (Maybe (List String))
         Empty)
      Empty)
-> CommonOptionsWithDefaults Empty
-> Product
     DefaultsConfig
     (Product
        (CommonOptions
           (Maybe (List String))
           (Maybe (List String))
           (Maybe (List String))
           Empty)
        Empty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CommonOptions
  (Maybe (List String))
  (Maybe (List String))
  (Maybe (List String))
  Empty
-> Empty
-> Product
     (CommonOptions
        (Maybe (List String))
        (Maybe (List String))
        (Maybe (List String))
        Empty)
     Empty
forall a b. a -> b -> Product a b
`Product` Empty
Empty) (CommonOptionsWithDefaults Empty
 -> Product
      DefaultsConfig
      (Product
         (CommonOptions
            (Maybe (List String))
            (Maybe (List String))
            (Maybe (List String))
            Empty)
         Empty))
-> (Product
      DefaultsConfig
      (Product
         (CommonOptions
            (Maybe (List String))
            (Maybe (List String))
            (Maybe (List String))
            Empty)
         Empty)
    -> WriterT
         [String]
         (Errors IO)
         (CommonOptions
            (Maybe (List String))
            (Maybe (List String))
            (Maybe (List String))
            Empty))
-> CommonOptionsWithDefaults Empty
-> WriterT
     [String]
     (Errors IO)
     (CommonOptions
        (Maybe (List String))
        (Maybe (List String))
        (Maybe (List String))
        Empty)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ProgramName
-> String
-> String
-> Product
     DefaultsConfig
     (Product
        (CommonOptions
           (Maybe (List String))
           (Maybe (List String))
           (Maybe (List String))
           Empty)
        Empty)
-> Warnings
     (Errors IO)
     (Product
        (CommonOptions
           (Maybe (List String))
           (Maybe (List String))
           (Maybe (List String))
           Empty)
        Empty)
forall a.
(FromValue a, Semigroup a, Monoid a) =>
ProgramName
-> String
-> String
-> WithCommonOptionsWithDefaults a
-> Warnings
     (Errors IO)
     (WithCommonOptions
        (Maybe (List String))
        (Maybe (List String))
        (Maybe (List String))
        a)
expandDefaults ProgramName
programName String
userDataDir String
dir (Product
   DefaultsConfig
   (Product
      (CommonOptions
         (Maybe (List String))
         (Maybe (List String))
         (Maybe (List String))
         Empty)
      Empty)
 -> Warnings
      (Errors IO)
      (Product
         (CommonOptions
            (Maybe (List String))
            (Maybe (List String))
            (Maybe (List String))
            Empty)
         Empty))
-> (Product
      (CommonOptions
         (Maybe (List String))
         (Maybe (List String))
         (Maybe (List String))
         Empty)
      Empty
    -> WriterT
         [String]
         (Errors IO)
         (CommonOptions
            (Maybe (List String))
            (Maybe (List String))
            (Maybe (List String))
            Empty))
-> Product
     DefaultsConfig
     (Product
        (CommonOptions
           (Maybe (List String))
           (Maybe (List String))
           (Maybe (List String))
           Empty)
        Empty)
-> WriterT
     [String]
     (Errors IO)
     (CommonOptions
        (Maybe (List String))
        (Maybe (List String))
        (Maybe (List String))
        Empty)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \ (Product CommonOptions
  (Maybe (List String))
  (Maybe (List String))
  (Maybe (List String))
  Empty
c Empty
Empty) -> CommonOptions
  (Maybe (List String))
  (Maybe (List String))
  (Maybe (List String))
  Empty
-> WriterT
     [String]
     (Errors IO)
     (CommonOptions
        (Maybe (List String))
        (Maybe (List String))
        (Maybe (List String))
        Empty)
forall (m :: * -> *) a. Monad m => a -> m a
return CommonOptions
  (Maybe (List String))
  (Maybe (List String))
  (Maybe (List String))
  Empty
c

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

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

    get :: forall a. (FromValue a, Semigroup a, Monoid a) =>
         [FilePath]
      -> FilePath
      -> Defaults
      -> Warnings (Errors IO) (WithCommonOptions ParseCSources ParseCxxSources ParseJsSources a)
    get :: [String]
-> String
-> Defaults
-> Warnings
     (Errors IO)
     (WithCommonOptions
        (Maybe (List String))
        (Maybe (List String))
        (Maybe (List String))
        a)
get [String]
seen String
dir Defaults
defaults = do
      String
file <- ExceptT String IO String -> WriterT [String] (Errors IO) String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT String IO String -> WriterT [String] (Errors IO) String)
-> ExceptT String IO String -> WriterT [String] (Errors IO) String
forall a b. (a -> b) -> a -> b
$ IO (Either String String) -> ExceptT String IO String
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (String -> String -> Defaults -> IO (Either String String)
ensure String
userDataDir String
dir Defaults
defaults)
      [String]
seen_ <- ExceptT String IO [String] -> WriterT [String] (Errors IO) [String]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([String] -> String -> ExceptT String IO [String]
checkCycle [String]
seen String
file)
      let dir_ :: String
dir_ = ShowS
takeDirectory String
file
      ProgramName
-> String -> Warnings (Errors IO) (WithCommonOptionsWithDefaults a)
forall a.
FromValue a =>
ProgramName -> String -> Warnings (Errors IO) a
decodeYaml ProgramName
programName String
file Warnings (Errors IO) (WithCommonOptionsWithDefaults a)
-> (WithCommonOptionsWithDefaults a
    -> Warnings
         (Errors IO)
         (WithCommonOptions
            (Maybe (List String))
            (Maybe (List String))
            (Maybe (List String))
            a))
-> Warnings
     (Errors IO)
     (WithCommonOptions
        (Maybe (List String))
        (Maybe (List String))
        (Maybe (List String))
        a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String]
-> String
-> WithCommonOptionsWithDefaults a
-> Warnings
     (Errors IO)
     (WithCommonOptions
        (Maybe (List String))
        (Maybe (List String))
        (Maybe (List String))
        a)
forall a.
(FromValue a, Semigroup a, Monoid a) =>
[String]
-> String
-> WithCommonOptionsWithDefaults a
-> Warnings
     (Errors IO)
     (WithCommonOptions
        (Maybe (List String))
        (Maybe (List String))
        (Maybe (List String))
        a)
expand [String]
seen_ String
dir_

    checkCycle :: [FilePath] -> FilePath -> Errors IO [FilePath]
    checkCycle :: [String] -> String -> ExceptT String IO [String]
checkCycle [String]
seen String
file = do
      String
canonic <- IO String -> ExceptT String IO String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> ExceptT String IO String)
-> IO String -> ExceptT String IO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath String
file
      let seen_ :: [String]
seen_ = String
canonic String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
seen
      Bool -> ExceptT String IO () -> ExceptT String IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
canonic String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
seen) (ExceptT String IO () -> ExceptT String IO ())
-> ExceptT String IO () -> ExceptT String IO ()
forall a b. (a -> b) -> a -> b
$ do
        String -> ExceptT String IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (String
"cycle in defaults (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" -> " ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
seen_) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")")
      [String] -> ExceptT String IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
seen_

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

type GlobalOptions = CommonOptions CSources CxxSources JsSources Empty

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

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

    toSect :: (Monad m, Monoid a) => WithCommonOptions CSources CxxSources JsSources a -> Warnings m (Section a)
    toSect :: WithCommonOptions [Path] [Path] [Path] a -> Warnings m (Section a)
toSect = String
-> [String]
-> WithCommonOptions [Path] [Path] [Path] a
-> Warnings m (Section a)
forall (m :: * -> *) a.
Monad m =>
String
-> [String]
-> WithCommonOptions [Path] [Path] [Path] a
-> Warnings m (Section a)
toSection String
packageName_ [String]
executableNames (WithCommonOptions [Path] [Path] [Path] a
 -> Warnings m (Section a))
-> (WithCommonOptions [Path] [Path] [Path] a
    -> WithCommonOptions [Path] [Path] [Path] a)
-> WithCommonOptions [Path] [Path] [Path] a
-> Warnings m (Section a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommonOptions [Path] [Path] [Path] a
 -> CommonOptions [Path] [Path] [Path] a)
-> WithCommonOptions [Path] [Path] [Path] a
-> WithCommonOptions [Path] [Path] [Path] a
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] a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ GlobalOptions
globalOptions) CommonOptions [Path] [Path] [Path] a
-> CommonOptions [Path] [Path] [Path] a
-> CommonOptions [Path] [Path] [Path] a
forall a. Semigroup a => a -> a -> a
<>)

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

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

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

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

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

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

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

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

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

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

  Maybe (License License)
inferredLicense <- case (Maybe (Maybe String)
packageConfigLicense, [String]
licenseFiles) of
    (Maybe (Maybe String)
Nothing, [String
file]) -> do
      Maybe String
input <- IO (Maybe String) -> WriterT [String] m (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Maybe String)
tryReadFile (String
dir String -> ShowS
</> String
file))
      case Maybe String
input Maybe String
-> (String -> Maybe (License License)) -> Maybe (License License)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe (License License)
inferLicense of
        Maybe (License License)
Nothing -> do
          [String] -> WriterT [String] m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [String
"Inferring license from file " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" failed!"]
          Maybe (License License)
-> WriterT [String] m (Maybe (License License))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (License License)
forall a. Maybe a
Nothing
        Maybe (License License)
license -> Maybe (License License)
-> WriterT [String] m (Maybe (License License))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (License License)
license
    (Maybe (Maybe String), [String])
_ -> Maybe (License License)
-> WriterT [String] m (Maybe (License License))
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 :: String
-> String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> [String]
-> [String]
-> [String]
-> BuildType
-> Maybe String
-> [String]
-> [String]
-> [Flag]
-> [Path]
-> [Path]
-> [Path]
-> Maybe String
-> Maybe SourceRepository
-> Maybe CustomSetup
-> Maybe (Section Library)
-> Map String (Section Library)
-> Map String (Section Executable)
-> Map String (Section Executable)
-> Map String (Section Executable)
-> [Verbatim]
-> Package
Package {
        packageName :: String
packageName = String
packageName_
      , packageVersion :: String
packageVersion = String
-> (PackageVersion -> String) -> Maybe PackageVersion -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"0.0.0" PackageVersion -> String
unPackageVersion Maybe PackageVersion
packageConfigVersion
      , packageSynopsis :: Maybe String
packageSynopsis = Maybe String
packageConfigSynopsis
      , packageDescription :: Maybe String
packageDescription = Maybe String
packageConfigDescription
      , packageHomepage :: Maybe String
packageHomepage = Maybe String
homepage
      , packageBugReports :: Maybe String
packageBugReports = Maybe String
bugReports
      , packageCategory :: Maybe String
packageCategory = Maybe String
packageConfigCategory
      , packageStability :: Maybe String
packageStability = Maybe String
packageConfigStability
      , packageAuthor :: [String]
packageAuthor = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
packageConfigAuthor
      , packageMaintainer :: [String]
packageMaintainer = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
maintainer
      , packageCopyright :: [String]
packageCopyright = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
packageConfigCopyright
      , packageBuildType :: BuildType
packageBuildType = BuildType -> Maybe BuildType -> BuildType
forall a. a -> Maybe a -> a
fromMaybe BuildType
defaultBuildType Maybe BuildType
packageConfigBuildType
      , packageLicense :: Maybe String
packageLicense = Maybe (Maybe String) -> Maybe String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe String)
packageConfigLicense
      , packageLicenseFile :: [String]
packageLicenseFile = [String]
licenseFiles
      , packageTestedWith :: [String]
packageTestedWith = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
packageConfigTestedWith
      , packageFlags :: [Flag]
packageFlags = [Flag]
flags
      , packageExtraSourceFiles :: [Path]
packageExtraSourceFiles = [Path]
extraSourceFiles
      , packageExtraDocFiles :: [Path]
packageExtraDocFiles = [Path]
extraDocFiles
      , packageDataFiles :: [Path]
packageDataFiles = [Path]
dataFiles
      , packageDataDir :: Maybe String
packageDataDir = Maybe String
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 String (Section Library)
packageInternalLibraries = Map String (Section Library)
internalLibraries
      , packageExecutables :: Map String (Section Executable)
packageExecutables = Map String (Section Executable)
executables
      , packageTests :: Map String (Section Executable)
packageTests = Map String (Section Executable)
tests
      , packageBenchmarks :: Map String (Section Executable)
packageBenchmarks = Map String (Section Executable)
benchmarks
      , packageVerbatim :: [Verbatim]
packageVerbatim = Maybe (List Verbatim) -> [Verbatim]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List Verbatim)
globalVerbatim
      }

  [String] -> WriterT [String] m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [String]
nameWarnings
  [String] -> WriterT [String] m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell ([String] -> [String]
formatMissingSourceDirs [String]
missingSourceDirs)
  (Package, String) -> Warnings m (Package, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (License License) -> Package -> (Package, String)
determineCabalVersion Maybe (License License)
inferredLicense Package
pkg)
  where
    nameWarnings :: [String]
    packageName_ :: String
    ([String]
nameWarnings, String
packageName_) = case Maybe String
packageConfigName of
      Maybe String
Nothing -> let inferredName :: String
inferredName = ShowS
takeBaseName String
dir in
        ([String
"Package name not specified, inferred " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
inferredName], String
inferredName)
      Just String
n -> ([], String
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 = ((String, FlagSection) -> Flag)
-> [(String, FlagSection)] -> [Flag]
forall a b. (a -> b) -> [a] -> [b]
map (String, FlagSection) -> Flag
toFlag ([(String, FlagSection)] -> [Flag])
-> [(String, FlagSection)] -> [Flag]
forall a b. (a -> b) -> a -> b
$ Maybe (Map String FlagSection) -> [(String, FlagSection)]
forall a. Maybe (Map String a) -> [(String, a)]
toList Maybe (Map String FlagSection)
packageConfigFlags

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

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

    sourceRepository :: Maybe SourceRepository
    sourceRepository :: Maybe SourceRepository
sourceRepository = Maybe SourceRepository
github Maybe SourceRepository
-> Maybe SourceRepository -> Maybe SourceRepository
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (String -> Maybe String -> SourceRepository
`SourceRepository` Maybe String
forall a. Maybe a
Nothing) (String -> SourceRepository)
-> Maybe String -> Maybe SourceRepository
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
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 String
owner String
repo Maybe String
subdir) = String -> Maybe String -> SourceRepository
SourceRepository (String
githubBaseUrl String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
owner String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
repo) Maybe String
subdir

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

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

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

expandForeignSources
  :: MonadIO m
  => FilePath
  -> Traverse (Warnings m) ParseCSources CSources ParseCxxSources CxxSources ParseJsSources JsSources
expandForeignSources :: String
-> Traverse
     (Warnings m)
     (Maybe (List String))
     [Path]
     (Maybe (List String))
     [Path]
     (Maybe (List String))
     [Path]
expandForeignSources String
dir = Traverse :: forall (m :: * -> *) cSources cSources_ cxxSources cxxSources_
       jsSources jsSources_.
(cSources -> m cSources_)
-> (cxxSources -> m cxxSources_)
-> (jsSources -> m jsSources_)
-> Traverse
     m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
Traverse {
    traverseCSources :: Maybe (List String) -> Warnings m [Path]
traverseCSources = String -> Maybe (List String) -> Warnings m [Path]
forall (m :: * -> *).
MonadIO m =>
String -> Maybe (List String) -> Warnings m [Path]
expand String
"c-sources"
  , traverseCxxSources :: Maybe (List String) -> Warnings m [Path]
traverseCxxSources = String -> Maybe (List String) -> Warnings m [Path]
forall (m :: * -> *).
MonadIO m =>
String -> Maybe (List String) -> Warnings m [Path]
expand String
"cxx-sources"
  , traverseJsSources :: Maybe (List String) -> Warnings m [Path]
traverseJsSources = String -> Maybe (List String) -> Warnings m [Path]
forall (m :: * -> *).
MonadIO m =>
String -> Maybe (List String) -> Warnings m [Path]
expand String
"js-sources"
  }
  where
    expand :: String -> Maybe (List String) -> Warnings m [Path]
expand String
fieldName Maybe (List String)
xs = do
      String -> String -> [String] -> Warnings m [Path]
forall (m :: * -> *).
MonadIO m =>
String -> String -> [String] -> Warnings m [Path]
expandGlobs String
fieldName String
dir (Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
xs)

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

instance IsString Path where
  fromString :: String -> Path
fromString = String -> Path
Path

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

toCustomSetup :: CustomSetupSection -> CustomSetup
toCustomSetup :: CustomSetupSection -> CustomSetup
toCustomSetup CustomSetupSection{Maybe Dependencies
customSetupSectionDependencies :: Maybe Dependencies
customSetupSectionDependencies :: CustomSetupSection -> Maybe Dependencies
..} = CustomSetup :: Dependencies -> CustomSetup
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 :: (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
[String]
[Path]
[Conditional (Section a)]
[Verbatim]
Maybe Bool
Map BuildTool DependencyVersion
Dependencies
SystemBuildTools
sectionVerbatim :: [Verbatim]
sectionSystemBuildTools :: SystemBuildTools
sectionBuildTools :: Map BuildTool DependencyVersion
sectionConditionals :: [Conditional (Section a)]
sectionBuildable :: Maybe Bool
sectionLdOptions :: [String]
sectionInstallIncludes :: [String]
sectionIncludeDirs :: [String]
sectionFrameworks :: [String]
sectionExtraFrameworksDirs :: [String]
sectionExtraLibraries :: [String]
sectionExtraLibDirs :: [String]
sectionJsSources :: [Path]
sectionCxxSources :: [Path]
sectionCxxOptions :: [String]
sectionCSources :: [Path]
sectionCcOptions :: [String]
sectionCppOptions :: [String]
sectionGhcjsOptions :: [String]
sectionGhcProfOptions :: [String]
sectionGhcOptions :: [String]
sectionOtherExtensions :: [String]
sectionDefaultExtensions :: [String]
sectionPkgConfigDependencies :: [String]
sectionDependencies :: Dependencies
sectionSourceDirs :: [String]
sectionData :: a
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 -> [String]
sectionInstallIncludes :: forall a. Section a -> [String]
sectionIncludeDirs :: forall a. Section a -> [String]
sectionFrameworks :: forall a. Section a -> [String]
sectionExtraFrameworksDirs :: forall a. Section a -> [String]
sectionExtraLibraries :: forall a. Section a -> [String]
sectionExtraLibDirs :: forall a. Section a -> [String]
sectionJsSources :: forall a. Section a -> [Path]
sectionCxxSources :: forall a. Section a -> [Path]
sectionCxxOptions :: forall a. Section a -> [String]
sectionCSources :: forall a. Section a -> [Path]
sectionCcOptions :: forall a. Section a -> [String]
sectionCppOptions :: forall a. Section a -> [String]
sectionGhcjsOptions :: forall a. Section a -> [String]
sectionGhcProfOptions :: forall a. Section a -> [String]
sectionGhcOptions :: forall a. Section a -> [String]
sectionOtherExtensions :: forall a. Section a -> [String]
sectionDefaultExtensions :: forall a. Section a -> [String]
sectionPkgConfigDependencies :: forall a. Section a -> [String]
sectionDependencies :: forall a. Section a -> Dependencies
sectionSourceDirs :: forall a. Section a -> [String]
sectionData :: forall a. Section a -> a
..} = 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 (m :: * -> *) a. Monad m => a -> m a
return Section a
sect{sectionData :: b
sectionData = b
x, sectionConditionals :: [Conditional (Section b)]
sectionConditionals = [Conditional (Section b)]
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)
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)
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 String
_ Maybe (List Module)
exposedModules Maybe (List Module)
generatedExposedModules Maybe (List Module)
otherModules Maybe (List Module)
generatedOtherModules Maybe (List String)
_ Maybe (List String)
_)
  = 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{[String]
[Module]
Maybe Bool
Maybe String
librarySignatures :: [String]
libraryReexportedModules :: [String]
libraryGeneratedModules :: [Module]
libraryOtherModules :: [Module]
libraryExposedModules :: [Module]
libraryVisibility :: Maybe String
libraryExposed :: Maybe Bool
libraryOtherModules :: Library -> [Module]
libraryExposedModules :: Library -> [Module]
libraryExposed :: Library -> Maybe Bool
libraryVisibility :: Library -> Maybe String
libraryGeneratedModules :: Library -> [Module]
librarySignatures :: Library -> [String]
libraryReexportedModules :: Library -> [String]
..} = [Module]
libraryExposedModules [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ [Module]
libraryOtherModules

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

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

removeConditionalsThatAreAlwaysFalse :: Section a -> Section a
removeConditionalsThatAreAlwaysFalse :: Section a -> Section a
removeConditionalsThatAreAlwaysFalse Section a
sect = Section a
sect {
    sectionConditionals :: [Conditional (Section a)]
sectionConditionals = (Conditional (Section a) -> Bool)
-> [Conditional (Section a)] -> [Conditional (Section a)]
forall a. (a -> Bool) -> [a] -> [a]
filter Conditional (Section a) -> Bool
forall a. Conditional a -> Bool
p ([Conditional (Section a)] -> [Conditional (Section a)])
-> [Conditional (Section a)] -> [Conditional (Section a)]
forall a b. (a -> b) -> a -> b
$ Section a -> [Conditional (Section a)]
forall a. Section a -> [Conditional (Section a)]
sectionConditionals Section a
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 ::
     FilePath
  -> String
  -> (a -> [Module])
  -> (b -> [Module])
  -> ([Module] -> [Module] -> a -> b)
  -> ([Module] -> a -> b)
  -> Section a
  -> IO (Section b)
inferModules :: String
-> String
-> (a -> [Module])
-> (b -> [Module])
-> ([Module] -> [Module] -> a -> b)
-> ([Module] -> a -> b)
-> Section a
-> IO (Section b)
inferModules String
dir String
packageName_ a -> [Module]
getMentionedModules b -> [Module]
getInferredModules [Module] -> [Module] -> a -> b
fromData [Module] -> a -> b
fromConditionals = (Section b -> Section b) -> IO (Section b) -> IO (Section b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Section b -> Section b
forall a. Section a -> Section a
removeConditionalsThatAreAlwaysFalse (IO (Section b) -> IO (Section b))
-> (Section a -> IO (Section b)) -> Section a -> IO (Section b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Module] -> Section a -> IO ([Module], b))
-> ([Module] -> Section a -> IO ([Module], b))
-> [Module]
-> Section a
-> IO (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 -> IO ([Module], b)
fromConfigSection [Module] -> [Module] -> a -> b
fromData [String -> Module
pathsModuleFromPackageName String
packageName_])
  (([Module] -> [Module] -> a -> b)
-> [Module] -> [Module] -> Section a -> IO ([Module], b)
fromConfigSection (\ [] -> [Module] -> a -> b
fromConditionals) [])
  []
  where
    fromConfigSection :: ([Module] -> [Module] -> a -> b)
-> [Module] -> [Module] -> Section a -> IO ([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 <- String -> Section a -> IO [Module]
forall a. String -> Section a -> IO [Module]
listModules String
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) -> IO ([Module], b)
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 :: FilePath -> String -> Section LibrarySection -> IO (Section Library)
toLibrary :: String -> String -> Section LibrarySection -> IO (Section Library)
toLibrary String
dir String
name =
    String
-> String
-> (LibrarySection -> [Module])
-> (Library -> [Module])
-> ([Module] -> [Module] -> LibrarySection -> Library)
-> ([Module] -> LibrarySection -> Library)
-> Section LibrarySection
-> IO (Section Library)
forall a b.
String
-> String
-> (a -> [Module])
-> (b -> [Module])
-> ([Module] -> [Module] -> a -> b)
-> ([Module] -> a -> b)
-> Section a
-> IO (Section b)
inferModules String
dir String
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 String
Maybe (List String)
Maybe (List Module)
librarySectionSignatures :: Maybe (List String)
librarySectionReexportedModules :: Maybe (List String)
librarySectionGeneratedOtherModules :: Maybe (List Module)
librarySectionOtherModules :: Maybe (List Module)
librarySectionGeneratedExposedModules :: Maybe (List Module)
librarySectionExposedModules :: Maybe (List Module)
librarySectionVisibility :: Maybe String
librarySectionExposed :: Maybe Bool
librarySectionSignatures :: LibrarySection -> Maybe (List String)
librarySectionReexportedModules :: LibrarySection -> Maybe (List String)
librarySectionGeneratedOtherModules :: LibrarySection -> Maybe (List Module)
librarySectionOtherModules :: LibrarySection -> Maybe (List Module)
librarySectionGeneratedExposedModules :: LibrarySection -> Maybe (List Module)
librarySectionExposedModules :: LibrarySection -> Maybe (List Module)
librarySectionVisibility :: LibrarySection -> Maybe String
librarySectionExposed :: LibrarySection -> Maybe Bool
..} =
      Maybe Bool
-> Maybe String
-> [Module]
-> [Module]
-> [Module]
-> [String]
-> [String]
-> Library
Library Maybe Bool
librarySectionExposed Maybe String
librarySectionVisibility [Module]
exposedModules [Module]
otherModules [Module]
generatedModules [String]
reexportedModules [String]
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 :: [String]
reexportedModules = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
librarySectionReexportedModules
        signatures :: [String]
signatures = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
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 String
_ Maybe (List Module)
exposedModules Maybe (List Module)
_ Maybe (List Module)
otherModules Maybe (List Module)
_ Maybe (List String)
_ Maybe (List String)
_) =
  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 :: [Module]
libraryOtherModules = [Module]
xs [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ Library -> [Module]
libraryOtherModules Library
r}

fromLibrarySectionPlain :: LibrarySection -> Library
fromLibrarySectionPlain :: LibrarySection -> Library
fromLibrarySectionPlain LibrarySection{Maybe Bool
Maybe String
Maybe (List String)
Maybe (List Module)
librarySectionSignatures :: Maybe (List String)
librarySectionReexportedModules :: Maybe (List String)
librarySectionGeneratedOtherModules :: Maybe (List Module)
librarySectionOtherModules :: Maybe (List Module)
librarySectionGeneratedExposedModules :: Maybe (List Module)
librarySectionExposedModules :: Maybe (List Module)
librarySectionVisibility :: Maybe String
librarySectionExposed :: Maybe Bool
librarySectionSignatures :: LibrarySection -> Maybe (List String)
librarySectionReexportedModules :: LibrarySection -> Maybe (List String)
librarySectionGeneratedOtherModules :: LibrarySection -> Maybe (List Module)
librarySectionOtherModules :: LibrarySection -> Maybe (List Module)
librarySectionGeneratedExposedModules :: LibrarySection -> Maybe (List Module)
librarySectionExposedModules :: LibrarySection -> Maybe (List Module)
librarySectionVisibility :: LibrarySection -> Maybe String
librarySectionExposed :: LibrarySection -> Maybe Bool
..} = Library :: Maybe Bool
-> Maybe String
-> [Module]
-> [Module]
-> [Module]
-> [String]
-> [String]
-> Library
Library {
    libraryExposed :: Maybe Bool
libraryExposed = Maybe Bool
librarySectionExposed
  , libraryVisibility :: Maybe String
libraryVisibility = Maybe String
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 :: [String]
libraryReexportedModules = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
librarySectionReexportedModules
  , librarySignatures :: [String]
librarySignatures = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
librarySectionSignatures
  }

getMentionedExecutableModules :: ExecutableSection -> [Module]
getMentionedExecutableModules :: ExecutableSection -> [Module]
getMentionedExecutableModules (ExecutableSection Maybe String
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) -> (String -> Path) -> String -> Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Path
Path.fromFilePath (String -> Module) -> Maybe String -> Maybe Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
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 :: FilePath -> String -> Section ExecutableSection -> IO (Section Executable)
toExecutable :: String
-> String -> Section ExecutableSection -> IO (Section Executable)
toExecutable String
dir String
packageName_ =
    String
-> String
-> (ExecutableSection -> [Module])
-> (Executable -> [Module])
-> ([Module] -> [Module] -> ExecutableSection -> Executable)
-> ([Module] -> ExecutableSection -> Executable)
-> Section ExecutableSection
-> IO (Section Executable)
forall a b.
String
-> String
-> (a -> [Module])
-> (b -> [Module])
-> ([Module] -> [Module] -> a -> b)
-> ([Module] -> a -> b)
-> Section a
-> IO (Section b)
inferModules String
dir String
packageName_ ExecutableSection -> [Module]
getMentionedExecutableModules Executable -> [Module]
getExecutableModules [Module] -> [Module] -> ExecutableSection -> Executable
fromExecutableSection ([Module] -> [Module] -> ExecutableSection -> Executable
fromExecutableSection [])
  (Section ExecutableSection -> IO (Section Executable))
-> (Section ExecutableSection -> Section ExecutableSection)
-> Section ExecutableSection
-> IO (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 String
Maybe (List Module)
executableSectionGeneratedOtherModules :: Maybe (List Module)
executableSectionOtherModules :: Maybe (List Module)
executableSectionMain :: Maybe String
executableSectionGeneratedOtherModules :: ExecutableSection -> Maybe (List Module)
executableSectionOtherModules :: ExecutableSection -> Maybe (List Module)
executableSectionMain :: ExecutableSection -> Maybe String
..} =
      (Maybe String -> [Module] -> [Module] -> Executable
Executable Maybe String
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 ([String], ExecutableSection) -> Section ExecutableSection
flatten (Section ([String], ExecutableSection)
 -> Section ExecutableSection)
-> (Section ExecutableSection
    -> Section ([String], ExecutableSection))
-> Section ExecutableSection
-> Section ExecutableSection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section ExecutableSection -> Section ([String], ExecutableSection)
expand
  where
    expand :: Section ExecutableSection -> Section ([GhcOption], ExecutableSection)
    expand :: Section ExecutableSection -> Section ([String], ExecutableSection)
expand = (ExecutableSection -> ([String], ExecutableSection))
-> Section ExecutableSection
-> Section ([String], ExecutableSection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExecutableSection -> ([String], ExecutableSection)
go
      where
        go :: ExecutableSection -> ([String], ExecutableSection)
go exec :: ExecutableSection
exec@ExecutableSection{Maybe String
Maybe (List Module)
executableSectionGeneratedOtherModules :: Maybe (List Module)
executableSectionOtherModules :: Maybe (List Module)
executableSectionMain :: Maybe String
executableSectionGeneratedOtherModules :: ExecutableSection -> Maybe (List Module)
executableSectionOtherModules :: ExecutableSection -> Maybe (List Module)
executableSectionMain :: ExecutableSection -> Maybe String
..} =
          let
            (Maybe String
mainSrcFile, [String]
ghcOptions) = (Maybe String, [String])
-> (String -> (Maybe String, [String]))
-> Maybe String
-> (Maybe String, [String])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe String
forall a. Maybe a
Nothing, []) ((String -> Maybe String)
-> (String, [String]) -> (Maybe String, [String])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Maybe String
forall a. a -> Maybe a
Just ((String, [String]) -> (Maybe String, [String]))
-> (String -> (String, [String]))
-> String
-> (Maybe String, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, [String])
parseMain) Maybe String
executableSectionMain
          in
            ([String]
ghcOptions, ExecutableSection
exec{executableSectionMain :: Maybe String
executableSectionMain = Maybe String
mainSrcFile})

    flatten :: Section ([GhcOption], ExecutableSection) -> Section ExecutableSection
    flatten :: Section ([String], ExecutableSection) -> Section ExecutableSection
flatten sect :: Section ([String], ExecutableSection)
sect@Section{sectionData :: forall a. Section a -> a
sectionData = ([String]
ghcOptions, ExecutableSection
exec), [String]
[Path]
[Conditional (Section ([String], ExecutableSection))]
[Verbatim]
Maybe Bool
Map BuildTool DependencyVersion
Dependencies
SystemBuildTools
sectionVerbatim :: [Verbatim]
sectionSystemBuildTools :: SystemBuildTools
sectionBuildTools :: Map BuildTool DependencyVersion
sectionConditionals :: [Conditional (Section ([String], ExecutableSection))]
sectionBuildable :: Maybe Bool
sectionLdOptions :: [String]
sectionInstallIncludes :: [String]
sectionIncludeDirs :: [String]
sectionFrameworks :: [String]
sectionExtraFrameworksDirs :: [String]
sectionExtraLibraries :: [String]
sectionExtraLibDirs :: [String]
sectionJsSources :: [Path]
sectionCxxSources :: [Path]
sectionCxxOptions :: [String]
sectionCSources :: [Path]
sectionCcOptions :: [String]
sectionCppOptions :: [String]
sectionGhcjsOptions :: [String]
sectionGhcProfOptions :: [String]
sectionGhcOptions :: [String]
sectionOtherExtensions :: [String]
sectionDefaultExtensions :: [String]
sectionPkgConfigDependencies :: [String]
sectionDependencies :: Dependencies
sectionSourceDirs :: [String]
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 -> [String]
sectionInstallIncludes :: forall a. Section a -> [String]
sectionIncludeDirs :: forall a. Section a -> [String]
sectionFrameworks :: forall a. Section a -> [String]
sectionExtraFrameworksDirs :: forall a. Section a -> [String]
sectionExtraLibraries :: forall a. Section a -> [String]
sectionExtraLibDirs :: forall a. Section a -> [String]
sectionJsSources :: forall a. Section a -> [Path]
sectionCxxSources :: forall a. Section a -> [Path]
sectionCxxOptions :: forall a. Section a -> [String]
sectionCSources :: forall a. Section a -> [Path]
sectionCcOptions :: forall a. Section a -> [String]
sectionCppOptions :: forall a. Section a -> [String]
sectionGhcjsOptions :: forall a. Section a -> [String]
sectionGhcProfOptions :: forall a. Section a -> [String]
sectionGhcOptions :: forall a. Section a -> [String]
sectionOtherExtensions :: forall a. Section a -> [String]
sectionDefaultExtensions :: forall a. Section a -> [String]
sectionPkgConfigDependencies :: forall a. Section a -> [String]
sectionDependencies :: forall a. Section a -> Dependencies
sectionSourceDirs :: forall a. Section a -> [String]
..} = Section ([String], ExecutableSection)
sect{
        sectionData :: ExecutableSection
sectionData = ExecutableSection
exec
      , sectionGhcOptions :: [String]
sectionGhcOptions = [String]
sectionGhcOptions [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ghcOptions
      , sectionConditionals :: [Conditional (Section ExecutableSection)]
sectionConditionals = (Conditional (Section ([String], ExecutableSection))
 -> Conditional (Section ExecutableSection))
-> [Conditional (Section ([String], ExecutableSection))]
-> [Conditional (Section ExecutableSection)]
forall a b. (a -> b) -> [a] -> [b]
map ((Section ([String], ExecutableSection)
 -> Section ExecutableSection)
-> Conditional (Section ([String], ExecutableSection))
-> Conditional (Section ExecutableSection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Section ([String], ExecutableSection) -> Section ExecutableSection
flatten) [Conditional (Section ([String], ExecutableSection))]
sectionConditionals
      }

toSection :: Monad m => String -> [String] -> WithCommonOptions CSources CxxSources JsSources a -> Warnings m (Section a)
toSection :: String
-> [String]
-> WithCommonOptions [Path] [Path] [Path] a
-> Warnings m (Section a)
toSection String
packageName_ [String]
executableNames = WithCommonOptions [Path] [Path] [Path] a -> Warnings m (Section a)
forall (m :: * -> *) a.
Monad m =>
Product (CommonOptions [Path] [Path] [Path] a) a
-> WriterT [String] m (Section a)
go
  where
    go :: Product (CommonOptions [Path] [Path] [Path] a) a
-> WriterT [String] m (Section a)
go (Product CommonOptions{[Path]
Maybe Bool
Maybe (List String)
Maybe (List (ConditionalSection [Path] [Path] [Path] a))
Maybe (List Verbatim)
Maybe Dependencies
Maybe SystemBuildTools
Maybe BuildTools
commonOptionsVerbatim :: Maybe (List Verbatim)
commonOptionsSystemBuildTools :: Maybe SystemBuildTools
commonOptionsBuildTools :: Maybe BuildTools
commonOptionsWhen :: Maybe (List (ConditionalSection [Path] [Path] [Path] a))
commonOptionsBuildable :: Maybe Bool
commonOptionsLdOptions :: Maybe (List String)
commonOptionsInstallIncludes :: Maybe (List String)
commonOptionsIncludeDirs :: Maybe (List String)
commonOptionsFrameworks :: Maybe (List String)
commonOptionsExtraFrameworksDirs :: Maybe (List String)
commonOptionsExtraLibraries :: Maybe (List String)
commonOptionsExtraLibDirs :: Maybe (List String)
commonOptionsJsSources :: [Path]
commonOptionsCxxSources :: [Path]
commonOptionsCxxOptions :: Maybe (List String)
commonOptionsCSources :: [Path]
commonOptionsCcOptions :: Maybe (List String)
commonOptionsCppOptions :: Maybe (List String)
commonOptionsGhcjsOptions :: Maybe (List String)
commonOptionsGhcProfOptions :: Maybe (List String)
commonOptionsGhcOptions :: Maybe (List String)
commonOptionsOtherExtensions :: Maybe (List String)
commonOptionsDefaultExtensions :: Maybe (List String)
commonOptionsPkgConfigDependencies :: Maybe (List String)
commonOptionsDependencies :: Maybe Dependencies
commonOptionsSourceDirs :: Maybe (List String)
commonOptionsVerbatim :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List Verbatim)
commonOptionsSystemBuildTools :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe SystemBuildTools
commonOptionsBuildTools :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> Maybe BuildTools
commonOptionsWhen :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe
     (List (ConditionalSection cSources cxxSources jsSources a))
commonOptionsBuildable :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> Maybe Bool
commonOptionsLdOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsInstallIncludes :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsIncludeDirs :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsFrameworks :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsExtraFrameworksDirs :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsExtraLibraries :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsExtraLibDirs :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsJsSources :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> jsSources
commonOptionsCxxSources :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> cxxSources
commonOptionsCxxOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsCSources :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> cSources
commonOptionsCcOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsCppOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsGhcjsOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsGhcProfOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsGhcOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsOtherExtensions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsDefaultExtensions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsPkgConfigDependencies :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
commonOptionsDependencies :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> Maybe Dependencies
commonOptionsSourceDirs :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List String)
..} a
a) = do
      (SystemBuildTools
systemBuildTools, Map BuildTool DependencyVersion
buildTools) <- WriterT
  [String] m (SystemBuildTools, Map BuildTool DependencyVersion)
-> (BuildTools
    -> WriterT
         [String] m (SystemBuildTools, Map BuildTool DependencyVersion))
-> Maybe BuildTools
-> WriterT
     [String] m (SystemBuildTools, Map BuildTool DependencyVersion)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((SystemBuildTools, Map BuildTool DependencyVersion)
-> WriterT
     [String] m (SystemBuildTools, Map BuildTool DependencyVersion)
forall (m :: * -> *) a. Monad m => a -> m a
return (SystemBuildTools, Map BuildTool DependencyVersion)
forall a. Monoid a => a
mempty) BuildTools
-> WriterT
     [String] m (SystemBuildTools, Map BuildTool DependencyVersion)
forall (m :: * -> *).
Monad m =>
BuildTools
-> Warnings m (SystemBuildTools, Map BuildTool DependencyVersion)
toBuildTools Maybe BuildTools
commonOptionsBuildTools

      [Conditional (Section a)]
conditionals <- (ConditionalSection [Path] [Path] [Path] a
 -> WriterT [String] m (Conditional (Section a)))
-> [ConditionalSection [Path] [Path] [Path] a]
-> WriterT [String] m [Conditional (Section a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ConditionalSection [Path] [Path] [Path] a
-> WriterT [String] m (Conditional (Section a))
forall (m :: * -> *) a.
Monad m =>
ConditionalSection [Path] [Path] [Path] a
-> Warnings m (Conditional (Section a))
toConditional (Maybe (List (ConditionalSection [Path] [Path] [Path] a))
-> [ConditionalSection [Path] [Path] [Path] a]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List (ConditionalSection [Path] [Path] [Path] a))
commonOptionsWhen)
      Section a -> WriterT [String] m (Section a)
forall (m :: * -> *) a. Monad m => a -> m a
return Section :: forall a.
a
-> [String]
-> Dependencies
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [Path]
-> [String]
-> [Path]
-> [Path]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> Maybe Bool
-> [Conditional (Section a)]
-> Map BuildTool DependencyVersion
-> SystemBuildTools
-> [Verbatim]
-> Section a
Section {
        sectionData :: a
sectionData = a
a
      , sectionSourceDirs :: [String]
sectionSourceDirs = [String] -> [String]
forall a. Ord a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
commonOptionsSourceDirs
      , sectionDefaultExtensions :: [String]
sectionDefaultExtensions = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
commonOptionsDefaultExtensions
      , sectionOtherExtensions :: [String]
sectionOtherExtensions = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
commonOptionsOtherExtensions
      , sectionGhcOptions :: [String]
sectionGhcOptions = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
commonOptionsGhcOptions
      , sectionGhcProfOptions :: [String]
sectionGhcProfOptions = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
commonOptionsGhcProfOptions
      , sectionGhcjsOptions :: [String]
sectionGhcjsOptions = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
commonOptionsGhcjsOptions
      , sectionCppOptions :: [String]
sectionCppOptions = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
commonOptionsCppOptions
      , sectionCcOptions :: [String]
sectionCcOptions = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
commonOptionsCcOptions
      , sectionCSources :: [Path]
sectionCSources = [Path]
commonOptionsCSources
      , sectionCxxOptions :: [String]
sectionCxxOptions = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
commonOptionsCxxOptions
      , sectionCxxSources :: [Path]
sectionCxxSources = [Path]
commonOptionsCxxSources
      , sectionJsSources :: [Path]
sectionJsSources = [Path]
commonOptionsJsSources
      , sectionExtraLibDirs :: [String]
sectionExtraLibDirs = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
commonOptionsExtraLibDirs
      , sectionExtraLibraries :: [String]
sectionExtraLibraries = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
commonOptionsExtraLibraries
      , sectionExtraFrameworksDirs :: [String]
sectionExtraFrameworksDirs = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
commonOptionsExtraFrameworksDirs
      , sectionFrameworks :: [String]
sectionFrameworks = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
commonOptionsFrameworks
      , sectionIncludeDirs :: [String]
sectionIncludeDirs = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
commonOptionsIncludeDirs
      , sectionInstallIncludes :: [String]
sectionInstallIncludes = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
commonOptionsInstallIncludes
      , sectionLdOptions :: [String]
sectionLdOptions = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
commonOptionsLdOptions
      , sectionBuildable :: Maybe Bool
sectionBuildable = Maybe Bool
commonOptionsBuildable
      , sectionDependencies :: Dependencies
sectionDependencies = Dependencies -> Maybe Dependencies -> Dependencies
forall a. a -> Maybe a -> a
fromMaybe Dependencies
forall a. Monoid a => a
mempty Maybe Dependencies
commonOptionsDependencies
      , sectionPkgConfigDependencies :: [String]
sectionPkgConfigDependencies = Maybe (List String) -> [String]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List String)
commonOptionsPkgConfigDependencies
      , 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 :: Monad m => BuildTools -> Warnings m (SystemBuildTools, Map BuildTool DependencyVersion)
    toBuildTools :: BuildTools
-> Warnings m (SystemBuildTools, Map BuildTool DependencyVersion)
toBuildTools = ([Either SystemBuildTool (BuildTool, DependencyVersion)]
 -> (SystemBuildTools, Map BuildTool DependencyVersion))
-> WriterT
     [String] m [Either SystemBuildTool (BuildTool, DependencyVersion)]
-> Warnings m (SystemBuildTools, Map BuildTool DependencyVersion)
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 (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) (WriterT
   [String] m [Either SystemBuildTool (BuildTool, DependencyVersion)]
 -> Warnings m (SystemBuildTools, Map BuildTool DependencyVersion))
-> (BuildTools
    -> WriterT
         [String] m [Either SystemBuildTool (BuildTool, DependencyVersion)])
-> BuildTools
-> Warnings m (SystemBuildTools, Map BuildTool DependencyVersion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ParseBuildTool, DependencyVersion)
 -> WriterT
      [String] m (Either SystemBuildTool (BuildTool, DependencyVersion)))
-> [(ParseBuildTool, DependencyVersion)]
-> WriterT
     [String] m [Either SystemBuildTool (BuildTool, DependencyVersion)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String
-> [String]
-> (ParseBuildTool, DependencyVersion)
-> WriterT
     [String] m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall (m :: * -> *).
Monad m =>
String
-> [String]
-> (ParseBuildTool, DependencyVersion)
-> Warnings
     m (Either SystemBuildTool (BuildTool, DependencyVersion))
toBuildTool String
packageName_ [String]
executableNames)([(ParseBuildTool, DependencyVersion)]
 -> WriterT
      [String] m [Either SystemBuildTool (BuildTool, DependencyVersion)])
-> (BuildTools -> [(ParseBuildTool, DependencyVersion)])
-> BuildTools
-> WriterT
     [String] 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 :: [Either SystemBuildTool b] -> SystemBuildTools
mkSystemBuildTools = Map String VersionConstraint -> SystemBuildTools
SystemBuildTools (Map String VersionConstraint -> SystemBuildTools)
-> ([Either SystemBuildTool b] -> Map String VersionConstraint)
-> [Either SystemBuildTool b]
-> SystemBuildTools
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SystemBuildTool] -> Map String VersionConstraint
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([SystemBuildTool] -> Map String VersionConstraint)
-> ([Either SystemBuildTool b] -> [SystemBuildTool])
-> [Either SystemBuildTool b]
-> Map String 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 :: Monad m => ConditionalSection CSources CxxSources JsSources a -> Warnings m (Conditional (Section a))
    toConditional :: ConditionalSection [Path] [Path] [Path] a
-> Warnings m (Conditional (Section a))
toConditional ConditionalSection [Path] [Path] [Path] a
x = case ConditionalSection [Path] [Path] [Path] a
x of
      ThenElseConditional (Product (ThenElse WithCommonOptions [Path] [Path] [Path] a
then_ WithCommonOptions [Path] [Path] [Path] 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))
-> WriterT [String] m (Section a)
-> WriterT
     [String] m (Maybe (Section a) -> Conditional (Section a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WithCommonOptions [Path] [Path] [Path] a
-> WriterT [String] m (Section a)
forall (m :: * -> *) a.
Monad m =>
Product (CommonOptions [Path] [Path] [Path] a) a
-> WriterT [String] m (Section a)
go WithCommonOptions [Path] [Path] [Path] a
then_) WriterT [String] m (Maybe (Section a) -> Conditional (Section a))
-> WriterT [String] m (Maybe (Section a))
-> Warnings m (Conditional (Section a))
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))
-> WriterT [String] m (Section a)
-> WriterT [String] m (Maybe (Section a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithCommonOptions [Path] [Path] [Path] a
-> WriterT [String] m (Section a)
forall (m :: * -> *) a.
Monad m =>
Product (CommonOptions [Path] [Path] [Path] a) a
-> WriterT [String] m (Section a)
go WithCommonOptions [Path] [Path] [Path] a
else_)
      FlatConditional (Product WithCommonOptions [Path] [Path] [Path] 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))
-> WriterT [String] m (Section a)
-> WriterT
     [String] m (Maybe (Section a) -> Conditional (Section a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WithCommonOptions [Path] [Path] [Path] a
-> WriterT [String] m (Section a)
forall (m :: * -> *) a.
Monad m =>
Product (CommonOptions [Path] [Path] [Path] a) a
-> WriterT [String] m (Section a)
go WithCommonOptions [Path] [Path] [Path] a
sect) WriterT [String] m (Maybe (Section a) -> Conditional (Section a))
-> WriterT [String] m (Maybe (Section a))
-> Warnings m (Conditional (Section a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Section a) -> WriterT [String] m (Maybe (Section 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 :: Monad m => String -> [String] -> (ParseBuildTool, DependencyVersion)
  -> Warnings m (Either SystemBuildTool (BuildTool, DependencyVersion))
toBuildTool :: String
-> [String]
-> (ParseBuildTool, DependencyVersion)
-> Warnings
     m (Either SystemBuildTool (BuildTool, DependencyVersion))
toBuildTool String
packageName_ [String]
executableNames = \ case
  (QualifiedBuildTool String
pkg String
executable, DependencyVersion
v)
    | String
pkg String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
packageName_ Bool -> Bool -> Bool
&& String
executable String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
executableNames -> String
-> DependencyVersion
-> Warnings
     m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall (m :: * -> *) b a.
Monad m =>
String -> b -> m (Either a (BuildTool, b))
localBuildTool String
executable DependencyVersion
v
    | Bool
otherwise -> String
-> String
-> DependencyVersion
-> Warnings
     m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall (m :: * -> *) b a.
Monad m =>
String -> String -> b -> m (Either a (BuildTool, b))
buildTool String
pkg String
executable DependencyVersion
v
  (UnqualifiedBuildTool String
executable, DependencyVersion
v)
    | String
executable String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
executableNames -> String
-> DependencyVersion
-> Warnings
     m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall (m :: * -> *) b a.
Monad m =>
String -> b -> m (Either a (BuildTool, b))
localBuildTool String
executable DependencyVersion
v
    | Just String
pkg <- String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
executable [(String, String)]
legacyTools -> String
-> String
-> DependencyVersion
-> Warnings
     m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall (m :: * -> *) b a.
Monad m =>
String
-> String -> b -> WriterT [String] m (Either a (BuildTool, b))
legacyBuildTool String
pkg String
executable DependencyVersion
v
    | String
executable String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
legacySystemTools, DependencyVersion Maybe SourceDependency
Nothing VersionConstraint
c <- DependencyVersion
v -> String
-> VersionConstraint
-> Warnings
     m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall a b b.
Show a =>
a -> b -> WriterT [String] m (Either (a, b) b)
legacySystemBuildTool String
executable VersionConstraint
c
    | Bool
otherwise -> String
-> String
-> DependencyVersion
-> Warnings
     m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall (m :: * -> *) b a.
Monad m =>
String -> String -> b -> m (Either a (BuildTool, b))
buildTool String
executable String
executable DependencyVersion
v
  where
    buildTool :: String -> String -> b -> m (Either a (BuildTool, b))
buildTool String
pkg String
executable b
v = Either a (BuildTool, b) -> m (Either a (BuildTool, b))
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
$ (String -> String -> BuildTool
BuildTool String
pkg String
executable, b
v)

    systemBuildTool :: a -> WriterT [String] m (Either a b)
systemBuildTool = Either a b -> WriterT [String] m (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> WriterT [String] m (Either a b))
-> (a -> Either a b) -> a -> WriterT [String] 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 :: String -> b -> m (Either a (BuildTool, b))
localBuildTool String
executable b
v = Either a (BuildTool, b) -> m (Either a (BuildTool, b))
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
$ (String -> BuildTool
LocalBuildTool String
executable, b
v)
    legacyBuildTool :: String
-> String -> b -> WriterT [String] m (Either a (BuildTool, b))
legacyBuildTool String
pkg String
executable b
v = String -> String -> WriterT [String] m ()
forall (m :: * -> *).
Monad m =>
String -> String -> WriterT [String] m ()
warnLegacyTool String
pkg String
executable WriterT [String] m ()
-> WriterT [String] m (Either a (BuildTool, b))
-> WriterT [String] m (Either a (BuildTool, b))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String
-> String -> b -> WriterT [String] m (Either a (BuildTool, b))
forall (m :: * -> *) b a.
Monad m =>
String -> String -> b -> m (Either a (BuildTool, b))
buildTool String
pkg String
executable b
v
    legacySystemBuildTool :: a -> b -> WriterT [String] m (Either (a, b) b)
legacySystemBuildTool a
executable b
c = a -> WriterT [String] m ()
forall (m :: * -> *) a.
(Monad m, Show a) =>
a -> WriterT [String] m ()
warnLegacySystemTool a
executable WriterT [String] m ()
-> WriterT [String] m (Either (a, b) b)
-> WriterT [String] m (Either (a, b) b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a, b) -> WriterT [String] m (Either (a, b) b)
forall a b. a -> WriterT [String] m (Either a b)
systemBuildTool (a
executable, b
c)

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

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