{-# LANGUAGE TupleSections #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  NgxExport.Distribution
-- Copyright   :  (c) Alexey Radkov 2021
-- License     :  BSD-style
--
-- Maintainer  :  alexey.radkov@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Quick and dirty build of simple shared libraries and collecting
-- dependencies. This was designed to build custom Haskell handlers for
-- <http://github.com/lyokha/nginx-haskell-module nginx-haskell-module>.
--
-----------------------------------------------------------------------------


module NgxExport.Distribution (
    -- * Usage and examples
    -- $usage
                               buildSharedLib
                              ,patchAndCollectDependentLibs
                              ,ngxExportHooks
                              ,defaultMain
                              ) where

import Distribution.Simple hiding (defaultMain)
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program.Builtin
import Distribution.Simple.Program.Run
import Distribution.Simple.Program.Db
import Distribution.Simple.Program
import Distribution.Simple.Setup
import Distribution.Types.PackageDescription
import Distribution.Types.BuildInfo
import Distribution.Types.Library
import Distribution.Verbosity
import Distribution.Pretty
import System.FilePath
import Control.Exception
import Control.Arrow
import Control.Monad
import Data.Maybe

-- $usage
--
-- This module allows for building simple shared libraries with Cabal.
--
-- Below is a simple example.
--
-- ==== File /ngx_distribution_test.hs/
-- @
-- {-\# LANGUAGE TemplateHaskell \#-}
--
-- module NgxDistributionTest where
--
-- import           NgxExport
--
-- import           Data.ByteString (ByteString)
-- import qualified Data.ByteString.Lazy.Char8 as C8L
-- import           Data.Aeson
-- import           Data.Maybe
--
-- incCnt :: ByteString -> C8L.ByteString
-- incCnt = C8L.pack . show . succ . fromMaybe (0 :: Int) . decodeStrict
-- ngxExportYY \'incCnt
-- @
--
-- ==== File /ngx-distribution-test.cabal/
-- @
-- name:                       ngx-distribution-test
-- version:                    0.1.0.0
-- build-type:                 __/Custom/__
-- cabal-version:              1.24
--
-- __/custom-setup/__
--   setup-depends:            base >= 4.8 && < 5
--                           , __/ngx-export-distribution/__
--
-- library
--   default-language:         Haskell2010
--   build-depends:            base >= 4.8 && < 5
--                           , ngx-export
--                           , bytestring
--                           , aeson
--
--   ghc-options:             -Wall -O2 -no-keep-hi-files -no-keep-o-files
-- @
--
-- ==== File /Setup.hs/
-- @
-- import __/NgxExport.Distribution/__
-- main = 'defaultMain'
-- @
--
-- The configuration step requires that utilities /patchelf/ and
-- <https://github.com/lyokha/nginx-haskell-module/blob/master/utils/hslibdeps hslibdeps>
-- were found in the paths of environment variable /$PATH/.
--
-- Building is a bit cumbersome: it expects explicit option /--prefix/ at the
-- configuration step (which will be interpreted as the first part of the
-- /rpath/ by utility /hslibdeps/), and requires explicit ghc option /-o/ at
-- the build step which is as well used by /hslibdeps/ as the name of the
-- target library. The build also requires the explicit option for linkage
-- against the Haskell RTS library.
--
-- Let's build the example with commands /cabal v1-configure/ and
-- /cabal v1-build/ (the /v2-/commands should probably work as well).
--
-- > $ cabal v1-configure --prefix=/var/lib/nginx
-- > Resolving dependencies...
-- > [1 of 1] Compiling Main             ( dist/setup/setup.hs, dist/setup/Main.o )
-- > Linking ./dist/setup/setup ...
-- > Configuring ngx-distribution-test-0.1.0.0...
--
-- > $ cabal v1-build --ghc-options="ngx_distribution_test.hs -o ngx_distribution_test.so -lHSrts_thr-ghc$(ghc --numeric-version)"
-- > [1 of 1] Compiling NgxDistributionTest ( ngx_distribution_test.hs, ngx_distribution_test.o )
-- > Linking ngx_distribution_test.so ...
-- > ---> Collecting libraries
-- > '/usr/lib64/libHSrts_thr-ghc8.10.5.so' -> 'x86_64-linux-ghc-8.10.5/libHSrts_thr-ghc8.10.5.so'
-- > '/home/lyokha/.cabal/lib/x86_64-linux-ghc-8.10.5/libHSngx-export-1.7.5-JzTEmHewqdC9gGi6rzcAtt-ghc8.10.5.so' -> 'x86_64-linux-ghc-8.10.5/libHSngx-export-1.7.5-JzTEmHewqdC9gGi6rzcAtt-ghc8.10.5.so'
-- > '/home/lyokha/.cabal/lib/x86_64-linux-ghc-8.10.5/libHSmonad-loops-0.4.3-8Lx5Hn3pTtO62yOPdPW77x-ghc8.10.5.so' -> 'x86_64-linux-ghc-8.10.5/libHSmonad-loops-0.4.3-8Lx5Hn3pTtO62yOPdPW77x-ghc8.10.5.so'
-- > '/home/lyokha/.cabal/lib/x86_64-linux-ghc-8.10.5/libHSasync-2.2.4-ENjuIeC23kaKyMVDRYThP3-ghc8.10.5.so' -> 'x86_64-linux-ghc-8.10.5/libHSasync-2.2.4-ENjuIeC23kaKyMVDRYThP3-ghc8.10.5.so'
-- > '/usr/lib64/libHSstm-2.5.0.1-ghc8.10.5.so' -> 'x86_64-linux-ghc-8.10.5/libHSstm-2.5.0.1-ghc8.10.5.so'
-- > '/home/lyokha/.cabal/lib/x86_64-linux-ghc-8.10.5/libHSaeson-1.5.6.0-6XeGmWHoO3vJYEUW5PXPgC-ghc8.10.5.so' -> 'x86_64-linux-ghc-8.10.5/libHSaeson-1.5.6.0-6XeGmWHoO3vJYEUW5PXPgC-ghc8.10.5.so'
-- >
-- >    ...
-- >
-- > '/usr/lib64/libHSbase-4.14.2.0-ghc8.10.5.so' -> 'x86_64-linux-ghc-8.10.5/libHSbase-4.14.2.0-ghc8.10.5.so'
-- > '/usr/lib64/libHSinteger-gmp-1.0.3.0-ghc8.10.5.so' -> 'x86_64-linux-ghc-8.10.5/libHSinteger-gmp-1.0.3.0-ghc8.10.5.so'
-- > '/usr/lib64/libHSghc-prim-0.6.1-ghc8.10.5.so' -> 'x86_64-linux-ghc-8.10.5/libHSghc-prim-0.6.1-ghc8.10.5.so'
-- >
-- > ---> Patching ngx_distribution_test.so
-- > /var/lib/nginx/x86_64-linux-ghc-8.10.5:/home/lyokha/.cabal/lib/x86_64-linux-ghc-8.10.5:/usr/lib64:/usr/lib64/ghc-8.10.5/rts
--
-- Now the current working directory contains new files
-- /ngx_distribution_test.so/ and /ngx_distribution_test-0.1.0.0.tar.gz/ and a
-- new directory /x86_64-linux-ghc-8.10.5/. The tar-file contains the patched
-- shared library and the directory with dependent libraries: it is ready for
-- installation in directory /\/var\/lib\/nginx/ at the target system.
--
-- With this building approach, the following list of drawbacks must be taken
-- into account.
--
-- - Utility /hslibdeps/ collects only libraries prefixed with /libHS/,
-- - command /cabal v1-clean/ only deletes directory /dist/, it does not delete
--   build artifacts in the current working directory,
-- - behavior of Cabal commands other than /configure/, /build/ and /clean/ is
--   not well defined.

data LibNameNotSpecified = LibNameNotSpecified

instance Exception LibNameNotSpecified
instance Show LibNameNotSpecified where
    show :: LibNameNotSpecified -> String
show = String -> LibNameNotSpecified -> String
forall a b. a -> b -> a
const String
"Error: the library name was not specified, \
                 \the name must be passed in ghc with option -o"

hslibdeps :: Program
hslibdeps :: Program
hslibdeps = String -> Program
simpleProgram String
"hslibdeps"

patchelf :: Program
patchelf :: Program
patchelf = String -> Program
simpleProgram String
"patchelf"

-- | Builds a shared library.
--
-- Runs /ghc/ compiler with the following arguments.
--
-- - /-dynamic/, /-shared/, /-fPIC/,
-- - all arguments listed in /ghc-options/ in the Cabal file,
-- - all arguments passed in option /--ghc-options/ from command-line.
--
-- Requires that the arguments contain /-o path/ for the path to the shared
-- library to build.
--
-- Returns the path to the built shared library.
buildSharedLib :: Verbosity                         -- ^ Verbosity level
               -> PackageDescription                -- ^ Package description
               -> LocalBuildInfo                    -- ^ Local build info
               -> BuildFlags                        -- ^ Build flags
               -> IO FilePath
buildSharedLib :: Verbosity
-> PackageDescription -> LocalBuildInfo -> BuildFlags -> IO String
buildSharedLib Verbosity
verbosity PackageDescription
desc LocalBuildInfo
lbi BuildFlags
flags = do
    let configGhcOptions :: [(String, String)]
configGhcOptions =
            [(String, String)]
-> ([String] -> [(String, String)])
-> Maybe [String]
-> [(String, String)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (String
"ghc", )) (Maybe [String] -> [(String, String)])
-> Maybe [String] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$
                CompilerFlavor -> [(CompilerFlavor, [String])] -> Maybe [String]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CompilerFlavor
GHC ([(CompilerFlavor, [String])] -> Maybe [String])
-> [(CompilerFlavor, [String])] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ PerCompilerFlavor [String] -> [(CompilerFlavor, [String])]
forall v. PerCompilerFlavor v -> [(CompilerFlavor, v)]
perCompilerFlavorToList (PerCompilerFlavor [String] -> [(CompilerFlavor, [String])])
-> PerCompilerFlavor [String] -> [(CompilerFlavor, [String])]
forall a b. (a -> b) -> a -> b
$
                    BuildInfo -> PerCompilerFlavor [String]
options (BuildInfo -> PerCompilerFlavor [String])
-> BuildInfo -> PerCompilerFlavor [String]
forall a b. (a -> b) -> a -> b
$ Library -> BuildInfo
libBuildInfo (Library -> BuildInfo) -> Library -> BuildInfo
forall a b. (a -> b) -> a -> b
$ Maybe Library -> Library
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Library -> Library) -> Maybe Library -> Library
forall a b. (a -> b) -> a -> b
$ PackageDescription -> Maybe Library
library PackageDescription
desc
        lib :: Maybe String
lib = (Maybe String, Bool) -> Maybe String
forall a b. (a, b) -> a
fst ((Maybe String, Bool) -> Maybe String)
-> (Maybe String, Bool) -> Maybe String
forall a b. (a -> b) -> a -> b
$
            ((Maybe String, Bool)
 -> (String, [String]) -> (Maybe String, Bool))
-> (Maybe String, Bool)
-> [(String, [String])]
-> (Maybe String, Bool)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a :: (Maybe String, Bool)
a@(Maybe String
r, Bool
_) (String
prog, [String]
v) ->
                if String
prog String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"ghc" Bool -> Bool -> Bool
|| Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
r
                    then (Maybe String, Bool)
a
                    else ((Maybe String, Bool) -> String -> (Maybe String, Bool))
-> (Maybe String, Bool) -> [String] -> (Maybe String, Bool)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a' :: (Maybe String, Bool)
a'@(Maybe String
r', Bool
ready) String
v' ->
                                    if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
