summaryrefslogtreecommitdiff
path: root/accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs
diff options
context:
space:
mode:
Diffstat (limited to 'accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs')
-rw-r--r--accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs127
1 files changed, 127 insertions, 0 deletions
diff --git a/accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs b/accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs
new file mode 100644
index 00000000..e6accdcc
--- /dev/null
+++ b/accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs
@@ -0,0 +1,127 @@
1{-# LANGUAGE DeriveGeneric, OverloadedLists, OverloadedStrings, ViewPatterns, ExistentialQuantification, MultiWayIf #-}
2
3module XMonad.Mpv
4 ( MpvCommand(..), MpvResponse(..), MpvException(..)
5 , mpv
6 , mpvDir
7 , mpvAll, mpvOne
8 , mpvResponse
9 ) where
10
11import Data.Aeson
12
13import Data.Monoid
14
15import Network.Socket hiding (recv)
16import Network.Socket.ByteString
17
18import qualified Data.ByteString as BS
19import qualified Data.ByteString.Char8 as CBS
20import qualified Data.ByteString.Lazy as LBS
21
22import GHC.Generics (Generic)
23import Data.Typeable (Typeable)
24import Data.String (IsString(..))
25
26import Control.Exception
27
28import System.IO.Temp (getCanonicalTemporaryDirectory)
29
30import Control.Monad
31import Control.Exception (bracket)
32import Control.Monad.IO.Class (MonadIO(..))
33
34import System.FilePath
35import System.Directory (getDirectoryContents)
36
37import Data.List
38import Data.Either
39import Data.Maybe
40
41import Debug.Trace
42
43
44data MpvCommand
45 = forall a. ToJSON a => MpvSetProperty String a
46 | MpvGetProperty String
47data MpvResponse
48 = MpvError String
49 | MpvSuccess (Maybe Value)
50 deriving (Read, Show, Generic, Eq)
51data MpvException = MpvException String
52 | MpvNoValue
53 | MpvNoParse String
54 deriving (Generic, Typeable, Read, Show)
55instance Exception MpvException
56
57
58instance ToJSON MpvCommand where
59 toJSON (MpvSetProperty name val) = Array ["set_property", fromString name, toJSON val]
60 toJSON (MpvGetProperty name) = Array ["get_property", fromString name]
61
62instance FromJSON MpvResponse where
63 parseJSON = withObject "response object" $ \obj -> do
64 mval <- obj .:? "data"
65 err <- obj .: "error"
66
67 let ret
68 | err == "success" = MpvSuccess mval
69 | otherwise = MpvError err
70
71 return ret
72
73mpvSocket :: FilePath -> (Socket -> IO a) -> IO a
74mpvSocket sockPath = withSocketsDo . bracket mkSock close
75 where
76 mkSock = do
77 sock <- socket AF_UNIX Stream defaultProtocol
78 connect sock $ SockAddrUnix (traceId sockPath)
79 return sock
80
81mpvResponse :: FromJSON v => MpvResponse -> IO v
82mpvResponse (MpvError str) = throwIO $ MpvException str
83mpvResponse (MpvSuccess Nothing) = throwIO MpvNoValue
84mpvResponse (MpvSuccess (Just v)) = case fromJSON v of
85 Success v' -> return v'
86 Error str -> throwIO $ MpvNoParse str
87
88mpv :: FilePath -> MpvCommand -> IO MpvResponse
89mpv sockPath cmd = mpvSocket sockPath $ \sock -> do
90 let message = (`BS.append` "\n") . LBS.toStrict . encode $ Object [("command", toJSON cmd)]
91 traceIO $ show message
92 sendAll sock message
93 let recvAll = do
94 prefix <- recv sock 4096
95 if
96 | (prefix', rest) <- CBS.break (== '\n') prefix
97 , not (BS.null rest) -> return prefix'
98 | BS.null prefix -> return prefix
99 | otherwise -> BS.append prefix <$> recvAll
100 response <- recvAll
101 traceIO $ show response
102 either (ioError . userError) return . traceShowId $ eitherDecodeStrict' response
103
104mpvDir :: Exception e => FilePath -> (FilePath -> [(FilePath, Either e MpvResponse)] -> Maybe MpvCommand) -> IO [(FilePath, Either e MpvResponse)]
105mpvDir dir step = do
106 socks <- filter (".sock" `isSuffixOf`) <$> getDirectoryContents dir
107 go [] socks
108 where
109 go acc [] = return acc
110 go acc (sock:socks)
111 | Just cmd <- step sock acc = do
112 res <- try $ mpv (dir </> sock) cmd
113 go ((sock, res) : acc) socks
114 | otherwise =
115 go acc socks
116
117mpvAll :: FilePath -> MpvCommand -> IO [MpvResponse]
118mpvAll dir cmd = do
119 results <- map snd <$> (mpvDir dir (\_ _ -> Just cmd) :: IO [(FilePath, Either SomeException MpvResponse)])
120 mapM (either throwIO return) results
121
122mpvOne :: FilePath -> MpvCommand -> IO (Maybe MpvResponse)
123mpvOne dir cmd = listToMaybe . snd . partitionEithers . map snd <$> (mpvDir dir step :: IO [(FilePath, Either SomeException MpvResponse)])
124 where
125 step _ results
126 | any (isRight . snd) results = Nothing
127 | otherwise = Just cmd