mp 1.0.2 → 1.1.0
raw patch · 6 files changed
+145/−68 lines, 6 filesdep +unixdep ~containersdep ~exceptionsdep ~lenssetup-changed
Dependencies added: unix
Dependency ranges changed: containers, exceptions, lens, network, resourcet, template-haskell, vty
Files
- Setup.hs +0/−2
- mp.cabal +11/−9
- src/Mp/Player/PlaySong.hs +32/−0
- src/Mp/Player/Server.hs +86/−51
- src/Mp/Player/ServerState.hs +13/−4
- stack.yaml +3/−2
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
mp.cabal view
@@ -1,5 +1,5 @@ name: mp-version: 1.0.2+version: 1.1.0 cabal-version: >=1.22 build-type: Simple author: Piotr Borek <piotrborek@op.pl>@@ -18,7 +18,7 @@ hs-source-dirs: src main-is: Main.hs default-language: Haskell2010- ghc-options: -Wall -threaded+ ghc-options: -Wall -threaded -fprof-auto -fprof-cafs default-extensions: CPP FlexibleInstances@@ -36,20 +36,21 @@ mtl (>= 2.2 && < 2.3), random (>= 1.1 && < 1.2), binary (>= 0.8 && < 0.9),- network (>= 2.6 && < 2.7),+ network (>= 2.6 && < 2.9), directory (>= 1.3 && < 1.4), filepath (>= 1.4 && < 1.5), utf8-string (>= 1.0 && < 1.1), ConfigFile (>= 1.1 && < 1.2), MissingH (>= 1.4 && < 1.5),- resourcet (>= 1.1 && < 1.2),- exceptions (>= 0.8 && < 0.9),+ resourcet (>= 1.1 && < 1.3),+ exceptions (>= 0.8 && < 0.11), async (>= 2.1 && < 2.3), daemons (>= 0.2 && < 0.3),- vty (>= 5.16 && < 5.22),- lens (>= 4.15 && < 4.17),- containers (>= 0.5 && < 0.6),- template-haskell (>= 2.11 && < 2.14),+ vty (>= 5.16 && < 5.26),+ lens (>= 4.15 && < 4.18),+ containers (>= 0.5 && < 0.7),+ template-haskell (>= 2.11 && < 2.15),+ unix (>= 2.7 && < 2.8), simple-ui == 0.1.* other-modules:@@ -71,6 +72,7 @@ Mp.Player.Client Mp.Player.Daemon Mp.Player.GstPlayer+ Mp.Player.PlaySong Mp.Player.Server Mp.Player.ServerState Mp.Utils.Network
+ src/Mp/Player/PlaySong.hs view
@@ -0,0 +1,32 @@+{-+ * Programmer: Piotr Borek+ * E-mail: piotrborek@op.pl+ * Copyright 2019 Piotr Borek+ *+ * Distributed under the terms of the GPL (GNU Public License)+ *+ * This program is free software; you can redistribute it and/or modify+ * it under the terms of the GNU General Public License as published by+ * the Free Software Foundation; either version 2 of the License, or+ * (at your option) any later version.+ *+ * This program is distributed in the hope that it will be useful,+ * but WITHOUT ANY WARRANTY; without even the implied warranty of+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ * GNU General Public License for more details.+ *+ * You should have received a copy of the GNU General Public License+ * along with this program; if not, write to the Free Software+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Mp.Player.PlaySong where++data PlaySong = PlaySongNext+ | PlaySongPrevious+ | PlaySongIndex Int++playSongNextIndex :: PlaySong -> Int -> Int+playSongNextIndex PlaySongNext index = succ index+playSongNextIndex PlaySongPrevious index = pred index+playSongNextIndex (PlaySongIndex newIndex) _ = newIndex
src/Mp/Player/Server.hs view
@@ -28,6 +28,7 @@ import qualified Control.Monad.State as State import qualified Data.Text as T import qualified GI.Gst as G+import qualified System.Posix.Signals as Posix import Control.Concurrent import Control.Concurrent.Async@@ -46,6 +47,8 @@ import Mp.Configuration.Configuration import Mp.Player.GstPlayer import Mp.Player.ServerState+import Mp.Player.PlaySong+import Mp.Player.Client (clientSendQuitMessage) import Mp.Utils.Network import Mp.Utils.Shuffle @@ -71,8 +74,21 @@ cfgDir <- configDirFilePath encodeFile (cfgDir </> "server.index") (PlayingIndex index) -startServerBlocking :: MonadResource m => String -> m ()+unixSignalHandler :: Posix.Handler+unixSignalHandler = Posix.Catch $ clientSendQuitMessage++installSigTerm :: MonadIO m => m ()+installSigTerm = liftIO $+ void $ Posix.installHandler Posix.sigTERM unixSignalHandler Nothing++installSigKill :: MonadIO m => m ()+installSigKill = liftIO $+ void $ Posix.installHandler Posix.sigKILL unixSignalHandler Nothing+ +startServerBlocking :: (MonadResource m, MonadThrow m) => String -> m () startServerBlocking socName = do+ installSigTerm+ installSigKill player <- initGstPlayer @@ -86,10 +102,21 @@ gstBusAddWatch player $ \_ message -> do messageType <- G.getMessageType message when (G.MessageTypeError `elem` messageType) $ do- modifyMVar_ serverState $ flip modifyPlayerStop player (_, errText) <- G.messageParseError message putStrLn $ T.unpack errText- when (G.MessageTypeEos `elem` messageType) $ playerPlay serverState player succ+ incrementErrorCounter serverState+ st <- readMVar serverState+ if errorCounter st > 25+ then do+ playerStop serverState player+ else+ case lastOperation st of+ PlaySongNext -> playerPlay serverState player PlaySongNext+ PlaySongPrevious -> playerPlay serverState player PlaySongPrevious+ PlaySongIndex _ -> playerPlay serverState player PlaySongNext+ when (G.MessageTypeEos `elem` messageType) $ do+ resetErrorCounter serverState+ playerPlay serverState player PlaySongNext return True gstPlayerMainLoopBlocking player@@ -144,6 +171,20 @@ } return True +incrementErrorCounter :: MonadIO m => MVar ServerState -> m ()+incrementErrorCounter serverState = liftIO $+ modifyMVar_ serverState $ \st ->+ return st {+ errorCounter = succ $ errorCounter st+ }++resetErrorCounter :: MonadIO m => MVar ServerState -> m ()+resetErrorCounter serverState = liftIO $+ modifyMVar_ serverState $ \st ->+ return st {+ errorCounter = 0+ }+ modifyPlayerStop :: ServerState -> GstPlayer -> IO ServerState modifyPlayerStop st player = do saveServerIndex 0@@ -155,8 +196,8 @@ getStatus = "Stopped" } -modifyPlayerPlay :: ServerState -> GstPlayer -> Int -> IO ServerState-modifyPlayerPlay st player index = do+modifyPlayerPlay :: ServerState -> GstPlayer -> Int -> PlaySong -> IO ServerState+modifyPlayerPlay st player index playSongOperation = do saveServerIndex index let list = getPlaylist st let (f, d) = if isShuffleMode st then@@ -168,27 +209,33 @@ getPlaying = index, getStatus = "Playing", shuffleFunc = f,- shuffleData = d+ shuffleData = d,+ lastOperation = playSongOperation } -playerPlay :: MonadIO m => MVar ServerState -> GstPlayer -> (Int -> Int) -> m ()-playerPlay serverState player indexFunction = liftIO $+playerPlay :: MonadIO m => MVar ServerState -> GstPlayer -> PlaySong -> m ()+playerPlay serverState player playSongOperation = liftIO $ modifyMVar_ serverState $ \st -> do let list = getPlaylist st- let index = indexFunction $ getPlaying st+ let index = playSongNextIndex playSongOperation $ getPlaying st if index >= 0 && index < length list then- modifyPlayerPlay st player index+ modifyPlayerPlay st player index playSongOperation else if isRepeatMode st then if | null list -> modifyPlayerStop st player- | index < 0 -> modifyPlayerPlay st player (length list - 1)- | index >= length list -> modifyPlayerPlay st player 0+ | index < 0 -> modifyPlayerPlay st player (length list - 1) playSongOperation+ | index >= length list -> modifyPlayerPlay st player 0 playSongOperation else modifyPlayerStop st player +playerStop :: MonadIO m => MVar ServerState -> GstPlayer -> m ()+playerStop serverState player = liftIO $ do+ resetErrorCounter serverState+ modifyMVar_ serverState $ flip modifyPlayerStop player+ talkBlocking :: MVar ServerState -> GstPlayer -> Socket -> IO () talkBlocking serverState player sock = processMessages `finally` shutdownServer@@ -269,12 +316,13 @@ index <- recvString' conn sendString conn "OK" + resetErrorCounter serverState st <- liftIO $ readMVar serverState if isShuffleMode st then- playerPlay serverState player $ const 0+ playerPlay serverState player $ PlaySongIndex 0 else- playerPlay serverState player $ const (read index :: Int)+ playerPlay serverState player $ PlaySongIndex (read index :: Int) talkGetPlay :: MonadIO m => MVar ServerState -> Socket -> m () talkGetPlay serverState conn = do@@ -310,21 +358,25 @@ let (_, d) = State.runState shuffleRemove $ shuffleData st liftIO $ putMVar serverState $ update index playing d st - when (shuffleEnabled || playing == index) $ playerPlay serverState player id+ if shuffleEnabled+ then+ playerPlay serverState player (PlaySongIndex 0)+ else+ when (playing == index) $ playerPlay serverState player (PlaySongIndex index) - where- update index playing d st- | index < playing =- st {- getPlaying = pred playing,- getPlaylist = removeAt index $ getPlaylist st,- shuffleData = d- }- | otherwise =- st {- getPlaylist = removeAt index $ getPlaylist st,- shuffleData = d- }+ where+ update index playing d st+ | index < playing =+ st {+ getPlaying = pred playing,+ getPlaylist = removeAt index $ getPlaylist st,+ shuffleData = d+ }+ | otherwise =+ st {+ getPlaylist = removeAt index $ getPlaylist st,+ shuffleData = d+ } talkClear :: MonadIO m => MVar ServerState -> GstPlayer -> Socket -> m () talkClear serverState player conn = do@@ -335,7 +387,7 @@ talkStop :: MonadIO m => MVar ServerState -> Socket -> GstPlayer -> m () talkStop serverState conn player = do sendString conn "OK"- liftIO $ modifyMVar_ serverState $ flip modifyPlayerStop player+ liftIO $ playerStop serverState player talkPause :: MonadIO m => MVar ServerState -> Socket -> GstPlayer -> m () talkPause serverState conn player = do@@ -358,31 +410,14 @@ talkNext :: MonadIO m => MVar ServerState -> Socket -> GstPlayer -> m () talkNext serverState conn player = do sendString conn "OK"- st <- liftIO $ takeMVar serverState- let status = getStatus st- let index = succ $ getPlaying st- let len = length $ getPlaylist st- let rpt = isRepeatMode st- liftIO $ putMVar serverState st-- if rpt then- when (status == "Playing") $ playerPlay serverState player succ- else- when (status == "Playing" && index < len) $ playerPlay serverState player succ+ resetErrorCounter serverState+ playerPlay serverState player PlaySongNext talkPrev :: MonadIO m => MVar ServerState -> Socket -> GstPlayer -> m () talkPrev serverState conn player = do sendString conn "OK"- st <- liftIO $ takeMVar serverState- let status = getStatus st- let index = pred $ getPlaying st- let rpt = isRepeatMode st- liftIO $ putMVar serverState st-- if rpt then- when (status == "Playing") $ playerPlay serverState player pred- else- when (status == "Playing" && index >= 0) $ playerPlay serverState player pred+ resetErrorCounter serverState+ playerPlay serverState player PlaySongPrevious talkVolumeUp :: MonadIO m => MVar ServerState -> Socket -> GstPlayer -> m () talkVolumeUp serverState conn player = do@@ -455,7 +490,7 @@ newSt <- enableShuffle st return (newSt, getStatus st == "Playing") - when shuffleEnabled $ playerPlay serverState player id+ when shuffleEnabled $ playerPlay serverState player (PlaySongIndex 0) disableShuffle :: MonadIO m => ServerState -> m ServerState disableShuffle st =
src/Mp/Player/ServerState.hs view
@@ -29,6 +29,7 @@ import System.Random import Mp.Utils.Shuffle+import Mp.Player.PlaySong data PlayingIndex = PlayingIndex Int @@ -43,7 +44,9 @@ isShuffleMode :: !Bool, randomInitializer :: !Int, shuffleFunc :: Int -> Int,- shuffleData :: !ShuffleData+ shuffleData :: !ShuffleData,+ errorCounter :: !Int,+ lastOperation :: !PlaySong } instance Binary PlayingIndex where@@ -120,7 +123,9 @@ isShuffleMode = shuffleMode, randomInitializer = r, shuffleFunc = f,- shuffleData = d+ shuffleData = d,+ errorCounter = 0,+ lastOperation = PlaySongNext } getVersion1 = do@@ -144,7 +149,9 @@ isShuffleMode = shuffleMode, randomInitializer = r, shuffleFunc = f,- shuffleData = d+ shuffleData = d,+ errorCounter = 0,+ lastOperation = PlaySongNext } defaultServerState :: ServerState@@ -159,7 +166,9 @@ isShuffleMode = False, randomInitializer = 0, shuffleFunc = id,- shuffleData = shuffleInitial $ mkStdGen 0+ shuffleData = shuffleInitial $ mkStdGen 0,+ errorCounter = 0,+ lastOperation = PlaySongNext } readStateFromFile :: String -> IO ServerState
stack.yaml view
@@ -1,4 +1,4 @@-resolver: lts-9.21+resolver: lts-13.18 packages: - '.' extra-deps:@@ -10,7 +10,8 @@ - haskell-gi-overloading-0.0 - daemons-0.2.1 - clock-0.7.2-- simple-ui-0.1.1+- simple-ui-0.1.2+- ConfigFile-1.1.4 flags: {} extra-package-dbs: [] allow-newer: true