r'
                                        then (Maybe String, Bool)
a'
                                        else if String
v' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-o"
                                                 then (Maybe String
forall a. Maybe a
Nothing, Bool
True)
                                                 else if Bool
ready
                                                          then (String -> Maybe String
forall a. a -> Maybe a
Just String
v', Bool
False)
                                                          else (Maybe String
forall a. Maybe a
Nothing, Bool
False)
                               ) (Maybe String, Bool)
a [String]
v
                  ) (Maybe String
forall a. Maybe a
Nothing, Bool
False) ([(String, [String])] -> (Maybe String, Bool))
-> [(String, [String])] -> (Maybe String, Bool)
forall a b. (a -> b) -> a -> b
$
                      BuildFlags -> [(String, [String])]
buildProgramArgs BuildFlags
flags [(String, [String])]
-> [(String, [String])] -> [(String, [String])]
forall a. [a] -> [a] -> [a]
++
                          ((String, String) -> (String, [String]))
-> [(String, String)] -> [(String, [String])]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> [String]) -> (String, String) -> (String, [String])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second String -> [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) [(String, String)]
configGhcOptions
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
lib) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ LibNameNotSpecified -> IO ()
forall e a. Exception e => e -> IO a
throwIO LibNameNotSpecified
LibNameNotSpecified
    ConfiguredProgram
