-- This file is part of Hoppy.
--
-- Copyright 2015-2024 Bryan Gardiner <bog@khumba.net>
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.

{-# LANGUAGE CPP #-}

-- | Implementations of Cabal setup programs for use in packages of generated
-- bindings.
--
-- Much like the default Setup.hs that Cabal recommends for packages,
--
-- @
-- import "Distribution.Simple"
-- main = 'Distribution.Simple.defaultMain'
-- @
--
-- this module provides simplified configuration of packages for generated
-- bindings.  Suppose you have a project named foobar that is composed of Cabal
-- packages named \"foobar-generator\" for the code generator, \"foobar-cpp\"
-- for the C++ gateway, and \"foobar\" for the Haskell gateway.  The C++ gateway
-- package can use the following code:
--
-- @
-- import "Foreign.Hoppy.Setup" ('ProjectConfig' (..), 'cppMain')
--
-- main =
--   cppMain $
--   'ProjectConfig'
--   { generatorExecutableName = \"foobar-generator\"
--   , cppPackageName = \"foobar-cpp\"
--   , cppPackagedSourcesLocation = Nothing
--   , cppSourcesDir = 'GenerateInAutogenDir' \"\"
--   , hsSourcesDir = 'GenerateInAutogenDir' \"\"
--   }
-- @
--
-- The Haskell gateway uses the same code, except calling 'hsMain' instead of
-- 'cppMain'.  This causes all (C++, Haskell) generated sources to be placed in
-- the \"autogen\" directories provided by Cabal, which keeps the source
-- directory clean.  See the documentation of the fields of 'ProjectConfig' for
-- more information on how to set up your project's build process.
--
-- The gateway packages need to set @build-type: Custom@ in their @.cabal@ files
-- to use these setup files.
module Foreign.Hoppy.Setup (
  ProjectConfig (..),
  GenerateLocation (..),
  combinedMain,
  combinedUserHooks,
  cppMain,
  cppUserHooks,
  hsMain,
  hsUserHooks,
  ) where

import Control.Monad (unless, when)
import Data.List (isInfixOf)
import qualified Data.Map as M
import Distribution.InstalledPackageInfo (libraryDirs)
import qualified Distribution.ModuleName as ModuleName
#if MIN_VERSION_Cabal(2,0,0)
import Distribution.Package (mkPackageName)
#else
import Distribution.Package (PackageName (PackageName))
#endif
import Distribution.PackageDescription (
  HookedBuildInfo,
  PackageDescription,
  autogenModules,
  emptyBuildInfo,
  extraLibDirs,
  )
import Distribution.Simple (defaultMainWithHooks, simpleUserHooks)
import Distribution.Simple.BuildPaths (autogenComponentModulesDir)
import Distribution.Simple.LocalBuildInfo (
  LocalBuildInfo,
  absoluteInstallDirs,
  buildDir,
  installedPkgs,
  libdir,
  withPrograms,
  )
import Distribution.Simple.PackageIndex (lookupPackageName)
import Distribution.Simple.Program (
  runDbProgram,
  runProgram,
  simpleProgram,
  )
import Distribution.Simple.Program.Find (
  ProgramSearchPathEntry (ProgramSearchPathDefault),
  findProgramOnSearchPath,
  )
import Distribution.Simple.Program.Types (
  ConfiguredProgram,
  Program,
  ProgramLocation (FoundOnSystem),
  simpleConfiguredProgram,
  )
import Distribution.Simple.Setup (
  CopyDest (CopyTo, NoCopyDest),
  RegisterFlags,
  buildVerbosity,
  cleanVerbosity,
  configVerbosity,
  copyDest,
  copyVerbosity,
  flagToMaybe,
  fromFlagOrDefault,
  installDistPref,
  installVerbosity,
  regInPlace,
  regVerbosity,
  replVerbosity,
  testVerbosity,
  )
import Distribution.Simple.UserHooks (
  UserHooks (
    buildHook,
    hookedPrograms,
    cleanHook,
    copyHook,
    instHook,
    regHook,
    postConf,
    preBuild,
    preCopy,
    preInst,
    preReg,
    preRepl,
    preTest
    ),
  )
#if MIN_VERSION_Cabal(2,0,0)
import Distribution.Simple.Utils (die')
#else
import Distribution.Simple.Utils (die)
#endif
import Distribution.Simple.Utils (installOrdinaryFile)
import Distribution.Types.ComponentName (ComponentName (CLibName))
#if MIN_VERSION_Cabal(3,0,0)
import Distribution.Types.LibraryName (LibraryName (LMainLibName))
#endif
import Distribution.Types.LocalBuildInfo (componentNameCLBIs)
import Distribution.Verbosity (Verbosity, normal)
import Foreign.Hoppy.Generator.Language.Haskell (getModuleName)
import Foreign.Hoppy.Generator.Main (run)
import Foreign.Hoppy.Generator.Spec (Interface, interfaceModules)
import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory)
import System.FilePath ((</>), takeDirectory)

-- | Configuration parameters for a project using Hoppy.
data ProjectConfig = ProjectConfig
  { ProjectConfig -> Either FilePath Interface
interfaceResult :: Either String Interface
    -- ^ The interface to run the generator with.  This result is returned from
    -- @Foreign.Hoppy.Generator.Spec.interface@ and some may have failed; the
    -- string is a message indicating the problem.

  , ProjectConfig -> FilePath
cppPackageName :: String
    -- ^ The name of the C++ gateway package.
    --
    -- When using separate Cabal packages for the C++ and Haskell gateway
    -- packages, this must be nonempty.  When using a single combined gateway
    -- package with 'combinedMain', this must be empty.

  , ProjectConfig -> Maybe FilePath
cppPackagedSourcesLocation :: Maybe FilePath
    -- ^ If the C++ gateway package includes C++ files needed for compliation
    -- (either sources or headers), then this should point to the base directory
    -- holding these files, relative to the root of the project.  The project
    -- root itself may be specified with @Just \"\"@.
    --
    -- When present, this is passed to the C++ package's makefile in the
    -- environment variable @HOPPY_CPP_PKG_DIR@.  A value of @Just \"\"@ is
    -- passed with @HOPPY_CPP_PKG_DIR@ set to the base directory of the Cabal
    -- package (equivalent to @Just \".\"@).
    --
    -- This is also added automatically as a system include path (i.e. @gcc -I@)
    -- for the C++ compiler when compiling the test program for enum
    -- autodetection.

  , ProjectConfig -> GenerateLocation
cppGeneratedSourcesLocation :: GenerateLocation
    -- ^ Specifies the directory where C++ sources will be generated.
    --
    -- This is passed to the C++ package's makefile in the environment variable
    -- @HOPPY_CPP_GEN_DIR@.
  }

-- | Where to generate sources for binding packages.
data GenerateLocation =
  GenerateInAutogenDir FilePath
  -- ^ Generate sources in the package's autogen directory provided by Cabal.
  -- This is preferrable as it keeps the source directory clean.
  --
  -- Sources are generated below the given @FilePath@ if nonempty, otherwise
  -- sources are generated directly in the autogen directory.
  | GenerateInSourcesDir FilePath
  -- ^ Generate sources in the package's root source directory, i.e. the
  -- directory with the @.cabal@ file.
  --
  -- Sources are generated below the given @FilePath@ if nonempty, otherwise
  -- sources are generated directly in the root directory.

-- | The name of the file we'll use to hold the enum evaluation cache.
enumEvalCacheFileName :: FilePath
enumEvalCacheFileName :: FilePath
enumEvalCacheFileName = FilePath
"hoppy-enum-eval-cache"

-- | Extracts the 'Interface' from a 'ProjectConfig', checking its
-- 'interfaceResult' and aborting the program if the result is unsuccessful.
getInterface :: ProjectConfig -> Verbosity -> IO Interface
getInterface :: ProjectConfig -> Verbosity -> IO Interface
getInterface ProjectConfig
project Verbosity
verbosity = case ProjectConfig -> Either FilePath Interface
interfaceResult ProjectConfig
project of
  Left FilePath
errorMsg ->
#if MIN_VERSION_Cabal(2,0,0)
    Verbosity -> FilePath -> IO Interface
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO Interface) -> FilePath -> IO Interface
forall a b. (a -> b) -> a -> b
$
#else
    die $
#endif
    FilePath
"Error initializing interface: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
errorMsg
  Right Interface
iface -> Interface -> IO Interface
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Interface
iface

-- | A @main@ implementation to be used in the @Setup.hs@ of a single Hoppy
-- binding package that combined both the C++ and Haskell gateway code in one
-- package.
--
-- @combinedMain project = 'defaultMainWithHooks' $ 'combinedUserHooks' project@
combinedMain :: ProjectConfig -> IO ()
combinedMain :: ProjectConfig -> IO ()
combinedMain ProjectConfig
project = UserHooks -> IO ()
defaultMainWithHooks (UserHooks -> IO ()) -> UserHooks -> IO ()
forall a b. (a -> b) -> a -> b
$ ProjectConfig -> UserHooks
combinedUserHooks ProjectConfig
project

-- | Cabal user hooks for a combined gateway package.  When overriding
-- overriding fields in the result, be sure to call the previous hook.
--
-- The following hooks are defined:
--
-- - 'postConf': Runs the generator to generate C++ and Haskell sources.
combinedUserHooks :: ProjectConfig -> UserHooks
combinedUserHooks :: ProjectConfig -> UserHooks
combinedUserHooks ProjectConfig
project =
  UserHooks
simpleUserHooks
  { postConf = \Args
args ConfigFlags
flags PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo -> do
      let verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
flags

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> Bool) -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ ProjectConfig -> FilePath
cppPackageName ProjectConfig
project) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
        FilePath
