Merge pull request #2 from input-output-hk/nm/error-reporting

Improve error reporting in changelogs subcommand

Author: neilmayhew

.github/workflows/haskell.yml

@@ -52,3 +52,8 @@ jobs:
 
     - name: Run tests
       run: cabal test all
+
+    - name: Lint changelogs
+      run: |
+        cabal run -- clrt changelogs -i $(git ls-files '*CHANGELOG.md')
+        git diff --exit-code

CHANGELOG.md

@@ -0,0 +1,25 @@
+# Changelog
+
+Version history for `cardano-ledger-release-tool`
+
+## 0.1.1.0
+
+* Add a `--version` option
+* Shorten executable name to `clrt`
+
+### changelogs
+
+* Improve error reporting
+  - Catch and report IO exceptions
+  - Exit with a failure if exceptions or errors occurred
+* Stop appending an extra blank line when writing to stdout
+
+## 0.1.0.0
+
+* Restructure as a single `cardano-ledger-release-tool` app with subcommands
+
+## 0.0.0.0
+
+### changelogs
+
+* Initial release of the `changelogs` app

cabal.project

@@ -1,4 +1 @@
-packages:
-  common
-  changelogs
-  main
+packages: .

cardano-ledger-release-tool.cabal

@@ -0,0 +1,58 @@
+cabal-version: 3.12
+name: cardano-ledger-release-tool
+version: 0.1.1.0
+author: Neil Mayhew <neil.mayhew@iohk.io>
+copyright: 2025 IOG
+license: Apache-2.0
+synopsis:
+  Assist with release policy for cardano-ledger
+
+description:
+  This is a tool that is used by the cardano-ledger team to simplify and enforce
+  releasing and versioning policy
+
+tested-with:
+  ghc ==8.10.7 || ==9.2.8 || ==9.4.8 || ==9.6.7 || ==9.8.4 || ==9.10.2 || ==9.12.2
+
+common language
+  default-language: Haskell2010
+  other-extensions:
+    ApplicativeDo
+    OverloadedStrings
+    RecordWildCards
+
+common warnings
+  ghc-options:
+    -Wall
+    -Wcompat
+    -Wunused-packages
+    -Werror
+
+common rts
+  ghc-options:
+    -threaded
+    -rtsopts
+    -with-rtsopts=-N
+
+executable clrt
+  import: language, warnings, rts
+  hs-source-dirs: src
+  main-is: main.hs
+  other-modules:
+    Changelog
+    Changelogs
+    Options
+    PackageInfo_cardano_ledger_release_tool
+
+  autogen-modules:
+    PackageInfo_cardano_ledger_release_tool
+
+  build-depends:
+    base,
+    cmark,
+    mtl,
+    optparse-applicative,
+    pretty-simple,
+    terminal-size,
+    text,
+    unliftio,

changelogs/changelogs.cabal

@@ -5,11 +5,16 @@
 module Changelogs (subcmd) where
 
 import Changelog
-import Data.Foldable (for_)
+import Control.Monad (when, (<=<))
+import Data.Bitraversable (bitraverse)
+import Data.Either (isLeft)
 import Data.Functor ((<&>))
 import Data.Text.Lazy (Text, unpack)
+import Data.Traversable (for)
 import Options.Applicative
-import System.IO (stderr)
+import System.Exit (exitFailure)
+import System.IO (hPrint, stderr)
+import UnliftIO.Exception (tryAny)
 
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.IO as TL
@@ -39,7 +44,7 @@ options =
                 <> metavar "FILE"
           stdoutParser =
             -- Write output to stdout
-            pure $ const TL.putStrLn
+            pure $ const TL.putStr
         optWriteFile <- inplaceParser <|> fileParser <|> stdoutParser
         optBulletHierarchy <-
           strOption $
@@ -61,8 +66,10 @@ subcmd :: Mod CommandFields (Global.Options -> IO ())
 subcmd =
   command "changelogs" $
     options <&> \Options {..} Global.Options {} -> do
-      for_ optChangelogs $ \fp -> do
-        let
-          printError e = TL.hPutStrLn stderr $ TL.pack fp <> ": " <> e
-          writeLog = optWriteFile fp . renderChangelog optBulletHierarchy
-        either printError writeLog . parseChangelog =<< TL.readFile fp
+      failure <- fmap (any isLeft) . for optChangelogs $ \fp -> do
+        bitraverse (hPrint stderr) pure <=< tryAny $ do
+          let
+            throwError e = errorWithoutStackTrace $ fp <> ": " <> TL.unpack e
+            writeLog = optWriteFile fp . renderChangelog optBulletHierarchy
+          either throwError writeLog . parseChangelog =<< TL.readFile fp
+      when failure exitFailure