hmp3-ng 2.15.1 → 2.16.0
raw patch · 10 files changed
+84/−156 lines, 10 filesdep −binarydep −zlibdep ~directory
Dependencies removed: binary, zlib
Dependency ranges changed: directory
Files
- Base.hs +1/−0
- Core.hs +33/−54
- Keymap.hs +11/−4
- Lexer.hs +1/−1
- Main.hs +19/−12
- README.md +8/−12
- Syntax.hs +1/−1
- Tree.hs +7/−67
- UI.hs +1/−1
- hmp3-ng.cabal +2/−4
Base.hs view
@@ -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 view
@@ -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
Keymap.hs view
@@ -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)
Lexer.hs view
@@ -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
Main.hs view
@@ -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
README.md view
@@ -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:
Syntax.hs view
@@ -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) ------------------------------------------------------------------------
Tree.hs view
@@ -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))
UI.hs view
@@ -406,7 +406,7 @@ instance Element PMode where draw dd = PMode case status $ drawState dd of Stopped -> "◼"- Paused -> "Ⅱ"+ Paused -> "⏸" Playing -> "▶" -- | Loop, normal, or random
hmp3-ng.cabal view
@@ -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