diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,7 @@ +### 0.5.0.0 + +- Build executable *nhm-tool* to replace utilities *hslibdeps* and *nhm-init*. + ### 0.4.1.0 - Test GHC version to figure out whether to use option *-flink-rts* in run-time. diff --git a/NgxExport/Distribution.hs b/NgxExport/Distribution.hs --- a/NgxExport/Distribution.hs +++ b/NgxExport/Distribution.hs @@ -33,6 +33,9 @@ -- *** Building dependencies with cabal v2-build -- $deps-cabal-v2 + -- *** Bootstrapping a new project + -- $bootstrapping-project + -- *** Drawbacks -- $drawbacks @@ -114,14 +117,23 @@ -- main = 'defaultMain' -- @ -- --- The configuration step requires that utilities /patchelf/ and --- --- were found in the paths of environment variable /$PATH/. +-- The configuration step requires that utilities /nhm-tool/ and /patchelf/ +-- were found in the paths of environment variable /$PATH/. The /nhm-tool/ is +-- packaged with this module and can be installed by running -- +-- > $ cabal install +-- +-- from the root directory of the module or by running +-- +-- > $ cabal install ngx-export-distribution +-- +-- from any other directory, in which case it will be installed from /Hackage/. +-- -- Building is a bit cumbersome: it expects explicit option /--prefix/ at the -- configuration step (which will be interpreted as the prefix part of the --- /rpath/ by utility /hslibdeps/) and explicit ghc option /-o/ at the build --- step which is as well used by /hslibdeps/ as the name of the target library. +-- /rpath/ by /nhm-tool dist/) and explicit ghc option /-o/ at the build +-- step which is as well used by /nhm-tool dist/ as the name of the target +-- library. -- $cabal-v1 -- @@ -194,15 +206,18 @@ -- $setup-hs -- --- For building custom artifacts, options of /hslibdeps/ must be accessed +-- For building custom artifacts, options of /nhm-tool dist/ must be accessed -- directly. For this, commands /runhaskell Setup.hs configure \/ build/ can be -- used instead of /cabal v1-configure \/ v1-build/. Let's change the names of -- the directory with dependent libraries and the tar-file to /deps\// and -- /deps.tar.gz/ respectively, and also define the /rpath/ directory without -- using option /--prefix/. -- --- > $ runhaskell Setup.hs configure --user --hslibdeps-options="-t/var/lib/nginx/deps -ddeps -adeps" +-- > $ runhaskell Setup.hs configure --user --nhm-tool-options="-t/var/lib/nginx/deps -ddeps -adeps" -- +-- Note that despite the name /--nhm-tool-options/, the specified options are +-- passed internally into a sub-command /nhm-tool dist/. +-- -- > $ runhaskell Setup.hs build --ghc-options="ngx_distribution_test.hs -o ngx_distribution_test.so -threaded" -- $deps-cabal-v2 @@ -213,13 +228,7 @@ -- build dependencies and put them in a package environment in the current -- working directory. -- --- > $ cabal v2-install --lib --only-dependencies --package-env . --- --- > $ cabal v2-build ngx-export-distribution --- --- The second command is probably no-op because /ngx-export-distribution/ should --- have been installed by the first command. At least in Cabal /3.10/, this is --- the case. +-- > $ cabal install --lib --only-dependencies --package-env . -- -- > $ sed -i 's/\(^package-id \)/--\1/' .ghc.environment.x86_64-linux-$(ghc --numeric-version) -- @@ -243,10 +252,10 @@ -- [cabal-plan](https://hackage.haskell.org/package/cabal-plan), finding the -- direct dependencies in the /cabal plan/ can be done automatically. -- --- > $ hslibdeps -e >> .ghc.environment.x86_64-linux-$(ghc --numeric-version) +-- > $ nhm-tool deps ngx-distribution-test >> .ghc.environment.x86_64-linux-$(ghc --numeric-version) -- --- Command /hslibdeps -e/ is a convenient wrapper around /cabal-plan/. After --- running this, four lines looking similar to +-- Command /nhm-tool deps/ builds around the code of the /cabal-plan/ library. +-- After running this, four lines looking similar to -- -- > package-id aeson-2.1.0.0-9b19e87ee2a82567866c50e13806427068fd4bcc78cedb01ecad7389791f6761 -- > package-id base-4.17.0.0 @@ -262,38 +271,54 @@ -- Haskell libraries found in the global package database and the Cabal package -- store. +-- $bootstrapping-project +-- +-- All the steps listed in the previous section can be automated. This is +-- exactly what /nhm-tool init/ does. Running +-- +-- > $ nhm-tool init project-name +-- +-- produces files /cabal.project/, /Setup.hs/, /project-name.cabal/, /Makefile/, +-- and /project_name.hs/. If any of the former four files exist, add option /-f/ +-- to override them. +-- +-- Note that the root Haskell source file is /project_name.hs/ where +-- /project_name/ is /project-name/ with all dashes replaced by underscores. If +-- the source code will depend on packages other than /base/ and /ngx-export/, +-- add them into /project-name.cabal/ manually. +-- +-- By default, the target library will be linked against the threaded Haskell +-- RTS library. To link against the base RTS library, add option /-no-threaded/. +-- +-- The target library will be installed in directory /\/var\/lib\/nginx/. Use +-- option /-p prefix/ to override the install directory. +-- +-- Build and install the target library. +-- +-- > $ make +-- > $ sudo make install +-- +-- With ghc older than /8.10.6/, build with +-- +-- > $ make LINKRTS=-lHSrts_thr-ghc$(ghc --numeric-version) + -- $drawbacks -- -- With all the building approaches shown above, the following list of drawbacks -- must be taken into account. -- --- - Utility /hslibdeps/ collects only libraries prefixed with /libHS/, +-- - Utility /nhm-tool/ collects only libraries prefixed with /libHS/, -- - clean commands such as /cabal v1-clean/ do not delete build artifacts in -- the current working directory, -- - behavior of Cabal commands other than /configure/, /build/ and /clean/ is -- not well defined. -hslibdeps :: Program -hslibdeps = simpleProgram "hslibdeps" +nhmTool :: Program +nhmTool = simpleProgram "nhm-tool" patchelf :: Program patchelf = simpleProgram "patchelf" -requireHslibdeps :: Verbosity -> ProgramDb -> IO (ConfiguredProgram, ProgramDb) -requireHslibdeps verbosity progdb = do - mres <- needProgram verbosity prog progdb - case mres of - Nothing -> die' verbosity notFound - Just res -> return res - where prog = hslibdeps - progName = programName prog - notFound = "The program '" ++ progName ++ - "' is required but it could not be found." ++ - "\nNote: Get '" ++ progName ++ "' from " ++ url ++ - " and put it into a directory listed in the PATH." - url = "https://github.com/lyokha/nginx-haskell-module\ - \/blob/master/utils/hslibdeps" - -- | Builds a shared library. -- -- Runs /ghc/ compiler with the following arguments. @@ -332,8 +357,8 @@ map (second pure) configGhcOptions (lib', extraGhcOptions) = maybe (let name = unPackageName $ pkgName $ package desc - nameSo = addExtension name "so" - in (nameSo, [addExtension name "hs", "-o", nameSo]) + nameSo = name <.> "so" + in (nameSo, [name <.> "hs", "-o", nameSo]) ) (, []) lib unless (null extraGhcOptions) $ do let extraSourceFile = head extraGhcOptions @@ -357,17 +382,16 @@ -- -- - Collects all dependent Haskell libraries in a directory with the name equal -- to the value of /$abi/ which normally expands to /$arch-$os-$compiler/ (or --- with that overridden in option /--hslibdeps-options/), +-- with that overridden in option /--nhm-tool-options/), -- - adds value /$prefix\/$abi/ (or that overridden in option --- /--hslibdeps-options/) in the beginning of the list of /rpath/ in the +-- /--nhm-tool-options/) in the beginning of the list of /rpath/ in the -- shared library, -- - archives the shared library and the directory with the collected dependent -- libraries in a /tar.gz/ file. -- --- All steps are performed by utility --- . --- It collects all libraries with prefix /libHS/ from the list returned by --- command /ldd/ applied to the shared library. +-- All steps are performed by utility /nhm-tool/. 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 @@ -380,16 +404,16 @@ rpathArg = maybe [] (("-t" :) . pure . ( dir) . fromPathTemplate) $ flagToMaybe $ prefix $ configInstallDirs $ configFlags lbi archiveArg = "-a" : [prettyShow $ package desc] - hslibdepsP <- fst <$> requireHslibdeps verbosity (withPrograms lbi) - let hslibdepsR = programInvocation hslibdepsP $ - lib : rpathArg ++ dirArg ++ archiveArg - runProgramInvocation verbosity hslibdepsR + nhmToolP <- fst <$> requireProgram verbosity nhmTool (withPrograms lbi) + let nhmToolR = programInvocation nhmToolP $ + "dist" : lib : "-v" : rpathArg ++ dirArg ++ archiveArg + runProgramInvocation verbosity nhmToolR -- | Build hooks. -- -- Based on 'simpleUserHooks'. Overrides -- --- - 'confHook' by configuring programs /hslibdeps/ and /patchelf/ and then +-- - 'confHook' by configuring programs /nhm-tool/ and /patchelf/ and then -- running the original /confHook/ from /simpleUserHooks/, -- - 'buildHook' by running in sequence 'buildSharedLib' and -- 'patchAndCollectDependentLibs'. @@ -398,11 +422,11 @@ -- neither tested nor recommended. ngxExportHooks :: UserHooks ngxExportHooks = - simpleUserHooks { hookedPrograms = [hslibdeps] + simpleUserHooks { hookedPrograms = [nhmTool] , confHook = \desc flags -> do let verbosity = toVerbosity $ configVerbosity flags pdb = configPrograms flags - _ <- requireHslibdeps verbosity pdb >>= + _ <- requireProgram verbosity nhmTool pdb >>= requireProgram verbosity patchelf . snd confHook simpleUserHooks desc flags , buildHook = \desc lbi _ flags -> do diff --git a/ngx-export-distribution.cabal b/ngx-export-distribution.cabal --- a/ngx-export-distribution.cabal +++ b/ngx-export-distribution.cabal @@ -1,5 +1,5 @@ name: ngx-export-distribution -version: 0.4.1.0 +version: 0.5.0.0 synopsis: Build custom libraries for Nginx haskell module description: Build custom libraries for . @@ -23,6 +23,24 @@ , filepath exposed-modules: NgxExport.Distribution + + ghc-options: -Wall + +executable nhm-tool + default-language: Haskell2010 + build-depends: base >= 4.8 && < 5 + , Cabal >= 3.0.0.0 + , directory + , filepath + , text + , containers + , prettyprinter + , prettyprinter-ansi-terminal + , cabal-plan + , parsec + , extra + + main-is: nhm-tool.hs ghc-options: -Wall diff --git a/nhm-tool.hs b/nhm-tool.hs new file mode 100644 --- /dev/null +++ b/nhm-tool.hs @@ -0,0 +1,526 @@ +{-# LANGUAGE RecordWildCards, LambdaCase, MultiWayIf, ViewPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Text.Parsec +import Distribution.Simple.Program.Types +import Distribution.Simple.Program +import Distribution.Verbosity +import Cabal.Plan +import Control.Monad +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Data.Text (Text) +import qualified Data.Map as M +import qualified Data.Set as S +import Data.Functor +import Data.Maybe +import Data.Char +import Data.List +import Data.List.Extra +import Prettyprinter (pretty, annotate) +import Prettyprinter.Render.Terminal +import System.Environment +import System.Directory +import System.FilePath +import System.Exit +import System.IO +import GHC.IO.Device +import qualified GHC.IO.FD as FD + +data DistData = DistData { distDataDir :: String + , distDataArchive :: String + , distDataTargetDir :: String + , distDataPatchOnly :: Bool + , distDataTargetLib :: String + , distDataWait :: Maybe ArgWait + , distDataOwnVerbosity :: Verbosity + , distDataOtherVerbosity :: Verbosity + , distDataHelp :: Bool + } + +defaultDistDataDir :: String +defaultDistDataDir = ".hslibs" + +data DepsData = DepsData { depsDataProject :: String + , depsDataHelp :: Bool + } + +data InitData = InitData { initDataPrefix :: String + , initDataNoThreaded :: Bool + , initDataForce :: Bool + , initDataToStdout :: Bool + , initDataProject :: String + , initDataWait :: Maybe ArgWait + , initDataHelp :: Bool + } + +defaultInitDataPrefix :: String +defaultInitDataPrefix = "/var/lib/nginx" + +data ArgWait = ArgWaitA | ArgWaitD | ArgWaitT | ArgWaitP + +data LddRec = LibHS String (Maybe FilePath) + | LibOther String (Maybe FilePath) + deriving Show + +data HelpSection = HelpDist | HelpDeps | HelpInit deriving Eq + +usage :: Maybe HelpSection -> Bool -> IO () +usage section success = do + when (isNothing section) $ + putStrLn "nhm-tool: help building custom Haskell handlers for Nginx\n\ + \this is a tool from \ + \https://github.com/lyokha/nginx-haskell-module\n" + putStrLn "Usage:" + when (isNothing section || section == Just HelpDist) $ + T.putStrLn $ T.concat ["\n\ + \ * nhm-tool dist [-d dir -a ar | -p] [-t target_dir] [-v | -vv] \ + \hslib\n\n\ + \ 'dir' is a directory where dependent libraries will be\n\ + \ collected (default is", T.pack defaultDistDataDir, ")\n\ + \ 'target_dir' is a directory where dependent libraries will be\n\ + \ installed (no default, 'hslib' will not be patched if omitted)\n\ + \ 'ar' is the base name of the archive to contain 'hslib' and\n\ + \ 'dir' (no default, the archive will not be created if omitted)\n\ + \ if '-p' (patch-only) is specified then dependent libraries will\n\ + \ neither be collected nor archived\n\ + \ use options '-v' and '-vv' to increase verbosity level\n\ + \ special value '-' for 'dir', 'target_dir', and 'ar' resets them\n\ + \ (with -d- being equivalent to -p)" + ] + when (isNothing section || section == Just HelpDeps) $ + T.putStrLn "\n\ + \ * nhm-tool deps project-name\n\n\ + \ print all direct dependencies of the given project,\n\ + \ the output is compatible with the format of GHC environment files" + when (isNothing section || section == Just HelpInit) $ + T.putStrLn $ T.concat ["\n\ + \ * nhm-tool init [-p dir] [-no-threaded] [-f | -to-stdout] \ + \project-name\n\n\ + \ '-p' prefix for install dir, default is ", + T.pack defaultInitDataPrefix, "\n\ + \ '-no-threaded' use base RTS library\n\ + \ '-f' force re-writing of existing files (except the source file)\n\ + \ '-to-stdout' do not write files but dump what will be written" + ] + when (isNothing section) $ + T.putStrLn "\n\ + \ * nhm-tool [-h | -help | --help]\n\n\ + \ show this help message and exit, applicable in sub-commands \ + \as well" + if success + then exitSuccess + else exitFailure + +main :: IO () +main = do + args <- getArgs + when (null args) $ usage Nothing True + case head args of + "dist" -> do + let distData = foldl parseDistArgs (Just defaultArgs) $ tail args + defaultArgs = DistData defaultDistDataDir "" "" False "" + Nothing normal normal False + case distData of + Nothing -> usage (Just HelpDist) False + Just (normalizeDistData -> distData'@DistData {..}) -> + if distDataHelp + then usage (Just HelpDist) True + else if isJust distDataWait || null distDataTargetLib + then usage (Just HelpDist) False + else cmdDist distData' + "deps" -> do + let depsData = foldl parseDepsArgs (Just defaultArgs) $ tail args + defaultArgs = DepsData "" False + case depsData of + Nothing -> usage (Just HelpDeps) False + Just depsData'@DepsData {..} -> + if depsDataHelp + then usage (Just HelpDeps) True + else if null depsDataProject + then usage (Just HelpDeps) False + else cmdDeps depsData' + "init" -> do + let initData = foldl parseInitArgs (Just defaultArgs) $ tail args + defaultArgs = InitData defaultInitDataPrefix False False False + "" Nothing False + case initData of + Nothing -> usage (Just HelpInit) False + Just initData'@InitData {..} -> + if initDataHelp + then usage (Just HelpInit) True + else if isJust initDataWait || null initDataProject || + initDataForce && initDataToStdout + then usage (Just HelpInit) False + else cmdInit initData' + "-h" -> usage Nothing True + "-help" -> usage Nothing True + "--help" -> usage Nothing True + _ -> usage Nothing False + where normalizeDistData dist@DistData {..} = + dist { distDataTargetDir = + if distDataTargetDir == "-" + then "" + else distDataTargetDir + , distDataArchive = + if distDataArchive == "-" + then "" + else distDataArchive + , distDataPatchOnly = + distDataDir == "-" || distDataPatchOnly + } + +parseDistArgs :: Maybe DistData -> String -> Maybe DistData +parseDistArgs Nothing _ = Nothing +parseDistArgs (Just dist@DistData {..}) arg = + case distDataWait of + Nothing -> + let optLong = length arg > 2 + optValue = drop 2 arg + in if | "-d" `isPrefixOf` arg -> + if optLong + then Just dist' { distDataDir = optValue } + else Just dist { distDataWait = Just ArgWaitD } + | "-t" `isPrefixOf` arg -> + if optLong + then Just dist' { distDataTargetDir = optValue } + else Just dist { distDataWait = Just ArgWaitT } + | "-a" `isPrefixOf` arg -> + if optLong + then Just dist' { distDataArchive = optValue } + else Just dist { distDataWait = Just ArgWaitA } + | "-p" == arg -> + Just dist' { distDataPatchOnly = True } + | "-v" == arg -> + Just dist' { distDataOwnVerbosity = verbose } + | "-vv" == arg -> + Just dist' { distDataOwnVerbosity = verbose + , distDataOtherVerbosity = verbose + } + | "-h" == arg || "-help" == arg || "--help" == arg -> + Just dist' { distDataHelp = True } + | "-" `isPrefixOf` arg -> Nothing + | otherwise -> + if null distDataTargetLib + then Just dist' { distDataTargetLib = arg } + else Nothing + Just ArgWaitD -> Just dist' { distDataDir = arg } + Just ArgWaitT -> Just dist' { distDataTargetDir = arg } + Just ArgWaitA -> Just dist' { distDataArchive = arg } + Just _ -> undefined + where dist' = dist { distDataWait = Nothing } + +parseDepsArgs :: Maybe DepsData -> String -> Maybe DepsData +parseDepsArgs Nothing _ = Nothing +parseDepsArgs (Just deps@DepsData {..}) arg = + if | "-h" == arg || "-help" == arg || "--help" == arg -> + Just deps { depsDataHelp = True } + | "-" `isPrefixOf` arg -> Nothing + | otherwise -> + if null depsDataProject + then Just deps { depsDataProject = arg } + else Nothing + +parseInitArgs :: Maybe InitData -> String -> Maybe InitData +parseInitArgs Nothing _ = Nothing +parseInitArgs (Just init'@InitData {..}) arg = + case initDataWait of + Nothing -> + let optLong = length arg > 2 + optValue = drop 2 arg + in if | "-p" `isPrefixOf` arg -> + if optLong + then Just init'' { initDataPrefix = optValue } + else Just init' { initDataWait = Just ArgWaitP } + | "-no-threaded" == arg -> + Just init'' { initDataNoThreaded = True } + | "-f" == arg -> + Just init'' { initDataForce = True } + | "-to-stdout" == arg -> + Just init'' { initDataToStdout = True } + | "-h" == arg || "-help" == arg || "--help" == arg -> + Just init'' { initDataHelp = True } + | "-" `isPrefixOf` arg -> Nothing + | otherwise -> + if null initDataProject + then Just init'' { initDataProject = arg } + else Nothing + Just ArgWaitP -> Just init'' { initDataPrefix = arg } + Just _ -> undefined + where init'' = init' { initDataWait = Nothing } + +cmdDist :: DistData -> IO () +cmdDist DistData {..} = do + let pdb = emptyProgramDb + patchelf = simpleProgram "patchelf" + ldd = simpleProgram "ldd" + (patchelf', pdb') <- requireProgram distDataOtherVerbosity patchelf pdb + if distDataPatchOnly + then patchTargetLib patchelf' + else do + (ldd', pdb'') <- requireProgram distDataOtherVerbosity ldd pdb' + putStrLn' "---> Collecting libraries" + lddOut <- getProgramOutput distDataOtherVerbosity + ldd' [distDataTargetLib] + case parseLddOutput lddOut of + Left msg -> do + hPrint stderr msg + exitFailure + Right recs -> do + (tar', _) <- requireProgram distDataOtherVerbosity + tarProgram pdb'' + collectLibs recs lddOut + unless (null distDataTargetDir) $ putStrLn' "" + patchTargetLib patchelf' + putStrLn' "" + archiveLibs tar' + where patchTargetLib patchelf' = + unless (null distDataTargetDir) $ do + putStrLn' $ "---> Patching " ++ distDataTargetLib + patchelfOut <- getProgramOutput distDataOtherVerbosity + patchelf' ["--print-rpath", distDataTargetLib] + case parsePatchelfRpathOutput patchelfOut of + Left msg -> do + hPrint stderr msg + exitFailure + Right paths -> do + unless (distDataTargetDir `elem` paths) $ + runProgram distDataOtherVerbosity patchelf' + ["--set-rpath" + ,distDataTargetDir ++ ':' : patchelfOut + ,distDataTargetLib + ] + patchelfOut' <- getProgramOutput + distDataOtherVerbosity + patchelf' ["--print-rpath" + ,distDataTargetLib + ] + putStrLnTrim patchelfOut' + collectLibs recs lddOut = do + let recsLibHS = filter (\case + LibHS _ _ -> True + _ -> False + ) recs + if null recsLibHS + then do + hPutStrLn stderr + "There were no Haskell libraries collected" + exitFailure + else do + let recsLibHSNotFound = + filter (\case + LibHS _ Nothing -> True + _ -> False + ) recsLibHS + if null recsLibHSNotFound + then do + createDirectoryIfMissing False distDataDir + forM_ recsLibHS $ \case + LibHS _ (Just path) -> do + let dst = distDataDir + takeFileName path + putStrLn' $ path ++ " -> " ++ dst + copyFile path dst + _ -> undefined + else do + hPutStrLn stderr $ + "There were missing Haskell libraries:\n" ++ + lddOut + exitFailure + archiveLibs tar' = + unless (null distDataArchive) $ do + putStrLn' "---> Archiving artifacts" + tarOut <- getProgramOutput distDataOtherVerbosity tar' + ["czvf" + ,distDataArchive <.> ".tar.gz" + ,distDataTargetLib + ,distDataDir + ] + putStrLnTrim tarOut + putStrLn' = when (distDataOwnVerbosity == verbose) . putStrLn + putStrLnTrim = putStrLn' . fst . spanEnd (== '\n') + +parsePatchelfRpathOutput :: String -> Either ParseError [String] +parsePatchelfRpathOutput = + parse (many (satisfy (/= colon)) `sepBy` char colon) "patchelf_rpath" + where colon = ':' + +parseLddOutput :: String -> Either ParseError [LddRec] +parseLddOutput = flip parse "ldd" $ many $ + spaces >> + (try (do + lib <- manyTill anyChar' sep + path <- (char bs >> right <&> Just . (bs :)) + <|> (string "not found" >> return Nothing) + return $ if "libHS" `isPrefixOf` lib + then LibHS lib path + else LibOther lib path + ) + <|> (right <&> (`LibOther` Nothing)) + ) + where right = manyTill anyChar' (try $ spaces1 >> addr >> newline) + addr = string "(0x" >> many1 hexDigit >> char ')' + anyChar' = satisfy (/= '\n') + sep = spaces1 >> string "=>" >> spaces1 + spaces1 = skipMany1 space + bs = '/' + +cmdDeps :: DepsData -> IO () +cmdDeps DepsData {..} = do + units <- pjUnits <$> findAndDecodePlanJson (ProjectRelativeToDir ".") + let locals = [ Unit {..} + | Unit {..} <- M.elems units + , uType == UnitTypeLocal + , M.member CompNameLib uComps + , toPkgName uPId == T.pack depsDataProject + ] + when (null locals) $ do + hPutStrLn stderr $ "Failed to find plan for " ++ depsDataProject + exitFailure + let locals' = foldl (\a (Unit {..}) -> + let comps = M.filterWithKey + (const . (== CompNameLib)) uComps + deps = M.map ciLibDeps comps + in M.foldr S.union a deps + ) S.empty locals + forM_ (S.toList locals') $ \(UnitId local) -> + putStrLn $ "package-id " ++ T.unpack local + where toPkgName (PkgId (PkgName name) _) = name + +cmdInit :: InitData -> IO () +cmdInit init'@InitData {..} = do + let files = [("cabal.project", cabalProject init', True) + ,("Setup.hs", setupHs init', True) + ,(initDataProject ++ ".cabal", projectCabal init', True) + ,("Makefile", makefile init', True) + ,(replace "-" "_" initDataProject ++ ".hs" + ,projectHs init' + ,False + ) + ] + forM_ files $ + if initDataToStdout + then \(name, file, _) -> + printHeader name >> T.putStrLn file + else \(name, file, overridable) -> do + exists <- doesFileExist name + if exists + then if initDataForce && overridable + then T.writeFile name file + else hPutStrLn stderr $ + if overridable + then useForceMsg name + else existsMsg name + else T.writeFile name file + where printHeader header = do + isTerm <- isTerminal FD.stdout + if isTerm + then putDoc $ annotate (color Blue <> underlined) $ + pretty $ header ++ "\n\n" + else putStrLn $ " ~~~ " ++ header ++ "\n" + existsMsg name = "File " ++ name ++ " exists" + useForceMsg name = existsMsg name ++ ", use option -f to override it" + +cabalProject :: InitData -> Text +cabalProject InitData {..} = T.concat + ["packages: ", T.pack initDataProject, ".cabal\n"] + +setupHs :: InitData -> Text +setupHs = const + "import NgxExport.Distribution\n\ + \main = defaultMain\n" + +projectCabal :: InitData -> Text +projectCabal InitData {..} = T.concat + ["name: ", T.pack initDataProject, "\n\ + \version: 0.1.0.0\n\ + \build-type: Custom\n\ + \cabal-version: 1.24\n\ + \\n\ + \custom-setup\n\ + \ setup-depends: base >= 4.8 && < 5\n\ + \ , ngx-export-distribution\n\ + \\n\ + \library\n\ + \ default-language: Haskell2010\n\ + \ build-depends: base >= 4.8 && < 5\n\ + \ , ngx-export\n\ + \\n\ + \ ghc-options: -Wall -O2\n" + ,if initDataNoThreaded + then "" + else + "\n\ + \ if impl(ghc >= 8.10.6)\n\ + \ ghc-options: -threaded\n" + ] + +makefile :: InitData -> Text +makefile InitData {..} = T.concat + ["NAME := ", T.replace "-" "_" $ T.pack initDataProject, "\n\ + \PKGNAME := $(subst _,-,$(NAME))\n\ + \PKGVER := 0.1.0.0\n\ + \\n\ + \PREFIX := ", T.pack initDataPrefix, "\n\ + \MACHINE := $(shell uname -m)\n\ + \KERNEL := $(shell uname -s | tr A-Z a-z)\n\ + \\n\ + \PKGDISTR := ngx-export-distribution\n\ + \\n\ + \SRC := $(NAME).hs\n\ + \LIB := $(NAME).so\n\ + \STUB := $(NAME)_stub.h\n\ + \DISTR := $(PKGNAME)-$(PKGVER).tar.gz\n\ + \\n\ + \GHCVER := $(shell ghc --numeric-version)\n\ + \GHCENV := .ghc.environment.$(MACHINE)-$(KERNEL)-$(GHCVER)\n\ + \DEPLIBS := $(MACHINE)-$(KERNEL)-ghc-$(GHCVER)\n\ + \DISTDIR := dist\n\ + \DISTV2DIR := dist-newstyle\n\ + \\n\ + \all: $(DISTR)\n\ + \\n\ + \$(DISTR): $(SRC)\n\ + \\tcabal install --lib --only-dependencies --package-env .\n\ + \\tsed -i 's/\\(^package-id \\)/--\\1/' $(GHCENV)\n\ + \\trunhaskell --ghc-arg=-package=base \\\n\ + \\t --ghc-arg=-package=$(PKGDISTR) Setup.hs configure \\\n\ + \\t --package-db=clear --package-db=global \\\n\ + \\t $$(sed -n 's/^\\(package-db\\)\\s\\+/--\\1=/p' $(GHCENV)) \\\n\ + \\t --prefix=$(PREFIX)\n\ + \\tnhm-tool deps $(PKGNAME) >> $(GHCENV)\n\ + \\trunhaskell --ghc-arg=-package=base \\\n\ + \\t --ghc-arg=-package=$(PKGDISTR) Setup.hs build \\\n\ + \\t --ghc-options=\"$(SRC) -o $(LIB) $(LINKRTS)\"\n\ + \\n\ + \install: $(DISTR)\n\ + \\tinstall -d $(PREFIX)\n\ + \\ttar xf $(DISTR) -C $(PREFIX) --no-same-owner\n\ + \\n\ + \.PHONY: clean\n\ + \\n\ + \clean:\n\ + \\trm -rf $(DISTDIR) $(DISTV2DIR) $(DEPLIBS)\n\ + \\trm -f $(GHCENV) $(STUB) $(NAME).hi $(NAME).o\n\ + \\trm -f $(LIB)\n\ + \\n\ + \clean-all: clean\n\ + \\trm -f $(DISTR)\n" + ] + +projectHs :: InitData -> Text +projectHs InitData {..} = T.concat + ["{-# LANGUAGE TemplateHaskell #-}\n\n\ + \module " + ,T.pack $ fst $ + foldl (\(a, tr) v -> if v == '-' || v == '_' + then (a, True) + else if tr || null a + then (a ++ [toUpper v], False) + else (a ++ [v], False) + ) ("", False) initDataProject + , " where\n\n" + ] +