module Data.GI.CodeGen.CabalHooks
( setupHaskellGIBinding
) 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)
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 (parseOverridesFile, girFixups,
filterAPIsAndDeps)
import Data.GI.CodeGen.Util (ucFirst)
import Control.Monad (when, void)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import System.Directory (doesFileExist)
import System.FilePath ((</>), (<.>))
type ConfHook = (GenericPackageDescription, HookedBuildInfo) -> ConfigFlags
-> IO LocalBuildInfo
confCodeGenHook :: Text
-> Text
-> Bool
-> Maybe FilePath
-> Maybe FilePath
-> ConfHook
-> ConfHook
confCodeGenHook :: Text
-> Text
-> Bool
-> Maybe FilePath
-> Maybe FilePath
-> ConfHook
-> ConfHook
confCodeGenHook name :: Text
name version :: Text
version verbosity :: Bool
verbosity overrides :: Maybe FilePath
overrides outputDir :: Maybe FilePath
outputDir
defaultConfHook :: ConfHook
defaultConfHook (gpd :: GenericPackageDescription
gpd, hbi :: HookedBuildInfo
hbi) flags :: ConfigFlags
flags = do
[FilePath] -> IO ()
setupTypelibSearchPath []
Overrides
ovs <- case Maybe FilePath
overrides of
Nothing -> Overrides -> IO Overrides
forall (m :: * -> *) a. Monad m => a -> m a
return Overrides
forall a. Monoid a => a
mempty
Just fname :: FilePath
fname -> FilePath -> IO (Either Text Overrides)
parseOverridesFile FilePath
fname IO (Either Text Overrides)
-> (Either Text Overrides -> IO Overrides) -> IO Overrides
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left err :: Text
err -> FilePath -> IO Overrides
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO Overrides) -> FilePath -> IO Overrides
forall a b. (a -> b) -> a -> b
$ "Error when parsing overrides file: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
T.unpack Text
err
Right ovs :: Overrides
ovs -> Overrides -> IO Overrides
forall (m :: * -> *) a. Monad m => a -> m a
return Overrides
ovs
(gir :: GIRInfo
gir, girDeps :: [GIRInfo]
girDeps) <- Bool
-> Text
-> Maybe Text
-> [FilePath]
-> [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 (apis :: Map Name API
apis, deps :: 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 :: Text -> Bool -> Overrides -> Config
Config {modName :: Text
modName = Text
name,
verbose :: Bool
verbose = Bool
verbosity,
overrides :: Overrides
overrides = Overrides
ovs}
let m :: ModuleInfo
m = Config -> Map Name API -> ModulePath -> CodeGen () -> ModuleInfo
genCode Config
cfg Map Name API
allAPIs (Text -> ModulePath
toModulePath Text
name) (Map Name API -> CodeGen ()
genModule Map Name API
apis)
let em' :: [ModuleName]
em' = (Text -> ModuleName) -> [Text] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> ModuleName
forall a. IsString a => FilePath -> a
MN.fromString (FilePath -> ModuleName)
-> (Text -> FilePath) -> Text -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) (ModuleInfo -> [Text]
listModuleTree ModuleInfo
m)
ctd' :: Library
ctd' = ((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) {exposedModules :: [ModuleName]
exposedModules = [ModuleName]
em'}
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 :: Library
condTreeData = Library
ctd'}
gpd' :: GenericPackageDescription
gpd' = GenericPackageDescription
gpd {condLibrary :: Maybe (CondTree ConfVar [Dependency] Library)
condLibrary = CondTree ConfVar [Dependency] Library
-> Maybe (CondTree ConfVar [Dependency] Library)
forall a. a -> Maybe a
Just CondTree ConfVar [Dependency] Library
cL'}
Bool
alreadyDone <- FilePath -> IO Bool
doesFileExist (FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe "" Maybe FilePath
outputDir
FilePath -> FilePath -> FilePath
</> "GI" FilePath -> FilePath -> FilePath
</> Text -> FilePath
T.unpack (Text -> Text
ucFirst Text
name) FilePath -> FilePath -> FilePath
<.> "hs")
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
alreadyDone) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO [Text] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [Text] -> IO ()) -> IO [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe FilePath -> ModuleInfo -> IO [Text]
writeModuleTree Bool
verbosity Maybe FilePath
outputDir ModuleInfo
m
LocalBuildInfo
lbi <- ConfHook
defaultConfHook (GenericPackageDescription
gpd', HookedBuildInfo
hbi) ConfigFlags
flags
LocalBuildInfo -> IO LocalBuildInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalBuildInfo
lbi {withOptimization :: OptimisationLevel
withOptimization = OptimisationLevel
NoOptimisation})
setupHaskellGIBinding :: Text
-> Text
-> Bool
-> Maybe FilePath
-> Maybe FilePath
-> IO ()
setupHaskellGIBinding :: Text -> Text -> Bool -> Maybe FilePath -> Maybe FilePath -> IO ()
setupHaskellGIBinding name :: Text
name version :: Text
version verbose :: Bool
verbose overridesFile :: Maybe FilePath
overridesFile outputDir :: Maybe FilePath
outputDir =
UserHooks -> IO ()
defaultMainWithHooks (UserHooks
simpleUserHooks {
confHook :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
confHook = Text
-> Text
-> Bool
-> Maybe FilePath
-> Maybe FilePath
-> ConfHook
-> ConfHook
confCodeGenHook Text
name Text
version Bool
verbose
Maybe FilePath
overridesFile Maybe FilePath
outputDir
(UserHooks
-> (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags
-> IO LocalBuildInfo
confHook UserHooks
simpleUserHooks)
})