"combinedMain expects an empty cppPackageName, found \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
        ProjectConfig -> FilePath
cppPackageName ProjectConfig
project FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\"."

      Interface
iface <- case ProjectConfig -> Either FilePath Interface
interfaceResult ProjectConfig
project of
        Left FilePath
errorMsg ->
          Verbosity -> FilePath -> IO Interface
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO Interface) -> FilePath -> IO Interface
forall a b. (a -> b) -> a -> b
$
          FilePath
"Error initializing interface: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
errorMsg
        Right Interface
iface -> Interface -> IO Interface
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Interface
iface

      ProjectConfig -> Verbosity -> LocalBuildInfo -> Interface -> IO ()
genCpp ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo Interface
iface
      Verbosity -> LocalBuildInfo -> Interface -> IO ()
genHs Verbosity
verbosity LocalBuildInfo
localBuildInfo Interface
iface
      UserHooks
-> Args
-> ConfigFlags
-> PackageDescription
-> LocalBuildInfo
-> IO ()
postConf UserHooks
simpleUserHooks Args
args ConfigFlags
flags PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo

  , preBuild = \Args
_ BuildFlags
flags -> ProjectConfig -> Verbosity -> IO HookedBuildInfo
myHsPreHook ProjectConfig
project (Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
flags)
  , preTest = \Args
_ TestFlags
flags -> ProjectConfig -> Verbosity -> IO HookedBuildInfo
myHsPreHook ProjectConfig
project (Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ TestFlags -> Flag Verbosity
testVerbosity TestFlags
flags)
  , preCopy = \Args
_ CopyFlags
flags -> ProjectConfig -> Verbosity -> IO HookedBuildInfo
myHsPreHook ProjectConfig
project (Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CopyFlags -> Flag Verbosity
copyVerbosity CopyFlags
flags)
  , preInst = \Args
_ InstallFlags
flags -> ProjectConfig -> Verbosity -> IO HookedBuildInfo
myHsPreHook ProjectConfig
project (Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ InstallFlags -> Flag Verbosity
installVerbosity InstallFlags
flags)
  , preReg = \Args
_ RegisterFlags
flags -> ProjectConfig -> Verbosity -> IO HookedBuildInfo
myHsPreHook ProjectConfig
project (Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ RegisterFlags -> Flag Verbosity
regVerbosity RegisterFlags
flags)
  , preRepl = \Args
