module MSU.Context
    ( Context(..)
    , getContext
    , Display(..)
    , getDisplays
    , Wifi(..)
    , getWifi
    )
where

import Data.Char (isSpace)
import MSU.Xrandr.Parse
import System.Process (readProcess)
import UnliftIO.Exception (handleAny)

data Context = Context
   { Context -> [Display]
displays :: [Display]
   , Context -> Maybe Wifi
wifi :: Maybe Wifi
   }

newtype Wifi = Wifi
    { Wifi -> String
essid :: String
    }

getContext :: IO Context
getContext :: IO Context
getContext = [Display] -> Maybe Wifi -> Context
Context ([Display] -> Maybe Wifi -> Context)
-> IO [Display] -> IO (Maybe Wifi -> Context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Display]
getDisplays IO (Maybe Wifi -> Context) -> IO (Maybe Wifi) -> IO Context
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Maybe Wifi)
getWifi

getDisplays :: IO [Display]
getDisplays :: IO [Display]
getDisplays = String -> IO [Display]
forall (m :: * -> *). MonadIO m => String -> m [Display]
parseXrandrUnsafe (String -> IO [Display]) -> IO String -> IO [Display]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> [String] -> String -> IO String
readProcess String
"xrandr" [String
"--query"] String
""

getWifi :: IO (Maybe Wifi)
getWifi :: IO (Maybe Wifi)
getWifi = do
    String
x <- IO String
getEssid
    Maybe Wifi -> IO (Maybe Wifi)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Wifi -> IO (Maybe Wifi)) -> Maybe Wifi -> IO (Maybe Wifi)
forall a b. (a -> b) -> a -> b
$ if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x then Maybe Wifi
forall a. Maybe a
Nothing else Wifi -> Maybe Wifi
forall a. a -> Maybe a
Just (Wifi -> Maybe Wifi) -> Wifi -> Maybe Wifi
forall a b. (a -> b) -> a -> b
$ Wifi :: String -> Wifi
Wifi { essid :: String
essid = String
x }

-- TODO: do this "correctly", whatever that would be
getEssid :: IO String
getEssid :: IO String
getEssid = (SomeException -> IO String) -> IO String -> IO String
forall (m :: * -> *) a.
MonadUnliftIO m =>
(SomeException -> m a) -> m a -> m a
handleAny (\SomeException
_ -> String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"") (IO String -> IO String) -> IO String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String
trim (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess
    String
"sh"
    [String
"-c", String
"iwconfig 2>/dev/null | " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
sed]
    String
""
  where
    sed :: String
sed = String
"sed '/^.* ESSID:\"\\([^\\\"]*\\)\".*$/!d; s//\\1/'"

    trim :: String -> String
    trim :: String -> String
trim = String -> String
f (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f where f :: String -> String
f = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse