Demo and prepare for release

.github/workflows/haskell-ci.yml

@@ -1,6 +1,6 @@
 # This GitHub workflow config has been generated by a script via
 #
-#   haskell-ci 'github' 'debuggable.cabal'
+#   haskell-ci 'github' 'cabal.project.ci'
 #
 # To regenerate the script (for example after adjusting tested-with) run
 #
@@ -10,7 +10,7 @@
 #
 # version: 0.19.20241121
 #
-# REGENDATA ("0.19.20241121",["github","debuggable.cabal"])
+# REGENDATA ("0.19.20241121",["github","cabal.project.ci"])
 #
 name: Haskell-CI
 on:
@@ -203,6 +203,9 @@ jobs:
       - name: build
         run: |
           $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
+      - name: tests
+        run: |
+          $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
       - name: cabal check
         run: |
           cd ${PKGDIR_debuggable} || false

.gitignore

@@ -1,2 +1,3 @@
 dist-newstyle/
 .envrc
+niio

cabal.project

@@ -0,0 +1,4 @@
+packages: .
+
+package debuggable
+  tests: True

cabal.project.ci

@@ -0,0 +1,5 @@
+packages: .
+
+package debuggable
+  tests: True
+  ghc-options: -Werror

debuggable.cabal

@@ -24,7 +24,6 @@ tested-with:     GHC==8.10.7
 
 common lang
   default-language: Haskell2010
-  ghc-options:      -Wall
   build-depends:    base >= 4.14 && < 4.21
 
   default-extensions:
@@ -34,14 +33,27 @@ common lang
       DeriveGeneric
       DerivingStrategies
       GeneralizedNewtypeDeriving
+      ImportQualifiedPost
       LambdaCase
       NamedFieldPuns
+      NumericUnderscores
       RankNTypes
       ScopedTypeVariables
       StandaloneDeriving
       TupleSections
       TypeApplications
 
+  ghc-options:
+      -Wall
+      -Wredundant-constraints
+      -Wprepositive-qualified-module
+      -Widentities
+      -Wmissing-export-lists
+
+  if impl(ghc >= 9.0)
+    ghc-options:
+      -Wunused-packages
+
 library
   import:         lang
   hs-source-dirs: src
@@ -63,3 +75,30 @@ library
 
   other-extensions:
       ImplicitParams
+
+test-suite demo
+  import:         lang
+  type:           exitcode-stdio-1.0
+  main-is:        Demo.hs
+  hs-source-dirs: demo
+
+  ghc-options:
+      -main-is Demo
+      -rtsopts
+      -threaded
+      "-with-rtsopts=-N"
+
+  other-modules:
+      Cmdline
+      Demo.CallSite
+      Demo.NIIO
+
+  build-depends:
+      -- inherited dependencies
+      debuggable
+
+  build-depends:
+      -- additional dependencies
+    , async                >= 2.2  && < 2.3
+    , optparse-applicative >= 0.18 && < 0.19
+

demo/Cmdline.hs

@@ -0,0 +1,78 @@
+module Cmdline (
+    Cmdline(..)
+  , Demo(..)
+  , UseDebuggable(..)
+  , getCmdline
+  ) where
+
+import Options.Applicative
+
+{-------------------------------------------------------------------------------
+  Top-level
+-------------------------------------------------------------------------------}
+
+data Cmdline = Cmdline {
+      cmdDemo :: Maybe Demo
+    }
+  deriving stock (Show)
+
+data Demo =
+    DemoNIIO     UseDebuggable
+  | DemoCallSite UseDebuggable
+  deriving stock (Show)
+
+data UseDebuggable =
+    UseDebuggable
+  | WithoutDebuggable
+  deriving stock (Show)
+
+getCmdline :: IO Cmdline
+getCmdline = execParser opts
+  where
+    opts :: ParserInfo Cmdline
+    opts = info (parseCmdline <**> helper) $ mconcat [
+          fullDesc
+        , header "Demo of the debuggable package"
+        ]
+
+{-------------------------------------------------------------------------------
+  Parser
+-------------------------------------------------------------------------------}
+
+parseCmdline :: Parser Cmdline
+parseCmdline =
+    Cmdline
+      <$> optional parseDemo
+
+parseDemo :: Parser Demo
+parseDemo = subparser $ mconcat [
+      command'
+        "niio"
+        (DemoNIIO <$> parseUseDebuggable)
+        "Demo Debug.NonInterleavedIO"
+    , command'
+        "provenance"
+        (DemoCallSite <$> parseUseDebuggable)
+        "Demo CallSite from Debug.Provenance"
+    ]
+
+parseUseDebuggable :: Parser UseDebuggable
+parseUseDebuggable = asum [
+      flag' UseDebuggable $ mconcat [
+          long "use-debuggable"
+        , help "Use the debuggable library"
+        ]
+    , flag' WithoutDebuggable $ mconcat [
+          long "without-debuggable"
+        , help "Show what happens if we don't have the library support"
+        ]
+    ]
+
+{-------------------------------------------------------------------------------
+  Auxiliary optparse-applicative
+-------------------------------------------------------------------------------}
+
+command' :: String -> Parser a -> String -> Mod CommandFields a
+command' cmd parser desc = command cmd $ info parser $ mconcat [
+      progDesc desc
+    ]