_ ReplFlags
flags -> ProjectConfig -> Verbosity -> IO HookedBuildInfo
myHsPreHook ProjectConfig
project (Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ ReplFlags -> Flag Verbosity
replVerbosity ReplFlags
flags)
  }

  where genCpp :: ProjectConfig -> Verbosity -> LocalBuildInfo -> Interface -> IO ()
        genCpp :: ProjectConfig -> Verbosity -> LocalBuildInfo -> Interface -> IO ()
genCpp ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo Interface
iface = do
          (FilePath
_, FilePath
cppGenDir) <-
            ProjectConfig
-> Verbosity -> LocalBuildInfo -> IO (FilePath, FilePath)
getAutogenAndCppGenDir ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo
          FilePath
cppPackagedSourcesDir <- case ProjectConfig -> Maybe FilePath
cppPackagedSourcesLocation ProjectConfig
project of
            Maybe FilePath
Nothing -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""
            Just FilePath
subpath -> (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> FilePath
</> FilePath
subpath) IO FilePath
getCurrentDirectory
          Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
cppGenDir
          Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
localBuildInfo
          [Action]
_ <- [Interface] -> Args -> IO [Action]
run [Interface
iface]
                   [ FilePath
"--enum-eval-cache-mode", FilePath
"refresh"
                   , FilePath
"--enum-eval-cache-path", LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
localBuildInfo FilePath -> FilePath -> FilePath
</> FilePath
enumEvalCacheFileName
                   , FilePath
"--gen-cpp", FilePath
cppGenDir, FilePath
cppPackagedSourcesDir
                   ]
          () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        genHs :: Verbosity -> LocalBuildInfo -> Interface -> IO ()
        genHs :: Verbosity -> LocalBuildInfo -> Interface -> IO ()
genHs Verbosity
verbosity LocalBuildInfo
localBuildInfo Interface
iface = do
          (FilePath
_, FilePath
hsGenDir) <- Verbosity -> LocalBuildInfo -> IO (FilePath, FilePath)
getAutogenAndHsGenDir Verbosity
verbosity LocalBuildInfo
localBuildInfo
          Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
hsGenDir
          [Action]
_ <- [Interface] -> Args -> IO [Action]
run [Interface
iface]
                   [ FilePath
"--enum-eval-cache-mode", FilePath
"must-exist"
                   , FilePath
"--enum-eval-cache-path", LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
localBuildInfo FilePath -> FilePath -> FilePath
</> FilePath
enumEvalCacheFileName
                   , FilePath
"--gen-hs", FilePath
hsGenDir
                   ]
          () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        -- See also hsPreHook.
        myHsPreHook :: ProjectConfig -> Verbosity -> IO HookedBuildInfo
        myHsPreHook :: ProjectConfig -> Verbosity -> IO HookedBuildInfo
myHsPreHook ProjectConfig
project Verbosity
verbosity = do
          Interface
iface <- ProjectConfig -> Verbosity -> IO Interface
getInterface ProjectConfig
project Verbosity
verbosity
          let moduleNames :: [ModuleName]
moduleNames =
                (Module -> ModuleName) -> [Module] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> ModuleName
forall a. IsString a => FilePath -> a
ModuleName.fromString (FilePath -> ModuleName)
-> (Module -> FilePath) -> Module -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> Module -> FilePath
getModuleName Interface
iface) ([Module] -> [ModuleName]) -> [Module] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$
                Map FilePath Module -> [Module]
forall k a. Map k a -> [a]
M.elems (Interface -> Map FilePath Module
interfaceModules Interface
iface)

          -- Injected autogenerated modules here works for most commands, however sdist
          -- is not hookable, so autogen-modules should still be written out manually in
          -- your Cabal file!  (See Cabal issue #6180.)
          HookedBuildInfo -> IO HookedBuildInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildInfo -> Maybe BuildInfo
forall a. a -> Maybe a
Just BuildInfo
emptyBuildInfo { autogenModules = moduleNames }, [])

-- | A @main@ implementation to be used in the @Setup.hs@ of a C++ gateway
-- package.
--
-- @cppMain project = 'defaultMainWithHooks' $ 'cppUserHooks' project@
cppMain :: ProjectConfig -> IO ()
cppMain :: ProjectConfig -> IO ()
cppMain ProjectConfig
project = UserHooks -> IO ()
defaultMainWithHooks (UserHooks -> IO ()) -> UserHooks -> IO ()
forall a b. (a -> b) -> a -> b
$ ProjectConfig -> UserHooks
cppUserHooks ProjectConfig
project

-- | Cabal user hooks for a C++ gateway package.  When overriding fields in the
-- result, be sure to call the previous hook.
--
-- The following hooks are defined:
--
-- - 'postConf': Runs the generator program to generate C++ sources.  Checks if
-- a @configure@ script exists in the C++ gateway root, and calls it if so
-- (without arguments).
--
-- - 'buildHook': Runs @make@ with no arguments from the C++ gateway root.
--
-- - 'copyHook' and 'instHook': Runs @make install libdir=$libdir@ where
-- @$libdir@ is the directory into which to install the built shared library.
--
-- - 'cleanHook': Removes files created by the generator, then calls @make
-- clean@.
cppUserHooks :: ProjectConfig -> UserHooks
cppUserHooks :: ProjectConfig -> UserHooks
cppUserHooks ProjectConfig
project =
  UserHooks
