No file list cache and only save mode, DEL deletes from search history.

.github/workflows/haskell.yml

@@ -5,7 +5,7 @@ jobs:
     runs-on: 'ubuntu-22.04'
     strategy:
       matrix:
-        ghc: ['9.0', '9.4', '9.6', '9.8', '9.10', 'latest']
+        ghc: ['9.4', '9.6', '9.8', '9.10', 'latest']
     name: GHC ${{ matrix.ghc }}
     steps:
       - uses: actions/checkout@v4

Base.hs

@@ -33,7 +33,7 @@
 import Data.Char as X
 import Data.Fixed as X
 import Data.Foldable as X
 import Data.Functor as X hiding (unzip)
 import Data.IORef as X
 import Data.List as X ((\\), group, groupBy, isPrefixOf, sort, sortBy, intersperse)
 import Data.Maybe as X
@@ -46,6 +46,7 @@
 import System.IO as X (Handle, hClose)
 import System.IO.Unsafe as X
 import Text.Printf as X
+import Text.Read as X (readMaybe)
 import System.Clock
 
 

Core.hs

@@ -2,7 +2,7 @@
 
 -- 
 -- Copyright (c) 2005-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons
--- Copyright (c) 2008, 2019-2024 Galen Huntington
+-- Copyright (c) 2008, 2019-2025 Galen Huntington
 -- 
 -- This program is free software; you can redistribute it and/or
 -- modify it under the terms of the GNU General Public License as
@@ -33,12 +33,10 @@
         seekStart,
         blacklist,
         showHist, hideHist,
-        writeSt, readSt,
         jumpToMatch, jumpToMatchFile,
         toggleFocus, jumpToNextDir, jumpToPrevDir,
         loadConfig,
         discardErrors,
-        FileListSource,
         toggleExit,
     ) where
 
@@ -67,13 +65,11 @@
 import System.Process           (runInteractiveProcess, waitForProcess)
 import System.Clock             (TimeSpec(..), diffTimeSpec)
 import System.Random            (randomIO)
-import System.FilePath          ((</>), takeDirectory)
+import System.FilePath          ((</>))
 import Data.List                (isInfixOf, tails)
 
 import System.Posix.Process     (exitImmediately)
 
-type FileListSource = Either SerialT [ByteString]
-
 
 mp3Tool :: String
 mp3Tool =
@@ -85,24 +81,15 @@
 
 ------------------------------------------------------------------------
 
-start :: Bool -> FileListSource -> IO ()
-start playNow ms = handle @SomeException (shutdown . Just . show) do
+start :: Bool -> Tree -> IO ()
+start playNow (Tree ds fs) = handle @SomeException (shutdown . Just . show) do
 
     t0 <- forkIO mpgLoop    -- start this off early, to give mpg123 time to settle
 
     c <- UI.start -- initialise curses
 
-    (ds,fs,i,m)   -- construct the state
-        <- case ms of
-           Right roots -> do Tree a b <- buildTree roots
-                             pure (a,b,0,Normal)
-
-           Left st     -> pure (ser_darr st
-                               ,ser_farr st
-                               ,ser_indx st
-                               ,ser_mode st)
-
     now <- getMonoTime
+    mode <- readState
 
     -- fork some threads
     t1 <- forkIO $ mpgInput readf
@@ -117,17 +104,18 @@
         { music        = fs
         , folders      = ds
         , size         = 1 + (snd . bounds $ fs)
-        , cursor       = i
-        , current      = i
-        , mode         = m
+        , cursor       = 0
+        , current      = 0
+        , mode         = mode
         , uptime       = showTimeDiff now now
         , boottime     = now
         , config       = c
         , threads      = [t0,t1,t2,t3,t4,t5] }
 
     loadConfig
 
-    when (0 <= (snd . bounds $ fs)) play -- start the first song
+    when (0 <= (snd . bounds $ fs)) do
+        if mode == Random then playRandom else playCur
     when (not playNow) pause
 
     run         -- won't restart if this fails!
@@ -238,7 +226,7 @@
 
 ------------------------------------------------------------------------
 
