haskell-player 0.1.2.0 → 0.1.2.1
raw patch · 12 files changed
+412/−412 lines, 12 filesdep ~brickdep ~bytestringdep ~data-default
Dependency ranges changed: brick, bytestring, data-default, directory, filepath, microlens, process, text, transformers, vector, vty, xml-conduit
Files
- app/Main.hs +1/−1
- haskell-player.cabal +18/−18
- src/Player.hs +0/−243
- src/Player/AudioInfo.hs +0/−46
- src/Player/AudioPlay.hs +0/−42
- src/Player/Types.hs +0/−45
- src/Player/Widgets.hs +0/−17
- src/Sound/Player.hs +243/−0
- src/Sound/Player/AudioInfo.hs +46/−0
- src/Sound/Player/AudioPlay.hs +42/−0
- src/Sound/Player/Types.hs +45/−0
- src/Sound/Player/Widgets.hs +17/−0
app/Main.hs view
@@ -2,7 +2,7 @@ import Control.Monad (void) -import Player (appMain)+import Sound.Player (appMain) main :: IO ()
haskell-player.cabal view
@@ -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
− src/Player.hs
@@ -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
− src/Player/AudioInfo.hs
@@ -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"
− src/Player/AudioPlay.hs
@@ -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
− src/Player/Types.hs
@@ -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
− src/Player/Widgets.hs
@@ -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 _ = " "
+ src/Sound/Player.hs view
@@ -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
+ src/Sound/Player/AudioInfo.hs view
@@ -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"
+ src/Sound/Player/AudioPlay.hs view
@@ -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
+ src/Sound/Player/Types.hs view
@@ -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
+ src/Sound/Player/Widgets.hs view
@@ -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 _ = " "