simpleUserHooks
  { hookedPrograms = [makeProgram]

  , postConf = \Args
args ConfigFlags
flags PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo -> do
      let verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
flags
      ProjectConfig -> Verbosity -> LocalBuildInfo -> IO ()
cppConfigure ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo
      UserHooks
-> Args
-> ConfigFlags
-> PackageDescription
-> LocalBuildInfo
-> IO ()
postConf UserHooks
simpleUserHooks Args
args ConfigFlags
flags PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo

  , buildHook = \PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo UserHooks
hooks BuildFlags
flags -> do
      UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> BuildFlags
-> IO ()
buildHook UserHooks
simpleUserHooks PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo UserHooks
hooks BuildFlags
flags
      let verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
flags
      ProjectConfig -> Verbosity -> LocalBuildInfo -> IO ()
cppBuild ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo

  , copyHook = \PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo UserHooks
hooks CopyFlags
flags -> do
      UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> CopyFlags
-> IO ()
copyHook UserHooks
simpleUserHooks PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo UserHooks
hooks CopyFlags
flags
      let verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CopyFlags -> Flag Verbosity
copyVerbosity CopyFlags
flags
          dest :: CopyDest
dest = CopyDest -> Flag CopyDest -> CopyDest
forall a. a -> Flag a -> a
fromFlagOrDefault CopyDest
NoCopyDest (Flag CopyDest -> CopyDest) -> Flag CopyDest -> CopyDest
forall a b. (a -> b) -> a -> b
$ CopyFlags -> Flag CopyDest
copyDest CopyFlags
flags
      ProjectConfig
-> Verbosity
-> PackageDescription
-> LocalBuildInfo
-> CopyDest
-> IO ()
cppInstall ProjectConfig
project Verbosity
verbosity PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo CopyDest
dest

  , instHook = \PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo UserHooks
hooks InstallFlags
flags -> do
      UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> InstallFlags
-> IO ()
instHook UserHooks
simpleUserHooks PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo UserHooks
hooks InstallFlags
flags
      let verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ InstallFlags -> Flag Verbosity
installVerbosity InstallFlags
flags
          dest :: CopyDest
dest = CopyDest -> (FilePath -> CopyDest) -> Maybe FilePath -> CopyDest
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CopyDest
NoCopyDest FilePath -> CopyDest
CopyTo (Maybe FilePath -> CopyDest) -> Maybe FilePath -> CopyDest
forall a b. (a -> b) -> a -> b
$
                 Flag FilePath -> Maybe FilePath
forall a. Flag a -> Maybe a
flagToMaybe (Flag FilePath -> Maybe FilePath)
-> Flag FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ InstallFlags -> Flag FilePath
installDistPref InstallFlags
flags
      ProjectConfig
-> Verbosity
-> PackageDescription
-> LocalBuildInfo
-> CopyDest
-> IO ()
cppInstall ProjectConfig
project Verbosity
verbosity PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo CopyDest
dest

  , regHook = \PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo UserHooks
hooks RegisterFlags
flags -> do
      UserHooks
-> PackageDescription
-> LocalBuildInfo
-> UserHooks
-> RegisterFlags
-> IO ()
regHook UserHooks
simpleUserHooks PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo UserHooks
hooks RegisterFlags
flags
      let verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ RegisterFlags -> Flag Verbosity
regVerbosity RegisterFlags
flags
      ProjectConfig
-> Verbosity -> LocalBuildInfo -> RegisterFlags -> IO ()
cppRegister ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo RegisterFlags
flags

  , cleanHook = \PackageDescription
pkgDesc ()
z UserHooks
hooks CleanFlags
flags -> do
      UserHooks
-> PackageDescription -> () -> UserHooks -> CleanFlags -> IO ()
cleanHook UserHooks
simpleUserHooks PackageDescription
pkgDesc ()
z UserHooks
hooks CleanFlags
flags
      let verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CleanFlags -> Flag Verbosity
cleanVerbosity CleanFlags
flags
      ProjectConfig -> Verbosity -> IO ()
cppClean ProjectConfig
project Verbosity
verbosity
  }

makeProgram :: Program
makeProgram :: Program
makeProgram = FilePath -> Program
simpleProgram FilePath
"make"

defaultLibComponentName :: ComponentName
defaultLibComponentName :: ComponentName
defaultLibComponentName =
#if MIN_VERSION_Cabal(3,0,0)
  LibraryName -> ComponentName
CLibName LibraryName
LMainLibName
#else
  CLibName
#endif

-- | Locates the autogen directory for the library component.
getAutogenDir :: Verbosity -> LocalBuildInfo -> IO FilePath
getAutogenDir :: Verbosity -> LocalBuildInfo -> IO FilePath
getAutogenDir Verbosity
verbosity LocalBuildInfo
localBuildInfo = do
  let libCLBIs :: [ComponentLocalBuildInfo]
libCLBIs = LocalBuildInfo -> ComponentName -> [ComponentLocalBuildInfo]
componentNameCLBIs LocalBuildInfo
localBuildInfo ComponentName
defaultLibComponentName
#if MIN_VERSION_Cabal(2,0,0)
      dieFn :: FilePath -> IO a
dieFn = Verbosity -> FilePath -> IO a
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity
#else
      dieFn = die
#endif

  case [ComponentLocalBuildInfo]
libCLBIs of
    [ComponentLocalBuildInfo
libCLBI] -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
autogenComponentModulesDir LocalBuildInfo
localBuildInfo ComponentLocalBuildInfo
libCLBI
    [ComponentLocalBuildInfo]
_ ->
      -- TODO Show interface name, and "C++" or "Haskell"?
      FilePath -> IO FilePath
