{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Simplex.Chat.Terminal.Notification (Notification (..), initializeNotifications) where

import Control.Monad (void)
import Data.List (isInfixOf)
import Data.Map (Map, fromList)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isJust)
import Data.Text (Text)
import qualified Data.Text as T
import Simplex.Messaging.Util (catchAll_)
import System.Directory (createDirectoryIfMissing, doesFileExist, findExecutable, getAppUserDataDirectory)
import System.FilePath (combine)
import System.Info (os)
import System.Process (readCreateProcess, shell)

data Notification = Notification {Notification -> Text
title :: Text, Notification -> Text
text :: Text}

initializeNotifications :: IO (Notification -> IO ())
initializeNotifications :: IO (Notification -> IO ())
initializeNotifications =
  (Notification -> IO ()) -> Notification -> IO ()
forall a. (a -> IO ()) -> a -> IO ()
hideException ((Notification -> IO ()) -> Notification -> IO ())
-> IO (Notification -> IO ()) -> IO (Notification -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case String
os of
    String
"darwin" -> (Notification -> IO ()) -> IO (Notification -> IO ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Notification -> IO ()) -> IO (Notification -> IO ()))
-> (Notification -> IO ()) -> IO (Notification -> IO ())
forall a b. (a -> b) -> a -> b
$ (Notification -> Text) -> Notification -> IO ()
notify Notification -> Text
macScript
    String
"mingw32" -> IO (Notification -> IO ())
initWinNotify
    String
"linux" ->
      String -> IO Bool
doesFileExist String
"/proc/sys/kernel/osrelease" IO Bool
-> (Bool -> IO (Notification -> IO ()))
-> IO (Notification -> IO ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
False -> IO (Notification -> IO ())
initLinuxNotify
        Bool
True -> do
          String
v <- String -> IO String
readFile String
"/proc/sys/kernel/osrelease"
          if String
"Microsoft" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
v Bool -> Bool -> Bool
|| String
"WSL" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
v
            then IO (Notification -> IO ())
initWslNotify
            else IO (Notification -> IO ())
initLinuxNotify
    String
_ -> (Notification -> IO ()) -> IO (Notification -> IO ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Notification -> IO ()
noNotifications

noNotifications :: Notification -> IO ()
noNotifications :: Notification -> IO ()
noNotifications Notification
_ = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

hideException :: (a -> IO ()) -> (a -> IO ())
hideException :: forall a. (a -> IO ()) -> a -> IO ()
hideException a -> IO ()
f a
a = a -> IO ()
f a
a IO () -> IO () -> IO ()
forall a. IO a -> IO a -> IO a
`catchAll_` () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

initLinuxNotify :: IO (Notification -> IO ())
initLinuxNotify :: IO (Notification -> IO ())
initLinuxNotify = do
  Bool
found <- Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
findExecutable String
"notify-send"
  (Notification -> IO ()) -> IO (Notification -> IO ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Notification -> IO ()) -> IO (Notification -> IO ()))
-> (Notification -> IO ()) -> IO (Notification -> IO ())
forall a b. (a -> b) -> a -> b
$ if Bool
found then (Notification -> Text) -> Notification -> IO ()
notify Notification -> Text
linuxScript else Notification -> IO ()
noNotifications

notify :: (Notification -> Text) -> Notification -> IO ()
notify :: (Notification -> Text) -> Notification -> IO ()
notify Notification -> Text
script Notification
notification =
  IO String -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO String -> IO ()) -> IO String -> IO ()
forall a b. (a -> b) -> a -> b
$ CreateProcess -> String -> IO String
readCreateProcess (String -> CreateProcess
shell (String -> CreateProcess)
-> (Text -> String) -> Text -> CreateProcess
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> CreateProcess) -> Text -> CreateProcess
forall a b. (a -> b) -> a -> b
$ Notification -> Text
script Notification
notification) String
""

linuxScript :: Notification -> Text
linuxScript :: Notification -> Text
linuxScript Notification {Text
title :: Notification -> Text
title :: Text
title, Text
text :: Notification -> Text
text :: Text
text} = Text
"notify-send '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
linuxEscape Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
linuxEscape Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"

linuxEscape :: Text -> Text
linuxEscape :: Text -> Text
linuxEscape = Map Char Text -> Text -> Text
replaceAll (Map Char Text -> Text -> Text) -> Map Char Text -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [(Char, Text)] -> Map Char Text
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(Char
'\'', Text
"'\\''")]

macScript :: Notification -> Text
macScript :: Notification -> Text
macScript Notification {Text
title :: Notification -> Text
title :: Text
title, Text
text :: Notification -> Text
text :: Text
text} = Text
"osascript -e 'display notification \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
macEscape Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" with title \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
macEscape Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"'"

