hmp3-ng 2.12.1 → 2.14.1.1
raw patch · 8 files changed
+123/−83 lines, 8 files
Files
- Core.hs +39/−29
- Keymap.hs +24/−14
- Lexers.hs +1/−1
- README.md +10/−11
- State.hs +3/−1
- Style.hs +2/−3
- UI.hs +21/−7
- hmp3-ng.cabal +23/−17
Core.hs view
@@ -2,7 +2,7 @@ -- -- Copyright (c) 2005-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons--- Copyright (c) 2008, 2019-2021 Galen Huntington+-- Copyright (c) 2008, 2019-2022 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@@ -27,7 +27,7 @@ start, shutdown, seekLeft, seekRight, up, down, pause, nextMode, playNext, playPrev,- quit, putmsg, clrmsg, toggleHelp, play, playCur,+ forcePause, quit, putmsg, clrmsg, toggleHelp, play, playCur, jumpToPlaying, jump, jumpRel, upPage, downPage, seekStart,@@ -39,6 +39,7 @@ loadConfig, discardErrors, FileListSource,+ toggleExit, ) where import Base@@ -60,16 +61,16 @@ import qualified Data.Sequence as Seq import Data.Array ((!), bounds, Array)-import System.Directory (doesFileExist,findExecutable)+import System.Directory (doesFileExist, findExecutable, createDirectoryIfMissing,+ getXdgDirectory, XdgDirectory(..)) import System.IO (hPutStrLn, hGetLine, stderr, hFlush) import System.Process (runInteractiveProcess, waitForProcess) import System.Clock (TimeSpec(..), diffTimeSpec) import System.Random (randomIO)-import System.FilePath ((</>))+import System.FilePath ((</>), takeDirectory) import Data.List (isInfixOf, tails) import System.Posix.Process (exitImmediately)-import System.Posix.User (getUserEntryForID, getRealUserID, homeDirectory) type FileListSource = Either SerialT [ByteString] @@ -477,6 +478,12 @@ pause :: IO () pause = withST $ \st -> readMVar (writeh st) >>= flip send Pause +-- | Always pause+forcePause :: IO ()+forcePause = do+ st <- getsST status+ when (st == Playing) pause+ -- | Shutdown and exit quit :: Maybe String -> IO () quit = shutdown@@ -575,7 +582,7 @@ ------------------------------------------------------------------------ --- | Show\/hide the help window+-- | Show/hide the help window toggleHelp :: IO () toggleHelp = modifyST $ \st -> st { helpVisible = not (helpVisible st) } @@ -583,6 +590,10 @@ toggleFocus :: IO () toggleFocus = modifyST $ \st -> st { miniFocused = not (miniFocused st) } +-- | Show/hide the confirm exit modal+toggleExit :: IO ()+toggleExit = modifyST $ \st -> st { exitVisible = not (exitVisible st) }+ -- | History on or off hideHist :: IO () hideHist = modifyST $ \st -> st { histVisible = Nothing }@@ -605,59 +616,58 @@ ------------------------------------------------------------------------ +getCachePath :: IO FilePath+getCachePath = getXdgDirectory XdgCache $ "hmp3" </> "playlist.db"+ -- | Saving the playlist --- Only save if there's something to save. Should preven dbs being wiped+-- 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- home <- getHome- let f = home </> ".hmp3db"- withST \st -> do+ f <- getCachePath+ withST \st -> when (size st > 0) do let arr1 = music st arr2 = folders st idx = current st mde = mode st- when (size st > 0) $ writeTree f $ SerialT {- ser_farr = arr1- ,ser_darr = arr2- ,ser_indx = idx- ,ser_mode = mde- }+ 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- home <- getHome- let f = home </> ".hmp3db"+ f <- getCachePath b <- doesFileExist f if b then Just <$!> readTree f else pure Nothing --- | Find a user's home in a canonical sort of way-getHome :: IO String-getHome = catch @SomeException- do getRealUserID >>= getUserEntryForID <&> homeDirectory- do const $ getEnv "HOME"- --------------------------------------------------------------------------- Read styles from ~/.hmp3+-- Read styles from style.conf --++getConfPath :: IO FilePath+getConfPath = getXdgDirectory XdgConfig $ "hmp3" </> "style.conf"+ loadConfig :: IO () loadConfig = do- home <- getHome- let f = home </> ".hmp3"+ f <- getConfPath b <- doesFileExist f if b then do str' <- readFile f str <- let (old, new) = ("hmp3_helpscreen", "hmp3_modals") in if old `isInfixOf` str' then do- warnA $ old ++ " is now " ++ new ++ " in ~/.hmp3"+ 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 ~/.hmp3" $> Nothing)+ warnA "Parse error in style.conf" $> Nothing) case msty of Nothing -> pure () Just rsty -> do
Keymap.hs view
@@ -1,6 +1,6 @@ -- -- Copyright (c) 2004-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons--- Copyright (c) 2008, 2019-2021 Galen Huntington+-- Copyright (c) 2008, 2019-2022 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@@ -36,6 +36,7 @@ import Base hiding (all) import Core+import Config (package) import State (getsST, touchST, HState(helpVisible, playHist)) import Style (defaultSty, StringA(Fast)) import qualified UI (resetui)@@ -74,10 +75,10 @@ -- keymap :: [Char] -> [IO ()] keymap cs = map (clrmsg *>) actions- where (actions,_,_) = execLexer all (cs, SearchState [] undefined)+ where (actions,_,_) = execLexer allKeys (cs, SearchState [] undefined) -all :: LexerS-all = commands >||< search >||< history+allKeys :: LexerS+allKeys = commands >||< search >||< history >||< confirmQuit commands :: LexerS commands = alt keys `action` \[c] -> Just $ fromMaybe (pure ()) $ M.lookup c keyMap@@ -105,7 +106,7 @@ dosearch = search_char >||< search_bs >||< search_up >||< search_down >||< search_esc >||< search_eval endSearchWith :: IO () -> [String] -> MetaTarget-endSearchWith a hist = (with (a *> toggleFocus), SearchState hist undefined, Just all)+endSearchWith a hist = (with (a *> toggleFocus), SearchState hist undefined, Just allKeys) -- "lens" zipEdit :: (String -> String) -> Zipper -> Zipper@@ -162,7 +163,7 @@ history = alt ['H', ';'] `meta` \_ st -> (with (showHist *> touchST), st, Just inner) where inner =- alt any' `meta` (\_ st -> (with (hideHist *> touchST), st, Just all))+ alt any' `meta` (\_ st -> (with (hideHist *> touchST), st, Just allKeys)) >||< alt ['0'..'9'] `meta` handleKey '0' 0 >||< alt ['a'..'z'] `meta` handleKey 'a' 10 handleKey base off cs st =@@ -174,11 +175,19 @@ hideHist touchST , st- , Just all+ , Just allKeys ) ------------------------------------------------------------------------ +confirmQuit :: LexerS+confirmQuit = char 'q' `meta`+ \_ st -> (with (forcePause *> toggleExit *> touchST), st, Just inner) where+ inner = alt any' `meta` (\_ st -> (with (toggleExit *> touchST), st, Just allKeys))+ >||< char 'y' `meta` (\_ st -> (with $ quit Nothing, st, Nothing))++------------------------------------------------------------------------+ -- "Key"s seem to be inscrutable and incomparable. -- Solution is to translate to chars. Really hacky! -- TODO at least use lookup table (standalone deriving Ord)@@ -225,19 +234,17 @@ ,("Seek right within song", [unkey KeyRight], seekRight) ,("Toggle pause",- [' '], pause)+ [' '], pause) ,("Play song under cursor",- ['\n'], play)+ ['\n'], play) ,("Play previous track",- ['K'], playPrev)+ ['K'], playPrev) ,("Play next track",- ['J'], playNext)+ ['J'], playNext) ,("Toggle the help screen", ['h'], toggleHelp) ,("Jump to currently playing song", ['t'], jumpToPlaying)- ,("Quit (or close help screen)",- ['q'], do b <- helpIsVisible ; if b then toggleHelp else quit Nothing) ,("Select and play next track", ['d'], playNext *> jumpToPlaying) ,("Cycle through normal, random, and loop modes",@@ -266,7 +273,10 @@ ,("Search for file matching regex", ['/']) ,("Search backwards for file", ['?']) ,("Search for directory matching regex", ['\\'])- ,("Search backwards for directory", ['|']) ]+ ,("Search backwards for directory", ['|'])+ -- ,("Quit (or close help screen)", ['q'])+ ,("Quit " ++ package, ['q'])+ ] helpIsVisible :: IO Bool helpIsVisible = getsST helpVisible
Lexers.hs view
@@ -549,4 +549,4 @@ -- | closing a difference list into a normal list (EXPORTED) closeDL :: DList a -> [a]-closeDL = ($[])+closeDL = ($ [])
README.md view
@@ -21,14 +21,11 @@ regeneration of a `configure` file (now gone). * The code has been updated to compile under recent GHC (currently-8.6, 8.8, 8.10, and 9.0) and libraries. This required rewriting or-entirely replacing large sections, mainly low-level optimizations.+8.6, 8.8, 8.10, 9.0, and 9.2) and libraries. This required rewriting+or entirely replacing large sections, mainly low-level optimizations. * I added support for building with Stack. -* Cabal is configured using [hpack](https://github.com/sol/hpack)-with a `package.yaml` file.- * There is a public GitHub issue tracker, and Travis integration to continuously test builds. @@ -43,8 +40,8 @@ are utilized in the interface. * It is much more stable. The app used to crash frequently and-require restart, but I’ve had `hmp3-ng` running continuously for-more than a year with heavy use without any problems.+require restart, but I’ve had `hmp3-ng` running multiple times+continuously for more than a year with heavy use without any problems. * Several additions and changes have been made to the feature set and the UI. A few of the key bindings have been modified per my@@ -72,8 +69,9 @@ ## 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 `~/.hmp3db`.+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`. ``` $ hmp3 ~/Music ~/Downloads/La-La.mp3@@ -82,10 +80,11 @@ Once running, `hmp3` is controlled by fairly intuitive key commands. `h` shows a help menu, and `q` quits. `hmp3 -h` prints a simple help-message with options.+message with command line options. A color scheme can be specified by writing out a `Config { .. }`-value in `~/.hmp3`. See `Style.hs` for the definition. The `l`+value in `~/.config/hmp3/style.conf` or the equivalent in your+XDG config directory. See `Style.hs` for the definition. The `l` command hot-reloads this configuration.
State.hs view
@@ -63,8 +63,9 @@ ,info :: !(Maybe Info) -- mp3 info ,status :: !Status ,minibuffer :: !StringA -- contents of minibuffer- ,helpVisible :: !Bool -- is the help window shown+ ,helpVisible :: !Bool -- is the help window shown? ,histVisible :: !(Maybe [(String, String)]) -- history pop-up if shown+ ,exitVisible :: !Bool -- confirm exit modal shown ,miniFocused :: !Bool -- is the mini buffer focused? ,mode :: !Mode -- random mode ,uptime :: !ByteString@@ -109,6 +110,7 @@ ,clockUpdate = False ,helpVisible = False ,histVisible = Nothing+ ,exitVisible = False ,miniFocused = False ,xterm = False ,doNotResuscitate = False -- mpg321 should be restarted
Style.hs view
@@ -305,7 +305,7 @@ -- -- The fields must map to UIStyle ----- It is this data type that is stored in 'show' format in ~/.hmp3+-- It is this data type that is stored in 'show' format in style.conf -- data Config = Config { hmp3_window :: (String,String)@@ -320,8 +320,7 @@ } deriving stock (Show,Read) ----- | Read the ~/.hmp3 file, and construct a UIStyle from it, to insert--- into +-- | Read style.conf, and construct a UIStyle from it, to insert into -- buildStyle :: Config -> UIStyle buildStyle bs = UIStyle {
UI.hs view
@@ -2,7 +2,7 @@ -- -- Copyright (C) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons--- Copyright (c) 2019-2021 Galen Huntington+-- Copyright (c) 2019-2022 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@@ -228,8 +228,9 @@ newtype PlayInfo = PlayInfo ByteString newtype PlayModes = PlayModes String -data HelpScreen-data HistScreen+data HelpModal+data HistModal+data ExitModal class ModalElement a where -- takes style, window width, state; returns (width, list of lines) drawModal :: Style -> Int -> HState -> Maybe (Int, [StringA])@@ -295,7 +296,7 @@ -- instance ModalElement me => Element (Modal me) where draw = drawModal -instance ModalElement HelpScreen where+instance ModalElement HelpModal where drawModal sty swd st = do guard $ helpVisible st pure $ (wd,) $@@ -327,7 +328,7 @@ ------------------------------------------------------------------------ -instance ModalElement HistScreen where+instance ModalElement HistModal where drawModal sty swd st = flip fmap (histVisible st) \hist -> do let wd = modalWidth swd mtlen = maximum $ map (length . fst) hist@@ -338,6 +339,17 @@ ------------------------------------------------------------------------ +instance ModalElement ExitModal where+ drawModal sty swd st = do+ guard $ exitVisible st+ let wd = modalWidth swd `min` 19+ blank = Fast (UTF8.fromString $ forceWidth wd "") sty+ padl = replicate ((wd - 9) `div` 2) ' '+ msg = forceWidth wd $ padl ++ "Exit (y)?"+ pure $ (wd, [blank, Fast (UTF8.fromString msg) sty, blank])++------------------------------------------------------------------------+ -- | The time used and time left instance Element PTimes where draw DD { drawFrame=Just Frame {..}, drawSize=Size{sizeW=x} } =@@ -598,10 +610,12 @@ (y',_) <- Curses.getYX Curses.stdScr Curses.wMove Curses.stdScr (y'+1) hoffset +-- XXX don't understand what sz is even doing renderModals :: HState -> Size -> IO () renderModals s sz = do- renderModal @HelpScreen s sz- renderModal @HistScreen s sz+ renderModal @HelpModal s sz+ renderModal @HistModal s sz+ renderModal @ExitModal s sz ------------------------------------------------------------------------ --
hmp3-ng.cabal view
@@ -1,24 +1,17 @@-cabal-version: 1.12---- This file has been generated from package.yaml by hpack version 0.33.0.------ see: https://github.com/sol/hpack------ hash: ed921d75498f5adab5e40868233e64732bc07148abdfb6a0dca0415ae6ae9124+cabal-version: 2.2 name: hmp3-ng-version: 2.12.1+version: 2.14.1.1 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, and saved to the- ~/.hmp3db database. Type 'h' to display the help page. Colours may- be configured at runtime by editing the "~/.hmp3" file.+description: An mp3 player with a curses frontend. Playlists are populated by+ passing file and directory names on the command line. 'h' displays+ help. category: Sound homepage: https://github.com/galenhuntington/hmp3-ng#readme bug-reports: https://github.com/galenhuntington/hmp3-ng/issues author: Don Stewart, Galen Huntington maintainer: Galen Huntington-license: GPL+license: GPL-2.0-or-later license-file: LICENSE build-type: Simple extra-source-files:@@ -45,15 +38,27 @@ Tree UI Paths_hmp3_ng+ autogen-modules:+ Paths_hmp3_ng hs-source-dirs:- ./.- default-extensions: BangPatterns BlockArguments NondecreasingIndentation OverloadedStrings ScopedTypeVariables TypeApplications DerivingStrategies RecordWildCards LambdaCase MultiWayIf+ ./+ default-extensions:+ BangPatterns+ BlockArguments+ NondecreasingIndentation+ OverloadedStrings+ ScopedTypeVariables+ TypeApplications+ DerivingStrategies+ RecordWildCards+ LambdaCase+ MultiWayIf ghc-options: -Wall -funbox-strict-fields -threaded -Wno-unused-do-bind extra-libraries: ncursesw build-depends:- array- , base >=4 && <5+ , array+ , base ==4.* , binary >=0.4 , bytestring >=0.10 , clock@@ -69,3 +74,4 @@ , utf8-string , zlib >=0.4 default-language: Haskell2010+