module Data.GI.CodeGen.CabalHooks
( setupBinding
, setupCompatWrapper
, configureDryRun
, TaggedOverride(..)
) where
import qualified Distribution.ModuleName as MN
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Setup
import Distribution.Simple (UserHooks(..), simpleUserHooks,
defaultMainWithHooks, OptimisationLevel(..))
import Distribution.PackageDescription
import Data.GI.CodeGen.API (loadGIRInfo)
import Data.GI.CodeGen.Code (genCode, writeModuleTree, listModuleTree,
ModuleInfo, transitiveModuleDeps)
import Data.GI.CodeGen.CodeGen (genModule)
import Data.GI.CodeGen.Config (Config(..))
import Data.GI.CodeGen.LibGIRepository (setupTypelibSearchPath)
import Data.GI.CodeGen.ModulePath (toModulePath)
import Data.GI.CodeGen.Overrides (parseOverrides, girFixups,
filterAPIsAndDeps)
import Data.GI.CodeGen.Util (utf8ReadFile, utf8WriteFile, ucFirst, splitOn)
import System.Directory (createDirectoryIfMissing)
import System.FilePath (joinPath, takeDirectory, (</>))
import Control.Monad (forM)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.Map as M
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
type ConfHook = (GenericPackageDescription, HookedBuildInfo) -> ConfigFlags
-> IO LocalBuildInfo
data TaggedOverride =
TaggedOverride { TaggedOverride -> Text
overrideTag :: Text
, TaggedOverride -> Text
overrideText :: Text
}
genModuleCode :: Text
-> Text
-> Text
-> Text
-> Bool
-> [TaggedOverride]
-> IO ModuleInfo
genModuleCode :: Text
-> Text
-> Text
-> Text
-> Bool
-> [TaggedOverride]
-> IO ModuleInfo
genModuleCode Text
name Text
version Text
pkgName Text
pkgVersion Bool
verbosity [TaggedOverride]
overrides = do
[String] -> IO ()
setupTypelibSearchPath []
[Overrides]
parsed <- [TaggedOverride]
-> (TaggedOverride -> IO Overrides) -> IO [Overrides]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [TaggedOverride]
overrides ((TaggedOverride -> IO Overrides) -> IO [Overrides])
-> (TaggedOverride -> IO Overrides) -> IO [Overrides]
forall a b. (a -> b) -> a -> b
$ \(TaggedOverride Text
tag Text
ovText) -> do
Text -> IO (Either Text Overrides)
parseOverrides Text
ovText IO (Either Text Overrides)
-> (Either Text Overrides -> IO Overrides) -> IO Overrides
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Text
err -> String -> IO Overrides
forall a. HasCallStack => String -> a
error (String -> IO Overrides) -> String -> IO Overrides
forall a b. (a -> b) -> a -> b
$ String
"Error when parsing overrides file \""
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
tag String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\":"
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
err
Right Overrides
ovs -> Overrides -> IO Overrides
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Overrides
ovs
let ovs :: Overrides
ovs = [Overrides] -> Overrides
forall a. Monoid a => [a] -> a
mconcat [Overrides]
parsed
(GIRInfo
gir, [GIRInfo]
girDeps) <- Bool
-> Text
-> Maybe Text
-> [String]
-> [GIRRule]
-> IO (GIRInfo, [GIRInfo])
loadGIRInfo Bool
verbosity Text
name (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
version) [] (Overrides -> [GIRRule]
girFixups Overrides
ovs)
let (Map Name API
apis, Map Name API
deps) = Overrides -> GIRInfo -> [GIRInfo] -> (Map Name API, Map Name API)
filterAPIsAndDeps Overrides
ovs GIRInfo
gir [GIRInfo]
girDeps
allAPIs :: Map Name API
allAPIs = Map Name API -> Map Name API -> Map Name API
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map Name API
apis Map Name API
deps
cfg :: Config
cfg = Config {modName :: Text
modName = Text
name,
modVersion :: Text
modVersion = Text
version,
ghcPkgName :: Text
ghcPkgName = Text
pkgName,
ghcPkgVersion :: Text
ghcPkgVersion = Text
pkgVersion,
verbose :: Bool
verbose = Bool
verbosity,
overrides :: Overrides
overrides = Overrides
ovs}
ModuleInfo -> IO ModuleInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleInfo -> IO ModuleInfo) -> ModuleInfo -> IO ModuleInfo
forall a b. (a -> b) -> a -> b
$ Config
-> Map Name API -> ModulePath -> CodeGen Any () -> ModuleInfo
forall e.
Config -> Map Name API -> ModulePath -> CodeGen e () -> ModuleInfo
genCode Config
cfg Map Name API
allAPIs (Text -> ModulePath
toModulePath Text
name) (Map Name API -> CodeGen Any ()
forall e. Map Name API -> CodeGen e ()
genModule Map Name API
apis)
genConfigModule :: Maybe FilePath -> Text -> Maybe TaggedOverride ->
[Text] -> IO ()
genConfigModule :: Maybe String -> Text -> Maybe TaggedOverride -> [Text] -> IO ()
genConfigModule Maybe String
outputDir Text
modName Maybe TaggedOverride
maybeGiven [Text]
modules = do
let fname :: String
fname = [String] -> String
joinPath [ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
outputDir
, String
"GI"
, Text -> String
T.unpack (Text -> Text
ucFirst Text
modName)
, String
"Config.hs" ]
dirname :: String
dirname = String -> String
takeDirectory String
fname
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dirname
String -> Text -> IO ()
utf8WriteFile String
fname (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
[ Text
"{-# LANGUAGE OverloadedStrings #-}"
, Text
"-- | Build time configuration used during code generation."
, Text
"module GI." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
ucFirst Text
modName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".Config ( overrides, modules ) where"
, Text
""
, Text
"import qualified Data.Text as T"
, Text
"import Data.Text (Text)"
, Text
""
, Text
"-- | Overrides used when generating these bindings."
, Text
"overrides :: Text"
, Text
"overrides = T.unlines"
, [Text] -> Text
formatList (Maybe TaggedOverride -> [Text]
overrides Maybe TaggedOverride
maybeGiven)
, Text
""
, Text
"-- | Modules in this package"
, Text
"modules :: [Text]"
, Text
"modules = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
[Text] -> Text
formatList ((Text
"GI." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
ucFirst Text
modName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".Config") Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
modules)
]
where overrides :: Maybe TaggedOverride -> [Text]
overrides :: Maybe TaggedOverride -> [Text]
overrides Maybe TaggedOverride
Nothing = []
overrides (Just (TaggedOverride Text
_ Text
ovText)) = Text -> [Text]
T.lines Text
ovText
formatList :: [Text] -> Text
formatList :: [Text] -> Text
formatList [Text]
l = Text
" [ "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"\n , " ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show) [Text]
l)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
confCodeGenHook :: Text
-> Text
-> Text
-> Text
-> Bool
-> Maybe FilePath
-> [TaggedOverride]
-> Maybe FilePath
-> ConfHook
-> ConfHook
confCodeGenHook :: Text
-> Text
-> Text
-> Text
-> Bool
-> Maybe String
-> [TaggedOverride]
-> Maybe String
-> ConfHook
-> ConfHook
confCodeGenHook Text
name Text
version Text
pkgName Text
pkgVersion Bool
verbosity
Maybe String
overridesFile [TaggedOverride]
inheritedOverrides Maybe String
outputDir
ConfHook
defaultConfHook (GenericPackageDescription
gpd, HookedBuildInfo
hbi) ConfigFlags
flags = do
Maybe TaggedOverride
givenOvs <- (String -> IO TaggedOverride)
-> Maybe String -> IO (Maybe TaggedOverride)
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 (\String
fname -> Text -> Text -> TaggedOverride
TaggedOverride (String -> Text
T.pack String
fname) (Text -> TaggedOverride) -> IO Text -> IO TaggedOverride
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
utf8ReadFile String
fname) Maybe String
overridesFile
let ovs :: [TaggedOverride]
ovs = [TaggedOverride]
-> (TaggedOverride -> [TaggedOverride])
-> Maybe TaggedOverride
-> [TaggedOverride]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [TaggedOverride]
inheritedOverrides (TaggedOverride -> [TaggedOverride] -> [TaggedOverride]
forall a. a -> [a] -> [a]
:[TaggedOverride]
inheritedOverrides) Maybe TaggedOverride
givenOvs
ModuleInfo
m <- Text
-> Text
-> Text
-> Text
-> Bool
-> [TaggedOverride]
-> IO ModuleInfo
genModuleCode Text
name Text
version Text
pkgName Text
pkgVersion Bool
verbosity [TaggedOverride]
ovs
let buildInfo :: ModuleName
buildInfo = String -> ModuleName
forall a. IsString a => String -> a
MN.fromString (String -> ModuleName) -> (Text -> String) -> Text -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ModuleName) -> Text -> ModuleName
forall a b. (a -> b) -> a -> b
$ Text
"GI." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
ucFirst Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".Config"
em' :: [ModuleName]
em' = ModuleName
buildInfo ModuleName -> [ModuleName] -> [ModuleName]
forall a. a -> [a] -> [a]
: (Text -> ModuleName) -> [Text] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ModuleName
forall a. IsString a => String -> a
MN.fromString (String -> ModuleName) -> (Text -> String) -> Text -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (ModuleInfo -> [Text]
listModuleTree ModuleInfo
m)
lib :: Library
lib = ((CondTree ConfVar [Dependency] Library -> Library
forall v c a. CondTree v c a -> a
condTreeData (CondTree ConfVar [Dependency] Library -> Library)
-> (GenericPackageDescription
-> CondTree ConfVar [Dependency] Library)
-> GenericPackageDescription
-> Library
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library)
-> (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library))
-> GenericPackageDescription
-> CondTree ConfVar [Dependency] Library
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary) GenericPackageDescription
gpd)
bi :: BuildInfo
bi = Library -> BuildInfo
libBuildInfo Library
lib
#if MIN_VERSION_base(4,11,0)
bi' :: BuildInfo
bi' = BuildInfo
bi {autogenModules = em'}
#else
bi' = bi
#endif
lib' :: Library
lib' = Library
lib {exposedModules = em', libBuildInfo = bi'}
cL' :: CondTree ConfVar [Dependency] Library
cL' = ((Maybe (CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library)
-> (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library))
-> GenericPackageDescription
-> CondTree ConfVar [Dependency] Library
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary) GenericPackageDescription
gpd) {condTreeData = lib'}
gpd' :: GenericPackageDescription
gpd' = GenericPackageDescription
gpd {condLibrary = Just cL'}
[Text]
modules <- Bool -> Maybe String -> ModuleInfo -> IO [Text]
writeModuleTree Bool
verbosity Maybe String
outputDir ModuleInfo
m
Maybe String -> Text -> Maybe TaggedOverride -> [Text] -> IO ()
genConfigModule Maybe String
outputDir Text
name Maybe TaggedOverride
givenOvs [Text]
modules
LocalBuildInfo
lbi <- ConfHook
defaultConfHook (GenericPackageDescription
gpd', HookedBuildInfo
hbi) ConfigFlags
flags
LocalBuildInfo -> IO LocalBuildInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalBuildInfo
lbi {withOptimization = NoOptimisation})
setupBinding :: Text
-> Text
-> Text
-> Text
-> Bool
-> Maybe FilePath
-> [TaggedOverride]
-> Maybe FilePath
-> IO ()
setupBinding :: Text
-> Text
-> Text
-> Text
-> Bool
-> Maybe String
-> [TaggedOverride]
-> Maybe String
-> IO ()
setupBinding Text
name Text
version Text
pkgName Text
pkgVersion Bool
verbose Maybe String
overridesFile [TaggedOverride]
overrides Maybe String
outputDir =
UserHooks -> IO ()
defaultMainWithHooks (UserHooks
simpleUserHooks {
confHook = confCodeGenHook name version
pkgName pkgVersion
verbose
overridesFile overrides outputDir
(confHook simpleUserHooks)
})
compatGenConfHook :: String
-> [Text]
-> ConfHook
-> ConfHook
compatGenConfHook :: String -> [Text] -> ConfHook -> ConfHook
compatGenConfHook String
newVersion [Text]
modules ConfHook
defaultConfHook (GenericPackageDescription
gpd, HookedBuildInfo
hbi) ConfigFlags
flags = do
let em' :: [ModuleName]
em' = (Text -> ModuleName) -> [Text] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ModuleName
forall a. IsString a => String -> a
MN.fromString (String -> ModuleName) -> (Text -> String) -> Text -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) [Text]
modules
lib :: Library
lib = ((CondTree ConfVar [Dependency] Library -> Library
forall v c a. CondTree v c a -> a
condTreeData (CondTree ConfVar [Dependency] Library -> Library)
-> (GenericPackageDescription
-> CondTree ConfVar [Dependency] Library)
-> GenericPackageDescription
-> Library
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library)
-> (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library))
-> GenericPackageDescription
-> CondTree ConfVar [Dependency] Library
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary) GenericPackageDescription
gpd)
bi :: BuildInfo
bi = Library -> BuildInfo
libBuildInfo Library
lib
#if MIN_VERSION_base(4,11,0)
bi' :: BuildInfo
bi' = BuildInfo
bi {autogenModules = em'}
#else
bi' = bi
#endif
lib' :: Library
lib' = Library
lib {exposedModules = em', libBuildInfo = bi'}
cL' :: CondTree ConfVar [Dependency] Library
cL' = ((Maybe (CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library)
-> (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library))
-> GenericPackageDescription
-> CondTree ConfVar [Dependency] Library
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary) GenericPackageDescription
gpd) {condTreeData = lib'}
gpd' :: GenericPackageDescription
gpd' = GenericPackageDescription
gpd {condLibrary = Just cL'}
(Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
writeCompatModule (String -> IO ()) -> (Text -> String) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) [Text]
modules
LocalBuildInfo
lbi <- ConfHook
defaultConfHook (GenericPackageDescription
gpd', HookedBuildInfo
hbi) ConfigFlags
flags
LocalBuildInfo -> IO LocalBuildInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalBuildInfo
lbi {withOptimization = NoOptimisation})
where
writeCompatModule :: String -> IO ()
writeCompatModule :: String -> IO ()
writeCompatModule String
modName = do
String
fname <- case [String] -> Maybe ([String], String)
forall a. [a] -> Maybe ([a], a)
unsnoc (Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
splitOn Char
'.' String
modName) of
Maybe ([String], String)
Nothing -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
modName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".hs"
Just ([], String
last) -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
last String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".hs"
Just ([String]
init, String
last) -> let path :: String
path = [String] -> String
joinPath [String]
init
in do
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
path
String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
path String -> String -> String
</> (String
last String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".hs")
String -> Text -> IO ()
utf8WriteFile String
fname Text
modContents
where modContents :: Text
modContents :: Text
modContents = let
mod :: Text
mod = String -> Text
T.pack String
modName
link :: Text
link = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
newVersion
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"](https://hackage.haskell.org/package/"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
newVersion Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
in [Text] -> Text
T.unlines [
Text
"{-# LANGUAGE PackageImports #-}"
, Text
"{- | This is a backwards-compatibility module re-exporting the contents of the "
, Text
mod Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" module in the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
link Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" package."
, Text
""
, Text
"The link below will take you to the relevant entry in the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
link Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" documentation."
, Text
"-}"
, Text
"module " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mod Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
, Text
" module X) where"
, Text
""
, Text
"import \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
newVersion Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mod Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" as X"
]
unsnoc :: [a] -> Maybe ([a], a)
unsnoc :: forall a. [a] -> Maybe ([a], a)
unsnoc = (a -> Maybe ([a], a) -> Maybe ([a], a))
-> Maybe ([a], a) -> [a] -> Maybe ([a], a)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x -> ([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just (([a], a) -> Maybe ([a], a))
-> (Maybe ([a], a) -> ([a], a)) -> Maybe ([a], a) -> Maybe ([a], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], a) -> (([a], a) -> ([a], a)) -> Maybe ([a], a) -> ([a], a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([], a
x) (\(~([a]
a, a
b)) -> (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
a, a
b))) Maybe ([a], a)
forall a. Maybe a
Nothing
setupCompatWrapper :: String
-> [Text]
-> IO ()
setupCompatWrapper :: String -> [Text] -> IO ()
setupCompatWrapper String
newPackage [Text]
modules =
UserHooks -> IO ()
defaultMainWithHooks (UserHooks
simpleUserHooks {
confHook = compatGenConfHook newPackage modules
(confHook simpleUserHooks)
})
configureDryRun :: Text
-> Text
-> Text
-> Text
-> Maybe FilePath
-> [TaggedOverride]
-> IO ([Text], S.Set Text)
configureDryRun :: Text
-> Text
-> Text
-> Text
-> Maybe String
-> [TaggedOverride]
-> IO ([Text], Set Text)
configureDryRun Text
name Text
version Text
pkgName Text
pkgVersion Maybe String
overridesFile [TaggedOverride]
inheritedOverrides = do
Maybe TaggedOverride
givenOvs <- (String -> IO TaggedOverride)
-> Maybe String -> IO (Maybe TaggedOverride)
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 (\String
fname -> Text -> Text -> TaggedOverride
TaggedOverride (String -> Text
T.pack String
fname) (Text -> TaggedOverride) -> IO Text -> IO TaggedOverride
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
utf8ReadFile String
fname) Maybe String
overridesFile
let ovs :: [TaggedOverride]
ovs = [TaggedOverride]
-> (TaggedOverride -> [TaggedOverride])
-> Maybe TaggedOverride
-> [TaggedOverride]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [TaggedOverride]
inheritedOverrides (TaggedOverride -> [TaggedOverride] -> [TaggedOverride]
forall a. a -> [a] -> [a]
:[TaggedOverride]
inheritedOverrides) Maybe TaggedOverride
givenOvs
ModuleInfo
m <- Text
-> Text
-> Text
-> Text
-> Bool
-> [TaggedOverride]
-> IO ModuleInfo
genModuleCode Text
name Text
version Text
pkgName Text
pkgVersion Bool
False [TaggedOverride]
ovs
([Text], Set Text) -> IO ([Text], Set Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text
"GI." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
ucFirst Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".Config") Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ModuleInfo -> [Text]
listModuleTree ModuleInfo
m,
ModuleInfo -> Set Text
transitiveModuleDeps ModuleInfo
m)