diff --git a/Base.hs b/Base.hs --- a/Base.hs +++ b/Base.hs @@ -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 diff --git a/Core.hs b/Core.hs --- a/Core.hs +++ b/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,14 +65,12 @@ 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 = #ifdef MPG321 @@ -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,9 +104,9 @@ { 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 @@ -127,7 +114,8 @@ 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" +getStatePath :: IO FilePath +getStatePath = getXdgDirectory XdgState "hmp3" --- | 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 - } +-- | Save mode state +writeState :: IO () +writeState = do + dir <- getStatePath + createDirectoryIfMissing True dir + mode <- getsST mode + writeFile (dir "mode") $ show mode ++ "\n" --- | Read the playlist back -readSt :: IO (Maybe SerialT) -readSt = do - f <- getCachePath +-- | 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 @@ -664,11 +645,9 @@ 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 diff --git a/Keymap.hs b/Keymap.hs --- a/Keymap.hs +++ b/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 @@ -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 @@ -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) diff --git a/Lexer.hs b/Lexer.hs --- a/Lexer.hs +++ b/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 diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/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 @@ 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 @@ 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 @@ ] -- | 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 diff --git a/README.md b/README.md --- a/README.md +++ b/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 @@ 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 @@ ## 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 @@ configuration. -## Original authorship list +## Original authorship ``` License: diff --git a/Syntax.hs b/Syntax.hs --- a/Syntax.hs +++ b/Syntax.hs @@ -140,7 +140,7 @@ deriving stock (Eq, Show) data Mode = Normal | Loop | Random - deriving stock (Eq, Bounded, Enum) + deriving stock (Eq, Bounded, Enum, Show, Read) ------------------------------------------------------------------------ diff --git a/Tree.hs b/Tree.hs --- a/Tree.hs +++ b/Tree.hs @@ -1,7 +1,7 @@ {-# OPTIONS -fno-warn-orphans #-} -- -- Copyright (c) 2005-8 Don Stewart - http://www.cse.unsw.edu.au/~dons --- Copyright (c) 2019, 2020 Galen Huntington +-- Copyright (c) 2019-2020, 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 @@ -28,12 +28,8 @@ import Base import FastIO -import Syntax (Mode(..)) import qualified Data.ByteString.Char8 as P -import qualified Data.ByteString.Lazy as L -import Codec.Compression.GZip -import Data.Binary import Data.Array import System.IO (hPrint, stderr) @@ -85,6 +81,10 @@ pure $! Tree dirsArray fileArray +-- | Is the tree empty? +isEmpty :: Tree -> Bool +isEmpty (Tree _ files) = null files + -- | Create nodes based on dirname for orphan files on cmdline doOrphans :: [FilePathP] -> [(FilePathP, [FilePathP])] doOrphans = map \f -> (dirnameP f, [basenameP f]) @@ -118,8 +118,7 @@ -- Assumes no evil sym links -- expandDir :: FilePathP -> IO (Maybe (FilePathP, [FilePathP]), [FilePathP]) -expandDir f | seq f False = undefined -- stricitfy -expandDir f = do +expandDir !f = do ls_raw <- handle @SomeException (\e -> hPrint stderr e $> []) $ packedGetDirectoryContents f let ls = (map \s -> P.intercalate (P.singleton '/') [f,s]) @@ -131,7 +130,7 @@ where notEdge p = p /= dot && p /= dotdot validFiles p = notEdge p - onlyMp3s p = mp3 == (P.map toLower . P.drop (P.length p -3) $ p) + onlyMp3s p = mp3 == (P.map toLower . P.drop (P.length p - 3) $ p) mp3 = "mp3" dot = "." @@ -164,62 +163,3 @@ pure if y then (a:fs, ds) else (fs, ds) else pure (fs, a:ds) ------------------------------------------------------------------------- --- --- And some more Binary instances --- - -instance Binary File where - put (File nm i) = put nm >> put i - get = do - nm <- get - i <- get - pure (File nm i) - -instance Binary Dir where - put (Dir nm sz lo hi) = put nm >> put sz >> put lo >> put hi - get = do - nm <- get - sz <- get - lo <- get - hi <- get - pure (Dir nm sz lo hi) - -instance Binary Mode where - put = put . fromEnum - get = toEnum <$> get - --- How we write everything out -instance Binary SerialT where - put st = do - put (ser_farr st, ser_darr st) - put (ser_indx st) - put (ser_mode st) - - get = do - (a,b)<- get - i <- get - m <- get - pure $ SerialT { - ser_farr = a - ,ser_darr = b - ,ser_indx = i - ,ser_mode = m - } - ------------------------------------------------------------------------ - --- | Wrap up the values we're going to dump to disk -data SerialT = SerialT { - ser_farr :: !FileArray, - ser_darr :: !DirArray, - ser_indx :: !Int, - ser_mode :: !Mode - } - -writeTree :: FilePath -> SerialT -> IO () -writeTree f s = L.writeFile f (compress (encode s)) - -readTree :: FilePath -> IO SerialT -readTree f = do s <- L.readFile f - pure (decode (decompress s)) diff --git a/UI.hs b/UI.hs --- a/UI.hs +++ b/UI.hs @@ -406,7 +406,7 @@ instance Element PMode where draw dd = PMode case status $ drawState dd of Stopped -> "◼" - Paused -> "Ⅱ" + Paused -> "⏸" Playing -> "▶" -- | Loop, normal, or random diff --git a/hmp3-ng.cabal b/hmp3-ng.cabal --- a/hmp3-ng.cabal +++ b/hmp3-ng.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: hmp3-ng -version: 2.15.1 +version: 2.16.0 synopsis: A 2019 fork of an ncurses mp3 player written in Haskell description: An mp3 player with a curses frontend. Playlists are populated by passing file and directory names on the command line. 'h' displays @@ -61,11 +61,10 @@ build-depends: , array , base ==4.* - , binary >=0.4 , bytestring >=0.10 , clock , containers - , directory + , directory >=1.3.7.0 , filepath , hscurses , mtl @@ -74,6 +73,5 @@ , random , unix >=2.7 , utf8-string - , zlib >=0.4 default-language: Haskell2010