Add tasty test-suite for pure helpers.

The cabal file is restructured into a library plus executable plus
test-suite, sharing a `common opts` stanza for default extensions and
GHC options.  The library exposes every module except `Main` so the
test-suite can import them directly.

Initial tests cover the pure logic that is easiest to nail down:

  * `Lexer.doP`/`doF`/`doS`/`doI` for the mpg123 protocol parsers,
  * `Tree.doOrphans` and `Tree.merge` (including the value-order
    behavior of the latter),
  * `FastIO.basenameP`/`dirnameP`/`trim`/`packedFileNameEndClean`,
  * `Core.showTimeDiff_` across the four output branches.

`Lexer.doP/doF/doS/doI` and `Core.showTimeDiff_` are added to their
module export lists for testability.

CI runs `cabal build all && cabal test all` and `stack test`; the build
step is kept because `cabal test` does not build the executable.

Author: claude

.github/workflows/haskell.yml

@@ -12,7 +12,8 @@ jobs:
       - uses: haskell-actions/setup@v2
         with:
           ghc-version: ${{ matrix.ghc }}
-      - run: cabal build
+      - run: cabal build all
+      - run: cabal test all --test-show-details=streaming
   stack:
     runs-on: 'ubuntu-22.04'
     name: Stack
@@ -21,5 +22,4 @@ jobs:
       - uses: haskell-actions/setup@v2
         with:
           enable-stack: true
-      - run: stack build
-
+      - run: stack test

Core.hs

@@ -38,6 +38,7 @@ module Core (
         loadConfig,
         discardErrors,
         toggleExit,
+        showTimeDiff_,
     ) where
 
 import Base

Lexer.hs

@@ -20,7 +20,7 @@
 
 -- Lexer for mpg123 messages
 
-module Lexer ( parser ) where
+module Lexer ( parser, doP, doF, doS, doI ) where
 
 import Base
 

hmp3-ng.cabal

@@ -23,9 +23,26 @@ source-repository head
   type: git
   location: https://github.com/galenhuntington/hmp3-ng
 
-executable hmp3
-  main-is: Main.hs
-  other-modules:
+common opts
+  default-language: Haskell2010
+  default-extensions:
+      BangPatterns
+      BlockArguments
+      OverloadedStrings
+      ScopedTypeVariables
+      TypeApplications
+      DerivingStrategies
+      RecordWildCards
+      LambdaCase
+      MultiWayIf
+      StandaloneDeriving
+      NumericUnderscores
+  ghc-options: -Wall -funbox-strict-fields -Wno-unused-do-bind
+
+library
+  import: opts
+  hs-source-dirs: ./
+  exposed-modules:
       Base
       Config
       Core
@@ -38,24 +55,10 @@ executable hmp3
       Syntax
       Tree
       UI
+  other-modules:
       Paths_hmp3_ng
   autogen-modules:
       Paths_hmp3_ng
-  hs-source-dirs:
-      ./
-  default-extensions:
-      BangPatterns
-      BlockArguments
-      OverloadedStrings
-      ScopedTypeVariables
-      TypeApplications
-      DerivingStrategies
-      RecordWildCards
-      LambdaCase
-      MultiWayIf
-      StandaloneDeriving
-      NumericUnderscores
-  ghc-options: -Wall -funbox-strict-fields -threaded -Wno-unused-do-bind
   pkgconfig-depends:
       ncursesw
   build-depends:
@@ -73,5 +76,33 @@ executable hmp3
     , random
     , unix >=2.7
     , utf8-string
-  default-language: Haskell2010
 
+executable hmp3
+  import: opts
+  main-is: Main.hs
+  hs-source-dirs: ./
+  ghc-options: -threaded
+  build-depends:
+    , base
+    , bytestring
+    , hmp3-ng
+    , unix
+    , utf8-string
+
+test-suite test
+  import: opts
+  type: exitcode-stdio-1.0
+  main-is: Main.hs
+  hs-source-dirs: test
+  other-modules:
+      CoreSpec
+      FastIOSpec
+      LexerSpec
+      TreeSpec
+  build-depends:
+    , base
+    , bytestring
+    , clock
+    , hmp3-ng
+    , tasty           >=1.4
+    , tasty-hunit     >=0.10

