{-# Language OverloadedStrings #-}
{-|
Module      : Client.Configuration.Notifications
Description : Options for running commands to notify users
Copyright   : (c) TheDaemoness, 2023
License     : ISC
Maintainer  : emertens@gmail.com
-}
module Client.Configuration.Notifications ( NotifyWith(..), notifyCmd, notifySpec, notifyWithDefault ) where

import           Config.Schema (ValueSpec, atomSpec, nonemptySpec, stringSpec, (<!>))
import qualified Data.Text.Lazy as LText
import           System.Process.Typed (ProcessConfig, proc, setEnv)
import           System.Info (os)
import qualified Data.List.NonEmpty as NonEmpty

data NotifyWith
  = NotifyWithCustom [String]
  | NotifyWithNotifySend
  | NotifyWithOsaScript
  | NotifyWithTerminalNotifier
  deriving Int -> NotifyWith -> ShowS
[NotifyWith] -> ShowS
NotifyWith -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotifyWith] -> ShowS
$cshowList :: [NotifyWith] -> ShowS
show :: NotifyWith -> String
$cshow :: NotifyWith -> String
showsPrec :: Int -> NotifyWith -> ShowS
$cshowsPrec :: Int -> NotifyWith -> ShowS
Show

notifyCmd :: NotifyWith -> Maybe ((LText.Text, LText.Text) -> ProcessConfig () () ())
notifyCmd :: NotifyWith -> Maybe ((Text, Text) -> ProcessConfig () () ())
notifyCmd (NotifyWithCustom (String
cmd:[String]
args)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \(Text
header, Text
body) ->
  String -> [String] -> ProcessConfig () () ()
proc String
cmd ([String]
args forall a. [a] -> [a] -> [a]
++ [Text -> String
LText.unpack Text
header, Text -> String
LText.unpack Text
body])
notifyCmd NotifyWith
NotifyWithNotifySend = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \(Text
header, Text
body) ->
  String -> [String] -> ProcessConfig () () ()
proc String
"notify-send" [String
"-a", String
"glirc", Text -> String
LText.unpack Text
header, Text -> String
LText.unpack Text
body]
notifyCmd NotifyWith
NotifyWithOsaScript = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \(Text
header, Text
body) ->
  forall stdin stdout stderr.
[(String, String)]
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setEnv [(String
"_GLIRC_NOTIF_HEADER", Text -> String
LText.unpack Text
header), (String
"_GLIRC_NOTIF_BODY", Text -> String
LText.unpack Text
body)] forall a b. (a -> b) -> a -> b
$
  String -> [String] -> ProcessConfig () () ()
proc String
"osascript" [String
"-e", String
script]
  where
    script :: String
script = String
"display notification (system attribute \"_GLIRC_NOTIF_BODY\") with title \"glirc\" subtitle (system attribute \"_GLIRC_NOTIF_HEADER\")"
notifyCmd NotifyWith
NotifyWithTerminalNotifier = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \(Text
header, Text
body) ->
  String -> [String] -> ProcessConfig () () ()
proc String
"terminal-notifier" [String
"-title", String
"glirc", String
"-subtitle", Text -> String
LText.unpack Text
header, String
"-message", String
"\\" forall a. Semigroup a => a -> a -> a
<> Text -> String
LText.unpack Text
body]
notifyCmd NotifyWith
_ = forall a. Maybe a
Nothing

notifyWithDefault :: NotifyWith
notifyWithDefault :: NotifyWith
notifyWithDefault = case String
os of
  String
"darwin" -> NotifyWith
NotifyWithOsaScript
  String
"linux"  -> NotifyWith
NotifyWithNotifySend
  String
_        -> [String] -> NotifyWith
NotifyWithCustom []

notifySpec :: ValueSpec NotifyWith
notifySpec :: ValueSpec NotifyWith
notifySpec =
  [String] -> NotifyWith
NotifyWithCustom []        forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"no"  forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
  NotifyWith
notifyWithDefault          forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"yes" forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
  NotifyWith
NotifyWithNotifySend       forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"notify-send" forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
  NotifyWith
NotifyWithOsaScript        forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"osascript" forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
  NotifyWith
NotifyWithTerminalNotifier forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ValueSpec ()
atomSpec Text
"terminal-notifier" forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!>
  [String] -> NotifyWith
NotifyWithCustom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NonEmpty.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ValueSpec a -> ValueSpec (NonEmpty a)
nonemptySpec ValueSpec String
stringSpec