--- | Once each half second, wake up a and redraw the clock
+-- | Once each half second, wake up and redraw the clock
 clockLoop :: IO ()
 clockLoop = runForever $ threadDelay delay >> UI.refreshClock
   where
@@ -287,7 +275,7 @@
 shutdown :: Maybe String -> IO ()
 shutdown ms =
     do  silentlyModifyST $ \st -> st { doNotResuscitate = True }
-        discardErrors writeSt
+        discardErrors writeState
         withST $ \st -> do
             case mp3pid st of
                 Nothing  -> pure ()
@@ -615,34 +603,27 @@
 
 ------------------------------------------------------------------------
 
-getCachePath :: IO FilePath
-getCachePath = getXdgDirectory XdgCache $ "hmp3" </> "playlist.db"
-
--- | Saving the playlist 
--- Only save if there's something to save. Should prevent dbs being wiped
--- if curses crashes before the state is read.
-writeSt :: IO ()
-writeSt = do
-    f <- getCachePath
-    withST \st -> when (size st > 0) do
-        let arr1 = music st
-            arr2 = folders st
-            idx  = current st
-            mde  = mode st
-        createDirectoryIfMissing True $ takeDirectory f
-        writeTree f $ SerialT {
-            ser_farr = arr1
-           ,ser_darr = arr2
-           ,ser_indx = idx
-           ,ser_mode = mde
-          }
-
--- | Read the playlist back
-readSt :: IO (Maybe SerialT)
-readSt = do
-    f <- getCachePath
+getStatePath :: IO FilePath
+getStatePath = getXdgDirectory XdgState "hmp3"
+
+-- | Save mode state
+writeState :: IO ()
+writeState = do
+    dir <- getStatePath
+    createDirectoryIfMissing True dir
+    mode <- getsST mode
+    writeFile (dir </> "mode") $ show mode ++ "\n"
+
+-- | Read mode state
+readState :: IO Mode
+readState = do
+    dir <- getStatePath
+    let f = dir </> "mode"
     b <- doesFileExist f
-    if b then Just <$!> readTree f else pure Nothing
+    modeM <- if b
+        then readMaybe <$!> readFile f
+        else pure Nothing
+    pure $ fromMaybe (mode emptySt) modeM
 
 ------------------------------------------------------------------------
 -- Read styles from style.conf
@@ -661,14 +642,12 @@
             if old `isInfixOf` str'
             then do
                 warnA $ old ++ " is now " ++ new ++ " in style.conf"
                 let (ix, rest) = head $ filter (\ (_, s) -> old `isPrefixOf` s) $ zip [0..] $ tails str'
                 pure $ take ix str' ++ new ++ drop (length old) rest
             else pure str'
-        msty <- catch (fmap Just $ evaluate $ read str)
-                      (\ (_ :: SomeException) ->
-                        warnA "Parse error in style.conf" $> Nothing)
-        case msty of
-            Nothing  -> pure ()
+        case readMaybe str of
+            Nothing  -> do
+                warnA "Parse error in style.conf"
             Just rsty -> do
                 let sty = buildStyle rsty
                 initcolours sty

Keymap.hs

@@ -1,6 +1,6 @@
 -- 
 -- Copyright (c) 2004-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons
--- Copyright (c) 2008, 2019-2024 Galen Huntington
+-- Copyright (c) 2008, 2019-2025 Galen Huntington
 -- 
 -- This program is free software; you can redistribute it and/or
 -- modify it under the terms of the GNU General Public License as
@@ -81,7 +81,7 @@
 allKeys = commands >||< search >||< history >||< confirmQuit
 
 commands :: LexerS
 commands = alt keys `action` \[c] -> Just $ fromMaybe (pure ()) $ M.lookup c keyMap
 
 ------------------------------------------------------------------------
 
@@ -103,7 +103,9 @@
         >||< searchStart '?' SearchFiles Backwards
 
 dosearch :: LexerS
-dosearch = search_char >||< search_bs >||< search_up >||< search_down >||< search_esc >||< search_eval
+dosearch = search_char >||< search_bs
+    >||< search_up >||< search_down >||< search_del
+    >||< search_esc >||< search_eval
 
 endSearchWith :: IO () -> [String] -> MetaTarget
 endSearchWith a hist = (with (a *> toggleFocus), SearchState hist undefined, Just allKeys)