test/CoreSpec.hs

@@ -0,0 +1,44 @@
+module CoreSpec (tests) where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import System.Clock (TimeSpec(..))
+
+import Core (showTimeDiff_)
+
+tests :: TestTree
+tests = testGroup "Core"
+    [ testGroup "showTimeDiff_ (secs=False)"
+        [ testCase "under a minute is 0m"
+            $ showTimeDiff_ False (t 0) (t 30)    @?= "0m"
+        , testCase "exactly one minute"
+            $ showTimeDiff_ False (t 0) (t 60)    @?= "1m"
+        , testCase "under an hour"
+            $ showTimeDiff_ False (t 0) (t 599)   @?= "9m"
+        , testCase "exactly one hour"
+            $ showTimeDiff_ False (t 0) (t 3600)  @?= "1h00m"
+        , testCase "one hour, one minute, one second drops seconds"
+            $ showTimeDiff_ False (t 0) (t 3661)  @?= "1h01m"
+        , testCase "exactly one day"
+            $ showTimeDiff_ False (t 0) (t 86400) @?= "1d00h00m"
+        , testCase "day, hour, minute"
+            $ showTimeDiff_ False (t 0) (t 90060) @?= "1d01h01m"
+        ]
+    , testGroup "showTimeDiff_ (secs=True)"
+        [ testCase "thirty seconds"
+            $ showTimeDiff_ True (t 0) (t 30)      @?= "30s"
+        , testCase "one minute exactly appends 00s"
+            $ showTimeDiff_ True (t 0) (t 60)      @?= "1m00s"
+        , testCase "one minute thirty seconds"
+            $ showTimeDiff_ True (t 0) (t 90)      @?= "1m30s"
+        , testCase "one hour one minute one second"
+            $ showTimeDiff_ True (t 0) (t 3661)    @?= "1h01m01s"
+        , testCase "diff is taken from monotonic delta, not absolute values"
+            $ showTimeDiff_ True (t 1000) (t 1090) @?= "1m30s"
+        ]
+    ]
+
+-- Build a TimeSpec from a whole number of seconds.
+t :: Integer -> TimeSpec
+t s = TimeSpec (fromInteger s) 0

test/FastIOSpec.hs

@@ -0,0 +1,42 @@
+module FastIOSpec (tests) where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import FastIO (basenameP, dirnameP, packedFileNameEndClean, trim)
+
+tests :: TestTree
+tests = testGroup "FastIO"
+    [ testGroup "basenameP"
+        [ testCase "no slash"           $ basenameP "foo"         @?= "foo"
+        , testCase "single dir"         $ basenameP "foo/bar"     @?= "bar"
+        , testCase "leading slash"      $ basenameP "/foo"        @?= "foo"
+        , testCase "nested"             $ basenameP "a/b/c/d.mp3" @?= "d.mp3"
+        , testCase "trailing slash"     $ basenameP "foo/"        @?= ""
+        , testCase "empty"              $ basenameP ""            @?= ""
+        ]
+    , testGroup "dirnameP"
+        [ testCase "no slash"           $ dirnameP "foo"          @?= "."
+        , testCase "single dir"         $ dirnameP "foo/bar"      @?= "foo"
+        , testCase "leading slash"      $ dirnameP "/foo"         @?= ""
+        , testCase "nested"             $ dirnameP "a/b/c/d.mp3"  @?= "a/b/c"
+        ]
+    , testGroup "trim"
+        [ testCase "no whitespace"      $ trim "foo"              @?= "foo"
+        , testCase "leading spaces"     $ trim "   foo"           @?= "foo"
+        , testCase "trailing spaces"    $ trim "foo   "           @?= "foo"
+        , testCase "both"               $ trim "   foo   "        @?= "foo"
+        , testCase "internal preserved" $ trim "  foo bar  "      @?= "foo bar"
+        , testCase "tabs and newlines"  $ trim "\t foo \n"        @?= "foo"
+        , testCase "whitespace only"    $ trim "   "              @?= ""
+        , testCase "empty"              $ trim ""                 @?= ""
+        ]
+    , testGroup "packedFileNameEndClean"
+        [ testCase "no trailing"        $ packedFileNameEndClean "foo"      @?= "foo"
+        , testCase "trailing slash"     $ packedFileNameEndClean "foo/"     @?= "foo"
+        , testCase "trailing backslash" $ packedFileNameEndClean "foo\\"    @?= "foo"
+        , testCase "multiple trailing"  $ packedFileNameEndClean "foo/\\/"  @?= "foo"
+        , testCase "internal preserved" $ packedFileNameEndClean "a/b/c/"   @?= "a/b/c"
+        , testCase "empty"              $ packedFileNameEndClean ""         @?= ""
+        ]
+    ]

