ngx-export-distribution 0.5.6.0 → 0.6.0.0
raw patch · 3 files changed
+164/−130 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Changelog.md +7/−0
- ngx-export-distribution.cabal +1/−1
- nhm-tool.hs +156/−129
Changelog.md view
@@ -1,3 +1,10 @@+### 0.6.0.0++- *nhm-tool*: add command *plan* to print the build plan or its derivatives.+ Command *deps* is now a synonym for command *plan deps*.+- *nhm-tool*: generate more secure *Makefile* with variables surrounded by+ commas in shell parts.+ ### 0.5.6.0 - *nhm-tool*: Cabal *3.12* generates paths with *Project Unit Id* for GHC
ngx-export-distribution.cabal view
@@ -1,5 +1,5 @@ name: ngx-export-distribution-version: 0.5.6.0+version: 0.6.0.0 synopsis: Build custom libraries for Nginx Haskell module description: Build custom libraries for <https://github.com/lyokha/nginx-haskell-module Nginx Haskell module>.
nhm-tool.hs view
@@ -39,12 +39,16 @@ defaultDistDataDir :: String defaultDistDataDir = ".hslibs" -data DepsData = DepsData { depsDataBuilddir :: String- , depsDataProject :: String- , depsDataWaitArg :: Maybe String- , depsDataHelp :: Bool+data PlanData = PlanData { planDataBuilddir :: String+ , planDataQuery :: Maybe PlanDataQuery+ , planDataWaitArg :: Maybe String+ , planDataWaitProjectName :: Bool+ , planDataHelp :: Bool } +data PlanDataQuery = PlanDataQueryDeps String+ | PlanDataQueryAbi+ data InitData = InitData { initDataPrefix :: String , initDataNoThreaded :: Bool , initDataForce :: Bool@@ -63,8 +67,11 @@ | LibOther String (Maybe FilePath) deriving Show -data HelpSection = HelpDist | HelpDeps | HelpInit deriving Eq+data HelpSection = HelpDist | HelpPlan | HelpDeps | HelpInit deriving Eq +replaceChar :: Char -> Char -> String -> String+replaceChar from to = map $ \v -> if v == from then to else v+ progVersion :: String progVersion = "nhm-tool " ++ showVersion version @@ -95,15 +102,21 @@ \ special value '-' for 'dir', 'target_dir', and 'ar' resets them\n\ \ (with -d- being equivalent to -p)" ]- when (isNothing section || section == Just HelpDeps) $+ when (isNothing section || section `elem` map Just [HelpPlan, HelpDeps]) $ T.putStrLn "\n\- \ * nhm-tool deps [-d dir] project-name\n\n\- \ print all direct dependencies of 'project-name',\n\- \ the output is compatible with the format of GHC environment \- \files\n\n\+ \ * nhm-tool plan [-d dir] [deps project-name | abi]\n\n\+ \ print build plan or its derivatives:\n\+ \ 'deps' print all direct dependencies of 'project-name',\n\+ \ the output is compatible with the format of GHC environment \+ \files\n\+ \ 'abi' print 'Arch-Os-CompilerId' bundle in GHC style\n\n\ \ 'dir' is the cabal build directory where the build plan is \ \located\n\ \ (default is dist-newstyle)"+ when (isNothing section || section == Just HelpDeps) $+ T.putStrLn "\n\+ \ * nhm-tool deps [-d dir] project-name\n\n\+ \ synonym for 'nhm-tool plan [-d dir] deps project-name'" when (isNothing section || section == Just HelpInit) $ T.putStrLn $ T.concat ["\n\ \ * nhm-tool init [-p dir] [-no-threaded] [-f | -to-stdout] \@@ -141,18 +154,30 @@ || null distDataTargetLib -> usage (Just HelpDist) False | otherwise -> cmdDist distData'+ "plan" : args' -> do+ let planData = foldl parsePlanArg (Just defaultArgs) args'+ defaultArgs = PlanData "" Nothing Nothing False False+ case planData of+ Nothing -> usage (Just HelpPlan) False+ Just planData'@PlanData {..} ->+ if | planDataHelp ->+ usage (Just HelpPlan) $ length args' == 1+ | isJust planDataWaitArg+ || planDataWaitProjectName ->+ usage (Just HelpPlan) False+ | otherwise -> cmdPlan planData' "deps" : args' -> do- let depsData = foldl parseDepsArg (Just defaultArgs) args'- defaultArgs = DepsData "" "" Nothing False- case depsData of+ let planData = foldl parsePlanArg (Just defaultArgs) args'+ defaultArgs = PlanData "" Nothing Nothing True False+ case planData of Nothing -> usage (Just HelpDeps) False- Just depsData'@DepsData {..} ->- if | depsDataHelp ->+ Just planData'@PlanData {..} ->+ if | planDataHelp -> usage (Just HelpDeps) $ length args' == 1- | isJust depsDataWaitArg- || null depsDataProject ->+ | isJust planDataWaitArg+ || planDataWaitProjectName -> usage (Just HelpDeps) False- | otherwise -> cmdDeps depsData'+ | otherwise -> cmdPlan planData' "init" : args' -> do let initData = foldl parseInitArg (Just defaultArgs) args' defaultArgs = InitData defaultInitDataPrefix False False False@@ -222,29 +247,37 @@ Just "-t" -> Just dist' { distDataTargetDir = arg } Just "-a" -> Just dist' { distDataArchive = arg } Just _ -> undefined- where dist' = dist { distDataWaitArg = Nothing }+ where dist' = dist { distDataWaitArg = Nothing } -parseDepsArg :: Maybe DepsData -> String -> Maybe DepsData-parseDepsArg Nothing _ = Nothing-parseDepsArg (Just deps@DepsData {..}) arg =- case depsDataWaitArg of+parsePlanArg :: Maybe PlanData -> String -> Maybe PlanData+parsePlanArg Nothing _ = Nothing+parsePlanArg (Just plan@PlanData {..}) arg =+ case planDataWaitArg of Nothing -> let (opt, value) = splitAt 2 arg- in if | "-d" == opt ->+ in if | "deps" == arg && not hasDataQuery ->+ Just plan' { planDataWaitProjectName = True }+ | "abi" == arg && not hasDataQuery ->+ Just plan' { planDataQuery = Just PlanDataQueryAbi }+ | "-d" == opt -> Just $ if null value- then deps { depsDataWaitArg = Just opt }- else deps' { depsDataBuilddir = value }+ then plan { planDataWaitArg = Just opt }+ else plan' { planDataBuilddir = value } | (`elem` ["-h", "-help", "--help"]) arg ->- Just deps' { depsDataHelp = True }+ Just plan' { planDataHelp = True } | Just '-' == (fst <$> uncons arg) -> Nothing- | null depsDataProject ->- Just deps' { depsDataProject = arg }+ | planDataWaitProjectName ->+ Just plan'+ { planDataQuery = Just $ PlanDataQueryDeps arg+ , planDataWaitProjectName = False+ } | otherwise -> Nothing- Just "-d" -> Just deps' { depsDataBuilddir = arg }+ Just "-d" -> Just plan' { planDataBuilddir = arg } Just _ -> undefined- where deps' = deps { depsDataWaitArg = Nothing }+ where plan' = plan { planDataWaitArg = Nothing }+ hasDataQuery = isJust planDataQuery || planDataWaitProjectName parseInitArg :: Maybe InitData -> String -> Maybe InitData parseInitArg Nothing _ = Nothing@@ -272,56 +305,44 @@ Nothing Just "-p" -> Just init'' { initDataPrefix = arg } Just _ -> undefined- where init'' = init' { initDataWaitArg = Nothing }+ where init'' = init' { initDataWaitArg = Nothing } cmdDist :: DistData -> IO () cmdDist DistData {..} = do- let pdb = emptyProgramDb- patchelf = simpleProgram "patchelf"- (patchelf', pdb') <- requireProgram distDataOtherVerbosity patchelf pdb+ patchelf <- requireProgram' $ simpleProgram "patchelf" if distDataPatchOnly- then patchTargetLib patchelf'+ then patchTargetLib patchelf else do- let ldd = simpleProgram "ldd"- (ldd', pdb'') <- requireProgram distDataOtherVerbosity ldd pdb'+ ldd <- requireProgram' $ simpleProgram "ldd" putStrLn' "---> Collecting libraries"- lddOut <- getProgramOutput distDataOtherVerbosity- ldd' [distDataTargetLib]+ lddOut <- getProgramOutput' ldd [distDataTargetLib] case parseLddOutput lddOut of Left err -> do hPutStrLn stderr $ show err ++ " in\n" ++ lddOut exitFailure Right recs -> do- (tar', _) <- requireProgram distDataOtherVerbosity- tarProgram pdb''+ tar' <- requireProgram' tarProgram collectLibs recs lddOut unless (null distDataTargetDir) $- putStrLn' "" >> patchTargetLib patchelf'+ putStrLn' "" >> patchTargetLib patchelf unless (null distDataArchive) $ putStrLn' "" >> archiveLibs tar'- where patchTargetLib patchelf'- | null distDataTargetDir = return ()- | otherwise = do- putStrLn' $ "---> Patching " ++ distDataTargetLib- patchelfOut <- getProgramOutput distDataOtherVerbosity- patchelf' ["--print-rpath", distDataTargetLib]- case parsePatchelfRpathOutput patchelfOut of- Left err -> do- hPutStrLn stderr $ show err ++ " in\n" ++ patchelfOut- 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'+ where patchTargetLib patchelf = unless (null distDataTargetDir) $ do+ putStrLn' $ "---> Patching " ++ distDataTargetLib+ let printRpath = getProgramOutput'+ patchelf ["--print-rpath", distDataTargetLib]+ patchelfOut <- printRpath+ case parsePatchelfRpathOutput patchelfOut of+ Left err -> do+ hPutStrLn stderr $ show err ++ " in\n" ++ patchelfOut+ exitFailure+ Right paths -> do+ unless (distDataTargetDir `elem` paths) $ runProgram'+ patchelf ["--set-rpath"+ ,distDataTargetDir ++ ':' : patchelfOut+ ,distDataTargetLib+ ]+ printRpath >>= putStrLnTrim collectLibs recs lddOut = do let recsLibHS = M.fromList $ mapMaybe (\case@@ -350,24 +371,21 @@ show (M.keys recsLibHSNotFound) ++ " were not found in\n" ++ lddOut exitFailure- archiveLibs tar'- | null distDataArchive = return ()- | otherwise = do- putStrLn' "---> Archiving artifacts"- tarOut <- getProgramOutput distDataOtherVerbosity tar'- ["czvf"- ,distDataArchive <.> ".tar.gz"- ,distDataTargetLib- ,distDataDir- ]- putStrLnTrim tarOut+ archiveLibs tar' = unless (null distDataArchive) $ do+ putStrLn' "---> Archiving artifacts"+ tarOut <- getProgramOutput'+ tar' ["czvf"+ ,distDataArchive <.> ".tar.gz"+ ,distDataTargetLib+ ,distDataDir+ ]+ putStrLnTrim tarOut+ requireProgram' = fmap fst .+ flip (requireProgram distDataOtherVerbosity) emptyProgramDb+ getProgramOutput' = getProgramOutput distDataOtherVerbosity+ runProgram' = runProgram distDataOtherVerbosity putStrLn' = when (distDataOwnVerbosity == verbose) . putStrLn- putStrLnTrim = putStrLn' . trimEnd '\n'- trimEnd end = fst . foldr (\v a@(vs, skipped) ->- if skipped || v /= end- then (v : vs, True)- else a- ) ("", False)+ putStrLnTrim = putStrLn' . dropWhileEnd (== '\n') parsePatchelfRpathOutput :: String -> Either ParseError [String] parsePatchelfRpathOutput =@@ -395,28 +413,38 @@ sep = spaces1 *> string "=>" *> spaces1 spaces1 = skipMany1 space -cmdDeps :: DepsData -> IO ()-cmdDeps DepsData {..} = do- let buildDir = if null depsDataBuilddir+cmdPlan :: PlanData -> IO ()+cmdPlan PlanData {..} = do+ let buildDir = if null planDataBuilddir then ProjectRelativeToDir "."- else InBuildDir depsDataBuilddir- units <- pjUnits <$> findAndDecodePlanJson buildDir- let comps = [ uComps- | Unit {..} <- M.elems units- , uType == UnitTypeLocal- , let uPkgName = (\(PkgId (PkgName name) _) -> name) uPId- , uPkgName == T.pack depsDataProject- ]- when (null comps) $ do- hPutStrLn stderr $ "Failed to find plan for " ++ depsDataProject- exitFailure- let deps = foldl (\a curComps ->- let libComps = M.filterWithKey- (const . (== CompNameLib)) curComps- in M.foldr S.union a $ M.map ciLibDeps libComps- ) S.empty comps- forM_ (S.toList deps) $ \(UnitId unit) ->- putStrLn $ "package-id " ++ T.unpack unit+ else InBuildDir planDataBuilddir+ path <- findPlanJson buildDir+ case planDataQuery of+ Nothing ->+ readFile path >>= putStrLn+ Just (PlanDataQueryDeps proj) -> do+ units <- pjUnits <$> decodePlanJson path+ let comps = [ uComps+ | Unit {..} <- M.elems units+ , uType == UnitTypeLocal+ , let uPkgName = (\(PkgId (PkgName pkg) _) -> pkg) uPId+ , uPkgName == T.pack proj+ ]+ when (null comps) $ do+ hPutStrLn stderr $ "Failed to find plan for " ++ proj+ exitFailure+ let deps = foldl (\a curComps ->+ let libComps = M.filterWithKey+ (const . (== CompNameLib)) curComps+ in M.foldr S.union a $+ M.map ciLibDeps libComps+ ) S.empty comps+ forM_ (S.toList deps) $ \(UnitId unit) ->+ putStrLn $ "package-id " ++ T.unpack unit+ Just PlanDataQueryAbi -> do+ PlanJson {..} <- decodePlanJson path+ T.putStrLn $+ T.intercalate "-" [pjArch, pjOs, dispPkgId pjCompilerId] cmdInit :: InitData -> IO () cmdInit init'@InitData {..} = do@@ -424,7 +452,7 @@ ,("Setup.hs", setupHs init', True) ,(initDataProject ++ ".cabal", projectCabal init', True) ,("Makefile", makefile init', True)- ,(replace '-' '_' initDataProject ++ ".hs"+ ,(replaceChar '-' '_' initDataProject ++ ".hs" ,projectHs init' ,False )@@ -443,8 +471,7 @@ then useForceMsg name else existsMsg name else T.writeFile name file- where replace from to = foldr (\v -> ((if v == from then to else v) :)) ""- printHeader header = do+ where printHeader header = do isANSITerm <- hSupportsANSI stdout if isANSITerm then do@@ -494,7 +521,7 @@ makefile :: InitData -> Text makefile InitData {..} = T.concat- ["NAME := ", T.replace "-" "_" $ T.pack initDataProject, "\n\+ ["NAME := ", T.pack $ replaceChar '-' '_' initDataProject, "\n\ \PKGNAME := $(subst _,-,$(NAME))\n\ \PKGVER := 0.1.0.0\n\ \\n\@@ -509,11 +536,11 @@ \LIB := $(NAME).so\n\ \DISTR := $(PKGNAME)-$(PKGVER).tar.gz\n\ \\n\- \OBJS := $(SRC:.hs=.o)\n\- \HIOBJS := $(SRC:.hs=.hi)\n\- \DYNOBJS := $(SRC:.hs=.dyn_o)\n\- \DYNHIOBJS := $(SRC:.hs=.dyn_hi)\n\- \STUBS := $(SRC:.hs=_stub.h)\n\+ \override OBJS := $(SRC:.hs=.o)\n\+ \override HIOBJS := $(SRC:.hs=.hi)\n\+ \override DYNOBJS := $(SRC:.hs=.dyn_o)\n\+ \override DYNHIOBJS := $(SRC:.hs=.dyn_hi)\n\+ \override STUBS := $(SRC:.hs=_stub.h)\n\ \\n\ \GHC := ghc\n\ \CABAL := cabal\n\@@ -546,53 +573,53 @@ \config: $(SETUPCONFIG)\n\ \\n\ \$(GHCENVLNK): cabal.project $(PKGNAME).cabal\n\- \\trm -f $(GHCENVLNK)\n\+ \\trm -f \"$(GHCENVLNK)\"\n\ \\t$(CABAL) install --builddir=\"$(BUILDDIR)\" --lib --only-dependencies \ \\\\n\ \\t --package-env .\n\- \\tsed -i 's/\\(^package-id \\)/--\\1/' $(GHCENV)\n",+ \\tsed -i 's/\\(^package-id \\)/--\\1/' \"$(GHCENV)\"\n", updatePath,- "\t$(NHMTOOL) deps $(PKGNAME) -d \"$(BUILDDIR)\" >> $(GHCENV)\n\- \\tln -sf $(GHCENV) $(GHCENVLNK)\n\+ "\t$(NHMTOOL) deps \"$(PKGNAME)\" -d \"$(BUILDDIR)\" >> \"$(GHCENV)\"\n\+ \\tln -sf \"$(GHCENV)\" \"$(GHCENVLNK)\"\n\ \\n\ \$(SETUPCONFIG): $(GHCENVLNK)\n", updatePath, "\trunhaskell --ghc-arg=-package=base \\\n\- \\t --ghc-arg=-package=$(PKGDISTR) Setup.hs configure \\\n\+ \\t --ghc-arg=-package=\"$(PKGDISTR)\" Setup.hs configure \\\n\ \\t --builddir=\"$(BUILDDIR)\" \\\n\ \\t --package-db=clear --package-db=global \\\n\- \\t $$(sed -n 's/^\\(package-db\\)\\s\\+/--\\1=/p' $(GHCENV)) \\\n\+ \\t $$(sed -n 's/^\\(package-db\\)\\s\\+/--\\1=/p' \"$(GHCENV)\") \\\n\ \\t $$(sed -n 's/^package-id\\s\\+\\(.*\\)'` \\\n\ \\t `'\\(-\\([0-9]\\+\\.\\)*[0-9]\\+\\($$\\|-.*\\)\\)/'` \\\n\ \\t `'--dependency=\\1=\\1\\2/p' \\\n\- \\t $(GHCENV)) \\\n\- \\t --prefix=$(PREFIX)\n\+ \\t \"$(GHCENV)\") \\\n\+ \\t --prefix=\"$(PREFIX)\"\n\ \\n\ \$(DISTR): $(SETUPCONFIG) $(SRC)\n", updatePath, "\trunhaskell --ghc-arg=-package=base \\\n\- \\t --ghc-arg=-package=$(PKGDISTR) Setup.hs build \\\n\+ \\t --ghc-arg=-package=\"$(PKGDISTR)\" Setup.hs build \\\n\ \\t --builddir=\"$(BUILDDIR)\" \\\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\+ \\tinstall -d \"$(PREFIX)\"\n\+ \\ttar xf \"$(DISTR)\" -C \"$(PREFIX)\" --no-same-owner\n\ \\n\ \clean:\n\- \\trm -rf $(DEPLIBS)\n\+ \\trm -rf \"$(DEPLIBS)\"\n\ \\trm -f $(OBJS) $(HIOBJS) $(DYNOBJS) $(DYNHIOBJS) $(STUBS)\n\- \\trm -f $(LIB)\n\+ \\trm -f \"$(LIB)\"\n\ \\n\ \clean-all: clean\n\- \\trm -rf $(BUILDDIR)\n\- \\trm -f $(GHCENV) $(GHCENVLNK) $(DISTR)\n"+ \\trm -rf \"$(BUILDDIR)\"\n\+ \\trm -f \"$(GHCENV)\" \"$(GHCENVLNK)\" \"$(DISTR)\"\n" ] where updatePath = "\tif test \"$(NHMTOOL)\" = nhm-tool && ! command -v nhm-tool \ \>/dev/null; \\\n\ \\tthen \\\n\- \\t PATH=$$(dirname $$($(CABAL) list-bin $(PKGDISTR) \\\n\+ \\t PATH=$$(dirname $$($(CABAL) list-bin \"$(PKGDISTR)\" \\\n\ \\t --builddir=\"$(BUILDDIR)\")):$$PATH; \\\n\ \\tfi; \\\n"