diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -2,7 +2,7 @@ import Control.Monad (void) -import Player (appMain) +import Sound.Player (appMain) main :: IO () diff --git a/haskell-player.cabal b/haskell-player.cabal --- a/haskell-player.cabal +++ b/haskell-player.cabal @@ -1,5 +1,5 @@ name: haskell-player -version: 0.1.2.0 +version: 0.1.2.1 synopsis: A terminal music player based on afplay description: Please see README.md homepage: https://github.com/potomak/haskell-player @@ -15,25 +15,25 @@ library hs-source-dirs: src - exposed-modules: Player - , Player.AudioInfo - , Player.AudioPlay - , Player.Types - , Player.Widgets + exposed-modules: Sound.Player + , Sound.Player.AudioInfo + , Sound.Player.AudioPlay + , Sound.Player.Types + , Sound.Player.Widgets ghc-options: -Wall build-depends: base >= 4.7 && < 5 - , brick >= 0.6.4 - , bytestring - , data-default - , directory - , filepath - , microlens - , process - , text - , transformers - , vector - , vty - , xml-conduit + , brick >= 0.6.4 && < 0.7 + , bytestring >= 0.10.6 && < 0.11 + , data-default >= 0.5.3 && < 0.6 + , directory >= 1.2.2 && < 1.3 + , filepath >= 1.4 && < 1.5 + , microlens >= 0.4.2.1 && < 0.5 + , process >= 1.2.3 && < 1.3 + , text >= 1.2.2.1 && < 1.3 + , transformers >= 0.4.2 && < 0.5 + , vector >= 0.11 && < 0.12 + , vty >= 5.5 && < 5.6 + , xml-conduit >= 1.3.5 && < 1.4 default-language: Haskell2010 executable haskell-player diff --git a/src/Player.hs b/src/Player.hs deleted file mode 100644 --- a/src/Player.hs +++ /dev/null @@ -1,243 +0,0 @@ --- TODO: playlist --- TODO: search --- TODO: go to playing song --- TODO: next/previous - -{-# LANGUAGE OverloadedStrings #-} - -module Player ( - appMain -) where - -import qualified Brick.AttrMap as A -import qualified Brick.Main as M -import Brick.Types (Widget, EventM, Next, Name(Name), handleEvent) -import Brick.Widgets.Core ((<+>), str, vBox) -import qualified Brick.Widgets.Border as B -import qualified Brick.Widgets.List as L -import qualified Brick.Widgets.ProgressBar as P -import Brick.Util (on) -import Control.Concurrent (Chan, ThreadId, forkIO, killThread, newChan, - writeChan, threadDelay) -import Control.Monad.IO.Class (liftIO) -import Data.Default (def) -import Data.List (isPrefixOf, stripPrefix) -import Data.Maybe (fromMaybe) -import qualified Data.Vector as Vec -import GHC.Float (double2Float) -import qualified Graphics.Vty as V -import Lens.Micro ((^.)) -import System.Directory (doesDirectoryExist, getDirectoryContents) -import System.Environment (getEnv) -import System.FilePath (()) -import System.Process (ProcessHandle) - -import Player.AudioInfo (SongInfo(SongInfo), fetchSongInfo) -import Player.AudioPlay (play, pause, resume, stop) -import Player.Types (Song(Song, songStatus), PlayerApp(PlayerApp, songsList, - playerStatus, playback), Playback(Playback, playhead), Status(Play, Pause, - Stop), PlayheadAdvance(VtyEvent, PlayheadAdvance)) -import Player.Widgets (songWidget) - -drawUI :: PlayerApp -> [Widget] -drawUI (PlayerApp l _ _ mPlayback) = [ui] - where - playheadWidget Nothing = str " " - playheadWidget (Just (Playback _ _ ph d _)) = str $ - "Duration: " ++ show ph ++ - " - Progress: " ++ show (1 - (double2Float ph / double2Float d)) - playheadProgressBar Nothing = str " " - playheadProgressBar (Just (Playback _ _ ph d _)) = - P.progressBar Nothing (1 - (double2Float ph / double2Float d)) - label = str "Item " <+> cur <+> str " of " <+> total - cur = - case l ^. L.listSelectedL of - Nothing -> str "-" - Just i -> str (show (i + 1)) - total = str $ show $ Vec.length $ l ^. L.listElementsL - box = B.borderWithLabel label $ L.renderList l (const songWidget) - ui = vBox [ box - , playheadProgressBar mPlayback - , playheadWidget mPlayback - , str "Press spacebar to play/pause, q to exit." - ] - -appEvent :: PlayerApp -> PlayheadAdvance -> EventM (Next PlayerApp) -appEvent app@(PlayerApp l status chan mPlayback) e = - case e of - -- press spacebar to play/pause - VtyEvent (V.EvKey (V.KChar ' ') []) -> do - let mPos = l ^. L.listSelectedL - songs = L.listElements l - case mPos of - Nothing -> M.continue app - Just pos -> do - let selectedSong = songs Vec.! pos - case status of - Play -> - -- pause/stop playing the selected song - case mPlayback of - Nothing -> M.continue app - Just pb@(Playback playPos playProc _ _ _) -> do - app' <- if playPos == pos - then do - let songs' = songs Vec.// [(pos, selectedSong { songStatus = Pause })] - liftIO $ pause playProc - return app { - songsList = L.listReplace songs' (Just pos) l, - playerStatus = Pause - } - else do - let song = songs Vec.! playPos - songs' = songs Vec.// [(playPos, song { songStatus = Stop })] - liftIO $ stopPlayingSong pb - return app { - songsList = L.listReplace songs' (Just pos) l, - playerStatus = Stop, - playback = Nothing - } - M.continue app' - Pause -> - -- resume/play the selected song - case mPlayback of - Nothing -> M.continue app - Just (Playback playPos playProc _ _ _) -> do - app' <- do - let song = songs Vec.! playPos - songs' = songs Vec.// [(playPos, song { songStatus = Play })] - liftIO $ resume playProc - return app { - songsList = L.listReplace songs' (Just pos) l, - playerStatus = Play - } - M.continue app' - Stop -> do - let songs' = songs Vec.// [(pos, selectedSong { songStatus = Play })] - -- play selected song - (proc, duration, tId) <- liftIO $ playSong selectedSong chan - M.continue app { - songsList = L.listReplace songs' (Just pos) l, - playerStatus = Play, - playback = Just (Playback pos proc duration duration tId) - } - -- press q to quit - VtyEvent (V.EvKey (V.KChar 'q') []) -> do - -- stop current process if present - maybe (return ()) (liftIO . stopPlayingSong) mPlayback - M.halt app - - -- any other event - VtyEvent ev -> do - l' <- handleEvent ev l - M.continue app { songsList = l' } - PlayheadAdvance -> - case status of - Play -> - case mPlayback of - Nothing -> M.continue app - Just pb@(Playback playPos _ ph _ _) -> - if ph > 0 - then - -- advance playhead - M.continue app { - playback = Just pb { playhead = ph - 1.0 } - } - else do - let songs = L.listElements l - song = songs Vec.! playPos - nextPos = (playPos + 1) `mod` Vec.length songs - nextSong = songs Vec.! nextPos - songs' = songs Vec.// [ - (playPos, song { songStatus = Stop }), - (nextPos, nextSong { songStatus = Play }) - ] - -- stop current song - liftIO $ stopPlayingSong pb - -- play next song - (proc, duration, tId) <- liftIO $ playSong nextSong chan - M.continue app { - songsList = L.listReplace songs' (l ^. L.listSelectedL) l, - playback = Just (Playback nextPos proc duration duration tId) - } - _ -> M.continue app - - -playheadAdvanceLoop :: Chan PlayheadAdvance -> IO ThreadId -playheadAdvanceLoop chan = forkIO loop - where - loop = do - threadDelay 1000000 - writeChan chan PlayheadAdvance - loop - - -stopPlayingSong :: Playback -> IO () -stopPlayingSong (Playback _ playProc _ _ threadId) = do - stop playProc - killThread threadId - - -playSong :: Song -> Chan PlayheadAdvance -> IO (ProcessHandle, Double, ThreadId) -playSong (Song _ path _) chan = do - musicDir <- defaultMusicDirectory - (SongInfo duration) <- fetchSongInfo $ musicDir path - proc <- play $ musicDir path - tId <- playheadAdvanceLoop chan - return (proc, duration, tId) - - -initialState :: IO PlayerApp -initialState = do - chan <- newChan - paths <- listMusicDirectory - let songs = map (\p -> Song Nothing p Stop) paths - listWidget = L.list (Name "list") (Vec.fromList songs) 1 - return $ PlayerApp listWidget Stop chan Nothing - - -theMap :: A.AttrMap -theMap = A.attrMap V.defAttr - [ (L.listAttr, V.white `on` V.blue) - , (L.listSelectedAttr, V.blue `on` V.white) - , (P.progressCompleteAttr, V.blue `on` V.white) - ] - - -theApp :: M.App PlayerApp PlayheadAdvance -theApp = - M.App { M.appDraw = drawUI - , M.appChooseCursor = M.showFirstCursor - , M.appHandleEvent = appEvent - , M.appStartEvent = return - , M.appAttrMap = const theMap - , M.appLiftVtyEvent = VtyEvent - } - - -listMusicDirectory :: IO [FilePath] -listMusicDirectory = do - musicDir <- defaultMusicDirectory - map (stripMusicDirectory musicDir) <$> listMusicDirectoryRic [musicDir] - where - listMusicDirectoryRic [] = return [] - listMusicDirectoryRic (p:ps) = do - isDirectory <- doesDirectoryExist p - if isDirectory - then do - files <- map (p ) . filter visible <$> getDirectoryContents p - listMusicDirectoryRic (files ++ ps) - else do - files <- listMusicDirectoryRic ps - return $ p:files - visible = not . isPrefixOf "." - stripMusicDirectory musicDir = fromMaybe musicDir . stripPrefix musicDir - - -defaultMusicDirectory :: IO FilePath -defaultMusicDirectory = ( "Music/") <$> getEnv "HOME" - - -appMain :: IO PlayerApp -appMain = do - playerApp@(PlayerApp _ _ chan _) <- initialState - M.customMain (V.mkVty def) chan theApp playerApp diff --git a/src/Player/AudioInfo.hs b/src/Player/AudioInfo.hs deleted file mode 100644 --- a/src/Player/AudioInfo.hs +++ /dev/null @@ -1,46 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Player.AudioInfo ( - SongInfo(..), - fetchSongInfo -) where - -import Control.Exception (SomeException) -import Data.ByteString.Lazy (ByteString, hGetContents) -import qualified Data.Text as T -import System.Process (StdStream(CreatePipe), CreateProcess(std_out), - createProcess, proc) -import Text.XML (def, parseLBS) -import Text.XML.Cursor (($//), (&//), fromDocument, content, element) - - -data SongInfo = SongInfo { - duration :: Double - } deriving (Show) - - -fetchSongInfo :: FilePath -> IO SongInfo -fetchSongInfo path = do - songInfoXML <- fetchRawSongInfo path - case parseSongInfo songInfoXML of - Left _ -> fail "Song info parsing error" - Right songInfo -> return songInfo - - -fetchRawSongInfo :: FilePath -> IO ByteString -fetchRawSongInfo path = do - (_, Just hout, _, _) <- - createProcess (proc "afinfo" ["-x", path]) { - std_out = CreatePipe - } - hGetContents hout - - -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 - where - durationElement = - element "{http://apple.com/core_audio/audio_info}duration" diff --git a/src/Player/AudioPlay.hs b/src/Player/AudioPlay.hs deleted file mode 100644 --- a/src/Player/AudioPlay.hs +++ /dev/null @@ -1,42 +0,0 @@ -module Player.AudioPlay ( - play, - pause, - resume, - stop -) where - -import Control.Monad (void) -import Data.Maybe (fromJust) -import System.Process (ProcessHandle, createProcess, proc, terminateProcess) -import System.Process.Internals (ProcessHandle__(OpenHandle, ClosedHandle), - PHANDLE, withProcessHandle) - - -play :: FilePath -> IO ProcessHandle -play path = do - (_, _, _, processHandle) <- createProcess (proc "afplay" [path]) - return processHandle - - -pause :: ProcessHandle -> IO () -pause ph = do - mPid <- getPid ph - void $ createProcess (proc "kill" ["-17", show $ fromJust mPid]) - - -resume :: ProcessHandle -> IO () -resume ph = do - mPid <- getPid ph - void $ createProcess (proc "kill" ["-19", show $ fromJust mPid]) - - -stop :: ProcessHandle -> IO () -stop = terminateProcess - - --- See https://mail.haskell.org/pipermail/haskell-cafe/2012-October/104028.html -getPid :: ProcessHandle -> IO (Maybe PHANDLE) -getPid ph = withProcessHandle ph (return . go) - where - go (OpenHandle pid) = Just pid - go (ClosedHandle _) = Nothing diff --git a/src/Player/Types.hs b/src/Player/Types.hs deleted file mode 100644 --- a/src/Player/Types.hs +++ /dev/null @@ -1,45 +0,0 @@ -module Player.Types ( - PlayerApp(..), - Playback(..), - Song(..), - Status(..), - PlayheadAdvance(..) -) where - -import Brick.Widgets.List (List) -import Control.Concurrent (ThreadId, Chan) -import qualified Graphics.Vty as V -import System.Process (ProcessHandle) - -import Player.AudioInfo (SongInfo) - - -data PlayerApp = PlayerApp { - songsList :: List Song, - playerStatus :: Status, - playbackChan :: Chan PlayheadAdvance, - playback :: Maybe Playback - } - - -data Playback = Playback { - position :: Int, - process :: ProcessHandle, - playhead :: Double, - duration :: Double, - playheadThread :: ThreadId - } - - -data Song = Song { - songInfo :: Maybe SongInfo, - songPath :: FilePath, - songStatus :: Status - } deriving (Show) - - -data Status = Play | Pause | Stop - deriving (Show) - - -data PlayheadAdvance = VtyEvent V.Event | PlayheadAdvance diff --git a/src/Player/Widgets.hs b/src/Player/Widgets.hs deleted file mode 100644 --- a/src/Player/Widgets.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Player.Widgets ( - songWidget -) where - -import Brick.Types (Widget) -import Brick.Widgets.Core ((<+>), str, fill, vLimit) - -import Player.Types (Song(Song), Status(Play, Pause)) - - -songWidget :: Song -> Widget -songWidget (Song _ path status) = - vLimit 1 $ str (statusSymbol status) <+> str " " <+> str path <+> fill ' ' - where - statusSymbol Play = "♫" - statusSymbol Pause = "►" - statusSymbol _ = " " diff --git a/src/Sound/Player.hs b/src/Sound/Player.hs new file mode 100644 --- /dev/null +++ b/src/Sound/Player.hs @@ -0,0 +1,243 @@ +-- TODO: playlist +-- TODO: search +-- TODO: go to playing song +-- TODO: next/previous + +{-# LANGUAGE OverloadedStrings #-} + +module Sound.Player ( + appMain +) where + +import qualified Brick.AttrMap as A +import qualified Brick.Main as M +import Brick.Types (Widget, EventM, Next, Name(Name), handleEvent) +import Brick.Widgets.Core ((<+>), str, vBox) +import qualified Brick.Widgets.Border as B +import qualified Brick.Widgets.List as L +import qualified Brick.Widgets.ProgressBar as P +import Brick.Util (on) +import Control.Concurrent (Chan, ThreadId, forkIO, killThread, newChan, + writeChan, threadDelay) +import Control.Monad.IO.Class (liftIO) +import Data.Default (def) +import Data.List (isPrefixOf, stripPrefix) +import Data.Maybe (fromMaybe) +import qualified Data.Vector as Vec +import GHC.Float (double2Float) +import qualified Graphics.Vty as V +import Lens.Micro ((^.)) +import System.Directory (doesDirectoryExist, getDirectoryContents) +import System.Environment (getEnv) +import System.FilePath (()) +import System.Process (ProcessHandle) + +import Sound.Player.AudioInfo (SongInfo(SongInfo), fetchSongInfo) +import Sound.Player.AudioPlay (play, pause, resume, stop) +import Sound.Player.Types (Song(Song, songStatus), PlayerApp(PlayerApp, songsList, + playerStatus, playback), Playback(Playback, playhead), Status(Play, Pause, + Stop), PlayheadAdvance(VtyEvent, PlayheadAdvance)) +import Sound.Player.Widgets (songWidget) + +drawUI :: PlayerApp -> [Widget] +drawUI (PlayerApp l _ _ mPlayback) = [ui] + where + playheadWidget Nothing = str " " + playheadWidget (Just (Playback _ _ ph d _)) = str $ + "Duration: " ++ show ph ++ + " - Progress: " ++ show (1 - (double2Float ph / double2Float d)) + playheadProgressBar Nothing = str " " + playheadProgressBar (Just (Playback _ _ ph d _)) = + P.progressBar Nothing (1 - (double2Float ph / double2Float d)) + label = str "Item " <+> cur <+> str " of " <+> total + cur = + case l ^. L.listSelectedL of + Nothing -> str "-" + Just i -> str (show (i + 1)) + total = str $ show $ Vec.length $ l ^. L.listElementsL + box = B.borderWithLabel label $ L.renderList l (const songWidget) + ui = vBox [ box + , playheadProgressBar mPlayback + , playheadWidget mPlayback + , str "Press spacebar to play/pause, q to exit." + ] + +appEvent :: PlayerApp -> PlayheadAdvance -> EventM (Next PlayerApp) +appEvent app@(PlayerApp l status chan mPlayback) e = + case e of + -- press spacebar to play/pause + VtyEvent (V.EvKey (V.KChar ' ') []) -> do + let mPos = l ^. L.listSelectedL + songs = L.listElements l + case mPos of + Nothing -> M.continue app + Just pos -> do + let selectedSong = songs Vec.! pos + case status of + Play -> + -- pause/stop playing the selected song + case mPlayback of + Nothing -> M.continue app + Just pb@(Playback playPos playProc _ _ _) -> do + app' <- if playPos == pos + then do + let songs' = songs Vec.// [(pos, selectedSong { songStatus = Pause })] + liftIO $ pause playProc + return app { + songsList = L.listReplace songs' (Just pos) l, + playerStatus = Pause + } + else do + let song = songs Vec.! playPos + songs' = songs Vec.// [(playPos, song { songStatus = Stop })] + liftIO $ stopPlayingSong pb + return app { + songsList = L.listReplace songs' (Just pos) l, + playerStatus = Stop, + playback = Nothing + } + M.continue app' + Pause -> + -- resume/play the selected song + case mPlayback of + Nothing -> M.continue app + Just (Playback playPos playProc _ _ _) -> do + app' <- do + let song = songs Vec.! playPos + songs' = songs Vec.// [(playPos, song { songStatus = Play })] + liftIO $ resume playProc + return app { + songsList = L.listReplace songs' (Just pos) l, + playerStatus = Play + } + M.continue app' + Stop -> do + let songs' = songs Vec.// [(pos, selectedSong { songStatus = Play })] + -- play selected song + (proc, duration, tId) <- liftIO $ playSong selectedSong chan + M.continue app { + songsList = L.listReplace songs' (Just pos) l, + playerStatus = Play, + playback = Just (Playback pos proc duration duration tId) + } + -- press q to quit + VtyEvent (V.EvKey (V.KChar 'q') []) -> do + -- stop current process if present + maybe (return ()) (liftIO . stopPlayingSong) mPlayback + M.halt app + + -- any other event + VtyEvent ev -> do + l' <- handleEvent ev l + M.continue app { songsList = l' } + PlayheadAdvance -> + case status of + Play -> + case mPlayback of + Nothing -> M.continue app + Just pb@(Playback playPos _ ph _ _) -> + if ph > 0 + then + -- advance playhead + M.continue app { + playback = Just pb { playhead = ph - 1.0 } + } + else do + let songs = L.listElements l + song = songs Vec.! playPos + nextPos = (playPos + 1) `mod` Vec.length songs + nextSong = songs Vec.! nextPos + songs' = songs Vec.// [ + (playPos, song { songStatus = Stop }), + (nextPos, nextSong { songStatus = Play }) + ] + -- stop current song + liftIO $ stopPlayingSong pb + -- play next song + (proc, duration, tId) <- liftIO $ playSong nextSong chan + M.continue app { + songsList = L.listReplace songs' (l ^. L.listSelectedL) l, + playback = Just (Playback nextPos proc duration duration tId) + } + _ -> M.continue app + + +playheadAdvanceLoop :: Chan PlayheadAdvance -> IO ThreadId +playheadAdvanceLoop chan = forkIO loop + where + loop = do + threadDelay 1000000 + writeChan chan PlayheadAdvance + loop + + +stopPlayingSong :: Playback -> IO () +stopPlayingSong (Playback _ playProc _ _ threadId) = do + stop playProc + killThread threadId + + +playSong :: Song -> Chan PlayheadAdvance -> IO (ProcessHandle, Double, ThreadId) +playSong (Song _ path _) chan = do + musicDir <- defaultMusicDirectory + (SongInfo duration) <- fetchSongInfo $ musicDir path + proc <- play $ musicDir path + tId <- playheadAdvanceLoop chan + return (proc, duration, tId) + + +initialState :: IO PlayerApp +initialState = do + chan <- newChan + paths <- listMusicDirectory + let songs = map (\p -> Song Nothing p Stop) paths + listWidget = L.list (Name "list") (Vec.fromList songs) 1 + return $ PlayerApp listWidget Stop chan Nothing + + +theMap :: A.AttrMap +theMap = A.attrMap V.defAttr + [ (L.listAttr, V.white `on` V.blue) + , (L.listSelectedAttr, V.blue `on` V.white) + , (P.progressCompleteAttr, V.blue `on` V.white) + ] + + +theApp :: M.App PlayerApp PlayheadAdvance +theApp = + M.App { M.appDraw = drawUI + , M.appChooseCursor = M.showFirstCursor + , M.appHandleEvent = appEvent + , M.appStartEvent = return + , M.appAttrMap = const theMap + , M.appLiftVtyEvent = VtyEvent + } + + +listMusicDirectory :: IO [FilePath] +listMusicDirectory = do + musicDir <- defaultMusicDirectory + map (stripMusicDirectory musicDir) <$> listMusicDirectoryRic [musicDir] + where + listMusicDirectoryRic [] = return [] + listMusicDirectoryRic (p:ps) = do + isDirectory <- doesDirectoryExist p + if isDirectory + then do + files <- map (p ) . filter visible <$> getDirectoryContents p + listMusicDirectoryRic (files ++ ps) + else do + files <- listMusicDirectoryRic ps + return $ p:files + visible = not . isPrefixOf "." + stripMusicDirectory musicDir = fromMaybe musicDir . stripPrefix musicDir + + +defaultMusicDirectory :: IO FilePath +defaultMusicDirectory = ( "Music/") <$> getEnv "HOME" + + +appMain :: IO PlayerApp +appMain = do + playerApp@(PlayerApp _ _ chan _) <- initialState + M.customMain (V.mkVty def) chan theApp playerApp diff --git a/src/Sound/Player/AudioInfo.hs b/src/Sound/Player/AudioInfo.hs new file mode 100644 --- /dev/null +++ b/src/Sound/Player/AudioInfo.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Sound.Player.AudioInfo ( + SongInfo(..), + fetchSongInfo +) where + +import Control.Exception (SomeException) +import Data.ByteString.Lazy (ByteString, hGetContents) +import qualified Data.Text as T +import System.Process (StdStream(CreatePipe), CreateProcess(std_out), + createProcess, proc) +import Text.XML (def, parseLBS) +import Text.XML.Cursor (($//), (&//), fromDocument, content, element) + + +data SongInfo = SongInfo { + duration :: Double + } deriving (Show) + + +fetchSongInfo :: FilePath -> IO SongInfo +fetchSongInfo path = do + songInfoXML <- fetchRawSongInfo path + case parseSongInfo songInfoXML of + Left _ -> fail "Song info parsing error" + Right songInfo -> return songInfo + + +fetchRawSongInfo :: FilePath -> IO ByteString +fetchRawSongInfo path = do + (_, Just hout, _, _) <- + createProcess (proc "afinfo" ["-x", path]) { + std_out = CreatePipe + } + hGetContents hout + + +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 + where + durationElement = + element "{http://apple.com/core_audio/audio_info}duration" diff --git a/src/Sound/Player/AudioPlay.hs b/src/Sound/Player/AudioPlay.hs new file mode 100644 --- /dev/null +++ b/src/Sound/Player/AudioPlay.hs @@ -0,0 +1,42 @@ +module Sound.Player.AudioPlay ( + play, + pause, + resume, + stop +) where + +import Control.Monad (void) +import Data.Maybe (fromJust) +import System.Process (ProcessHandle, createProcess, proc, terminateProcess) +import System.Process.Internals (ProcessHandle__(OpenHandle, ClosedHandle), + PHANDLE, withProcessHandle) + + +play :: FilePath -> IO ProcessHandle +play path = do + (_, _, _, processHandle) <- createProcess (proc "afplay" [path]) + return processHandle + + +pause :: ProcessHandle -> IO () +pause ph = do + mPid <- getPid ph + void $ createProcess (proc "kill" ["-17", show $ fromJust mPid]) + + +resume :: ProcessHandle -> IO () +resume ph = do + mPid <- getPid ph + void $ createProcess (proc "kill" ["-19", show $ fromJust mPid]) + + +stop :: ProcessHandle -> IO () +stop = terminateProcess + + +-- See https://mail.haskell.org/pipermail/haskell-cafe/2012-October/104028.html +getPid :: ProcessHandle -> IO (Maybe PHANDLE) +getPid ph = withProcessHandle ph (return . go) + where + go (OpenHandle pid) = Just pid + go (ClosedHandle _) = Nothing diff --git a/src/Sound/Player/Types.hs b/src/Sound/Player/Types.hs new file mode 100644 --- /dev/null +++ b/src/Sound/Player/Types.hs @@ -0,0 +1,45 @@ +module Sound.Player.Types ( + PlayerApp(..), + Playback(..), + Song(..), + Status(..), + PlayheadAdvance(..) +) where + +import Brick.Widgets.List (List) +import Control.Concurrent (ThreadId, Chan) +import qualified Graphics.Vty as V +import System.Process (ProcessHandle) + +import Sound.Player.AudioInfo (SongInfo) + + +data PlayerApp = PlayerApp { + songsList :: List Song, + playerStatus :: Status, + playbackChan :: Chan PlayheadAdvance, + playback :: Maybe Playback + } + + +data Playback = Playback { + position :: Int, + process :: ProcessHandle, + playhead :: Double, + duration :: Double, + playheadThread :: ThreadId + } + + +data Song = Song { + songInfo :: Maybe SongInfo, + songPath :: FilePath, + songStatus :: Status + } deriving (Show) + + +data Status = Play | Pause | Stop + deriving (Show) + + +data PlayheadAdvance = VtyEvent V.Event | PlayheadAdvance diff --git a/src/Sound/Player/Widgets.hs b/src/Sound/Player/Widgets.hs new file mode 100644 --- /dev/null +++ b/src/Sound/Player/Widgets.hs @@ -0,0 +1,17 @@ +module Sound.Player.Widgets ( + songWidget +) where + +import Brick.Types (Widget) +import Brick.Widgets.Core ((<+>), str, fill, vLimit) + +import Sound.Player.Types (Song(Song), Status(Play, Pause)) + + +songWidget :: Song -> Widget +songWidget (Song _ path status) = + vLimit 1 $ str (statusSymbol status) <+> str " " <+> str path <+> fill ' ' + where + statusSymbol Play = "♫" + statusSymbol Pause = "►" + statusSymbol _ = " "