test/LexerSpec.hs

@@ -0,0 +1,95 @@
+module LexerSpec (tests) where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import qualified Data.ByteString.Char8 as P
+
+import Lexer (doP, doF, doS, doI)
+import Syntax
+
+tests :: TestTree
+tests = testGroup "Lexer"
+    [ testGroup "doP (status messages)"
+        [ testCase "0 is Stopped"        $ status (doP "0")   @?= Stopped
+        , testCase "1 is Paused"         $ status (doP "1")   @?= Paused
+        , testCase "2 is Playing"        $ status (doP "2")   @?= Playing
+        , testCase "3 is Playing"        $ status (doP "3")   @?= Playing
+        , testCase "empty is Playing"    $ status (doP "")    @?= Playing
+        , testCase "garbage is Playing"  $ status (doP "xyz") @?= Playing
+        ]
+    , testGroup "doF (frame messages)"
+        [ testCase "all four fields parse" $ do
+            let Frame{..} = frame (doF "123 456 12.34 56.78")
+            currentFrame @?= 123
+            framesLeft   @?= 456
+            currentTime  @?= 12.34
+            timeLeft     @?= 56.78
+        , testCase "negative timeLeft is clamped to zero" $ do
+            timeLeft (frame (doF "0 0 0.00 -1.00")) @?= 0
+        ]
+    , testGroup "doS (info messages)"
+        [ testCase "userinfo combines version, bitrate, kHz" $
+            userinfo (info (doS "1.0 1 44100 stereo 0 0 2 0 0 0 128 0"))
+                @?= "mpeg 1.0 128kbit/s 44kHz"
+        ]
+    , testGroup "doI (track info / id3)"
+        [ testCase "non-id3 input becomes Left filename" $
+            fileLeft (doI "song.mp3") @?= "song.mp3"
+        , testCase "non-id3 input is trimmed" $
+            fileLeft (doI "  song.mp3  ") @?= "song.mp3"
+        , testCase "id3 with title only" $ do
+            let i = fileRight (doI ("ID3:" <> field30 "Title"))
+            id3title  i @?= "Title"
+            id3artist i @?= ""
+            id3album  i @?= ""
+            id3str    i @?= "Title"
+        , testCase "id3 with title and artist" $ do
+            let i = fileRight (doI ("ID3:" <> field30 "Title" <> field30 "Artist"))
+            id3title  i @?= "Title"
+            id3artist i @?= "Artist"
+            id3album  i @?= ""
+            id3str    i @?= "Artist : Title"
+        , testCase "id3 with title, artist, and album" $ do
+            let i = fileRight (doI ("ID3:" <> field30 "Title"
+                                          <> field30 "Artist"
+                                          <> field30 "Album"))
+            id3title  i @?= "Title"
+            id3artist i @?= "Artist"
+            id3album  i @?= "Album"
+            id3str    i @?= "Artist : Album : Title"
+        , testCase "id3 with empty title falls back to Left of trimmed input" $
+            -- mpg123 sometimes returns ID3 records with a blank title; rather than
+            -- present an empty track name, the parser exposes the raw line.
+            fileLeft (doI ("ID3:" <> field30 "" <> field30 "Artist"))
+                @?= "ID3:" <> P.replicate 30 ' ' <> "Artist"
+        ]
+    ]
+
+------------------------------------------------------------------------
+-- Helpers
+
+-- Pad/truncate a ByteString to exactly 30 characters with trailing spaces,
+-- matching the fixed-width field convention used by mpg123 ID3 output.
+field30 :: P.ByteString -> P.ByteString
+field30 b = P.take 30 (b <> P.replicate 30 ' ')
+
+status :: Msg -> Status
+status (S s) = s
+status _     = error "expected S"
+
+frame :: Msg -> Frame
+frame (R f) = f
+frame _     = error "expected R"
+
+info :: Msg -> Info
+info (I i) = i
+info _     = error "expected I"
+
+fileLeft :: Msg -> P.ByteString
+fileLeft (F (File (Left  s))) = s
+fileLeft _                    = error "expected F (File (Left _))"
+
+fileRight :: Msg -> Id3
+fileRight (F (File (Right i))) = i
+fileRight _                    = error "expected F (File (Right _))"