forall {a}. FilePath -> IO a
dieFn (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Args -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [FilePath
"Expected one library ComponentLocalBuildInfo, found ",
       Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> Int -> FilePath
forall a b. (a -> b) -> a -> b
$ [ComponentLocalBuildInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ComponentLocalBuildInfo]
libCLBIs, FilePath
"."]

getAutogenAndGenDir :: GenerateLocation
                    -> Verbosity
                    -> LocalBuildInfo
                    -> IO (FilePath, FilePath)
getAutogenAndGenDir :: GenerateLocation
-> Verbosity -> LocalBuildInfo -> IO (FilePath, FilePath)
getAutogenAndGenDir GenerateLocation
genLoc Verbosity
verbosity LocalBuildInfo
localBuildInfo = do
  FilePath
autogenDir <- Verbosity -> LocalBuildInfo -> IO FilePath
getAutogenDir Verbosity
verbosity LocalBuildInfo
localBuildInfo
  case GenerateLocation
genLoc of
    GenerateInAutogenDir FilePath
subpath ->
      (FilePath, FilePath) -> IO (FilePath, FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
autogenDir, FilePath
autogenDir FilePath -> FilePath -> FilePath
</> FilePath
subpath)
    GenerateInSourcesDir FilePath
subpath -> do
      FilePath
curDir <- IO FilePath
getCurrentDirectory
      (FilePath, FilePath) -> IO (FilePath, FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
autogenDir, FilePath
curDir FilePath -> FilePath -> FilePath
</> FilePath
subpath)

getAutogenAndCppGenDir :: ProjectConfig -> Verbosity -> LocalBuildInfo -> IO (FilePath, FilePath)
getAutogenAndCppGenDir :: ProjectConfig
-> Verbosity -> LocalBuildInfo -> IO (FilePath, FilePath)
getAutogenAndCppGenDir ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo =
  GenerateLocation
-> Verbosity -> LocalBuildInfo -> IO (FilePath, FilePath)
getAutogenAndGenDir (ProjectConfig -> GenerateLocation
cppGeneratedSourcesLocation ProjectConfig
project) Verbosity
verbosity LocalBuildInfo
localBuildInfo

getAutogenAndHsGenDir :: Verbosity -> LocalBuildInfo -> IO (FilePath, FilePath)
getAutogenAndHsGenDir :: Verbosity -> LocalBuildInfo -> IO (FilePath, FilePath)
getAutogenAndHsGenDir Verbosity
verbosity LocalBuildInfo
localBuildInfo =
  GenerateLocation
-> Verbosity -> LocalBuildInfo -> IO (FilePath, FilePath)
getAutogenAndGenDir (FilePath -> GenerateLocation
GenerateInAutogenDir FilePath
"") Verbosity
verbosity LocalBuildInfo
localBuildInfo

getCppDirEnvVars :: ProjectConfig -> Verbosity -> LocalBuildInfo -> IO [String]
getCppDirEnvVars :: ProjectConfig -> Verbosity -> LocalBuildInfo -> IO Args
getCppDirEnvVars ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo = do
  (FilePath
autogenDir, FilePath
cppGenDir) <- ProjectConfig
-> Verbosity -> LocalBuildInfo -> IO (FilePath, FilePath)
getAutogenAndCppGenDir ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo
  Args -> IO Args
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Args -> IO Args) -> Args -> IO Args
forall a b. (a -> b) -> a -> b
$
    [ FilePath
"HOPPY_AUTOGEN_DIR=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
autogenDir
    , FilePath
"HOPPY_CPP_GEN_DIR=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cppGenDir
    ] Args -> Args -> Args
forall a. [a] -> [a] -> [a]
++
    (case ProjectConfig -> Maybe FilePath
cppPackagedSourcesLocation ProjectConfig
project of
      Just FilePath
"" -> [FilePath
"HOPPY_CPP_PKG_DIR=."]
      Just FilePath
subpath -> [FilePath
"HOPPY_CPP_PKG_DIR=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
subpath]
      Maybe FilePath
Nothing -> [])

cppConfigure :: ProjectConfig -> Verbosity -> LocalBuildInfo -> IO ()
cppConfigure :: ProjectConfig -> Verbosity -> LocalBuildInfo -> IO ()
cppConfigure ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo = do
  -- Invoke the generator to create C++ code.
  (FilePath
_, FilePath
cppGenDir) <- ProjectConfig
-> Verbosity -> LocalBuildInfo -> IO (FilePath, FilePath)
getAutogenAndCppGenDir ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo
  FilePath
cppPackagedSourcesDir <- case ProjectConfig -> Maybe FilePath
cppPackagedSourcesLocation ProjectConfig
project of
    Maybe FilePath
Nothing -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""
    Just FilePath
subpath -> (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> FilePath
</> FilePath
subpath) IO FilePath
getCurrentDirectory
  Interface
iface <- ProjectConfig -> Verbosity -> IO Interface
getInterface ProjectConfig
project Verbosity
verbosity
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
cppGenDir
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
localBuildInfo
  [Action]
_ <- [Interface] -> Args -> IO [Action]
run [Interface
iface]
           [ FilePath
"--enum-eval-cache-mode", FilePath
"refresh"
           , FilePath
"--enum-eval-cache-path", LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
localBuildInfo FilePath -> FilePath -> FilePath
</> FilePath
enumEvalCacheFileName
           , FilePath
"--gen-cpp", FilePath
cppGenDir, FilePath
cppPackagedSourcesDir
           ]

  -- When there is a configure script, then run it.
  Maybe ConfiguredProgram
maybeConfigureProgram <- IO (Maybe ConfiguredProgram)
findConfigure
  case Maybe ConfiguredProgram
maybeConfigureProgram of
    Just ConfiguredProgram
configureProgram -> Verbosity -> ConfiguredProgram -> Args -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
configureProgram []
    Maybe ConfiguredProgram
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  where findConfigure :: IO (Maybe ConfiguredProgram)
        findConfigure :: IO (Maybe ConfiguredProgram)
findConfigure = do
          Bool
hasConfigure <- FilePath -> IO Bool
doesFileExist FilePath
"configure"
          Maybe ConfiguredProgram -> IO (Maybe ConfiguredProgram)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ConfiguredProgram -> IO (Maybe ConfiguredProgram))
-> Maybe ConfiguredProgram -> IO (Maybe ConfiguredProgram)
forall a b. (a -> b) -> a -> b
$ if Bool
hasConfigure
                   then ConfiguredProgram -> Maybe ConfiguredProgram
forall a. a -> Maybe a
Just (ConfiguredProgram -> Maybe ConfiguredProgram)
-> ConfiguredProgram -> Maybe ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ FilePath -> ProgramLocation -> ConfiguredProgram
simpleConfiguredProgram FilePath
"configure" (ProgramLocation -> ConfiguredProgram)
-> ProgramLocation -> ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ FilePath -> ProgramLocation
FoundOnSystem FilePath
"./configure"
                   else Maybe ConfiguredProgram
forall a. Maybe a
Nothing

