-- | Integration for @build-type: Custom@ builds.
module Distribution.Simple.GResource.Custom (gResourceUserHooks) where

import Distribution.PackageDescription
  ( Benchmark (benchmarkName),
    Executable (exeName),
    PackageDescription (benchmarks, executables, testSuites),
    TestSuite (testName),
    benchmarkBuildInfo,
    buildInfo,
    testBuildInfo,
  )
import Distribution.Simple (UserHooks, buildHook)
import Distribution.Simple.GResource.Internal
  ( GResourceCmd (..),
    GResourceConfig (..),
    addCSources,
    generatedCFile,
    parseGResourceConfig,
    runGResourceCmd,
  )
import Distribution.Simple.LocalBuildInfo
  ( LocalBuildInfo (withPrograms),
    buildDir,
    mbWorkDirLBI,
  )
import Distribution.Simple.Program (requireProgram, simpleProgram)
import Distribution.Simple.Setup (buildVerbosity, fromFlagOrDefault)
import Distribution.Types.BuildInfo (BuildInfo (customFieldsBI))
import Distribution.Types.UnqualComponentName (unUnqualComponentName)
import Distribution.Utils.Path (Build, FileOrDir (Dir), Pkg, SymbolicPath)
import Distribution.Verbosity (VerbosityFlags, defaultVerbosityHandles, mkVerbosity, normal)

-- | 'UserHooks' for building GResource files with @build-type: Custom@.
-- Use in @Setup.hs@ to integrate into the build process.
--
-- @
-- import Distribution.Simple
-- import Distribution.Simple.GResource
--
-- main :: IO ()
-- main = defaultMainWithHooks (gResourceUserHooks simpleUserHooks)
-- @
--
-- Add @cabal-gresource@ to @setup-depends@:
--
-- @
-- build-type: Custom
--
-- custom-setup
--   setup-depends:
--     base,
--     Cabal,
--     cabal-gresource
--
-- executable application:
--   ...
--   x-gresource-xml-file: resource/resource.xml
--   x-gresource-source-dir: resource
-- @
--
-- @since 0.1.0.0
gResourceUserHooks :: UserHooks -> UserHooks
gResourceUserHooks :: UserHooks -> UserHooks
gResourceUserHooks UserHooks
uh =
  UserHooks
uh
    { buildHook = \PackageDescription
pd LocalBuildInfo
lbi UserHooks
hooks BuildFlags
flags -> do
        let verbosityFlags :: VerbosityFlags
verbosityFlags = VerbosityFlags -> Flag VerbosityFlags -> VerbosityFlags
forall a. a -> Flag a -> a
fromFlagOrDefault VerbosityFlags
normal (BuildFlags -> Flag VerbosityFlags
buildVerbosity BuildFlags
flags)
        pd' <- VerbosityFlags
-> LocalBuildInfo -> PackageDescription -> IO PackageDescription
addGResources VerbosityFlags
verbosityFlags LocalBuildInfo
lbi PackageDescription
pd
        buildHook uh pd' lbi hooks flags
    }

addGResources :: VerbosityFlags -> LocalBuildInfo -> PackageDescription -> IO PackageDescription
addGResources :: VerbosityFlags
-> LocalBuildInfo -> PackageDescription -> IO PackageDescription
addGResources VerbosityFlags
verbosity LocalBuildInfo
lbi PackageDescription
pd = do
  exes' <-
    (Executable -> IO Executable) -> [Executable] -> IO [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) -> [a] -> f [b]
traverse
      ((Executable -> String)
-> (Executable -> BuildInfo)
-> (Executable -> BuildInfo -> Executable)
-> Executable
-> IO Executable
forall c.
(c -> String)
-> (c -> BuildInfo) -> (c -> BuildInfo -> c) -> c -> IO c
onComponent (UnqualComponentName -> String
unUnqualComponentName (UnqualComponentName -> String)
-> (Executable -> UnqualComponentName) -> Executable -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> UnqualComponentName
exeName) Executable -> BuildInfo
buildInfo (\Executable
e BuildInfo
bi -> Executable
e {buildInfo = bi}))
      (PackageDescription -> [Executable]
executables PackageDescription
pd)
  tests' <-
    traverse
      (onComponent (unUnqualComponentName . testName) testBuildInfo (\TestSuite
t BuildInfo
bi -> TestSuite
t {testBuildInfo = bi}))
      (testSuites pd)
  benchs' <-
    traverse
      (onComponent (unUnqualComponentName . benchmarkName) benchmarkBuildInfo (\Benchmark
b BuildInfo
bi -> Benchmark
b {benchmarkBuildInfo = bi}))
      (benchmarks pd)
  pure pd {executables = exes', testSuites = tests', benchmarks = benchs'}
  where
    bdir :: SymbolicPath Pkg ('Dir Build)
bdir = LocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi
    onComponent ::
      (c -> String) ->
      (c -> BuildInfo) ->
      (c -> BuildInfo -> c) ->
      c ->
      IO c
    onComponent :: forall c.
(c -> String)
-> (c -> BuildInfo) -> (c -> BuildInfo -> c) -> c -> IO c
onComponent c -> String
nameOf c -> BuildInfo
getBI c -> BuildInfo -> c
setBI c
c = do
      bi' <- VerbosityFlags
-> LocalBuildInfo
-> SymbolicPath Pkg ('Dir Build)
-> String
-> BuildInfo
-> IO BuildInfo
processComponent VerbosityFlags
verbosity LocalBuildInfo
lbi SymbolicPath Pkg ('Dir Build)
bdir (c -> String
nameOf c
c) (c -> BuildInfo
getBI c
c)
      pure (setBI c bi')

processComponent ::
  VerbosityFlags ->
  LocalBuildInfo ->
  SymbolicPath Pkg (Dir Build) ->
  String ->
  BuildInfo ->
  IO BuildInfo
processComponent :: VerbosityFlags
-> LocalBuildInfo
-> SymbolicPath Pkg ('Dir Build)
-> String
-> BuildInfo
-> IO BuildInfo
processComponent VerbosityFlags
verbosityFlags LocalBuildInfo
lbi SymbolicPath Pkg ('Dir Build)
bdir String
name BuildInfo
bi =
  case [(String, String)] -> Maybe GResourceConfig
parseGResourceConfig (BuildInfo -> [(String, String)]
customFieldsBI BuildInfo
bi) of
    Maybe GResourceConfig
Nothing -> BuildInfo -> IO BuildInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BuildInfo
bi
    Just GResourceConfig
cfg -> do
      (prog, _) <-
        Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity (String -> Program
simpleProgram String
"glib-compile-resources") (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
      let xml = GResourceConfig -> RelativePath Source 'File
gresourceXml GResourceConfig
cfg
      let targetAbs = SymbolicPath Pkg ('Dir Build)
-> String -> RelativePath Source 'File -> SymbolicPath Pkg 'File
generatedCFile SymbolicPath Pkg ('Dir Build)
bdir String
name RelativePath Source 'File
xml
      runGResourceCmd
        GResourceCmd
          { gcProgram = prog,
            gcPkgDirectory = pkgDir,
            gcSourceDir = gresourceSource cfg,
            gcTarget = targetAbs,
            gcXmlFile = xml,
            gcVerbosity = verbosityFlags
          }
      pure (addCSources [targetAbs] bi)
  where
    pkgDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
pkgDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
    verbosity :: Verbosity
verbosity = VerbosityHandles -> VerbosityFlags -> Verbosity
mkVerbosity VerbosityHandles
defaultVerbosityHandles VerbosityFlags
verbosityFlags