{-# LANGUAGE TupleSections #-}
module NgxExport.Distribution (
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
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"
buildAndHslibdeps :: Verbosity -> PackageDescription -> LocalBuildInfo ->
BuildFlags -> IO ()
buildAndHslibdeps :: Verbosity
-> PackageDescription -> LocalBuildInfo -> BuildFlags -> IO ()
buildAndHslibdeps Verbosity
verbosity PackageDescription
desc LocalBuildInfo
lbi BuildFlags
flags = do
let configGhcOptions :: [(String, [String])]
configGhcOptions =
(String -> (String, [String])) -> [String] -> [(String, [String])]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"ghc", ) ([String] -> (String, [String]))
-> (String -> [String]) -> String -> (String, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) ([String] -> [(String, [String])])
-> ([(CompilerFlavor, [String])] -> [String])
-> [(CompilerFlavor, [String])]
-> [(String, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CompilerFlavor, [String]) -> [String])
-> [(CompilerFlavor, [String])] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CompilerFlavor, [String]) -> [String]
forall a b. (a, b) -> b
snd
([(CompilerFlavor, [String])] -> [String])
-> ([(CompilerFlavor, [String])] -> [(CompilerFlavor, [String])])
-> [(CompilerFlavor, [String])]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CompilerFlavor, [String]) -> Bool)
-> [(CompilerFlavor, [String])] -> [(CompilerFlavor, [String])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(CompilerFlavor
c, [String]
o) -> CompilerFlavor
c CompilerFlavor -> CompilerFlavor -> Bool
forall a. Eq a => a -> a -> Bool
== CompilerFlavor
GHC Bool -> Bool -> Bool
&& Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
o)) ([(CompilerFlavor, [String])] -> [(String, [String])])
-> [(CompilerFlavor, [String])] -> [(String, [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
ready) (String
prog, [String]
v) ->
if String
prog String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"ghc" Bool -> Bool -> Bool
|| [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
v Bool -> Bool -> Bool
|| Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
r
then (Maybe String, Bool)
a
else let v' :: String
v' = [String] -> String
forall a. [a] -> a
head [String]
v
in 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
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])]
configGhcOptions
env :: [(PathTemplateVariable, String)]
env = ((PathTemplateVariable, PathTemplate)
-> (PathTemplateVariable, String))
-> [(PathTemplateVariable, PathTemplate)]
-> [(PathTemplateVariable, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((PathTemplate -> String)
-> (PathTemplateVariable, PathTemplate)
-> (PathTemplateVariable, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second PathTemplate -> String
fromPathTemplate) ([(PathTemplateVariable, PathTemplate)]
-> [(PathTemplateVariable, String)])
-> [(PathTemplateVariable, PathTemplate)]
-> [(PathTemplateVariable, String)]
forall a b. (a -> b) -> a -> b
$
CompilerInfo -> [(PathTemplateVariable, PathTemplate)]
compilerTemplateEnv (Compiler -> CompilerInfo
compilerInfo (Compiler -> CompilerInfo) -> Compiler -> CompilerInfo
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) [(PathTemplateVariable, PathTemplate)]
-> [(PathTemplateVariable, PathTemplate)]
-> [(PathTemplateVariable, PathTemplate)]
forall a. [a] -> [a] -> [a]
++
Platform -> [(PathTemplateVariable, PathTemplate)]
platformTemplateEnv (LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi)
dir :: String
dir = Maybe String -> String
maybeUnknown (PathTemplateVariable
-> [(PathTemplateVariable, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup PathTemplateVariable
ArchVar [(PathTemplateVariable, String)]
env) String -> ShowS
forall a. [a] -> [a] -> [a]
++
Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Maybe String -> String
maybeUnknown (PathTemplateVariable
-> [(PathTemplateVariable, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup PathTemplateVariable
OSVar [(PathTemplateVariable, String)]
env) String -> ShowS
forall a. [a] -> [a] -> [a]
++
Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Maybe String -> String
maybeUnknown (PathTemplateVariable
-> [(PathTemplateVariable, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup PathTemplateVariable
CompilerVar [(PathTemplateVariable, String)]
env)
dirArg :: [String]
dirArg = String
"-d" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String
dir]
maybeUnknown :: Maybe String -> String
maybeUnknown = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"unknown"
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
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
let lib' :: String
lib' = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust Maybe String
lib
plbi :: ProgramDb
plbi = LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi
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 ProgramDb
plbi
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
forall a. [a] -> a
head ([String] -> String)
-> ((String, [String]) -> [String]) -> (String, [String]) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [String]) -> [String]
forall a b. (a, b) -> b
snd) [(String, [String])]
configGhcOptions
Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity ProgramInvocation
ghcR
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
ngxExportHooks :: UserHooks
ngxExportHooks :: UserHooks
ngxExportHooks =
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
normal 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
normal 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 ()
buildAndHslibdeps Verbosity
normal PackageDescription
desc LocalBuildInfo
lbi BuildFlags
flags
}
defaultMain :: IO ()
defaultMain :: IO ()
defaultMain = UserHooks -> IO ()
defaultMainWithHooks UserHooks
ngxExportHooks