test/Main.hs

@@ -0,0 +1,16 @@
+module Main (main) where
+
+import Test.Tasty
+
+import qualified CoreSpec
+import qualified FastIOSpec
+import qualified LexerSpec
+import qualified TreeSpec
+
+main :: IO ()
+main = defaultMain $ testGroup "hmp3-ng"
+    [ CoreSpec.tests
+    , FastIOSpec.tests
+    , LexerSpec.tests
+    , TreeSpec.tests
+    ]

test/TreeSpec.hs

@@ -0,0 +1,38 @@
+module TreeSpec (tests) where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import Tree (doOrphans, merge)
+
+tests :: TestTree
+tests = testGroup "Tree"
+    [ testGroup "doOrphans"
+        [ testCase "empty"
+            $ doOrphans []                       @?= []
+        , testCase "bare filename"
+            $ doOrphans ["song.mp3"]             @?= [(".", ["song.mp3"])]
+        , testCase "single directory"
+            $ doOrphans ["a/song.mp3"]           @?= [("a", ["song.mp3"])]
+        , testCase "nested directory"
+            $ doOrphans ["a/b/song.mp3"]         @?= [("a/b", ["song.mp3"])]
+        , testCase "multiple, no merging here"
+            $ doOrphans ["a/x.mp3", "a/y.mp3"]   @?= [("a", ["x.mp3"]), ("a", ["y.mp3"])]
+        ]
+    , testGroup "merge"
+        [ testCase "empty"
+            $ merge []                                           @?= []
+        , testCase "singleton passes through"
+            $ merge [("a", ["x"])]                               @?= [("a", ["x"])]
+        , testCase "different keys are sorted"
+            $ merge [("b", ["1"]), ("a", ["2"])]                 @?= [("a", ["2"]), ("b", ["1"])]
+        , testCase "same key combines values"
+            $ merge [("a", ["x"]), ("a", ["y"])]                 @?= [("a", ["x", "y"])]
+        , testCase "preserves value order within a key"
+            $ merge [("a", ["1"]), ("a", ["2"]), ("a", ["3"])]   @?= [("a", ["1", "2", "3"])]
+        , testCase "value lists with multiple elements"
+            $ merge [("a", ["x", "y"]), ("a", ["z"])]            @?= [("a", ["x", "y", "z"])]
+        , testCase "interleaved keys"
+            $ merge [("a", ["1"]), ("b", ["2"]), ("a", ["3"])]   @?= [("a", ["1", "3"]), ("b", ["2"])]
+        ]
+    ]