cppBuild :: ProjectConfig -> Verbosity -> LocalBuildInfo -> IO ()
cppBuild :: ProjectConfig -> Verbosity -> LocalBuildInfo -> IO ()
cppBuild ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo = do
  Bool
hasMakefile <- FilePath -> IO Bool
doesFileExist FilePath
"Makefile"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasMakefile (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
#if MIN_VERSION_Cabal(2,0,0)
    Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity
#else
    die
#endif
    FilePath
"No Makefile found."

  Args
cppDirEnvVars <- ProjectConfig -> Verbosity -> LocalBuildInfo -> IO Args
getCppDirEnvVars ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo

  let programDb :: ProgramDb
programDb = LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
localBuildInfo
  Verbosity -> Program -> ProgramDb -> Args -> IO ()
runDbProgram Verbosity
verbosity Program
makeProgram ProgramDb
programDb Args
cppDirEnvVars

cppInstall :: ProjectConfig
           -> Verbosity
           -> PackageDescription
           -> LocalBuildInfo
           -> CopyDest
           -> IO ()
cppInstall :: ProjectConfig
-> Verbosity
-> PackageDescription
-> LocalBuildInfo
-> CopyDest
-> IO ()
cppInstall ProjectConfig
project Verbosity
verbosity PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo CopyDest
dest = do
  Bool
hasMakefile <- FilePath -> IO Bool
doesFileExist FilePath
"Makefile"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasMakefile (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
#if MIN_VERSION_Cabal(2,0,0)
    Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity
#else
    die
#endif
    FilePath
"No Makefile found."
  let programDb :: ProgramDb
programDb = LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
localBuildInfo
      libDir :: FilePath
libDir = InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
libdir (InstallDirs FilePath -> FilePath)
-> InstallDirs FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ PackageDescription
-> LocalBuildInfo -> CopyDest -> InstallDirs FilePath
absoluteInstallDirs PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo CopyDest
dest
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
libDir
  Args
cppDirEnvVars <- ProjectConfig -> Verbosity -> LocalBuildInfo -> IO Args
getCppDirEnvVars ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo
  Verbosity -> Program -> ProgramDb -> Args -> IO ()
runDbProgram Verbosity
verbosity Program
makeProgram ProgramDb
programDb (Args -> IO ()) -> Args -> IO ()
forall a b. (a -> b) -> a -> b
$
    [FilePath
"install", FilePath
"libdir=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
libDir] Args -> Args -> Args
forall a. [a] -> [a] -> [a]
++ Args
cppDirEnvVars

  -- We're doing an old-style install, so copy the enum eval cache file from the
  -- build directory to the library directory where the Haskell side of the
  -- bindings will find it.
  let enumEvalCacheFilePath :: FilePath
enumEvalCacheFilePath = LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
localBuildInfo FilePath -> FilePath -> FilePath
</> FilePath
enumEvalCacheFileName
  Bool
enumEvalCacheExists <- FilePath -> IO Bool
doesFileExist FilePath
enumEvalCacheFilePath
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
enumEvalCacheExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Verbosity -> FilePath -> FilePath -> IO ()
installOrdinaryFile Verbosity
verbosity
                        FilePath
enumEvalCacheFilePath
                        (FilePath
libDir FilePath -> FilePath -> FilePath
</> FilePath
enumEvalCacheFileName)

cppRegister :: ProjectConfig -> Verbosity -> LocalBuildInfo -> RegisterFlags -> IO ()
cppRegister :: ProjectConfig
-> Verbosity -> LocalBuildInfo -> RegisterFlags -> IO ()
cppRegister ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo RegisterFlags
flags = do
  Bool
hasMakefile <- FilePath -> IO Bool
doesFileExist FilePath
"Makefile"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasMakefile (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
#if MIN_VERSION_Cabal(2,0,0)
    Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity
#else
    die
#endif
    FilePath
"No Makefile found."
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (RegisterFlags -> Flag Bool
regInPlace RegisterFlags
flags)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let programDb :: ProgramDb
programDb = LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
localBuildInfo
        libDir :: FilePath
libDir = LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
localBuildInfo
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
libDir
    Args
cppDirEnvVars <- ProjectConfig -> Verbosity -> LocalBuildInfo -> IO Args
getCppDirEnvVars ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo
    Verbosity -> Program -> ProgramDb -> Args -> IO ()
runDbProgram Verbosity
verbosity Program
makeProgram ProgramDb
programDb (Args -> IO ()) -> Args -> IO ()
forall a b. (a -> b) -> a -> b
$
      [FilePath
"install", FilePath
"libdir=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
libDir] Args -> Args -> Args
forall a. [a] -> [a] -> [a]
++ Args
cppDirEnvVars

cppClean :: ProjectConfig -> Verbosity -> IO ()
cppClean :: ProjectConfig -> Verbosity -> IO ()
cppClean ProjectConfig
project Verbosity
verbosity = do
  Interface
iface <- ProjectConfig -> Verbosity -> IO Interface
getInterface ProjectConfig
project Verbosity
verbosity
  -- We can remove generated sources if we wrote them to the source directory.
  -- We don't have access to the autogen directory from this hook though.
  -- Although, Cabal ought to remove the autogen directory already when
  -- cleaning...
  case ProjectConfig -> GenerateLocation
cppGeneratedSourcesLocation ProjectConfig
project of
    GenerateInAutogenDir FilePath
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    GenerateInSourcesDir FilePath
subpath -> do
      FilePath
cppPackagedSourcesDir <- case ProjectConfig -> Maybe FilePath
cppPackagedSourcesLocation ProjectConfig
project of
        Maybe FilePath
Nothing -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""
        Just FilePath
subpath -> (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> FilePath
</> FilePath
subpath) IO FilePath
getCurrentDirectory
      [Action]
_ <- [Interface] -> Args -> IO [Action]
run [Interface
iface] [FilePath
"--clean-cpp", FilePath
subpath, FilePath
cppPackagedSourcesDir]
      () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  Bool
hasMakefile <- FilePath -> IO Bool
doesFileExist FilePath
"Makefile"
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasMakefile (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
#if MIN_VERSION_Cabal(2,0,0)
    Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity
#else
    die
#endif
    FilePath
"No Makefile found."
  ConfiguredProgram
make <- Verbosity -> FilePath -> IO ConfiguredProgram
findSystemProgram Verbosity
verbosity FilePath
"make"
  Verbosity -> ConfiguredProgram -> Args -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
make [FilePath
"clean"]  -- No Hoppy directories passed in here!

findSystemProgram :: Verbosity -> FilePath -> IO ConfiguredProgram
findSystemProgram :: Verbosity -> FilePath -> IO ConfiguredProgram
findSystemProgram Verbosity
verbosity FilePath
basename = do
  Maybe FilePath
maybePath <-
#if MIN_VERSION_Cabal(1,24,0)
    (Maybe (FilePath, Args) -> Maybe FilePath)
-> IO (Maybe (FilePath, Args)) -> IO (Maybe FilePath)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((FilePath, Args) -> FilePath)
-> Maybe (FilePath, Args) -> Maybe FilePath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath, Args) -> FilePath
forall a b. (a, b) -> a
fst) (IO (Maybe (FilePath, Args)) -> IO (Maybe FilePath))
-> IO (Maybe (FilePath, Args)) -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$  -- We don't care about failed search paths.
#endif
    Verbosity
-> ProgramSearchPath -> FilePath -> IO (Maybe (FilePath, Args))
findProgramOnSearchPath Verbosity
verbosity [ProgramSearchPathEntry
ProgramSearchPathDefault] FilePath
basename
  case Maybe FilePath
maybePath of
    Just FilePath
path -> ConfiguredProgram -> IO ConfiguredProgram
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConfiguredProgram -> IO ConfiguredProgram)
-> ConfiguredProgram -> IO ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ FilePath -> ProgramLocation -> ConfiguredProgram
simpleConfiguredProgram FilePath
basename (ProgramLocation -> ConfiguredProgram)
-> ProgramLocation -> ConfiguredProgram
forall a b. (a -> b) -> a -> b
$ FilePath -> ProgramLocation
FoundOnSystem FilePath
path
    Maybe FilePath
Nothing ->
#if MIN_VERSION_Cabal(2,0,0)
      Verbosity -> FilePath -> IO ConfiguredProgram
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ConfiguredProgram)
-> FilePath -> IO ConfiguredProgram
forall a b. (a -> b) -> a -> b
$
#else
      die $