@@ -140,6 +142,11 @@
     Zipper cur back (pv:rest) -> Zipper pv (cur:back) rest
     zipp                      -> zipp
 
+search_del :: LexerS
+search_del = char (unkey KeyDC) `meta` \_ -> updateSearch \case
+    Zipper _ back (pv:rest) -> Zipper pv back rest
+    Zipper _ back _         -> Zipper "" back []
+
 search_esc :: LexerS
 search_esc = char '\ESC' `meta`
     \_ (SearchState hist _) -> endSearchWith (clrmsg *> touchST) hist
@@ -170,7 +177,7 @@
         (with do
             ph <- getsST playHist
             for_
                 do ph Seq.!? (fromEnum (head cs) - (fromEnum base - off))
                 do jump . snd
             hideHist
             touchST
@@ -191,7 +198,7 @@
 -- "Key"s seem to be inscrutable and incomparable.
 -- So, add an orphan instance to help translate to chars.
 
 deriving stock instance Ord Key
 
 charToKey :: Char -> Key
 charToKey = decodeKey . toEnum . fromEnum
@@ -204,7 +211,7 @@
 
 enter', any', digit', delete' :: [Char]
 enter'   = ['\n', '\r']
-delete'  = ['\BS', '\127', unkey KeyBackspace]
+delete'  = ['\BS', '\DEL', unkey KeyBackspace]
 any'     = ['\0' .. '\255']
 digit'   = ['0' .. '9']
 
@@ -262,7 +269,7 @@
         ['N'],   jumpToMatchFile Nothing False)
     ,("Play",
         ['p'],   playCur)
-    ,("Mark for deletion in ~/.hmp3-delete",
+    ,("Mark for deletion in .hmp3-delete",
         ['D'],   blacklist)
     ,("Load config file",
         ['l'],   loadConfig)

Lexer.hs

@@ -1,6 +1,6 @@
 -- 
 -- Copyright (c) 2005-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons
--- Copyright (c) 2008, 2019-2024 Galen Huntington
+-- Copyright (c) 2008, 2019-2025 Galen Huntington
 -- 
 -- This program is free software; you can redistribute it and/or
 -- modify it under the terms of the GNU General Public License as
@@ -30,7 +30,7 @@
 import qualified Data.ByteString.Char8 as P
 import qualified Data.ByteString.UTF8 as UTF8
 import Control.Monad.Except
 import Control.Monad.Trans (lift)
 
 ------------------------------------------------------------------------
 
@@ -60,7 +60,7 @@
               , timeLeft     = max 0 . read . P.unpack $ f3
            }
         where
           f0 : f1 : f2 : f3 : _ = P.split ' ' s
 
 -- Outputs information about the mp3 file after loading.
 doS :: ByteString -> Msg
@@ -152,7 +152,7 @@
 
     when (P.length x < 3) skip
     let (pre, m) = P.splitAt 3 x
         at : code : sp : _ = P.unpack pre
     when (at /= '@' || sp /= ' ') skip
 
     -- TODO: make doX functions total

Main.hs

@@ -1,7 +1,7 @@
 -- 
 -- Copyright (c) Don Stewart 2004-2008.
 -- Copyright (c) Tuomo Valkonen 2004.
--- Copyright (c) 2019-2024 Galen Huntington
+-- Copyright (c) 2019-2025 Galen Huntington
 --
 -- This program is free software; you can redistribute it and/or
 -- modify it under the terms of the GNU General Public License as
@@ -23,8 +23,9 @@ module Main where
 
 import Base
 
-import Core     (start, readSt, shutdown, FileListSource)
+import Core     (start, shutdown)
 import Config   (help, versinfo)
+import Tree     (Tree, buildTree, isEmpty)
 
 import System.IO            (hPrint, stderr)
 import System.Posix.Signals (installHandler, sigTERM, sigPIPE, sigINT, sigHUP
@@ -54,6 +55,7 @@ initSignals = do
             catch (shutdown Nothing) (\ (f :: SomeException) -> hPrint stderr f)
             exitWith (ExitFailure 1) )) Nothing
 
