diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,15 @@ # Changelog +## 0.2.7 (2020-02-27) +- Main.hs: explicitly export main and add SPDX-License-Identifier +- move Main.hs to src/ +- handle git submodules (not --recursive yet) +- use typed-process to interleave IO to display auth errors +- check name and .cabal filename consistent +- put tarballs in .hkgr/ +- upload: error if tag no longer on branch +- publish: only push up to tag + ## 0.2.6.1 (2020-07-30) - upload: do not hide output since it conceals any error - new: improvements to work better with cabal-3.0 init diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -8,6 +8,7 @@ import Control.Exception (bracket_, finally, onException) import Control.Monad.Extra +import qualified Data.ByteString.Lazy.Char8 as B import Data.Char import Data.List.Extra import Data.Maybe @@ -15,17 +16,14 @@ import Data.Monoid ((<>)) #endif import SimpleCabal -import SimpleCmd -#if MIN_VERSION_simple_cmd(0,2,1) - hiding (ifM, whenM) -#endif -import SimpleCmd.Git import SimpleCmdArgs import System.Directory import System.Environment.XDG.BaseDir +import System.Exit (ExitCode (..)) import System.FilePath import System.IO (BufferMode(NoBuffering), hSetBuffering, hSetEcho, stdin, stdout) +import qualified System.Process.Typed as P import Paths_hkgr (getDataFileName, version) main :: IO () @@ -52,17 +50,61 @@ where forceOpt = switchWith 'f' "force" +git :: String -> [String] -> P.ProcessConfig () () () +git c args = P.proc "git" (c:args) + +git_ :: String -> [String] -> IO () +git_ c args = + cmd_ "git" (c:args) + +gitBool :: String -> [String] -> IO Bool +gitBool c args = do + (== ExitSuccess) <$> P.runProcess (git c args) + +removeTrailingNewline :: B.ByteString -> B.ByteString +removeTrailingNewline "" = "" +removeTrailingNewline bs = + if B.last bs == '\n' + then B.init bs + else bs + +-- cmd :: String -> [String] -> IO String +-- cmd c args = +-- B.unpack . removeTrailingNewline <$> P.readProcessStdout_ (P.proc c args) + +cmd_ :: String -> [String] -> IO () +cmd_ c args = P.runProcess_ $ P.proc c args + +cmdOut :: P.ProcessConfig () () () -> IO String +cmdOut p = + B.unpack . removeTrailingNewline <$> P.readProcessStdout_ p + +cmdMaybe :: P.ProcessConfig () () () -> IO (Maybe String) +cmdMaybe p = do + (ret, out ,_err) <- P.readProcess p + return $ if ret == ExitSuccess + then Just (B.unpack (removeTrailingNewline out)) + else Nothing + +-- from simple-cmd +error' :: String -> a +#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,9,0)) +error' = errorWithoutStackTrace +#else +error' = error +#endif + tagDistCmd :: Bool -> IO () tagDistCmd force = do needProgram "cabal" - diff <- git "diff" ["HEAD"] + diff <- cmdOut $ git "diff" ["HEAD"] unless (null diff) $ do putStrLn "=== start of uncommitted changes ===" putStrLn diff putStrLn "=== end of uncommitted changes ===" pkgid <- checkPackage let tag = pkgidTag pkgid - tagHash <- cmdMaybe "git" ["rev-parse", tag] + tagHash <- cmdMaybe (git "rev-parse" [tag]) when (isJust tagHash && not force) $ error' $ "tag " ++ tag ++ " exists: use --force to override and move" git_ "tag" $ ["--force" | force] ++ [tag] @@ -79,28 +121,31 @@ checkPackage :: IO PackageIdentifier checkPackage = do pkgid <- getPackageId - checkVersionCommitted pkgid + checkNameVersionCommitted pkgid checkNotPublished pkgid return pkgid - -checkVersionCommitted :: PackageIdentifier -> IO () -checkVersionCommitted pkgid = do - let pkg = packageName pkgid - diff <- git "diff" ["-U0", "HEAD", unPackageName pkg <.> "cabal"] - when ("version:" `isInfixOf` map toLower diff) $ - error' "Please commit or revert the package Version first" + where + checkNameVersionCommitted :: PackageIdentifier -> IO () + checkNameVersionCommitted pkgid = do + let pkg = packageName pkgid + cabalfile = unPackageName pkg <.> "cabal" + unlessM (doesFileExist cabalfile) $ + error' $ ".cabal filename differs from package name: " ++ unPackageName pkg + diff <- cmdOut (git "diff" ["-U0", "HEAD", cabalfile]) + when ("version:" `isPrefixOf` map toLower diff) $ + error' "Please commit or revert the package Version first" -checkNotPublished :: PackageIdentifier -> IO () -checkNotPublished pkgid = do - let published = sdistDir showPkgId pkgid <.> ".tar.gz" <.> "published" - exists <- doesFileExist published - when exists $ error' $ showPkgId pkgid <> " was already published!!" - let oldpublished = "dist" showPkgId pkgid <.> ".tar.gz" <.> "published" - oldExists <- doesFileExist oldpublished - when oldExists $ error' $ showPkgId pkgid <> " was already published!!" + checkNotPublished :: PackageIdentifier -> IO () + checkNotPublished pkgid = do + let published = sdistDir showPkgId pkgid <.> ".tar.gz" <.> "published" + exists <- doesFileExist published + when exists $ error' $ showPkgId pkgid <> " was already published!!" + let oldpublished = "dist" showPkgId pkgid <.> ".tar.gz" <.> "published" + oldExists <- doesFileExist oldpublished + when oldExists $ error' $ showPkgId pkgid <> " was already published!!" sdistDir :: FilePath -sdistDir = "dist-newstyle/sdist" +sdistDir = ".hkgr" sdist :: Bool -> PackageIdentifier -> IO () sdist force pkgid = do @@ -115,11 +160,13 @@ withTempDirectory "tmp-sdist" $ do git_ "clone" ["-q", "--no-checkout", "..", "."] git_ "checkout" ["-q", tag] + whenM (doesFileExist ".gitmodules") $ + git_ "submodule" ["update", "--init"] cabal_ "check" [] mhlint <- findExecutable "hlint" when (isJust mhlint) $ do putStrLn "Running hlint" - void $ cmdBool "hlint" ["--no-summary", "."] + void $ P.runProcess $ P.proc "hlint" ["--no-summary", "."] let dest = takeDirectory $ cwd target unlessM (doesDirectoryExist dest) $ createDirectoryIfMissing True dest @@ -130,45 +177,63 @@ pkgid <- getPackageId putStrLn $ packageVersion pkgid +-- FIXME cabal install creates tarballs now uploadCmd :: Bool -> Bool -> IO () uploadCmd publish force = do pkgid <- checkPackage let file = sdistDir showPkgId pkgid <.> ".tar.gz" + tag = pkgidTag pkgid exists <- doesFileExist file - if force - then tagDistCmd True - else unless exists $ tagDistCmd False + when (force || not exists) $ + tagDistCmd force + whenM (null <$> cmdOut (git "branch" ["--contains", "tags/" ++ tag])) $ + error' $ tag ++ " is no longer on branch: use --force to move it" when publish $ do - let tag = pkgidTag pkgid - tagHash <- cmd "git" ["rev-parse", tag] - branch <- cmd "git" ["branch", "--show-current"] - git_ "push" ["origin", tagHash ++ ":" ++ branch] + tagHash <- cmdOut $ git "rev-parse" [tag] + branch <- cmdOut $ git "branch" ["--show-current"] + mergeable <- gitBool "merge-base" ["--is-ancestor", "HEAD", tagHash] + when mergeable $ do + putStr "git pushing... " + git_ "push" ["--quiet", "origin", tagHash ++ ":" ++ branch] + putStrLn "done" git_ "push" ["origin", tag] - username <- prompt False "Hackage username" - passwd <- prompt True "Hackage password" - -- FIXME can fail to output error - out <- cmdStdIn "cabal" ("upload" : ["--publish" | publish] ++ [file]) $ - unlines [username, passwd] - putStrLn out + username <- prompt False "hackage.haskell.org username" + passwd <- prompt True "hackage.haskell.org password" + let userpassBS = B.pack $ unlines [username, passwd] + void $ P.readProcessInterleaved_ (P.setStdin (P.byteStringInput userpassBS) $ P.proc "cabal" ("upload" : ["--publish" | publish] ++ [file])) putStrLn $ (if publish then "Published at " else "Uploaded to ") ++ "https://hackage.haskell.org/package/" ++ showPkgId pkgid ++ if publish then "" else "/candidate" when publish $ createFileLink (takeFileName file) (file <.> "published") + +-- maybeGetUserPassword :: IO (Maybe String, Maybe String) +-- maybeGetUserPassword = do +-- muser <- maybeGetUsername +-- mpwd <- maybeGetPassword +-- return (muser,mpwd) +-- where +-- maybeGetUsername :: IO (Maybe String) + +prompt :: Bool -> String -> IO String +prompt hide s = do + putStr $ s ++ ": " + inp <- if hide then withoutEcho getLine else getLine + when hide $ putChar '\n' + return inp where - prompt :: Bool -> String -> IO String - prompt hide s = do - putStr $ s ++ ": " - inp <- if hide then withoutEcho getLine else getLine - when hide $ putChar '\n' - return inp - where - withoutEcho :: IO a -> IO a - withoutEcho action = - finally (hSetEcho stdin False >> action) (hSetEcho stdin True) + withoutEcho :: IO a -> IO a + withoutEcho action = + finally (hSetEcho stdin False >> action) (hSetEcho stdin True) upHaddockCmd :: Bool -> IO () -upHaddockCmd publish = - cabal_ "upload" $ "--documentation" : ["--publish" | publish] +upHaddockCmd publish = do + username <- prompt False "hackage.haskell.org username" + passwd <- prompt True "hackage.haskell.org password" + let userpassBS = B.pack $ unlines [username, passwd] + _out <- P.readProcessInterleaved_ (P.setStdin (P.byteStringInput userpassBS) $ P.proc "cabal" ("upload" : "--documentation" : ["--publish" | publish])) + pkgid <- getPackageId + putStrLn $ (if publish then "Published at " else "Uploaded to ") ++ "https://hackage.haskell.org/package/" ++ showPkgId pkgid ++ if publish then "" else "/candidate" + cabal_ :: String -> [String] -> IO () cabal_ c args = cmd_ "cabal" (c:args) @@ -178,14 +243,15 @@ bracket_ (createDirectory dir) (removeDirectoryRecursive dir) $ withCurrentDirectory dir run -#if (defined(MIN_VERSION_simple_cmd) && MIN_VERSION_simple_cmd(0,2,1)) -#else +-- #if (defined(MIN_VERSION_simple_cmd) && MIN_VERSION_simple_cmd(0,2,1)) +-- #else needProgram :: String -> IO () needProgram prog = do mx <- findExecutable prog unless (isJust mx) $ error' $ "program needs " ++ prog -#endif +-- #endif +-- FIXME warning if upstream template changed (keep a versioned template copy) -- FIXME add default templates dir -- FIXME --license newCmd :: Maybe String -> IO () @@ -211,9 +277,9 @@ let setupFile = "Setup.hs" origsetup <- doesFileExist setupFile cabal_ "init" ["--quiet", "--no-comments", "--non-interactive", "--is-libandexe", "--cabal-version=1.18", "--license=BSD3", "--package-name=" ++ name, "--version=0.1.0", "--dependency=base<5", "--source-dir=src"] - whenJustM (cmdMaybe "find" ["-name", "Main.hs"]) $ \ file -> do - sed ["/module Main where/,+1 d"] file - unless (file == "./Main.hs") $ renameFile file "./Main.hs" + whenJustM (cmdMaybe $ P.proc "find" ["-name", "Main.hs"]) $ \ file -> do + sed ["1s/^module Main where/-- SPDX-License-Identifier: BSD-3-Clause\\n\\nmodule Main (main) where/"] file + unless (file == "src/Main.hs") $ renameFile file "src/Main.hs" whenM (doesFileExist "CHANGELOG.md") $ renameFile "CHANGELOG.md" "ChangeLog.md" unlessM (doesFileExist "README.md") $ @@ -229,7 +295,7 @@ mstack <- findExecutable "stack" -- FIXME add stack.yaml template too when (not haveStackCfg && isJust mstack) $ do - cmd_ "stack" ["init", "--verbosity", "warn", "--resolver", "lts-15"] + cmd_ "stack" ["init", "--verbosity", "warn", "--resolver", "lts-16"] sed ["/^#/d", "/^$/d"] "stack.yaml" haveGit <- doesDirectoryExist ".git" unless haveGit $ do @@ -245,6 +311,7 @@ _ -> error' "More than one .cabal file found!" sed :: [String] -> FilePath -> IO () + sed [] _ = error' "sed given no script" sed args file = cmd_ "sed" $ ["-i", "-e"] ++ intersperse "-e" args ++ [file] @@ -256,25 +323,26 @@ createDirectoryIfMissing True $ takeDirectory userTemplate -- FIXME put a copy of the current template there too for reference copyFile origTemplate userTemplate - username <- git "config" ["--global", "user.name"] + username <- cmdOut $ git "config" ["--global", "user.name"] replaceHolder "NAME" username userTemplate usermail <- - fromMaybeM (git "config" ["--global", "user.email"]) $ - cmdMaybe "git" ["config", "--global", "github.email"] + fromMaybeM (cmdOut $ git "config" ["--global", "user.email"]) $ + cmdMaybe $ git "config" ["--global", "github.email"] replaceHolder "EMAIL" usermail userTemplate - githubuser <- git "config" ["--global", "github.user"] + githubuser <- cmdOut $ git "config" ["--global", "github.user"] replaceHolder "USER" githubuser userTemplate putStrLn $ userTemplate ++ " set up" copyFile userTemplate $ name <.> "cabal" replaceHolder "PROJECT" name $ name <.> "cabal" replaceHolder "PROJECT_" (map underscore name) $ name <.> "cabal" replaceHolder "SUMMARY" (name ++ " project") $ name <.> "cabal" - year <- cmd "date" ["+%Y"] + year <- cmdOut (P.proc "date" ["+%Y"]) replaceHolder "YEAR" year $ name <.> "cabal" let modulePath = "src/MyLib.hs" unlessM (doesFileExist modulePath) $ do createDirectoryIfMissing True $ takeDirectory modulePath - writeFile modulePath "module MyLib where \n" + writeFile modulePath "-- SPDX-License-Identifier: BSD-3-Clause\n\nmodule MyLib where\n" + -- sed ["-i", "1s/^/-- SPDX-License-Identifier: BSD-3-Clause\n\n/"] modulePath where replaceHolder lbl val file = sed ["s/@" ++ lbl ++ "@/" ++ val ++ "/"] file diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ [![Hackage](https://img.shields.io/hackage/v/hkgr.svg)](https://hackage.haskell.org/package/hkgr) [![GPL-3 license](https://img.shields.io/badge/license-GPL--3-blue.svg)](LICENSE) -[![Build status](https://secure.travis-ci.org/juhp/hkgr.svg)](https://travis-ci.org/juhp/hkgr) +[![GitHub CI](https://github.com/juhp/hkgr/workflows/build/badge.svg)](https://github.com/juhp/hkgr/actions) `hkgr` (pronounced "hackager") is a tool for making releases of Haskell packages on Hackage. diff --git a/data/template.cabal.tmpl b/data/template.cabal.tmpl --- a/data/template.cabal.tmpl +++ b/data/template.cabal.tmpl @@ -8,19 +8,21 @@ author: @NAME@ <@EMAIL@> maintainer: @NAME@ <@EMAIL@> copyright: @YEAR@ @NAME@ <@EMAIL@> +category: Unclassified homepage: https://github.com/@USER@/@PROJECT@ bug-reports: https://github.com/@USER@/@PROJECT@/issues build-type: Simple -extra-doc-files: README.md - ChangeLog.md +-- extra-doc-files: README.md +-- ChangeLog.md cabal-version: 1.18 +--tested-with: GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.4 source-repository head type: git location: https://github.com/@USER@/@PROJECT@.git executable @PROJECT@ - main-is: Main.hs + main-is: src/Main.hs -- other-modules: Paths_@PROJECT_@ -- hs-source-dirs: app build-depends: base < 5, @@ -38,9 +40,12 @@ if impl(ghc >= 8.4) ghc-options: -Wmissing-export-lists -Wpartial-fields + if impl(ghc >= 8.10) + ghc-options: -Wunused-packages library build-depends: base < 5 + default-language: Haskell2010 exposed-modules: MyLib hs-source-dirs: src @@ -56,5 +61,5 @@ if impl(ghc >= 8.4) ghc-options: -Wmissing-export-lists -Wpartial-fields - - default-language: Haskell2010 + if impl(ghc >= 8.10) + ghc-options: -Wunused-packages diff --git a/hkgr.cabal b/hkgr.cabal --- a/hkgr.cabal +++ b/hkgr.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: hkgr -version: 0.2.6.1 +version: 0.2.7 synopsis: Simple Hackage release workflow for package maintainers description: Hkgr (pronounced "Hackager") is a tool to help make new releases of @@ -33,15 +33,29 @@ autogen-modules: Paths_hkgr build-depends: base < 5 + , bytestring , directory >= 1.3.1.0 , extra , filepath , simple-cabal >= 0.1.0 - , simple-cmd >= 0.2.0 , simple-cmd-args >= 0.1.6 + , typed-process , xdg-basedir ghc-options: -Wall + if impl(ghc >= 8.0) + ghc-options: -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -Wredundant-constraints + if impl(ghc >= 8.2) + ghc-options: -fhide-source-paths + if impl(ghc >= 8.4) + ghc-options: -Wmissing-export-lists + -Wpartial-fields + if impl(ghc >= 8.10) + ghc-options: -Wunused-packages default-language: Haskell2010 default-extensions: OverloadedStrings