hmp3 1.3 → 1.4
raw patch · 18 files changed
+174/−286 lines, 18 filesdep +arraydep +bytestringdep +containersdep ~basedep ~binary
Dependencies added: array, bytestring, containers, directory, old-time, pcre-light, process, random
Dependency ranges changed: base, binary
Files
- Config.hs +8/−8
- Core.hs +36/−32
- Curses.hsc +19/−19
- FastIO.hs +7/−6
- Keymap.hs +29/−29
- Lexer.hs +7/−7
- Lexers.hs +1/−1
- Main.hs +3/−3
- Makefile +10/−0
- README +2/−7
- Regex.hsc +0/−133
- State.hs +2/−2
- Style.hs +4/−4
- Syntax.hs +10/−10
- Tree.hs +1/−1
- UI.hs +1/−1
- Utils.hs +8/−7
- hmp3.cabal +26/−16
Config.hs view
@@ -1,5 +1,5 @@ -- --- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- Copyright (c) 2005-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License as@@ -29,13 +29,13 @@ , cursors = Style black cyan , combined = Style brightwhite cyan , warnings = Style red defaultbg- , helpscreen = Style black white + , helpscreen = Style black white , blockcursor= Style black red , progress = Style cyan white } -- | A style more suitable for light backgrounds (used if HMP_HAS_LIGHT_BG=true) lightBgStyle :: UIStyle-lightBgStyle = +lightBgStyle = defaultStyle { selected = Style darkblue defaultbg , warnings = Style darkred defaultbg } @@ -53,7 +53,7 @@ , blockcursor= Style black darkred , progress = Style cyan white } -bwStyle :: UIStyle +bwStyle :: UIStyle bwStyle = UIStyle { window = Style defaultfg defaultbg ,titlebar = Style reversefg reversebg@@ -65,7 +65,7 @@ ,blockcursor = Style reversefg reversebg ,progress = Style reversefg reversebg }- + ------------------------------------------------------------------------ package :: String@@ -73,9 +73,9 @@ versinfo :: String versinfo = package++" "++ version- where + where version :: String- version = "1.1" ++ if (not . null) (PATCH_COUNT :: String) && (PATCH_COUNT /= "1")+ version = "1.4" ++ if (not . null) (PATCH_COUNT :: String) && (PATCH_COUNT /= "1") then "p" ++ PATCH_COUNT else "" @@ -83,4 +83,4 @@ help = "- curses-based MP3 player" darcsinfo :: String-darcsinfo = "darcs get --partial http://www.cse.unsw.edu.au/~dons/code/hmp3"+darcsinfo = "darcs get http://code.haskell.org/~dons/code/hmp3"
Core.hs view
@@ -1,5 +1,5 @@ -- --- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- Copyright (c) 2005-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License as@@ -41,13 +41,12 @@ import FastIO (send,fdToCFile,forceNextPacket) import Tree hiding (File,Dir) import qualified Tree (File,Dir)-import Regex import qualified UI +import Text.Regex.PCRE.Light import {-# SOURCE #-} Keymap (keymap) -import qualified Data.ByteString.Char8 as P (pack,empty,ByteString,join,singleton)-import Data.ByteString (useAsCString)+import qualified Data.ByteString.Char8 as P (ByteString,pack,empty,intercalate,singleton) import Data.Array ((!), bounds, Array) import Data.Maybe (isJust,fromJust)@@ -82,7 +81,7 @@ (ds,fs,i,m) -- construct the state <- case ms of- Right roots -> do (a,b) <- buildTree roots + Right roots -> do (a,b) <- buildTree roots return (a,b,0,Normal) Left st -> return (ser_darr st@@ -99,7 +98,7 @@ t4 <- forkIO uptimeLoop t5 <- forkIO errorLoop - silentlyModifyST $ \s -> s + silentlyModifyST $ \s -> s { music = fs , folders = ds , size = 1 + (snd . bounds $ fs)@@ -107,7 +106,7 @@ , current = i , mode = m , uptime = drawUptime now now- , boottime = now + , boottime = now , config = c , threads = [t0,t1,t2,t3,t4,t5] } @@ -150,7 +149,7 @@ mmpg <- findExecutable (MPG321 :: String) case mmpg of Nothing -> quit (Just $ "Cannot find " ++ MPG321 ++ " in path")- Just mpg321 -> do + Just mpg321 -> do -- if we're never able to start mpg321, do something sensible mv <- catch (popen (mpg321 :: String) ["-R","-"] >>= return . Just)@@ -160,8 +159,8 @@ Nothing -> threadDelay (1000 * 500) >> mpgLoop Just (r,w,e,pid) -> do - hw <- fdToHandle (fdToInt w) -- so we can use Haskell IO- ew <- fdToHandle (fdToInt e) -- so we can use Haskell IO+ hw <- fdToHandle (fromIntegral w) -- so we can use Haskell IO+ ew <- fdToHandle (fromIntegral e) -- so we can use Haskell IO filep <- fdToCFile r -- so we can use C IO mhw <- newMVar hw mew <- newMVar ew@@ -171,11 +170,11 @@ st { mp3pid = Just pid , writeh = mhw , errh = mew- , readf = mfilep + , readf = mfilep , status = Stopped , info = Nothing , id3 = Nothing }- + catch (waitForProcess (pid2phdl pid)) (\_ -> return ExitSuccess) stop <- getsST doNotResuscitate when (stop) $ exitWith ExitSuccess@@ -193,8 +192,8 @@ -- | Once a minute read the clock time uptimeLoop :: IO () uptimeLoop = forever $ do- threadDelay delay - now <- getClockTime + threadDelay delay+ now <- getClockTime modifyST $ \st -> st { uptime = drawUptime (boottime st) now } where delay = 60 * 1000 * 1000 -- 1 minute@@ -247,7 +246,7 @@ -- | Close most things. Important to do all the jobs: shutdown :: Maybe String -> IO ()-shutdown ms = +shutdown ms = (do silentlyModifyST $ \st -> st { doNotResuscitate = True } catch writeSt (\_ -> return ()) withST $ \st -> do@@ -259,12 +258,14 @@ waitForProcess $ pid2phdl pid return ()) - `finally` + `finally` (do isXterm <- getsST xterm UI.end isXterm when (isJust ms) $ hPutStrLn stderr (fromJust ms) >> hFlush stderr- exitImmediately ExitSuccess) -- race. a thread might touch the screen+ exitImmediately ExitSuccess)+ -- race. a thread might touch the screen+ -- gets in the way of profiling -- return ()) ------------------------------------------------------------------------@@ -307,7 +308,7 @@ seek :: (Frame -> Int) -> IO () seek fn = do f <- getsST clock- case f of + case f of Nothing -> return () Just g -> do withST $ \st -> do@@ -384,7 +385,8 @@ let m = music st i = current st fe = m ! (fn i)- f = P.join (P.singleton '/') [(dname $ folders st ! fdir fe),(fbase fe)]+ f = P.intercalate (P.singleton '/')+ [(dname $ folders st ! fdir fe),(fbase fe)] j = cursor st st' = st { current = fn i , status = Playing@@ -452,12 +454,14 @@ genericJumpToMatch re k sel = do found <- modifySTM_ $ \st -> do- mre <- case re of -- work out if we have no pattern, a cached pattern, or a new pattern- Nothing -> case regex st of- Nothing -> return Nothing- Just (r,d) -> return $ Just (r,d)- Just (s,d) -> do v <- regcomp s (regExtended + regIgnoreCase + regNewline)- return $ Just (v,d)+ 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)+ Just (s,d) -> case compileM (P.pack s) [caseless] of+ Nothing -> Nothing+ Just v -> Just (v,d) case mre of Nothing -> return (st,False) -- no pattern Just (p,forwards) -> do@@ -466,9 +470,9 @@ loop fn inc n | fn n = return Nothing- | otherwise = useAsCString (extract (fs ! n)) $ \s -> do- v <- regexec p s 0- case v of+ | otherwise = do+ let s = extract (fs ! n)+ case match p s [] of Nothing -> loop fn inc $! inc n Just _ -> return $ Just n @@ -529,21 +533,21 @@ -- | Find a user's home in a canonical sort of way getHome :: IO String-getHome = Control.Exception.catch +getHome = Control.Exception.catch (getRealUserID >>= getUserEntryForID >>= (return . homeDirectory)) (\_ -> getEnv "HOME") ------------------------------------------------------------------------ -- Read styles from ~/.hmp3 ---loadConfig :: IO () +loadConfig :: IO () loadConfig = do home <- getHome let f = home </> ".hmp3" b <- doesFileExist f when b $ do -- otherwise used compiled-in values str <- readFile f- msty <- catch (readM str >>= return . Just) + msty <- catch (readM str >>= return . Just) (const $ warnA "Parse error in ~/.hmp3" >> return Nothing) case msty of Nothing -> return ()@@ -565,6 +569,6 @@ -- warnA :: String -> IO ()-warnA x = do +warnA x = do sty <- getsST config putmsg $ Fast (P.pack x) (warnings sty)
Curses.hsc view
@@ -1,6 +1,6 @@ -- -- Copyright (c) 2002-2004 John Meacham (john at repetae dot net)--- Copyright (c) 2004-2005 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- Copyright (c) 2004-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons -- -- Permission is hereby granted, free of charge, to any person obtaining a -- copy of this software and associated documentation files (the@@ -86,7 +86,7 @@ -- * error handling throwIfErr_, -- :: Num a => String -> IO a -> IO ()- + ) where #if HAVE_SIGNAL_H@@ -213,7 +213,7 @@ -- > to stdscr. -- initScr :: IO Window-initScr = throwPackedIfNull (P.packAddress "initscr"##) c_initscr+initScr = throwPackedIfNull (P.pack "initscr") c_initscr foreign import ccall unsafe "initscr" c_initscr :: IO Window@@ -227,8 +227,8 @@ -- > the terminal to normal (cooked) mode. -- cBreak :: Bool -> IO ()-cBreak True = throwIfErr_ (P.packAddress "cbreak"##) cbreak-cBreak False = throwIfErr_ (P.packAddress "nocbreak"##) nocbreak+cBreak True = throwIfErr_ (P.pack "cbreak") cbreak+cBreak False = throwIfErr_ (P.pack "nocbreak") nocbreak foreign import ccall unsafe "cbreak" cbreak :: IO CInt foreign import ccall unsafe "nocbreak" nocbreak :: IO CInt@@ -245,8 +245,8 @@ -- > routines interact with cbreak and nocbreak.] -- echo :: Bool -> IO ()-echo False = throwIfErr_ (P.packAddress "noecho"##) noecho-echo True = throwIfErr_ (P.packAddress "echo"##) echo_c+echo False = throwIfErr_ (P.pack "noecho") noecho+echo True = throwIfErr_ (P.pack "echo") echo_c foreign import ccall unsafe "noecho" noecho :: IO CInt foreign import ccall unsafe "echo" echo_c :: IO CInt@@ -264,8 +264,8 @@ -- > the return key. -- > nl :: Bool -> IO ()-nl True = throwIfErr_ (P.packAddress "nl"##) nl_c-nl False = throwIfErr_ (P.packAddress "nonl"##) nonl+nl True = throwIfErr_ (P.pack "nl") nl_c+nl False = throwIfErr_ (P.pack "nonl") nonl foreign import ccall unsafe "nl" nl_c :: IO CInt foreign import ccall unsafe "nonl" nonl :: IO CInt@@ -274,7 +274,7 @@ -- | Enable the keypad of the user's terminal. -- keypad :: Window -> Bool -> IO ()-keypad win bf = throwIfErr_ (P.packAddress "keypad"##) $ +keypad win bf = throwIfErr_ (P.pack "keypad") $ keypad_c win (if bf then 1 else 0) foreign import ccall unsafe "keypad" @@ -285,7 +285,7 @@ -- > is FALSE), getch waits until a key is pressed. -- noDelay :: Window -> Bool -> IO ()-noDelay win bf = throwIfErr_ (P.packAddress "nodelay"##) $ +noDelay win bf = throwIfErr_ (P.pack "nodelay") $ nodelay win (if bf then 1 else 0) foreign import ccall unsafe nodelay @@ -330,7 +330,7 @@ -- > exiting from curses. -- endWin :: IO ()-endWin = throwIfErr_ (P.packAddress "endwin"##) endwin+endWin = throwIfErr_ (P.pack "endwin") endwin foreign import ccall unsafe "endwin" endwin :: IO CInt@@ -353,7 +353,7 @@ -- | refresh curses windows and lines. curs_refresh(3) -- refresh :: IO ()-refresh = throwIfErr_ (P.packAddress "refresh"##) refresh_c+refresh = throwIfErr_ (P.pack "refresh") refresh_c foreign import ccall unsafe "refresh" refresh_c :: IO CInt@@ -371,7 +371,7 @@ -- default colors (white on black) -- startColor :: IO ()-startColor = throwIfErr_ (P.packAddress "start_color"##) start_color+startColor = throwIfErr_ (P.pack "start_color") start_color foreign import ccall unsafe start_color :: IO CInt @@ -423,7 +423,7 @@ -- initPair :: Pair -> Color -> Color -> IO () initPair (Pair p) (Color f) (Color b) =- throwIfErr_ (P.packAddress "init_pair"##) $+ throwIfErr_ (P.pack "init_pair") $ init_pair (fi p) (fi f) (fi b) foreign import ccall unsafe @@ -437,7 +437,7 @@ attrSet :: Attr -> Pair -> IO () attrSet (Attr attr) (Pair p) = do- throwIfErr_ (P.packAddress "attrset"##) $ c_attrset (attr .|. fi (colorPair p))+ throwIfErr_ (P.pack "attrset") $ c_attrset (attr .|. fi (colorPair p)) ------------------------------------------------------------------------ @@ -491,7 +491,7 @@ waddnstr :: Window -> CString -> CInt -> IO CInt clrToEol :: IO ()-clrToEol = throwIfErr_ (P.packAddress "clrtoeol"##) c_clrtoeol+clrToEol = throwIfErr_ (P.pack "clrtoeol") c_clrtoeol foreign import ccall unsafe "clrtoeol" c_clrtoeol :: IO CInt @@ -503,7 +503,7 @@ -- > corner of the window, which is (0,0). -- wMove :: Window -> Int -> Int -> IO ()-wMove w y x = throwIfErr_ (P.packAddress "wmove"##) $ wmove w (fi y) (fi x)+wMove w y x = throwIfErr_ (P.pack "wmove") $ wmove w (fi y) (fi x) foreign import ccall unsafe wmove :: Window -> CInt -> CInt -> IO CInt@@ -602,7 +602,7 @@ -- try to set the upper bits meta :: Window -> Bool -> IO ()-meta win bf = throwIfErr_ (P.packAddress "meta"##) $+meta win bf = throwIfErr_ (P.pack "meta") $ c_meta win (if bf then 1 else 0) foreign import ccall unsafe "meta"
FastIO.hs view
@@ -1,5 +1,5 @@ -- --- Copyright (c) 2005-6 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- Copyright (c) 2005-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License as@@ -25,7 +25,8 @@ import qualified Data.ByteString.Char8 as P import qualified Data.ByteString as B-import qualified Data.ByteString.Base as B+import qualified Data.ByteString.Internal as B+--import qualified Data.ByteString.Unsafe as B import Data.Word (Word8) import Foreign.C.Error@@ -85,7 +86,7 @@ if (dEnt == nullPtr) then return [] else do -- copy entry out before we free:- entry <- B.copyCString =<< d_name dEnt+ entry <- B.packCString =<< d_name dEnt P.length entry `seq` return () -- strictify freeDirEnt dEnt entries <- loop ptr_dEnt dir@@ -102,7 +103,7 @@ -- packed version: doesFileExist :: P.ByteString -> IO Bool doesFileExist name = Control.Exception.catch- (packedWithFileStatus "Utils.doesFileExist" name $ \st -> do + (packedWithFileStatus "Utils.doesFileExist" name $ \st -> do b <- isDirectory st; return (not b)) (\ _ -> return False) @@ -141,9 +142,9 @@ -- Returning a ByteString. Note that the underlying C code is dropping -- redundant \@F frames for us. getFilteredPacket :: Ptr CFile -> IO P.ByteString-getFilteredPacket fp = B.createAndTrim size $ \p -> do +getFilteredPacket fp = B.createAndTrim size $ \p -> do i <- c_getline p fp- if i == -1 + if i == -1 then throwErrno "FastIO.packedHGetLine" else return i where
Keymap.hs view
@@ -1,5 +1,5 @@ -- --- Copyright (c) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- Copyright (c) 2004-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License as@@ -44,7 +44,7 @@ import Data.List ((\\)) -import qualified Data.ByteString.Char8 as P (packAddress,ByteString,pack)+import qualified Data.ByteString.Char8 as P (ByteString, pack) import qualified Data.Map as M (fromList, lookup, Map) data Search = SearchFile | SearchDir@@ -141,64 +141,64 @@ keyTable :: [(P.ByteString, [Char], IO ())] keyTable = [- (p "Move up"#,+ (p "Move up", ['k',keyUp], up)- ,(p "Move down"#,+ ,(p "Move down", ['j',keyDown], down)- ,(p "Next directory down"#,+ ,(p "Next directory down", [keyNPage], jumpToNextDir)- ,(p "Next directory up"#,+ ,(p "Next directory up", [keyPPage], jumpToPrevDir)- ,(p "Jump to start of list"#,+ ,(p "Jump to start of list", [keyHome,'1'], jump 0)- ,(p "Jump to end of list"#,+ ,(p "Jump to end of list", [keyEnd,'G'], jump maxBound)- ,(p "Seek left within song"#,+ ,(p "Seek left within song", [keyLeft], seekLeft)- ,(p "Seek right within song"#,+ ,(p "Seek right within song", [keyRight], seekRight)- ,(p "Toggle pause"#,+ ,(p "Toggle pause", ['p'], pause)- ,(p "Play song under cursor"#,+ ,(p "Play song under cursor", ['\n',' '], play)- ,(p "Play previous track"#,+ ,(p "Play previous track", ['K'], playPrev)- ,(p "Play next track"#,+ ,(p "Play next track", ['J'], playNext)- ,(p "Toggle the help screen"#,+ ,(p "Toggle the help screen", ['h'], toggleHelp)- ,(p "Jump to currently playing song"#,+ ,(p "Jump to currently playing song", ['t'], jumpToPlaying)- ,(p "Quit (or close help screen)"#,+ ,(p "Quit (or close help screen)", ['q'], do b <- helpIsVisible ; if b then toggleHelp else quit Nothing)- ,(p "Select and play next track"#,+ ,(p "Select and play next track", ['d'], playNext >> jumpToPlaying)- ,(p "Cycle through normal, random and loop modes"#,+ ,(p "Cycle through normal, random and loop modes", ['m'], nextMode)- ,(p "Refresh the display"#,+ ,(p "Refresh the display", ['\^L'], UI.resetui)- ,(p "Repeat last regex search"#,+ ,(p "Repeat last regex search", ['n'], jumpToMatch Nothing)- ,(p "Repeat last regex search on files"#,+ ,(p "Repeat last regex search on files", ['N'], jumpToMatchFile Nothing)- ,(p "Load config file"#,+ ,(p "Load config file", ['l'], loadConfig) ] where -- Keep as Addr#. If we try the pack/packAddress rule, ghc seems to get -- confused and want to *unpack* the strings :/- p = P.packAddress+ p = P.pack {-# INLINE p #-} extraTable :: [(P.ByteString, [Char])]-extraTable = [(p "Search for directory matching regex"#, ['/'])- ,(p "Search backwards for directory"#, ['?'])- ,(p "Search for file matching regex"#, ['\\'])- ,(p "Search backwards for file"#, ['|']) ]+extraTable = [(p "Search for directory matching regex", ['/'])+ ,(p "Search backwards for directory", ['?'])+ ,(p "Search for file matching regex", ['\\'])+ ,(p "Search backwards for file", ['|']) ] where -- Keep as Addr#. If we try the pack/packAddress rule, ghc seems to get -- confused and want to *unpack* the strings :/- p = P.packAddress+ p = P.pack {-# INLINE p #-}
Lexer.hs view
@@ -1,5 +1,5 @@ -- --- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- Copyright (c) 2005-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License as@@ -51,8 +51,8 @@ where fs = P.split ' ' . P.tail $ s- f n = case P.split '.' (fs !! n) of { [x,y] -> - case readPS x of { rx -> + f n = case P.split '.' (fs !! n) of { [x,y] ->+ case readPS x of { rx -> case readPS y of { ry -> (rx,ry) }} ; _ -> error "doF.f" } @@ -77,7 +77,7 @@ , bitrate = read $ P.unpack $ fs !! 10 , extension = read $ P.unpack $ fs !! 11 -}- userinfo = P.concat + userinfo = P.concat [P.pack "mpeg " ,fs !! 0 ,P.pack " "@@ -103,14 +103,14 @@ splitUp :: P.ByteString -> [P.ByteString] splitUp f | f == P.empty = []- | otherwise + | otherwise = let (a,xs) = P.splitAt 30 f -- we expect it to be xs' = splitUp xs in a : xs' -- and some ugly code: toId :: Id3 -> [P.ByteString] -> Id3- toId i ls = + toId i ls = let j = case length ls of 0 -> i @@ -148,7 +148,7 @@ -- normalise the packet let (s,m) = let a = P.dropWhile (== ' ') x -- drop any leading whitespace (b,d)= P.break (== ' ') a -- split into header and body- b' = if '@' `P.elem` b + b' = if '@' `P.elem` b then P.dropWhile (/= '@') b -- make sure '@' is first char else b in (P.dropWhile (== '@') b', d)
Lexers.hs view
@@ -6,7 +6,7 @@ -- Version $Revision: 1.1 $ from $Date: 2002/07/28 03:35:20 $ -- -- Copyright (c) [1995..2000] Manuel M. T. Chakravarty--- Copyright (c) 2004-5 Don Stewart+-- Copyright (c) 2004-2008 Don Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Library General Public
Main.hs view
@@ -1,5 +1,5 @@ -- --- Copyright (c) Don Stewart 2004-5.+-- Copyright (c) Don Stewart 2004-2008. -- Copyright (c) Tuomo Valkonen 2004. -- -- This program is free software; you can redistribute it and/or@@ -78,7 +78,7 @@ -- | Parse the args do_args :: [P.ByteString] -> IO (Either SerialT [P.ByteString]) do_args [] = do -- attempt to read db- x <- readSt + x <- readSt case x of Nothing -> do mapM_ putStrLn usage; exitWith ExitSuccess Just st -> return $ Left st@@ -99,7 +99,7 @@ -- handlers, then jump to ui event loop with the state. -- main :: IO ()-main = do +main = do args <- return . map P.pack =<< getArgs files <- do_args args initSignals
+ Makefile view
@@ -0,0 +1,10 @@+all: conf build++conf:+ ./Setup.hs configure++build:+ ./Setup.hs build++clean:+ ./Setup.hs clean
README view
@@ -3,12 +3,7 @@ --------------------------------------------------- Dependencies:- The Glasgow Haskell Compiler >= 6.4.2 http://haskell.org/ghc- mpg321 http://mpg321.sourceforge.net/- A version of FPS >= 0.7 http://www.cse.unsw.edu.au/~dons/fps.html- A Cabal newer than 1.0 http://haskell.org/cabal- curses- binary >= 0.2 http://darcs.haskell.org/binary/+ mpg321 http://mpg321.sourceforge.net/ Building: $ chmod +x configure Setup.hs@@ -89,7 +84,7 @@ GPL Author:- Don Stewart, Tue Jun 27 17:11:03 EST 2006+ Don Stewart, Tue Jan 15 15:16:55 PST 2008 Contributors: Samuel Bronson
− Regex.hsc
@@ -1,133 +0,0 @@--------- Module : Text.Regex.Posix------ Copyright : (c) The University of Glasgow 2002--- (c) Don Stewart 2004------ License : BSD-style (see the file libraries/base/LICENSE)--- --- Maintainer : libraries@haskell.org--- Stability : experimental--- Portability : portable------- --- | Interface to the POSIX regular expression library.-----module Regex (-- -- * The @Regex@ type- Regex, -- abstract-- -- * Compiling a regular expression- regcomp, -- :: String -> Int -> IO Regex-- -- ** Flags for regcomp- regExtended, -- (flag to regcomp) use extended regex syntax- regIgnoreCase, -- (flag to regcomp) ignore case when matching- regNewline, -- (flag to regcomp) '.' doesn't match newline- regNosub, -- unused-- -- * Matching a regular expression- regexec, -- :: Regex -> Ptr CChar -> Int- -- -> IO (Maybe ((Int,Int), [(Int,Int)]))-- ) where--#include "config.h"--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_REGEX_H-# include <regex.h>-#endif--import Foreign.C-import Foreign--type CRegex = ()---- | A compiled regular expression-newtype Regex = Regex (ForeignPtr CRegex)---- ------------------------------------------------------------------------ | Compiles a regular expression----regcomp :: String -- ^ The regular expression to compile- -> Int -- ^ Flags (summed together)- -> IO Regex -- ^ Returns: the compiled regular expression--regcomp pattern flags = do- regex_fptr <- mallocForeignPtrBytes (#const sizeof(regex_t))- r <- withCString pattern $ \cstr ->- withForeignPtr regex_fptr $ \p ->- c_regcomp p cstr (fromIntegral flags)- if (r == 0)- then do- addForeignPtrFinalizer ptr_regfree regex_fptr- return (Regex regex_fptr)- else ioError $ userError $ "Error in pattern: " ++ pattern---- ------------------------------------------------------------------------ | Matches a regular expression against a buffer, returning the buffer--- indicies of the match, and any submatches----regexec :: Regex -- ^ Compiled regular expression- -> Ptr CChar -- ^ The buffer to match against- -> Int -- ^ Offset in buffer to start searching from- -> IO (Maybe ((Int,Int), [(Int,Int)]))- -- ^ Returns: 'Nothing' if the regex did not match the- -- or Just the start and end indicies of the match and submatches--regexec (Regex regex_fptr) ptr i = do- withForeignPtr regex_fptr $ \regex_ptr -> do- nsub <- (#peek regex_t, re_nsub) regex_ptr- let nsub_int = fromIntegral (nsub :: CSize)- allocaBytes ((1 + nsub_int)*(#const sizeof(regmatch_t))) $ \p_match-> do- -- add one because index zero covers the whole match- r <- cregexec regex_ptr (ptr `plusPtr` i) - (1 + nsub) p_match 0{-no flags -}-- if (r /= 0) then return Nothing else do - match <- indexOfMatch p_match- sub_matches <- mapM (indexOfMatch) $ take nsub_int $ tail $- iterate (`plusPtr` (#const sizeof(regmatch_t))) p_match-- return (Just (match, sub_matches))--indexOfMatch :: Ptr CRegMatch -> IO (Int, Int)-indexOfMatch p_match = do- start <- (#peek regmatch_t, rm_so) p_match :: IO (#type regoff_t)- end <- (#peek regmatch_t, rm_eo) p_match :: IO (#type regoff_t)- let s = fromIntegral start; e = fromIntegral end- return (s, e)---- -------------------------------------------------------------------------------- The POSIX regex C interface--regExtended :: Int-regExtended = 1-regIgnoreCase :: Int-regIgnoreCase = 2-regNosub :: Int-regNosub = 4-regNewline :: Int-regNewline = 8--type CRegMatch = ()--foreign import ccall unsafe "regex.h regcomp"- c_regcomp :: Ptr CRegex -> CString -> CInt -> IO CInt--foreign import ccall unsafe "regex.h ®free"- ptr_regfree :: FunPtr (Ptr CRegex -> IO ())--foreign import ccall unsafe "regex.h regexec"- cregexec :: Ptr CRegex - -> Ptr CChar - -> CSize -> Ptr CRegMatch -> CInt -> IO CInt-
State.hs view
@@ -1,5 +1,5 @@ -- --- Copyright (c) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- Copyright (c) 2004-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License as@@ -25,10 +25,10 @@ import Syntax (Status(Stopped), Mode(..), Frame, Info,Id3) import Tree (FileArray, DirArray) import Style (StringA(Fast), defaultSty, UIStyle)-import Regex (Regex) import qualified Data.ByteString as P (empty,ByteString) import qualified Config (defaultStyle) +import Text.Regex.PCRE.Light (Regex) import Data.Array (listArray) import System.IO.Unsafe (unsafePerformIO) import System.Posix.Types (ProcessID)
Style.hs view
@@ -1,5 +1,5 @@ -- --- Copyright (c) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- Copyright (c) 2004-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License as@@ -42,7 +42,7 @@ -- | User-configurable colours -- Each component of this structure corresponds to a fg\/bg colour pair -- for an item in the ui-data UIStyle = UIStyle { +data UIStyle = UIStyle { window :: !Style -- default window colour , helpscreen :: !Style -- help screen , titlebar :: !Style -- titlebar of window@@ -165,12 +165,12 @@ selected sty, titlebar sty, progress sty, blockcursor sty, cursors sty, combined sty ] (Style fg bg) = progress sty -- bonus style- + pairs <- initUiColors (ls ++ [Style bg bg, Style fg fg]) writeIORef pairMap pairs -- set the background uiAttr (window sty) >>= \(_,p) -> Curses.bkgrndSet nullA p- + ------------------------------------------------------------------------ -- -- | Set up the ui attributes, given a ui style record
Syntax.hs view
@@ -1,5 +1,5 @@ -- --- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- Copyright (c) 2005-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License as@@ -26,7 +26,7 @@ module Syntax where -import qualified Data.ByteString.Char8 as P (packAddress,concat,pack,ByteString)+import qualified Data.ByteString.Char8 as P (concat,pack,ByteString) ------------------------------------------------------------------------ --@@ -37,7 +37,7 @@ data Load = Load {-# UNPACK #-} !P.ByteString instance Pretty Load where- ppr (Load f) = P.concat [P.packAddress "LOAD "#, f]+ ppr (Load f) = P.concat [P.pack "LOAD ", f] -- If '+' or '-' is specified, jumps <frames> frames forward, or backwards, -- respectively, in the the mp3 file. If neither is specifies, jumps to@@ -45,19 +45,19 @@ data Jump = Jump {-# UNPACK #-} !Int instance Pretty Jump where- ppr (Jump i) = P.concat [P.packAddress "JUMP "#, P.pack . show $ i]+ ppr (Jump i) = P.concat [P.pack "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.packAddress "PAUSE"#+ ppr Pause = P.pack "PAUSE" -- Quits mpg321. data Quit = Quit instance Pretty Quit where- ppr Quit = P.packAddress "QUIT"#+ ppr Quit = P.pack "QUIT" ------------------------------------------------------------------------ --@@ -70,10 +70,10 @@ data File = File {-# UNPACK #-} !(Either P.ByteString Id3) -- ID3 info -data Id3 = Id3 - { id3title :: !P.ByteString - , id3artist :: !P.ByteString - , id3album :: !P.ByteString +data Id3 = Id3+ { id3title :: !P.ByteString+ , id3artist :: !P.ByteString+ , id3album :: !P.ByteString , id3str :: !P.ByteString } -- cache screen string to draw -- , year :: Maybe P.ByteString
Tree.hs view
@@ -124,7 +124,7 @@ expandDir f = do ls_raw <- Control.Exception.handle (\e -> hPutStrLn stderr (show e) >> return []) $ packedGetDirectoryContents f- let ls = map (\s -> P.join (P.singleton '/') [f,s]) . sort . filter validFiles $! ls_raw+ let ls = map (\s -> P.intercalate (P.singleton '/') [f,s]) . sort . filter validFiles $! ls_raw ls `seq` return () (fs',ds) <- partition ls let fs = filter onlyMp3s fs'
UI.hs view
@@ -647,7 +647,7 @@ Curses.throwIfErr_ msg $ Curses.waddnstr Curses.stdScr cstr (fromIntegral . P.length $ ps) where- msg = P.packAddress "drawPackedString"#+ msg = P.pack "drawPackedString" ------------------------------------------------------------------------
Utils.hs view
@@ -1,5 +1,5 @@ -- --- Copyright (c) 2003-5 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- Copyright (c) 2003-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons -- -- This program is free software; you can redistribute it and/or -- modify it under the terms of the GNU General Public License as@@ -33,7 +33,8 @@ module Utils where import FastIO (printfPS)-import qualified Data.ByteString.Base as P (packAddress,ByteString)+import qualified Data.ByteString.Char8 as P (pack)+import qualified Data.ByteString as P (ByteString) import Data.Char (toLower) import System.Time (diffClockTimes, TimeDiff(tdSec), ClockTime)@@ -73,9 +74,9 @@ m = quot sr 60 in printfPS fmt h m where- fmt = P.packAddress "%3d:%02d"# -- sometimes ghc doesn't want to fire a RULE here, why?+ fmt = P.pack "%3d:%02d" -- sometimes ghc doesn't want to fire a RULE here, why? -- its crucial for snprintf that this is unpacked- + ------------------------------------------------------------------------ -- | Repeat an action -- Also known as `forever' in the Awkward squad paper@@ -111,8 +112,8 @@ popen :: FilePath -> [String] -> IO (Fd, Fd, Fd, ProcessID) popen cmd args = do (pr, pw) <- createPipe- (cr, cw) <- createPipe - (cre, cwe) <- createPipe + (cr, cw) <- createPipe+ (cre, cwe) <- createPipe -- parent -- let parent = do closeFd cw@@ -120,7 +121,7 @@ closeFd pr -- child -- let child = do closeFd pw- closeFd cr + closeFd cr closeFd cre exec cmd args (pr,cw,cwe) error "exec cmd failed!" -- typing only
hmp3.cabal view
@@ -1,28 +1,38 @@ name: hmp3-version: 1.3+version: 1.4+homepage: http://code.haskell.org/~dons/code/hmp3 license: GPL license-file: LICENSE author: Don Stewart-maintainer: dons@cse.unsw.edu.au-build-depends: base, unix, binary >= 0.2-synopsis: An ncurses mp3 player written in Haskell +maintainer: dons@galois.com category: Sound+synopsis: An ncurses mp3 player written in Haskell description: An mp3 player with a curses frontend. Playlists are populated by passing directory names on the commandline, and saved to the ~/.hmp3db database. Type 'h' to display the help page. Colours may be configured at runtime by editing the "~/.hmp3" file.+ .+cabal-version: >= 1.2 extra-source-files: Keymap.hs-boot README TODO configure configure.ac -executable: hmp3-main-is: Main.hs-extensions: CPP, ForeignFunctionInterface-extra-libraries: curses-include-dirs: cbits-c-sources: cbits/utils.c-other-modules: Curses Regex-ghc-options: -Wall -fglasgow-exts -O2 -funbox-strict-fields -fasm -optl-Wl,-s -Icbits -threaded- --- ghc-options: -Wall -fglasgow-exts -O2 -funbox-strict-fields -fvia-C -optc-O3 -optl-Wl,-s -Icbits -threaded -lncurses--- ghc-options: -prof -auto-all -Wall -fglasgow-exts -O2 -optc-O3 -funbox-strict-fields -Icbits -threaded -lncurses--- ghc-options: -Wall -fglasgow-exts -Onot -Icbits -threaded -lncurses+flag small_base+ description: Choose the new smaller, split-up base package.++executable hmp3+ build-depends: unix, binary >= 0.4, pcre-light >=0.2.1+ if flag(small_base)+ build-depends: base >= 3, bytestring >= 0.9, containers,+ array, old-time, directory, process, random+ else+ build-depends: base < 3++ ghc-options: -Wall -O2 -funbox-strict-fields -optl-Wl,-s -threaded+ main-is: Main.hs+ other-modules: Curses Config Core FastIO Keymap+ Lexer Lexers State Style Syntax Tree UI Utils++ extensions: CPP, ForeignFunctionInterface+ extra-libraries: curses+ include-dirs: cbits+ c-sources: cbits/utils.c