+-- XXX this function is not used
 releaseSignals :: IO ()
 releaseSignals =
     for_ [sigINT, sigPIPE, sigHUP, sigABRT, sigTERM]
@@ -71,25 +73,30 @@ usage = ["Usage: hmp3 [-VhP] [FILE|DIR ...]"
         ]
 
 -- | Parse the args
-doArgs :: [ByteString] -> IO (Bool, FileListSource)
+doArgs :: [ByteString] -> IO (Bool, Tree)
 doArgs = loopArgs True where
 
-    loopArgs playNow []  = do    -- attempt to read db
-        x <- readSt
-        case x of
-            Nothing -> traverse_ putStrLn usage *> exitSuccess
-            Just st -> pure (playNow, Left st)
+    verLine = putStrLn $ unwords [versinfo, help]
+    showUsage = traverse_ putStrLn usage
+
+    loopArgs _ [] = do
+        putStrLn "Specify at least one file or directory."
+        showUsage
+        exitFailure
 
     loopArgs _ (s:xs)
         | s == "-V" || s == "--version"
-        = do verLine *> exitSuccess
+        = verLine *> exitSuccess
         | s == "-h" || s == "--help"
-        = do verLine *> traverse_ putStrLn usage *> exitSuccess
+        = verLine *> showUsage *> exitSuccess
         | s == "-P" || s == "--paused"
         = loopArgs False xs
-        where verLine = putStrLn $ unwords [versinfo, help]
 
-    loopArgs playNow xs = pure (playNow, Right xs)
+    loopArgs playNow xs = do
+        tree <- buildTree xs
+        if isEmpty tree
+            then putStrLn "Error: No music files found." *> exitFailure
+            else pure (playNow, tree)
 
 -- ---------------------------------------------------------------------
 -- | Static main. This is the front end to the statically linked

README.md

@@ -3,11 +3,10 @@
 
 ##  hmp3-ng
 
-The `hmp3` music player, written in Haskell, dates to 2005, and has a
-curses interface for use in a text terminal.  However, it has become
-abandonware: the last update was in June 2008, and it no longer builds
-with today’s Haskell and standard libraries.
-
+The original `hmp3` music player, written in Haskell, dates to 2005,
+and has a curses interface for use in a text terminal.  However,
+it has become abandonware: the last update was in June 2008, and
+it no longer builds with today’s Haskell and standard libraries.
 This repository is an effort to resurrect this software.
 
 The original Darcs repo has vanished from the Internet.  However, I
@@ -59,8 +58,8 @@ Either `cabal install` or `stack install` will build a binary.
 You will need to have `mpg123` installed, which is free software and
 widely available in package managers.  Alternatively, `mpg321` can
 be used by compiling with the `-DMPG321` option.  In my experience,
-the latter worked better, but it has not been updated since 2012 and
-is no longer available on many systems.
+the latter worked better, but it too is abandoned, with no update
+since 2012, and is no longer available on many systems.
 
 The build depends on the package `hscurses`, which in turn requires
 curses dev files.  In Ubuntu/Debian, for example, these can be obtained
@@ -70,13 +69,10 @@ by installing `libncurses-dev`.
 ##  Use
 
 The `hmp3` executable is invoked with a list of mp3 files or
-directories of mp3 files.  With no arguments, it will use the
-playlist from the last time it was run, which is stored in an XDG
-cache directory, usually `~/.cache/hmp3/playlist.db`.
+directories of mp3 files.
 
 ```
 $ hmp3 ~/Music ~/Downloads/La-La.mp3
-$ hmp3
 ```
 
 Once running, `hmp3` is controlled by fairly intuitive key commands.
@@ -89,7 +85,7 @@ See `Style.hs` for the definition.  The `l` command hot-reloads this
 configuration.
 
 
-##  Original authorship list
+##  Original authorship
 
 ```
 License:

Syntax.hs

@@ -140,7 +140,7 @@ data Status = Stopped
     deriving stock (Eq, Show)
 
 data Mode = Normal | Loop | Random
-    deriving stock (Eq, Bounded, Enum)
+    deriving stock (Eq, Bounded, Enum, Show, Read)
 
 ------------------------------------------------------------------------