haskell-player 0.1.3.2 → 0.1.3.3
raw patch · 4 files changed
+54/−25 lines, 4 filesdep +unix
Dependencies added: unix
Files
- haskell-player.cabal +2/−1
- src/Sound/Player.hs +9/−9
- src/Sound/Player/AudioInfo.hs +19/−3
- src/Sound/Player/AudioPlay.hs +24/−12
haskell-player.cabal view
@@ -1,5 +1,5 @@ name: haskell-player-version: 0.1.3.2+version: 0.1.3.3 synopsis: A terminal music player based on afplay description: A minimal graphical interface on top of afplay and afinfo built using brick.@@ -32,6 +32,7 @@ , process >= 1.2.3 && < 1.3 , text >= 1.2.2.1 && < 1.3 , transformers >= 0.4.2 && < 0.5+ , unix >= 2.7.1 && < 2.8 , vector >= 0.11 && < 0.12 , vty >= 5.5 && < 5.6 , xml-conduit >= 1.3.5 && < 1.4
src/Sound/Player.hs view
@@ -1,8 +1,3 @@--- TODO: playlist--- TODO: search--- TODO: go to playing song--- TODO: help dialog- {-# LANGUAGE OverloadedStrings #-} module Sound.Player (@@ -19,6 +14,7 @@ import Brick.Util (on) import Control.Concurrent (Chan, ThreadId, forkIO, killThread, newChan, writeChan, threadDelay)+import Control.Exception (SomeException, catch) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Default (def) import Data.List (isPrefixOf, stripPrefix)@@ -168,10 +164,14 @@ where songs = L.listElements l song = songs Vec.! pos+ failSongInfo :: SomeException -> IO SongInfo+ failSongInfo _ = return $ SongInfo (-1) playSong :: Song -> IO (ProcessHandle, Double, ThreadId) playSong (Song _ path _) = do musicDir <- defaultMusicDirectory- (SongInfo duration) <- fetchSongInfo $ musicDir </> path+ (SongInfo duration) <- catch+ (fetchSongInfo $ musicDir </> path)+ failSongInfo proc <- AP.play $ musicDir </> path tId <- playheadAdvanceLoop chan return (proc, duration, tId)@@ -179,7 +179,7 @@ -- Stops current song and play selected song. stopAndPlaySelected :: (MonadIO m) => PlayerApp -> m PlayerApp-stopAndPlaySelected app = play mPos =<< stop app+stopAndPlaySelected app = stop app >>= play mPos where mPos = songsList app ^. L.listSelectedL @@ -188,7 +188,7 @@ stopAndPlayDelta :: (MonadIO m) => Int -> PlayerApp -> m PlayerApp stopAndPlayDelta _ app@(PlayerApp _ _ _ Nothing) = return app stopAndPlayDelta delta app@(PlayerApp l _ _ (Just (Playback playPos _ _ _ _))) =- play (Just pos) =<< stop app+ stop app >>= play (Just pos) where pos = (playPos + delta) `mod` Vec.length (L.listElements l) @@ -243,7 +243,7 @@ stripMusicDirectory musicDir = fromMaybe musicDir . stripPrefix musicDir --- | The default music directory is /$HOME\/Music/.+-- | The default music directory is @$HOME/Music@. defaultMusicDirectory :: IO FilePath defaultMusicDirectory = (</> "Music/") <$> getEnv "HOME"
src/Sound/Player/AudioInfo.hs view
@@ -5,11 +5,12 @@ fetchSongInfo ) where -import Control.Exception (SomeException)+import Control.Exception (SomeException(SomeException), Exception) import Data.ByteString.Lazy (ByteString, hGetContents) import qualified Data.Text as T import System.Process (StdStream(CreatePipe), CreateProcess(std_out), createProcess, proc)+import Text.Read (readMaybe) import Text.XML (def, parseLBS) import Text.XML.Cursor (($//), (&//), fromDocument, content, element) @@ -19,6 +20,14 @@ } deriving (Show) +newtype SongInfoParsingException = SongInfoParsingException String++instance Exception SongInfoParsingException++instance Show SongInfoParsingException where+ showsPrec _ (SongInfoParsingException err) = showString err++ fetchSongInfo :: FilePath -> IO SongInfo fetchSongInfo path = do songInfoXML <- fetchRawSongInfo path@@ -39,8 +48,15 @@ parseSongInfo :: ByteString -> Either SomeException SongInfo parseSongInfo contents = do doc <- parseLBS def contents- let durations = fromDocument doc $// durationElement &// content- return . SongInfo . read . T.unpack . T.concat $ durations+ maybe+ (Left . SomeException $ parsingException)+ (Right . SongInfo)+ (readFirst $ durations doc) where+ parsingException = SongInfoParsingException "Can't find song duration"+ durations doc = fromDocument doc $// durationElement &// content+ readFirst :: [T.Text] -> Maybe Double+ readFirst (d:_) = readMaybe (T.unpack d)+ readFirst _ = Nothing durationElement = element "{http://apple.com/core_audio/audio_info}duration"
src/Sound/Player/AudioPlay.hs view
@@ -5,37 +5,49 @@ stop ) where -import Control.Monad (void)-import Data.Maybe (fromJust)-import System.Process (ProcessHandle, createProcess, proc, terminateProcess)+import System.Process (ProcessHandle, StdStream(CreatePipe),+ CreateProcess(std_err), createProcess, proc, terminateProcess)+import System.Posix (ProcessID)+import System.Posix.Signals (signalProcess) import System.Process.Internals (ProcessHandle__(OpenHandle, ClosedHandle),- PHANDLE, withProcessHandle)+ withProcessHandle) +-- | Creates an @afplay@ process to play file at @path@.+--+-- Note: it suppresses process' @stderr@. play :: FilePath -> IO ProcessHandle play path = do- (_, _, _, processHandle) <- createProcess (proc "afplay" [path])+ (_, _, _, processHandle) <-+ -- TODO: update System.Process version to use NoStream+ createProcess (proc "afplay" [path]) {+ std_err = CreatePipe+ } return processHandle +-- | Sends a @17@ signal to @ph@'s process. If @ph@ is the handle of a running+-- @afplay@ process it will pause playback. pause :: ProcessHandle -> IO ()-pause ph = do- mPid <- getPid ph- void $ createProcess (proc "kill" ["-17", show $ fromJust mPid])+pause ph =+ maybe (return ()) (signalProcess 17) =<< getPid ph +-- | Sends a @19@ signal to @ph@'s process. If @ph@ is the handle of a running+-- @afplay@ process it will resume playback. resume :: ProcessHandle -> IO ()-resume ph = do- mPid <- getPid ph- void $ createProcess (proc "kill" ["-19", show $ fromJust mPid])+resume ph =+ maybe (return ()) (signalProcess 19) =<< getPid ph +-- | Terminates the selected process. If @ph@ is the handle of a running+-- @afplay@ process it will stop playback. stop :: ProcessHandle -> IO () stop = terminateProcess -- See https://mail.haskell.org/pipermail/haskell-cafe/2012-October/104028.html-getPid :: ProcessHandle -> IO (Maybe PHANDLE)+getPid :: ProcessHandle -> IO (Maybe ProcessID) getPid ph = withProcessHandle ph (return . go) where go (OpenHandle pid) = Just pid