ghcP <- (ConfiguredProgram, ProgramDb) -> ConfiguredProgram
forall a b. (a, b) -> a
fst ((ConfiguredProgram, ProgramDb) -> ConfiguredProgram)
-> IO (ConfiguredProgram, ProgramDb) -> IO ConfiguredProgram
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
ghcProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
    let ghcR :: ProgramInvocation
ghcR = ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
ghcP ([String] -> ProgramInvocation) -> [String] -> ProgramInvocation
forall a b. (a -> b) -> a -> b
$ [String
"-dynamic", String
"-shared", String
"-fPIC"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
            ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd [(String, String)]
configGhcOptions
    Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity ProgramInvocation
ghcR
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust Maybe String
lib

-- | Patches the shared library and collects dependent Haskell libraries.
--
-- Performs the following steps.
--
-- - Adds the value of /prefix/ to the list of /rpath/ in the shared library,
-- - collects all dependent Haskell libraries in a directory whose name forms
--   as /arch-os-compiler/,
-- - archives the shared library and the directory with the collected dependent
--   libraries in a /tar.gz/ file.
--
-- The initial 2 steps are performed by utility
-- <https://github.com/lyokha/nginx-haskell-module/blob/master/utils/hslibdeps hslibdeps>.
-- It collects all libraries with prefix /libHS/ from the list returned by
-- command /ldd/ applied to the shared library.
patchAndCollectDependentLibs :: Verbosity           -- ^ Verbosity level
                             -> FilePath            -- ^ Path to the library
                             -> PackageDescription  -- ^ Package description
                             -> LocalBuildInfo      -- ^ Local build info
                             -> IO ()
patchAndCollectDependentLibs :: Verbosity
-> String -> PackageDescription -> LocalBuildInfo -> IO ()
patchAndCollectDependentLibs Verbosity
verbosity String
lib PackageDescription
desc LocalBuildInfo
lbi = do
    let dir :: String
dir = Platform -> String
forall a. Pretty a => a -> String
prettyShow (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi) String -> ShowS
forall a. [a] -> [a] -> [a]
++
            Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: CompilerId -> String
forall a. Pretty a => a -> String
prettyShow (Compiler -> CompilerId
compilerId (Compiler -> CompilerId) -> Compiler -> CompilerId
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi)
        dirArg :: [String]
dirArg = String
"-d" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String
dir]
        rpathArg :: [String]
