Miscellaneous code improvements.

Author: galenhuntington

Core.hs

@@ -406,7 +406,7 @@ blacklist = do
 jumpToRandom :: HState -> IO HState
 jumpToRandom st = do
     n' <- randomIO
-    let n = abs n' `mod` (size st - 1)
+    let n = abs n' `mod` size st
     playAtN st (const n)
 
 -- | Play the song before the current song, if we're not at the beginning
@@ -520,46 +520,22 @@ genericJumpToMatch :: Lookup a
                    -> IO ()
 
 genericJumpToMatch re sw k sel = do
-    found <- modifySTM_ $ \st -> do
+    found <- modifySTM_ $ \st -> pure do
         let mre = case re of
-            -- work out if we have no pattern, a cached pattern, or a new pattern
-                Nothing     -> case regex st of
-                                Nothing     -> Nothing
-                                Just (r,d)  -> Just (r,d==sw)
-                Just s  -> case compileM (P.pack s) [caseless,utf8] of
-                                Left _      -> Nothing
-                                Right v     -> Just (v,sw)
-        case mre of
-            Nothing -> pure (st,False)    -- no pattern
-            Just (p,forwards) -> do
-
-            let (fs,cur,m) = k st
-
-{-
-                loop fn inc n
-                    | fn n      = pure Nothing
-                    | otherwise = do
-                        let s = extract (fs ! n)
-                        case match p s [] of
-                            Nothing -> loop fn inc $! inc n
--}
-
-                check n = let s = extract (fs ! n) in
-                        case match p s [] of
-                            Nothing -> pure Nothing
-                            Just _  -> pure $ Just n
-
-            -- mi <- if forwards then loop (>=m) (+1)         (cur+1)
-                              -- else loop (<0)  (subtract 1) (cur-1)
-            mi <- fmap msum $ traverse check $
-                       if forwards then [cur+1..m-1] ++ [0..cur]
-                                   else [cur-1,cur-2..0] ++ [m-1,m-2..cur]
-
-
-            let st' = st { regex = Just (p,forwards==sw) }
-            pure case mi of
-                Nothing -> (st',False)
-                Just i  -> (st' { cursor = sel i st }, True)
+                Nothing -> case regex st of
+                    Nothing     -> Nothing
+                    Just (r, d) -> Just (r, d==sw)
+                Just s  -> case compileM (P.pack s) [caseless, utf8] of
+                    Left _      -> Nothing
+                    Right v     -> Just (v, sw)
+        flip (maybe (st, False)) mre \ (p, forwards) -> do
+            let (fs, cur, m) = k st
+                l = if forwards then [cur+1..m-1] ++ [0..cur]
+                                else [cur-1,cur-2..0] ++ [m-1,m-2..cur]
+                st' = st { regex = Just (p, forwards==sw) }
+            case [ i | i <- l, isJust $ match p (extract (fs ! i)) [] ] of
+                i:_ -> (st' { cursor = sel i st }, True)
+                _   -> (st', False)
 
     unless found $ putmsg (Fast "No match found." defaultSty) *> touchST
 
@@ -580,6 +556,7 @@ toggleExit = modifyST $ \st -> st { exitVisible = not (exitVisible st) }
 -- | History on or off
 hideHist :: IO ()
 hideHist = modifyST $ \st -> st { histVisible = Nothing }
+
 showHist :: IO ()
 showHist = do
     now <- getMonoTime

Lexer.hs

@@ -34,22 +34,19 @@ import Control.Monad.Trans (lift)
 
 ------------------------------------------------------------------------
 
-pSafeHead :: ByteString -> Char
-pSafeHead s = if P.null s then ' ' else P.head s
-
 readPS :: ByteString -> Int
 readPS = fst . fromJust . P.readInt
 
 doP :: ByteString -> Msg
-doP s = S case pSafeHead s of
-                '0' -> Stopped
-                '1' -> Paused
-                '2' -> Playing
-                -- mpg123 outputs this but then @P 0 causing double Plays
-                -- (I think old mpg123 didn't do @P 0 so I added this)
-                -- '3' -> Stopped  -- used by mpg123 for end of song
-                _ -> Playing
-                -- _ -> error "Invalid Status"
+doP s = S case fst <$> P.uncons s of
+    Just '0' -> Stopped
+    Just '1' -> Paused
+    Just '2' -> Playing
+    -- mpg123 outputs this but then @P 0 causing double Plays
+    -- (I think old mpg123 didn't do @P 0 so I added this)
+    -- '3' -> Stopped  -- used by mpg123 for end of song
+    _ -> Playing
+    -- _ -> error "Invalid Status"
 
 -- Frame decoding status updates (once per frame).
 doF :: ByteString -> Msg

Main.hs

@@ -31,6 +31,8 @@ import System.IO            (hPrint, stderr)
 import System.Posix.Signals (installHandler, sigTERM, sigPIPE, sigINT, sigHUP
                             ,sigALRM, sigABRT, Handler(Ignore, Default, Catch))
 
+import qualified Data.ByteString.UTF8 as UTF8
+
 -- ---------------------------------------------------------------------
 -- | Set up the signal handlers
 
@@ -108,7 +110,7 @@ doArgs = loopArgs True where
 --
 main :: IO ()
 main = do
-    (playNow, files) <- doArgs . map fromString =<< getArgs
+    (playNow, files) <- doArgs . map UTF8.fromString =<< getArgs
     initSignals
     start playNow files -- never returns
 

README.md

@@ -24,7 +24,7 @@ through 9.10) and libraries.  This required rewriting or entirely
 replacing large sections, mainly low-level optimizations.
 
 *  I added support for building with Stack.  It can also be installed
-from Nix.
+with Nix from nixpkgs (`haskellPackages.hmp3-ng`).
 
 *  There is a public GitHub issue tracker, and a GitHub action to
 continuously test builds.

Tree.hs

@@ -29,6 +29,7 @@ import Base hiding (partition)
 
 import FastIO
 import qualified Data.ByteString.Char8 as P
+import qualified Data.Map.Strict as M
 
 import Data.Array
 import System.IO        (hPrint, stderr)
@@ -91,15 +92,7 @@ doOrphans = map \f -> (dirnameP f, [basenameP f])
 
 -- | Merge entries with the same root node into a single node
 merge :: [(FilePathP, [FilePathP])] -> [(FilePathP, [FilePathP])]
-merge [] = []
-merge xs =
-    let xs' = sortBy  (\a b -> fst a `compare` fst b) xs
-        xs''= groupBy (\a b -> fst a == fst b) xs'
-    in mapMaybe flatten xs''
-  where
-    flatten :: [(FilePathP,[FilePathP])] -> Maybe (FilePathP, [FilePathP])
-    flatten []     = Nothing    -- can't happen
-    flatten (x:ys) = let d = fst x in Just (d, snd x ++ concatMap snd ys)
+merge = M.assocs . M.fromListWith (++)
 
 -- | fold builder, for generating Dirs and Files
 make :: (Int,Int,[Dir],[File]) -> (FilePathP,[FilePathP]) -> (Int,Int,[Dir],[File])
@@ -127,14 +120,9 @@ expandDir !f = do
     let fs = filter onlyMp3s fs'
         v = if null fs then Nothing else Just (f,fs)
     pure (v,ds)
-    where
-          notEdge    p = p /= dot && p /= dotdot
-          validFiles p = notEdge p
-          onlyMp3s   p = mp3 == (P.map toLower . P.drop (P.length p - 3) $ p)
-
-          mp3        = "mp3"
-          dot        = "."
-          dotdot     = ".."
+  where
+    validFiles = not . P.isPrefixOf "."
+    onlyMp3s   = P.isSuffixOf ".mp3" . P.map toLower
 
 --
 -- | Given an the next index into the files array, a directory name, and

UI.hs

@@ -52,7 +52,7 @@ import Config
 import qualified UI.HSCurses.Curses as Curses
 import {-# SOURCE #-} Keymap    (extraTable, keyTable, unkey, charToKey)
 
-import Data.Array               ((!), bounds, Array, listArray)
+import Data.Array               ((!), bounds, Array)
 import Data.Array.Base          (unsafeAt)
 import System.IO                (stderr, hFlush)
 import System.Posix.Signals     (raiseSignal, sigTSTP, installHandler, Handler(..))
@@ -577,18 +577,8 @@ printPlayList (PlayList s) = s
 
 ------------------------------------------------------------------------
 
--- | Calculate whitespaces, very common, so precompute likely values
 spaces :: Int -> ByteString
-spaces n
-    | n <= 0    = ""
-    | n > 100   = P.replicate n ' ' -- unlikely
-    | otherwise = arr ! n
-  where
-    arr :: Array Int ByteString   -- precompute some whitespace strs
-    arr = listArray (0,100) [ P.take i s100 | i <- [0..100] ]
-
-    s100 :: ByteString
-    s100 = P.replicate 100 ' '  -- seems reasonable
+spaces = flip P.replicate ' '
 
 ------------------------------------------------------------------------
 --
@@ -626,7 +616,6 @@ renderModal st (Size h w) = do
             (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 @HelpModal s sz

hmp3-ng.cabal

@@ -1,7 +1,7 @@
-cabal-version: 2.2
+cabal-version: 3.0
 
 name:           hmp3-ng
-version:        2.17.3
+version:        2.18.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
@@ -15,8 +15,9 @@ license:        GPL-2.0-or-later
 license-file:   LICENSE
 build-type:     Simple
 extra-source-files:
-    README.md
     Keymap.hs-boot
+extra-doc-files:
+    README.md
 
 source-repository head
   type: git
@@ -45,7 +46,6 @@ executable hmp3
   default-extensions:
       BangPatterns
       BlockArguments
-      NondecreasingIndentation
       OverloadedStrings
       ScopedTypeVariables
       TypeApplications