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-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 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-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 diff --git a/Lexers.hs b/Lexers.hs --- a/Lexers.hs +++ b/Lexers.hs @@ -549,4 +549,4 @@ -- | closing a difference list into a normal list (EXPORTED) closeDL :: DList a -> [a] -closeDL = ($[]) +closeDL = ($ []) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/State.hs b/State.hs --- a/State.hs +++ b/State.hs @@ -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 diff --git a/Style.hs b/Style.hs --- a/Style.hs +++ b/Style.hs @@ -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 { diff --git a/UI.hs b/UI.hs --- a/UI.hs +++ b/UI.hs @@ -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 ------------------------------------------------------------------------ -- diff --git a/hmp3-ng.cabal b/hmp3-ng.cabal --- a/hmp3-ng.cabal +++ b/hmp3-ng.cabal @@ -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 +