demo/Demo.hs

@@ -0,0 +1,19 @@
+module Demo (main) where
+
+import Cmdline
+
+import Demo.NIIO     qualified as NIIO
+import Demo.CallSite qualified as CallSite
+
+main :: IO ()
+main = do
+    Cmdline{cmdDemo} <- getCmdline
+    case cmdDemo of
+      Nothing   -> putStrLn "Please select a demo (see --help)"
+      Just demo ->
+        case demo of
+          DemoNIIO     WithoutDebuggable -> NIIO.withoutDebuggable
+          DemoNIIO     UseDebuggable     -> NIIO.useDebuggable
+          DemoCallSite WithoutDebuggable -> CallSite.withoutDebuggable
+          DemoCallSite UseDebuggable     -> CallSite.useDebuggable
+

demo/Demo/NIIO.hs

@@ -0,0 +1,42 @@
+module Demo.NIIO (withoutDebuggable, useDebuggable) where
+
+import Control.Concurrent
+import Control.Concurrent.Async
+import Control.Monad
+import System.IO
+
+import Debug.NonInterleavedIO qualified as NIIO
+
+{-------------------------------------------------------------------------------
+  Without the library
+-------------------------------------------------------------------------------}
+
+withoutDebuggable :: IO ()
+withoutDebuggable = do
+    hSetBuffering stdout NoBuffering
+
+    concurrently_
+      ( replicateM_ 10 $ do
+          putStrLn "This is a message from the first thread"
+          threadDelay 100_000
+      )
+      ( replicateM_ 10 $ do
+          putStrLn "And this is a message from the second thread"
+          threadDelay 100_000
+      )
+
+{-------------------------------------------------------------------------------
+  Using the library
+-------------------------------------------------------------------------------}
+
+useDebuggable :: IO ()
+useDebuggable = do
+    concurrently_
+      ( replicateM_ 10 $ do
+          NIIO.putStrLn "This is a message from the first thread"
+          threadDelay 100_000
+      )
+      ( replicateM_ 10 $ do
+          NIIO.putStrLn "And this is a message from the second thread"
+          threadDelay 100_000
+      )

src/Debug/NonInterleavedIO.hs

@@ -36,11 +36,10 @@ import Control.Concurrent
 import Control.Exception
 import Control.Monad.IO.Class
 import System.Environment
+import System.IO qualified as IO
 import System.IO.Temp (getCanonicalTemporaryDirectory)
 import System.IO.Unsafe
 
-import qualified System.IO as IO
-
 {-------------------------------------------------------------------------------
   Output functions
 -------------------------------------------------------------------------------}

src/Debug/NonInterleavedIO/Scoped.hs

@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -Wno-orphans #-}
-
 -- | Utilities for writing debugging messages that include provenance
 --
 -- Intended for qualified import.
@@ -15,11 +13,10 @@ import Control.Monad.IO.Class
 import Data.List (intercalate)
 import GHC.Stack
 
+import Debug.NonInterleavedIO qualified as NIIO
 import Debug.Provenance
 import Debug.Provenance.Scope
 
-import qualified Debug.NonInterleavedIO as NIIO
-
 {-------------------------------------------------------------------------------
   Uniques
 -------------------------------------------------------------------------------}