{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module MSU.Monitors ( Monitors(..) , readMonitorsFileThrow , readMonitorsYaml , findMonitors -- * Create , createMonitor , writeMonitorsFile ) where import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Aeson import Data.Bifunctor (first) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.List (find) import qualified Data.Yaml as Yaml import GHC.Generics (Generic) import MSU.Context (Context) import qualified MSU.Context as Context import MSU.Match import qualified MSU.Xrandr.Parse as Xrandr import System.Directory (doesFileExist) data Monitors = Monitors { name :: String , match :: MatchContext , exec :: String } deriving stock Generic deriving anyclass (FromJSON, ToJSON) data MatchContext = MatchContext { displays :: Maybe (Match [String]) , wifi :: Maybe (Match String) } deriving stock Generic deriving anyclass (FromJSON, ToJSON) readMonitorsFileThrow :: MonadIO m => FilePath -> m [Monitors] readMonitorsFileThrow = Yaml.decodeFileThrow readMonitorsYaml :: ByteString -> Either String [Monitors] readMonitorsYaml = first show . Yaml.decodeEither' findMonitors :: Context -> [Monitors] -> Maybe Monitors findMonitors context = find $ \Monitors {..} -> let connected = filter Xrandr.connected $ Context.displays context names = map Xrandr.name connected mEssid = Context.essid <$> Context.wifi context in displays match `matches` names && wifi match `matchesMaybe` mEssid createMonitor :: Context -> Monitors createMonitor context = Monitors { name = "created" , match = MatchContext { displays = Just $ Eq connectedNames , wifi = Eq . Context.essid <$> Context.wifi context } , exec = unwords $ ("xrandr" :) $ concatMap xrandrArg $ Context.displays context } where connectedNames = map Xrandr.name $ filter Xrandr.connected $ Context.displays context xrandrArg display = ["--output", Xrandr.name display] <> if Xrandr.connected display then xrandrMode display else [] xrandrMode display = case Xrandr.modes display of ((x, y) : _) -> ["--mode", show x <> "x" <> show y] _ -> [] writeMonitorsFile :: MonadIO m => FilePath -> Monitors -> m () writeMonitorsFile path monitors = liftIO $ do exists <- doesFileExist path if exists then BS.appendFile path $ prefix <> encoded else BS.writeFile path encoded where prefix = "\n# TODO: created automatically\n" encoded = Yaml.encode [monitors]