rpathArg = [String]
-> (PathTemplate -> [String]) -> Maybe PathTemplate -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((String
"-t" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String])
-> (PathTemplate -> [String]) -> PathTemplate -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String])
-> (PathTemplate -> String) -> PathTemplate -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
</> String
dir) ShowS -> (PathTemplate -> String) -> PathTemplate -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathTemplate -> String
fromPathTemplate) (Maybe PathTemplate -> [String]) -> Maybe PathTemplate -> [String]
forall a b. (a -> b) -> a -> b
$
            Flag PathTemplate -> Maybe PathTemplate
forall a. Flag a -> Maybe a
flagToMaybe (Flag PathTemplate -> Maybe PathTemplate)
-> Flag PathTemplate -> Maybe PathTemplate
forall a b. (a -> b) -> a -> b
$ InstallDirs (Flag PathTemplate) -> Flag PathTemplate
forall dir. InstallDirs dir -> dir
prefix (InstallDirs (Flag PathTemplate) -> Flag PathTemplate)
-> InstallDirs (Flag PathTemplate) -> Flag PathTemplate
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> InstallDirs (Flag PathTemplate)
configInstallDirs (ConfigFlags -> InstallDirs (Flag PathTemplate))
-> ConfigFlags -> InstallDirs (Flag PathTemplate)
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ConfigFlags
configFlags LocalBuildInfo
lbi
        plbi :: ProgramDb
plbi = LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi
    ConfiguredProgram
hslibdepsP <- (ConfiguredProgram, ProgramDb) -> ConfiguredProgram
forall a b. (a, b) -> a
fst ((ConfiguredProgram, ProgramDb) -> ConfiguredProgram)
-> IO (ConfiguredProgram, ProgramDb) -> IO ConfiguredProgram
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
hslibdeps ProgramDb
plbi
    let hslibdepsR :: ProgramInvocation
