module System.MapleSSH (maple, mapleWithArgs) where

import Data.Maybe(fromMaybe)
import Data.Char(isSpace)
import System.IO (hPutStrLn, hClose, hGetContents)
import System.Process (proc, CreateProcess(..), StdStream(CreatePipe), createProcess, waitForProcess)
import System.Environment (lookupEnv)
import System.Exit (ExitCode(ExitSuccess))

-- Default values for SSH environment variables
defSSH, defUser, defServer, defCommand :: String
defSSH :: String
defSSH     = String
"/usr/bin/ssh"
defUser :: String
defUser    = String
"ppaml"
defServer :: String
defServer  = String
"karst.uits.iu.edu"
defCommand :: String
defCommand = String
"maple"
-- On the server side, ~/.modules should load maple/18, and ~/.mapleinit
-- should point to ~/hakaru/maple (updated by hakaru/maple/MapleUpdate.hs)

envVarsSSH :: IO (String, String, String, String)
envVarsSSH :: IO (String, String, String, String)
envVarsSSH = do
    String
ssh     <- String -> String -> IO String
get String
"MAPLE_SSH"     String
defSSH
    String
user    <- String -> String -> IO String
get String
"MAPLE_USER"    String
defUser
    String
server  <- String -> String -> IO String
get String
"MAPLE_SERVER"  String
defServer
    String
command <- String -> String -> IO String
get String
"MAPLE_COMMAND" String
defCommand
    (String, String, String, String)
-> IO (String, String, String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
ssh, String
user, String
server, String
command)
    where get :: String -> String -> IO String
get String
name String
def = (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
def) (String -> IO (Maybe String)
lookupEnv String
name)

processWithArgs :: [String] -> IO CreateProcess
processWithArgs :: [String] -> IO CreateProcess
processWithArgs [String]
args = do
    Maybe String
bin <- String -> IO (Maybe String)
lookupEnv String
"LOCAL_MAPLE"
    case Maybe String
bin of
        Just String
b  -> CreateProcess -> IO CreateProcess
forall (m :: * -> *) a. Monad m => a -> m a
return (CreateProcess -> IO CreateProcess)
-> CreateProcess -> IO CreateProcess
forall a b. (a -> b) -> a -> b
$ String -> [String] -> CreateProcess
proc String
b [String]
args 
        Maybe String
Nothing -> 
          do (String
ssh, String
user, String
server, String
command) <- IO (String, String, String, String)
envVarsSSH
             let commands :: String
commands = String
command String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:) [String]
args
             CreateProcess -> IO CreateProcess
forall (m :: * -> *) a. Monad m => a -> m a
return (CreateProcess -> IO CreateProcess)
-> CreateProcess -> IO CreateProcess
forall a b. (a -> b) -> a -> b
$ String -> [String] -> CreateProcess
proc String
ssh [String
"-l" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
user, String
server, String
commands]

maple :: String -> IO String
maple :: String -> IO String
maple = (String -> [String] -> IO String)
-> [String] -> String -> IO String
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> IO String
mapleWithArgs [String
"-q", String
"-t"]

mapleWithArgs :: String -> [String] -> IO String
mapleWithArgs :: String -> [String] -> IO String
mapleWithArgs String
cmd [String]
args = do
    CreateProcess
p <- [String] -> IO CreateProcess
processWithArgs [String]
args 
    (Just Handle
inH, Just Handle
outH, Maybe Handle
Nothing, ProcessHandle
p') <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
p { std_in :: StdStream
std_in = StdStream
CreatePipe, std_out :: StdStream
std_out = StdStream
CreatePipe, close_fds :: Bool
close_fds = Bool
True }
    Handle -> String -> IO ()
hPutStrLn Handle
inH (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
    Handle -> IO ()
hClose Handle
inH
    String
c <- Handle -> IO String
hGetContents Handle
outH
    String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
c Int -> IO () -> IO ()
`seq` Handle -> IO ()
hClose Handle
outH
    ExitCode
exit <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p'
    case ExitCode
exit of
      ExitCode
ExitSuccess -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String
trim String
c
      ExitCode
_           -> String -> IO String
forall a. HasCallStack => String -> a
error (String
"maple returned exit code: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExitCode -> String
forall a. Show a => a -> String
show ExitCode
exit)

trim :: String -> String
trim :: String -> String
trim = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace