musicScroll 0.2.3.2 → 0.2.3.3
raw patch · 5 files changed
+34/−29 lines, 5 files
Files
- CHANGELOG.md +6/−1
- musicScroll.cabal +2/−2
- src/MusicScroll/LyricsPipeline.hs +23/−22
- src/MusicScroll/RealMain.hs +1/−1
- src/MusicScroll/Web.hs +2/−3
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Revision history for music-scroll +# 0.2.3.3++* On low bandwith conditions, don't keep downloading the previous song+ requested.+ ## 0.2.3.0 * Added other music providers@@ -16,7 +21,7 @@ add more. * Better management of dbus signals for changing connection state between music clients.- + ## 0.1.1.0 -- 2020-01-22 * Signal when the song couldn't be gotten from a lyrics website.
musicScroll.cabal view
@@ -4,8 +4,8 @@ -- http://haskell.org/cabal/users-guide/ name: musicScroll-version: 0.2.3.2-synopsis: Supply your tunes info without leaving your music player. +version: 0.2.3.3+synopsis: Supply your tunes info without leaving your music player. description: Automatically retrive the lyrics of of your current song on SMPlayer/VLC and update it on each change. See the lyrics on a really elegant GTK app.
src/MusicScroll/LyricsPipeline.hs view
@@ -2,7 +2,7 @@ -- | Discriminate between getting the lyrics from SQLite or the web. -import Control.Concurrent.Async (withAsync, waitAnyCancel)+import Control.Concurrent.Async (async, cancel, concurrently_) import Control.Concurrent.STM (atomically, orElse) import Control.Concurrent.STM.TBQueue ( TBQueue, readTBQueue, writeTBQueue, newTBQueue )@@ -13,7 +13,6 @@ import Control.Monad.Trans.Reader (ReaderT, runReaderT) import Control.Monad (forever, when) import Numeric.Natural (Natural)-import Data.Functor (void) import Data.Maybe (isJust) import Database.SQLite.Simple @@ -25,34 +24,33 @@ import MusicScroll.Providers.MusiXMatch (musiXMatchInstance) import MusicScroll.UIEvent +type TrackQueue = (TBQueue TrackIdentifier, TBQueue TrackSuplement)+type TrackContext a = StateT (Maybe TrackIdentifier) IO a+ sizeOfQueue :: Natural sizeOfQueue = 5 -lyricsThread :: TBQueue TrackIdentifier -> TBQueue TrackSuplement- -> TBQueue UIEvent -> IO ()-lyricsThread inputIdent inputSupl output =- do songFilterChan <- atomically (newTBQueue sizeOfQueue)- let seenSongThread' = seenSongsThread inputIdent inputSupl songFilterChan- withAsync (evalStateT seenSongThread' Nothing) $ \seenSongsA ->- withAsync (getLyricsThread songFilterChan output) $ \getLyricsA ->- void $ waitAnyCancel [seenSongsA, getLyricsA]+lyricsThread :: TrackQueue -> TBQueue UIEvent -> IO ()+lyricsThread input output =+ do middle <- atomically (newTBQueue sizeOfQueue)+ let seenSongT' = seenSongsThread input middle+ getLyricsT' = getLyricsThread middle output+ concurrently_ (evalStateT seenSongT' Nothing) getLyricsT' -- | This thread works as a model of the MVC pattern. The UI -- communicates its callbacks to here. The Dbus thread sends what it -- sees here to no repeat songs.-seenSongsThread :: TBQueue TrackIdentifier -> TBQueue TrackSuplement- -> TBQueue TrackIdentifier -> StateT (Maybe TrackIdentifier) IO a-seenSongsThread inputIdent inputSupl output = forever $- do mTrackIdent <- mergeQueue inputIdent inputSupl+seenSongsThread :: TrackQueue -> TBQueue TrackIdentifier -> TrackContext a+seenSongsThread input output = forever $+ do mTrackIdent <- mergeQueue input notSeen <- (/=) <$> get <*> pure mTrackIdent when (notSeen && isJust mTrackIdent) $ do let Just trackIdent = mTrackIdent put mTrackIdent liftIO . atomically $ writeTBQueue output trackIdent -mergeQueue :: TBQueue TrackIdentifier -> TBQueue TrackSuplement- -> StateT (Maybe TrackIdentifier) IO (Maybe TrackIdentifier)-mergeQueue inputIdent inputSupl =+mergeQueue :: TrackQueue -> TrackContext (Maybe TrackIdentifier)+mergeQueue (inputIdent, inputSupl) = do let cleanInputIdent = cleanTrack <$> readTBQueue inputIdent mergedInputChan = (Left <$> cleanInputIdent) `orElse` (Right <$> readTBQueue inputSupl)@@ -71,11 +69,14 @@ do dbPath <- getDBPath bracket (open dbPath) close $ \conn -> do execute_ conn sqlDBCreate- forever $- do trackIdent <- atomically (readTBQueue input)- event <- flip runReaderT conn $- either caseByPath caseByInfo trackIdent- atomically $ writeTBQueue output event+ flip evalStateT Nothing . forever $+ do trackIdent <- liftIO $ atomically (readTBQueue input)+ get >>= maybe (pure ()) (liftIO . cancel)+ asyncId <- liftIO . async $+ do event <- flip runReaderT conn $+ either caseByPath caseByInfo trackIdent+ atomically $ writeTBQueue output event+ put (pure asyncId) caseByInfo :: TrackInfo -> ReaderT Connection IO UIEvent caseByInfo track =
src/MusicScroll/RealMain.hs view
@@ -15,6 +15,6 @@ eventChan <- atomically (newTBQueue sizeOfQueue) suplChan <- atomically (newTBQueue sizeOfQueue) withAsync (setupUIThread eventChan suplChan) $ \setupUIA ->- withAsync (lyricsThread dbusSongChan suplChan eventChan) $ \lyricsA ->+ withAsync (lyricsThread (dbusSongChan, suplChan) eventChan) $ \lyricsA -> withAsync (dbusThread dbusSongChan eventChan) $ \dbusA -> void $ waitAnyCancel [setupUIA, lyricsA, dbusA]
src/MusicScroll/Web.hs view
@@ -2,7 +2,7 @@ {-# language TypeApplications, DataKinds #-} module MusicScroll.Web (getLyricsFromWeb) where -import Control.Exception (try, SomeException)+import Control.Exception (try) import Control.Applicative (Alternative(empty)) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.IO.Class (MonadIO(..))@@ -17,7 +17,7 @@ getLyricsFromWeb :: Provider -> TrackInfo -> ReaderT Connection IO Lyrics getLyricsFromWeb (Provider {..}) track = do let songUrl = toUrl track- resp <- liftIO $ try @SomeException (getPage songUrl)+ resp <- liftIO $ try @HttpException (getPage songUrl) let notValid = either (const True) ((/= 200) . responseStatusCode) resp if notValid then empty@@ -29,4 +29,3 @@ getPage :: Url 'Https -> IO BsResponse getPage url = runReq defaultHttpConfig $ req GET url NoReqBody bsResponse mempty-