macEscape :: Text -> Text
macEscape :: Text -> Text
macEscape = Map Char Text -> Text -> Text
replaceAll (Map Char Text -> Text -> Text) -> Map Char Text -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [(Char, Text)] -> Map Char Text
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(Char
'"', Text
"\\\""), (Char
'\'', Text
"")]

initWslNotify :: IO (Notification -> IO ())
initWslNotify :: IO (Notification -> IO ())
initWslNotify = (Notification -> Text) -> Notification -> IO ()
notify ((Notification -> Text) -> Notification -> IO ())
-> (String -> Notification -> Text)
-> String
-> Notification
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Notification -> Text
wslScript (String -> Notification -> IO ())
-> IO String -> IO (Notification -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
savePowershellScript

wslScript :: FilePath -> Notification -> Text
wslScript :: String -> Notification -> Text
wslScript String
path Notification {Text
title :: Notification -> Text
title :: Text
title, Text
text :: Notification -> Text
text :: Text
text} = Text
"powershell.exe \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" \\\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
wslEscape Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\\" \\\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
wslEscape Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\\"\""

wslEscape :: Text -> Text
wslEscape :: Text -> Text
wslEscape = Map Char Text -> Text -> Text
replaceAll (Map Char Text -> Text -> Text) -> Map Char Text -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [(Char, Text)] -> Map Char Text
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(Char
'`', Text
"\\`\\`"), (Char
'\\', Text
"\\\\"), (Char
'"', Text
"\\`\\\"")]

initWinNotify :: IO (Notification -> IO ())
initWinNotify :: IO (Notification -> IO ())
initWinNotify = (Notification -> Text) -> Notification -> IO ()
notify ((Notification -> Text) -> Notification -> IO ())
-> (String -> Notification -> Text)
-> String
-> Notification
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Notification -> Text
winScript (String -> Notification -> IO ())
-> IO String -> IO (Notification -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
savePowershellScript

winScript :: FilePath -> Notification -> Text
winScript :: String -> Notification -> Text
winScript String
path Notification {Text
title :: Notification -> Text
title :: Text
title, Text
text :: Notification -> Text
text :: Text
text} = Text
"powershell.exe \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
winRemoveQuotes Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
winRemoveQuotes Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'\""

winRemoveQuotes :: Text -> Text
winRemoveQuotes :: Text -> Text
winRemoveQuotes = Map Char Text -> Text -> Text
replaceAll (Map Char Text -> Text -> Text) -> Map Char Text -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [(Char, Text)] -> Map Char Text
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(Char
'`', Text
""), (Char
'\'', Text
""), (Char
'"', Text
"")]

replaceAll :: Map Char Text -> Text -> Text
replaceAll :: Map Char Text -> Text -> Text
replaceAll Map Char Text
rules = (Char -> Text) -> Text -> Text
T.concatMap ((Char -> Text) -> Text -> Text) -> (Char -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \Char
c -> Char -> Text
T.singleton Char
c Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
`fromMaybe` Char -> Map Char Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Char
c Map Char Text
rules

savePowershellScript :: IO FilePath
savePowershellScript :: IO String
savePowershellScript = do
  String
appDir <- String -> IO String
getAppUserDataDirectory String
"simplex"
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
appDir
  let psScript :: String
psScript = String -> String -> String
combine String
appDir String
"win-toast-notify.ps1"
  String -> String -> IO ()
writeFile
    String
psScript
    String
"[Windows.UI.Notifications.ToastNotificationManager, Windows.UI.Notifications, ContentType = WindowsRuntime] > $null\n\
    \$Template = [Windows.UI.Notifications.ToastNotificationManager]::GetTemplateContent([Windows.UI.Notifications.ToastTemplateType]::ToastText02)\n\
    \$RawXml = [xml] $Template.GetXml()\n\
    \($RawXml.toast.visual.binding.text|where {$_.id -eq \"1\"}).AppendChild($RawXml.CreateTextNode($args[0])) > $null\n\
    \($RawXml.toast.visual.binding.text|where {$_.id -eq \"2\"}).AppendChild($RawXml.CreateTextNode($args[1])) > $null\n\
    \$SerializedXml = New-Object Windows.Data.Xml.Dom.XmlDocument\n\
    \$SerializedXml.LoadXml($RawXml.OuterXml)\n\
    \$Toast = [Windows.UI.Notifications.ToastNotification]::new($SerializedXml)\n\
    \$Toast.Tag = \"simplex-chat\"\n\
    \$Toast.Group = \"simplex-chat\"\n\
    \$Toast.ExpirationTime = [DateTimeOffset]::Now.AddMinutes(1)\n\
    \$Notifier = [Windows.UI.Notifications.ToastNotificationManager]::CreateToastNotifier(\"PowerShell\")\n\
    \$Notifier.Show($Toast);\n"
  String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
psScript