hslibdepsR = ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
hslibdepsP ([String] -> ProgramInvocation) -> [String] -> ProgramInvocation
forall a b. (a -> b) -> a -> b
$ String
lib String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
rpathArg [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
dirArg
    Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity ProgramInvocation
hslibdepsR
    ConfiguredProgram
tarP <- (ConfiguredProgram, ProgramDb) -> ConfiguredProgram
forall a b. (a, b) -> a
fst ((ConfiguredProgram, ProgramDb) -> ConfiguredProgram)
-> IO (ConfiguredProgram, ProgramDb) -> IO ConfiguredProgram
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
tarProgram ProgramDb
plbi
    let ver :: Version
ver = PackageIdentifier -> Version
pkgVersion (PackageIdentifier -> Version) -> PackageIdentifier -> Version
forall a b. (a -> b) -> a -> b
$ PackageDescription -> PackageIdentifier
package PackageDescription
desc
        tar :: String
tar = String -> ShowS
addExtension (ShowS
takeBaseName String
lib String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Version -> String
forall a. Pretty a => a -> String
prettyShow Version
ver) String
"tar.gz"
        tarR :: ProgramInvocation
tarR = ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
tarP [String
"czf", String
tar, String
lib, String
dir]
    Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity ProgramInvocation
tarR

-- | Build hooks.
--
-- Based on 'simpleUserHooks'. Overrides
--
-- - 'confHook' by configuring programs /hslibdeps/ and /patchelf/ and then
--   running the original /confHook/ from /simpleUserHooks/,
-- - 'buildHook' by running in sequence 'buildSharedLib' and
--   'patchAndCollectDependentLibs'.
--
-- Other hooks from /simpleUserHooks/ get derived as is. Running them is
-- neither tested nor recommended.
ngxExportHooks :: Verbosity                         -- ^ Verbosity level
               -> UserHooks
ngxExportHooks :: Verbosity -> UserHooks
ngxExportHooks Verbosity
verbosity =
    let hooks :: UserHooks
hooks = UserHooks
simpleUserHooks
    in UserHooks
hooks { hookedPrograms :: [Program]
hookedPrograms = [Program
hslibdeps]
             , confHook :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
confHook = \(GenericPackageDescription, HookedBuildInfo)
desc ConfigFlags
flags -> do
                 let pdb :: ProgramDb
pdb = WithCallStack (ConfigFlags -> ProgramDb)
ConfigFlags -> ProgramDb
configPrograms ConfigFlags
flags
                 (ConfiguredProgram, ProgramDb)
_ <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
hslibdeps ProgramDb
pdb IO (ConfiguredProgram, ProgramDb)
-> ((ConfiguredProgram, ProgramDb)
    -> IO (ConfiguredProgram, ProgramDb))
-> IO (ConfiguredProgram, ProgramDb)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                          Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
patchelf (ProgramDb -> IO (ConfiguredProgram, ProgramDb))
-> ((ConfiguredProgram, ProgramDb) -> ProgramDb)
-> (ConfiguredProgram, ProgramDb)
-> IO (ConfiguredProgram, ProgramDb)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConfiguredProgram, ProgramDb) -> ProgramDb
forall a b. (a, b) -> b
snd
                 UserHooks
-> (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags
-> IO LocalBuildInfo
confHook UserHooks
simpleUserHooks (GenericPackageDescription, HookedBuildInfo)
desc ConfigFlags
flags
             , buildHook :: PackageDescription
-> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
buildHook =  \PackageDescription
desc LocalBuildInfo
lbi UserHooks
_ BuildFlags
flags ->
                 Verbosity
-> PackageDescription -> LocalBuildInfo -> BuildFlags -> IO String
buildSharedLib Verbosity
verbosity PackageDescription
desc LocalBuildInfo
lbi BuildFlags
flags IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
lib ->
                     Verbosity
-> String -> PackageDescription -> LocalBuildInfo -> IO ()
patchAndCollectDependentLibs Verbosity
verbosity String
lib PackageDescription
desc LocalBuildInfo
lbi
             }

-- | A simple implementation of /main/ for a Cabal setup script.
--
-- Implemented as
--
-- @
-- defaultMain = 'defaultMainWithHooks' $ 'ngxExportHooks' 'normal'
-- @
defaultMain :: IO ()
defaultMain :: IO ()
defaultMain = UserHooks -> IO ()
defaultMainWithHooks (UserHooks -> IO ()) -> UserHooks -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> UserHooks
ngxExportHooks Verbosity
normal