{-# 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 #-}
{-# LANGUAGE DataKinds #-}
module Hpack.Config (
DecodeOptions(..)
, ProgramName(..)
, defaultDecodeOptions
, packageConfig
, DecodeResult(..)
, readPackageConfig
, readPackageConfigWithError
, renamePackage
, packageDependencies
, package
, section
, Package(..)
, Dependencies(..)
, DependencyInfo(..)
, VersionConstraint(..)
, DependencyVersion(..)
, SourceDependency(..)
, GitRef
, GitUrl
, BuildTool(..)
, SystemBuildTools(..)
, GhcOption
, Verbatim(..)
, VerbatimValue(..)
, verbatimValueToString
, CustomSetup(..)
, Section(..)
, Library(..)
, Executable(..)
, Conditional(..)
, Cond(..)
, Flag(..)
, SourceRepository(..)
, Language(..)
, BuildType(..)
, GhcProfOption
, GhcjsOption
, CppOption
, CcOption
, LdOption
, Path(..)
, Module(..)
#ifdef TEST
, renameDependencies
, Empty(..)
, pathsModuleFromPackageName
, LibrarySection(..)
, fromLibrarySectionInConditional
, formatOrList
, toBuildTool
#endif
) where
import Imports
import Data.Either
import Data.Bitraversable
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as Map
import qualified Data.Aeson.Config.KeyMap as KeyMap
import Data.Maybe
import Data.Monoid (Last(..))
import Data.Ord
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import Data.Scientific (Scientific)
import System.Directory
import System.FilePath
import Control.Monad.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.Error
import Hpack.Syntax.Defaults
import Hpack.Util hiding (expandGlobs)
import qualified Hpack.Util as Util
import Hpack.Defaults
import qualified Hpack.Yaml as Yaml
import Hpack.Syntax.DependencyVersion
import Hpack.Syntax.Dependencies
import Hpack.Syntax.BuildTools
import Hpack.License
import Hpack.CabalFile (parseVersion)
import Hpack.Module
import qualified Path
import qualified Paths_hpack as Hpack (version)
package :: String -> String -> Package
package :: [Char] -> [Char] -> Package
package [Char]
name [Char]
version = Package {
packageName :: [Char]
packageName = [Char]
name
, packageVersion :: [Char]
packageVersion = [Char]
version
, packageSynopsis :: Maybe [Char]
packageSynopsis = Maybe [Char]
forall a. Maybe a
Nothing
, packageDescription :: Maybe [Char]
packageDescription = Maybe [Char]
forall a. Maybe a
Nothing
, packageHomepage :: Maybe [Char]
packageHomepage = Maybe [Char]
forall a. Maybe a
Nothing
, packageBugReports :: Maybe [Char]
packageBugReports = Maybe [Char]
forall a. Maybe a
Nothing
, packageCategory :: Maybe [Char]
packageCategory = Maybe [Char]
forall a. Maybe a
Nothing
, packageStability :: Maybe [Char]
packageStability = Maybe [Char]
forall a. Maybe a
Nothing
, packageAuthor :: [[Char]]
packageAuthor = []
, packageMaintainer :: [[Char]]
packageMaintainer = []
, packageCopyright :: [[Char]]
packageCopyright = []
, packageBuildType :: BuildType
packageBuildType = BuildType
Simple
, packageLicense :: Maybe [Char]
packageLicense = Maybe [Char]
forall a. Maybe a
Nothing
, packageLicenseFile :: [[Char]]
packageLicenseFile = []
, packageTestedWith :: [[Char]]
packageTestedWith = []
, packageFlags :: [Flag]
packageFlags = []
, packageExtraSourceFiles :: [Path]
packageExtraSourceFiles = []
, packageExtraDocFiles :: [Path]
packageExtraDocFiles = []
, packageDataFiles :: [Path]
packageDataFiles = []
, packageDataDir :: Maybe [Char]
packageDataDir = Maybe [Char]
forall a. Maybe a
Nothing
, packageSourceRepository :: Maybe SourceRepository
packageSourceRepository = Maybe SourceRepository
forall a. Maybe a
Nothing
, packageCustomSetup :: Maybe CustomSetup
packageCustomSetup = Maybe CustomSetup
forall a. Maybe a
Nothing
, packageLibrary :: Maybe (Section Library)
packageLibrary = Maybe (Section Library)
forall a. Maybe a
Nothing
, packageInternalLibraries :: Map [Char] (Section Library)
packageInternalLibraries = Map [Char] (Section Library)
forall a. Monoid a => a
mempty
, packageExecutables :: Map [Char] (Section Executable)
packageExecutables = Map [Char] (Section Executable)
forall a. Monoid a => a
mempty
, packageTests :: Map [Char] (Section Executable)
packageTests = Map [Char] (Section Executable)
forall a. Monoid a => a
mempty
, packageBenchmarks :: Map [Char] (Section Executable)
packageBenchmarks = Map [Char] (Section Executable)
forall a. Monoid a => a
mempty
, packageVerbatim :: [Verbatim]
packageVerbatim = []
}
renamePackage :: String -> Package -> Package
renamePackage :: [Char] -> Package -> Package
renamePackage [Char]
name p :: Package
p@Package{[Char]
[[Char]]
[Path]
[Flag]
[Verbatim]
Maybe [Char]
Maybe SourceRepository
Maybe (Section Library)
Maybe CustomSetup
Map [Char] (Section Executable)
Map [Char] (Section Library)
BuildType
packageName :: Package -> [Char]
packageVersion :: Package -> [Char]
packageSynopsis :: Package -> Maybe [Char]
packageDescription :: Package -> Maybe [Char]
packageHomepage :: Package -> Maybe [Char]
packageBugReports :: Package -> Maybe [Char]
packageCategory :: Package -> Maybe [Char]
packageStability :: Package -> Maybe [Char]
packageAuthor :: Package -> [[Char]]
packageMaintainer :: Package -> [[Char]]
packageCopyright :: Package -> [[Char]]
packageBuildType :: Package -> BuildType
packageLicense :: Package -> Maybe [Char]
packageLicenseFile :: Package -> [[Char]]
packageTestedWith :: Package -> [[Char]]
packageFlags :: Package -> [Flag]
packageExtraSourceFiles :: Package -> [Path]
packageExtraDocFiles :: Package -> [Path]
packageDataFiles :: Package -> [Path]
packageDataDir :: Package -> Maybe [Char]
packageSourceRepository :: Package -> Maybe SourceRepository
packageCustomSetup :: Package -> Maybe CustomSetup
packageLibrary :: Package -> Maybe (Section Library)
packageInternalLibraries :: Package -> Map [Char] (Section Library)
packageExecutables :: Package -> Map [Char] (Section Executable)
packageTests :: Package -> Map [Char] (Section Executable)
packageBenchmarks :: Package -> Map [Char] (Section Executable)
packageVerbatim :: Package -> [Verbatim]
packageName :: [Char]
packageVersion :: [Char]
packageSynopsis :: Maybe [Char]
packageDescription :: Maybe [Char]
packageHomepage :: Maybe [Char]
packageBugReports :: Maybe [Char]
packageCategory :: Maybe [Char]
packageStability :: Maybe [Char]
packageAuthor :: [[Char]]
packageMaintainer :: [[Char]]
packageCopyright :: [[Char]]
packageBuildType :: BuildType
packageLicense :: Maybe [Char]
packageLicenseFile :: [[Char]]
packageTestedWith :: [[Char]]
packageFlags :: [Flag]
packageExtraSourceFiles :: [Path]
packageExtraDocFiles :: [Path]
packageDataFiles :: [Path]
packageDataDir :: Maybe [Char]
packageSourceRepository :: Maybe SourceRepository
packageCustomSetup :: Maybe CustomSetup
packageLibrary :: Maybe (Section Library)
packageInternalLibraries :: Map [Char] (Section Library)
packageExecutables :: Map [Char] (Section Executable)
packageTests :: Map [Char] (Section Executable)
packageBenchmarks :: Map [Char] (Section Executable)
packageVerbatim :: [Verbatim]
..} = Package
p {
packageName :: [Char]
packageName = [Char]
name
, packageExecutables :: Map [Char] (Section Executable)
packageExecutables = (Section Executable -> Section Executable)
-> Map [Char] (Section Executable)
-> Map [Char] (Section Executable)
forall a b. (a -> b) -> Map [Char] a -> Map [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> [Char] -> Section Executable -> Section Executable
forall a. [Char] -> [Char] -> Section a -> Section a
renameDependencies [Char]
packageName [Char]
name) Map [Char] (Section Executable)
packageExecutables
, packageTests :: Map [Char] (Section Executable)
packageTests = (Section Executable -> Section Executable)
-> Map [Char] (Section Executable)
-> Map [Char] (Section Executable)
forall a b. (a -> b) -> Map [Char] a -> Map [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> [Char] -> Section Executable -> Section Executable
forall a. [Char] -> [Char] -> Section a -> Section a
renameDependencies [Char]
packageName [Char]
name) Map [Char] (Section Executable)
packageTests
, packageBenchmarks :: Map [Char] (Section Executable)
packageBenchmarks = (Section Executable -> Section Executable)
-> Map [Char] (Section Executable)
-> Map [Char] (Section Executable)
forall a b. (a -> b) -> Map [Char] a -> Map [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> [Char] -> Section Executable -> Section Executable
forall a. [Char] -> [Char] -> Section a -> Section a
renameDependencies [Char]
packageName [Char]
name) Map [Char] (Section Executable)
packageBenchmarks
}
renameDependencies :: String -> String -> Section a -> Section a
renameDependencies :: forall a. [Char] -> [Char] -> Section a -> Section a
renameDependencies [Char]
old [Char]
new sect :: Section a
sect@Section{a
[[Char]]
[Path]
[Conditional (Section a)]
[Verbatim]
Maybe Bool
Maybe Language
Map BuildTool DependencyVersion
Dependencies
SystemBuildTools
sectionData :: a
sectionSourceDirs :: [[Char]]
sectionDependencies :: Dependencies
sectionPkgConfigDependencies :: [[Char]]
sectionDefaultExtensions :: [[Char]]
sectionOtherExtensions :: [[Char]]
sectionLanguage :: Maybe Language
sectionGhcOptions :: [[Char]]
sectionGhcProfOptions :: [[Char]]
sectionGhcSharedOptions :: [[Char]]
sectionGhcjsOptions :: [[Char]]
sectionCppOptions :: [[Char]]
sectionCcOptions :: [[Char]]
sectionCSources :: [Path]
sectionCxxOptions :: [[Char]]
sectionCxxSources :: [Path]
sectionJsSources :: [Path]
sectionExtraLibDirs :: [[Char]]
sectionExtraLibraries :: [[Char]]
sectionExtraFrameworksDirs :: [[Char]]
sectionFrameworks :: [[Char]]
sectionIncludeDirs :: [[Char]]
sectionInstallIncludes :: [[Char]]
sectionLdOptions :: [[Char]]
sectionBuildable :: Maybe Bool
sectionConditionals :: [Conditional (Section a)]
sectionBuildTools :: Map BuildTool DependencyVersion
sectionSystemBuildTools :: SystemBuildTools
sectionVerbatim :: [Verbatim]
sectionData :: forall a. Section a -> a
sectionSourceDirs :: forall a. Section a -> [[Char]]
sectionDependencies :: forall a. Section a -> Dependencies
sectionPkgConfigDependencies :: forall a. Section a -> [[Char]]
sectionDefaultExtensions :: forall a. Section a -> [[Char]]
sectionOtherExtensions :: forall a. Section a -> [[Char]]
sectionLanguage :: forall a. Section a -> Maybe Language
sectionGhcOptions :: forall a. Section a -> [[Char]]
sectionGhcProfOptions :: forall a. Section a -> [[Char]]
sectionGhcSharedOptions :: forall a. Section a -> [[Char]]
sectionGhcjsOptions :: forall a. Section a -> [[Char]]
sectionCppOptions :: forall a. Section a -> [[Char]]
sectionCcOptions :: forall a. Section a -> [[Char]]
sectionCSources :: forall a. Section a -> [Path]
sectionCxxOptions :: forall a. Section a -> [[Char]]
sectionCxxSources :: forall a. Section a -> [Path]
sectionJsSources :: forall a. Section a -> [Path]
sectionExtraLibDirs :: forall a. Section a -> [[Char]]
sectionExtraLibraries :: forall a. Section a -> [[Char]]
sectionExtraFrameworksDirs :: forall a. Section a -> [[Char]]
sectionFrameworks :: forall a. Section a -> [[Char]]
sectionIncludeDirs :: forall a. Section a -> [[Char]]
sectionInstallIncludes :: forall a. Section a -> [[Char]]
sectionLdOptions :: forall a. Section a -> [[Char]]
sectionBuildable :: forall a. Section a -> Maybe Bool
sectionConditionals :: forall a. Section a -> [Conditional (Section a)]
sectionBuildTools :: forall a. Section a -> Map BuildTool DependencyVersion
sectionSystemBuildTools :: forall a. Section a -> SystemBuildTools
sectionVerbatim :: forall a. Section a -> [Verbatim]
..} = Section a
sect {sectionDependencies :: Dependencies
sectionDependencies = (Map [Char] DependencyInfo -> Dependencies
Dependencies (Map [Char] DependencyInfo -> Dependencies)
-> (Dependencies -> Map [Char] DependencyInfo)
-> Dependencies
-> Dependencies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Char], DependencyInfo)] -> Map [Char] DependencyInfo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Char], DependencyInfo)] -> Map [Char] DependencyInfo)
-> (Dependencies -> [([Char], DependencyInfo)])
-> Dependencies
-> Map [Char] DependencyInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], DependencyInfo) -> ([Char], DependencyInfo))
-> [([Char], DependencyInfo)] -> [([Char], DependencyInfo)]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], DependencyInfo) -> ([Char], DependencyInfo)
forall {b}. ([Char], b) -> ([Char], b)
rename ([([Char], DependencyInfo)] -> [([Char], DependencyInfo)])
-> (Dependencies -> [([Char], DependencyInfo)])
-> Dependencies
-> [([Char], DependencyInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map [Char] DependencyInfo -> [([Char], DependencyInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map [Char] DependencyInfo -> [([Char], DependencyInfo)])
-> (Dependencies -> Map [Char] DependencyInfo)
-> Dependencies
-> [([Char], DependencyInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> Map [Char] 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 :: ([Char], b) -> ([Char], b)
rename dep :: ([Char], b)
dep@([Char]
name, b
version)
| [Char]
name [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
old = ([Char]
new, b
version)
| Bool
otherwise = ([Char], b)
dep
renameConditional :: Conditional (Section a) -> Conditional (Section a)
renameConditional :: forall a. Conditional (Section a) -> Conditional (Section a)
renameConditional (Conditional Cond
condition Section a
then_ Maybe (Section a)
else_) = Cond -> Section a -> Maybe (Section a) -> Conditional (Section a)
forall a. Cond -> a -> Maybe a -> Conditional a
Conditional Cond
condition ([Char] -> [Char] -> Section a -> Section a
forall a. [Char] -> [Char] -> Section a -> Section a
renameDependencies [Char]
old [Char]
new Section a
then_) ([Char] -> [Char] -> Section a -> Section a
forall a. [Char] -> [Char] -> Section a -> Section a
renameDependencies [Char]
old [Char]
new (Section a -> Section a) -> Maybe (Section a) -> Maybe (Section a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Section a)
else_)
packageDependencies :: Package -> [(String, DependencyInfo)]
packageDependencies :: Package -> [([Char], DependencyInfo)]
packageDependencies Package{[Char]
[[Char]]
[Path]
[Flag]
[Verbatim]
Maybe [Char]
Maybe SourceRepository
Maybe (Section Library)
Maybe CustomSetup
Map [Char] (Section Executable)
Map [Char] (Section Library)
BuildType
packageName :: Package -> [Char]
packageVersion :: Package -> [Char]
packageSynopsis :: Package -> Maybe [Char]
packageDescription :: Package -> Maybe [Char]
packageHomepage :: Package -> Maybe [Char]
packageBugReports :: Package -> Maybe [Char]
packageCategory :: Package -> Maybe [Char]
packageStability :: Package -> Maybe [Char]
packageAuthor :: Package -> [[Char]]
packageMaintainer :: Package -> [[Char]]
packageCopyright :: Package -> [[Char]]
packageBuildType :: Package -> BuildType
packageLicense :: Package -> Maybe [Char]
packageLicenseFile :: Package -> [[Char]]
packageTestedWith :: Package -> [[Char]]
packageFlags :: Package -> [Flag]
packageExtraSourceFiles :: Package -> [Path]
packageExtraDocFiles :: Package -> [Path]
packageDataFiles :: Package -> [Path]
packageDataDir :: Package -> Maybe [Char]
packageSourceRepository :: Package -> Maybe SourceRepository
packageCustomSetup :: Package -> Maybe CustomSetup
packageLibrary :: Package -> Maybe (Section Library)
packageInternalLibraries :: Package -> Map [Char] (Section Library)
packageExecutables :: Package -> Map [Char] (Section Executable)
packageTests :: Package -> Map [Char] (Section Executable)
packageBenchmarks :: Package -> Map [Char] (Section Executable)
packageVerbatim :: Package -> [Verbatim]
packageName :: [Char]
packageVersion :: [Char]
packageSynopsis :: Maybe [Char]
packageDescription :: Maybe [Char]
packageHomepage :: Maybe [Char]
packageBugReports :: Maybe [Char]
packageCategory :: Maybe [Char]
packageStability :: Maybe [Char]
packageAuthor :: [[Char]]
packageMaintainer :: [[Char]]
packageCopyright :: [[Char]]
packageBuildType :: BuildType
packageLicense :: Maybe [Char]
packageLicenseFile :: [[Char]]
packageTestedWith :: [[Char]]
packageFlags :: [Flag]
packageExtraSourceFiles :: [Path]
packageExtraDocFiles :: [Path]
packageDataFiles :: [Path]
packageDataDir :: Maybe [Char]
packageSourceRepository :: Maybe SourceRepository
packageCustomSetup :: Maybe CustomSetup
packageLibrary :: Maybe (Section Library)
packageInternalLibraries :: Map [Char] (Section Library)
packageExecutables :: Map [Char] (Section Executable)
packageTests :: Map [Char] (Section Executable)
packageBenchmarks :: Map [Char] (Section Executable)
packageVerbatim :: [Verbatim]
..} = [([Char], DependencyInfo)] -> [([Char], DependencyInfo)]
forall a. Ord a => [a] -> [a]
nub ([([Char], DependencyInfo)] -> [([Char], DependencyInfo)])
-> ([([Char], DependencyInfo)] -> [([Char], DependencyInfo)])
-> [([Char], DependencyInfo)]
-> [([Char], DependencyInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], DependencyInfo) -> ([Char], DependencyInfo) -> Ordering)
-> [([Char], DependencyInfo)] -> [([Char], DependencyInfo)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((([Char], DependencyInfo) -> ([Char], [Char]))
-> ([Char], DependencyInfo) -> ([Char], DependencyInfo) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ([Char] -> ([Char], [Char])
lexicographically ([Char] -> ([Char], [Char]))
-> (([Char], DependencyInfo) -> [Char])
-> ([Char], DependencyInfo)
-> ([Char], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], DependencyInfo) -> [Char]
forall a b. (a, b) -> a
fst)) ([([Char], DependencyInfo)] -> [([Char], DependencyInfo)])
-> [([Char], DependencyInfo)] -> [([Char], DependencyInfo)]
forall a b. (a -> b) -> a -> b
$
((Section Executable -> [([Char], DependencyInfo)])
-> Map [Char] (Section Executable) -> [([Char], DependencyInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section Executable -> [([Char], DependencyInfo)]
forall {a}. Section a -> [([Char], DependencyInfo)]
deps Map [Char] (Section Executable)
packageExecutables)
[([Char], DependencyInfo)]
-> [([Char], DependencyInfo)] -> [([Char], DependencyInfo)]
forall a. [a] -> [a] -> [a]
++ ((Section Executable -> [([Char], DependencyInfo)])
-> Map [Char] (Section Executable) -> [([Char], DependencyInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section Executable -> [([Char], DependencyInfo)]
forall {a}. Section a -> [([Char], DependencyInfo)]
deps Map [Char] (Section Executable)
packageTests)
[([Char], DependencyInfo)]
-> [([Char], DependencyInfo)] -> [([Char], DependencyInfo)]
forall a. [a] -> [a] -> [a]
++ ((Section Executable -> [([Char], DependencyInfo)])
-> Map [Char] (Section Executable) -> [([Char], DependencyInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section Executable -> [([Char], DependencyInfo)]
forall {a}. Section a -> [([Char], DependencyInfo)]
deps Map [Char] (Section Executable)
packageBenchmarks)
[([Char], DependencyInfo)]
-> [([Char], DependencyInfo)] -> [([Char], DependencyInfo)]
forall a. [a] -> [a] -> [a]
++ [([Char], DependencyInfo)]
-> (Section Library -> [([Char], DependencyInfo)])
-> Maybe (Section Library)
-> [([Char], DependencyInfo)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Section Library -> [([Char], DependencyInfo)]
forall {a}. Section a -> [([Char], DependencyInfo)]
deps Maybe (Section Library)
packageLibrary
where
deps :: Section a -> [([Char], DependencyInfo)]
deps Section a
xs = [([Char]
name, DependencyInfo
info) | ([Char]
name, DependencyInfo
info) <- (Map [Char] DependencyInfo -> [([Char], DependencyInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map [Char] DependencyInfo -> [([Char], DependencyInfo)])
-> (Section a -> Map [Char] DependencyInfo)
-> Section a
-> [([Char], DependencyInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> Map [Char] DependencyInfo
unDependencies (Dependencies -> Map [Char] DependencyInfo)
-> (Section a -> Dependencies)
-> Section a
-> Map [Char] DependencyInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section a -> Dependencies
forall a. Section a -> Dependencies
sectionDependencies) Section a
xs]
section :: a -> Section a
section :: forall a. a -> Section a
section a
a = a
-> [[Char]]
-> Dependencies
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> Maybe Language
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [Path]
-> [[Char]]
-> [Path]
-> [Path]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> Maybe Bool
-> [Conditional (Section a)]
-> Map BuildTool DependencyVersion
-> SystemBuildTools
-> [Verbatim]
-> Section a
forall a.
a
-> [[Char]]
-> Dependencies
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> Maybe Language
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [Path]
-> [[Char]]
-> [Path]
-> [Path]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> Maybe Bool
-> [Conditional (Section a)]
-> Map BuildTool DependencyVersion
-> SystemBuildTools
-> [Verbatim]
-> Section a
Section a
a [] Dependencies
forall a. Monoid a => a
mempty [] [] [] Maybe Language
forall a. Maybe a
Nothing [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] [] Maybe Bool
forall a. Maybe a
Nothing [] Map BuildTool DependencyVersion
forall a. Monoid a => a
mempty SystemBuildTools
forall a. Monoid a => a
mempty []
packageConfig :: FilePath
packageConfig :: [Char]
packageConfig = [Char]
"package.yaml"
data CustomSetupSection = CustomSetupSection {
CustomSetupSection -> Maybe Dependencies
customSetupSectionDependencies :: Maybe Dependencies
} deriving (CustomSetupSection -> CustomSetupSection -> Bool
(CustomSetupSection -> CustomSetupSection -> Bool)
-> (CustomSetupSection -> CustomSetupSection -> Bool)
-> Eq CustomSetupSection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomSetupSection -> CustomSetupSection -> Bool
== :: CustomSetupSection -> CustomSetupSection -> Bool
$c/= :: CustomSetupSection -> CustomSetupSection -> Bool
/= :: CustomSetupSection -> CustomSetupSection -> Bool
Eq, Int -> CustomSetupSection -> ShowS
[CustomSetupSection] -> ShowS
CustomSetupSection -> [Char]
(Int -> CustomSetupSection -> ShowS)
-> (CustomSetupSection -> [Char])
-> ([CustomSetupSection] -> ShowS)
-> Show CustomSetupSection
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomSetupSection -> ShowS
showsPrec :: Int -> CustomSetupSection -> ShowS
$cshow :: CustomSetupSection -> [Char]
show :: CustomSetupSection -> [Char]
$cshowList :: [CustomSetupSection] -> ShowS
showList :: [CustomSetupSection] -> ShowS
Show, (forall x. CustomSetupSection -> Rep CustomSetupSection x)
-> (forall x. Rep CustomSetupSection x -> CustomSetupSection)
-> Generic CustomSetupSection
forall x. Rep CustomSetupSection x -> CustomSetupSection
forall x. CustomSetupSection -> Rep CustomSetupSection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CustomSetupSection -> Rep CustomSetupSection x
from :: forall x. CustomSetupSection -> Rep CustomSetupSection x
$cto :: forall x. Rep CustomSetupSection x -> CustomSetupSection
to :: forall x. Rep CustomSetupSection x -> CustomSetupSection
Generic, Value -> Parser CustomSetupSection
(Value -> Parser CustomSetupSection)
-> FromValue CustomSetupSection
forall a. (Value -> Parser a) -> FromValue a
$cfromValue :: Value -> Parser CustomSetupSection
fromValue :: Value -> Parser CustomSetupSection
FromValue)
data LibrarySection = LibrarySection {
LibrarySection -> Maybe Bool
librarySectionExposed :: Maybe Bool
, LibrarySection -> Maybe [Char]
librarySectionVisibility :: Maybe String
, LibrarySection -> Maybe (List Module)
librarySectionExposedModules :: Maybe (List Module)
, LibrarySection -> Maybe (List Module)
librarySectionGeneratedExposedModules :: Maybe (List Module)
, LibrarySection -> Maybe (List Module)
librarySectionOtherModules :: Maybe (List Module)
, LibrarySection -> Maybe (List Module)
librarySectionGeneratedOtherModules :: Maybe (List Module)
, LibrarySection -> ParseCSources
librarySectionReexportedModules :: Maybe (List String)
, LibrarySection -> ParseCSources
librarySectionSignatures :: Maybe (List String)
} deriving (LibrarySection -> LibrarySection -> Bool
(LibrarySection -> LibrarySection -> Bool)
-> (LibrarySection -> LibrarySection -> Bool) -> Eq LibrarySection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LibrarySection -> LibrarySection -> Bool
== :: LibrarySection -> LibrarySection -> Bool
$c/= :: LibrarySection -> LibrarySection -> Bool
/= :: LibrarySection -> LibrarySection -> Bool
Eq, Int -> LibrarySection -> ShowS
[LibrarySection] -> ShowS
LibrarySection -> [Char]
(Int -> LibrarySection -> ShowS)
-> (LibrarySection -> [Char])
-> ([LibrarySection] -> ShowS)
-> Show LibrarySection
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LibrarySection -> ShowS
showsPrec :: Int -> LibrarySection -> ShowS
$cshow :: LibrarySection -> [Char]
show :: LibrarySection -> [Char]
$cshowList :: [LibrarySection] -> ShowS
showList :: [LibrarySection] -> ShowS
Show, (forall x. LibrarySection -> Rep LibrarySection x)
-> (forall x. Rep LibrarySection x -> LibrarySection)
-> Generic LibrarySection
forall x. Rep LibrarySection x -> LibrarySection
forall x. LibrarySection -> Rep LibrarySection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LibrarySection -> Rep LibrarySection x
from :: forall x. LibrarySection -> Rep LibrarySection x
$cto :: forall x. Rep LibrarySection x -> LibrarySection
to :: forall x. Rep LibrarySection x -> LibrarySection
Generic, Value -> Parser LibrarySection
(Value -> Parser LibrarySection) -> FromValue LibrarySection
forall a. (Value -> Parser a) -> FromValue a
$cfromValue :: Value -> Parser LibrarySection
fromValue :: Value -> Parser LibrarySection
FromValue)
instance Monoid LibrarySection where
mempty :: LibrarySection
mempty = Maybe Bool
-> Maybe [Char]
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List Module)
-> ParseCSources
-> ParseCSources
-> LibrarySection
LibrarySection Maybe Bool
forall a. Maybe a
Nothing Maybe [Char]
forall a. Maybe a
Nothing Maybe (List Module)
forall a. Maybe a
Nothing Maybe (List Module)
forall a. Maybe a
Nothing Maybe (List Module)
forall a. Maybe a
Nothing Maybe (List Module)
forall a. Maybe a
Nothing ParseCSources
forall a. Maybe a
Nothing ParseCSources
forall a. Maybe a
Nothing
mappend :: LibrarySection -> LibrarySection -> LibrarySection
mappend = LibrarySection -> LibrarySection -> LibrarySection
forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup LibrarySection where
LibrarySection
a <> :: LibrarySection -> LibrarySection -> LibrarySection
<> LibrarySection
b = LibrarySection {
librarySectionExposed :: Maybe Bool
librarySectionExposed = LibrarySection -> Maybe Bool
librarySectionExposed LibrarySection
b Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LibrarySection -> Maybe Bool
librarySectionExposed LibrarySection
a
, librarySectionVisibility :: Maybe [Char]
librarySectionVisibility = LibrarySection -> Maybe [Char]
librarySectionVisibility LibrarySection
b Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LibrarySection -> Maybe [Char]
librarySectionVisibility LibrarySection
a
, librarySectionExposedModules :: Maybe (List Module)
librarySectionExposedModules = LibrarySection -> Maybe (List Module)
librarySectionExposedModules LibrarySection
a Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> LibrarySection -> Maybe (List Module)
librarySectionExposedModules LibrarySection
b
, librarySectionGeneratedExposedModules :: Maybe (List Module)
librarySectionGeneratedExposedModules = LibrarySection -> Maybe (List Module)
librarySectionGeneratedExposedModules LibrarySection
a Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> LibrarySection -> Maybe (List Module)
librarySectionGeneratedExposedModules LibrarySection
b
, librarySectionOtherModules :: Maybe (List Module)
librarySectionOtherModules = LibrarySection -> Maybe (List Module)
librarySectionOtherModules LibrarySection
a Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> LibrarySection -> Maybe (List Module)
librarySectionOtherModules LibrarySection
b
, librarySectionGeneratedOtherModules :: Maybe (List Module)
librarySectionGeneratedOtherModules = LibrarySection -> Maybe (List Module)
librarySectionGeneratedOtherModules LibrarySection
a Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> LibrarySection -> Maybe (List Module)
librarySectionGeneratedOtherModules LibrarySection
b
, librarySectionReexportedModules :: ParseCSources
librarySectionReexportedModules = LibrarySection -> ParseCSources
librarySectionReexportedModules LibrarySection
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> LibrarySection -> ParseCSources
librarySectionReexportedModules LibrarySection
b
, librarySectionSignatures :: ParseCSources
librarySectionSignatures = LibrarySection -> ParseCSources
librarySectionSignatures LibrarySection
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> LibrarySection -> ParseCSources
librarySectionSignatures LibrarySection
b
}
data ExecutableSection = ExecutableSection {
ExecutableSection -> Alias 'True "main-is" (Last [Char])
executableSectionMain :: Alias 'True "main-is" (Last FilePath)
, ExecutableSection -> Maybe (List Module)
executableSectionOtherModules :: Maybe (List Module)
, ExecutableSection -> Maybe (List Module)
executableSectionGeneratedOtherModules :: Maybe (List Module)
} deriving (ExecutableSection -> ExecutableSection -> Bool
(ExecutableSection -> ExecutableSection -> Bool)
-> (ExecutableSection -> ExecutableSection -> Bool)
-> Eq ExecutableSection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExecutableSection -> ExecutableSection -> Bool
== :: ExecutableSection -> ExecutableSection -> Bool
$c/= :: ExecutableSection -> ExecutableSection -> Bool
/= :: ExecutableSection -> ExecutableSection -> Bool
Eq, Int -> ExecutableSection -> ShowS
[ExecutableSection] -> ShowS
ExecutableSection -> [Char]
(Int -> ExecutableSection -> ShowS)
-> (ExecutableSection -> [Char])
-> ([ExecutableSection] -> ShowS)
-> Show ExecutableSection
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecutableSection -> ShowS
showsPrec :: Int -> ExecutableSection -> ShowS
$cshow :: ExecutableSection -> [Char]
show :: ExecutableSection -> [Char]
$cshowList :: [ExecutableSection] -> ShowS
showList :: [ExecutableSection] -> ShowS
Show, (forall x. ExecutableSection -> Rep ExecutableSection x)
-> (forall x. Rep ExecutableSection x -> ExecutableSection)
-> Generic ExecutableSection
forall x. Rep ExecutableSection x -> ExecutableSection
forall x. ExecutableSection -> Rep ExecutableSection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExecutableSection -> Rep ExecutableSection x
from :: forall x. ExecutableSection -> Rep ExecutableSection x
$cto :: forall x. Rep ExecutableSection x -> ExecutableSection
to :: forall x. Rep ExecutableSection x -> ExecutableSection
Generic, Value -> Parser ExecutableSection
(Value -> Parser ExecutableSection) -> FromValue ExecutableSection
forall a. (Value -> Parser a) -> FromValue a
$cfromValue :: Value -> Parser ExecutableSection
fromValue :: Value -> Parser ExecutableSection
FromValue)
instance Monoid ExecutableSection where
mempty :: ExecutableSection
mempty = Alias 'True "main-is" (Last [Char])
-> Maybe (List Module) -> Maybe (List Module) -> ExecutableSection
ExecutableSection Alias 'True "main-is" (Last [Char])
forall a. Monoid a => a
mempty Maybe (List Module)
forall a. Maybe a
Nothing Maybe (List Module)
forall a. Maybe a
Nothing
mappend :: ExecutableSection -> ExecutableSection -> ExecutableSection
mappend = ExecutableSection -> ExecutableSection -> ExecutableSection
forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup ExecutableSection where
ExecutableSection
a <> :: ExecutableSection -> ExecutableSection -> ExecutableSection
<> ExecutableSection
b = ExecutableSection {
executableSectionMain :: Alias 'True "main-is" (Last [Char])
executableSectionMain = ExecutableSection -> Alias 'True "main-is" (Last [Char])
executableSectionMain ExecutableSection
a Alias 'True "main-is" (Last [Char])
-> Alias 'True "main-is" (Last [Char])
-> Alias 'True "main-is" (Last [Char])
forall a. Semigroup a => a -> a -> a
<> ExecutableSection -> Alias 'True "main-is" (Last [Char])
executableSectionMain ExecutableSection
b
, executableSectionOtherModules :: Maybe (List Module)
executableSectionOtherModules = ExecutableSection -> Maybe (List Module)
executableSectionOtherModules ExecutableSection
a Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> ExecutableSection -> Maybe (List Module)
executableSectionOtherModules ExecutableSection
b
, executableSectionGeneratedOtherModules :: Maybe (List Module)
executableSectionGeneratedOtherModules = ExecutableSection -> Maybe (List Module)
executableSectionGeneratedOtherModules ExecutableSection
a Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> ExecutableSection -> Maybe (List Module)
executableSectionGeneratedOtherModules ExecutableSection
b
}
data VerbatimValue =
VerbatimString String
| VerbatimNumber Scientific
| VerbatimBool Bool
| VerbatimNull
deriving (VerbatimValue -> VerbatimValue -> Bool
(VerbatimValue -> VerbatimValue -> Bool)
-> (VerbatimValue -> VerbatimValue -> Bool) -> Eq VerbatimValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerbatimValue -> VerbatimValue -> Bool
== :: VerbatimValue -> VerbatimValue -> Bool
$c/= :: VerbatimValue -> VerbatimValue -> Bool
/= :: VerbatimValue -> VerbatimValue -> Bool
Eq, Int -> VerbatimValue -> ShowS
[VerbatimValue] -> ShowS
VerbatimValue -> [Char]
(Int -> VerbatimValue -> ShowS)
-> (VerbatimValue -> [Char])
-> ([VerbatimValue] -> ShowS)
-> Show VerbatimValue
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerbatimValue -> ShowS
showsPrec :: Int -> VerbatimValue -> ShowS
$cshow :: VerbatimValue -> [Char]
show :: VerbatimValue -> [Char]
$cshowList :: [VerbatimValue] -> ShowS
showList :: [VerbatimValue] -> ShowS
Show)
instance FromValue VerbatimValue where
fromValue :: Value -> Parser VerbatimValue
fromValue Value
v = case Value
v of
String Text
s -> VerbatimValue -> Parser VerbatimValue
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> VerbatimValue
VerbatimString ([Char] -> VerbatimValue) -> [Char] -> VerbatimValue
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
s)
Number Scientific
n -> VerbatimValue -> Parser VerbatimValue
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Scientific -> VerbatimValue
VerbatimNumber Scientific
n)
Bool Bool
b -> VerbatimValue -> Parser VerbatimValue
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> VerbatimValue
VerbatimBool Bool
b)
Value
Null -> VerbatimValue -> Parser VerbatimValue
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return VerbatimValue
VerbatimNull
Object Object
_ -> Parser VerbatimValue
forall {a}. Parser a
err
Array Array
_ -> Parser VerbatimValue
forall {a}. Parser a
err
where
err :: Parser a
err = [Char] -> Value -> Parser a
forall a. [Char] -> Value -> Parser a
typeMismatch ([[Char]] -> [Char]
formatOrList [[Char]
"String", [Char]
"Number", [Char]
"Bool", [Char]
"Null"]) Value
v
data Verbatim = VerbatimLiteral String | VerbatimObject (Map String VerbatimValue)
deriving (Verbatim -> Verbatim -> Bool
(Verbatim -> Verbatim -> Bool)
-> (Verbatim -> Verbatim -> Bool) -> Eq Verbatim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Verbatim -> Verbatim -> Bool
== :: Verbatim -> Verbatim -> Bool
$c/= :: Verbatim -> Verbatim -> Bool
/= :: Verbatim -> Verbatim -> Bool
Eq, Int -> Verbatim -> ShowS
[Verbatim] -> ShowS
Verbatim -> [Char]
(Int -> Verbatim -> ShowS)
-> (Verbatim -> [Char]) -> ([Verbatim] -> ShowS) -> Show Verbatim
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Verbatim -> ShowS
showsPrec :: Int -> Verbatim -> ShowS
$cshow :: Verbatim -> [Char]
show :: Verbatim -> [Char]
$cshowList :: [Verbatim] -> ShowS
showList :: [Verbatim] -> ShowS
Show)
instance FromValue Verbatim where
fromValue :: Value -> Parser Verbatim
fromValue Value
v = case Value
v of
String Text
s -> Verbatim -> Parser Verbatim
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Verbatim
VerbatimLiteral ([Char] -> Verbatim) -> [Char] -> Verbatim
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
s)
Object Object
_ -> Map [Char] VerbatimValue -> Verbatim
VerbatimObject (Map [Char] VerbatimValue -> Verbatim)
-> Parser (Map [Char] VerbatimValue) -> Parser Verbatim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Map [Char] VerbatimValue)
forall a. FromValue a => Value -> Parser a
fromValue Value
v
Value
_ -> [Char] -> Value -> Parser Verbatim
forall a. [Char] -> Value -> Parser a
typeMismatch ([[Char]] -> [Char]
formatOrList [[Char]
"String", [Char]
"Object"]) Value
v
data CommonOptions cSources cxxSources jsSources a = CommonOptions {
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "hs-source-dirs" ParseCSources
commonOptionsSourceDirs :: Alias 'True "hs-source-dirs" (Maybe (List FilePath))
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsDependencies :: Alias 'True "build-depends" (Maybe Dependencies)
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'False "pkgconfig-depends" ParseCSources
commonOptionsPkgConfigDependencies :: Alias 'False "pkgconfig-depends" (Maybe (List String))
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsDefaultExtensions :: Maybe (List String)
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsOtherExtensions :: Maybe (List String)
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "default-language" (Last (Maybe Language))
commonOptionsLanguage :: Alias 'True "default-language" (Last (Maybe Language))
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcOptions :: Maybe (List GhcOption)
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcProfOptions :: Maybe (List GhcProfOption)
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcSharedOptions :: Maybe (List GhcOption)
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcjsOptions :: Maybe (List GhcjsOption)
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsCppOptions :: Maybe (List CppOption)
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsCcOptions :: Maybe (List CcOption)
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> cSources
commonOptionsCSources :: cSources
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsCxxOptions :: Maybe (List CxxOption)
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> cxxSources
commonOptionsCxxSources :: cxxSources
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> jsSources
commonOptionsJsSources :: jsSources
, :: Maybe (List FilePath)
, :: Maybe (List FilePath)
, :: Maybe (List FilePath)
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsFrameworks :: Maybe (List String)
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsIncludeDirs :: Maybe (List FilePath)
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsInstallIncludes :: Maybe (List FilePath)
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsLdOptions :: Maybe (List LdOption)
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> Last Bool
commonOptionsBuildable :: Last Bool
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe
(List (ConditionalSection cSources cxxSources jsSources a))
commonOptionsWhen :: Maybe (List (ConditionalSection cSources cxxSources jsSources a))
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsBuildTools :: Alias 'True "build-tool-depends" (Maybe BuildTools)
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe SystemBuildTools
commonOptionsSystemBuildTools :: Maybe SystemBuildTools
, forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List Verbatim)
commonOptionsVerbatim :: Maybe (List Verbatim)
} deriving ((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
$cfmap :: forall cSources cxxSources jsSources a b.
(a -> b)
-> CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources b
fmap :: forall a b.
(a -> b)
-> CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources b
$c<$ :: forall cSources cxxSources jsSources a b.
a
-> CommonOptions cSources cxxSources jsSources b
-> CommonOptions cSources cxxSources jsSources a
<$ :: forall a b.
a
-> CommonOptions cSources cxxSources jsSources b
-> CommonOptions cSources cxxSources jsSources a
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
$cfrom :: forall cSources cxxSources jsSources a x.
CommonOptions cSources cxxSources jsSources a
-> Rep (CommonOptions cSources cxxSources jsSources a) x
from :: forall 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
to :: forall x.
Rep (CommonOptions cSources cxxSources jsSources a) x
-> CommonOptions cSources cxxSources jsSources a
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 {
commonOptionsSourceDirs :: Alias 'True "hs-source-dirs" ParseCSources
commonOptionsSourceDirs = ParseCSources -> Alias 'True "hs-source-dirs" ParseCSources
forall (deprecated :: Bool) (alias :: Symbol) a.
a -> Alias deprecated alias a
Alias ParseCSources
forall a. Maybe a
Nothing
, commonOptionsDependencies :: Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsDependencies = Maybe Dependencies
-> Alias 'True "build-depends" (Maybe Dependencies)
forall (deprecated :: Bool) (alias :: Symbol) a.
a -> Alias deprecated alias a
Alias Maybe Dependencies
forall a. Maybe a
Nothing
, commonOptionsPkgConfigDependencies :: Alias 'False "pkgconfig-depends" ParseCSources
commonOptionsPkgConfigDependencies = ParseCSources -> Alias 'False "pkgconfig-depends" ParseCSources
forall (deprecated :: Bool) (alias :: Symbol) a.
a -> Alias deprecated alias a
Alias ParseCSources
forall a. Maybe a
Nothing
, commonOptionsDefaultExtensions :: ParseCSources
commonOptionsDefaultExtensions = ParseCSources
forall a. Maybe a
Nothing
, commonOptionsOtherExtensions :: ParseCSources
commonOptionsOtherExtensions = ParseCSources
forall a. Maybe a
Nothing
, commonOptionsLanguage :: Alias 'True "default-language" (Last (Maybe Language))
commonOptionsLanguage = Alias 'True "default-language" (Last (Maybe Language))
forall a. Monoid a => a
mempty
, commonOptionsGhcOptions :: ParseCSources
commonOptionsGhcOptions = ParseCSources
forall a. Maybe a
Nothing
, commonOptionsGhcProfOptions :: ParseCSources
commonOptionsGhcProfOptions = ParseCSources
forall a. Maybe a
Nothing
, commonOptionsGhcSharedOptions :: ParseCSources
commonOptionsGhcSharedOptions = ParseCSources
forall a. Maybe a
Nothing
, commonOptionsGhcjsOptions :: ParseCSources
commonOptionsGhcjsOptions = ParseCSources
forall a. Maybe a
Nothing
, commonOptionsCppOptions :: ParseCSources
commonOptionsCppOptions = ParseCSources
forall a. Maybe a
Nothing
, commonOptionsCcOptions :: ParseCSources
commonOptionsCcOptions = ParseCSources
forall a. Maybe a
Nothing
, commonOptionsCSources :: cSources
commonOptionsCSources = cSources
forall a. Monoid a => a
mempty
, commonOptionsCxxOptions :: ParseCSources
commonOptionsCxxOptions = ParseCSources
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 :: ParseCSources
commonOptionsExtraLibDirs = ParseCSources
forall a. Maybe a
Nothing
, commonOptionsExtraLibraries :: ParseCSources
commonOptionsExtraLibraries = ParseCSources
forall a. Maybe a
Nothing
, commonOptionsExtraFrameworksDirs :: ParseCSources
commonOptionsExtraFrameworksDirs = ParseCSources
forall a. Maybe a
Nothing
, commonOptionsFrameworks :: ParseCSources
commonOptionsFrameworks = ParseCSources
forall a. Maybe a
Nothing
, commonOptionsIncludeDirs :: ParseCSources
commonOptionsIncludeDirs = ParseCSources
forall a. Maybe a
Nothing
, commonOptionsInstallIncludes :: ParseCSources
commonOptionsInstallIncludes = ParseCSources
forall a. Maybe a
Nothing
, commonOptionsLdOptions :: ParseCSources
commonOptionsLdOptions = ParseCSources
forall a. Maybe a
Nothing
, commonOptionsBuildable :: Last Bool
commonOptionsBuildable = Last Bool
forall a. Monoid a => a
mempty
, commonOptionsWhen :: Maybe (List (ConditionalSection cSources cxxSources jsSources a))
commonOptionsWhen = Maybe (List (ConditionalSection cSources cxxSources jsSources a))
forall a. Maybe a
Nothing
, commonOptionsBuildTools :: Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsBuildTools = Maybe BuildTools
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
forall (deprecated :: Bool) (alias :: Symbol) a.
a -> Alias deprecated alias a
Alias Maybe BuildTools
forall a. Maybe a
Nothing
, commonOptionsSystemBuildTools :: Maybe SystemBuildTools
commonOptionsSystemBuildTools = Maybe SystemBuildTools
forall a. Maybe a
Nothing
, commonOptionsVerbatim :: Maybe (List Verbatim)
commonOptionsVerbatim = Maybe (List Verbatim)
forall a. Maybe a
Nothing
}
mappend :: CommonOptions 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 {
commonOptionsSourceDirs :: Alias 'True "hs-source-dirs" ParseCSources
commonOptionsSourceDirs = CommonOptions cSources cxxSources jsSources a
-> Alias 'True "hs-source-dirs" ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "hs-source-dirs" ParseCSources
commonOptionsSourceDirs CommonOptions cSources cxxSources jsSources a
a Alias 'True "hs-source-dirs" ParseCSources
-> Alias 'True "hs-source-dirs" ParseCSources
-> Alias 'True "hs-source-dirs" ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Alias 'True "hs-source-dirs" ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "hs-source-dirs" ParseCSources
commonOptionsSourceDirs CommonOptions cSources cxxSources jsSources a
b
, commonOptionsDependencies :: Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsDependencies = CommonOptions cSources cxxSources jsSources a
-> Alias 'True "build-depends" (Maybe Dependencies)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsDependencies CommonOptions cSources cxxSources jsSources a
b Alias 'True "build-depends" (Maybe Dependencies)
-> Alias 'True "build-depends" (Maybe Dependencies)
-> Alias 'True "build-depends" (Maybe Dependencies)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Alias 'True "build-depends" (Maybe Dependencies)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsDependencies CommonOptions cSources cxxSources jsSources a
a
, commonOptionsPkgConfigDependencies :: Alias 'False "pkgconfig-depends" ParseCSources
commonOptionsPkgConfigDependencies = CommonOptions cSources cxxSources jsSources a
-> Alias 'False "pkgconfig-depends" ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'False "pkgconfig-depends" ParseCSources
commonOptionsPkgConfigDependencies CommonOptions cSources cxxSources jsSources a
a Alias 'False "pkgconfig-depends" ParseCSources
-> Alias 'False "pkgconfig-depends" ParseCSources
-> Alias 'False "pkgconfig-depends" ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Alias 'False "pkgconfig-depends" ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'False "pkgconfig-depends" ParseCSources
commonOptionsPkgConfigDependencies CommonOptions cSources cxxSources jsSources a
b
, commonOptionsDefaultExtensions :: ParseCSources
commonOptionsDefaultExtensions = CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsDefaultExtensions CommonOptions cSources cxxSources jsSources a
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsDefaultExtensions CommonOptions cSources cxxSources jsSources a
b
, commonOptionsOtherExtensions :: ParseCSources
commonOptionsOtherExtensions = CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsOtherExtensions CommonOptions cSources cxxSources jsSources a
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsOtherExtensions CommonOptions cSources cxxSources jsSources a
b
, commonOptionsLanguage :: Alias 'True "default-language" (Last (Maybe Language))
commonOptionsLanguage = CommonOptions cSources cxxSources jsSources a
-> Alias 'True "default-language" (Last (Maybe Language))
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "default-language" (Last (Maybe Language))
commonOptionsLanguage CommonOptions cSources cxxSources jsSources a
a Alias 'True "default-language" (Last (Maybe Language))
-> Alias 'True "default-language" (Last (Maybe Language))
-> Alias 'True "default-language" (Last (Maybe Language))
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Alias 'True "default-language" (Last (Maybe Language))
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "default-language" (Last (Maybe Language))
commonOptionsLanguage CommonOptions cSources cxxSources jsSources a
b
, commonOptionsGhcOptions :: ParseCSources
commonOptionsGhcOptions = CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcOptions CommonOptions cSources cxxSources jsSources a
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcOptions CommonOptions cSources cxxSources jsSources a
b
, commonOptionsGhcProfOptions :: ParseCSources
commonOptionsGhcProfOptions = CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcProfOptions CommonOptions cSources cxxSources jsSources a
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcProfOptions CommonOptions cSources cxxSources jsSources a
b
, commonOptionsGhcSharedOptions :: ParseCSources
commonOptionsGhcSharedOptions = CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcSharedOptions CommonOptions cSources cxxSources jsSources a
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcSharedOptions CommonOptions cSources cxxSources jsSources a
b
, commonOptionsGhcjsOptions :: ParseCSources
commonOptionsGhcjsOptions = CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcjsOptions CommonOptions cSources cxxSources jsSources a
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcjsOptions CommonOptions cSources cxxSources jsSources a
b
, commonOptionsCppOptions :: ParseCSources
commonOptionsCppOptions = CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsCppOptions CommonOptions cSources cxxSources jsSources a
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsCppOptions CommonOptions cSources cxxSources jsSources a
b
, commonOptionsCcOptions :: ParseCSources
commonOptionsCcOptions = CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsCcOptions CommonOptions cSources cxxSources jsSources a
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
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 :: ParseCSources
commonOptionsCxxOptions = CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsCxxOptions CommonOptions cSources cxxSources jsSources a
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
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 :: ParseCSources
commonOptionsExtraLibDirs = CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsExtraLibDirs CommonOptions cSources cxxSources jsSources a
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsExtraLibDirs CommonOptions cSources cxxSources jsSources a
b
, commonOptionsExtraLibraries :: ParseCSources
commonOptionsExtraLibraries = CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsExtraLibraries CommonOptions cSources cxxSources jsSources a
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsExtraLibraries CommonOptions cSources cxxSources jsSources a
b
, commonOptionsExtraFrameworksDirs :: ParseCSources
commonOptionsExtraFrameworksDirs = CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsExtraFrameworksDirs CommonOptions cSources cxxSources jsSources a
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsExtraFrameworksDirs CommonOptions cSources cxxSources jsSources a
b
, commonOptionsFrameworks :: ParseCSources
commonOptionsFrameworks = CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsFrameworks CommonOptions cSources cxxSources jsSources a
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsFrameworks CommonOptions cSources cxxSources jsSources a
b
, commonOptionsIncludeDirs :: ParseCSources
commonOptionsIncludeDirs = CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsIncludeDirs CommonOptions cSources cxxSources jsSources a
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsIncludeDirs CommonOptions cSources cxxSources jsSources a
b
, commonOptionsInstallIncludes :: ParseCSources
commonOptionsInstallIncludes = CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsInstallIncludes CommonOptions cSources cxxSources jsSources a
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsInstallIncludes CommonOptions cSources cxxSources jsSources a
b
, commonOptionsLdOptions :: ParseCSources
commonOptionsLdOptions = CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsLdOptions CommonOptions cSources cxxSources jsSources a
a ParseCSources -> ParseCSources -> ParseCSources
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> ParseCSources
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsLdOptions CommonOptions cSources cxxSources jsSources a
b
, commonOptionsBuildable :: Last Bool
commonOptionsBuildable = CommonOptions cSources cxxSources jsSources a -> Last Bool
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> Last Bool
commonOptionsBuildable CommonOptions cSources cxxSources jsSources a
a Last Bool -> Last Bool -> Last Bool
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a -> Last Bool
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> Last Bool
commonOptionsBuildable CommonOptions cSources cxxSources jsSources a
b
, 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 :: Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsBuildTools = CommonOptions cSources cxxSources jsSources a
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsBuildTools CommonOptions cSources cxxSources jsSources a
a Alias 'True "build-tool-depends" (Maybe BuildTools)
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
forall a. Semigroup a => a -> a -> a
<> CommonOptions cSources cxxSources jsSources a
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "build-tool-depends" (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 {
forall (m :: * -> *) cSources cSources_ cxxSources cxxSources_
jsSources jsSources_.
Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> cSources -> m cSources_
traverseCSources :: cSources -> m cSources_
, forall (m :: * -> *) cSources cSources_ cxxSources cxxSources_
jsSources jsSources_.
Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> cxxSources -> m cxxSources_
traverseCxxSources :: cxxSources -> m cxxSources_
, forall (m :: * -> *) cSources cSources_ cxxSources cxxSources_
jsSources jsSources_.
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 :: Traversal_ CommonOptions
traverseCommonOptions t :: Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t@Traverse{cSources -> m cSources_
cxxSources -> m cxxSources_
jsSources -> m jsSources_
traverseCSources :: forall (m :: * -> *) cSources cSources_ cxxSources cxxSources_
jsSources jsSources_.
Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> cSources -> m cSources_
traverseCxxSources :: forall (m :: * -> *) cSources cSources_ cxxSources cxxSources_
jsSources jsSources_.
Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> cxxSources -> m cxxSources_
traverseJsSources :: forall (m :: * -> *) cSources cSources_ cxxSources cxxSources_
jsSources jsSources_.
Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> jsSources -> m jsSources_
traverseCSources :: cSources -> m cSources_
traverseCxxSources :: cxxSources -> m cxxSources_
traverseJsSources :: jsSources -> m jsSources_
..} c :: CommonOptions cSources cxxSources jsSources a
c@CommonOptions{cSources
cxxSources
jsSources
ParseCSources
Maybe (List (ConditionalSection cSources cxxSources jsSources a))
Maybe (List Verbatim)
Maybe SystemBuildTools
Last Bool
Alias 'False "pkgconfig-depends" ParseCSources
Alias 'True "hs-source-dirs" ParseCSources
Alias 'True "build-depends" (Maybe Dependencies)
Alias 'True "default-language" (Last (Maybe Language))
Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsSourceDirs :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "hs-source-dirs" ParseCSources
commonOptionsDependencies :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsPkgConfigDependencies :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'False "pkgconfig-depends" ParseCSources
commonOptionsDefaultExtensions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsOtherExtensions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsLanguage :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "default-language" (Last (Maybe Language))
commonOptionsGhcOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcProfOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcSharedOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcjsOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsCppOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsCcOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsCSources :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> cSources
commonOptionsCxxOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsCxxSources :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> cxxSources
commonOptionsJsSources :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> jsSources
commonOptionsExtraLibDirs :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsExtraLibraries :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsExtraFrameworksDirs :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsFrameworks :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsIncludeDirs :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsInstallIncludes :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsLdOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsBuildable :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> Last Bool
commonOptionsWhen :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe
(List (ConditionalSection cSources cxxSources jsSources a))
commonOptionsBuildTools :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsSystemBuildTools :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe SystemBuildTools
commonOptionsVerbatim :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List Verbatim)
commonOptionsSourceDirs :: Alias 'True "hs-source-dirs" ParseCSources
commonOptionsDependencies :: Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsPkgConfigDependencies :: Alias 'False "pkgconfig-depends" ParseCSources
commonOptionsDefaultExtensions :: ParseCSources
commonOptionsOtherExtensions :: ParseCSources
commonOptionsLanguage :: Alias 'True "default-language" (Last (Maybe Language))
commonOptionsGhcOptions :: ParseCSources
commonOptionsGhcProfOptions :: ParseCSources
commonOptionsGhcSharedOptions :: ParseCSources
commonOptionsGhcjsOptions :: ParseCSources
commonOptionsCppOptions :: ParseCSources
commonOptionsCcOptions :: ParseCSources
commonOptionsCSources :: cSources
commonOptionsCxxOptions :: ParseCSources
commonOptionsCxxSources :: cxxSources
commonOptionsJsSources :: jsSources
commonOptionsExtraLibDirs :: ParseCSources
commonOptionsExtraLibraries :: ParseCSources
commonOptionsExtraFrameworksDirs :: ParseCSources
commonOptionsFrameworks :: ParseCSources
commonOptionsIncludeDirs :: ParseCSources
commonOptionsInstallIncludes :: ParseCSources
commonOptionsLdOptions :: ParseCSources
commonOptionsBuildable :: Last Bool
commonOptionsWhen :: Maybe (List (ConditionalSection cSources cxxSources jsSources a))
commonOptionsBuildTools :: Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsSystemBuildTools :: Maybe SystemBuildTools
commonOptionsVerbatim :: Maybe (List Verbatim)
..} = 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> List a -> f (List 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 a. a -> m 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 :: Traversal_ ConditionalSection
traverseConditionalSection Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t = \ 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 (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Product a b -> f (Product c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Traverse
m 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 a. a -> m a
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 (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Product a b -> f (Product c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Traverse
m 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Product
(WithCommonOptions cSources cxxSources jsSources a) Condition
c
traverseThenElse :: Traversal_ ThenElse
traverseThenElse :: Traversal_ ThenElse
traverseThenElse Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t c :: ThenElse cSources cxxSources jsSources a
c@ThenElse{WithCommonOptions cSources cxxSources jsSources a
thenElseThen :: WithCommonOptions cSources cxxSources jsSources a
thenElseElse :: WithCommonOptions cSources cxxSources jsSources a
thenElseThen :: forall cSources cxxSources jsSources a.
ThenElse cSources cxxSources jsSources a
-> WithCommonOptions cSources cxxSources jsSources a
thenElseElse :: forall cSources cxxSources jsSources a.
ThenElse cSources cxxSources jsSources a
-> 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 a. a -> m 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 :: Traversal_ WithCommonOptions
traverseWithCommonOptions Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t = (CommonOptions cSources cxxSources jsSources a
-> m (CommonOptions cSources_ cxxSources_ jsSources_ a))
-> (a -> m a)
-> Product (CommonOptions cSources cxxSources jsSources a) a
-> m (Product (CommonOptions cSources_ cxxSources_ jsSources_ a) a)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Product a b -> f (Product c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Traverse
m 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 a. 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 :: forall a b.
(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 a b c. (a -> b) -> Product a c -> Product b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((a -> b)
-> ThenElse cSources cxxSources jsSources a
-> ThenElse cSources cxxSources jsSources b
forall a b.
(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 a b c. (a -> b) -> Product a c -> Product b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources b)
-> (a -> b)
-> WithCommonOptions cSources cxxSources jsSources a
-> WithCommonOptions cSources cxxSources jsSources b
forall a b c d. (a -> b) -> (c -> d) -> Product a c -> Product b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((a -> b)
-> CommonOptions 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 (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
| Key -> Value -> Bool
hasKey Key
"then" Value
v Bool -> Bool -> Bool
|| Key -> Value -> Bool
hasKey Key
"else" Value
v = Product
(ThenElse ParseCSources ParseCSources ParseCSources a) Condition
-> ParseConditionalSection a
forall cSources cxxSources jsSources a.
Product (ThenElse cSources cxxSources jsSources a) Condition
-> ConditionalSection cSources cxxSources jsSources a
ThenElseConditional (Product
(ThenElse ParseCSources ParseCSources ParseCSources a) Condition
-> ParseConditionalSection a)
-> Parser
(Product
(ThenElse ParseCSources ParseCSources ParseCSources a) Condition)
-> Parser (ParseConditionalSection a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
-> Parser
(Product
(ThenElse ParseCSources ParseCSources ParseCSources a) Condition)
forall a. FromValue a => Value -> Parser a
fromValue Value
v Parser (ParseConditionalSection a)
-> Parser () -> Parser (ParseConditionalSection a)
forall a b. Parser a -> Parser b -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
giveHint
| Bool
otherwise = Product
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
Condition
-> ParseConditionalSection a
forall cSources cxxSources jsSources a.
Product
(WithCommonOptions cSources cxxSources jsSources a) Condition
-> ConditionalSection cSources cxxSources jsSources a
FlatConditional (Product
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
Condition
-> ParseConditionalSection a)
-> Parser
(Product
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
Condition)
-> Parser (ParseConditionalSection a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
-> Parser
(Product
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
Condition)
forall a. FromValue a => Value -> Parser a
fromValue Value
v
where
giveHint :: Parser ()
giveHint = case Value
v of
Object Object
o -> case (,,) (Value -> Value -> Value -> (Value, Value, Value))
-> Maybe Value -> Maybe (Value -> Value -> (Value, Value, Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"then" Object
o Maybe (Value -> Value -> (Value, Value, Value))
-> Maybe Value -> Maybe (Value -> (Value, Value, Value))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"else" Object
o Maybe (Value -> (Value, Value, Value))
-> Maybe Value -> Maybe (Value, Value, Value)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"condition" Object
o of
Just (Object Object
then_, Object Object
else_, String Text
condition) -> do
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Object -> Bool
forall v. KeyMap v -> Bool
KeyMap.null Object
then_) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ [Char]
"then" [Char] -> Value -> Parser ()
`emptyTryInstead` Value
flatElse
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Object -> Bool
forall v. KeyMap v -> Bool
KeyMap.null Object
else_) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ [Char]
"else" [Char] -> Value -> Parser ()
`emptyTryInstead` Value
flatThen
where
flatThen :: Value
flatThen = Text -> Object -> Value
flatConditional Text
condition Object
then_
flatElse :: Value
flatElse = Text -> Object -> Value
flatConditional (Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
negate_ Text
condition) Object
else_
Maybe (Value, Value, Value)
_ -> () -> Parser ()
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Value
_ -> () -> Parser ()
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
negate_ :: a -> a
negate_ a
condition = a
"!(" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
condition a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"
flatConditional :: Text -> Object -> Value
flatConditional Text
condition Object
sect = [Pair] -> Value
object [(Key
"when" Key -> Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert Key
"condition" (Text -> Value
String Text
condition) Object
sect)]
emptyTryInstead :: String -> Value -> Parser ()
emptyTryInstead :: [Char] -> Value -> Parser ()
emptyTryInstead [Char]
name Value
sect = do
[Char] -> Parser ()
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser ()) -> [Char] -> Parser ()
forall a b. (a -> b) -> a -> b
$ [Char]
"an empty " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> [Char]
show [Char]
name [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" section is not allowed, try the following instead:\n\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
encodePretty Value
sect
encodePretty :: Value -> [Char]
encodePretty = Text -> [Char]
T.unpack (Text -> [Char]) -> (Value -> Text) -> Value -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (Value -> ByteString) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Value -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
Yaml.encodePretty Config
c
where
c :: Yaml.Config
c :: Config
c = (Text -> Text -> Ordering) -> Config -> Config
Yaml.setConfCompare Text -> Text -> Ordering
forall {a}. (IsString a, Ord a) => a -> a -> Ordering
f Config
Yaml.defConfig
where
f :: a -> a -> Ordering
f a
a a
b = case (a
a, a
b) of
(a
"condition", a
"condition") -> Ordering
EQ
(a
"condition", a
_) -> Ordering
LT
(a
_, a
"condition") -> Ordering
GT
(a, a)
_ -> a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
hasKey :: Key -> Value -> Bool
hasKey :: Key -> Value -> Bool
hasKey Key
key (Object Object
o) = Key -> Object -> Bool
forall a. Key -> KeyMap a -> Bool
KeyMap.member Key
key Object
o
hasKey Key
_ Value
_ = Bool
False
newtype Condition = Condition {
Condition -> Cond
conditionCondition :: Cond
} deriving (Condition -> Condition -> Bool
(Condition -> Condition -> Bool)
-> (Condition -> Condition -> Bool) -> Eq Condition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Condition -> Condition -> Bool
== :: Condition -> Condition -> Bool
$c/= :: Condition -> Condition -> Bool
/= :: Condition -> Condition -> Bool
Eq, Int -> Condition -> ShowS
[Condition] -> ShowS
Condition -> [Char]
(Int -> Condition -> ShowS)
-> (Condition -> [Char])
-> ([Condition] -> ShowS)
-> Show Condition
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Condition -> ShowS
showsPrec :: Int -> Condition -> ShowS
$cshow :: Condition -> [Char]
show :: Condition -> [Char]
$cshowList :: [Condition] -> ShowS
showList :: [Condition] -> ShowS
Show, (forall x. Condition -> Rep Condition x)
-> (forall x. Rep Condition x -> Condition) -> Generic Condition
forall x. Rep Condition x -> Condition
forall x. Condition -> Rep Condition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Condition -> Rep Condition x
from :: forall x. Condition -> Rep Condition x
$cto :: forall x. Rep Condition x -> Condition
to :: forall x. Rep Condition x -> Condition
Generic, Value -> Parser Condition
(Value -> Parser Condition) -> FromValue Condition
forall a. (Value -> Parser a) -> FromValue a
$cfromValue :: Value -> Parser Condition
fromValue :: Value -> Parser Condition
FromValue)
data Cond = CondBool Bool | CondExpression String
deriving (Cond -> Cond -> Bool
(Cond -> Cond -> Bool) -> (Cond -> Cond -> Bool) -> Eq Cond
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cond -> Cond -> Bool
== :: Cond -> Cond -> Bool
$c/= :: Cond -> Cond -> Bool
/= :: Cond -> Cond -> Bool
Eq, Int -> Cond -> ShowS
[Cond] -> ShowS
Cond -> [Char]
(Int -> Cond -> ShowS)
-> (Cond -> [Char]) -> ([Cond] -> ShowS) -> Show Cond
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cond -> ShowS
showsPrec :: Int -> Cond -> ShowS
$cshow :: Cond -> [Char]
show :: Cond -> [Char]
$cshowList :: [Cond] -> ShowS
showList :: [Cond] -> ShowS
Show)
instance FromValue Cond where
fromValue :: Value -> Parser Cond
fromValue Value
v = case Value
v of
String Text
c -> Cond -> Parser Cond
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Cond
CondExpression ([Char] -> Cond) -> [Char] -> Cond
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
c)
Bool Bool
c -> Cond -> Parser Cond
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Cond
CondBool Bool
c)
Value
_ -> [Char] -> Value -> Parser Cond
forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
"Boolean or String" Value
v
data ThenElse cSources cxxSources jsSources a = ThenElse {
forall cSources cxxSources jsSources a.
ThenElse cSources cxxSources jsSources a
-> WithCommonOptions cSources cxxSources jsSources a
thenElseThen :: WithCommonOptions cSources cxxSources jsSources a
, forall 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
$cfrom :: forall cSources cxxSources jsSources a x.
ThenElse cSources cxxSources jsSources a
-> Rep (ThenElse cSources cxxSources jsSources a) x
from :: forall 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
to :: forall x.
Rep (ThenElse cSources cxxSources jsSources a) x
-> ThenElse cSources cxxSources jsSources a
Generic
instance Functor (ThenElse cSources cxxSources jsSources) where
fmap :: forall a b.
(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
thenElseThen :: forall cSources cxxSources jsSources a.
ThenElse cSources cxxSources jsSources a
-> WithCommonOptions cSources cxxSources jsSources a
thenElseElse :: forall cSources cxxSources jsSources a.
ThenElse cSources cxxSources jsSources a
-> WithCommonOptions cSources cxxSources jsSources a
thenElseThen :: WithCommonOptions cSources cxxSources jsSources a
thenElseElse :: 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 a b c d. (a -> b) -> (c -> d) -> Product a c -> Product b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((a -> b)
-> CommonOptions 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 (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
$c== :: Empty -> Empty -> Bool
== :: Empty -> Empty -> Bool
$c/= :: Empty -> Empty -> Bool
/= :: Empty -> Empty -> Bool
Eq, Int -> Empty -> ShowS
[Empty] -> ShowS
Empty -> [Char]
(Int -> Empty -> ShowS)
-> (Empty -> [Char]) -> ([Empty] -> ShowS) -> Show Empty
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Empty -> ShowS
showsPrec :: Int -> Empty -> ShowS
$cshow :: Empty -> [Char]
show :: Empty -> [Char]
$cshowList :: [Empty] -> ShowS
showList :: [Empty] -> ShowS
Show)
instance Monoid Empty where
mempty :: Empty
mempty = Empty
Empty
mappend :: Empty -> Empty -> Empty
mappend = Empty -> Empty -> Empty
forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup Empty where
Empty
Empty <> :: Empty -> Empty -> Empty
<> Empty
Empty = Empty
Empty
instance FromValue Empty where
fromValue :: Value -> Parser Empty
fromValue Value
_ = Empty -> Parser Empty
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Empty
Empty
newtype Language = Language String
deriving (Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
/= :: Language -> Language -> Bool
Eq, Int -> Language -> ShowS
[Language] -> ShowS
Language -> [Char]
(Int -> Language -> ShowS)
-> (Language -> [Char]) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Language -> ShowS
showsPrec :: Int -> Language -> ShowS
$cshow :: Language -> [Char]
show :: Language -> [Char]
$cshowList :: [Language] -> ShowS
showList :: [Language] -> ShowS
Show)
instance IsString Language where
fromString :: [Char] -> Language
fromString = [Char] -> Language
Language
instance FromValue Language where
fromValue :: Value -> Parser Language
fromValue = ([Char] -> Language) -> Parser [Char] -> Parser Language
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> Language
Language (Parser [Char] -> Parser Language)
-> (Value -> Parser [Char]) -> Value -> Parser Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser [Char]
forall a. FromValue a => Value -> Parser a
fromValue
data BuildType =
Simple
| Configure
| Make
| Custom
deriving (BuildType -> BuildType -> Bool
(BuildType -> BuildType -> Bool)
-> (BuildType -> BuildType -> Bool) -> Eq BuildType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildType -> BuildType -> Bool
== :: BuildType -> BuildType -> Bool
$c/= :: BuildType -> BuildType -> Bool
/= :: BuildType -> BuildType -> Bool
Eq, Int -> BuildType -> ShowS
[BuildType] -> ShowS
BuildType -> [Char]
(Int -> BuildType -> ShowS)
-> (BuildType -> [Char])
-> ([BuildType] -> ShowS)
-> Show BuildType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildType -> ShowS
showsPrec :: Int -> BuildType -> ShowS
$cshow :: BuildType -> [Char]
show :: BuildType -> [Char]
$cshowList :: [BuildType] -> ShowS
showList :: [BuildType] -> ShowS
Show, Int -> BuildType
BuildType -> Int
BuildType -> [BuildType]
BuildType -> BuildType
BuildType -> BuildType -> [BuildType]
BuildType -> BuildType -> BuildType -> [BuildType]
(BuildType -> BuildType)
-> (BuildType -> BuildType)
-> (Int -> BuildType)
-> (BuildType -> Int)
-> (BuildType -> [BuildType])
-> (BuildType -> BuildType -> [BuildType])
-> (BuildType -> BuildType -> [BuildType])
-> (BuildType -> BuildType -> BuildType -> [BuildType])
-> Enum BuildType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BuildType -> BuildType
succ :: BuildType -> BuildType
$cpred :: BuildType -> BuildType
pred :: BuildType -> BuildType
$ctoEnum :: Int -> BuildType
toEnum :: Int -> BuildType
$cfromEnum :: BuildType -> Int
fromEnum :: BuildType -> Int
$cenumFrom :: BuildType -> [BuildType]
enumFrom :: BuildType -> [BuildType]
$cenumFromThen :: BuildType -> BuildType -> [BuildType]
enumFromThen :: BuildType -> BuildType -> [BuildType]
$cenumFromTo :: BuildType -> BuildType -> [BuildType]
enumFromTo :: BuildType -> BuildType -> [BuildType]
$cenumFromThenTo :: BuildType -> BuildType -> BuildType -> [BuildType]
enumFromThenTo :: BuildType -> BuildType -> BuildType -> [BuildType]
Enum, BuildType
BuildType -> BuildType -> Bounded BuildType
forall a. a -> a -> Bounded a
$cminBound :: BuildType
minBound :: BuildType
$cmaxBound :: BuildType
maxBound :: BuildType
Bounded)
instance FromValue BuildType where
fromValue :: Value -> Parser BuildType
fromValue = (Text -> Parser BuildType) -> Value -> Parser BuildType
forall a. (Text -> Parser a) -> Value -> Parser a
withText ((Text -> Parser BuildType) -> Value -> Parser BuildType)
-> (Text -> Parser BuildType) -> Value -> Parser BuildType
forall a b. (a -> b) -> a -> b
$ \ (Text -> [Char]
T.unpack -> [Char]
t) -> do
Parser BuildType
-> (BuildType -> Parser BuildType)
-> Maybe BuildType
-> Parser BuildType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser BuildType
forall {a}. Parser a
err BuildType -> Parser BuildType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> [([Char], BuildType)] -> Maybe BuildType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
t [([Char], BuildType)]
options)
where
err :: Parser a
err = [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"expected one of " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
formatOrList [[Char]]
buildTypesAsString)
buildTypes :: [BuildType]
buildTypes = [BuildType
forall a. Bounded a => a
minBound .. BuildType
forall a. Bounded a => a
maxBound]
buildTypesAsString :: [[Char]]
buildTypesAsString = (BuildType -> [Char]) -> [BuildType] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map BuildType -> [Char]
forall a. Show a => a -> [Char]
show [BuildType]
buildTypes
options :: [([Char], BuildType)]
options = [[Char]] -> [BuildType] -> [([Char], BuildType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
buildTypesAsString [BuildType]
buildTypes
formatOrList :: [String] -> String
formatOrList :: [[Char]] -> [Char]
formatOrList [[Char]]
xs = case [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
xs of
[] -> [Char]
""
[Char]
x : [] -> [Char]
x
[Char]
y : [Char]
x : [] -> [Char]
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" or " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
y
[Char]
x : ys :: [[Char]]
ys@([Char]
_:[Char]
_:[[Char]]
_) -> [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([Char]
"or " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
ys
type SectionConfigWithDefaults cSources cxxSources jsSources a = Product DefaultsConfig (WithCommonOptions cSources cxxSources jsSources a)
type PackageConfigWithDefaults cSources cxxSources jsSources = PackageConfig_
(SectionConfigWithDefaults cSources cxxSources jsSources LibrarySection)
(SectionConfigWithDefaults cSources cxxSources jsSources ExecutableSection)
type PackageConfig cSources cxxSources jsSources = PackageConfig_
(WithCommonOptions cSources cxxSources jsSources LibrarySection)
(WithCommonOptions cSources cxxSources jsSources ExecutableSection)
data PackageVersion = PackageVersion {PackageVersion -> [Char]
unPackageVersion :: String}
instance FromValue PackageVersion where
fromValue :: Value -> Parser PackageVersion
fromValue Value
v = [Char] -> PackageVersion
PackageVersion ([Char] -> PackageVersion)
-> Parser [Char] -> Parser PackageVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Value
v of
Number Scientific
n -> [Char] -> Parser [Char]
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Scientific -> [Char]
scientificToVersion Scientific
n)
String Text
s -> [Char] -> Parser [Char]
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [Char]
T.unpack Text
s)
Value
_ -> [Char] -> Value -> Parser [Char]
forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
"Number or String" Value
v
data PackageConfig_ library executable = PackageConfig {
forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigName :: Maybe String
, forall library executable.
PackageConfig_ library executable -> Maybe PackageVersion
packageConfigVersion :: Maybe PackageVersion
, forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigSynopsis :: Maybe String
, forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigDescription :: Maybe String
, forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigHomepage :: Maybe (Maybe String)
, forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigBugReports :: Maybe (Maybe String)
, forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigCategory :: Maybe String
, forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigStability :: Maybe String
, forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigAuthor :: Maybe (List String)
, forall library executable.
PackageConfig_ library executable -> Maybe ParseCSources
packageConfigMaintainer :: Maybe (Maybe (List String))
, forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigCopyright :: Maybe (List String)
, forall library executable.
PackageConfig_ library executable -> Maybe BuildType
packageConfigBuildType :: Maybe BuildType
, forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigLicense :: Maybe (Maybe String)
, forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigLicenseFile :: Maybe (List String)
, forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigTestedWith :: Maybe (List String)
, forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] FlagSection)
packageConfigFlags :: Maybe (Map String FlagSection)
, :: Maybe (List FilePath)
, :: Maybe (List FilePath)
, forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigDataFiles :: Maybe (List FilePath)
, forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigDataDir :: Maybe FilePath
, forall library executable.
PackageConfig_ library executable -> Maybe GitHub
packageConfigGithub :: Maybe GitHub
, forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigGit :: Maybe String
, forall library executable.
PackageConfig_ library executable -> Maybe CustomSetupSection
packageConfigCustomSetup :: Maybe CustomSetupSection
, forall library executable.
PackageConfig_ library executable -> Maybe library
packageConfigLibrary :: Maybe library
, forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] library)
packageConfigInternalLibraries :: Maybe (Map String library)
, forall library executable.
PackageConfig_ library executable -> Maybe executable
packageConfigExecutable :: Maybe executable
, forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigExecutables :: Maybe (Map String executable)
, forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigTests :: Maybe (Map String executable)
, forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigBenchmarks :: Maybe (Map String executable)
} deriving (forall x.
PackageConfig_ library executable
-> Rep (PackageConfig_ library executable) x)
-> (forall x.
Rep (PackageConfig_ library executable) x
-> PackageConfig_ library executable)
-> Generic (PackageConfig_ library executable)
forall x.
Rep (PackageConfig_ library executable) x
-> PackageConfig_ library executable
forall x.
PackageConfig_ library executable
-> Rep (PackageConfig_ library executable) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall library executable x.
Rep (PackageConfig_ library executable) x
-> PackageConfig_ library executable
forall library executable x.
PackageConfig_ library executable
-> Rep (PackageConfig_ library executable) x
$cfrom :: forall library executable x.
PackageConfig_ library executable
-> Rep (PackageConfig_ library executable) x
from :: forall x.
PackageConfig_ library executable
-> Rep (PackageConfig_ library executable) x
$cto :: forall library executable x.
Rep (PackageConfig_ library executable) x
-> PackageConfig_ library executable
to :: forall x.
Rep (PackageConfig_ library executable) x
-> PackageConfig_ library executable
Generic
data GitHub = GitHub {
GitHub -> [Char]
_gitHubOwner :: String
, GitHub -> [Char]
_gitHubRepo :: String
, GitHub -> Maybe [Char]
_gitHubSubdir :: Maybe String
}
instance FromValue GitHub where
fromValue :: Value -> Parser GitHub
fromValue Value
v = do
Text
input <- Value -> Parser Text
forall a. FromValue a => Value -> Parser a
fromValue Value
v
case (Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack ([Text] -> [[Char]]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"/" Text
input of
[[Char]
owner, [Char]
repo, [Char]
subdir] -> GitHub -> Parser GitHub
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (GitHub -> Parser GitHub) -> GitHub -> Parser GitHub
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Maybe [Char] -> GitHub
GitHub [Char]
owner [Char]
repo ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
subdir)
[[Char]
owner, [Char]
repo] -> GitHub -> Parser GitHub
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (GitHub -> Parser GitHub) -> GitHub -> Parser GitHub
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Maybe [Char] -> GitHub
GitHub [Char]
owner [Char]
repo Maybe [Char]
forall a. Maybe a
Nothing
[[Char]]
_ -> [Char] -> Parser GitHub
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser GitHub) -> [Char] -> Parser GitHub
forall a b. (a -> b) -> a -> b
$ [Char]
"expected owner/repo or owner/repo/subdir, but encountered " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
input
data DefaultsConfig = DefaultsConfig {
DefaultsConfig -> Maybe (List Defaults)
defaultsConfigDefaults :: Maybe (List Defaults)
} deriving ((forall x. DefaultsConfig -> Rep DefaultsConfig x)
-> (forall x. Rep DefaultsConfig x -> DefaultsConfig)
-> Generic DefaultsConfig
forall x. Rep DefaultsConfig x -> DefaultsConfig
forall x. DefaultsConfig -> Rep DefaultsConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DefaultsConfig -> Rep DefaultsConfig x
from :: forall x. DefaultsConfig -> Rep DefaultsConfig x
$cto :: forall x. Rep DefaultsConfig x -> DefaultsConfig
to :: forall x. Rep DefaultsConfig x -> DefaultsConfig
Generic, Value -> Parser DefaultsConfig
(Value -> Parser DefaultsConfig) -> FromValue DefaultsConfig
forall a. (Value -> Parser a) -> FromValue a
$cfromValue :: Value -> Parser DefaultsConfig
fromValue :: Value -> Parser DefaultsConfig
FromValue)
traversePackageConfig :: Traversal PackageConfig
traversePackageConfig :: Traversal PackageConfig
traversePackageConfig Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t p :: PackageConfig cSources cxxSources jsSources
p@PackageConfig{Maybe [Char]
Maybe (Maybe [Char])
Maybe ParseCSources
Maybe
(Map
[Char]
(WithCommonOptions
cSources cxxSources jsSources ExecutableSection))
Maybe
(Map
[Char]
(WithCommonOptions cSources cxxSources jsSources LibrarySection))
Maybe (Map [Char] FlagSection)
Maybe
(WithCommonOptions cSources cxxSources jsSources ExecutableSection)
Maybe
(WithCommonOptions cSources cxxSources jsSources LibrarySection)
ParseCSources
Maybe GitHub
Maybe PackageVersion
Maybe BuildType
Maybe CustomSetupSection
packageConfigName :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigVersion :: forall library executable.
PackageConfig_ library executable -> Maybe PackageVersion
packageConfigSynopsis :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigDescription :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigHomepage :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigBugReports :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigCategory :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigStability :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigAuthor :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigMaintainer :: forall library executable.
PackageConfig_ library executable -> Maybe ParseCSources
packageConfigCopyright :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigBuildType :: forall library executable.
PackageConfig_ library executable -> Maybe BuildType
packageConfigLicense :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigLicenseFile :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigTestedWith :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigFlags :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] FlagSection)
packageConfigExtraSourceFiles :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigExtraDocFiles :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigDataFiles :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigDataDir :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigGithub :: forall library executable.
PackageConfig_ library executable -> Maybe GitHub
packageConfigGit :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigCustomSetup :: forall library executable.
PackageConfig_ library executable -> Maybe CustomSetupSection
packageConfigLibrary :: forall library executable.
PackageConfig_ library executable -> Maybe library
packageConfigInternalLibraries :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] library)
packageConfigExecutable :: forall library executable.
PackageConfig_ library executable -> Maybe executable
packageConfigExecutables :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigTests :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigBenchmarks :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigName :: Maybe [Char]
packageConfigVersion :: Maybe PackageVersion
packageConfigSynopsis :: Maybe [Char]
packageConfigDescription :: Maybe [Char]
packageConfigHomepage :: Maybe (Maybe [Char])
packageConfigBugReports :: Maybe (Maybe [Char])
packageConfigCategory :: Maybe [Char]
packageConfigStability :: Maybe [Char]
packageConfigAuthor :: ParseCSources
packageConfigMaintainer :: Maybe ParseCSources
packageConfigCopyright :: ParseCSources
packageConfigBuildType :: Maybe BuildType
packageConfigLicense :: Maybe (Maybe [Char])
packageConfigLicenseFile :: ParseCSources
packageConfigTestedWith :: ParseCSources
packageConfigFlags :: Maybe (Map [Char] FlagSection)
packageConfigExtraSourceFiles :: ParseCSources
packageConfigExtraDocFiles :: ParseCSources
packageConfigDataFiles :: ParseCSources
packageConfigDataDir :: Maybe [Char]
packageConfigGithub :: Maybe GitHub
packageConfigGit :: Maybe [Char]
packageConfigCustomSetup :: Maybe CustomSetupSection
packageConfigLibrary :: Maybe
(WithCommonOptions cSources cxxSources jsSources LibrarySection)
packageConfigInternalLibraries :: Maybe
(Map
[Char]
(WithCommonOptions cSources cxxSources jsSources LibrarySection))
packageConfigExecutable :: Maybe
(WithCommonOptions cSources cxxSources jsSources ExecutableSection)
packageConfigExecutables :: Maybe
(Map
[Char]
(WithCommonOptions
cSources cxxSources jsSources ExecutableSection))
packageConfigTests :: Maybe
(Map
[Char]
(WithCommonOptions
cSources cxxSources jsSources ExecutableSection))
packageConfigBenchmarks :: Maybe
(Map
[Char]
(WithCommonOptions
cSources cxxSources jsSources ExecutableSection))
..} = 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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
[Char]
(WithCommonOptions
cSources_ cxxSources_ jsSources_ LibrarySection))
internalLibraries <- Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> Maybe
(Map
[Char]
(WithCommonOptions cSources cxxSources jsSources LibrarySection))
-> m (Maybe
(Map
[Char]
(WithCommonOptions
cSources_ cxxSources_ jsSources_ LibrarySection)))
forall {cSources} {cSources_} {cxxSources} {cxxSources_}
{jsSources} {jsSources_} {a}.
Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> Maybe
(Map [Char] (WithCommonOptions cSources cxxSources jsSources a))
-> m (Maybe
(Map
[Char] (WithCommonOptions cSources_ cxxSources_ jsSources_ a)))
traverseNamedConfigs Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t Maybe
(Map
[Char]
(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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe 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
[Char]
(WithCommonOptions
cSources_ cxxSources_ jsSources_ ExecutableSection))
executables <- Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> Maybe
(Map
[Char]
(WithCommonOptions
cSources cxxSources jsSources ExecutableSection))
-> m (Maybe
(Map
[Char]
(WithCommonOptions
cSources_ cxxSources_ jsSources_ ExecutableSection)))
forall {cSources} {cSources_} {cxxSources} {cxxSources_}
{jsSources} {jsSources_} {a}.
Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> Maybe
(Map [Char] (WithCommonOptions cSources cxxSources jsSources a))
-> m (Maybe
(Map
[Char] (WithCommonOptions cSources_ cxxSources_ jsSources_ a)))
traverseNamedConfigs Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t Maybe
(Map
[Char]
(WithCommonOptions
cSources cxxSources jsSources ExecutableSection))
packageConfigExecutables
Maybe
(Map
[Char]
(WithCommonOptions
cSources_ cxxSources_ jsSources_ ExecutableSection))
tests <- Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> Maybe
(Map
[Char]
(WithCommonOptions
cSources cxxSources jsSources ExecutableSection))
-> m (Maybe
(Map
[Char]
(WithCommonOptions
cSources_ cxxSources_ jsSources_ ExecutableSection)))
forall {cSources} {cSources_} {cxxSources} {cxxSources_}
{jsSources} {jsSources_} {a}.
Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> Maybe
(Map [Char] (WithCommonOptions cSources cxxSources jsSources a))
-> m (Maybe
(Map
[Char] (WithCommonOptions cSources_ cxxSources_ jsSources_ a)))
traverseNamedConfigs Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t Maybe
(Map
[Char]
(WithCommonOptions
cSources cxxSources jsSources ExecutableSection))
packageConfigTests
Maybe
(Map
[Char]
(WithCommonOptions
cSources_ cxxSources_ jsSources_ ExecutableSection))
benchmarks <- Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> Maybe
(Map
[Char]
(WithCommonOptions
cSources cxxSources jsSources ExecutableSection))
-> m (Maybe
(Map
[Char]
(WithCommonOptions
cSources_ cxxSources_ jsSources_ ExecutableSection)))
forall {cSources} {cSources_} {cxxSources} {cxxSources_}
{jsSources} {jsSources_} {a}.
Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> Maybe
(Map [Char] (WithCommonOptions cSources cxxSources jsSources a))
-> m (Maybe
(Map
[Char] (WithCommonOptions cSources_ cxxSources_ jsSources_ a)))
traverseNamedConfigs Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
t Maybe
(Map
[Char]
(WithCommonOptions
cSources cxxSources jsSources ExecutableSection))
packageConfigBenchmarks
PackageConfig cSources_ cxxSources_ jsSources_
-> m (PackageConfig cSources_ cxxSources_ jsSources_)
forall a. a -> m a
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
[Char]
(WithCommonOptions
cSources_ cxxSources_ jsSources_ LibrarySection))
packageConfigInternalLibraries = Maybe
(Map
[Char]
(WithCommonOptions
cSources_ cxxSources_ jsSources_ LibrarySection))
internalLibraries
, packageConfigExecutable :: Maybe
(WithCommonOptions
cSources_ cxxSources_ jsSources_ ExecutableSection)
packageConfigExecutable = Maybe
(WithCommonOptions
cSources_ cxxSources_ jsSources_ ExecutableSection)
executable
, packageConfigExecutables :: Maybe
(Map
[Char]
(WithCommonOptions
cSources_ cxxSources_ jsSources_ ExecutableSection))
packageConfigExecutables = Maybe
(Map
[Char]
(WithCommonOptions
cSources_ cxxSources_ jsSources_ ExecutableSection))
executables
, packageConfigTests :: Maybe
(Map
[Char]
(WithCommonOptions
cSources_ cxxSources_ jsSources_ ExecutableSection))
packageConfigTests = Maybe
(Map
[Char]
(WithCommonOptions
cSources_ cxxSources_ jsSources_ ExecutableSection))
tests
, packageConfigBenchmarks :: Maybe
(Map
[Char]
(WithCommonOptions
cSources_ cxxSources_ jsSources_ ExecutableSection))
packageConfigBenchmarks = Maybe
(Map
[Char]
(WithCommonOptions
cSources_ cxxSources_ jsSources_ ExecutableSection))
benchmarks
}
where
traverseNamedConfigs :: Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> Maybe
(Map [Char] (WithCommonOptions cSources cxxSources jsSources a))
-> m (Maybe
(Map
[Char] (WithCommonOptions cSources_ cxxSources_ jsSources_ a)))
traverseNamedConfigs = (Map [Char] (WithCommonOptions cSources cxxSources jsSources a)
-> m (Map
[Char] (WithCommonOptions cSources_ cxxSources_ jsSources_ a)))
-> Maybe
(Map [Char] (WithCommonOptions cSources cxxSources jsSources a))
-> m (Maybe
(Map
[Char] (WithCommonOptions cSources_ cxxSources_ jsSources_ a)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((Map [Char] (WithCommonOptions cSources cxxSources jsSources a)
-> m (Map
[Char] (WithCommonOptions cSources_ cxxSources_ jsSources_ a)))
-> Maybe
(Map [Char] (WithCommonOptions cSources cxxSources jsSources a))
-> m (Maybe
(Map
[Char] (WithCommonOptions cSources_ cxxSources_ jsSources_ a))))
-> (Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> Map [Char] (WithCommonOptions cSources cxxSources jsSources a)
-> m (Map
[Char] (WithCommonOptions cSources_ cxxSources_ jsSources_ a)))
-> Traverse
m cSources cSources_ cxxSources cxxSources_ jsSources jsSources_
-> Maybe
(Map [Char] (WithCommonOptions cSources cxxSources jsSources a))
-> m (Maybe
(Map
[Char] (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 [Char] (WithCommonOptions cSources cxxSources jsSources a)
-> m (Map
[Char] (WithCommonOptions cSources_ cxxSources_ jsSources_ a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map [Char] a -> f (Map [Char] b)
traverse ((WithCommonOptions cSources cxxSources jsSources a
-> m (WithCommonOptions cSources_ cxxSources_ jsSources_ a))
-> Map [Char] (WithCommonOptions cSources cxxSources jsSources a)
-> m (Map
[Char] (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 [Char] (WithCommonOptions cSources cxxSources jsSources a)
-> m (Map
[Char] (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 HpackError
liftEither :: IO (Either HpackError a) -> Warnings (Errors IO) a
liftEither :: forall a. IO (Either HpackError a) -> Warnings (Errors IO) a
liftEither = Errors IO a -> WriterT [[Char]] (Errors IO) a
forall (m :: * -> *) a. Monad m => m a -> WriterT [[Char]] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Errors IO a -> WriterT [[Char]] (Errors IO) a)
-> (IO (Either HpackError a) -> Errors IO a)
-> IO (Either HpackError a)
-> WriterT [[Char]] (Errors IO) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either HpackError a) -> Errors IO a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT
type FormatYamlParseError = FilePath -> Yaml.ParseException -> String
decodeYaml :: FromValue a => FormatYamlParseError -> FilePath -> Warnings (Errors IO) a
decodeYaml :: forall a.
FromValue a =>
FormatYamlParseError -> [Char] -> Warnings (Errors IO) a
decodeYaml FormatYamlParseError
formatYamlParseError [Char]
file = do
([[Char]]
warnings, Value
a) <- IO (Either HpackError ([[Char]], Value))
-> Warnings (Errors IO) ([[Char]], Value)
forall a. IO (Either HpackError a) -> Warnings (Errors IO) a
liftEither (IO (Either HpackError ([[Char]], Value))
-> Warnings (Errors IO) ([[Char]], Value))
-> IO (Either HpackError ([[Char]], Value))
-> Warnings (Errors IO) ([[Char]], Value)
forall a b. (a -> b) -> a -> b
$ (ParseException -> HpackError)
-> Either ParseException ([[Char]], Value)
-> Either HpackError ([[Char]], Value)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Char] -> HpackError
ParseError ([Char] -> HpackError)
-> (ParseException -> [Char]) -> ParseException -> HpackError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormatYamlParseError
formatYamlParseError [Char]
file) (Either ParseException ([[Char]], Value)
-> Either HpackError ([[Char]], Value))
-> IO (Either ParseException ([[Char]], Value))
-> IO (Either HpackError ([[Char]], Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Either ParseException ([[Char]], Value))
Yaml.decodeYamlWithParseError [Char]
file
[[Char]] -> WriterT [[Char]] (Errors IO) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [[Char]]
warnings
[Char] -> Value -> Warnings (Errors IO) a
forall a. FromValue a => [Char] -> Value -> Warnings (Errors IO) a
decodeValue [Char]
file Value
a
data DecodeOptions = DecodeOptions {
DecodeOptions -> ProgramName
decodeOptionsProgramName :: ProgramName
, DecodeOptions -> [Char]
decodeOptionsTarget :: FilePath
, DecodeOptions -> Maybe [Char]
decodeOptionsUserDataDir :: Maybe FilePath
, DecodeOptions -> [Char] -> IO (Either [Char] ([[Char]], Value))
decodeOptionsDecode :: FilePath -> IO (Either String ([String], Value))
, DecodeOptions -> FormatYamlParseError
decodeOptionsFormatYamlParseError :: FilePath -> Yaml.ParseException -> String
}
defaultDecodeOptions :: DecodeOptions
defaultDecodeOptions :: DecodeOptions
defaultDecodeOptions = ProgramName
-> [Char]
-> Maybe [Char]
-> ([Char] -> IO (Either [Char] ([[Char]], Value)))
-> FormatYamlParseError
-> DecodeOptions
DecodeOptions ProgramName
"hpack" [Char]
packageConfig Maybe [Char]
forall a. Maybe a
Nothing [Char] -> IO (Either [Char] ([[Char]], Value))
Yaml.decodeYaml FormatYamlParseError
Yaml.formatYamlParseError
data DecodeResult = DecodeResult {
DecodeResult -> Package
decodeResultPackage :: Package
, DecodeResult -> [Char]
decodeResultCabalVersion :: String
, DecodeResult -> [Char]
decodeResultCabalFile :: FilePath
, DecodeResult -> [[Char]]
decodeResultWarnings :: [String]
} deriving (DecodeResult -> DecodeResult -> Bool
(DecodeResult -> DecodeResult -> Bool)
-> (DecodeResult -> DecodeResult -> Bool) -> Eq DecodeResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecodeResult -> DecodeResult -> Bool
== :: DecodeResult -> DecodeResult -> Bool
$c/= :: DecodeResult -> DecodeResult -> Bool
/= :: DecodeResult -> DecodeResult -> Bool
Eq, Int -> DecodeResult -> ShowS
[DecodeResult] -> ShowS
DecodeResult -> [Char]
(Int -> DecodeResult -> ShowS)
-> (DecodeResult -> [Char])
-> ([DecodeResult] -> ShowS)
-> Show DecodeResult
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodeResult -> ShowS
showsPrec :: Int -> DecodeResult -> ShowS
$cshow :: DecodeResult -> [Char]
show :: DecodeResult -> [Char]
$cshowList :: [DecodeResult] -> ShowS
showList :: [DecodeResult] -> ShowS
Show)
readPackageConfig :: DecodeOptions -> IO (Either String DecodeResult)
readPackageConfig :: DecodeOptions -> IO (Either [Char] DecodeResult)
readPackageConfig DecodeOptions
options = (HpackError -> [Char])
-> Either HpackError DecodeResult -> Either [Char] DecodeResult
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ProgramName -> HpackError -> [Char]
formatHpackError (ProgramName -> HpackError -> [Char])
-> ProgramName -> HpackError -> [Char]
forall a b. (a -> b) -> a -> b
$ DecodeOptions -> ProgramName
decodeOptionsProgramName DecodeOptions
options) (Either HpackError DecodeResult -> Either [Char] DecodeResult)
-> IO (Either HpackError DecodeResult)
-> IO (Either [Char] DecodeResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeOptions -> IO (Either HpackError DecodeResult)
readPackageConfigWithError DecodeOptions
options
readPackageConfigWithError :: DecodeOptions -> IO (Either HpackError DecodeResult)
readPackageConfigWithError :: DecodeOptions -> IO (Either HpackError DecodeResult)
readPackageConfigWithError (DecodeOptions ProgramName
_ [Char]
file Maybe [Char]
mUserDataDir [Char] -> IO (Either [Char] ([[Char]], Value))
readValue FormatYamlParseError
formatYamlParseError) = ExceptT HpackError IO DecodeResult
-> IO (Either HpackError DecodeResult)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT HpackError IO DecodeResult
-> IO (Either HpackError DecodeResult))
-> ExceptT HpackError IO DecodeResult
-> IO (Either HpackError DecodeResult)
forall a b. (a -> b) -> a -> b
$ (((Package, [Char]), [[Char]]) -> DecodeResult)
-> ExceptT HpackError IO ((Package, [Char]), [[Char]])
-> ExceptT HpackError IO DecodeResult
forall a b.
(a -> b) -> ExceptT HpackError IO a -> ExceptT HpackError IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Package, [Char]), [[Char]]) -> DecodeResult
addCabalFile (ExceptT HpackError IO ((Package, [Char]), [[Char]])
-> ExceptT HpackError IO DecodeResult)
-> (WriterT [[Char]] (Errors IO) (Package, [Char])
-> ExceptT HpackError IO ((Package, [Char]), [[Char]]))
-> WriterT [[Char]] (Errors IO) (Package, [Char])
-> ExceptT HpackError IO DecodeResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [[Char]] (Errors IO) (Package, [Char])
-> ExceptT HpackError IO ((Package, [Char]), [[Char]])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [[Char]] (Errors IO) (Package, [Char])
-> ExceptT HpackError IO DecodeResult)
-> WriterT [[Char]] (Errors IO) (Package, [Char])
-> ExceptT HpackError IO DecodeResult
forall a b. (a -> b) -> a -> b
$ do
([[Char]]
warnings, Value
value) <- IO (Either HpackError ([[Char]], Value))
-> Warnings (Errors IO) ([[Char]], Value)
forall a. IO (Either HpackError a) -> Warnings (Errors IO) a
liftEither (IO (Either HpackError ([[Char]], Value))
-> Warnings (Errors IO) ([[Char]], Value))
-> IO (Either HpackError ([[Char]], Value))
-> Warnings (Errors IO) ([[Char]], Value)
forall a b. (a -> b) -> a -> b
$ ([Char] -> HpackError)
-> Either [Char] ([[Char]], Value)
-> Either HpackError ([[Char]], Value)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Char] -> HpackError
ParseError (Either [Char] ([[Char]], Value)
-> Either HpackError ([[Char]], Value))
-> IO (Either [Char] ([[Char]], Value))
-> IO (Either HpackError ([[Char]], Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Either [Char] ([[Char]], Value))
readValue [Char]
file
[[Char]] -> WriterT [[Char]] (Errors IO) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [[Char]]
warnings
ConfigWithDefaults
config <- [Char] -> Value -> Warnings (Errors IO) ConfigWithDefaults
forall a. FromValue a => [Char] -> Value -> Warnings (Errors IO) a
decodeValue [Char]
file Value
value
[Char]
dir <- IO [Char] -> WriterT [[Char]] (Errors IO) [Char]
forall a. IO a -> WriterT [[Char]] (Errors IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> WriterT [[Char]] (Errors IO) [Char])
-> IO [Char] -> WriterT [[Char]] (Errors IO) [Char]
forall a b. (a -> b) -> a -> b
$ ShowS
takeDirectory ShowS -> IO [Char] -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
canonicalizePath [Char]
file
[Char]
userDataDir <- IO [Char] -> WriterT [[Char]] (Errors IO) [Char]
forall a. IO a -> WriterT [[Char]] (Errors IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> WriterT [[Char]] (Errors IO) [Char])
-> IO [Char] -> WriterT [[Char]] (Errors IO) [Char]
forall a b. (a -> b) -> a -> b
$ IO [Char] -> ([Char] -> IO [Char]) -> Maybe [Char] -> IO [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> IO [Char]
getAppUserDataDirectory [Char]
"hpack") [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
mUserDataDir
FormatYamlParseError
-> [Char]
-> [Char]
-> ConfigWithDefaults
-> WriterT [[Char]] (Errors IO) (Package, [Char])
toPackage FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir ConfigWithDefaults
config
where
addCabalFile :: ((Package, String), [String]) -> DecodeResult
addCabalFile :: ((Package, [Char]), [[Char]]) -> DecodeResult
addCabalFile ((Package
pkg, [Char]
cabalVersion), [[Char]]
warnings) = Package -> [Char] -> [Char] -> [[Char]] -> DecodeResult
DecodeResult Package
pkg [Char]
cabalVersion (ShowS
takeDirectory_ [Char]
file [Char] -> ShowS
</> (Package -> [Char]
packageName Package
pkg [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".cabal")) [[Char]]
warnings
takeDirectory_ :: FilePath -> FilePath
takeDirectory_ :: ShowS
takeDirectory_ [Char]
p
| ShowS
takeFileName [Char]
p [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
p = [Char]
""
| Bool
otherwise = ShowS
takeDirectory [Char]
p
deleteVerbatimField :: String -> [Verbatim] -> [Verbatim]
deleteVerbatimField :: [Char] -> [Verbatim] -> [Verbatim]
deleteVerbatimField [Char]
name = (Verbatim -> Verbatim) -> [Verbatim] -> [Verbatim]
forall a b. (a -> b) -> [a] -> [b]
map ((Verbatim -> Verbatim) -> [Verbatim] -> [Verbatim])
-> (Verbatim -> Verbatim) -> [Verbatim] -> [Verbatim]
forall a b. (a -> b) -> a -> b
$ \ case
literal :: Verbatim
literal@VerbatimLiteral {} -> Verbatim
literal
VerbatimObject Map [Char] VerbatimValue
o -> Map [Char] VerbatimValue -> Verbatim
VerbatimObject ([Char] -> Map [Char] VerbatimValue -> Map [Char] VerbatimValue
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete [Char]
name Map [Char] VerbatimValue
o)
verbatimValueToString :: VerbatimValue -> String
verbatimValueToString :: VerbatimValue -> [Char]
verbatimValueToString = \ case
VerbatimString [Char]
s -> [Char]
s
VerbatimNumber Scientific
n -> Scientific -> [Char]
scientificToVersion Scientific
n
VerbatimBool Bool
b -> Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
b
VerbatimValue
VerbatimNull -> [Char]
""
addPathsModuleToGeneratedModules :: Package -> Version -> Package
addPathsModuleToGeneratedModules :: Package -> Version -> Package
addPathsModuleToGeneratedModules Package
pkg Version
cabalVersion
| Version
cabalVersion Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
makeVersion [Int
2] = Package
pkg
| Bool
otherwise = Package
pkg {
packageLibrary :: Maybe (Section Library)
packageLibrary = (Library -> Library) -> Section Library -> Section Library
forall a b. (a -> b) -> Section a -> Section b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Library -> Library
mapLibrary (Section Library -> Section Library)
-> Maybe (Section Library) -> Maybe (Section Library)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> Maybe (Section Library)
packageLibrary Package
pkg
, packageInternalLibraries :: Map [Char] (Section Library)
packageInternalLibraries = (Library -> Library) -> Section Library -> Section Library
forall a b. (a -> b) -> Section a -> Section b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Library -> Library
mapLibrary (Section Library -> Section Library)
-> Map [Char] (Section Library) -> Map [Char] (Section Library)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> Map [Char] (Section Library)
packageInternalLibraries Package
pkg
, packageExecutables :: Map [Char] (Section Executable)
packageExecutables = (Executable -> Executable)
-> Section Executable -> Section Executable
forall a b. (a -> b) -> Section a -> Section b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Executable -> Executable
mapExecutable (Section Executable -> Section Executable)
-> Map [Char] (Section Executable)
-> Map [Char] (Section Executable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> Map [Char] (Section Executable)
packageExecutables Package
pkg
, packageTests :: Map [Char] (Section Executable)
packageTests = (Executable -> Executable)
-> Section Executable -> Section Executable
forall a b. (a -> b) -> Section a -> Section b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Executable -> Executable
mapExecutable (Section Executable -> Section Executable)
-> Map [Char] (Section Executable)
-> Map [Char] (Section Executable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> Map [Char] (Section Executable)
packageTests Package
pkg
, packageBenchmarks :: Map [Char] (Section Executable)
packageBenchmarks = (Executable -> Executable)
-> Section Executable -> Section Executable
forall a b. (a -> b) -> Section a -> Section b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Executable -> Executable
mapExecutable (Section Executable -> Section Executable)
-> Map [Char] (Section Executable)
-> Map [Char] (Section Executable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> Map [Char] (Section Executable)
packageBenchmarks Package
pkg
}
where
pathsModule :: Module
pathsModule = [Char] -> Module
pathsModuleFromPackageName (Package -> [Char]
packageName Package
pkg)
mapLibrary :: Library -> Library
mapLibrary :: Library -> Library
mapLibrary Library
lib
| Module
pathsModule Module -> [Module] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Library -> [Module]
getLibraryModules Library
lib = Library
lib {
libraryGeneratedModules :: [Module]
libraryGeneratedModules = if Module
pathsModule Module -> [Module] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Module]
generatedModules then [Module]
generatedModules else Module
pathsModule Module -> [Module] -> [Module]
forall a. a -> [a] -> [a]
: [Module]
generatedModules
}
| Bool
otherwise = Library
lib
where
generatedModules :: [Module]
generatedModules = Library -> [Module]
libraryGeneratedModules Library
lib
mapExecutable :: Executable -> Executable
mapExecutable :: Executable -> Executable
mapExecutable Executable
executable
| Module
pathsModule Module -> [Module] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Executable -> [Module]
executableOtherModules Executable
executable = Executable
executable {
executableGeneratedModules :: [Module]
executableGeneratedModules = if Module
pathsModule Module -> [Module] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Module]
generatedModules then [Module]
generatedModules else Module
pathsModule Module -> [Module] -> [Module]
forall a. a -> [a] -> [a]
: [Module]
generatedModules
}
| Bool
otherwise = Executable
executable
where
generatedModules :: [Module]
generatedModules = Executable -> [Module]
executableGeneratedModules Executable
executable
determineCabalVersion :: Maybe (License SPDX.License) -> Package -> (Package, String, Maybe Version)
determineCabalVersion :: Maybe (License License)
-> Package -> (Package, [Char], Maybe Version)
determineCabalVersion Maybe (License License)
inferredLicense pkg :: Package
pkg@Package{[Char]
[[Char]]
[Path]
[Flag]
[Verbatim]
Maybe [Char]
Maybe SourceRepository
Maybe (Section Library)
Maybe CustomSetup
Map [Char] (Section Executable)
Map [Char] (Section Library)
BuildType
packageName :: Package -> [Char]
packageVersion :: Package -> [Char]
packageSynopsis :: Package -> Maybe [Char]
packageDescription :: Package -> Maybe [Char]
packageHomepage :: Package -> Maybe [Char]
packageBugReports :: Package -> Maybe [Char]
packageCategory :: Package -> Maybe [Char]
packageStability :: Package -> Maybe [Char]
packageAuthor :: Package -> [[Char]]
packageMaintainer :: Package -> [[Char]]
packageCopyright :: Package -> [[Char]]
packageBuildType :: Package -> BuildType
packageLicense :: Package -> Maybe [Char]
packageLicenseFile :: Package -> [[Char]]
packageTestedWith :: Package -> [[Char]]
packageFlags :: Package -> [Flag]
packageExtraSourceFiles :: Package -> [Path]
packageExtraDocFiles :: Package -> [Path]
packageDataFiles :: Package -> [Path]
packageDataDir :: Package -> Maybe [Char]
packageSourceRepository :: Package -> Maybe SourceRepository
packageCustomSetup :: Package -> Maybe CustomSetup
packageLibrary :: Package -> Maybe (Section Library)
packageInternalLibraries :: Package -> Map [Char] (Section Library)
packageExecutables :: Package -> Map [Char] (Section Executable)
packageTests :: Package -> Map [Char] (Section Executable)
packageBenchmarks :: Package -> Map [Char] (Section Executable)
packageVerbatim :: Package -> [Verbatim]
packageName :: [Char]
packageVersion :: [Char]
packageSynopsis :: Maybe [Char]
packageDescription :: Maybe [Char]
packageHomepage :: Maybe [Char]
packageBugReports :: Maybe [Char]
packageCategory :: Maybe [Char]
packageStability :: Maybe [Char]
packageAuthor :: [[Char]]
packageMaintainer :: [[Char]]
packageCopyright :: [[Char]]
packageBuildType :: BuildType
packageLicense :: Maybe [Char]
packageLicenseFile :: [[Char]]
packageTestedWith :: [[Char]]
packageFlags :: [Flag]
packageExtraSourceFiles :: [Path]
packageExtraDocFiles :: [Path]
packageDataFiles :: [Path]
packageDataDir :: Maybe [Char]
packageSourceRepository :: Maybe SourceRepository
packageCustomSetup :: Maybe CustomSetup
packageLibrary :: Maybe (Section Library)
packageInternalLibraries :: Map [Char] (Section Library)
packageExecutables :: Map [Char] (Section Executable)
packageTests :: Map [Char] (Section Executable)
packageBenchmarks :: Map [Char] (Section Executable)
packageVerbatim :: [Verbatim]
..} = (
Package
pkg {
packageVerbatim :: [Verbatim]
packageVerbatim = [Char] -> [Verbatim] -> [Verbatim]
deleteVerbatimField [Char]
"cabal-version" [Verbatim]
packageVerbatim
, packageLicense :: Maybe [Char]
packageLicense = License [Char] -> [Char]
formatLicense (License [Char] -> [Char])
-> Maybe (License [Char]) -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (License [Char])
license
}
, [Char]
"cabal-version: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
effectiveCabalVersion [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n\n"
, [Char] -> Maybe Version
parseVersion [Char]
effectiveCabalVersion
)
where
effectiveCabalVersion :: [Char]
effectiveCabalVersion = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
inferredCabalVersion Maybe [Char]
verbatimCabalVersion
license :: Maybe (License [Char])
license = (License -> [Char]) -> License License -> License [Char]
forall a b. (a -> b) -> License a -> License b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap License -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (License License -> License [Char])
-> Maybe (License License) -> Maybe (License [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (License License)
parsedLicense Maybe (License License)
-> Maybe (License License) -> Maybe (License License)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (License License)
inferredLicense)
parsedLicense :: Maybe (License License)
parsedLicense = [Char] -> License License
parseLicense ([Char] -> License License)
-> Maybe [Char] -> Maybe (License License)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
packageLicense
formatLicense :: License [Char] -> [Char]
formatLicense = \ case
MustSPDX [Char]
spdx -> [Char]
spdx
CanSPDX License
_ [Char]
spdx | Version
version Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
makeVersion [Int
2,Int
2] -> [Char]
spdx
CanSPDX License
cabal [Char]
_ -> License -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow License
cabal
DontTouch [Char]
original -> [Char]
original
mustSPDX :: Bool
mustSPDX :: Bool
mustSPDX = Bool -> (License [Char] -> Bool) -> Maybe (License [Char]) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False License [Char] -> Bool
forall {a}. License a -> Bool
f Maybe (License [Char])
license
where
f :: License a -> Bool
f = \case
DontTouch [Char]
_ -> Bool
False
CanSPDX License
_ a
_ -> Bool
False
MustSPDX a
_ -> Bool
True
verbatimCabalVersion :: Maybe String
verbatimCabalVersion :: Maybe [Char]
verbatimCabalVersion = [[Char]] -> Maybe [Char]
forall a. [a] -> Maybe a
listToMaybe ((Verbatim -> Maybe [Char]) -> [Verbatim] -> [[Char]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Verbatim -> Maybe [Char]
f [Verbatim]
packageVerbatim)
where
f :: Verbatim -> Maybe String
f :: Verbatim -> Maybe [Char]
f = \ case
VerbatimLiteral [Char]
_ -> Maybe [Char]
forall a. Maybe a
Nothing
VerbatimObject Map [Char] VerbatimValue
o -> case [Char] -> Map [Char] VerbatimValue -> Maybe VerbatimValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
"cabal-version" Map [Char] VerbatimValue
o of
Just VerbatimValue
v -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (VerbatimValue -> [Char]
verbatimValueToString VerbatimValue
v)
Maybe VerbatimValue
Nothing -> Maybe [Char]
forall a. Maybe a
Nothing
inferredCabalVersion :: String
inferredCabalVersion :: [Char]
inferredCabalVersion = Version -> [Char]
showVersion Version
version
version :: Version
version = Version -> Maybe Version -> Version
forall a. a -> Maybe a -> a
fromMaybe ([Int] -> Version
makeVersion [Int
1,Int
12]) (Maybe Version -> Version) -> Maybe Version -> Version
forall a b. (a -> b) -> a -> b
$ [Maybe Version] -> Maybe Version
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [
Maybe Version
packageCabalVersion
, Maybe (Section Library)
packageLibrary Maybe (Section Library)
-> (Section Library -> Maybe Version) -> Maybe Version
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Section Library -> Maybe Version
libraryCabalVersion
, Map [Char] (Section Library) -> Maybe Version
internalLibsCabalVersion Map [Char] (Section Library)
packageInternalLibraries
, Map [Char] (Section Executable) -> Maybe Version
executablesCabalVersion Map [Char] (Section Executable)
packageExecutables
, Map [Char] (Section Executable) -> Maybe Version
executablesCabalVersion Map [Char] (Section Executable)
packageTests
, Map [Char] (Section Executable) -> Maybe Version
executablesCabalVersion Map [Char] (Section Executable)
packageBenchmarks
]
packageCabalVersion :: Maybe Version
packageCabalVersion :: Maybe Version
packageCabalVersion = [Maybe Version] -> Maybe Version
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [
Maybe Version
forall a. Maybe a
Nothing
, [Int] -> Version
makeVersion [Int
2,Int
2] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
mustSPDX
, [Int] -> Version
makeVersion [Int
1,Int
24] Version -> Maybe CustomSetup -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe CustomSetup
packageCustomSetup
, [Int] -> Version
makeVersion [Int
1,Int
18] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not ([Path] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path]
packageExtraDocFiles))
]
libraryCabalVersion :: Section Library -> Maybe Version
libraryCabalVersion :: Section Library -> Maybe Version
libraryCabalVersion Section Library
sect = [Maybe Version] -> Maybe Version
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [
[Int] -> Version
makeVersion [Int
1,Int
22] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Library -> [[Char]]) -> Bool
forall {t :: * -> *} {a}. Foldable t => (Library -> t a) -> Bool
has Library -> [[Char]]
libraryReexportedModules)
, [Int] -> Version
makeVersion [Int
2,Int
0] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Library -> [[Char]]) -> Bool
forall {t :: * -> *} {a}. Foldable t => (Library -> t a) -> Bool
has Library -> [[Char]]
librarySignatures)
, [Int] -> Version
makeVersion [Int
2,Int
0] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Library -> [Module]) -> Bool
forall {t :: * -> *} {a}. Foldable t => (Library -> t a) -> Bool
has Library -> [Module]
libraryGeneratedModules)
, [Int] -> Version
makeVersion [Int
3,Int
0] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Library -> Maybe [Char]) -> Bool
forall {t :: * -> *} {a}. Foldable t => (Library -> t a) -> Bool
has Library -> Maybe [Char]
libraryVisibility)
, (Section Library -> [Module]) -> Section Library -> Maybe Version
forall a. (Section a -> [Module]) -> Section a -> Maybe Version
sectionCabalVersion ((Library -> [Module]) -> Section Library -> [Module]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Library -> [Module]
getLibraryModules) Section Library
sect
]
where
has :: (Library -> t a) -> Bool
has Library -> t a
field = (Library -> Bool) -> Section Library -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Library -> Bool) -> Library -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (t a -> Bool) -> (Library -> t a) -> Library -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> t a
field) Section Library
sect
internalLibsCabalVersion :: Map String (Section Library) -> Maybe Version
internalLibsCabalVersion :: Map [Char] (Section Library) -> Maybe Version
internalLibsCabalVersion Map [Char] (Section Library)
internalLibraries
| Map [Char] (Section Library) -> Bool
forall k a. Map k a -> Bool
Map.null Map [Char] (Section Library)
internalLibraries = Maybe Version
forall a. Maybe a
Nothing
| Bool
otherwise = (Maybe Version -> Maybe Version -> Maybe Version)
-> Maybe Version -> [Maybe Version] -> Maybe Version
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe Version -> Maybe Version -> Maybe Version
forall a. Ord a => a -> a -> a
max (Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Int] -> Version
makeVersion [Int
2,Int
0]) [Maybe Version]
versions
where
versions :: [Maybe Version]
versions = Section Library -> Maybe Version
libraryCabalVersion (Section Library -> Maybe Version)
-> [Section Library] -> [Maybe Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Char] (Section Library) -> [Section Library]
forall k a. Map k a -> [a]
Map.elems Map [Char] (Section Library)
internalLibraries
executablesCabalVersion :: Map String (Section Executable) -> Maybe Version
executablesCabalVersion :: Map [Char] (Section Executable) -> Maybe Version
executablesCabalVersion = (Maybe Version -> Maybe Version -> Maybe Version)
-> Maybe Version -> [Maybe Version] -> Maybe Version
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe Version -> Maybe Version -> Maybe Version
forall a. Ord a => a -> a -> a
max Maybe Version
forall a. Maybe a
Nothing ([Maybe Version] -> Maybe Version)
-> (Map [Char] (Section Executable) -> [Maybe Version])
-> Map [Char] (Section Executable)
-> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Section Executable -> Maybe Version)
-> [Section Executable] -> [Maybe Version]
forall a b. (a -> b) -> [a] -> [b]
map Section Executable -> Maybe Version
executableCabalVersion ([Section Executable] -> [Maybe Version])
-> (Map [Char] (Section Executable) -> [Section Executable])
-> Map [Char] (Section Executable)
-> [Maybe Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map [Char] (Section Executable) -> [Section Executable]
forall k a. Map k a -> [a]
Map.elems
executableCabalVersion :: Section Executable -> Maybe Version
executableCabalVersion :: Section Executable -> Maybe Version
executableCabalVersion Section Executable
sect = [Maybe Version] -> Maybe Version
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [
[Int] -> Version
makeVersion [Int
2,Int
0] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Section Executable -> Bool
executableHasGeneratedModules Section Executable
sect)
, (Section Executable -> [Module])
-> Section Executable -> Maybe Version
forall a. (Section a -> [Module]) -> Section a -> Maybe Version
sectionCabalVersion ((Executable -> [Module]) -> Section Executable -> [Module]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Executable -> [Module]
getExecutableModules) Section Executable
sect
]
executableHasGeneratedModules :: Section Executable -> Bool
executableHasGeneratedModules :: Section Executable -> Bool
executableHasGeneratedModules = (Executable -> Bool) -> Section Executable -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Executable -> Bool) -> Executable -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Module] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Module] -> Bool)
-> (Executable -> [Module]) -> Executable -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> [Module]
executableGeneratedModules)
sectionCabalVersion :: (Section a -> [Module]) -> Section a -> Maybe Version
sectionCabalVersion :: forall a. (Section a -> [Module]) -> Section a -> Maybe Version
sectionCabalVersion Section a -> [Module]
getMentionedModules Section a
sect = [Maybe Version] -> Maybe Version
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Maybe Version] -> Maybe Version)
-> [Maybe Version] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [
[Int] -> Version
makeVersion [Int
2,Int
2] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Section a -> Bool) -> Section a -> Bool
forall a. (Section a -> Bool) -> Section a -> Bool
sectionSatisfies (Bool -> Bool
not (Bool -> Bool) -> (Section a -> Bool) -> Section a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Path] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Path] -> Bool) -> (Section a -> [Path]) -> Section a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section a -> [Path]
forall a. Section a -> [Path]
sectionCxxSources) Section a
sect)
, [Int] -> Version
makeVersion [Int
2,Int
2] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Section a -> Bool) -> Section a -> Bool
forall a. (Section a -> Bool) -> Section a -> Bool
sectionSatisfies (Bool -> Bool
not (Bool -> Bool) -> (Section a -> Bool) -> Section a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[Char]] -> Bool) -> (Section a -> [[Char]]) -> Section a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section a -> [[Char]]
forall a. Section a -> [[Char]]
sectionCxxOptions) Section a
sect)
, [Int] -> Version
makeVersion [Int
2,Int
0] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Section a -> Bool) -> Section a -> Bool
forall a. (Section a -> Bool) -> Section a -> Bool
sectionSatisfies ((DependencyInfo -> Bool) -> Map [Char] DependencyInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any DependencyInfo -> Bool
hasMixins (Map [Char] DependencyInfo -> Bool)
-> (Section a -> Map [Char] DependencyInfo) -> Section a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> Map [Char] DependencyInfo
unDependencies (Dependencies -> Map [Char] DependencyInfo)
-> (Section a -> Dependencies)
-> Section a
-> Map [Char] DependencyInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section a -> Dependencies
forall a. Section a -> Dependencies
sectionDependencies) Section a
sect)
, [Int] -> Version
makeVersion [Int
3,Int
0] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ((Section a -> Bool) -> Section a -> Bool
forall a. (Section a -> Bool) -> Section a -> Bool
sectionSatisfies (([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [Char] -> Bool
hasSubcomponents ([[Char]] -> Bool) -> (Section a -> [[Char]]) -> Section a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map [Char] DependencyInfo -> [[Char]]
forall k a. Map k a -> [k]
Map.keys (Map [Char] DependencyInfo -> [[Char]])
-> (Section a -> Map [Char] DependencyInfo)
-> Section a
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> Map [Char] DependencyInfo
unDependencies (Dependencies -> Map [Char] DependencyInfo)
-> (Section a -> Dependencies)
-> Section a
-> Map [Char] DependencyInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section a -> Dependencies
forall a. Section a -> Dependencies
sectionDependencies) Section a
sect)
, [Int] -> Version
makeVersion [Int
2,Int
2] Version -> Maybe () -> Maybe Version
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (
[Char] -> Bool
uses [Char]
"RebindableSyntax"
Bool -> Bool -> Bool
&& ([Char] -> Bool
uses [Char]
"OverloadedStrings" Bool -> Bool -> Bool
|| [Char] -> Bool
uses [Char]
"OverloadedLists")
Bool -> Bool -> Bool
&& Module
pathsModule Module -> [Module] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Section a -> [Module]
getMentionedModules Section a
sect)
] [Maybe Version] -> [Maybe Version] -> [Maybe Version]
forall a. [a] -> [a] -> [a]
++ ([Char] -> Maybe Version) -> [[Char]] -> [Maybe Version]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Maybe Version
versionFromSystemBuildTool [[Char]]
systemBuildTools
where
defaultExtensions :: [[Char]]
defaultExtensions = (Section a -> [[Char]]) -> Section a -> [[Char]]
forall b a.
(Semigroup b, Monoid b) =>
(Section a -> b) -> Section a -> b
sectionAll Section a -> [[Char]]
forall a. Section a -> [[Char]]
sectionDefaultExtensions Section a
sect
uses :: [Char] -> Bool
uses = ([Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
defaultExtensions)
pathsModule :: Module
pathsModule = [Char] -> Module
pathsModuleFromPackageName [Char]
packageName
versionFromSystemBuildTool :: [Char] -> Maybe Version
versionFromSystemBuildTool [Char]
name
| [Char]
name [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
known_1_10 = Maybe Version
forall a. Maybe a
Nothing
| [Char]
name [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
known_1_14 = Version -> Maybe Version
forall a. a -> Maybe a
Just ([Int] -> Version
makeVersion [Int
1,Int
14])
| [Char]
name [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
known_1_22 = Version -> Maybe Version
forall a. a -> Maybe a
Just ([Int] -> Version
makeVersion [Int
1,Int
22])
| Bool
otherwise = Version -> Maybe Version
forall a. a -> Maybe a
Just ([Int] -> Version
makeVersion [Int
2,Int
0])
known_1_10 :: [[Char]]
known_1_10 = [
[Char]
"ghc"
, [Char]
"ghc-pkg"
, [Char]
"hugs"
, [Char]
"ffihugs"
, [Char]
"nhc98"
, [Char]
"hmake"
, [Char]
"jhc"
, [Char]
"lhc"
, [Char]
"lhc-pkg"
, [Char]
"uhc"
, [Char]
"gcc"
, [Char]
"ranlib"
, [Char]
"ar"
, [Char]
"strip"
, [Char]
"ld"
, [Char]
"tar"
, [Char]
"pkg-config"
] [[Char]] -> [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [a]
\\ [
[Char]
"hugs"
, [Char]
"ffihugs"
, [Char]
"nhc98"
, [Char]
"ranlib"
, [Char]
"lhc"
, [Char]
"lhc-pkg"
]
known_1_14 :: [[Char]]
known_1_14 = [
[Char]
"hpc"
]
known_1_22 :: [[Char]]
known_1_22 = [
[Char]
"ghcjs"
, [Char]
"ghcjs-pkg"
]
systemBuildTools :: [String]
systemBuildTools :: [[Char]]
systemBuildTools = Map [Char] VersionConstraint -> [[Char]]
forall k a. Map k a -> [k]
Map.keys (Map [Char] VersionConstraint -> [[Char]])
-> Map [Char] VersionConstraint -> [[Char]]
forall a b. (a -> b) -> a -> b
$ SystemBuildTools -> Map [Char] VersionConstraint
unSystemBuildTools (SystemBuildTools -> Map [Char] VersionConstraint)
-> SystemBuildTools -> Map [Char] VersionConstraint
forall a b. (a -> b) -> a -> b
$ (Section a -> SystemBuildTools) -> Section a -> SystemBuildTools
forall b a.
(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 :: forall a. (Section a -> Bool) -> Section a -> Bool
sectionSatisfies Section a -> Bool
p Section a
sect = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [
Section a -> Bool
p Section a
sect
, (Conditional (Section a) -> Bool)
-> [Conditional (Section a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Section a -> Bool) -> Conditional (Section a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Section a -> Bool) -> Section a -> Bool
forall a. (Section a -> Bool) -> Section a -> Bool
sectionSatisfies Section a -> Bool
p)) (Section a -> [Conditional (Section a)]
forall a. Section a -> [Conditional (Section a)]
sectionConditionals Section a
sect)
]
hasMixins :: DependencyInfo -> Bool
hasMixins :: DependencyInfo -> Bool
hasMixins (DependencyInfo [[Char]]
mixins DependencyVersion
_) = Bool -> Bool
not ([[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
mixins)
hasSubcomponents :: String -> Bool
hasSubcomponents :: [Char] -> Bool
hasSubcomponents = Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
':'
sectionAll :: (Semigroup b, Monoid b) => (Section a -> b) -> Section a -> b
sectionAll :: forall b a.
(Semigroup b, Monoid b) =>
(Section a -> b) -> Section a -> b
sectionAll Section a -> b
f Section a
sect = Section a -> b
f Section a
sect b -> b -> b
forall a. Semigroup a => a -> a -> a
<> (Conditional (Section a) -> b) -> [Conditional (Section a)] -> b
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Section a -> b) -> Conditional (Section a) -> b
forall m a. Monoid m => (a -> m) -> Conditional a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Section a -> b) -> Conditional (Section a) -> b)
-> (Section a -> b) -> Conditional (Section a) -> b
forall a b. (a -> b) -> a -> b
$ (Section a -> b) -> Section a -> b
forall b a.
(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 => FilePath -> Value -> Warnings (Errors IO) a
decodeValue :: forall a. FromValue a => [Char] -> Value -> Warnings (Errors IO) a
decodeValue [Char]
file Value
value = do
(CheckSpecVersion a
r, [[Char]]
unknown, [([Char], [Char])]
deprecated) <- IO
(Either
HpackError (CheckSpecVersion a, [[Char]], [([Char], [Char])]))
-> Warnings
(Errors IO) (CheckSpecVersion a, [[Char]], [([Char], [Char])])
forall a. IO (Either HpackError a) -> Warnings (Errors IO) a
liftEither (IO
(Either
HpackError (CheckSpecVersion a, [[Char]], [([Char], [Char])]))
-> Warnings
(Errors IO) (CheckSpecVersion a, [[Char]], [([Char], [Char])]))
-> (Either
HpackError (CheckSpecVersion a, [[Char]], [([Char], [Char])])
-> IO
(Either
HpackError (CheckSpecVersion a, [[Char]], [([Char], [Char])])))
-> Either
HpackError (CheckSpecVersion a, [[Char]], [([Char], [Char])])
-> Warnings
(Errors IO) (CheckSpecVersion a, [[Char]], [([Char], [Char])])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either
HpackError (CheckSpecVersion a, [[Char]], [([Char], [Char])])
-> IO
(Either
HpackError (CheckSpecVersion a, [[Char]], [([Char], [Char])]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
HpackError (CheckSpecVersion a, [[Char]], [([Char], [Char])])
-> Warnings
(Errors IO) (CheckSpecVersion a, [[Char]], [([Char], [Char])]))
-> Either
HpackError (CheckSpecVersion a, [[Char]], [([Char], [Char])])
-> Warnings
(Errors IO) (CheckSpecVersion a, [[Char]], [([Char], [Char])])
forall a b. (a -> b) -> a -> b
$ ([Char] -> HpackError)
-> Either [Char] (CheckSpecVersion a, [[Char]], [([Char], [Char])])
-> Either
HpackError (CheckSpecVersion a, [[Char]], [([Char], [Char])])
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Char] -> [Char] -> HpackError
DecodeValueError [Char]
file) (Value
-> Either [Char] (CheckSpecVersion a, [[Char]], [([Char], [Char])])
forall a. FromValue a => Value -> Result a
Config.decodeValue Value
value)
case CheckSpecVersion a
r of
UnsupportedSpecVersion Version
v -> do
Errors IO a -> Warnings (Errors IO) a
forall (m :: * -> *) a. Monad m => m a -> WriterT [[Char]] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Errors IO a -> Warnings (Errors IO) a)
-> (HpackError -> Errors IO a)
-> HpackError
-> Warnings (Errors IO) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HpackError -> Errors IO a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (HpackError -> Warnings (Errors IO) a)
-> HpackError -> Warnings (Errors IO) a
forall a b. (a -> b) -> a -> b
$ [Char] -> Version -> Version -> HpackError
HpackVersionNotSupported [Char]
file Version
v Version
Hpack.version
SupportedSpecVersion a
a -> do
[[Char]] -> WriterT [[Char]] (Errors IO) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
formatUnknownField [[Char]]
unknown)
[[Char]] -> WriterT [[Char]] (Errors IO) ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell ((([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
formatDeprecatedField [([Char], [Char])]
deprecated)
a -> Warnings (Errors IO) a
forall a. a -> WriterT [[Char]] (Errors IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
where
prefix :: [Char]
prefix = [Char]
file [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": "
formatUnknownField :: ShowS
formatUnknownField [Char]
name = [Char]
prefix [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"Ignoring unrecognized field " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
name
formatDeprecatedField :: ([Char], [Char]) -> [Char]
formatDeprecatedField ([Char]
name, [Char]
substitute) = [Char]
prefix [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
name [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" is deprecated, use " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
substitute [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" instead"
data 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 -> Key -> Parser (Maybe ParseSpecVersion)
forall a. FromValue a => Object -> Key -> Parser (Maybe a)
.:? Key
"spec-version" Parser (Maybe ParseSpecVersion)
-> (Maybe ParseSpecVersion -> Parser (CheckSpecVersion a))
-> Parser (CheckSpecVersion a)
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
Just (ParseSpecVersion Version
v) | Version
Hpack.version Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
v -> CheckSpecVersion a -> Parser (CheckSpecVersion a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (CheckSpecVersion a -> Parser (CheckSpecVersion a))
-> CheckSpecVersion a -> Parser (CheckSpecVersion a)
forall a b. (a -> b) -> a -> b
$ Version -> CheckSpecVersion a
forall a. Version -> CheckSpecVersion a
UnsupportedSpecVersion Version
v
Maybe ParseSpecVersion
_ -> 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
[Char]
s <- case Value
value of
Number Scientific
n -> [Char] -> Parser [Char]
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Scientific -> [Char]
scientificToVersion Scientific
n)
String Text
s -> [Char] -> Parser [Char]
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [Char]
T.unpack Text
s)
Value
_ -> [Char] -> Value -> Parser [Char]
forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
"Number or String" Value
value
case [Char] -> Maybe Version
parseVersion [Char]
s of
Just Version
v -> ParseSpecVersion -> Parser ParseSpecVersion
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Version -> ParseSpecVersion
ParseSpecVersion Version
v)
Maybe Version
Nothing -> [Char] -> Parser ParseSpecVersion
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"invalid value " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
s)
data Package = Package {
Package -> [Char]
packageName :: String
, Package -> [Char]
packageVersion :: String
, Package -> Maybe [Char]
packageSynopsis :: Maybe String
, Package -> Maybe [Char]
packageDescription :: Maybe String
, Package -> Maybe [Char]
packageHomepage :: Maybe String
, Package -> Maybe [Char]
packageBugReports :: Maybe String
, Package -> Maybe [Char]
packageCategory :: Maybe String
, Package -> Maybe [Char]
packageStability :: Maybe String
, Package -> [[Char]]
packageAuthor :: [String]
, Package -> [[Char]]
packageMaintainer :: [String]
, Package -> [[Char]]
packageCopyright :: [String]
, Package -> BuildType
packageBuildType :: BuildType
, Package -> Maybe [Char]
packageLicense :: Maybe String
, Package -> [[Char]]
packageLicenseFile :: [FilePath]
, Package -> [[Char]]
packageTestedWith :: [String]
, Package -> [Flag]
packageFlags :: [Flag]
, :: [Path]
, :: [Path]
, Package -> [Path]
packageDataFiles :: [Path]
, Package -> Maybe [Char]
packageDataDir :: Maybe FilePath
, Package -> Maybe SourceRepository
packageSourceRepository :: Maybe SourceRepository
, Package -> Maybe CustomSetup
packageCustomSetup :: Maybe CustomSetup
, Package -> Maybe (Section Library)
packageLibrary :: Maybe (Section Library)
, Package -> Map [Char] (Section Library)
packageInternalLibraries :: Map String (Section Library)
, Package -> Map [Char] (Section Executable)
packageExecutables :: Map String (Section Executable)
, Package -> Map [Char] (Section Executable)
packageTests :: Map String (Section Executable)
, Package -> Map [Char] (Section Executable)
packageBenchmarks :: Map String (Section Executable)
, Package -> [Verbatim]
packageVerbatim :: [Verbatim]
} deriving (Package -> Package -> Bool
(Package -> Package -> Bool)
-> (Package -> Package -> Bool) -> Eq Package
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Package -> Package -> Bool
== :: Package -> Package -> Bool
$c/= :: Package -> Package -> Bool
/= :: Package -> Package -> Bool
Eq, Int -> Package -> ShowS
[Package] -> ShowS
Package -> [Char]
(Int -> Package -> ShowS)
-> (Package -> [Char]) -> ([Package] -> ShowS) -> Show Package
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Package -> ShowS
showsPrec :: Int -> Package -> ShowS
$cshow :: Package -> [Char]
show :: Package -> [Char]
$cshowList :: [Package] -> ShowS
showList :: [Package] -> ShowS
Show)
data CustomSetup = CustomSetup {
CustomSetup -> Dependencies
customSetupDependencies :: Dependencies
} deriving (CustomSetup -> CustomSetup -> Bool
(CustomSetup -> CustomSetup -> Bool)
-> (CustomSetup -> CustomSetup -> Bool) -> Eq CustomSetup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomSetup -> CustomSetup -> Bool
== :: CustomSetup -> CustomSetup -> Bool
$c/= :: CustomSetup -> CustomSetup -> Bool
/= :: CustomSetup -> CustomSetup -> Bool
Eq, Int -> CustomSetup -> ShowS
[CustomSetup] -> ShowS
CustomSetup -> [Char]
(Int -> CustomSetup -> ShowS)
-> (CustomSetup -> [Char])
-> ([CustomSetup] -> ShowS)
-> Show CustomSetup
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomSetup -> ShowS
showsPrec :: Int -> CustomSetup -> ShowS
$cshow :: CustomSetup -> [Char]
show :: CustomSetup -> [Char]
$cshowList :: [CustomSetup] -> ShowS
showList :: [CustomSetup] -> ShowS
Show)
data Library = Library {
Library -> Maybe Bool
libraryExposed :: Maybe Bool
, Library -> Maybe [Char]
libraryVisibility :: Maybe String
, Library -> [Module]
libraryExposedModules :: [Module]
, Library -> [Module]
libraryOtherModules :: [Module]
, Library -> [Module]
libraryGeneratedModules :: [Module]
, Library -> [[Char]]
libraryReexportedModules :: [String]
, Library -> [[Char]]
librarySignatures :: [String]
} deriving (Library -> Library -> Bool
(Library -> Library -> Bool)
-> (Library -> Library -> Bool) -> Eq Library
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Library -> Library -> Bool
== :: Library -> Library -> Bool
$c/= :: Library -> Library -> Bool
/= :: Library -> Library -> Bool
Eq, Int -> Library -> ShowS
[Library] -> ShowS
Library -> [Char]
(Int -> Library -> ShowS)
-> (Library -> [Char]) -> ([Library] -> ShowS) -> Show Library
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Library -> ShowS
showsPrec :: Int -> Library -> ShowS
$cshow :: Library -> [Char]
show :: Library -> [Char]
$cshowList :: [Library] -> ShowS
showList :: [Library] -> ShowS
Show)
data Executable = Executable {
Executable -> Maybe [Char]
executableMain :: Maybe FilePath
, Executable -> [Module]
executableOtherModules :: [Module]
, Executable -> [Module]
executableGeneratedModules :: [Module]
} deriving (Executable -> Executable -> Bool
(Executable -> Executable -> Bool)
-> (Executable -> Executable -> Bool) -> Eq Executable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Executable -> Executable -> Bool
== :: Executable -> Executable -> Bool
$c/= :: Executable -> Executable -> Bool
/= :: Executable -> Executable -> Bool
Eq, Int -> Executable -> ShowS
[Executable] -> ShowS
Executable -> [Char]
(Int -> Executable -> ShowS)
-> (Executable -> [Char])
-> ([Executable] -> ShowS)
-> Show Executable
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Executable -> ShowS
showsPrec :: Int -> Executable -> ShowS
$cshow :: Executable -> [Char]
show :: Executable -> [Char]
$cshowList :: [Executable] -> ShowS
showList :: [Executable] -> ShowS
Show)
data BuildTool = BuildTool String String | LocalBuildTool String
deriving (Int -> BuildTool -> ShowS
[BuildTool] -> ShowS
BuildTool -> [Char]
(Int -> BuildTool -> ShowS)
-> (BuildTool -> [Char])
-> ([BuildTool] -> ShowS)
-> Show BuildTool
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildTool -> ShowS
showsPrec :: Int -> BuildTool -> ShowS
$cshow :: BuildTool -> [Char]
show :: BuildTool -> [Char]
$cshowList :: [BuildTool] -> ShowS
showList :: [BuildTool] -> ShowS
Show, BuildTool -> BuildTool -> Bool
(BuildTool -> BuildTool -> Bool)
-> (BuildTool -> BuildTool -> Bool) -> Eq BuildTool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildTool -> BuildTool -> Bool
== :: BuildTool -> BuildTool -> Bool
$c/= :: BuildTool -> BuildTool -> Bool
/= :: BuildTool -> BuildTool -> Bool
Eq, Eq BuildTool
Eq BuildTool
-> (BuildTool -> BuildTool -> Ordering)
-> (BuildTool -> BuildTool -> Bool)
-> (BuildTool -> BuildTool -> Bool)
-> (BuildTool -> BuildTool -> Bool)
-> (BuildTool -> BuildTool -> Bool)
-> (BuildTool -> BuildTool -> BuildTool)
-> (BuildTool -> BuildTool -> BuildTool)
-> Ord BuildTool
BuildTool -> BuildTool -> Bool
BuildTool -> BuildTool -> Ordering
BuildTool -> BuildTool -> BuildTool
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BuildTool -> BuildTool -> Ordering
compare :: BuildTool -> BuildTool -> Ordering
$c< :: BuildTool -> BuildTool -> Bool
< :: BuildTool -> BuildTool -> Bool
$c<= :: BuildTool -> BuildTool -> Bool
<= :: BuildTool -> BuildTool -> Bool
$c> :: BuildTool -> BuildTool -> Bool
> :: BuildTool -> BuildTool -> Bool
$c>= :: BuildTool -> BuildTool -> Bool
>= :: BuildTool -> BuildTool -> Bool
$cmax :: BuildTool -> BuildTool -> BuildTool
max :: BuildTool -> BuildTool -> BuildTool
$cmin :: BuildTool -> BuildTool -> BuildTool
min :: BuildTool -> BuildTool -> BuildTool
Ord)
data Section a = Section {
forall a. Section a -> a
sectionData :: a
, forall a. Section a -> [[Char]]
sectionSourceDirs :: [FilePath]
, forall a. Section a -> Dependencies
sectionDependencies :: Dependencies
, forall a. Section a -> [[Char]]
sectionPkgConfigDependencies :: [String]
, forall a. Section a -> [[Char]]
sectionDefaultExtensions :: [String]
, forall a. Section a -> [[Char]]
sectionOtherExtensions :: [String]
, forall a. Section a -> Maybe Language
sectionLanguage :: Maybe Language
, forall a. Section a -> [[Char]]
sectionGhcOptions :: [GhcOption]
, forall a. Section a -> [[Char]]
sectionGhcProfOptions :: [GhcProfOption]
, forall a. Section a -> [[Char]]
sectionGhcSharedOptions :: [GhcOption]
, forall a. Section a -> [[Char]]
sectionGhcjsOptions :: [GhcjsOption]
, forall a. Section a -> [[Char]]
sectionCppOptions :: [CppOption]
, forall a. Section a -> [[Char]]
sectionCcOptions :: [CcOption]
, forall a. Section a -> [Path]
sectionCSources :: [Path]
, forall a. Section a -> [[Char]]
sectionCxxOptions :: [CxxOption]
, forall a. Section a -> [Path]
sectionCxxSources :: [Path]
, forall a. Section a -> [Path]
sectionJsSources :: [Path]
, :: [FilePath]
, :: [FilePath]
, :: [FilePath]
, forall a. Section a -> [[Char]]
sectionFrameworks :: [FilePath]
, forall a. Section a -> [[Char]]
sectionIncludeDirs :: [FilePath]
, forall a. Section a -> [[Char]]
sectionInstallIncludes :: [FilePath]
, forall a. Section a -> [[Char]]
sectionLdOptions :: [LdOption]
, forall a. Section a -> Maybe Bool
sectionBuildable :: Maybe Bool
, forall a. Section a -> [Conditional (Section a)]
sectionConditionals :: [Conditional (Section a)]
, forall a. Section a -> Map BuildTool DependencyVersion
sectionBuildTools :: Map BuildTool DependencyVersion
, forall a. Section a -> SystemBuildTools
sectionSystemBuildTools :: SystemBuildTools
, forall a. Section a -> [Verbatim]
sectionVerbatim :: [Verbatim]
} deriving (Section a -> Section a -> Bool
(Section a -> Section a -> Bool)
-> (Section a -> Section a -> Bool) -> Eq (Section a)
forall a. Eq a => Section a -> Section a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Section a -> Section a -> Bool
== :: Section a -> Section a -> Bool
$c/= :: forall a. Eq a => Section a -> Section a -> Bool
/= :: Section a -> Section a -> Bool
Eq, Int -> Section a -> ShowS
[Section a] -> ShowS
Section a -> [Char]
(Int -> Section a -> ShowS)
-> (Section a -> [Char])
-> ([Section a] -> ShowS)
-> Show (Section a)
forall a. Show a => Int -> Section a -> ShowS
forall a. Show a => [Section a] -> ShowS
forall a. Show a => Section a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Section a -> ShowS
showsPrec :: Int -> Section a -> ShowS
$cshow :: forall a. Show a => Section a -> [Char]
show :: Section a -> [Char]
$cshowList :: forall a. Show a => [Section a] -> ShowS
showList :: [Section a] -> ShowS
Show, (forall a b. (a -> b) -> Section a -> Section b)
-> (forall a b. a -> Section b -> Section a) -> Functor Section
forall a b. a -> Section b -> Section a
forall a b. (a -> b) -> Section a -> Section b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Section a -> Section b
fmap :: forall a b. (a -> b) -> Section a -> Section b
$c<$ :: forall a b. a -> Section b -> Section a
<$ :: forall a b. a -> Section b -> Section a
Functor, (forall m. Monoid m => Section m -> m)
-> (forall m a. Monoid m => (a -> m) -> Section a -> m)
-> (forall m a. Monoid m => (a -> m) -> Section a -> m)
-> (forall a b. (a -> b -> b) -> b -> Section a -> b)
-> (forall a b. (a -> b -> b) -> b -> Section a -> b)
-> (forall b a. (b -> a -> b) -> b -> Section a -> b)
-> (forall b a. (b -> a -> b) -> b -> Section a -> b)
-> (forall a. (a -> a -> a) -> Section a -> a)
-> (forall a. (a -> a -> a) -> Section a -> a)
-> (forall a. Section a -> [a])
-> (forall a. Section a -> Bool)
-> (forall a. Section a -> Int)
-> (forall a. Eq a => a -> Section a -> Bool)
-> (forall a. Ord a => Section a -> a)
-> (forall a. Ord a => Section a -> a)
-> (forall a. Num a => Section a -> a)
-> (forall a. Num a => Section a -> a)
-> Foldable Section
forall a. Eq a => a -> Section a -> Bool
forall a. Num a => Section a -> a
forall a. Ord a => Section a -> a
forall m. Monoid m => Section m -> m
forall a. Section a -> Bool
forall a. Section a -> Int
forall a. Section a -> [a]
forall a. (a -> a -> a) -> Section a -> a
forall m a. Monoid m => (a -> m) -> Section a -> m
forall b a. (b -> a -> b) -> b -> Section a -> b
forall a b. (a -> b -> b) -> b -> Section a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Section m -> m
fold :: forall m. Monoid m => Section m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Section a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Section a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Section a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Section a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Section a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Section a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Section a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Section a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Section a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Section a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Section a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Section a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Section a -> a
foldr1 :: forall a. (a -> a -> a) -> Section a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Section a -> a
foldl1 :: forall a. (a -> a -> a) -> Section a -> a
$ctoList :: forall a. Section a -> [a]
toList :: forall a. Section a -> [a]
$cnull :: forall a. Section a -> Bool
null :: forall a. Section a -> Bool
$clength :: forall a. Section a -> Int
length :: forall a. Section a -> Int
$celem :: forall a. Eq a => a -> Section a -> Bool
elem :: forall a. Eq a => a -> Section a -> Bool
$cmaximum :: forall a. Ord a => Section a -> a
maximum :: forall a. Ord a => Section a -> a
$cminimum :: forall a. Ord a => Section a -> a
minimum :: forall a. Ord a => Section a -> a
$csum :: forall a. Num a => Section a -> a
sum :: forall a. Num a => Section a -> a
$cproduct :: forall a. Num a => Section a -> a
product :: forall a. Num a => Section a -> a
Foldable, Functor Section
Foldable Section
Functor Section
-> Foldable Section
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Section a -> f (Section b))
-> (forall (f :: * -> *) a.
Applicative f =>
Section (f a) -> f (Section a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Section a -> m (Section b))
-> (forall (m :: * -> *) a.
Monad m =>
Section (m a) -> m (Section a))
-> Traversable Section
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Section (m a) -> m (Section a)
forall (f :: * -> *) a.
Applicative f =>
Section (f a) -> f (Section a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Section a -> m (Section b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Section a -> f (Section b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Section a -> f (Section b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Section a -> f (Section b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Section (f a) -> f (Section a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Section (f a) -> f (Section a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Section a -> m (Section b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Section a -> m (Section b)
$csequence :: forall (m :: * -> *) a. Monad m => Section (m a) -> m (Section a)
sequence :: forall (m :: * -> *) a. Monad m => Section (m a) -> m (Section a)
Traversable)
data Conditional a = Conditional {
forall a. Conditional a -> Cond
conditionalCondition :: Cond
, forall a. Conditional a -> a
conditionalThen :: a
, forall a. Conditional a -> Maybe a
conditionalElse :: Maybe a
} deriving (Conditional a -> Conditional a -> Bool
(Conditional a -> Conditional a -> Bool)
-> (Conditional a -> Conditional a -> Bool) -> Eq (Conditional a)
forall a. Eq a => Conditional a -> Conditional a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Conditional a -> Conditional a -> Bool
== :: Conditional a -> Conditional a -> Bool
$c/= :: forall a. Eq a => Conditional a -> Conditional a -> Bool
/= :: Conditional a -> Conditional a -> Bool
Eq, Int -> Conditional a -> ShowS
[Conditional a] -> ShowS
Conditional a -> [Char]
(Int -> Conditional a -> ShowS)
-> (Conditional a -> [Char])
-> ([Conditional a] -> ShowS)
-> Show (Conditional a)
forall a. Show a => Int -> Conditional a -> ShowS
forall a. Show a => [Conditional a] -> ShowS
forall a. Show a => Conditional a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Conditional a -> ShowS
showsPrec :: Int -> Conditional a -> ShowS
$cshow :: forall a. Show a => Conditional a -> [Char]
show :: Conditional a -> [Char]
$cshowList :: forall a. Show a => [Conditional a] -> ShowS
showList :: [Conditional a] -> ShowS
Show, (forall a b. (a -> b) -> Conditional a -> Conditional b)
-> (forall a b. a -> Conditional b -> Conditional a)
-> Functor Conditional
forall a b. a -> Conditional b -> Conditional a
forall a b. (a -> b) -> Conditional a -> Conditional b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Conditional a -> Conditional b
fmap :: forall a b. (a -> b) -> Conditional a -> Conditional b
$c<$ :: forall a b. a -> Conditional b -> Conditional a
<$ :: forall a b. a -> Conditional b -> Conditional a
Functor, (forall m. Monoid m => Conditional m -> m)
-> (forall m a. Monoid m => (a -> m) -> Conditional a -> m)
-> (forall m a. Monoid m => (a -> m) -> Conditional a -> m)
-> (forall a b. (a -> b -> b) -> b -> Conditional a -> b)
-> (forall a b. (a -> b -> b) -> b -> Conditional a -> b)
-> (forall b a. (b -> a -> b) -> b -> Conditional a -> b)
-> (forall b a. (b -> a -> b) -> b -> Conditional a -> b)
-> (forall a. (a -> a -> a) -> Conditional a -> a)
-> (forall a. (a -> a -> a) -> Conditional a -> a)
-> (forall a. Conditional a -> [a])
-> (forall a. Conditional a -> Bool)
-> (forall a. Conditional a -> Int)
-> (forall a. Eq a => a -> Conditional a -> Bool)
-> (forall a. Ord a => Conditional a -> a)
-> (forall a. Ord a => Conditional a -> a)
-> (forall a. Num a => Conditional a -> a)
-> (forall a. Num a => Conditional a -> a)
-> Foldable Conditional
forall a. Eq a => a -> Conditional a -> Bool
forall a. Num a => Conditional a -> a
forall a. Ord a => Conditional a -> a
forall m. Monoid m => Conditional m -> m
forall a. Conditional a -> Bool
forall a. Conditional a -> Int
forall a. Conditional a -> [a]
forall a. (a -> a -> a) -> Conditional a -> a
forall m a. Monoid m => (a -> m) -> Conditional a -> m
forall b a. (b -> a -> b) -> b -> Conditional a -> b
forall a b. (a -> b -> b) -> b -> Conditional a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Conditional m -> m
fold :: forall m. Monoid m => Conditional m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Conditional a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Conditional a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Conditional a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Conditional a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Conditional a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Conditional a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Conditional a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Conditional a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Conditional a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Conditional a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Conditional a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Conditional a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Conditional a -> a
foldr1 :: forall a. (a -> a -> a) -> Conditional a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Conditional a -> a
foldl1 :: forall a. (a -> a -> a) -> Conditional a -> a
$ctoList :: forall a. Conditional a -> [a]
toList :: forall a. Conditional a -> [a]
$cnull :: forall a. Conditional a -> Bool
null :: forall a. Conditional a -> Bool
$clength :: forall a. Conditional a -> Int
length :: forall a. Conditional a -> Int
$celem :: forall a. Eq a => a -> Conditional a -> Bool
elem :: forall a. Eq a => a -> Conditional a -> Bool
$cmaximum :: forall a. Ord a => Conditional a -> a
maximum :: forall a. Ord a => Conditional a -> a
$cminimum :: forall a. Ord a => Conditional a -> a
minimum :: forall a. Ord a => Conditional a -> a
$csum :: forall a. Num a => Conditional a -> a
sum :: forall a. Num a => Conditional a -> a
$cproduct :: forall a. Num a => Conditional a -> a
product :: forall a. Num a => Conditional a -> a
Foldable, Functor Conditional
Foldable Conditional
Functor Conditional
-> Foldable Conditional
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Conditional a -> f (Conditional b))
-> (forall (f :: * -> *) a.
Applicative f =>
Conditional (f a) -> f (Conditional a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Conditional a -> m (Conditional b))
-> (forall (m :: * -> *) a.
Monad m =>
Conditional (m a) -> m (Conditional a))
-> Traversable Conditional
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Conditional (m a) -> m (Conditional a)
forall (f :: * -> *) a.
Applicative f =>
Conditional (f a) -> f (Conditional a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Conditional a -> m (Conditional b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Conditional a -> f (Conditional b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Conditional a -> f (Conditional b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Conditional a -> f (Conditional b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Conditional (f a) -> f (Conditional a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Conditional (f a) -> f (Conditional a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Conditional a -> m (Conditional b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Conditional a -> m (Conditional b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Conditional (m a) -> m (Conditional a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Conditional (m a) -> m (Conditional a)
Traversable)
data FlagSection = FlagSection {
FlagSection -> Maybe [Char]
_flagSectionDescription :: Maybe String
, FlagSection -> Bool
_flagSectionManual :: Bool
, FlagSection -> Bool
_flagSectionDefault :: Bool
} deriving (FlagSection -> FlagSection -> Bool
(FlagSection -> FlagSection -> Bool)
-> (FlagSection -> FlagSection -> Bool) -> Eq FlagSection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FlagSection -> FlagSection -> Bool
== :: FlagSection -> FlagSection -> Bool
$c/= :: FlagSection -> FlagSection -> Bool
/= :: FlagSection -> FlagSection -> Bool
Eq, Int -> FlagSection -> ShowS
[FlagSection] -> ShowS
FlagSection -> [Char]
(Int -> FlagSection -> ShowS)
-> (FlagSection -> [Char])
-> ([FlagSection] -> ShowS)
-> Show FlagSection
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FlagSection -> ShowS
showsPrec :: Int -> FlagSection -> ShowS
$cshow :: FlagSection -> [Char]
show :: FlagSection -> [Char]
$cshowList :: [FlagSection] -> ShowS
showList :: [FlagSection] -> ShowS
Show, (forall x. FlagSection -> Rep FlagSection x)
-> (forall x. Rep FlagSection x -> FlagSection)
-> Generic FlagSection
forall x. Rep FlagSection x -> FlagSection
forall x. FlagSection -> Rep FlagSection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FlagSection -> Rep FlagSection x
from :: forall x. FlagSection -> Rep FlagSection x
$cto :: forall x. Rep FlagSection x -> FlagSection
to :: forall x. Rep FlagSection x -> FlagSection
Generic, Value -> Parser FlagSection
(Value -> Parser FlagSection) -> FromValue FlagSection
forall a. (Value -> Parser a) -> FromValue a
$cfromValue :: Value -> Parser FlagSection
fromValue :: Value -> Parser FlagSection
FromValue)
data Flag = Flag {
Flag -> [Char]
flagName :: String
, Flag -> Maybe [Char]
flagDescription :: Maybe String
, Flag -> Bool
flagManual :: Bool
, Flag -> Bool
flagDefault :: Bool
} deriving (Flag -> Flag -> Bool
(Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> Eq Flag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
/= :: Flag -> Flag -> Bool
Eq, Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> [Char]
(Int -> Flag -> ShowS)
-> (Flag -> [Char]) -> ([Flag] -> ShowS) -> Show Flag
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Flag -> ShowS
showsPrec :: Int -> Flag -> ShowS
$cshow :: Flag -> [Char]
show :: Flag -> [Char]
$cshowList :: [Flag] -> ShowS
showList :: [Flag] -> ShowS
Show)
toFlag :: (String, FlagSection) -> Flag
toFlag :: ([Char], FlagSection) -> Flag
toFlag ([Char]
name, FlagSection Maybe [Char]
description Bool
manual Bool
def) = [Char] -> Maybe [Char] -> Bool -> Bool -> Flag
Flag [Char]
name Maybe [Char]
description Bool
manual Bool
def
data SourceRepository = SourceRepository {
SourceRepository -> [Char]
sourceRepositoryUrl :: String
, SourceRepository -> Maybe [Char]
sourceRepositorySubdir :: Maybe String
} deriving (SourceRepository -> SourceRepository -> Bool
(SourceRepository -> SourceRepository -> Bool)
-> (SourceRepository -> SourceRepository -> Bool)
-> Eq SourceRepository
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceRepository -> SourceRepository -> Bool
== :: SourceRepository -> SourceRepository -> Bool
$c/= :: SourceRepository -> SourceRepository -> Bool
/= :: SourceRepository -> SourceRepository -> Bool
Eq, Int -> SourceRepository -> ShowS
[SourceRepository] -> ShowS
SourceRepository -> [Char]
(Int -> SourceRepository -> ShowS)
-> (SourceRepository -> [Char])
-> ([SourceRepository] -> ShowS)
-> Show SourceRepository
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceRepository -> ShowS
showsPrec :: Int -> SourceRepository -> ShowS
$cshow :: SourceRepository -> [Char]
show :: SourceRepository -> [Char]
$cshowList :: [SourceRepository] -> ShowS
showList :: [SourceRepository] -> ShowS
Show)
type Config cSources cxxSources jsSources =
Product (CommonOptions cSources cxxSources jsSources Empty) (PackageConfig cSources cxxSources jsSources)
traverseConfig :: Traversal Config
traverseConfig :: Traversal Config
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_))
-> Product
(CommonOptions cSources cxxSources jsSources Empty)
(PackageConfig cSources cxxSources jsSources)
-> m (Product
(CommonOptions cSources_ cxxSources_ jsSources_ Empty)
(PackageConfig cSources_ cxxSources_ jsSources_))
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Product a b -> f (Product c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Traverse
m 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 :: FormatYamlParseError -> FilePath -> FilePath -> ConfigWithDefaults -> Warnings (Errors IO) (Package, String)
toPackage :: FormatYamlParseError
-> [Char]
-> [Char]
-> ConfigWithDefaults
-> WriterT [[Char]] (Errors IO) (Package, [Char])
toPackage FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir =
FormatYamlParseError
-> [Char]
-> [Char]
-> ConfigWithDefaults
-> Warnings
(Errors IO) (Config ParseCSources ParseCSources ParseCSources)
expandDefaultsInConfig FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir
(ConfigWithDefaults
-> Warnings
(Errors IO) (Config ParseCSources ParseCSources ParseCSources))
-> (Config ParseCSources ParseCSources ParseCSources
-> WriterT [[Char]] (Errors IO) (Package, [Char]))
-> ConfigWithDefaults
-> WriterT [[Char]] (Errors IO) (Package, [Char])
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Language
-> Config ParseCSources ParseCSources ParseCSources
-> Config ParseCSources ParseCSources ParseCSources
forall {p :: * -> * -> *} {cSources} {cxxSources} {jsSources} {a}
{c}.
(Bifunctor p, Monoid cSources, Monoid cxxSources,
Monoid jsSources) =>
Language
-> p (CommonOptions cSources cxxSources jsSources a) c
-> p (CommonOptions cSources cxxSources jsSources a) c
setDefaultLanguage Language
"Haskell2010"
(Config ParseCSources ParseCSources ParseCSources
-> Config ParseCSources ParseCSources ParseCSources)
-> (Config ParseCSources ParseCSources ParseCSources
-> WriterT [[Char]] (Errors IO) (Package, [Char]))
-> Config ParseCSources ParseCSources ParseCSources
-> WriterT [[Char]] (Errors IO) (Package, [Char])
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Traverse
(WriterT [[Char]] (Errors IO))
ParseCSources
[Path]
ParseCSources
[Path]
ParseCSources
[Path]
-> Config ParseCSources ParseCSources ParseCSources
-> Warnings (Errors IO) (Config [Path] [Path] [Path])
Traversal Config
traverseConfig ([Char]
-> Traverse
(WriterT [[Char]] (Errors IO))
ParseCSources
[Path]
ParseCSources
[Path]
ParseCSources
[Path]
forall (m :: * -> *).
MonadIO m =>
[Char]
-> Traverse
(Warnings m)
ParseCSources
[Path]
ParseCSources
[Path]
ParseCSources
[Path]
expandForeignSources [Char]
dir)
(Config ParseCSources ParseCSources ParseCSources
-> Warnings (Errors IO) (Config [Path] [Path] [Path]))
-> (Config [Path] [Path] [Path]
-> WriterT [[Char]] (Errors IO) (Package, [Char]))
-> Config ParseCSources ParseCSources ParseCSources
-> WriterT [[Char]] (Errors IO) (Package, [Char])
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [Char]
-> Config [Path] [Path] [Path]
-> WriterT [[Char]] (Errors IO) (Package, [Char])
forall (m :: * -> *).
MonadIO m =>
[Char]
-> Config [Path] [Path] [Path] -> Warnings m (Package, [Char])
toPackage_ [Char]
dir
where
setDefaultLanguage :: Language
-> p (CommonOptions cSources cxxSources jsSources a) c
-> p (CommonOptions cSources cxxSources jsSources a) c
setDefaultLanguage Language
language p (CommonOptions cSources cxxSources jsSources a) c
config = (CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources a)
-> p (CommonOptions cSources cxxSources jsSources a) c
-> p (CommonOptions cSources cxxSources jsSources a) c
forall a b c. (a -> b) -> p a c -> p b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources a
forall {a}.
CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources a
setLanguage p (CommonOptions cSources cxxSources jsSources a) c
config
where
setLanguage :: CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources a
setLanguage = (CommonOptions cSources cxxSources jsSources a
forall a. Monoid a => a
mempty { commonOptionsLanguage :: Alias 'True "default-language" (Last (Maybe Language))
commonOptionsLanguage = Last (Maybe Language)
-> Alias 'True "default-language" (Last (Maybe Language))
forall (deprecated :: Bool) (alias :: Symbol) a.
a -> Alias deprecated alias a
Alias (Last (Maybe Language)
-> Alias 'True "default-language" (Last (Maybe Language)))
-> (Maybe (Maybe Language) -> Last (Maybe Language))
-> Maybe (Maybe Language)
-> Alias 'True "default-language" (Last (Maybe Language))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Maybe Language) -> Last (Maybe Language)
forall a. Maybe a -> Last a
Last (Maybe (Maybe Language)
-> Alias 'True "default-language" (Last (Maybe Language)))
-> Maybe (Maybe Language)
-> Alias 'True "default-language" (Last (Maybe Language))
forall a b. (a -> b) -> a -> b
$ Maybe Language -> Maybe (Maybe Language)
forall a. a -> Maybe a
Just (Language -> Maybe Language
forall a. a -> Maybe a
Just Language
language) } CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources a
-> CommonOptions cSources cxxSources jsSources a
forall a. Semigroup a => a -> a -> a
<>)
expandDefaultsInConfig
:: FormatYamlParseError
-> FilePath
-> FilePath
-> ConfigWithDefaults
-> Warnings (Errors IO) (Config ParseCSources ParseCxxSources ParseJsSources)
expandDefaultsInConfig :: FormatYamlParseError
-> [Char]
-> [Char]
-> ConfigWithDefaults
-> Warnings
(Errors IO) (Config ParseCSources ParseCSources ParseCSources)
expandDefaultsInConfig FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir = (Product
DefaultsConfig
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
-> WriterT
[[Char]]
(Errors IO)
(CommonOptions ParseCSources ParseCSources ParseCSources Empty))
-> (PackageConfig_
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection)
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection)
-> WriterT
[[Char]]
(Errors IO)
(PackageConfig ParseCSources ParseCSources ParseCSources))
-> ConfigWithDefaults
-> Warnings
(Errors IO) (Config ParseCSources ParseCSources ParseCSources)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Product a b -> f (Product c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (FormatYamlParseError
-> [Char]
-> [Char]
-> Product
DefaultsConfig
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
-> WriterT
[[Char]]
(Errors IO)
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
expandGlobalDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir) (FormatYamlParseError
-> [Char]
-> [Char]
-> PackageConfig_
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection)
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection)
-> WriterT
[[Char]]
(Errors IO)
(PackageConfig ParseCSources ParseCSources ParseCSources)
expandSectionDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir)
expandGlobalDefaults
:: FormatYamlParseError
-> FilePath
-> FilePath
-> CommonOptionsWithDefaults Empty
-> Warnings (Errors IO) (CommonOptions ParseCSources ParseCxxSources ParseJsSources Empty)
expandGlobalDefaults :: FormatYamlParseError
-> [Char]
-> [Char]
-> Product
DefaultsConfig
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
-> WriterT
[[Char]]
(Errors IO)
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
expandGlobalDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir = do
(CommonOptions ParseCSources ParseCSources ParseCSources Empty
-> Product
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
Empty)
-> Product
DefaultsConfig
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
-> Product
DefaultsConfig
(Product
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
Empty)
forall a b.
(a -> b) -> Product DefaultsConfig a -> Product DefaultsConfig b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CommonOptions ParseCSources ParseCSources ParseCSources Empty
-> Empty
-> Product
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
Empty
forall a b. a -> b -> Product a b
`Product` Empty
Empty) (Product
DefaultsConfig
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
-> Product
DefaultsConfig
(Product
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
Empty))
-> (Product
DefaultsConfig
(Product
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
Empty)
-> WriterT
[[Char]]
(Errors IO)
(CommonOptions ParseCSources ParseCSources ParseCSources Empty))
-> Product
DefaultsConfig
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
-> WriterT
[[Char]]
(Errors IO)
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> FormatYamlParseError
-> [Char]
-> [Char]
-> Product
DefaultsConfig
(Product
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
Empty)
-> Warnings
(Errors IO)
(Product
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
Empty)
forall a.
(FromValue a, Semigroup a, Monoid a) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
expandDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir (Product
DefaultsConfig
(Product
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
Empty)
-> Warnings
(Errors IO)
(Product
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
Empty))
-> (Product
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
Empty
-> WriterT
[[Char]]
(Errors IO)
(CommonOptions ParseCSources ParseCSources ParseCSources Empty))
-> Product
DefaultsConfig
(Product
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
Empty)
-> WriterT
[[Char]]
(Errors IO)
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \ (Product CommonOptions ParseCSources ParseCSources ParseCSources Empty
c Empty
Empty) -> CommonOptions ParseCSources ParseCSources ParseCSources Empty
-> WriterT
[[Char]]
(Errors IO)
(CommonOptions ParseCSources ParseCSources ParseCSources Empty)
forall a. a -> WriterT [[Char]] (Errors IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return CommonOptions ParseCSources ParseCSources ParseCSources Empty
c
expandSectionDefaults
:: FormatYamlParseError
-> FilePath
-> FilePath
-> PackageConfigWithDefaults ParseCSources ParseCxxSources ParseJsSources
-> Warnings (Errors IO) (PackageConfig ParseCSources ParseCxxSources ParseJsSources)
expandSectionDefaults :: FormatYamlParseError
-> [Char]
-> [Char]
-> PackageConfig_
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection)
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection)
-> WriterT
[[Char]]
(Errors IO)
(PackageConfig ParseCSources ParseCSources ParseCSources)
expandSectionDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir p :: PackageConfig_
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection)
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection)
p@PackageConfig{Maybe [Char]
Maybe (Maybe [Char])
Maybe ParseCSources
Maybe
(Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection))
Maybe
(Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection))
Maybe (Map [Char] FlagSection)
Maybe
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection)
Maybe
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection)
ParseCSources
Maybe GitHub
Maybe PackageVersion
Maybe BuildType
Maybe CustomSetupSection
packageConfigName :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigVersion :: forall library executable.
PackageConfig_ library executable -> Maybe PackageVersion
packageConfigSynopsis :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigDescription :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigHomepage :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigBugReports :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigCategory :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigStability :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigAuthor :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigMaintainer :: forall library executable.
PackageConfig_ library executable -> Maybe ParseCSources
packageConfigCopyright :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigBuildType :: forall library executable.
PackageConfig_ library executable -> Maybe BuildType
packageConfigLicense :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigLicenseFile :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigTestedWith :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigFlags :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] FlagSection)
packageConfigExtraSourceFiles :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigExtraDocFiles :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigDataFiles :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigDataDir :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigGithub :: forall library executable.
PackageConfig_ library executable -> Maybe GitHub
packageConfigGit :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigCustomSetup :: forall library executable.
PackageConfig_ library executable -> Maybe CustomSetupSection
packageConfigLibrary :: forall library executable.
PackageConfig_ library executable -> Maybe library
packageConfigInternalLibraries :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] library)
packageConfigExecutable :: forall library executable.
PackageConfig_ library executable -> Maybe executable
packageConfigExecutables :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigTests :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigBenchmarks :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigName :: Maybe [Char]
packageConfigVersion :: Maybe PackageVersion
packageConfigSynopsis :: Maybe [Char]
packageConfigDescription :: Maybe [Char]
packageConfigHomepage :: Maybe (Maybe [Char])
packageConfigBugReports :: Maybe (Maybe [Char])
packageConfigCategory :: Maybe [Char]
packageConfigStability :: Maybe [Char]
packageConfigAuthor :: ParseCSources
packageConfigMaintainer :: Maybe ParseCSources
packageConfigCopyright :: ParseCSources
packageConfigBuildType :: Maybe BuildType
packageConfigLicense :: Maybe (Maybe [Char])
packageConfigLicenseFile :: ParseCSources
packageConfigTestedWith :: ParseCSources
packageConfigFlags :: Maybe (Map [Char] FlagSection)
packageConfigExtraSourceFiles :: ParseCSources
packageConfigExtraDocFiles :: ParseCSources
packageConfigDataFiles :: ParseCSources
packageConfigDataDir :: Maybe [Char]
packageConfigGithub :: Maybe GitHub
packageConfigGit :: Maybe [Char]
packageConfigCustomSetup :: Maybe CustomSetupSection
packageConfigLibrary :: Maybe
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection)
packageConfigInternalLibraries :: Maybe
(Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection))
packageConfigExecutable :: Maybe
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection)
packageConfigExecutables :: Maybe
(Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection))
packageConfigTests :: Maybe
(Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection))
packageConfigBenchmarks :: Maybe
(Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection))
..} = do
Maybe
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources LibrarySection)
LibrarySection)
library <- (SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection
-> WriterT
[[Char]]
(Errors IO)
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources LibrarySection)
LibrarySection))
-> Maybe
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection)
-> WriterT
[[Char]]
(Errors IO)
(Maybe
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources LibrarySection)
LibrarySection))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (FormatYamlParseError
-> [Char]
-> [Char]
-> SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection
-> WriterT
[[Char]]
(Errors IO)
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources LibrarySection)
LibrarySection)
forall a.
(FromValue a, Semigroup a, Monoid a) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
expandDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir) Maybe
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection)
packageConfigLibrary
Maybe
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources LibrarySection)
LibrarySection))
internalLibraries <- (Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection)
-> WriterT
[[Char]]
(Errors IO)
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources LibrarySection)
LibrarySection)))
-> Maybe
(Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection))
-> WriterT
[[Char]]
(Errors IO)
(Maybe
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources LibrarySection)
LibrarySection)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection
-> WriterT
[[Char]]
(Errors IO)
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources LibrarySection)
LibrarySection))
-> Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection)
-> WriterT
[[Char]]
(Errors IO)
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources LibrarySection)
LibrarySection))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map [Char] a -> f (Map [Char] b)
traverse (FormatYamlParseError
-> [Char]
-> [Char]
-> SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection
-> WriterT
[[Char]]
(Errors IO)
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources LibrarySection)
LibrarySection)
forall a.
(FromValue a, Semigroup a, Monoid a) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
expandDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir)) Maybe
(Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection))
packageConfigInternalLibraries
Maybe
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection)
executable <- (SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection
-> WriterT
[[Char]]
(Errors IO)
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection))
-> Maybe
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection)
-> WriterT
[[Char]]
(Errors IO)
(Maybe
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (FormatYamlParseError
-> [Char]
-> [Char]
-> SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection
-> WriterT
[[Char]]
(Errors IO)
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection)
forall a.
(FromValue a, Semigroup a, Monoid a) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
expandDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir) Maybe
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection)
packageConfigExecutable
Maybe
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection))
executables <- (Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection)
-> WriterT
[[Char]]
(Errors IO)
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection)))
-> Maybe
(Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection))
-> WriterT
[[Char]]
(Errors IO)
(Maybe
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection
-> WriterT
[[Char]]
(Errors IO)
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection))
-> Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection)
-> WriterT
[[Char]]
(Errors IO)
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map [Char] a -> f (Map [Char] b)
traverse (FormatYamlParseError
-> [Char]
-> [Char]
-> SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection
-> WriterT
[[Char]]
(Errors IO)
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection)
forall a.
(FromValue a, Semigroup a, Monoid a) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
expandDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir)) Maybe
(Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection))
packageConfigExecutables
Maybe
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection))
tests <- (Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection)
-> WriterT
[[Char]]
(Errors IO)
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection)))
-> Maybe
(Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection))
-> WriterT
[[Char]]
(Errors IO)
(Maybe
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection
-> WriterT
[[Char]]
(Errors IO)
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection))
-> Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection)
-> WriterT
[[Char]]
(Errors IO)
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map [Char] a -> f (Map [Char] b)
traverse (FormatYamlParseError
-> [Char]
-> [Char]
-> SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection
-> WriterT
[[Char]]
(Errors IO)
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection)
forall a.
(FromValue a, Semigroup a, Monoid a) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
expandDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir)) Maybe
(Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection))
packageConfigTests
Maybe
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection))
benchmarks <- (Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection)
-> WriterT
[[Char]]
(Errors IO)
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection)))
-> Maybe
(Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection))
-> WriterT
[[Char]]
(Errors IO)
(Maybe
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection
-> WriterT
[[Char]]
(Errors IO)
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection))
-> Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection)
-> WriterT
[[Char]]
(Errors IO)
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map [Char] a -> f (Map [Char] b)
traverse (FormatYamlParseError
-> [Char]
-> [Char]
-> SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection
-> WriterT
[[Char]]
(Errors IO)
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection)
forall a.
(FromValue a, Semigroup a, Monoid a) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
expandDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir [Char]
dir)) Maybe
(Map
[Char]
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection))
packageConfigBenchmarks
PackageConfig ParseCSources ParseCSources ParseCSources
-> WriterT
[[Char]]
(Errors IO)
(PackageConfig ParseCSources ParseCSources ParseCSources)
forall a. a -> WriterT [[Char]] (Errors IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return PackageConfig_
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources LibrarySection)
(SectionConfigWithDefaults
ParseCSources ParseCSources ParseCSources ExecutableSection)
p{
packageConfigLibrary :: Maybe
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources LibrarySection)
LibrarySection)
packageConfigLibrary = Maybe
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources LibrarySection)
LibrarySection)
library
, packageConfigInternalLibraries :: Maybe
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources LibrarySection)
LibrarySection))
packageConfigInternalLibraries = Maybe
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources LibrarySection)
LibrarySection))
internalLibraries
, packageConfigExecutable :: Maybe
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection)
packageConfigExecutable = Maybe
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection)
executable
, packageConfigExecutables :: Maybe
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection))
packageConfigExecutables = Maybe
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection))
executables
, packageConfigTests :: Maybe
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection))
packageConfigTests = Maybe
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection))
tests
, packageConfigBenchmarks :: Maybe
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection))
packageConfigBenchmarks = Maybe
(Map
[Char]
(Product
(CommonOptions
ParseCSources ParseCSources ParseCSources ExecutableSection)
ExecutableSection))
benchmarks
}
expandDefaults
:: (FromValue a, Semigroup a, Monoid a)
=> FormatYamlParseError
-> FilePath
-> FilePath
-> WithCommonOptionsWithDefaults a
-> Warnings (Errors IO) (WithCommonOptions ParseCSources ParseCxxSources ParseJsSources a)
expandDefaults :: forall a.
(FromValue a, Semigroup a, Monoid a) =>
FormatYamlParseError
-> [Char]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
expandDefaults FormatYamlParseError
formatYamlParseError [Char]
userDataDir = [[Char]]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
forall a.
(FromValue a, Semigroup a, Monoid a) =>
[[Char]]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
expand []
where
expand :: (FromValue a, Semigroup a, Monoid a) =>
[FilePath]
-> FilePath
-> WithCommonOptionsWithDefaults a
-> Warnings (Errors IO) (WithCommonOptions ParseCSources ParseCxxSources ParseJsSources a)
expand :: forall a.
(FromValue a, Semigroup a, Monoid a) =>
[[Char]]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
expand [[Char]]
seen [Char]
dir (Product DefaultsConfig{Maybe (List Defaults)
defaultsConfigDefaults :: DefaultsConfig -> Maybe (List Defaults)
defaultsConfigDefaults :: Maybe (List Defaults)
..} WithCommonOptions ParseCSources ParseCSources ParseCSources a
c) = do
WithCommonOptions ParseCSources ParseCSources ParseCSources a
d <- [WithCommonOptions ParseCSources ParseCSources ParseCSources a]
-> WithCommonOptions ParseCSources ParseCSources ParseCSources a
forall a. Monoid a => [a] -> a
mconcat ([WithCommonOptions ParseCSources ParseCSources ParseCSources a]
-> WithCommonOptions ParseCSources ParseCSources ParseCSources a)
-> WriterT
[[Char]]
(Errors IO)
[WithCommonOptions ParseCSources ParseCSources ParseCSources a]
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Defaults
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a))
-> [Defaults]
-> WriterT
[[Char]]
(Errors IO)
[WithCommonOptions ParseCSources ParseCSources ParseCSources a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([[Char]]
-> [Char]
-> Defaults
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
forall a.
(FromValue a, Semigroup a, Monoid a) =>
[[Char]]
-> [Char]
-> Defaults
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
get [[Char]]
seen [Char]
dir) (Maybe (List Defaults) -> [Defaults]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List Defaults)
defaultsConfigDefaults)
WithCommonOptions ParseCSources ParseCSources ParseCSources a
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
forall a. a -> WriterT [[Char]] (Errors IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (WithCommonOptions ParseCSources ParseCSources ParseCSources a
d WithCommonOptions ParseCSources ParseCSources ParseCSources a
-> WithCommonOptions ParseCSources ParseCSources ParseCSources a
-> WithCommonOptions ParseCSources ParseCSources ParseCSources a
forall a. Semigroup a => a -> a -> a
<> WithCommonOptions ParseCSources ParseCSources ParseCSources a
c)
get :: forall a. (FromValue a, Semigroup a, Monoid a) =>
[FilePath]
-> FilePath
-> Defaults
-> Warnings (Errors IO) (WithCommonOptions ParseCSources ParseCxxSources ParseJsSources a)
get :: forall a.
(FromValue a, Semigroup a, Monoid a) =>
[[Char]]
-> [Char]
-> Defaults
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
get [[Char]]
seen [Char]
dir Defaults
defaults = do
[Char]
file <- IO (Either HpackError [Char])
-> WriterT [[Char]] (Errors IO) [Char]
forall a. IO (Either HpackError a) -> Warnings (Errors IO) a
liftEither ([Char] -> [Char] -> Defaults -> IO (Either HpackError [Char])
ensure [Char]
userDataDir [Char]
dir Defaults
defaults)
[[Char]]
seen_ <- Errors IO [[Char]] -> WriterT [[Char]] (Errors IO) [[Char]]
forall (m :: * -> *) a. Monad m => m a -> WriterT [[Char]] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([[Char]] -> [Char] -> Errors IO [[Char]]
checkCycle [[Char]]
seen [Char]
file)
let dir_ :: [Char]
dir_ = ShowS
takeDirectory [Char]
file
FormatYamlParseError
-> [Char] -> Warnings (Errors IO) (WithCommonOptionsWithDefaults a)
forall a.
FromValue a =>
FormatYamlParseError -> [Char] -> Warnings (Errors IO) a
decodeYaml FormatYamlParseError
formatYamlParseError [Char]
file Warnings (Errors IO) (WithCommonOptionsWithDefaults a)
-> (WithCommonOptionsWithDefaults a
-> Warnings
(Errors IO)
(Product
(CommonOptions ParseCSources ParseCSources ParseCSources a) a))
-> Warnings
(Errors IO)
(Product
(CommonOptions ParseCSources ParseCSources ParseCSources a) a)
forall a b.
WriterT [[Char]] (Errors IO) a
-> (a -> WriterT [[Char]] (Errors IO) b)
-> WriterT [[Char]] (Errors IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [[Char]]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> Warnings
(Errors IO)
(Product
(CommonOptions ParseCSources ParseCSources ParseCSources a) a)
forall a.
(FromValue a, Semigroup a, Monoid a) =>
[[Char]]
-> [Char]
-> WithCommonOptionsWithDefaults a
-> Warnings
(Errors IO)
(WithCommonOptions ParseCSources ParseCSources ParseCSources a)
expand [[Char]]
seen_ [Char]
dir_
checkCycle :: [FilePath] -> FilePath -> Errors IO [FilePath]
checkCycle :: [[Char]] -> [Char] -> Errors IO [[Char]]
checkCycle [[Char]]
seen [Char]
file = do
[Char]
canonic <- IO [Char] -> ExceptT HpackError IO [Char]
forall a. IO a -> ExceptT HpackError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> ExceptT HpackError IO [Char])
-> IO [Char] -> ExceptT HpackError IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
canonicalizePath [Char]
file
let seen_ :: [[Char]]
seen_ = [Char]
canonic [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
seen
Bool -> ExceptT HpackError IO () -> ExceptT HpackError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
canonic [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
seen) (ExceptT HpackError IO () -> ExceptT HpackError IO ())
-> ExceptT HpackError IO () -> ExceptT HpackError IO ()
forall a b. (a -> b) -> a -> b
$ do
HpackError -> ExceptT HpackError IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (HpackError -> ExceptT HpackError IO ())
-> HpackError -> ExceptT HpackError IO ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> HpackError
CycleInDefaults ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
seen_)
[[Char]] -> Errors IO [[Char]]
forall a. a -> ExceptT HpackError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]]
seen_
toExecutableMap :: Monad m => String -> Maybe (Map String a) -> Maybe a -> Warnings m (Maybe (Map String a))
toExecutableMap :: forall (m :: * -> *) a.
Monad m =>
[Char]
-> Maybe (Map [Char] a)
-> Maybe a
-> Warnings m (Maybe (Map [Char] a))
toExecutableMap [Char]
name Maybe (Map [Char] a)
executables Maybe a
mExecutable = do
case Maybe a
mExecutable of
Just a
executable -> do
Bool -> WriterT [[Char]] m () -> WriterT [[Char]] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Map [Char] a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Map [Char] a)
executables) (WriterT [[Char]] m () -> WriterT [[Char]] m ())
-> WriterT [[Char]] m () -> WriterT [[Char]] m ()
forall a b. (a -> b) -> a -> b
$ do
[[Char]] -> WriterT [[Char]] m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [[Char]
"Ignoring field \"executables\" in favor of \"executable\""]
Maybe (Map [Char] a) -> Warnings m (Maybe (Map [Char] a))
forall a. a -> WriterT [[Char]] m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Map [Char] a) -> Warnings m (Maybe (Map [Char] a)))
-> Maybe (Map [Char] a) -> Warnings m (Maybe (Map [Char] a))
forall a b. (a -> b) -> a -> b
$ Map [Char] a -> Maybe (Map [Char] a)
forall a. a -> Maybe a
Just ([([Char], a)] -> Map [Char] a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [([Char]
name, a
executable)])
Maybe a
Nothing -> Maybe (Map [Char] a) -> Warnings m (Maybe (Map [Char] a))
forall a. a -> WriterT [[Char]] m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map [Char] a)
executables
type GlobalOptions = CommonOptions CSources CxxSources JsSources Empty
toPackage_ :: MonadIO m => FilePath -> Product GlobalOptions (PackageConfig CSources CxxSources JsSources) -> Warnings m (Package, String)
toPackage_ :: forall (m :: * -> *).
MonadIO m =>
[Char]
-> Config [Path] [Path] [Path] -> Warnings m (Package, [Char])
toPackage_ [Char]
dir (Product GlobalOptions
g PackageConfig{Maybe [Char]
Maybe (Maybe [Char])
Maybe ParseCSources
Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] LibrarySection))
Maybe (Map [Char] FlagSection)
Maybe (WithCommonOptions [Path] [Path] [Path] ExecutableSection)
Maybe (WithCommonOptions [Path] [Path] [Path] LibrarySection)
ParseCSources
Maybe GitHub
Maybe PackageVersion
Maybe BuildType
Maybe CustomSetupSection
packageConfigName :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigVersion :: forall library executable.
PackageConfig_ library executable -> Maybe PackageVersion
packageConfigSynopsis :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigDescription :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigHomepage :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigBugReports :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigCategory :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigStability :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigAuthor :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigMaintainer :: forall library executable.
PackageConfig_ library executable -> Maybe ParseCSources
packageConfigCopyright :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigBuildType :: forall library executable.
PackageConfig_ library executable -> Maybe BuildType
packageConfigLicense :: forall library executable.
PackageConfig_ library executable -> Maybe (Maybe [Char])
packageConfigLicenseFile :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigTestedWith :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigFlags :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] FlagSection)
packageConfigExtraSourceFiles :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigExtraDocFiles :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigDataFiles :: forall library executable.
PackageConfig_ library executable -> ParseCSources
packageConfigDataDir :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigGithub :: forall library executable.
PackageConfig_ library executable -> Maybe GitHub
packageConfigGit :: forall library executable.
PackageConfig_ library executable -> Maybe [Char]
packageConfigCustomSetup :: forall library executable.
PackageConfig_ library executable -> Maybe CustomSetupSection
packageConfigLibrary :: forall library executable.
PackageConfig_ library executable -> Maybe library
packageConfigInternalLibraries :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] library)
packageConfigExecutable :: forall library executable.
PackageConfig_ library executable -> Maybe executable
packageConfigExecutables :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigTests :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigBenchmarks :: forall library executable.
PackageConfig_ library executable -> Maybe (Map [Char] executable)
packageConfigName :: Maybe [Char]
packageConfigVersion :: Maybe PackageVersion
packageConfigSynopsis :: Maybe [Char]
packageConfigDescription :: Maybe [Char]
packageConfigHomepage :: Maybe (Maybe [Char])
packageConfigBugReports :: Maybe (Maybe [Char])
packageConfigCategory :: Maybe [Char]
packageConfigStability :: Maybe [Char]
packageConfigAuthor :: ParseCSources
packageConfigMaintainer :: Maybe ParseCSources
packageConfigCopyright :: ParseCSources
packageConfigBuildType :: Maybe BuildType
packageConfigLicense :: Maybe (Maybe [Char])
packageConfigLicenseFile :: ParseCSources
packageConfigTestedWith :: ParseCSources
packageConfigFlags :: Maybe (Map [Char] FlagSection)
packageConfigExtraSourceFiles :: ParseCSources
packageConfigExtraDocFiles :: ParseCSources
packageConfigDataFiles :: ParseCSources
packageConfigDataDir :: Maybe [Char]
packageConfigGithub :: Maybe GitHub
packageConfigGit :: Maybe [Char]
packageConfigCustomSetup :: Maybe CustomSetupSection
packageConfigLibrary :: Maybe (WithCommonOptions [Path] [Path] [Path] LibrarySection)
packageConfigInternalLibraries :: Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] LibrarySection))
packageConfigExecutable :: Maybe (WithCommonOptions [Path] [Path] [Path] ExecutableSection)
packageConfigExecutables :: Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
packageConfigTests :: Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
packageConfigBenchmarks :: Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
..}) = do
Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
executableMap <- [Char]
-> Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
-> Maybe (WithCommonOptions [Path] [Path] [Path] ExecutableSection)
-> Warnings
m
(Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection)))
forall (m :: * -> *) a.
Monad m =>
[Char]
-> Maybe (Map [Char] a)
-> Maybe a
-> Warnings m (Maybe (Map [Char] a))
toExecutableMap [Char]
packageName_ Maybe
(Map
[Char] (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 :: [[Char]]
executableNames = [[Char]]
-> (Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection)
-> [[Char]])
-> Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
-> [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection)
-> [[Char]]
forall k a. Map k a -> [k]
Map.keys Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
executableMap
toSect :: (Monad m, Monoid a) => WithCommonOptions CSources CxxSources JsSources a -> Warnings m (Section a)
toSect :: forall (m :: * -> *) a.
(Monad m, Monoid a) =>
WithCommonOptions [Path] [Path] [Path] a -> Warnings m (Section a)
toSect = [Char]
-> [[Char]]
-> WithCommonOptions [Path] [Path] [Path] a
-> Warnings m (Section a)
forall (m :: * -> *) a.
Monad m =>
[Char]
-> [[Char]]
-> WithCommonOptions [Path] [Path] [Path] a
-> Warnings m (Section a)
toSection [Char]
packageName_ [[Char]]
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 a b c. (a -> b) -> Product a c -> Product b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((a
forall a. Monoid a => a
mempty a -> GlobalOptions -> CommonOptions [Path] [Path] [Path] a
forall a b.
a
-> CommonOptions [Path] [Path] [Path] b
-> 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 :: forall (m :: * -> *) a.
(Monad m, Monoid a) =>
Maybe (Map [Char] (WithCommonOptions [Path] [Path] [Path] a))
-> Warnings m (Map [Char] (Section a))
toSections = Warnings m (Map [Char] (Section a))
-> (Map [Char] (WithCommonOptions [Path] [Path] [Path] a)
-> Warnings m (Map [Char] (Section a)))
-> Maybe (Map [Char] (WithCommonOptions [Path] [Path] [Path] a))
-> Warnings m (Map [Char] (Section a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Map [Char] (Section a) -> Warnings m (Map [Char] (Section a))
forall a. a -> WriterT [[Char]] m a
forall (m :: * -> *) a. Monad m => a -> m a
return Map [Char] (Section a)
forall a. Monoid a => a
mempty) ((WithCommonOptions [Path] [Path] [Path] a
-> WriterT [[Char]] m (Section a))
-> Map [Char] (WithCommonOptions [Path] [Path] [Path] a)
-> Warnings m (Map [Char] (Section a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map [Char] a -> f (Map [Char] b)
traverse WithCommonOptions [Path] [Path] [Path] a
-> WriterT [[Char]] m (Section a)
forall (m :: * -> *) a.
(Monad m, Monoid a) =>
WithCommonOptions [Path] [Path] [Path] a -> Warnings m (Section a)
toSect)
toLib :: Section LibrarySection -> WriterT [[Char]] m (Section Library)
toLib = IO (Section Library) -> WriterT [[Char]] m (Section Library)
forall a. IO a -> WriterT [[Char]] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Section Library) -> WriterT [[Char]] m (Section Library))
-> (Section LibrarySection -> IO (Section Library))
-> Section LibrarySection
-> WriterT [[Char]] m (Section Library)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> Section LibrarySection -> IO (Section Library)
toLibrary [Char]
dir [Char]
packageName_
toExecutables :: Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
-> WriterT [[Char]] m (Map [Char] (Section Executable))
toExecutables = Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
-> Warnings m (Map [Char] (Section ExecutableSection))
forall (m :: * -> *) a.
(Monad m, Monoid a) =>
Maybe (Map [Char] (WithCommonOptions [Path] [Path] [Path] a))
-> Warnings m (Map [Char] (Section a))
toSections (Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
-> Warnings m (Map [Char] (Section ExecutableSection)))
-> (Map [Char] (Section ExecutableSection)
-> WriterT [[Char]] m (Map [Char] (Section Executable)))
-> Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
-> WriterT [[Char]] m (Map [Char] (Section Executable))
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Section ExecutableSection
-> WriterT [[Char]] m (Section Executable))
-> Map [Char] (Section ExecutableSection)
-> WriterT [[Char]] m (Map [Char] (Section Executable))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map [Char] a -> f (Map [Char] b)
traverse (IO (Section Executable) -> WriterT [[Char]] m (Section Executable)
forall a. IO a -> WriterT [[Char]] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Section Executable)
-> WriterT [[Char]] m (Section Executable))
-> (Section ExecutableSection -> IO (Section Executable))
-> Section ExecutableSection
-> WriterT [[Char]] m (Section Executable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char]
-> [Char] -> Section ExecutableSection -> IO (Section Executable)
toExecutable [Char]
dir [Char]
packageName_)
Maybe (Section Library)
mLibrary <- (WithCommonOptions [Path] [Path] [Path] LibrarySection
-> WriterT [[Char]] m (Section Library))
-> Maybe (WithCommonOptions [Path] [Path] [Path] LibrarySection)
-> WriterT [[Char]] m (Maybe (Section Library))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (WithCommonOptions [Path] [Path] [Path] 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 [[Char]] m (Section Library))
-> WithCommonOptions [Path] [Path] [Path] LibrarySection
-> WriterT [[Char]] m (Section Library)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Section LibrarySection -> WriterT [[Char]] m (Section Library)
toLib) Maybe (WithCommonOptions [Path] [Path] [Path] LibrarySection)
packageConfigLibrary
Map [Char] (Section Library)
internalLibraries <- Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] LibrarySection))
-> Warnings m (Map [Char] (Section LibrarySection))
forall (m :: * -> *) a.
(Monad m, Monoid a) =>
Maybe (Map [Char] (WithCommonOptions [Path] [Path] [Path] a))
-> Warnings m (Map [Char] (Section a))
toSections Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] LibrarySection))
packageConfigInternalLibraries Warnings m (Map [Char] (Section LibrarySection))
-> (Map [Char] (Section LibrarySection)
-> WriterT [[Char]] m (Map [Char] (Section Library)))
-> WriterT [[Char]] m (Map [Char] (Section Library))
forall a b.
WriterT [[Char]] m a
-> (a -> WriterT [[Char]] m b) -> WriterT [[Char]] m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Section LibrarySection -> WriterT [[Char]] m (Section Library))
-> Map [Char] (Section LibrarySection)
-> WriterT [[Char]] m (Map [Char] (Section Library))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map [Char] a -> f (Map [Char] b)
traverse Section LibrarySection -> WriterT [[Char]] m (Section Library)
toLib
Map [Char] (Section Executable)
executables <- Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
-> WriterT [[Char]] m (Map [Char] (Section Executable))
toExecutables Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
executableMap
Map [Char] (Section Executable)
tests <- Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
-> WriterT [[Char]] m (Map [Char] (Section Executable))
toExecutables Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
packageConfigTests
Map [Char] (Section Executable)
benchmarks <- Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
-> WriterT [[Char]] m (Map [Char] (Section Executable))
toExecutables Maybe
(Map
[Char] (WithCommonOptions [Path] [Path] [Path] ExecutableSection))
packageConfigBenchmarks
Bool
licenseFileExists <- IO Bool -> WriterT [[Char]] m Bool
forall a. IO a -> WriterT [[Char]] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> WriterT [[Char]] m Bool)
-> IO Bool -> WriterT [[Char]] m Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist ([Char]
dir [Char] -> ShowS
</> [Char]
"LICENSE")
[[Char]]
missingSourceDirs <- IO [[Char]] -> WriterT [[Char]] m [[Char]]
forall a. IO a -> WriterT [[Char]] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[Char]] -> WriterT [[Char]] m [[Char]])
-> IO [[Char]] -> WriterT [[Char]] m [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
nub ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
sort ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Bool -> Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (IO Bool -> IO Bool) -> ([Char] -> IO Bool) -> [Char] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO Bool
doesDirectoryExist ([Char] -> IO Bool) -> ShowS -> [Char] -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
dir [Char] -> ShowS
</>)) (
[[Char]]
-> (Section Library -> [[Char]])
-> Maybe (Section Library)
-> [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Section Library -> [[Char]]
forall a. Section a -> [[Char]]
sectionSourceDirs Maybe (Section Library)
mLibrary
[[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (Section Library -> [[Char]])
-> Map [Char] (Section Library) -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section Library -> [[Char]]
forall a. Section a -> [[Char]]
sectionSourceDirs Map [Char] (Section Library)
internalLibraries
[[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (Section Executable -> [[Char]])
-> Map [Char] (Section Executable) -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section Executable -> [[Char]]
forall a. Section a -> [[Char]]
sectionSourceDirs Map [Char] (Section Executable)
executables
[[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (Section Executable -> [[Char]])
-> Map [Char] (Section Executable) -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section Executable -> [[Char]]
forall a. Section a -> [[Char]]
sectionSourceDirs Map [Char] (Section Executable)
tests
[[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (Section Executable -> [[Char]])
-> Map [Char] (Section Executable) -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Section Executable -> [[Char]]
forall a. Section a -> [[Char]]
sectionSourceDirs Map [Char] (Section Executable)
benchmarks
)
[Path]
extraSourceFiles <- [Char] -> [Char] -> [[Char]] -> Warnings m [Path]
forall (m :: * -> *).
MonadIO m =>
[Char] -> [Char] -> [[Char]] -> Warnings m [Path]
expandGlobs [Char]
"extra-source-files" [Char]
dir (ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
packageConfigExtraSourceFiles)
[Path]
extraDocFiles <- [Char] -> [Char] -> [[Char]] -> Warnings m [Path]
forall (m :: * -> *).
MonadIO m =>
[Char] -> [Char] -> [[Char]] -> Warnings m [Path]
expandGlobs [Char]
"extra-doc-files" [Char]
dir (ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
packageConfigExtraDocFiles)
let dataBaseDir :: [Char]
dataBaseDir = [Char] -> ShowS -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
dir ([Char]
dir [Char] -> ShowS
</>) Maybe [Char]
packageConfigDataDir
[Path]
dataFiles <- [Char] -> [Char] -> [[Char]] -> Warnings m [Path]
forall (m :: * -> *).
MonadIO m =>
[Char] -> [Char] -> [[Char]] -> Warnings m [Path]
expandGlobs [Char]
"data-files" [Char]
dataBaseDir (ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
packageConfigDataFiles)
let
licenseFiles :: [String]
licenseFiles :: [[Char]]
licenseFiles = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList (ParseCSources -> [[Char]]) -> ParseCSources -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ParseCSources
packageConfigLicenseFile ParseCSources -> ParseCSources -> ParseCSources
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
licenseFileExists
List [Char] -> ParseCSources
forall a. a -> Maybe a
Just ([[Char]] -> List [Char]
forall a. [a] -> List a
List [[Char]
"LICENSE"])
Maybe (License License)
inferredLicense <- case (Maybe (Maybe [Char])
packageConfigLicense, [[Char]]
licenseFiles) of
(Maybe (Maybe [Char])
Nothing, [[Char]
file]) -> do
Maybe [Char]
input <- IO (Maybe [Char]) -> WriterT [[Char]] m (Maybe [Char])
forall a. IO a -> WriterT [[Char]] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> IO (Maybe [Char])
tryReadFile ([Char]
dir [Char] -> ShowS
</> [Char]
file))
case Maybe [Char]
input Maybe [Char]
-> ([Char] -> Maybe (License License)) -> Maybe (License License)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe (License License)
inferLicense of
Maybe (License License)
Nothing -> do
[[Char]] -> WriterT [[Char]] m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [[Char]
"Inferring license from file " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
file [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" failed!"]
Maybe (License License)
-> WriterT [[Char]] m (Maybe (License License))
forall a. a -> WriterT [[Char]] m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (License License)
forall a. Maybe a
Nothing
Maybe (License License)
license -> Maybe (License License)
-> WriterT [[Char]] m (Maybe (License License))
forall a. a -> WriterT [[Char]] m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (License License)
license
(Maybe (Maybe [Char]), [[Char]])
_ -> Maybe (License License)
-> WriterT [[Char]] m (Maybe (License License))
forall a. a -> WriterT [[Char]] m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (License License)
forall a. Maybe a
Nothing
let defaultBuildType :: BuildType
defaultBuildType :: BuildType
defaultBuildType = BuildType
-> (CustomSetup -> BuildType) -> Maybe CustomSetup -> BuildType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BuildType
Simple (BuildType -> CustomSetup -> BuildType
forall a b. a -> b -> a
const BuildType
Custom) Maybe CustomSetup
mCustomSetup
pkg :: Package
pkg = Package {
packageName :: [Char]
packageName = [Char]
packageName_
, packageVersion :: [Char]
packageVersion = [Char]
-> (PackageVersion -> [Char]) -> Maybe PackageVersion -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"0.0.0" PackageVersion -> [Char]
unPackageVersion Maybe PackageVersion
packageConfigVersion
, packageSynopsis :: Maybe [Char]
packageSynopsis = Maybe [Char]
packageConfigSynopsis
, packageDescription :: Maybe [Char]
packageDescription = Maybe [Char]
packageConfigDescription
, packageHomepage :: Maybe [Char]
packageHomepage = Maybe [Char]
homepage
, packageBugReports :: Maybe [Char]
packageBugReports = Maybe [Char]
bugReports
, packageCategory :: Maybe [Char]
packageCategory = Maybe [Char]
packageConfigCategory
, packageStability :: Maybe [Char]
packageStability = Maybe [Char]
packageConfigStability
, packageAuthor :: [[Char]]
packageAuthor = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
packageConfigAuthor
, packageMaintainer :: [[Char]]
packageMaintainer = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
maintainer
, packageCopyright :: [[Char]]
packageCopyright = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
packageConfigCopyright
, packageBuildType :: BuildType
packageBuildType = BuildType -> Maybe BuildType -> BuildType
forall a. a -> Maybe a -> a
fromMaybe BuildType
defaultBuildType Maybe BuildType
packageConfigBuildType
, packageLicense :: Maybe [Char]
packageLicense = Maybe (Maybe [Char]) -> Maybe [Char]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe [Char])
packageConfigLicense
, packageLicenseFile :: [[Char]]
packageLicenseFile = [[Char]]
licenseFiles
, packageTestedWith :: [[Char]]
packageTestedWith = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
packageConfigTestedWith
, packageFlags :: [Flag]
packageFlags = [Flag]
flags
, packageExtraSourceFiles :: [Path]
packageExtraSourceFiles = [Path]
extraSourceFiles
, packageExtraDocFiles :: [Path]
packageExtraDocFiles = [Path]
extraDocFiles
, packageDataFiles :: [Path]
packageDataFiles = [Path]
dataFiles
, packageDataDir :: Maybe [Char]
packageDataDir = Maybe [Char]
packageConfigDataDir
, packageSourceRepository :: Maybe SourceRepository
packageSourceRepository = Maybe SourceRepository
sourceRepository
, packageCustomSetup :: Maybe CustomSetup
packageCustomSetup = Maybe CustomSetup
mCustomSetup
, packageLibrary :: Maybe (Section Library)
packageLibrary = Maybe (Section Library)
mLibrary
, packageInternalLibraries :: Map [Char] (Section Library)
packageInternalLibraries = Map [Char] (Section Library)
internalLibraries
, packageExecutables :: Map [Char] (Section Executable)
packageExecutables = Map [Char] (Section Executable)
executables
, packageTests :: Map [Char] (Section Executable)
packageTests = Map [Char] (Section Executable)
tests
, packageBenchmarks :: Map [Char] (Section Executable)
packageBenchmarks = Map [Char] (Section Executable)
benchmarks
, packageVerbatim :: [Verbatim]
packageVerbatim = Maybe (List Verbatim) -> [Verbatim]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List Verbatim)
globalVerbatim
}
[[Char]] -> WriterT [[Char]] m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [[Char]]
nameWarnings
[[Char]] -> WriterT [[Char]] m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell ([[Char]] -> [[Char]]
formatMissingSourceDirs [[Char]]
missingSourceDirs)
let (Package
pkg_, [Char]
renderedCabalVersion, Maybe Version
cabalVersion) = Maybe (License License)
-> Package -> (Package, [Char], Maybe Version)
determineCabalVersion Maybe (License License)
inferredLicense Package
pkg
(Package, [Char]) -> Warnings m (Package, [Char])
forall a. a -> WriterT [[Char]] m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Package -> (Version -> Package) -> Maybe Version -> Package
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Package
pkg_ (Package -> Version -> Package
addPathsModuleToGeneratedModules Package
pkg_) Maybe Version
cabalVersion, [Char]
renderedCabalVersion)
where
nameWarnings :: [String]
packageName_ :: String
([[Char]]
nameWarnings, [Char]
packageName_) = case Maybe [Char]
packageConfigName of
Maybe [Char]
Nothing -> let inferredName :: [Char]
inferredName = ShowS
takeBaseName [Char]
dir in
([[Char]
"Package name not specified, inferred " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
inferredName], [Char]
inferredName)
Just [Char]
n -> ([], [Char]
n)
mCustomSetup :: Maybe CustomSetup
mCustomSetup :: Maybe CustomSetup
mCustomSetup = CustomSetupSection -> CustomSetup
toCustomSetup (CustomSetupSection -> CustomSetup)
-> Maybe CustomSetupSection -> Maybe CustomSetup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CustomSetupSection
packageConfigCustomSetup
flags :: [Flag]
flags = (([Char], FlagSection) -> Flag)
-> [([Char], FlagSection)] -> [Flag]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], FlagSection) -> Flag
toFlag ([([Char], FlagSection)] -> [Flag])
-> [([Char], FlagSection)] -> [Flag]
forall a b. (a -> b) -> a -> b
$ Maybe (Map [Char] FlagSection) -> [([Char], FlagSection)]
forall a. Maybe (Map [Char] a) -> [([Char], a)]
toList Maybe (Map [Char] FlagSection)
packageConfigFlags
toList :: Maybe (Map String a) -> [(String, a)]
toList :: forall a. Maybe (Map [Char] a) -> [([Char], a)]
toList = Map [Char] a -> [([Char], a)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map [Char] a -> [([Char], a)])
-> (Maybe (Map [Char] a) -> Map [Char] a)
-> Maybe (Map [Char] a)
-> [([Char], a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map [Char] a -> Maybe (Map [Char] a) -> Map [Char] a
forall a. a -> Maybe a -> a
fromMaybe Map [Char] a
forall a. Monoid a => a
mempty
formatMissingSourceDirs :: [[Char]] -> [[Char]]
formatMissingSourceDirs = ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
forall a. Show a => a -> [Char]
f
where
f :: a -> [Char]
f a
name = [Char]
"Specified source-dir " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" does not exist"
sourceRepository :: Maybe SourceRepository
sourceRepository :: Maybe SourceRepository
sourceRepository = Maybe SourceRepository
github Maybe SourceRepository
-> Maybe SourceRepository -> Maybe SourceRepository
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Char] -> Maybe [Char] -> SourceRepository
`SourceRepository` Maybe [Char]
forall a. Maybe a
Nothing) ([Char] -> SourceRepository)
-> Maybe [Char] -> Maybe SourceRepository
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
packageConfigGit
github :: Maybe SourceRepository
github :: Maybe SourceRepository
github = GitHub -> SourceRepository
toSourceRepository (GitHub -> SourceRepository)
-> Maybe GitHub -> Maybe SourceRepository
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GitHub
packageConfigGithub
where
toSourceRepository :: GitHub -> SourceRepository
toSourceRepository :: GitHub -> SourceRepository
toSourceRepository (GitHub [Char]
owner [Char]
repo Maybe [Char]
subdir) = [Char] -> Maybe [Char] -> SourceRepository
SourceRepository ([Char]
githubBaseUrl [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
owner [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"/" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
repo) Maybe [Char]
subdir
homepage :: Maybe String
homepage :: Maybe [Char]
homepage = case Maybe (Maybe [Char])
packageConfigHomepage of
Just Maybe [Char]
Nothing -> Maybe [Char]
forall a. Maybe a
Nothing
Maybe (Maybe [Char])
_ -> Maybe (Maybe [Char]) -> Maybe [Char]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe [Char])
packageConfigHomepage Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [Char]
fromGithub
where
fromGithub :: Maybe [Char]
fromGithub = ([Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"#readme") ShowS -> (SourceRepository -> [Char]) -> SourceRepository -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceRepository -> [Char]
sourceRepositoryUrl (SourceRepository -> [Char])
-> Maybe SourceRepository -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SourceRepository
github
bugReports :: Maybe String
bugReports :: Maybe [Char]
bugReports = case Maybe (Maybe [Char])
packageConfigBugReports of
Just Maybe [Char]
Nothing -> Maybe [Char]
forall a. Maybe a
Nothing
Maybe (Maybe [Char])
_ -> Maybe (Maybe [Char]) -> Maybe [Char]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe [Char])
packageConfigBugReports Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [Char]
fromGithub
where
fromGithub :: Maybe [Char]
fromGithub = ([Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"/issues") ShowS -> (SourceRepository -> [Char]) -> SourceRepository -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceRepository -> [Char]
sourceRepositoryUrl (SourceRepository -> [Char])
-> Maybe SourceRepository -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SourceRepository
github
maintainer :: Maybe (List String)
maintainer :: ParseCSources
maintainer = case (ParseCSources
packageConfigAuthor, Maybe ParseCSources
packageConfigMaintainer) of
(Just List [Char]
_, Maybe ParseCSources
Nothing) -> ParseCSources
packageConfigAuthor
(ParseCSources
_, Just ParseCSources
m) -> ParseCSources
m
(ParseCSources, Maybe ParseCSources)
_ -> ParseCSources
forall a. Maybe a
Nothing
expandForeignSources
:: MonadIO m
=> FilePath
-> Traverse (Warnings m) ParseCSources CSources ParseCxxSources CxxSources ParseJsSources JsSources
expandForeignSources :: forall (m :: * -> *).
MonadIO m =>
[Char]
-> Traverse
(Warnings m)
ParseCSources
[Path]
ParseCSources
[Path]
ParseCSources
[Path]
expandForeignSources [Char]
dir = Traverse {
traverseCSources :: ParseCSources -> WriterT [[Char]] m [Path]
traverseCSources = [Char] -> ParseCSources -> WriterT [[Char]] m [Path]
forall {m :: * -> *}.
MonadIO m =>
[Char] -> ParseCSources -> Warnings m [Path]
expand [Char]
"c-sources"
, traverseCxxSources :: ParseCSources -> WriterT [[Char]] m [Path]
traverseCxxSources = [Char] -> ParseCSources -> WriterT [[Char]] m [Path]
forall {m :: * -> *}.
MonadIO m =>
[Char] -> ParseCSources -> Warnings m [Path]
expand [Char]
"cxx-sources"
, traverseJsSources :: ParseCSources -> WriterT [[Char]] m [Path]
traverseJsSources = [Char] -> ParseCSources -> WriterT [[Char]] m [Path]
forall {m :: * -> *}.
MonadIO m =>
[Char] -> ParseCSources -> Warnings m [Path]
expand [Char]
"js-sources"
}
where
expand :: [Char] -> ParseCSources -> Warnings m [Path]
expand [Char]
fieldName ParseCSources
xs = do
[Char] -> [Char] -> [[Char]] -> Warnings m [Path]
forall (m :: * -> *).
MonadIO m =>
[Char] -> [Char] -> [[Char]] -> Warnings m [Path]
expandGlobs [Char]
fieldName [Char]
dir (ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
xs)
newtype Path = Path { Path -> [Char]
unPath :: FilePath }
deriving (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
/= :: Path -> Path -> Bool
Eq, Int -> Path -> ShowS
[Path] -> ShowS
Path -> [Char]
(Int -> Path -> ShowS)
-> (Path -> [Char]) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Path -> ShowS
showsPrec :: Int -> Path -> ShowS
$cshow :: Path -> [Char]
show :: Path -> [Char]
$cshowList :: [Path] -> ShowS
showList :: [Path] -> ShowS
Show, Eq Path
Eq Path
-> (Path -> Path -> Ordering)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Path)
-> (Path -> Path -> Path)
-> Ord Path
Path -> Path -> Bool
Path -> Path -> Ordering
Path -> Path -> Path
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Path -> Path -> Ordering
compare :: Path -> Path -> Ordering
$c< :: Path -> Path -> Bool
< :: Path -> Path -> Bool
$c<= :: Path -> Path -> Bool
<= :: Path -> Path -> Bool
$c> :: Path -> Path -> Bool
> :: Path -> Path -> Bool
$c>= :: Path -> Path -> Bool
>= :: Path -> Path -> Bool
$cmax :: Path -> Path -> Path
max :: Path -> Path -> Path
$cmin :: Path -> Path -> Path
min :: Path -> Path -> Path
Ord)
instance IsString Path where
fromString :: [Char] -> Path
fromString = [Char] -> Path
Path
expandGlobs :: MonadIO m => String -> FilePath -> [String] -> Warnings m [Path]
expandGlobs :: forall (m :: * -> *).
MonadIO m =>
[Char] -> [Char] -> [[Char]] -> Warnings m [Path]
expandGlobs [Char]
name [Char]
dir [[Char]]
patterns = ([Char] -> Path) -> [[Char]] -> [Path]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Path
Path ([[Char]] -> [Path])
-> WriterT [[Char]] m [[Char]] -> WriterT [[Char]] m [Path]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
([[Char]]
warnings, [[Char]]
files) <- IO ([[Char]], [[Char]]) -> WriterT [[Char]] m ([[Char]], [[Char]])
forall a. IO a -> WriterT [[Char]] m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([[Char]], [[Char]])
-> WriterT [[Char]] m ([[Char]], [[Char]]))
-> IO ([[Char]], [[Char]])
-> WriterT [[Char]] m ([[Char]], [[Char]])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]] -> IO ([[Char]], [[Char]])
Util.expandGlobs [Char]
name [Char]
dir [[Char]]
patterns
[[Char]] -> WriterT [[Char]] m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [[Char]]
warnings
[[Char]] -> WriterT [[Char]] m [[Char]]
forall a. a -> WriterT [[Char]] m a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]]
files
toCustomSetup :: CustomSetupSection -> CustomSetup
toCustomSetup :: CustomSetupSection -> CustomSetup
toCustomSetup CustomSetupSection{Maybe Dependencies
customSetupSectionDependencies :: CustomSetupSection -> Maybe Dependencies
customSetupSectionDependencies :: Maybe Dependencies
..} = CustomSetup
{ customSetupDependencies :: Dependencies
customSetupDependencies = Dependencies -> Maybe Dependencies -> Dependencies
forall a. a -> Maybe a -> a
fromMaybe Dependencies
forall a. Monoid a => a
mempty Maybe Dependencies
customSetupSectionDependencies }
traverseSectionAndConditionals :: Monad m
=> (acc -> Section a -> m (acc, b))
-> (acc -> Section a -> m (acc, b))
-> acc
-> Section a
-> m (Section b)
traverseSectionAndConditionals :: forall (m :: * -> *) acc a b.
Monad m =>
(acc -> Section a -> m (acc, b))
-> (acc -> Section a -> m (acc, b))
-> acc
-> Section a
-> m (Section b)
traverseSectionAndConditionals acc -> Section a -> m (acc, b)
fData acc -> Section a -> m (acc, b)
fConditionals acc
acc0 sect :: Section a
sect@Section{a
[[Char]]
[Path]
[Conditional (Section a)]
[Verbatim]
Maybe Bool
Maybe Language
Map BuildTool DependencyVersion
Dependencies
SystemBuildTools
sectionData :: forall a. Section a -> a
sectionSourceDirs :: forall a. Section a -> [[Char]]
sectionDependencies :: forall a. Section a -> Dependencies
sectionPkgConfigDependencies :: forall a. Section a -> [[Char]]
sectionDefaultExtensions :: forall a. Section a -> [[Char]]
sectionOtherExtensions :: forall a. Section a -> [[Char]]
sectionLanguage :: forall a. Section a -> Maybe Language
sectionGhcOptions :: forall a. Section a -> [[Char]]
sectionGhcProfOptions :: forall a. Section a -> [[Char]]
sectionGhcSharedOptions :: forall a. Section a -> [[Char]]
sectionGhcjsOptions :: forall a. Section a -> [[Char]]
sectionCppOptions :: forall a. Section a -> [[Char]]
sectionCcOptions :: forall a. Section a -> [[Char]]
sectionCSources :: forall a. Section a -> [Path]
sectionCxxOptions :: forall a. Section a -> [[Char]]
sectionCxxSources :: forall a. Section a -> [Path]
sectionJsSources :: forall a. Section a -> [Path]
sectionExtraLibDirs :: forall a. Section a -> [[Char]]
sectionExtraLibraries :: forall a. Section a -> [[Char]]
sectionExtraFrameworksDirs :: forall a. Section a -> [[Char]]
sectionFrameworks :: forall a. Section a -> [[Char]]
sectionIncludeDirs :: forall a. Section a -> [[Char]]
sectionInstallIncludes :: forall a. Section a -> [[Char]]
sectionLdOptions :: forall a. Section a -> [[Char]]
sectionBuildable :: forall a. Section a -> Maybe Bool
sectionConditionals :: forall a. Section a -> [Conditional (Section a)]
sectionBuildTools :: forall a. Section a -> Map BuildTool DependencyVersion
sectionSystemBuildTools :: forall a. Section a -> SystemBuildTools
sectionVerbatim :: forall a. Section a -> [Verbatim]
sectionData :: a
sectionSourceDirs :: [[Char]]
sectionDependencies :: Dependencies
sectionPkgConfigDependencies :: [[Char]]
sectionDefaultExtensions :: [[Char]]
sectionOtherExtensions :: [[Char]]
sectionLanguage :: Maybe Language
sectionGhcOptions :: [[Char]]
sectionGhcProfOptions :: [[Char]]
sectionGhcSharedOptions :: [[Char]]
sectionGhcjsOptions :: [[Char]]
sectionCppOptions :: [[Char]]
sectionCcOptions :: [[Char]]
sectionCSources :: [Path]
sectionCxxOptions :: [[Char]]
sectionCxxSources :: [Path]
sectionJsSources :: [Path]
sectionExtraLibDirs :: [[Char]]
sectionExtraLibraries :: [[Char]]
sectionExtraFrameworksDirs :: [[Char]]
sectionFrameworks :: [[Char]]
sectionIncludeDirs :: [[Char]]
sectionInstallIncludes :: [[Char]]
sectionLdOptions :: [[Char]]
sectionBuildable :: Maybe Bool
sectionConditionals :: [Conditional (Section a)]
sectionBuildTools :: Map BuildTool DependencyVersion
sectionSystemBuildTools :: SystemBuildTools
sectionVerbatim :: [Verbatim]
..} = do
(acc
acc1, b
x) <- acc -> Section a -> m (acc, b)
fData acc
acc0 Section a
sect
[Conditional (Section b)]
xs <- acc -> [Conditional (Section a)] -> m [Conditional (Section b)]
traverseConditionals acc
acc1 [Conditional (Section a)]
sectionConditionals
Section b -> m (Section b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Section a
sect{sectionData :: 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Conditional (Section a) -> m (Conditional (Section b)))
-> [Conditional (Section a)] -> m [Conditional (Section b)])
-> (acc -> Conditional (Section a) -> m (Conditional (Section b)))
-> acc
-> [Conditional (Section a)]
-> m [Conditional (Section b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Section a -> m (Section b))
-> Conditional (Section a) -> m (Conditional (Section b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Conditional a -> f (Conditional b)
traverse ((Section a -> m (Section b))
-> Conditional (Section a) -> m (Conditional (Section b)))
-> (acc -> Section a -> m (Section b))
-> acc
-> Conditional (Section a)
-> m (Conditional (Section b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (acc -> Section a -> m (acc, b))
-> (acc -> Section a -> m (acc, b))
-> acc
-> Section a
-> m (Section b)
forall (m :: * -> *) acc a b.
Monad m =>
(acc -> Section a -> m (acc, b))
-> (acc -> Section a -> m (acc, b))
-> acc
-> Section a
-> m (Section b)
traverseSectionAndConditionals acc -> Section a -> m (acc, b)
fConditionals acc -> Section a -> m (acc, b)
fConditionals
getMentionedLibraryModules :: LibrarySection -> [Module]
getMentionedLibraryModules :: LibrarySection -> [Module]
getMentionedLibraryModules (LibrarySection Maybe Bool
_ Maybe [Char]
_ Maybe (List Module)
exposedModules Maybe (List Module)
generatedExposedModules Maybe (List Module)
otherModules Maybe (List Module)
generatedOtherModules ParseCSources
_ ParseCSources
_)
= Maybe (List Module) -> [Module]
forall a. Maybe (List a) -> [a]
fromMaybeList (Maybe (List Module)
exposedModules Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> Maybe (List Module)
generatedExposedModules Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> Maybe (List Module)
otherModules Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> Maybe (List Module)
generatedOtherModules)
getLibraryModules :: Library -> [Module]
getLibraryModules :: Library -> [Module]
getLibraryModules Library{[[Char]]
[Module]
Maybe Bool
Maybe [Char]
libraryGeneratedModules :: Library -> [Module]
libraryReexportedModules :: Library -> [[Char]]
librarySignatures :: Library -> [[Char]]
libraryVisibility :: Library -> Maybe [Char]
libraryExposed :: Library -> Maybe Bool
libraryExposedModules :: Library -> [Module]
libraryOtherModules :: Library -> [Module]
libraryExposed :: Maybe Bool
libraryVisibility :: Maybe [Char]
libraryExposedModules :: [Module]
libraryOtherModules :: [Module]
libraryGeneratedModules :: [Module]
libraryReexportedModules :: [[Char]]
librarySignatures :: [[Char]]
..} = [Module]
libraryExposedModules [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ [Module]
libraryOtherModules
getExecutableModules :: Executable -> [Module]
getExecutableModules :: Executable -> [Module]
getExecutableModules Executable{[Module]
Maybe [Char]
executableOtherModules :: Executable -> [Module]
executableGeneratedModules :: Executable -> [Module]
executableMain :: Executable -> Maybe [Char]
executableMain :: Maybe [Char]
executableOtherModules :: [Module]
executableGeneratedModules :: [Module]
..} = [Module]
executableOtherModules
listModules :: FilePath -> Section a -> IO [Module]
listModules :: forall a. [Char] -> Section a -> IO [Module]
listModules [Char]
dir Section{a
[[Char]]
[Path]
[Conditional (Section a)]
[Verbatim]
Maybe Bool
Maybe Language
Map BuildTool DependencyVersion
Dependencies
SystemBuildTools
sectionData :: forall a. Section a -> a
sectionSourceDirs :: forall a. Section a -> [[Char]]
sectionDependencies :: forall a. Section a -> Dependencies
sectionPkgConfigDependencies :: forall a. Section a -> [[Char]]
sectionDefaultExtensions :: forall a. Section a -> [[Char]]
sectionOtherExtensions :: forall a. Section a -> [[Char]]
sectionLanguage :: forall a. Section a -> Maybe Language
sectionGhcOptions :: forall a. Section a -> [[Char]]
sectionGhcProfOptions :: forall a. Section a -> [[Char]]
sectionGhcSharedOptions :: forall a. Section a -> [[Char]]
sectionGhcjsOptions :: forall a. Section a -> [[Char]]
sectionCppOptions :: forall a. Section a -> [[Char]]
sectionCcOptions :: forall a. Section a -> [[Char]]
sectionCSources :: forall a. Section a -> [Path]
sectionCxxOptions :: forall a. Section a -> [[Char]]
sectionCxxSources :: forall a. Section a -> [Path]
sectionJsSources :: forall a. Section a -> [Path]
sectionExtraLibDirs :: forall a. Section a -> [[Char]]
sectionExtraLibraries :: forall a. Section a -> [[Char]]
sectionExtraFrameworksDirs :: forall a. Section a -> [[Char]]
sectionFrameworks :: forall a. Section a -> [[Char]]
sectionIncludeDirs :: forall a. Section a -> [[Char]]
sectionInstallIncludes :: forall a. Section a -> [[Char]]
sectionLdOptions :: forall a. Section a -> [[Char]]
sectionBuildable :: forall a. Section a -> Maybe Bool
sectionConditionals :: forall a. Section a -> [Conditional (Section a)]
sectionBuildTools :: forall a. Section a -> Map BuildTool DependencyVersion
sectionSystemBuildTools :: forall a. Section a -> SystemBuildTools
sectionVerbatim :: forall a. Section a -> [Verbatim]
sectionData :: a
sectionSourceDirs :: [[Char]]
sectionDependencies :: Dependencies
sectionPkgConfigDependencies :: [[Char]]
sectionDefaultExtensions :: [[Char]]
sectionOtherExtensions :: [[Char]]
sectionLanguage :: Maybe Language
sectionGhcOptions :: [[Char]]
sectionGhcProfOptions :: [[Char]]
sectionGhcSharedOptions :: [[Char]]
sectionGhcjsOptions :: [[Char]]
sectionCppOptions :: [[Char]]
sectionCcOptions :: [[Char]]
sectionCSources :: [Path]
sectionCxxOptions :: [[Char]]
sectionCxxSources :: [Path]
sectionJsSources :: [Path]
sectionExtraLibDirs :: [[Char]]
sectionExtraLibraries :: [[Char]]
sectionExtraFrameworksDirs :: [[Char]]
sectionFrameworks :: [[Char]]
sectionIncludeDirs :: [[Char]]
sectionInstallIncludes :: [[Char]]
sectionLdOptions :: [[Char]]
sectionBuildable :: Maybe Bool
sectionConditionals :: [Conditional (Section a)]
sectionBuildTools :: Map BuildTool DependencyVersion
sectionSystemBuildTools :: SystemBuildTools
sectionVerbatim :: [Verbatim]
..} = [[Module]] -> [Module]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Module]] -> [Module]) -> IO [[Module]] -> IO [Module]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> IO [Module]) -> [[Char]] -> IO [[Module]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Char] -> [Char] -> IO [Module]
getModules [Char]
dir) [[Char]]
sectionSourceDirs
removeConditionalsThatAreAlwaysFalse :: Section a -> Section a
removeConditionalsThatAreAlwaysFalse :: forall a. Section a -> Section a
removeConditionalsThatAreAlwaysFalse Section a
sect = Section a
sect {
sectionConditionals :: [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 :: forall a b.
[Char]
-> [Char]
-> (a -> [Module])
-> (b -> [Module])
-> ([Module] -> [Module] -> a -> b)
-> ([Module] -> a -> b)
-> Section a
-> IO (Section b)
inferModules [Char]
dir [Char]
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 a b. (a -> b) -> IO a -> IO 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 [[Char] -> Module
pathsModuleFromPackageName [Char]
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 <- [Char] -> Section a -> IO [Module]
forall a. [Char] -> Section a -> IO [Module]
listModules [Char]
dir Section a
sect
let
mentionedModules :: [Module]
mentionedModules = (a -> [Module]) -> Section a -> [Module]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap a -> [Module]
getMentionedModules Section a
sect
inferableModules :: [Module]
inferableModules = ([Module]
modules [Module] -> [Module] -> [Module]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Module]
outerModules) [Module] -> [Module] -> [Module]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Module]
mentionedModules
pathsModule :: [Module]
pathsModule = ([Module]
pathsModule_ [Module] -> [Module] -> [Module]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Module]
outerModules) [Module] -> [Module] -> [Module]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Module]
mentionedModules
r :: b
r = [Module] -> [Module] -> a -> b
fromConfig [Module]
pathsModule [Module]
inferableModules a
conf
([Module], b) -> IO ([Module], b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Module]
outerModules [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ b -> [Module]
getInferredModules b
r, b
r)
toLibrary :: FilePath -> String -> Section LibrarySection -> IO (Section Library)
toLibrary :: [Char] -> [Char] -> Section LibrarySection -> IO (Section Library)
toLibrary [Char]
dir [Char]
name =
[Char]
-> [Char]
-> (LibrarySection -> [Module])
-> (Library -> [Module])
-> ([Module] -> [Module] -> LibrarySection -> Library)
-> ([Module] -> LibrarySection -> Library)
-> Section LibrarySection
-> IO (Section Library)
forall a b.
[Char]
-> [Char]
-> (a -> [Module])
-> (b -> [Module])
-> ([Module] -> [Module] -> a -> b)
-> ([Module] -> a -> b)
-> Section a
-> IO (Section b)
inferModules [Char]
dir [Char]
name LibrarySection -> [Module]
getMentionedLibraryModules Library -> [Module]
getLibraryModules [Module] -> [Module] -> LibrarySection -> Library
fromLibrarySectionTopLevel [Module] -> LibrarySection -> Library
fromLibrarySectionInConditional
where
fromLibrarySectionTopLevel :: [Module] -> [Module] -> LibrarySection -> Library
fromLibrarySectionTopLevel :: [Module] -> [Module] -> LibrarySection -> Library
fromLibrarySectionTopLevel [Module]
pathsModule [Module]
inferableModules LibrarySection{Maybe Bool
Maybe [Char]
ParseCSources
Maybe (List Module)
librarySectionExposed :: LibrarySection -> Maybe Bool
librarySectionVisibility :: LibrarySection -> Maybe [Char]
librarySectionExposedModules :: LibrarySection -> Maybe (List Module)
librarySectionGeneratedExposedModules :: LibrarySection -> Maybe (List Module)
librarySectionOtherModules :: LibrarySection -> Maybe (List Module)
librarySectionGeneratedOtherModules :: LibrarySection -> Maybe (List Module)
librarySectionReexportedModules :: LibrarySection -> ParseCSources
librarySectionSignatures :: LibrarySection -> ParseCSources
librarySectionExposed :: Maybe Bool
librarySectionVisibility :: Maybe [Char]
librarySectionExposedModules :: Maybe (List Module)
librarySectionGeneratedExposedModules :: Maybe (List Module)
librarySectionOtherModules :: Maybe (List Module)
librarySectionGeneratedOtherModules :: Maybe (List Module)
librarySectionReexportedModules :: ParseCSources
librarySectionSignatures :: ParseCSources
..} =
Maybe Bool
-> Maybe [Char]
-> [Module]
-> [Module]
-> [Module]
-> [[Char]]
-> [[Char]]
-> Library
Library Maybe Bool
librarySectionExposed Maybe [Char]
librarySectionVisibility [Module]
exposedModules [Module]
otherModules [Module]
generatedModules [[Char]]
reexportedModules [[Char]]
signatures
where
([Module]
exposedModules, [Module]
otherModules, [Module]
generatedModules) =
[Module]
-> [Module]
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List Module)
-> ([Module], [Module], [Module])
determineModules [Module]
pathsModule [Module]
inferableModules Maybe (List Module)
librarySectionExposedModules Maybe (List Module)
librarySectionGeneratedExposedModules Maybe (List Module)
librarySectionOtherModules Maybe (List Module)
librarySectionGeneratedOtherModules
reexportedModules :: [[Char]]
reexportedModules = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
librarySectionReexportedModules
signatures :: [[Char]]
signatures = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
librarySectionSignatures
determineModules :: [Module] -> [Module] -> Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module) -> ([Module], [Module], [Module])
determineModules :: [Module]
-> [Module]
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List Module)
-> Maybe (List Module)
-> ([Module], [Module], [Module])
determineModules [Module]
pathsModule [Module]
inferable Maybe (List Module)
mExposed Maybe (List Module)
mGeneratedExposed Maybe (List Module)
mOther Maybe (List Module)
mGeneratedOther =
([Module]
exposed, [Module]
others, [Module]
generated)
where
generated :: [Module]
generated = Maybe (List Module) -> [Module]
forall a. Maybe (List a) -> [a]
fromMaybeList (Maybe (List Module)
mGeneratedExposed Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> Maybe (List Module)
mGeneratedOther)
exposed :: [Module]
exposed = [Module]
-> (List Module -> [Module]) -> Maybe (List Module) -> [Module]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Module]
inferable List Module -> [Module]
forall a. List a -> [a]
fromList Maybe (List Module)
mExposed [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ Maybe (List Module) -> [Module]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List Module)
mGeneratedExposed
others :: [Module]
others = [Module]
-> (List Module -> [Module]) -> Maybe (List Module) -> [Module]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (([Module]
inferable [Module] -> [Module] -> [Module]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Module]
exposed) [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ [Module]
pathsModule) List Module -> [Module]
forall a. List a -> [a]
fromList Maybe (List Module)
mOther [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ Maybe (List Module) -> [Module]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List Module)
mGeneratedOther
fromLibrarySectionInConditional :: [Module] -> LibrarySection -> Library
fromLibrarySectionInConditional :: [Module] -> LibrarySection -> Library
fromLibrarySectionInConditional [Module]
inferableModules lib :: LibrarySection
lib@(LibrarySection Maybe Bool
_ Maybe [Char]
_ Maybe (List Module)
exposedModules Maybe (List Module)
_ Maybe (List Module)
otherModules Maybe (List Module)
_ ParseCSources
_ ParseCSources
_) =
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 [Char]
ParseCSources
Maybe (List Module)
librarySectionExposed :: LibrarySection -> Maybe Bool
librarySectionVisibility :: LibrarySection -> Maybe [Char]
librarySectionExposedModules :: LibrarySection -> Maybe (List Module)
librarySectionGeneratedExposedModules :: LibrarySection -> Maybe (List Module)
librarySectionOtherModules :: LibrarySection -> Maybe (List Module)
librarySectionGeneratedOtherModules :: LibrarySection -> Maybe (List Module)
librarySectionReexportedModules :: LibrarySection -> ParseCSources
librarySectionSignatures :: LibrarySection -> ParseCSources
librarySectionExposed :: Maybe Bool
librarySectionVisibility :: Maybe [Char]
librarySectionExposedModules :: Maybe (List Module)
librarySectionGeneratedExposedModules :: Maybe (List Module)
librarySectionOtherModules :: Maybe (List Module)
librarySectionGeneratedOtherModules :: Maybe (List Module)
librarySectionReexportedModules :: ParseCSources
librarySectionSignatures :: ParseCSources
..} = Library {
libraryExposed :: Maybe Bool
libraryExposed = Maybe Bool
librarySectionExposed
, libraryVisibility :: Maybe [Char]
libraryVisibility = Maybe [Char]
librarySectionVisibility
, libraryExposedModules :: [Module]
libraryExposedModules = Maybe (List Module) -> [Module]
forall a. Maybe (List a) -> [a]
fromMaybeList (Maybe (List Module)
librarySectionExposedModules Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> Maybe (List Module)
librarySectionGeneratedExposedModules)
, libraryOtherModules :: [Module]
libraryOtherModules = Maybe (List Module) -> [Module]
forall a. Maybe (List a) -> [a]
fromMaybeList (Maybe (List Module)
librarySectionOtherModules Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> Maybe (List Module)
librarySectionGeneratedOtherModules)
, libraryGeneratedModules :: [Module]
libraryGeneratedModules = Maybe (List Module) -> [Module]
forall a. Maybe (List a) -> [a]
fromMaybeList (Maybe (List Module)
librarySectionGeneratedOtherModules Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> Maybe (List Module)
librarySectionGeneratedExposedModules)
, libraryReexportedModules :: [[Char]]
libraryReexportedModules = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
librarySectionReexportedModules
, librarySignatures :: [[Char]]
librarySignatures = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
librarySectionSignatures
}
getMentionedExecutableModules :: ExecutableSection -> [Module]
getMentionedExecutableModules :: ExecutableSection -> [Module]
getMentionedExecutableModules (ExecutableSection (Alias (Last Maybe [Char]
main)) Maybe (List Module)
otherModules Maybe (List Module)
generatedModules)=
([Module] -> [Module])
-> (Module -> [Module] -> [Module])
-> Maybe Module
-> [Module]
-> [Module]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Module] -> [Module]
forall a. a -> a
id (:) (Path -> Module
toModule (Path -> Module) -> ([Char] -> Path) -> [Char] -> Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Path
Path.fromFilePath ([Char] -> Module) -> Maybe [Char] -> Maybe Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
main) ([Module] -> [Module]) -> [Module] -> [Module]
forall a b. (a -> b) -> a -> b
$ Maybe (List Module) -> [Module]
forall a. Maybe (List a) -> [a]
fromMaybeList (Maybe (List Module)
otherModules Maybe (List Module) -> Maybe (List Module) -> Maybe (List Module)
forall a. Semigroup a => a -> a -> a
<> Maybe (List Module)
generatedModules)
toExecutable :: FilePath -> String -> Section ExecutableSection -> IO (Section Executable)
toExecutable :: [Char]
-> [Char] -> Section ExecutableSection -> IO (Section Executable)
toExecutable [Char]
dir [Char]
packageName_ =
[Char]
-> [Char]
-> (ExecutableSection -> [Module])
-> (Executable -> [Module])
-> ([Module] -> [Module] -> ExecutableSection -> Executable)
-> ([Module] -> ExecutableSection -> Executable)
-> Section ExecutableSection
-> IO (Section Executable)
forall a b.
[Char]
-> [Char]
-> (a -> [Module])
-> (b -> [Module])
-> ([Module] -> [Module] -> a -> b)
-> ([Module] -> a -> b)
-> Section a
-> IO (Section b)
inferModules [Char]
dir [Char]
packageName_ ExecutableSection -> [Module]
getMentionedExecutableModules Executable -> [Module]
getExecutableModules [Module] -> [Module] -> ExecutableSection -> Executable
fromExecutableSection ([Module] -> [Module] -> ExecutableSection -> Executable
fromExecutableSection [])
(Section ExecutableSection -> 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 (List Module)
Alias 'True "main-is" (Last [Char])
executableSectionMain :: ExecutableSection -> Alias 'True "main-is" (Last [Char])
executableSectionOtherModules :: ExecutableSection -> Maybe (List Module)
executableSectionGeneratedOtherModules :: ExecutableSection -> Maybe (List Module)
executableSectionMain :: Alias 'True "main-is" (Last [Char])
executableSectionOtherModules :: Maybe (List Module)
executableSectionGeneratedOtherModules :: Maybe (List Module)
..} =
(Maybe [Char] -> [Module] -> [Module] -> Executable
Executable (Last [Char] -> Maybe [Char]
forall a. Last a -> Maybe a
getLast (Last [Char] -> Maybe [Char]) -> Last [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Alias 'True "main-is" (Last [Char]) -> Last [Char]
forall (deprecated :: Bool) (alias :: Symbol) a.
Alias deprecated alias a -> a
unAlias Alias 'True "main-is" (Last [Char])
executableSectionMain) ([Module]
otherModules [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ [Module]
generatedModules) [Module]
generatedModules)
where
otherModules :: [Module]
otherModules = [Module]
-> (List Module -> [Module]) -> Maybe (List Module) -> [Module]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Module]
inferableModules [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
++ [Module]
pathsModule) List Module -> [Module]
forall a. List a -> [a]
fromList Maybe (List Module)
executableSectionOtherModules
generatedModules :: [Module]
generatedModules = [Module]
-> (List Module -> [Module]) -> Maybe (List Module) -> [Module]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] List Module -> [Module]
forall a. List a -> [a]
fromList Maybe (List Module)
executableSectionGeneratedOtherModules
expandMain :: Section ExecutableSection -> Section ExecutableSection
expandMain :: Section ExecutableSection -> Section ExecutableSection
expandMain = Section ([[Char]], ExecutableSection) -> Section ExecutableSection
flatten (Section ([[Char]], ExecutableSection)
-> Section ExecutableSection)
-> (Section ExecutableSection
-> Section ([[Char]], ExecutableSection))
-> Section ExecutableSection
-> Section ExecutableSection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section ExecutableSection -> Section ([[Char]], ExecutableSection)
expand
where
expand :: Section ExecutableSection -> Section ([GhcOption], ExecutableSection)
expand :: Section ExecutableSection -> Section ([[Char]], ExecutableSection)
expand = (ExecutableSection -> ([[Char]], ExecutableSection))
-> Section ExecutableSection
-> Section ([[Char]], ExecutableSection)
forall a b. (a -> b) -> Section a -> Section b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExecutableSection -> ([[Char]], ExecutableSection)
go
where
go :: ExecutableSection -> ([[Char]], ExecutableSection)
go exec :: ExecutableSection
exec@ExecutableSection{Maybe (List Module)
Alias 'True "main-is" (Last [Char])
executableSectionMain :: ExecutableSection -> Alias 'True "main-is" (Last [Char])
executableSectionOtherModules :: ExecutableSection -> Maybe (List Module)
executableSectionGeneratedOtherModules :: ExecutableSection -> Maybe (List Module)
executableSectionMain :: Alias 'True "main-is" (Last [Char])
executableSectionOtherModules :: Maybe (List Module)
executableSectionGeneratedOtherModules :: Maybe (List Module)
..} =
let
(Maybe [Char]
mainSrcFile, [[Char]]
ghcOptions) = (Maybe [Char], [[Char]])
-> ([Char] -> (Maybe [Char], [[Char]]))
-> Maybe [Char]
-> (Maybe [Char], [[Char]])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe [Char]
forall a. Maybe a
Nothing, []) (([Char] -> Maybe [Char])
-> ([Char], [[Char]]) -> (Maybe [Char], [[Char]])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (([Char], [[Char]]) -> (Maybe [Char], [[Char]]))
-> ([Char] -> ([Char], [[Char]]))
-> [Char]
-> (Maybe [Char], [[Char]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ([Char], [[Char]])
parseMain) (Last [Char] -> Maybe [Char]
forall a. Last a -> Maybe a
getLast (Last [Char] -> Maybe [Char]) -> Last [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Alias 'True "main-is" (Last [Char]) -> Last [Char]
forall (deprecated :: Bool) (alias :: Symbol) a.
Alias deprecated alias a -> a
unAlias Alias 'True "main-is" (Last [Char])
executableSectionMain)
in
([[Char]]
ghcOptions, ExecutableSection
exec{executableSectionMain :: Alias 'True "main-is" (Last [Char])
executableSectionMain = Last [Char] -> Alias 'True "main-is" (Last [Char])
forall (deprecated :: Bool) (alias :: Symbol) a.
a -> Alias deprecated alias a
Alias (Last [Char] -> Alias 'True "main-is" (Last [Char]))
-> Last [Char] -> Alias 'True "main-is" (Last [Char])
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> Last [Char]
forall a. Maybe a -> Last a
Last Maybe [Char]
mainSrcFile})
flatten :: Section ([GhcOption], ExecutableSection) -> Section ExecutableSection
flatten :: Section ([[Char]], ExecutableSection) -> Section ExecutableSection
flatten sect :: Section ([[Char]], ExecutableSection)
sect@Section{sectionData :: forall a. Section a -> a
sectionData = ([[Char]]
ghcOptions, ExecutableSection
exec), [[Char]]
[Path]
[Conditional (Section ([[Char]], ExecutableSection))]
[Verbatim]
Maybe Bool
Maybe Language
Map BuildTool DependencyVersion
Dependencies
SystemBuildTools
sectionSourceDirs :: forall a. Section a -> [[Char]]
sectionDependencies :: forall a. Section a -> Dependencies
sectionPkgConfigDependencies :: forall a. Section a -> [[Char]]
sectionDefaultExtensions :: forall a. Section a -> [[Char]]
sectionOtherExtensions :: forall a. Section a -> [[Char]]
sectionLanguage :: forall a. Section a -> Maybe Language
sectionGhcOptions :: forall a. Section a -> [[Char]]
sectionGhcProfOptions :: forall a. Section a -> [[Char]]
sectionGhcSharedOptions :: forall a. Section a -> [[Char]]
sectionGhcjsOptions :: forall a. Section a -> [[Char]]
sectionCppOptions :: forall a. Section a -> [[Char]]
sectionCcOptions :: forall a. Section a -> [[Char]]
sectionCSources :: forall a. Section a -> [Path]
sectionCxxOptions :: forall a. Section a -> [[Char]]
sectionCxxSources :: forall a. Section a -> [Path]
sectionJsSources :: forall a. Section a -> [Path]
sectionExtraLibDirs :: forall a. Section a -> [[Char]]
sectionExtraLibraries :: forall a. Section a -> [[Char]]
sectionExtraFrameworksDirs :: forall a. Section a -> [[Char]]
sectionFrameworks :: forall a. Section a -> [[Char]]
sectionIncludeDirs :: forall a. Section a -> [[Char]]
sectionInstallIncludes :: forall a. Section a -> [[Char]]
sectionLdOptions :: forall a. Section a -> [[Char]]
sectionBuildable :: forall a. Section a -> Maybe Bool
sectionConditionals :: forall a. Section a -> [Conditional (Section a)]
sectionBuildTools :: forall a. Section a -> Map BuildTool DependencyVersion
sectionSystemBuildTools :: forall a. Section a -> SystemBuildTools
sectionVerbatim :: forall a. Section a -> [Verbatim]
sectionSourceDirs :: [[Char]]
sectionDependencies :: Dependencies
sectionPkgConfigDependencies :: [[Char]]
sectionDefaultExtensions :: [[Char]]
sectionOtherExtensions :: [[Char]]
sectionLanguage :: Maybe Language
sectionGhcOptions :: [[Char]]
sectionGhcProfOptions :: [[Char]]
sectionGhcSharedOptions :: [[Char]]
sectionGhcjsOptions :: [[Char]]
sectionCppOptions :: [[Char]]
sectionCcOptions :: [[Char]]
sectionCSources :: [Path]
sectionCxxOptions :: [[Char]]
sectionCxxSources :: [Path]
sectionJsSources :: [Path]
sectionExtraLibDirs :: [[Char]]
sectionExtraLibraries :: [[Char]]
sectionExtraFrameworksDirs :: [[Char]]
sectionFrameworks :: [[Char]]
sectionIncludeDirs :: [[Char]]
sectionInstallIncludes :: [[Char]]
sectionLdOptions :: [[Char]]
sectionBuildable :: Maybe Bool
sectionConditionals :: [Conditional (Section ([[Char]], ExecutableSection))]
sectionBuildTools :: Map BuildTool DependencyVersion
sectionSystemBuildTools :: SystemBuildTools
sectionVerbatim :: [Verbatim]
..} = Section ([[Char]], ExecutableSection)
sect{
sectionData :: ExecutableSection
sectionData = ExecutableSection
exec
, sectionGhcOptions :: [[Char]]
sectionGhcOptions = [[Char]]
sectionGhcOptions [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
ghcOptions
, sectionConditionals :: [Conditional (Section ExecutableSection)]
sectionConditionals = (Conditional (Section ([[Char]], ExecutableSection))
-> Conditional (Section ExecutableSection))
-> [Conditional (Section ([[Char]], ExecutableSection))]
-> [Conditional (Section ExecutableSection)]
forall a b. (a -> b) -> [a] -> [b]
map ((Section ([[Char]], ExecutableSection)
-> Section ExecutableSection)
-> Conditional (Section ([[Char]], ExecutableSection))
-> Conditional (Section ExecutableSection)
forall a b. (a -> b) -> Conditional a -> Conditional b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Section ([[Char]], ExecutableSection) -> Section ExecutableSection
flatten) [Conditional (Section ([[Char]], ExecutableSection))]
sectionConditionals
}
toSection :: Monad m => String -> [String] -> WithCommonOptions CSources CxxSources JsSources a -> Warnings m (Section a)
toSection :: forall (m :: * -> *) a.
Monad m =>
[Char]
-> [[Char]]
-> WithCommonOptions [Path] [Path] [Path] a
-> Warnings m (Section a)
toSection [Char]
packageName_ [[Char]]
executableNames = Product (CommonOptions [Path] [Path] [Path] a) a
-> WriterT [[Char]] m (Section a)
forall {m :: * -> *} {a}.
Monad m =>
Product (CommonOptions [Path] [Path] [Path] a) a
-> WriterT [[Char]] m (Section a)
go
where
go :: Product (CommonOptions [Path] [Path] [Path] a) a
-> WriterT [[Char]] m (Section a)
go (Product CommonOptions{[Path]
ParseCSources
Maybe (List (ConditionalSection [Path] [Path] [Path] a))
Maybe (List Verbatim)
Maybe SystemBuildTools
Last Bool
Alias 'False "pkgconfig-depends" ParseCSources
Alias 'True "hs-source-dirs" ParseCSources
Alias 'True "build-depends" (Maybe Dependencies)
Alias 'True "default-language" (Last (Maybe Language))
Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsSourceDirs :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "hs-source-dirs" ParseCSources
commonOptionsDependencies :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsPkgConfigDependencies :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'False "pkgconfig-depends" ParseCSources
commonOptionsDefaultExtensions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsOtherExtensions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsLanguage :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "default-language" (Last (Maybe Language))
commonOptionsGhcOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcProfOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcSharedOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsGhcjsOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsCppOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsCcOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsCSources :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> cSources
commonOptionsCxxOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsCxxSources :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> cxxSources
commonOptionsJsSources :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> jsSources
commonOptionsExtraLibDirs :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsExtraLibraries :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsExtraFrameworksDirs :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsFrameworks :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsIncludeDirs :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsInstallIncludes :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsLdOptions :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> ParseCSources
commonOptionsBuildable :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a -> Last Bool
commonOptionsWhen :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe
(List (ConditionalSection cSources cxxSources jsSources a))
commonOptionsBuildTools :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsSystemBuildTools :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe SystemBuildTools
commonOptionsVerbatim :: forall cSources cxxSources jsSources a.
CommonOptions cSources cxxSources jsSources a
-> Maybe (List Verbatim)
commonOptionsSourceDirs :: Alias 'True "hs-source-dirs" ParseCSources
commonOptionsDependencies :: Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsPkgConfigDependencies :: Alias 'False "pkgconfig-depends" ParseCSources
commonOptionsDefaultExtensions :: ParseCSources
commonOptionsOtherExtensions :: ParseCSources
commonOptionsLanguage :: Alias 'True "default-language" (Last (Maybe Language))
commonOptionsGhcOptions :: ParseCSources
commonOptionsGhcProfOptions :: ParseCSources
commonOptionsGhcSharedOptions :: ParseCSources
commonOptionsGhcjsOptions :: ParseCSources
commonOptionsCppOptions :: ParseCSources
commonOptionsCcOptions :: ParseCSources
commonOptionsCSources :: [Path]
commonOptionsCxxOptions :: ParseCSources
commonOptionsCxxSources :: [Path]
commonOptionsJsSources :: [Path]
commonOptionsExtraLibDirs :: ParseCSources
commonOptionsExtraLibraries :: ParseCSources
commonOptionsExtraFrameworksDirs :: ParseCSources
commonOptionsFrameworks :: ParseCSources
commonOptionsIncludeDirs :: ParseCSources
commonOptionsInstallIncludes :: ParseCSources
commonOptionsLdOptions :: ParseCSources
commonOptionsBuildable :: Last Bool
commonOptionsWhen :: Maybe (List (ConditionalSection [Path] [Path] [Path] a))
commonOptionsBuildTools :: Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsSystemBuildTools :: Maybe SystemBuildTools
commonOptionsVerbatim :: Maybe (List Verbatim)
..} a
a) = do
(SystemBuildTools
systemBuildTools, Map BuildTool DependencyVersion
buildTools) <- WriterT
[[Char]] m (SystemBuildTools, Map BuildTool DependencyVersion)
-> (BuildTools
-> WriterT
[[Char]] m (SystemBuildTools, Map BuildTool DependencyVersion))
-> Maybe BuildTools
-> WriterT
[[Char]] m (SystemBuildTools, Map BuildTool DependencyVersion)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((SystemBuildTools, Map BuildTool DependencyVersion)
-> WriterT
[[Char]] m (SystemBuildTools, Map BuildTool DependencyVersion)
forall a. a -> WriterT [[Char]] m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SystemBuildTools, Map BuildTool DependencyVersion)
forall a. Monoid a => a
mempty) BuildTools
-> WriterT
[[Char]] m (SystemBuildTools, Map BuildTool DependencyVersion)
forall (m :: * -> *).
Monad m =>
BuildTools
-> Warnings m (SystemBuildTools, Map BuildTool DependencyVersion)
toBuildTools (Alias 'True "build-tool-depends" (Maybe BuildTools)
-> Maybe BuildTools
forall (deprecated :: Bool) (alias :: Symbol) a.
Alias deprecated alias a -> a
unAlias Alias 'True "build-tool-depends" (Maybe BuildTools)
commonOptionsBuildTools)
[Conditional (Section a)]
conditionals <- (ConditionalSection [Path] [Path] [Path] a
-> WriterT [[Char]] m (Conditional (Section a)))
-> [ConditionalSection [Path] [Path] [Path] a]
-> WriterT [[Char]] m [Conditional (Section a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ConditionalSection [Path] [Path] [Path] a
-> WriterT [[Char]] 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 [[Char]] m (Section a)
forall a. a -> WriterT [[Char]] m a
forall (m :: * -> *) a. Monad m => a -> m a
return Section {
sectionData :: a
sectionData = a
a
, sectionSourceDirs :: [[Char]]
sectionSourceDirs = [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList (Alias 'True "hs-source-dirs" ParseCSources -> ParseCSources
forall (deprecated :: Bool) (alias :: Symbol) a.
Alias deprecated alias a -> a
unAlias Alias 'True "hs-source-dirs" ParseCSources
commonOptionsSourceDirs)
, sectionDependencies :: Dependencies
sectionDependencies = Dependencies -> Maybe Dependencies -> Dependencies
forall a. a -> Maybe a -> a
fromMaybe Dependencies
forall a. Monoid a => a
mempty (Alias 'True "build-depends" (Maybe Dependencies)
-> Maybe Dependencies
forall (deprecated :: Bool) (alias :: Symbol) a.
Alias deprecated alias a -> a
unAlias Alias 'True "build-depends" (Maybe Dependencies)
commonOptionsDependencies)
, sectionPkgConfigDependencies :: [[Char]]
sectionPkgConfigDependencies = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList (Alias 'False "pkgconfig-depends" ParseCSources -> ParseCSources
forall (deprecated :: Bool) (alias :: Symbol) a.
Alias deprecated alias a -> a
unAlias Alias 'False "pkgconfig-depends" ParseCSources
commonOptionsPkgConfigDependencies)
, sectionDefaultExtensions :: [[Char]]
sectionDefaultExtensions = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
commonOptionsDefaultExtensions
, sectionOtherExtensions :: [[Char]]
sectionOtherExtensions = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
commonOptionsOtherExtensions
, sectionLanguage :: Maybe Language
sectionLanguage = Maybe (Maybe Language) -> Maybe Language
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Language) -> Maybe Language)
-> (Last (Maybe Language) -> Maybe (Maybe Language))
-> Last (Maybe Language)
-> Maybe Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last (Maybe Language) -> Maybe (Maybe Language)
forall a. Last a -> Maybe a
getLast (Last (Maybe Language) -> Maybe Language)
-> Last (Maybe Language) -> Maybe Language
forall a b. (a -> b) -> a -> b
$ Alias 'True "default-language" (Last (Maybe Language))
-> Last (Maybe Language)
forall (deprecated :: Bool) (alias :: Symbol) a.
Alias deprecated alias a -> a
unAlias Alias 'True "default-language" (Last (Maybe Language))
commonOptionsLanguage
, sectionGhcOptions :: [[Char]]
sectionGhcOptions = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
commonOptionsGhcOptions
, sectionGhcProfOptions :: [[Char]]
sectionGhcProfOptions = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
commonOptionsGhcProfOptions
, sectionGhcSharedOptions :: [[Char]]
sectionGhcSharedOptions = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
commonOptionsGhcSharedOptions
, sectionGhcjsOptions :: [[Char]]
sectionGhcjsOptions = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
commonOptionsGhcjsOptions
, sectionCppOptions :: [[Char]]
sectionCppOptions = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
commonOptionsCppOptions
, sectionCcOptions :: [[Char]]
sectionCcOptions = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
commonOptionsCcOptions
, sectionCSources :: [Path]
sectionCSources = [Path]
commonOptionsCSources
, sectionCxxOptions :: [[Char]]
sectionCxxOptions = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
commonOptionsCxxOptions
, sectionCxxSources :: [Path]
sectionCxxSources = [Path]
commonOptionsCxxSources
, sectionJsSources :: [Path]
sectionJsSources = [Path]
commonOptionsJsSources
, sectionExtraLibDirs :: [[Char]]
sectionExtraLibDirs = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
commonOptionsExtraLibDirs
, sectionExtraLibraries :: [[Char]]
sectionExtraLibraries = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
commonOptionsExtraLibraries
, sectionExtraFrameworksDirs :: [[Char]]
sectionExtraFrameworksDirs = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
commonOptionsExtraFrameworksDirs
, sectionFrameworks :: [[Char]]
sectionFrameworks = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
commonOptionsFrameworks
, sectionIncludeDirs :: [[Char]]
sectionIncludeDirs = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
commonOptionsIncludeDirs
, sectionInstallIncludes :: [[Char]]
sectionInstallIncludes = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
commonOptionsInstallIncludes
, sectionLdOptions :: [[Char]]
sectionLdOptions = ParseCSources -> [[Char]]
forall a. Maybe (List a) -> [a]
fromMaybeList ParseCSources
commonOptionsLdOptions
, sectionBuildable :: Maybe Bool
sectionBuildable = Last Bool -> Maybe Bool
forall a. Last a -> Maybe a
getLast Last Bool
commonOptionsBuildable
, sectionConditionals :: [Conditional (Section a)]
sectionConditionals = [Conditional (Section a)]
conditionals
, sectionBuildTools :: Map BuildTool DependencyVersion
sectionBuildTools = Map BuildTool DependencyVersion
buildTools
, sectionSystemBuildTools :: SystemBuildTools
sectionSystemBuildTools = SystemBuildTools
systemBuildTools SystemBuildTools -> SystemBuildTools -> SystemBuildTools
forall a. Semigroup a => a -> a -> a
<> SystemBuildTools -> Maybe SystemBuildTools -> SystemBuildTools
forall a. a -> Maybe a -> a
fromMaybe SystemBuildTools
forall a. Monoid a => a
mempty Maybe SystemBuildTools
commonOptionsSystemBuildTools
, sectionVerbatim :: [Verbatim]
sectionVerbatim = Maybe (List Verbatim) -> [Verbatim]
forall a. Maybe (List a) -> [a]
fromMaybeList Maybe (List Verbatim)
commonOptionsVerbatim
}
toBuildTools :: Monad m => BuildTools -> Warnings m (SystemBuildTools, Map BuildTool DependencyVersion)
toBuildTools :: forall (m :: * -> *).
Monad m =>
BuildTools
-> Warnings m (SystemBuildTools, Map BuildTool DependencyVersion)
toBuildTools = ([Either SystemBuildTool (BuildTool, DependencyVersion)]
-> (SystemBuildTools, Map BuildTool DependencyVersion))
-> WriterT
[[Char]] m [Either SystemBuildTool (BuildTool, DependencyVersion)]
-> WriterT
[[Char]] m (SystemBuildTools, Map BuildTool DependencyVersion)
forall a b.
(a -> b) -> WriterT [[Char]] m a -> WriterT [[Char]] m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Either SystemBuildTool (BuildTool, DependencyVersion)]
-> SystemBuildTools
forall b. [Either SystemBuildTool b] -> SystemBuildTools
mkSystemBuildTools ([Either SystemBuildTool (BuildTool, DependencyVersion)]
-> SystemBuildTools)
-> ([Either SystemBuildTool (BuildTool, DependencyVersion)]
-> Map BuildTool DependencyVersion)
-> [Either SystemBuildTool (BuildTool, DependencyVersion)]
-> (SystemBuildTools, Map BuildTool DependencyVersion)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [Either SystemBuildTool (BuildTool, DependencyVersion)]
-> Map BuildTool DependencyVersion
forall {a} {a}. [Either a (BuildTool, a)] -> Map BuildTool a
mkBuildTools) (WriterT
[[Char]] m [Either SystemBuildTool (BuildTool, DependencyVersion)]
-> WriterT
[[Char]] m (SystemBuildTools, Map BuildTool DependencyVersion))
-> (BuildTools
-> WriterT
[[Char]] m [Either SystemBuildTool (BuildTool, DependencyVersion)])
-> BuildTools
-> WriterT
[[Char]] m (SystemBuildTools, Map BuildTool DependencyVersion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ParseBuildTool, DependencyVersion)
-> WriterT
[[Char]] m (Either SystemBuildTool (BuildTool, DependencyVersion)))
-> [(ParseBuildTool, DependencyVersion)]
-> WriterT
[[Char]] m [Either SystemBuildTool (BuildTool, DependencyVersion)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Char]
-> [[Char]]
-> (ParseBuildTool, DependencyVersion)
-> WriterT
[[Char]] m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall (m :: * -> *).
Monad m =>
[Char]
-> [[Char]]
-> (ParseBuildTool, DependencyVersion)
-> Warnings
m (Either SystemBuildTool (BuildTool, DependencyVersion))
toBuildTool [Char]
packageName_ [[Char]]
executableNames)([(ParseBuildTool, DependencyVersion)]
-> WriterT
[[Char]] m [Either SystemBuildTool (BuildTool, DependencyVersion)])
-> (BuildTools -> [(ParseBuildTool, DependencyVersion)])
-> BuildTools
-> WriterT
[[Char]] m [Either SystemBuildTool (BuildTool, DependencyVersion)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildTools -> [(ParseBuildTool, DependencyVersion)]
unBuildTools
where
mkSystemBuildTools :: [Either (String, VersionConstraint) b] -> SystemBuildTools
mkSystemBuildTools :: forall b. [Either SystemBuildTool b] -> SystemBuildTools
mkSystemBuildTools = Map [Char] VersionConstraint -> SystemBuildTools
SystemBuildTools (Map [Char] VersionConstraint -> SystemBuildTools)
-> ([Either SystemBuildTool b] -> Map [Char] VersionConstraint)
-> [Either SystemBuildTool b]
-> SystemBuildTools
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SystemBuildTool] -> Map [Char] VersionConstraint
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([SystemBuildTool] -> Map [Char] VersionConstraint)
-> ([Either SystemBuildTool b] -> [SystemBuildTool])
-> [Either SystemBuildTool b]
-> Map [Char] VersionConstraint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either SystemBuildTool b] -> [SystemBuildTool]
forall a b. [Either a b] -> [a]
lefts
mkBuildTools :: [Either a (BuildTool, a)] -> Map BuildTool a
mkBuildTools = [(BuildTool, a)] -> Map BuildTool a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(BuildTool, a)] -> Map BuildTool a)
-> ([Either a (BuildTool, a)] -> [(BuildTool, a)])
-> [Either a (BuildTool, a)]
-> Map BuildTool a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either a (BuildTool, a)] -> [(BuildTool, a)]
forall a b. [Either a b] -> [b]
rights
toConditional :: Monad m => ConditionalSection CSources CxxSources JsSources a -> Warnings m (Conditional (Section a))
toConditional :: forall (m :: * -> *) a.
Monad m =>
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 [[Char]] m (Section a)
-> WriterT
[[Char]] 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 [[Char]] m (Section a)
forall {m :: * -> *} {a}.
Monad m =>
Product (CommonOptions [Path] [Path] [Path] a) a
-> WriterT [[Char]] m (Section a)
go WithCommonOptions [Path] [Path] [Path] a
then_ WriterT [[Char]] m (Maybe (Section a) -> Conditional (Section a))
-> WriterT [[Char]] m (Maybe (Section a))
-> Warnings m (Conditional (Section a))
forall a b.
WriterT [[Char]] m (a -> b)
-> WriterT [[Char]] m a -> WriterT [[Char]] m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Section a -> Maybe (Section a)
forall a. a -> Maybe a
Just (Section a -> Maybe (Section a))
-> WriterT [[Char]] m (Section a)
-> WriterT [[Char]] m (Maybe (Section a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithCommonOptions [Path] [Path] [Path] a
-> WriterT [[Char]] m (Section a)
forall {m :: * -> *} {a}.
Monad m =>
Product (CommonOptions [Path] [Path] [Path] a) a
-> WriterT [[Char]] 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 [[Char]] m (Section a)
-> WriterT
[[Char]] 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 [[Char]] m (Section a)
forall {m :: * -> *} {a}.
Monad m =>
Product (CommonOptions [Path] [Path] [Path] a) a
-> WriterT [[Char]] m (Section a)
go WithCommonOptions [Path] [Path] [Path] a
sect) WriterT [[Char]] m (Maybe (Section a) -> Conditional (Section a))
-> WriterT [[Char]] m (Maybe (Section a))
-> Warnings m (Conditional (Section a))
forall a b.
WriterT [[Char]] m (a -> b)
-> WriterT [[Char]] m a -> WriterT [[Char]] m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Section a) -> WriterT [[Char]] m (Maybe (Section a))
forall a. a -> WriterT [[Char]] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Section a)
forall a. Maybe a
Nothing
where
conditional :: Condition -> a -> Maybe a -> Conditional a
conditional = Cond -> a -> Maybe a -> Conditional a
forall a. Cond -> a -> Maybe a -> Conditional a
Conditional (Cond -> a -> Maybe a -> Conditional a)
-> (Condition -> Cond)
-> Condition
-> a
-> Maybe a
-> Conditional a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Condition -> Cond
conditionCondition
type SystemBuildTool = (String, VersionConstraint)
toBuildTool :: Monad m => String -> [String] -> (ParseBuildTool, DependencyVersion)
-> Warnings m (Either SystemBuildTool (BuildTool, DependencyVersion))
toBuildTool :: forall (m :: * -> *).
Monad m =>
[Char]
-> [[Char]]
-> (ParseBuildTool, DependencyVersion)
-> Warnings
m (Either SystemBuildTool (BuildTool, DependencyVersion))
toBuildTool [Char]
packageName_ [[Char]]
executableNames = \ case
(QualifiedBuildTool [Char]
pkg [Char]
executable, DependencyVersion
v)
| [Char]
pkg [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
packageName_ Bool -> Bool -> Bool
&& [Char]
executable [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
executableNames -> [Char]
-> DependencyVersion
-> Warnings
m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall {m :: * -> *} {b} {a}.
Monad m =>
[Char] -> b -> m (Either a (BuildTool, b))
localBuildTool [Char]
executable DependencyVersion
v
| Bool
otherwise -> [Char]
-> [Char]
-> DependencyVersion
-> Warnings
m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall {m :: * -> *} {b} {a}.
Monad m =>
[Char] -> [Char] -> b -> m (Either a (BuildTool, b))
buildTool [Char]
pkg [Char]
executable DependencyVersion
v
(UnqualifiedBuildTool [Char]
executable, DependencyVersion
v)
| [Char]
executable [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
executableNames -> [Char]
-> DependencyVersion
-> Warnings
m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall {m :: * -> *} {b} {a}.
Monad m =>
[Char] -> b -> m (Either a (BuildTool, b))
localBuildTool [Char]
executable DependencyVersion
v
| Just [Char]
pkg <- [Char] -> [([Char], [Char])] -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
executable [([Char], [Char])]
legacyTools -> [Char]
-> [Char]
-> DependencyVersion
-> Warnings
m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall {m :: * -> *} {b} {a}.
Monad m =>
[Char]
-> [Char] -> b -> WriterT [[Char]] m (Either a (BuildTool, b))
legacyBuildTool [Char]
pkg [Char]
executable DependencyVersion
v
| [Char]
executable [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
legacySystemTools, DependencyVersion Maybe SourceDependency
Nothing VersionConstraint
c <- DependencyVersion
v -> [Char]
-> VersionConstraint
-> Warnings
m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall {a} {b} {b}.
Show a =>
a -> b -> WriterT [[Char]] m (Either (a, b) b)
legacySystemBuildTool [Char]
executable VersionConstraint
c
| Bool
otherwise -> [Char]
-> [Char]
-> DependencyVersion
-> Warnings
m (Either SystemBuildTool (BuildTool, DependencyVersion))
forall {m :: * -> *} {b} {a}.
Monad m =>
[Char] -> [Char] -> b -> m (Either a (BuildTool, b))
buildTool [Char]
executable [Char]
executable DependencyVersion
v
where
buildTool :: [Char] -> [Char] -> b -> m (Either a (BuildTool, b))
buildTool [Char]
pkg [Char]
executable b
v = Either a (BuildTool, b) -> m (Either a (BuildTool, b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (BuildTool, b) -> m (Either a (BuildTool, b)))
-> ((BuildTool, b) -> Either a (BuildTool, b))
-> (BuildTool, b)
-> m (Either a (BuildTool, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuildTool, b) -> Either a (BuildTool, b)
forall a b. b -> Either a b
Right ((BuildTool, b) -> m (Either a (BuildTool, b)))
-> (BuildTool, b) -> m (Either a (BuildTool, b))
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char] -> BuildTool
BuildTool [Char]
pkg [Char]
executable, b
v)
systemBuildTool :: a -> WriterT [[Char]] m (Either a b)
systemBuildTool = Either a b -> WriterT [[Char]] m (Either a b)
forall a. a -> WriterT [[Char]] m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> WriterT [[Char]] m (Either a b))
-> (a -> Either a b) -> a -> WriterT [[Char]] m (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left
localBuildTool :: [Char] -> b -> m (Either a (BuildTool, b))
localBuildTool [Char]
executable b
v = Either a (BuildTool, b) -> m (Either a (BuildTool, b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (BuildTool, b) -> m (Either a (BuildTool, b)))
-> ((BuildTool, b) -> Either a (BuildTool, b))
-> (BuildTool, b)
-> m (Either a (BuildTool, b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuildTool, b) -> Either a (BuildTool, b)
forall a b. b -> Either a b
Right ((BuildTool, b) -> m (Either a (BuildTool, b)))
-> (BuildTool, b) -> m (Either a (BuildTool, b))
forall a b. (a -> b) -> a -> b
$ ([Char] -> BuildTool
LocalBuildTool [Char]
executable, b
v)
legacyBuildTool :: [Char]
-> [Char] -> b -> WriterT [[Char]] m (Either a (BuildTool, b))
legacyBuildTool [Char]
pkg [Char]
executable b
v = [Char] -> [Char] -> WriterT [[Char]] m ()
forall {m :: * -> *}.
Monad m =>
[Char] -> [Char] -> WriterT [[Char]] m ()
warnLegacyTool [Char]
pkg [Char]
executable WriterT [[Char]] m ()
-> WriterT [[Char]] m (Either a (BuildTool, b))
-> WriterT [[Char]] m (Either a (BuildTool, b))
forall a b.
WriterT [[Char]] m a
-> WriterT [[Char]] m b -> WriterT [[Char]] m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char]
-> [Char] -> b -> WriterT [[Char]] m (Either a (BuildTool, b))
forall {m :: * -> *} {b} {a}.
Monad m =>
[Char] -> [Char] -> b -> m (Either a (BuildTool, b))
buildTool [Char]
pkg [Char]
executable b
v
legacySystemBuildTool :: a -> b -> WriterT [[Char]] m (Either (a, b) b)
legacySystemBuildTool a
executable b
c = a -> WriterT [[Char]] m ()
forall {m :: * -> *} {a}.
(Monad m, Show a) =>
a -> WriterT [[Char]] m ()
warnLegacySystemTool a
executable WriterT [[Char]] m ()
-> WriterT [[Char]] m (Either (a, b) b)
-> WriterT [[Char]] m (Either (a, b) b)
forall a b.
WriterT [[Char]] m a
-> WriterT [[Char]] m b -> WriterT [[Char]] m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a, b) -> WriterT [[Char]] m (Either (a, b) b)
forall {a} {b}. a -> WriterT [[Char]] m (Either a b)
systemBuildTool (a
executable, b
c)
legacyTools :: [([Char], [Char])]
legacyTools = [
([Char]
"gtk2hsTypeGen", [Char]
"gtk2hs-buildtools")
, ([Char]
"gtk2hsHookGenerator", [Char]
"gtk2hs-buildtools")
, ([Char]
"gtk2hsC2hs", [Char]
"gtk2hs-buildtools")
, ([Char]
"cabal", [Char]
"cabal-install")
, ([Char]
"grgen", [Char]
"cgen")
, ([Char]
"cgen-hs", [Char]
"cgen")
]
legacySystemTools :: [[Char]]
legacySystemTools = [
[Char]
"ghc"
, [Char]
"git"
, [Char]
"llvm-config"
, [Char]
"gfortran"
, [Char]
"gcc"
, [Char]
"couchdb"
, [Char]
"mcc"
, [Char]
"nix-store"
, [Char]
"nix-instantiate"
, [Char]
"nix-hash"
, [Char]
"nix-env"
, [Char]
"nix-build"
]
warnLegacyTool :: [Char] -> [Char] -> WriterT [[Char]] m ()
warnLegacyTool [Char]
pkg [Char]
name = [[Char]] -> WriterT [[Char]] m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [[Char]
"Usage of the unqualified build-tool name " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> [Char]
show [Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" is deprecated! Please use the qualified name \"" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
pkg [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\" instead!"]
warnLegacySystemTool :: a -> WriterT [[Char]] m ()
warnLegacySystemTool a
name = [[Char]] -> WriterT [[Char]] m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [[Char]
"Listing " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
name [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" under build-tools is deperecated! Please list system executables under system-build-tools instead!"]
pathsModuleFromPackageName :: String -> Module
pathsModuleFromPackageName :: [Char] -> Module
pathsModuleFromPackageName [Char]
name = [Char] -> Module
Module ([Char]
"Paths_" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f [Char]
name)
where
f :: Char -> Char
f Char
'-' = Char
'_'
f Char
x = Char
x