hmp3-ng 2.4.2 → 2.5.1
raw patch · 11 files changed
+145/−230 lines, 11 filesdep +clockdep +monad-extrasdep −old-time
Dependencies added: clock, monad-extras
Dependencies removed: old-time
Files
- Core.hs +13/−8
- FastIO.hs +24/−86
- Keymap.hs +31/−42
- Lexer.hs +7/−7
- Main.hs +2/−2
- State.hs +3/−3
- Syntax.hs +4/−4
- Tree.hs +4/−5
- UI.hs +39/−55
- Utils.hs +13/−13
- hmp3-ng.cabal +5/−5
Core.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- -- Copyright (c) 2005-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons -- Copyright (c) 2008, 2019 Galen Huntington@@ -62,7 +64,7 @@ import System.IO (hPutStrLn, hGetLine, stderr, hFlush) import System.IO.Unsafe (unsafeInterleaveIO) import System.Process (waitForProcess)-import System.Time (getClockTime)+import System.Clock (getTime, Clock(..)) import System.Random.Mersenne import System.Posix.Process (exitImmediately)@@ -97,7 +99,7 @@ ,ser_indx st ,ser_mode st) - now <- getClockTime+ now <- getTime Monotonic -- fork some threads t1 <- forkIO mpgInput@@ -201,15 +203,14 @@ ------------------------------------------------------------------------ --- | Once a minute read the clock time--- TODO use a monotonic clock+-- | The clock ticks once per minute, but check more often in case of drift. uptimeLoop :: IO () uptimeLoop = forever $ do threadDelay delay- now <- getClockTime+ now <- getTime Monotonic modifyST $ \st -> st { uptime = drawUptime (boottime st) now } where- delay = 60 * 1000 * 1000 -- 1 minute+ delay = 10 * 1000 * 1000 -- refresh every 10 seconds ------------------------------------------------------------------------ @@ -543,7 +544,7 @@ Nothing -> (st',False) Just i -> (st' { cursor = sel i st }, True) - when (not found) $ putmsg (Fast (P.pack "No match found.") defaultSty) >> touchST+ when (not found) $ putmsg (Fast "No match found." defaultSty) >> touchST ------------------------------------------------------------------------ @@ -604,7 +605,7 @@ home <- getHome let f = home </> ".hmp3" b <- doesFileExist f- when b $ do -- otherwise used compiled-in values+ if b then do str <- readFile f msty <- catch (readM str >>= return . Just) (\ (_ :: SomeException) -> warnA "Parse error in ~/.hmp3" >> return Nothing)@@ -614,6 +615,10 @@ let sty = buildStyle rsty initcolours sty modifyST $ \st -> st { config = sty }+ else do+ let sty = config emptySt+ initcolours sty+ modifyST $ \st -> st { config = sty } UI.resetui ------------------------------------------------------------------------
FastIO.hs view
@@ -28,23 +28,14 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B -import Data.Word (Word8)-import qualified Data.ByteString.UTF8 as UTF8-import Foreign.C.Error-import Foreign.C.Types (CInt(..), CSize(..))-import Foreign.Marshal (allocaBytes)-import Foreign.Ptr (Ptr, castPtr, plusPtr)-import Foreign.Storable (peekElemOff)-import Foreign.ForeignPtr+import System.Posix.Files.ByteString+import System.Posix.Directory.ByteString -import qualified System.Directory as Dir-import System.IO.Error (modifyIOError, ioeSetFileName)-import System.IO.Unsafe (unsafePerformIO) import System.IO (Handle,hFlush) import Data.IORef-import System.Posix.Internals -import Control.Exception (catch, SomeException)+import Control.Exception (catch, bracket, SomeException)+import Control.Monad.Extra (sequenceWhile) ------------------------------------------------------------------------ @@ -63,53 +54,32 @@ dirnameP :: P.ByteString -> P.ByteString dirnameP fps = case P.elemIndexEnd '/' fps of- Nothing -> P.pack "."+ Nothing -> "." Just i -> P.take i fps {-# INLINE dirnameP #-} ------ | Packed version of get directory contents--- Have them just return CStrings, then pack lazily?---+-- | Packed version of listDirectory packedGetDirectoryContents :: P.ByteString -> IO [P.ByteString]-packedGetDirectoryContents = do- fmap (map UTF8.fromString) . Dir.listDirectory . UTF8.toString+packedGetDirectoryContents fp = bracket (openDirStream fp) closeDirStream+ $ \ds -> fmap (filter (\p -> p/="." && p/=".."))+ $ sequenceWhile (not . P.null) $ repeat $ readDirStream ds --- packed version: doesFileExist :: P.ByteString -> IO Bool-doesFileExist name = Control.Exception.catch- (packedWithFileStatus "Utils.doesFileExist" name $ \st -> do- b <- isDirectory st; return (not b))+doesFileExist fp = catch+ (not <$> isDirectory <$> getFileStatus fp) (\ (_ :: SomeException) -> return False) --- packed version: doesDirectoryExist :: P.ByteString -> IO Bool-doesDirectoryExist name = Control.Exception.catch- (packedWithFileStatus "Utils.doesDirectoryExist" name $ \st -> isDirectory st)+doesDirectoryExist fp = catch+ (isDirectory <$> getFileStatus fp) (\ (_ :: SomeException) -> return False) -packedWithFileStatus :: String -> P.ByteString -> (Ptr CStat -> IO a) -> IO a-packedWithFileStatus loc name f = do- modifyIOError (`ioeSetFileName` []) $- allocaBytes sizeof_stat $ \p -> do- B.useAsCString name $ \s -> do -- i.e. every string is duplicated- throwErrnoIfMinus1Retry_ loc (c_stat s p)- f p- packedFileNameEndClean :: P.ByteString -> P.ByteString packedFileNameEndClean name =- if i > 0 && (ec == '\\' || ec == '/') then- packedFileNameEndClean (P.take i name)- else- name- where- i = (P.length name) - 1- ec = name `P.index` i--isDirectory :: Ptr CStat -> IO Bool-isDirectory stat = do- mode <- st_mode stat- return (s_isdir mode)+ case P.unsnoc name of+ Just (name', ec) | ec == '\\' || ec == '/'+ -> packedFileNameEndClean name'+ _ -> name -- --------------------------------------------------------------------- @@ -130,55 +100,23 @@ -- --------------------------------------------------------------------- -getPermissions :: P.ByteString -> IO Dir.Permissions-getPermissions = Dir.getPermissions . UTF8.toString+isReadable :: P.ByteString -> IO Bool+isReadable fp = fileAccess fp True False False -- --------------------------------------------------------------------- -- | Send a msg over the channel to the decoder send :: Pretty a => Handle -> a -> IO ()-send h m = P.hPut h (ppr m) >> P.hPut h nl >> hFlush h- where- nl = P.pack "\n"+send h m = P.hPut h (ppr m) >> P.hPut h "\n" >> hFlush h ------------------------------------------------------------------------ -- | 'dropSpaceEnd' efficiently returns the 'ByteString' argument with--- white space removed from the end. I.e.+-- white space removed from the end. I.e., -- -- > reverse . (dropWhile isSpace) . reverse == dropSpaceEnd------ but it is more efficient than using multiple reverses.--- dropSpaceEnd :: P.ByteString -> P.ByteString {-# INLINE dropSpaceEnd #-}-dropSpaceEnd (B.PS x s l) = unsafePerformIO $ withForeignPtr x $ \p -> do- i <- lastnonspace (p `plusPtr` s) (l-1)- return $! if i == (-1) then B.empty else B.PS x s (i+1)- where- lastnonspace :: Ptr Word8 -> Int -> IO Int- lastnonspace ptr n- | ptr `seq` n `seq` False = undefined- | n < 0 = return n- | otherwise = do w <- peekElemOff ptr n- if B.isSpaceWord8 w then lastnonspace ptr (n-1)- else return n-------------------------------------------------------------------------- ---- --- A wrapper over printf for use in UI.PTimes--- -printfPS :: P.ByteString -> Int -> Int -> P.ByteString-printfPS fmt arg1 arg2 =- unsafePerformIO $ B.createAndTrim lim $ \ptr ->- B.useAsCString fmt $ \c_fmt -> do- sz' <- c_printf2d ptr (fromIntegral lim) (castPtr c_fmt)- (fromIntegral arg1) (fromIntegral arg2)- return (min lim (fromIntegral sz')) -- snprintf might truncate- where- lim = 10 -- NB---- ---------------------------------------------------------------------+dropSpaceEnd bs = P.take (P.length bs - count) bs where+ count = B.foldl' go 0 bs+ go n c = if B.isSpaceWord8 c then n+1 else 0 -foreign import ccall unsafe "static stdio.h snprintf" - c_printf2d :: Ptr Word8 -> CSize -> Ptr Word8 -> CInt -> CInt -> IO CInt
Keymap.hs view
@@ -44,7 +44,7 @@ import Data.List ((\\), find) -import qualified Data.ByteString.Char8 as P (ByteString, pack)+import qualified Data.ByteString.Char8 as P (ByteString, pack, singleton) import qualified Data.Map as M (fromList, lookup, Map) data Search = SearchFile | SearchDir@@ -82,12 +82,12 @@ searchDir :: LexerS searchDir = (char '\\' >|< char '|') `meta` \[c] _ ->- (with (toggleFocus >> putmsg (Fast (P.pack [c]) defaultSty) >> touchST)+ (with (toggleFocus >> putmsg (Fast (P.singleton c) defaultSty) >> touchST) ,(SearchDir,if c == '\\' then Forwards else Backwards,[c]) ,Just dosearch) searchFile :: LexerS searchFile = (char '/' >|< char '?') `meta` \[c] _ ->- (with (toggleFocus >> putmsg (Fast (P.pack [c]) defaultSty) >> touchST)+ (with (toggleFocus >> putmsg (Fast (P.singleton c) defaultSty) >> touchST) ,(SearchFile,if c == '/' then Forwards else Backwards,[c]) ,Just dosearch) dosearch :: LexerS@@ -150,72 +150,61 @@ keyTable :: [(P.ByteString, [Char], IO ())] keyTable = [- (p "Move up",+ ("Move up", ['k',unkey KeyUp], up)- ,(p "Move down",+ ,("Move down", ['j',unkey KeyDown], down)- ,(p "Page down",+ ,("Page down", [unkey KeyNPage], downPage)- ,(p "Page up",+ ,("Page up", [unkey KeyPPage], upPage)- ,(p "Jump to start of list",+ ,("Jump to start of list", [unkey KeyHome,'1'], jump 0)- ,(p "Jump to end of list",+ ,("Jump to end of list", [unkey KeyEnd,'G'], jump maxBound)- ,(p "Seek left within song",+ ,("Seek left within song", [unkey KeyLeft], seekLeft)- ,(p "Seek right within song",+ ,("Seek right within song", [unkey KeyRight], seekRight)- ,(p "Toggle pause",+ ,("Toggle pause", [' '], pause)- ,(p "Play song under cursor",+ ,("Play song under cursor", ['\n'], play)- ,(p "Play previous track",+ ,("Play previous track", ['K'], playPrev)- ,(p "Play next track",+ ,("Play next track", ['J'], playNext)- ,(p "Toggle the help screen",+ ,("Toggle the help screen", ['h'], toggleHelp)- ,(p "Jump to currently playing song",+ ,("Jump to currently playing song", ['t'], jumpToPlaying)- ,(p "Quit (or close help screen)",+ ,("Quit (or close help screen)", ['q'], do b <- helpIsVisible ; if b then toggleHelp else quit Nothing)- ,(p "Select and play next track",+ ,("Select and play next track", ['d'], playNext >> jumpToPlaying)- ,(p "Cycle through normal, random and loop modes",+ ,("Cycle through normal, random and loop modes", ['m'], nextMode)- ,(p "Refresh the display",+ ,("Refresh the display", ['\^L'], UI.resetui)- ,(p "Repeat last regex search",+ ,("Repeat last regex search", ['n'], jumpToMatchFile Nothing True)- ,(p "Repeat last regex search backwards",+ ,("Repeat last regex search backwards", ['N'], jumpToMatchFile Nothing False)- ,(p "Play",+ ,("Play", ['p'], playCur)- ,(p "Mark as deletable",+ ,("Mark as deletable", ['d'], blacklist)- ,(p "Load config file",+ ,("Load config file", ['l'], loadConfig)- ,(p "Restart song",+ ,("Restart song", [unkey KeyBackspace], seekStart) ]- where- -- Keep as Addr#. If we try the pack/packAddress rule, ghc seems to get- -- confused and want to *unpack* the strings :/- p = P.pack- {-# INLINE p #-} extraTable :: [(P.ByteString, [Char])]-extraTable = [(p "Search for file matching regex", ['/'])- ,(p "Search backwards for file", ['?'])- ,(p "Search for directory matching regex", ['\\'])- ,(p "Search backwards for directory", ['|']) ]- where- -- Keep as Addr#. If we try the pack/packAddress rule, ghc seems to get- -- confused and want to *unpack* the strings :/- p = P.pack- {-# INLINE p #-}-+extraTable = [("Search for file matching regex", ['/'])+ ,("Search backwards for file", ['?'])+ ,("Search for directory matching regex", ['\\'])+ ,("Search backwards for directory", ['|']) ] helpIsVisible :: IO Bool helpIsVisible = getsST helpVisible
Lexer.hs view
@@ -81,13 +81,13 @@ , extension = read $ P.unpack $ fs !! 11 -} userinfo = P.concat- [P.pack "mpeg "+ ["mpeg " ,fs !! 0- ,P.pack " "+ ," " ,fs !! 10- ,P.pack "kbit/s "+ ,"kbit/s " ,(P.pack . show) ((readPS (fs !! 2)) `div` 1000 :: Int)- ,P.pack "kHz"]+ ,"kHz"] } -- Track info if ID fields are in the file, otherwise file name.@@ -95,8 +95,8 @@ doI :: P.ByteString -> Msg doI s = let f = dropSpaceEnd . P.dropWhile isSpace $ s in case P.take 4 f of- cs | cs == P.pack "ID3:" -> F . File . Right . toId id3 . splitUp . P.drop 4 $ f- | otherwise -> F . File . Left $ f+ cs | cs == "ID3:" -> F . File . Right . toId id3 . splitUp . P.drop 4 $ f+ | otherwise -> F . File . Left $ f where -- a default id3 :: Id3@@ -134,7 +134,7 @@ maybeJoin t f = if P.null f then t `P.append` P.empty else t `gap` f - gap x y = P.concat [ x, (P.pack " : "), y ]+ gap x y = P.concat [ x, " : ", y ] normalise = P.dropWhile isSpace . dropSpaceEnd
Main.hs view
@@ -83,9 +83,9 @@ Nothing -> do mapM_ putStrLn usage; exitWith ExitSuccess Just st -> return $ Left st -do_args [s] | s == P.pack "-V" || s == P.pack "--version"+do_args [s] | s == "-V" || s == "--version" = do putStrLn (versinfo <+> help); putStrLn darcsinfo; exitWith ExitSuccess- | s == P.pack "-h" || s == P.pack "--help"+ | s == "-h" || s == "--help" = do putStrLn (versinfo <+> help); mapM_ putStrLn usage; exitWith ExitSuccess do_args xs = return $ Right xs
State.hs view
@@ -34,7 +34,7 @@ import Data.Array (listArray) import System.IO.Unsafe (unsafePerformIO) import System.Posix.Types (ProcessID)-import System.Time (ClockTime(..))+import System.Clock (TimeSpec(..)) import System.IO (Handle) import System.Random.Mersenne @@ -73,7 +73,7 @@ ,miniFocused :: !Bool -- is the mini buffer focused? ,mode :: !Mode -- random mode ,uptime :: !P.ByteString- ,boottime :: !ClockTime+ ,boottime :: !TimeSpec ,regex :: !(Maybe (Regex,Bool)) -- most recent search pattern and direction ,xterm :: !Bool ,doNotResuscitate:: !Bool -- should we just let mpg321 die?@@ -117,7 +117,7 @@ ,doNotResuscitate = False -- mgp321 should be be restarted ,config = Config.defaultStyle- ,boottime = TOD 0 0+ ,boottime = TimeSpec 0 0 ,status = Stopped ,mode = Normal ,minibuffer = Fast P.empty defaultSty
Syntax.hs view
@@ -38,7 +38,7 @@ data Load = Load {-# UNPACK #-} !P.ByteString instance Pretty Load where- ppr (Load f) = P.concat [P.pack "LOAD ", f]+ ppr (Load f) = P.concat ["LOAD ", f] -- If '+' or '-' is specified, jumps <frames> frames forward, or backwards, -- respectively, in the the mp3 file. If neither is specifies, jumps to@@ -46,19 +46,19 @@ data Jump = Jump {-# UNPACK #-} !Int instance Pretty Jump where- ppr (Jump i) = P.concat [P.pack "JUMP ", P.pack . show $ i]+ ppr (Jump i) = P.concat ["JUMP ", P.pack . show $ i] -- Pauses the playback of the mp3 file; if already paused, restarts playback. data Pause = Pause instance Pretty Pause where- ppr Pause = P.pack "PAUSE"+ ppr Pause = "PAUSE" -- Quits mpg321. data Quit = Quit instance Pretty Quit where- ppr Quit = P.pack "QUIT"+ ppr Quit = "QUIT" ------------------------------------------------------------------------ --
Tree.hs view
@@ -39,7 +39,6 @@ import Data.List (sortBy,sort,foldl',groupBy) import System.IO (hPutStrLn,stderr)-import System.Directory (Permissions(readable)) import Control.Exception(handle, SomeException) import Control.Monad (liftM) @@ -138,9 +137,9 @@ validFiles p = notEdge p onlyMp3s p = mp3 == (P.map toLower . P.drop (P.length p -3) $ p) - mp3 = P.pack "mp3"- dot = P.pack "."- dotdot = P.pack ".."+ mp3 = "mp3"+ dot = "."+ dotdot = ".." -- -- | Given an the next index into the files array, a directory name, and@@ -165,7 +164,7 @@ partition (a:xs) = do (fs,ds) <- partition xs x <- doesFileExist a- if x then do y <- getPermissions a >>= return . readable+ if x then do y <- isReadable a return $! if y then (a:fs, ds) else (fs, ds) else return (fs, a:ds)
UI.hs view
@@ -40,7 +40,7 @@ import Style import Utils (isLightBg)-import FastIO (basenameP, printfPS)+import FastIO (basenameP) import Tree (File(fdir, fbase), Dir(dname)) import State import Syntax@@ -48,7 +48,7 @@ import qualified UI.HSCurses.Curses as Curses import {-# SOURCE #-} Keymap (extraTable, keyTable, unkey, charToKey) -import Data.List (intersperse,isPrefixOf)+import Data.List (isPrefixOf) import Data.Array ((!), bounds, Array, listArray) import Data.Array.Base (unsafeAt) import Control.Monad (when, void)@@ -56,14 +56,10 @@ import System.IO (stderr, hFlush) import System.Posix.Signals (raiseSignal, sigTSTP, installHandler, Handler(..)) import System.Posix.Env (getEnv, putEnv)+import Text.Printf import qualified Data.ByteString.Char8 as P-import qualified Data.ByteString as B--import Foreign.C.Types (CInt(..))-import Foreign.C.String (CString)---- import qualified Data.ByteString.UTF8 as UTF8+import qualified Data.ByteString.UTF8 as UTF8 ------------------------------------------------------------------------ @@ -112,7 +108,7 @@ -- | Clean up and go home. Refresh is needed on linux. grr. -- end :: Bool -> IO ()-end isXterm = do when isXterm $ setXtermTitle [P.pack "xterm"]+end isXterm = do when isXterm $ setXtermTitle ["xterm"] Curses.endWin --@@ -254,7 +250,7 @@ Just i -> userinfo i emptyVal :: P.ByteString-emptyVal = P.pack "(empty)"+emptyVal = "(empty)" spc2 :: P.ByteString spc2 = spaces 2@@ -270,16 +266,15 @@ f :: [Char] -> P.ByteString -> P.ByteString f cs ps = - let p = P.pack str `P.append` ps+ let p = str `P.append` ps s = P.pack (take (tot - P.length p) (repeat ' ')) in p `P.append` s where tot = round $! fromIntegral w * (0.8::Float) len = round $! fromIntegral tot * (0.2::Float) - -- faststringify- str = take len $ ' ' :- (concat . intersperse " " $ (map pprIt cs)) ++ repeat ' '+ str = P.take len $ P.intercalate " "+ ([""] ++ map pprIt cs ++ [P.replicate len ' ']) pprIt c = case c of '\n' -> "Enter"@@ -295,7 +290,7 @@ Curses.KeyEnd -> "End" Curses.KeyHome -> "Home" Curses.KeyBackspace -> "Backspace"- _ -> show c+ _ -> P.pack $ show c ------------------------------------------------------------------------ @@ -308,10 +303,8 @@ ,(gap, defaultSty) ,(remaining,defaultSty)] where- elapsed = printfPS fmt1 lm lm'- remaining = printfPS fmt2 rm rm'- fmt1 = P.pack "%01d:%02d" - fmt2 = P.pack "-%01d:%02d" + elapsed = P.pack $ printf "%d:%02d" lm lm'+ remaining = P.pack $ printf "-%d:%02d" rm rm' (lm,lm') = quotRem (fst . currentTime $ fr) 60 (rm,rm') = quotRem (fst . timeLeft $ fr) 60 gap = spaces distance@@ -361,9 +354,9 @@ Paused -> b Playing -> c - where a = P.pack "stop"- b = P.pack "pause"- c = P.pack "play"+ where a = "stop"+ b = "pause"+ c = "play" -- | Loop, normal or random instance Element PMode2 where@@ -372,9 +365,9 @@ Loop -> b Normal -> c - where a = P.pack "random"- b = P.pack "loop"- c = P.empty+ where a = "random"+ b = "loop"+ c = "" ------------------------------------------------------------------------ @@ -388,22 +381,22 @@ instance Element PlayInfo where draw _ _ st _ = PlayInfo $ P.concat [percent- ,P.pack " ("+ , " (" ,P.pack (show (1 + ( snd . bounds . folders $ st)))- ,P.pack " dir"+ , " dir" ,if (snd . bounds $ folders st) == 1 then P.empty else plural- ,P.pack ", "+ , ", " ,P.pack (show . size $ st)- ,P.pack " file"+ , " file" ,if size st == 1 then P.empty else plural- ,P.pack ")"]+ , ")"] where- plural = P.pack "s" -- expose to inlining- pct = P.pack "%"+ plural = "s" -- expose to inlining+ pct = "%" curr = cursor st - percent | percent' == 0 && curr == 0 = P.pack "top"- | percent' == 100 = P.pack "all"+ percent | percent' == 0 && curr == 0 = "top"+ | percent' == 100 = "all" | otherwise = if P.length s == 2 then ' ' `P.cons` s else s where s = P.pack (show percent') `P.append` pct@@ -509,7 +502,7 @@ post = (b, sty) d = basenameP $ case size st of- 0 -> P.pack "(empty)"+ 0 -> "(empty)" _ -> dname $ folders st ! i spc = spaces (indent - P.length d)@@ -560,7 +553,7 @@ s100 = P.replicate 100 ' ' -- seems reasonable ellipsis :: P.ByteString-ellipsis = P.pack "... "+ellipsis = "... " {-# INLINE ellipsis #-} ------------------------------------------------------------------------@@ -646,19 +639,14 @@ where loop [] = return () loop ((l,sty):xs) = drawPackedString l sty >> loop xs --- worker+-- much less efficient than before, could drop into FFI if pure ascii drawPackedString :: P.ByteString -> Style -> IO () drawPackedString ps sty =- withStyle sty $ B.useAsCString (P.map asAscii ps) $ \cstr ->- Curses.throwIfErr_ msg $- waddnstr Curses.stdScr- -- Curses.wAddStr Curses.stdScr- -- UTF8.toString ps- cstr (fromIntegral . P.length $ ps)- where- msg = "drawPackedString"- asAscii x | x >= ' ' && x < '\127' = x- | otherwise = '*'+ withStyle sty $ Curses.wAddStr Curses.stdScr+ -- a hack to somewhat not mess up spacing+ -- TODO have to redo length logic throughout+ $ s ++ replicate (P.length ps - length s) ' '+ where s = UTF8.toString ps ------------------------------------------------------------------------@@ -704,8 +692,8 @@ mapM_ (P.hPut stderr) (before : strs ++ [after]) hFlush stderr where- before = P.pack "\ESC]0;"- after = P.pack "\007"+ before = "\ESC]0;"+ after = "\007" ------------------------------------------------------------------------ @@ -716,15 +704,11 @@ if status s == Playing then case id3 s of Nothing -> case size s of- 0 -> [P.pack "hmp3"]+ 0 -> ["hmp3"] _ -> [(fbase $ music s ! current s)] Just ti -> id3artist ti : if P.null (id3title ti) then [] - else [P.pack ": ", id3title ti]+ else [": ", id3title ti] else let (PMode pm) = draw sz (0,0) s f :: PMode in [pm]---- Not exported by hscurses.-foreign import ccall safe- waddnstr :: Curses.Window -> CString -> CInt -> IO CInt
Utils.hs view
@@ -33,12 +33,11 @@ module Utils where -import FastIO (printfPS)-import qualified Data.ByteString.Char8 as P (pack) import qualified Data.ByteString as P (ByteString)+import qualified Data.ByteString.Char8 as P (pack) import Data.Char (toLower)-import System.Time (diffClockTimes, TimeDiff(tdSec), ClockTime)+import System.Clock (TimeSpec(..), diffTimeSpec) import System.Environment (getEnv) import System.Posix.Types (Fd(..),ProcessID) import System.Process.Internals (mkProcessHandle,ProcessHandle)@@ -49,6 +48,7 @@ import Control.Exception (handle, SomeException) import System.IO.Unsafe (unsafePerformIO)+import Text.Printf (printf) ------------------------------------------------------------------------ @@ -67,16 +67,16 @@ ------------------------------------------------------------------------ -drawUptime :: ClockTime -> ClockTime -> P.ByteString-drawUptime before now =- let r = diffClockTimes now before- s = tdSec r- (h,sr) = quotRem s (60 * 60)- m = quot sr 60- in printfPS fmt h m- where- fmt = P.pack "%3dh%02dm" -- sometimes ghc doesn't want to fire a RULE here, why?- -- its crucial for snprintf that this is unpacked+drawUptime :: TimeSpec -> TimeSpec -> P.ByteString+drawUptime before now+ | hs == 0 = P.pack $ printf "%dm" m+ | d == 0 = P.pack $ printf "%dh%02dm" h m+ | True = P.pack $ printf "%dd%02dh%02dm" d h m+ where+ s = sec $ diffTimeSpec now before+ ms = quot s 60+ (hs,m) = quotRem ms 60+ (d,h) = quotRem hs 24 ------------------------------------------------------------------------ -- | Repeat an action
hmp3-ng.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.6 name: hmp3-ng-version: 2.4.2+version: 2.5.1 homepage: https://github.com/galenhuntington/hmp3-ng license: GPL license-file: LICENSE@@ -31,12 +31,13 @@ bytestring >= 0.10, containers, array,- old-time,+ clock, directory, process, utf8-string, hscurses,- mtl+ mtl,+ monad-extras ghc-options: -Wall -funbox-strict-fields -threaded -Wno-unused-do-bind main-is: Main.hs@@ -44,5 +45,4 @@ Lexer Lexers State Style Syntax Tree UI Utils Paths_hmp3_ng - extensions: CPP, ForeignFunctionInterface, ScopedTypeVariables- extra-libraries: curses+ extensions: ScopedTypeVariables, OverloadedStrings