#endif
      FilePath
"Couldn't find program " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
basename FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"."

-- | A @main@ implementation to be used in the @Setup.hs@ of a Haskell gateway
-- package.
--
-- @hsMain project = 'defaultMainWithHooks' $ 'hsUserHooks' project@
hsMain :: ProjectConfig -> IO ()
hsMain :: ProjectConfig -> IO ()
hsMain ProjectConfig
project = UserHooks -> IO ()
defaultMainWithHooks (UserHooks -> IO ()) -> UserHooks -> IO ()
forall a b. (a -> b) -> a -> b
$ ProjectConfig -> UserHooks
hsUserHooks ProjectConfig
project

-- | Cabal user hooks for a Haskell gateway package.  When overriding fields in
-- the result, be sure to call the previous hook.
--
-- The following hooks are defined:
--
-- - 'postConf': Finds the shared library directory for the installed C++
-- gateway package, and writes this path to a @dist\/build\/hoppy-cpp-libdir@
-- file.  Runs the generator program to generate Haskell sources.
--
-- - 'preBuild', 'preTest', 'preCopy', 'preInst', 'preReg': Reads the C++
-- library directory from @dist\/build\/hoppy-cpp-libdir@ and adds it to the
-- library search path ('extraLibDirs').
--
-- - 'cleanHook': Removes files created by the generator.
hsUserHooks :: ProjectConfig -> UserHooks
hsUserHooks :: ProjectConfig -> UserHooks
hsUserHooks ProjectConfig
project =
  UserHooks
simpleUserHooks
  { postConf = \Args
args ConfigFlags
flags PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo -> do
      UserHooks
-> Args
-> ConfigFlags
-> PackageDescription
-> LocalBuildInfo
-> IO ()
postConf UserHooks
simpleUserHooks Args
args ConfigFlags
flags PackageDescription
pkgDesc LocalBuildInfo
localBuildInfo
      let verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
flags
      ProjectConfig -> Verbosity -> LocalBuildInfo -> IO ()
hsConfigure ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo

  , preBuild = \Args
_ BuildFlags
flags -> ProjectConfig -> Verbosity -> IO HookedBuildInfo
hsPreHook ProjectConfig
project (Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ BuildFlags -> Flag Verbosity
buildVerbosity BuildFlags
flags)
  , preTest = \Args
_ TestFlags
flags -> ProjectConfig -> Verbosity -> IO HookedBuildInfo
hsPreHook ProjectConfig
project (Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ TestFlags -> Flag Verbosity
testVerbosity TestFlags
flags)
  , preCopy = \Args
_ CopyFlags
flags -> ProjectConfig -> Verbosity -> IO HookedBuildInfo
hsPreHook ProjectConfig
project (Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CopyFlags -> Flag Verbosity
copyVerbosity CopyFlags
flags)
  , preInst = \Args
_ InstallFlags
flags -> ProjectConfig -> Verbosity -> IO HookedBuildInfo
hsPreHook ProjectConfig
project (Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ InstallFlags -> Flag Verbosity
installVerbosity InstallFlags
flags)
  , preReg = \Args
_ RegisterFlags
flags -> ProjectConfig -> Verbosity -> IO HookedBuildInfo
hsPreHook ProjectConfig
project (Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ RegisterFlags -> Flag Verbosity
regVerbosity RegisterFlags
flags)
  , preRepl = \Args
_ ReplFlags
flags -> ProjectConfig -> Verbosity -> IO HookedBuildInfo
hsPreHook ProjectConfig
project (Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ ReplFlags -> Flag Verbosity
replVerbosity ReplFlags
flags)
  }

