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.Exception (SomeException, catch)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Default (def)
import Data.List (isPrefixOf, stripPrefix)
import Data.Maybe (fromMaybe)
import qualified Data.Vector as Vec
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 qualified Sound.Player.AudioPlay as AP (play, pause, resume, stop)
import Sound.Player.Types (Song(Song, songStatus), PlayerApp(PlayerApp,
songsList, playerStatus, playback), Playback(Playback, playhead),
Status(Play, Pause, Stop), PlayerEvent(VtyEvent, PlayheadAdvance))
import Sound.Player.Widgets (songWidget, playbackProgressBar)
drawUI :: PlayerApp -> [Widget]
drawUI (PlayerApp l _ _ mPlayback) = [ui]
where
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
, playbackProgressBar mPlayback l
, str $ "Press enter to play/stop, spacebar to pause/resume, " ++
"left/right to play prev/next song, " ++
"q to exit."
]
updateAppStatus :: PlayerApp -> Status -> Int -> PlayerApp
updateAppStatus app@(PlayerApp l _ _ _) status pos =
app {
songsList = L.listReplace songs' mPos l,
playerStatus = status
}
where
songs = L.listElements l
mPos = l ^. L.listSelectedL
song = songs Vec.! pos
songs' = songs Vec.// [(pos, song { songStatus = status })]
appEvent :: PlayerApp -> PlayerEvent -> EventM (Next PlayerApp)
appEvent app@(PlayerApp l status _ mPlayback) e =
case e of
VtyEvent (V.EvKey V.KEnter []) ->
M.continue =<< stopAndPlaySelected app
VtyEvent (V.EvKey (V.KChar ' ') []) ->
case status of
Play ->
case mPlayback of
Nothing -> M.continue app
Just (Playback playPos playProc _ _ _) -> do
liftIO $ AP.pause playProc
M.continue $ updateAppStatus app Pause playPos
Pause ->
case mPlayback of
Nothing -> M.continue app
Just (Playback playPos playProc _ _ _) -> do
liftIO $ AP.resume playProc
M.continue $ updateAppStatus app Play playPos
Stop ->
M.continue =<< play (l ^. L.listSelectedL) app
VtyEvent (V.EvKey V.KLeft []) ->
M.continue =<< stopAndPlayDelta (1) app
VtyEvent (V.EvKey V.KRight []) ->
M.continue =<< stopAndPlayDelta 1 app
VtyEvent (V.EvKey (V.KChar 'q') []) ->
M.halt =<< stop app
VtyEvent ev -> do
l' <- handleEvent ev l
M.continue app { songsList = l' }
PlayheadAdvance ->
M.continue =<< case status of
Play ->
case mPlayback of
Nothing -> return app
Just pb@(Playback _ _ ph _ _) ->
if ph > 0 then
return app { playback = Just pb { playhead = ph 1.0 } }
else
stopAndPlayDelta 1 app
_ -> return app
playheadAdvanceLoop :: Chan PlayerEvent -> IO ThreadId
playheadAdvanceLoop chan = forkIO loop
where
loop = do
threadDelay 1000000
writeChan chan PlayheadAdvance
loop
stop :: (MonadIO m) => PlayerApp -> m PlayerApp
stop app@(PlayerApp _ _ _ Nothing) = return app
stop app@(PlayerApp _ _ _ (Just pb@(Playback playPos _ _ _ _))) = do
liftIO $ stopPlayingSong pb
return (updateAppStatus app Stop playPos) { playback = Nothing }
where
stopPlayingSong (Playback _ playProc _ _ threadId) = do
AP.stop playProc
killThread threadId
play :: (MonadIO m) => Maybe Int -> PlayerApp -> m PlayerApp
play Nothing app = return app
play (Just _) app@(PlayerApp _ _ _ (Just _)) = return app
play (Just pos) app@(PlayerApp l _ chan _) = do
(proc, duration, tId) <- liftIO $ playSong song
return (updateAppStatus app Play pos) {
playback = Just (Playback pos proc duration duration tId)
}
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) <- catch
(fetchSongInfo $ musicDir </> path)
failSongInfo
proc <- AP.play $ musicDir </> path
tId <- playheadAdvanceLoop chan
return (proc, duration, tId)
stopAndPlaySelected :: (MonadIO m) => PlayerApp -> m PlayerApp
stopAndPlaySelected app = stop app >>= play mPos
where
mPos = songsList app ^. L.listSelectedL
stopAndPlayDelta :: (MonadIO m) => Int -> PlayerApp -> m PlayerApp
stopAndPlayDelta _ app@(PlayerApp _ _ _ Nothing) = return app
stopAndPlayDelta delta app@(PlayerApp l _ _ (Just (Playback playPos _ _ _ _))) =
stop app >>= play (Just pos)
where
pos = (playPos + delta) `mod` Vec.length (L.listElements l)
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 PlayerEvent
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