From 413dde1f9a12da0449cd4356f3ff7566cd812ec9 Mon Sep 17 00:00:00 2001
From: jao <jao@gnu.org>
Date: Thu, 5 Dec 2019 01:15:56 +0000
Subject: GMPDP, an example of a plugin reading json

---
 src/lib/GMPDP.hs    | 96 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 xmobar-config.cabal |  6 ++--
 2 files changed, 100 insertions(+), 2 deletions(-)
 create mode 100644 src/lib/GMPDP.hs

diff --git a/src/lib/GMPDP.hs b/src/lib/GMPDP.hs
new file mode 100644
index 0000000..370e360
--- /dev/null
+++ b/src/lib/GMPDP.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
+
+-- https://www.schoolofhaskell.com/school/starting-with-haskell/libraries-and-frameworks/text-manipulation/json
+
+module GMPDP where
+
+import Data.Aeson
+import Data.Text
+import Control.Applicative
+import Control.Monad
+import qualified Data.ByteString.Lazy as B
+import Network.HTTP.Conduit (simpleHttp)
+import GHC.Generics
+
+import Xmobar
+
+import Control.Monad (when)
+import Control.Concurrent.STM
+import Control.Exception (SomeException (..), handle, evaluate)
+
+import System.INotify (Event(..), EventVariety(..), initINotify, addWatch)
+
+import qualified Data.ByteString.Char8 as BS (ByteString, pack)
+
+
+-- | Type of each JSON entry in record syntax.
+data Song =
+  Song { title :: !String
+       , artist :: !String
+       , album :: !String
+       } deriving (Eq,Show,Generic)
+
+data PlayTime =
+  PlayTime { current :: !Int
+           , total :: !Int
+           } deriving (Eq,Show,Generic)
+
+data GMPDPStatus =
+  GMPDPStatus { song :: Song
+              , time :: PlayTime
+              } deriving (Eq,Show,Generic)
+
+-- Instances to convert our type to/from JSON.
+
+instance FromJSON Song
+instance FromJSON PlayTime
+instance FromJSON GMPDPStatus
+
+-- | Location of the local copy, in case you have it,
+--   of the JSON file.
+jsonFile :: FilePath
+jsonFile = "/home/jao/.config/Google Play Music Desktop Player/json_store/playback.json"
+
+getJSON :: IO B.ByteString
+getJSON = B.readFile jsonFile
+
+getGMPDPStatus :: IO (Maybe GMPDPStatus)
+getGMPDPStatus = do
+    s <- (eitherDecode <$> getJSON) :: IO (Either String GMPDPStatus)
+    case s of
+      Left _ -> return Nothing
+      Right r -> return $ Just r
+
+data GMPDP = GMPDP String deriving (Show,Read,Generic)
+
+handleNotification :: TVar (Maybe GMPDPStatus) -> Event -> IO ()
+handleNotification v _ =
+  getGMPDPStatus >>= \s -> atomically $ writeTVar v s
+
+formatStatus Nothing = ""
+formatStatus (Just s) =
+  fmtt (current $ time s) ++ "/" ++ fmtt (total $ time s) ++
+  " " ++ (title $ song s) ++ " <fc=sienna4>" ++ (album $ song s) ++ "</fc>" ++
+  " " ++ (artist $ song s)
+  where fmtt ms = let s = ms `div` 1000
+                      sr x = if x < 10 then "0" ++ show x else show x
+                  in sr (s `div` 60) ++ ":" ++ sr (s `mod` 60)
+
+changeLoop :: Eq a => STM a -> (a -> IO ()) -> IO ()
+changeLoop s f = atomically s >>= go
+ where
+    go old = do
+        f old
+        go =<< atomically (do
+            new <- s
+            guard (new /= old)
+            return new)
+
+instance Exec GMPDP where
+  alias (GMPDP a) = a
+  start (GMPDP _) cb = do
+    i <- initINotify
+    s <- getGMPDPStatus
+    v <- newTVarIO s
+    addWatch i [CloseWrite] (BS.pack jsonFile) (handleNotification v)
+    changeLoop (readTVar v) $ \s -> cb (formatStatus s)
diff --git a/xmobar-config.cabal b/xmobar-config.cabal
index 841206e..be2bdee 100644
--- a/xmobar-config.cabal
+++ b/xmobar-config.cabal
@@ -13,8 +13,10 @@ extra-source-files:
 
 library
   hs-source-dirs: src/lib
-  exposed-modules: Config, Monitors, Bottom, Music
-  build-depends: base >=4.7 && <5, async > 2.2, stm >= 2.5, xmobar
+  exposed-modules: Config, Monitors, Bottom, Music, GMPDP
+  build-depends: base >=4.7 && <5, async > 2.2, stm >= 2.5,
+                 aeson, text, bytestring, http-conduit,
+                 hinotify, xmobar
   other-modules: Paths_xmobar_config
   default-language: Haskell2010
 
-- 
cgit v1.2.3