mplayer-spot (empty) → 0.1.0.0
raw patch · 6 files changed
+487/−0 lines, 6 filesdep +asyncdep +attoparsecdep +base
Dependencies added: async, attoparsec, base, bytestring, conduit, conduit-extra, directory, filepath, mplayer-spot, process, semigroupoids, streaming-commons, tagged, text
Files
- CHANGELOG.md +4/−0
- LICENSE +30/−0
- README.md +42/−0
- app/Main.hs +7/−0
- mplayer-spot.cabal +78/−0
- src/MPlayer/Spot.hs +326/−0
+ CHANGELOG.md view
@@ -0,0 +1,4 @@++## 0.1.0.0++* Initial release.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Dennis Gosnell (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,42 @@++mplayer-spot+============++[](http://travis-ci.org/cdepillabout/mplayer-spot)+[](https://hackage.haskell.org/package/mplayer-spot)+[](http://stackage.org/lts/package/mplayer-spot)+[](http://stackage.org/nightly/package/mplayer-spot)+[](./LICENSE)++`mplayer-spot` saves your spot when watching movies with `mplayer`.++## Usage++You can use `mplayer-spot` on the command line just as you would use `mplayer`:++```console+$ mplayer-spot Dumb-and-Dumber.mp4+```++This plays the movie just like `mplayer`.++However, if you exit part-way through the movie by pressing <kbd>q</kbd>, `mplayer-spot`+saves your current location. Next time you play the same file, `mplayer-spot`+looks up how far into the movie you watched, and starts playing from that+position.+++If instance, if you stop the movie after 45 minutes, and play it again with+`mplayer-spot`, it will start from the 45 minute mark.++`mplayer-spot` is convenient if you often watch long movies in parts, and want+an easy way to restart from where you left off.++## How Does `mplayer-spot` Work?++`mplayer-spot` runs `mplayer` in verbose mode, and parses the current position+in the movie. When exiting, it saves the position in the `~/.mplayer-spot`+directory.++`mplayer-spot` references files by filename, so if you rename a file, you will+not be able to restart from the same position.
+ app/Main.hs view
@@ -0,0 +1,7 @@++module Main where++import MPlayer.Spot (defaultMain)++main :: IO ()+main = defaultMain
+ mplayer-spot.cabal view
@@ -0,0 +1,78 @@+name: mplayer-spot+version: 0.1.0.0+synopsis: Save your spot when watching movies with @mplayer@.+description: Please see <https://github.com/cdepillabout/mplayer-spot#readme README.md>.+homepage: https://github.com/cdepillabout/mplayer-spot+license: BSD3+license-file: LICENSE+author: Dennis Gosnell+maintainer: cdep.illabout@gmail.com+copyright: 2020 Dennis Gosnell+category: Text+build-type: Simple+cabal-version: >=1.12+extra-source-files: README.md+ , CHANGELOG.md++library+ hs-source-dirs: src+ exposed-modules: MPlayer.Spot+ build-depends: base >= 4.11 && < 5+ , async+ , attoparsec+ , bytestring+ , conduit+ , conduit-extra+ , directory+ , filepath+ , process+ , semigroupoids+ , streaming-commons+ , tagged+ , text+ default-language: Haskell2010+ ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates+ default-extensions: DataKinds+ , DefaultSignatures+ , DeriveAnyClass+ , DeriveFoldable+ , DeriveFunctor+ , DeriveGeneric+ , DerivingStrategies+ , EmptyCase+ , ExistentialQuantification+ , FlexibleContexts+ , FlexibleInstances+ , GADTs+ , GeneralizedNewtypeDeriving+ , InstanceSigs+ , KindSignatures+ , LambdaCase+ , MultiParamTypeClasses+ , NamedFieldPuns+ , OverloadedLabels+ , OverloadedLists+ , OverloadedStrings+ , PatternSynonyms+ , PolyKinds+ , RankNTypes+ , RecordWildCards+ , ScopedTypeVariables+ , StandaloneDeriving+ , TypeApplications+ , TypeFamilies+ , TypeOperators+ other-extensions: TemplateHaskell+ , UndecidableInstances++executable mplayer-spot+ main-is: Main.hs+ hs-source-dirs: app+ build-depends: base+ , mplayer-spot+ default-language: Haskell2010+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N++source-repository head+ type: git+ location: git@github.com:cdepillabout/mplayer-spot.git
+ src/MPlayer/Spot.hs view
@@ -0,0 +1,326 @@+module MPlayer.Spot where++import Conduit (ConduitT, awaitForever, iterMC, runConduit, yield, (.|))+import Control.Applicative ((<|>))+import Control.Concurrent.Async (Concurrently(..))+import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, tryReadMVar)+import Control.Exception (IOException, finally, try)+import Control.Monad (void)+import Control.Monad.IO.Class (liftIO)+import Data.Attoparsec.ByteString.Char8+ ( Parser, char, notInClass, parseOnly, rational, skipSpace, skipWhile+ , string, takeWhile1+ )+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as C8+import Data.Conduit.Combinators (stderr, stdin, stdout)+import Data.Conduit.Process (streamingProcess, waitForStreamingProcess)+import Data.Monoid ((<>))+import Data.Streaming.Process (StreamingProcessHandle)+import Data.Text (unpack)+import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import Data.Void (Void)+import System.Directory (createDirectoryIfMissing, getHomeDirectory, removeFile)+import System.Environment (getArgs)+import System.Exit (exitWith)+import System.FilePath (takeFileName, (</>))+import System.IO (BufferMode(..), hSetBuffering)+import qualified System.IO as IO+import System.Process (proc)++-- Define the the types that should be defaulted to. We can define one+-- type for string-like things, and one type for integer-like things. It+-- doesn't matter what order they are in.+default (T.Text, Int)++-- | A config for our program.+data Config = Config { configMPlayerSpotRCDir :: FilePath -- ^ @~/.mplayer-spots@ dir+ , configSpotsDir :: FilePath -- ^ @~/.mplayer-spots/spots@ dir+ , configIgnoreSeconds :: Float -- how many seconds to ignore+ -- in media before creating+ -- spot file+ }+ deriving Show++-- | Create a default 'Config'.+defaultConfig :: IO Config+defaultConfig = do+ homeDir <- getHomeDirectory+ let rcDir = homeDir </> ".mplayer-spot"+ let spotsDir = rcDir </> "spots"+ let ignoreSeconds = 180+ pure $ Config rcDir spotsDir ignoreSeconds++-- | Info about our media.+data MediaInfo = MediaInfo { mediaInfoLength :: Maybe Float -- ^ length of the media+ , mediaInfoFilename :: Maybe ByteString -- ^ filename of the media+ , mediaInfoCurPos :: Maybe Float -- ^ current position+ , mediaInfoAlreadySetOldLocation :: Bool -- ^ whether we have already+ -- set the old location+ }+ deriving Show++defaultMediaInfo :: MediaInfo+defaultMediaInfo = MediaInfo { mediaInfoLength = Nothing+ , mediaInfoFilename = Nothing+ , mediaInfoCurPos = Nothing+ , mediaInfoAlreadySetOldLocation = False+ }++-- | Datatype to hold mplayer's stdin, stdout, etc conduits.+data MPlayer = MPlayer { mplayerStdin :: ConduitT ByteString Void IO ()+ , mplayerStdout :: ConduitT () ByteString IO ()+ , mplayerStderr :: ConduitT () ByteString IO ()+ , mplayerProcHandle :: StreamingProcessHandle+ }++-- | Take in a bunch of arguments and use them to create the mplayer process.+createMPlayerProcess :: [String] -> IO MPlayer+createMPlayerProcess programArgs = do+ let mplayerArgs = ["-identify", "-slave"] <> programArgs+ ( processStdin :: ConduitT ByteString Void IO ()+ , processStdout :: ConduitT () ByteString IO ()+ , processStderr :: ConduitT () ByteString IO ()+ , processHandle) <-+ streamingProcess (proc "mplayer" mplayerArgs)+ return $! MPlayer processStdin processStdout processStderr processHandle++-- streamingProcess :: (MonadIO m, InputSource stdin, OutputSink stdout, OutputSink stderr) => CreateProcess -> m (stdin, stdout, stderr, StreamingProcessHandle)+--+-- (r ~ (), r' ~ (), MonadIO m, MonadIO n, i ~ ByteString) => InputSource (ConduitM i o m r, n r')+-- (r ~ (), r' ~ (), MonadIO m, MonadIO n, o ~ ByteString) => OutputSink (ConduitM i o m r, n r')+-- InputSource (ConduitM ByteString o IO ())+-- OutputSink (ConduitM i ByteString IO ())+--+--++++-- | Parser for a value prefixed by a bytestring. Uses skipWhile to make it+-- faster.+genericParser :: forall a . ByteString -> Parser a -> ByteString -> Maybe a+genericParser str parser mplayerLine =+ either (const Nothing) Just $ parseOnly go mplayerLine+ where+ go :: Parser a+ go = do+ -- Skip until we find the first character of the prefix that we are looking for.+ skipWhile (/= C8.head str)+ -- Try to match the prefix. If it matches, run the parser.+ string str *> parser+ -- If it doesn't match, then strip the first character and recurse.+ <|> char (C8.head str) *> go++-- | Parser for the length of the of the media.+getLength :: ByteString -> Maybe Float+getLength = genericParser "ID_LENGTH=" rational++-- | Parser for the filename of the of the media.+getFilename :: ByteString -> Maybe ByteString+getFilename = genericParser "ID_FILENAME=" $ takeWhile1 (notInClass "\n")++-- | Parser for the current location in the media.+getCurPos :: ByteString -> Maybe Float+getCurPos = genericParser "A:" $ skipSpace *> rational++updateLength :: MVar MediaInfo -> ByteString -> IO ()+updateLength mediaInfoMVar mplayerLine = do+ maybeMediaInfo <- tryReadMVar mediaInfoMVar+ case maybeMediaInfo of+ Just (MediaInfo (Just _) _ _ _) -> pure ()+ _ ->+ case getLength mplayerLine of+ Nothing -> pure ()+ Just mediaLength ->+ modifyMVar_ mediaInfoMVar $ updateMediaInfo mediaLength+ where+ updateMediaInfo :: Float -> MediaInfo -> IO MediaInfo+ updateMediaInfo mediaLength mediaInfo =+ pure mediaInfo { mediaInfoLength = Just mediaLength }++updateFilename :: MVar MediaInfo -> ByteString -> IO ()+updateFilename mediaInfoMVar mplayerLine = do+ maybeMediaInfo <- tryReadMVar mediaInfoMVar+ case maybeMediaInfo of+ Just (MediaInfo _ (Just _) _ _) -> pure ()+ _ ->+ case getFilename mplayerLine of+ Nothing -> pure ()+ Just mediaFilename ->+ modifyMVar_ mediaInfoMVar $ updateMediaInfo mediaFilename+ where+ updateMediaInfo :: ByteString -> MediaInfo -> IO MediaInfo+ updateMediaInfo mediaFilename mediaInfo =+ pure mediaInfo { mediaInfoFilename = Just mediaFilename }++updateCurPos :: MVar MediaInfo -> ByteString -> IO ()+updateCurPos mediaInfoMVar mplayerLine =+ maybe (pure ()) (modifyMVar_ mediaInfoMVar . updateMediaInfo) $ getCurPos mplayerLine+ where+ updateMediaInfo :: Float -> MediaInfo -> IO MediaInfo+ updateMediaInfo mediaCurPos mediaInfo =+ pure mediaInfo { mediaInfoCurPos = Just mediaCurPos }++-- | Try to read 3 different things from the mplayer stdout:+--+-- - length of the media+-- - media filename+-- - current position in the media+processMPlayerStdout :: MVar MediaInfo -> ByteString -> IO ()+processMPlayerStdout mediaInfoMVar mplayerLine = do+ updateLength mediaInfoMVar mplayerLine+ updateFilename mediaInfoMVar mplayerLine+ updateCurPos mediaInfoMVar mplayerLine++-- | 'Conduit' that reads in key presses (from stdin), and yields mplayer+-- commands.+--+-- In order for this to work right when hooked up to stdin, stdin should be set+-- to 'NoBuffering'.+sendMPlayerCommands :: ConduitT ByteString ByteString IO ()+sendMPlayerCommands = awaitForever go+ where+ go :: ByteString -> ConduitT ByteString ByteString IO ()+ go inputChar+ | inputChar == "q" = yield "quit\n"+ | inputChar == "p" = yield "pause\n"+ | inputChar == " " = yield "pause\n"+ | inputChar == "\ESC[D" = yield "seek -10\n"+ | inputChar == "\ESC[C" = yield "seek 10\n"+ | inputChar == "\ESC[B" = yield "seek -60\n"+ | inputChar == "\ESC[A" = yield "seek 60\n"+ | inputChar == "\ESC[6~" = yield "seek -600\n"+ | inputChar == "\ESC[5~" = yield "seek 600\n"+ | otherwise =+ liftIO $ print $ "got keypress " <> inputChar <> " but don't know what to do with it"++calculateFullSpotsPath :: Config -> ByteString -> FilePath+calculateFullSpotsPath (Config _ spotsDir _) filename =+ spotsDir </> takeFileName (unpack (decodeUtf8 filename))++-- | Producer that tries to read the filename from the @'MVar' 'MediaInfo'@,+-- and if it succeeds, tries to open the spot file and read in the saved+-- position. Produce it as a value.+setOldLocation :: Config -> MVar MediaInfo -> ConduitT i ByteString IO ()+setOldLocation config mediaInfoMVar = do+ maybeMediaInfo <- liftIO $ tryReadMVar mediaInfoMVar+ case maybeMediaInfo of+ Just (MediaInfo _ _ _ True) -> pure ()+ Just (MediaInfo _ (Just filename) _ False) -> do+ let fullPath = calculateFullSpotsPath config filename+ filecontents <- liftIO $ try $ readFile fullPath+ case filecontents of+ Right oldLocation -> do+ yield $ "seek " <> encodeUtf8 (T.pack oldLocation) <> "\n"+ Left (_ :: IOException) -> pure ()+ liftIO $ modifyMVar_ mediaInfoMVar $ \mediaInfo -> pure mediaInfo { mediaInfoAlreadySetOldLocation = True }+ _ -> setOldLocation config mediaInfoMVar++-- | Run the mplayer process while doing 3 things:+--+-- - Read mplayer's stdout, looking for the length, filename, and current+-- position of the media.+-- - Once the filename has been found, look for a spot file, and if it exists,+-- make mplayer seek to the location.+-- - Take keys from stdin and translate them to mplayer commands. Since mplayer+-- is in slave mode, it can't take in commands like normal.+runMPlayerUpdateMediaInfo :: Config -> MPlayer -> MVar MediaInfo -> IO ()+runMPlayerUpdateMediaInfo config mplayer mediaInfoMVar = do+ -- set stdin to not be buffered so we only get one character at a time+ hSetBuffering IO.stdin NoBuffering++ -- a conduit for sending the old location to mplayer+ let oldLocationToMplayerStdin =+ runConduit $ setOldLocation config mediaInfoMVar .| mplayerStdin mplayer++ -- Read keypresses from stdin, translate to mplayer commands, and pipe to mplayer.+ let stdinToMplayerStdin =+ runConduit $+ stdin .|+ sendMPlayerCommands .|+ mplayerStdin mplayer++ -- Process mplayer's stdout to find filename, length, and current position.+ -- Print mplayer's stdout to our stdout.+ let mplayerStdoutToStdout =+ runConduit $+ mplayerStdout mplayer .|+ iterMC (processMPlayerStdout mediaInfoMVar) .|+ stdout++ -- Print mplayer's stderr to our stderr.+ let mplayerStderrToStderr = runConduit $ mplayerStderr mplayer .| stderr++ -- Handle for controlling the mplayer process.+ let mplayerHandle = mplayerProcHandle mplayer++ -- Run all conduits concurrently.+ runConcurrently $+ Concurrently mplayerStdoutToStdout *>+ Concurrently mplayerStderrToStderr *>+ Concurrently oldLocationToMplayerStdin *>+ Concurrently stdinToMplayerStdin *>+ Concurrently (waitForStreamingProcess mplayerHandle >>= exitWith)++-- | Create the .mplayer-spots/ and spots/ directories from the config file.+createMPlayerSpotsDir :: Config -> IO ()+createMPlayerSpotsDir (Config rcDir spotsDir _) = do+ createDirectoryIfMissing True rcDir+ createDirectoryIfMissing True spotsDir++-- | Write out a spot file to the spots directory if all the required fields+-- have been filled in the MediaInfo, and if our current position in the media+-- file is not too early or not too late.+writeSpotFile :: Config -> MVar MediaInfo -> IO ()+writeSpotFile config@(Config _ _ ignoreLength) mediaInfoMVar = do+ maybeMediaInfo <- tryReadMVar mediaInfoMVar+ case maybeMediaInfo of+ Just (MediaInfo (Just mediaLength) (Just filename) (Just exitPos) _) -> do+ let spotFilename = calculateFullSpotsPath config filename+ writeSpotFile' mediaLength spotFilename exitPos+ _ -> putStrLn "When exiting, do not currently have all fields of media info, so cannot write out spot file."+ where+ -- | Check that the length is not too early or too late. If it is not,+ -- then write out the spot file.+ writeSpotFile' :: Float -> FilePath -> Float -> IO ()+ writeSpotFile' mediaLength spotFilename exitPos+ | exitPos <= ignoreLength = do+ putStrLn $ "exit position is " <> show exitPos <> " seconds so not writing spot file (not far enough)"+ | exitPos >= (mediaLength - ignoreLength) = do+ putStrLn $ "exit position is " <> show exitPos <> " seconds so not writing spot file (too close to end)"+ removeOldSpotFile spotFilename+ | otherwise =+ writeFloatToFile spotFilename (max (exitPos - 10) 0)++ -- | Write a Float to a FilePath.+ writeFloatToFile :: FilePath -> Float -> IO ()+ writeFloatToFile spotFilename exitPos = do+ putStrLn $ "writing to file: " <> spotFilename <> " (" <> show exitPos <> ")"+ writeFile spotFilename $ show exitPos++ -- | Remove a file and ignore errors (like if the file doesn't exist).+ removeOldSpotFile :: FilePath -> IO ()+ removeOldSpotFile =+ void . (try :: IO () -> IO (Either IOException ())) . removeFile++defaultMain :: IO ()+defaultMain = do+ -- read in program arguments+ programArgs <- getArgs++ -- create the config we will be using+ config <- defaultConfig++ -- create the .mplayer-spots directory if it doesn't exist+ createMPlayerSpotsDir config++ -- create the mplayer process+ mplayerProcess <- createMPlayerProcess programArgs++ -- create the MediaInfo MVar we will be using to do concurrent stuff+ mediaInfoMVar <- newMVar defaultMediaInfo++ finally (runMPlayerUpdateMediaInfo config mplayerProcess mediaInfoMVar) $+ -- write the spot file after exiting+ writeSpotFile config mediaInfoMVar