hsCppLibDirFile :: FilePath
hsCppLibDirFile :: FilePath
hsCppLibDirFile = FilePath
"dist/build/hoppy-cpp-libdir"

hsConfigure :: ProjectConfig -> Verbosity -> LocalBuildInfo -> IO ()
hsConfigure :: ProjectConfig -> Verbosity -> LocalBuildInfo -> IO ()
hsConfigure ProjectConfig
project Verbosity
verbosity LocalBuildInfo
localBuildInfo = do
  Interface
iface <- ProjectConfig -> Verbosity -> IO Interface
getInterface ProjectConfig
project Verbosity
verbosity
  FilePath
libDir <- IO FilePath
lookupCppLibDir
  FilePath -> IO ()
storeCppLibDir FilePath
libDir
  Interface -> FilePath -> IO ()
generateSources Interface
iface FilePath
libDir

  where lookupCppLibDir :: IO FilePath
lookupCppLibDir = do
          -- Look for an installed -cpp package.
          let packageName :: FilePath
packageName = ProjectConfig -> FilePath
cppPackageName ProjectConfig
project
          InstalledPackageInfo
cppPkg <- case PackageIndex InstalledPackageInfo
-> PackageName -> [(Version, [InstalledPackageInfo])]
forall a. PackageIndex a -> PackageName -> [(Version, [a])]
lookupPackageName (LocalBuildInfo -> PackageIndex InstalledPackageInfo
installedPkgs LocalBuildInfo
localBuildInfo) (PackageName -> [(Version, [InstalledPackageInfo])])
-> PackageName -> [(Version, [InstalledPackageInfo])]
forall a b. (a -> b) -> a -> b
$
#if MIN_VERSION_Cabal(2,0,0)
                         FilePath -> PackageName
mkPackageName FilePath
packageName
#else
                         PackageName packageName
#endif
                         of
            [(Version
_, [InstalledPackageInfo
pkg])] -> InstalledPackageInfo -> IO InstalledPackageInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InstalledPackageInfo
pkg
            [(Version, [InstalledPackageInfo])]
results ->
#if MIN_VERSION_Cabal(2,0,0)
              Verbosity -> FilePath -> IO InstalledPackageInfo
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO InstalledPackageInfo)
-> FilePath -> IO InstalledPackageInfo
forall a b. (a -> b) -> a -> b
$
#else
              die $
#endif
              FilePath
"Failed to find a unique " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
packageName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
              FilePath
" installation.  Found " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [(Version, [InstalledPackageInfo])] -> FilePath
forall a. Show a => a -> FilePath
show [(Version, [InstalledPackageInfo])]
results FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"."

          -- Look up the libdir of the package we found.  The filter here is for NixOS,
          -- where libraryDirs includes the library directories of dependencies as well.
          case (FilePath -> Bool) -> Args -> Args
forall a. (a -> Bool) -> [a] -> [a]
filter (\FilePath
x -> FilePath
packageName FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
x) (Args -> Args) -> Args -> Args
forall a b. (a -> b) -> a -> b
$ InstalledPackageInfo -> Args
libraryDirs InstalledPackageInfo
cppPkg of
            [FilePath
libDir] -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
libDir
            Args
libDirs ->
#if MIN_VERSION_Cabal(2,0,0)
              Verbosity -> FilePath -> IO FilePath
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$
#else
              die $
#endif
              FilePath
"Expected a single library directory for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
packageName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
              FilePath
", got " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Args -> FilePath
forall a. Show a => a -> FilePath
show Args
libDirs FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"."

        storeCppLibDir :: FilePath -> IO ()
storeCppLibDir FilePath
libDir = do
          Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
hsCppLibDirFile
          FilePath -> FilePath -> IO ()
writeFile FilePath
hsCppLibDirFile FilePath
libDir

        generateSources :: Interface -> FilePath -> IO ()
generateSources Interface
iface FilePath
libDir = do
          (FilePath
_, FilePath
hsGenDir) <- Verbosity -> LocalBuildInfo -> IO (FilePath, FilePath)
getAutogenAndHsGenDir Verbosity
verbosity LocalBuildInfo
localBuildInfo
          Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
hsGenDir
          [Action]
_ <- [Interface] -> Args -> IO [Action]
run [Interface
iface]
                   [ FilePath
"--enum-eval-cache-mode", FilePath
"must-exist"
                   , FilePath
"--enum-eval-cache-path", FilePath
libDir FilePath -> FilePath -> FilePath
</> FilePath
enumEvalCacheFileName
                   , FilePath
"--gen-hs", FilePath
hsGenDir
                   ]
          () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- See also myHsPreHook.
hsPreHook :: ProjectConfig -> Verbosity -> IO HookedBuildInfo
hsPreHook :: ProjectConfig -> Verbosity -> IO HookedBuildInfo
hsPreHook ProjectConfig
project Verbosity
verbosity = do
  Interface
iface <- ProjectConfig -> Verbosity -> IO Interface
getInterface ProjectConfig
project Verbosity
verbosity
  let moduleNames :: [ModuleName]
moduleNames =
        (Module -> ModuleName) -> [Module] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> ModuleName
forall a. IsString a => FilePath -> a
ModuleName.fromString (FilePath -> ModuleName)
-> (Module -> FilePath) -> Module -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> Module -> FilePath
getModuleName Interface
iface) ([Module] -> [ModuleName]) -> [Module] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$
        Map FilePath Module -> [Module]
forall k a. Map k a -> [a]
M.elems (Interface -> Map FilePath Module
interfaceModules Interface
iface)

  FilePath
libDir <- FilePath -> IO FilePath
readFile FilePath
hsCppLibDirFile

  -- Injected autogenerated modules here works for most commands, however sdist
  -- is not hookable, so autogen-modules should still be written out manually in
  -- your Cabal file!  (See Cabal issue #6180.)
  HookedBuildInfo -> IO HookedBuildInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BuildInfo -> Maybe BuildInfo
forall a. a -> Maybe a
Just BuildInfo
emptyBuildInfo
          { autogenModules = moduleNames
          , extraLibDirs = [libDir]
          }
         , [])