{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Futhark.Server
(
Server,
ServerCfg (..),
newServerCfg,
withServer,
Cmd,
CmdFailure (..),
VarName,
TypeName,
EntryName,
InputType (..),
OutputType (..),
cmdRestore,
cmdStore,
cmdCall,
cmdFree,
cmdRename,
cmdInputs,
cmdOutputs,
cmdClear,
cmdTypes,
cmdEntryPoints,
cmdNew,
cmdProject,
cmdFields,
cmdReport,
cmdPauseProfiling,
cmdUnpauseProfiling,
cmdSetTuningParam,
cmdTuningParams,
cmdTuningParamClass,
cmdMaybe,
cmdEither,
startServer,
stopServer,
sendCommand,
)
where
import Control.Exception
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import System.Directory (removeFile)
import System.Exit
import System.IO hiding (stdin, stdout)
import System.IO.Temp (getCanonicalTemporaryDirectory)
import qualified System.Process as P
type Cmd = Text
data Server = Server
{ Server -> Handle
serverStdin :: Handle,
Server -> Handle
serverStdout :: Handle,
Server -> [Char]
serverErrLog :: FilePath,
Server -> ProcessHandle
serverProc :: P.ProcessHandle,
Server -> Text -> Text -> IO ()
serverOnLine :: Cmd -> Text -> IO (),
Server -> Bool
serverDebug :: Bool
}
data ServerCfg = ServerCfg
{
ServerCfg -> [Char]
cfgProg :: FilePath,
ServerCfg -> [[Char]]
cfgProgOpts :: [String],
ServerCfg -> Bool
cfgDebug :: Bool,
ServerCfg -> Text -> Text -> IO ()
cfgOnLine :: Cmd -> Text -> IO ()
}
newServerCfg :: FilePath -> [String] -> ServerCfg
newServerCfg :: [Char] -> [[Char]] -> ServerCfg
newServerCfg [Char]
prog [[Char]]
opts =
ServerCfg
{ cfgProg :: [Char]
cfgProg = [Char]
prog,
cfgProgOpts :: [[Char]]
cfgProgOpts = [[Char]]
opts,
cfgDebug :: Bool
cfgDebug = Bool
False,
cfgOnLine :: Text -> Text -> IO ()
cfgOnLine = \Text
_ Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
}
startServer :: ServerCfg -> IO Server
startServer :: ServerCfg -> IO Server
startServer (ServerCfg [Char]
prog [[Char]]
options Bool
debug Text -> Text -> IO ()
on_line_f) = do
[Char]
tmpdir <- IO [Char]
getCanonicalTemporaryDirectory
([Char]
err_log_f, Handle
err_log_h) <- [Char] -> [Char] -> IO ([Char], Handle)
openTempFile [Char]
tmpdir [Char]
"futhark-server-stderr.log"
(Just Handle
stdin, Just Handle
stdout, Maybe Handle
Nothing, ProcessHandle
phandle) <-
CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
P.createProcess
( ([Char] -> [[Char]] -> CreateProcess
P.proc [Char]
prog [[Char]]
options)
{ std_err :: StdStream
P.std_err = Handle -> StdStream
P.UseHandle Handle
err_log_h,
std_in :: StdStream
P.std_in = StdStream
P.CreatePipe,
std_out :: StdStream
P.std_out = StdStream
P.CreatePipe
}
)
Maybe ExitCode
code <- ProcessHandle -> IO (Maybe ExitCode)
P.getProcessExitCode ProcessHandle
phandle
case Maybe ExitCode
code of
Just (ExitFailure Int
e) ->
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot start " forall a. [a] -> [a] -> [a]
++ [Char]
prog forall a. [a] -> [a] -> [a]
++ [Char]
": error " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
e
Maybe ExitCode
_ -> do
let server :: Server
server =
Server
{ serverStdin :: Handle
serverStdin = Handle
stdin,
serverStdout :: Handle
serverStdout = Handle
stdout,
serverProc :: ProcessHandle
serverProc = ProcessHandle
phandle,
serverDebug :: Bool
serverDebug = Bool
debug,
serverErrLog :: [Char]
serverErrLog = [Char]
err_log_f,
serverOnLine :: Text -> Text -> IO ()
serverOnLine = Text -> Text -> IO ()
on_line_f
}
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> Server -> IO [Text]
responseLines Text
"startup" Server
server) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. Server -> IOError -> IO a
onStartupError Server
server
forall (f :: * -> *) a. Applicative f => a -> f a
pure Server
server
where
onStartupError :: Server -> IOError -> IO a
onStartupError :: forall a. Server -> IOError -> IO a
onStartupError Server
s IOError
_ = do
ExitCode
code <- ProcessHandle -> IO ExitCode
P.waitForProcess forall a b. (a -> b) -> a -> b
$ Server -> ProcessHandle
serverProc Server
s
[Char]
stderr_s <- [Char] -> IO [Char]
readFile forall a b. (a -> b) -> a -> b
$ Server -> [Char]
serverErrLog Server
s
[Char] -> IO ()
removeFile forall a b. (a -> b) -> a -> b
$ Server -> [Char]
serverErrLog Server
s
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
[Char]
"Command failed with "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ExitCode
code
forall a. [a] -> [a] -> [a]
++ [Char]
":\n"
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords ([Char]
prog forall a. a -> [a] -> [a]
: [[Char]]
options)
forall a. [a] -> [a] -> [a]
++ [Char]
"\nStderr:\n"
forall a. [a] -> [a] -> [a]
++ [Char]
stderr_s
stopServer :: Server -> IO ()
stopServer :: Server -> IO ()
stopServer Server
s = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. IO a -> IO b -> IO a
finally ([Char] -> IO ()
removeFile (Server -> [Char]
serverErrLog Server
s)) forall a b. (a -> b) -> a -> b
$ do
Handle -> IO ()
hClose forall a b. (a -> b) -> a -> b
$ Server -> Handle
serverStdin Server
s
ExitCode
code <- ProcessHandle -> IO ExitCode
P.waitForProcess forall a b. (a -> b) -> a -> b
$ Server -> ProcessHandle
serverProc Server
s
case ExitCode
code of
ExitCode
ExitSuccess -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ExitFailure Int
_ -> do
[Char]
stderr_s <- [Char] -> IO [Char]
readFile forall a b. (a -> b) -> a -> b
$ Server -> [Char]
serverErrLog Server
s
forall a. HasCallStack => [Char] -> a
error [Char]
stderr_s
withServer :: ServerCfg -> (Server -> IO a) -> IO a
withServer :: forall a. ServerCfg -> (Server -> IO a) -> IO a
withServer ServerCfg
cfg Server -> IO a
m = forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
Server
server <- ServerCfg -> IO Server
startServer ServerCfg
cfg
a
x <- forall a. IO a -> IO a
restore (Server -> IO a
m Server
server) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall {b}. Server -> SomeException -> IO b
mException Server
server
Server -> IO ()
stopServer Server
server
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
where
mException :: Server -> SomeException -> IO b
mException Server
server SomeException
e = do
Server -> IO ()
stopServer Server
server forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. SomeException -> SomeException -> IO a
stopServerException SomeException
e
forall a e. Exception e => e -> a
throw SomeException
e
stopServerException :: SomeException -> SomeException -> IO a
stopServerException :: forall a. SomeException -> SomeException -> IO a
stopServerException SomeException
e SomeException
_ = forall a e. Exception e => e -> a
throw SomeException
e
responseLines :: Cmd -> Server -> IO [Text]
responseLines :: Text -> Server -> IO [Text]
responseLines Text
cmd Server
s = do
Text
l <- Handle -> IO Text
T.hGetLine forall a b. (a -> b) -> a -> b
$ Server -> Handle
serverStdout Server
s
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Server -> Bool
serverDebug Server
s) forall a b. (a -> b) -> a -> b
$
Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$
Text
"<<< " forall a. Semigroup a => a -> a -> a
<> Text
l
case Text
l of
Text
"%%% OK" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Text
_ -> do
Server -> Text -> Text -> IO ()
serverOnLine Server
s Text
cmd Text
l
(Text
l forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Server -> IO [Text]
responseLines Text
cmd Server
s
data CmdFailure = CmdFailure {CmdFailure -> [Text]
failureLog :: [Text], CmdFailure -> [Text]
failureMsg :: [Text]}
deriving (CmdFailure -> CmdFailure -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmdFailure -> CmdFailure -> Bool
$c/= :: CmdFailure -> CmdFailure -> Bool
== :: CmdFailure -> CmdFailure -> Bool
$c== :: CmdFailure -> CmdFailure -> Bool
Eq, Eq CmdFailure
CmdFailure -> CmdFailure -> Bool
CmdFailure -> CmdFailure -> Ordering
CmdFailure -> CmdFailure -> CmdFailure
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CmdFailure -> CmdFailure -> CmdFailure
$cmin :: CmdFailure -> CmdFailure -> CmdFailure
max :: CmdFailure -> CmdFailure -> CmdFailure
$cmax :: CmdFailure -> CmdFailure -> CmdFailure
>= :: CmdFailure -> CmdFailure -> Bool
$c>= :: CmdFailure -> CmdFailure -> Bool
> :: CmdFailure -> CmdFailure -> Bool
$c> :: CmdFailure -> CmdFailure -> Bool
<= :: CmdFailure -> CmdFailure -> Bool
$c<= :: CmdFailure -> CmdFailure -> Bool
< :: CmdFailure -> CmdFailure -> Bool
$c< :: CmdFailure -> CmdFailure -> Bool
compare :: CmdFailure -> CmdFailure -> Ordering
$ccompare :: CmdFailure -> CmdFailure -> Ordering
Ord, Int -> CmdFailure -> ShowS
[CmdFailure] -> ShowS
CmdFailure -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CmdFailure] -> ShowS
$cshowList :: [CmdFailure] -> ShowS
show :: CmdFailure -> [Char]
$cshow :: CmdFailure -> [Char]
showsPrec :: Int -> CmdFailure -> ShowS
$cshowsPrec :: Int -> CmdFailure -> ShowS
Show)
checkForFailure :: [Text] -> Either CmdFailure [Text]
checkForFailure :: [Text] -> Either CmdFailure [Text]
checkForFailure [] = forall a b. b -> Either a b
Right []
checkForFailure (Text
"%%% FAILURE" : [Text]
ls) = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> CmdFailure
CmdFailure forall a. Monoid a => a
mempty [Text]
ls
checkForFailure (Text
l : [Text]
ls) =
case [Text] -> Either CmdFailure [Text]
checkForFailure [Text]
ls of
Left (CmdFailure [Text]
xs [Text]
ys) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> CmdFailure
CmdFailure (Text
l forall a. a -> [a] -> [a]
: [Text]
xs) [Text]
ys
Right [Text]
ls' -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text
l forall a. a -> [a] -> [a]
: [Text]
ls'
quoteWord :: Text -> Text
quoteWord :: Text -> Text
quoteWord Text
t
| Just Char
_ <- (Char -> Bool) -> Text -> Maybe Char
T.find (forall a. Eq a => a -> a -> Bool
== Char
' ') Text
t =
Text
"\"" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"\""
| Bool
otherwise = Text
t
sendCommand :: Server -> Cmd -> [Text] -> IO (Either CmdFailure [Text])
sendCommand :: Server -> Text -> [Text] -> IO (Either CmdFailure [Text])
sendCommand Server
s Text
cmd [Text]
args = do
let cmd_and_args' :: Text
cmd_and_args' = [Text] -> Text
T.unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
quoteWord forall a b. (a -> b) -> a -> b
$ Text
cmd forall a. a -> [a] -> [a]
: [Text]
args
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Server -> Bool
serverDebug Server
s) forall a b. (a -> b) -> a -> b
$
Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$
Text
">>> " forall a. Semigroup a => a -> a -> a
<> Text
cmd_and_args'
Handle -> Text -> IO ()
T.hPutStrLn (Server -> Handle
serverStdin Server
s) Text
cmd_and_args'
Handle -> IO ()
hFlush forall a b. (a -> b) -> a -> b
$ Server -> Handle
serverStdin Server
s
[Text] -> Either CmdFailure [Text]
checkForFailure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Server -> IO [Text]
responseLines Text
cmd Server
s forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. IOError -> IO a
onError
where
onError :: IOError -> IO a
onError :: forall a. IOError -> IO a
onError IOError
e = do
Maybe ExitCode
code <- ProcessHandle -> IO (Maybe ExitCode)
P.getProcessExitCode forall a b. (a -> b) -> a -> b
$ Server -> ProcessHandle
serverProc Server
s
let code_msg :: [Char]
code_msg =
case Maybe ExitCode
code of
Just (ExitFailure Int
x) ->
[Char]
"\nServer process exited unexpectedly with exit code: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
x
Maybe ExitCode
_ -> forall a. Monoid a => a
mempty
[Char]
stderr_s <- [Char] -> IO [Char]
readFile forall a b. (a -> b) -> a -> b
$ Server -> [Char]
serverErrLog Server
s
forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
[Char]
"After sending command "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
cmd
forall a. [a] -> [a] -> [a]
++ [Char]
" to server process:"
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show IOError
e
forall a. [a] -> [a] -> [a]
++ [Char]
code_msg
forall a. [a] -> [a] -> [a]
++ [Char]
"\nServer stderr:\n"
forall a. [a] -> [a] -> [a]
++ [Char]
stderr_s
type VarName = Text
type TypeName = Text
type EntryName = Text
data InputType = InputType
{ InputType -> Bool
inputConsumed :: Bool,
InputType -> Text
inputType :: TypeName
}
data OutputType = OutputType
{ OutputType -> Bool
outputUnique :: Bool,
OutputType -> Text
outputType :: TypeName
}
inOutType :: (Bool -> TypeName -> a) -> Text -> a
inOutType :: forall a. (Bool -> Text -> a) -> Text -> a
inOutType Bool -> Text -> a
f Text
t =
case Text -> Maybe (Char, Text)
T.uncons Text
t of
Just (Char
'*', Text
t') -> Bool -> Text -> a
f Bool
True Text
t'
Maybe (Char, Text)
_ -> Bool -> Text -> a
f Bool
False Text
t
helpCmd :: Server -> Cmd -> [Text] -> IO (Maybe CmdFailure)
helpCmd :: Server -> Text -> [Text] -> IO (Maybe CmdFailure)
helpCmd Server
s Text
cmd [Text]
args =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> Maybe a
Just (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Server -> Text -> [Text] -> IO (Either CmdFailure [Text])
sendCommand Server
s Text
cmd [Text]
args
cmdRestore :: Server -> FilePath -> [(VarName, TypeName)] -> IO (Maybe CmdFailure)
cmdRestore :: Server -> [Char] -> [(Text, Text)] -> IO (Maybe CmdFailure)
cmdRestore Server
s [Char]
fname [(Text, Text)]
vars = Server -> Text -> [Text] -> IO (Maybe CmdFailure)
helpCmd Server
s Text
"restore" forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
fname forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a}. (a, a) -> [a]
f [(Text, Text)]
vars
where
f :: (a, a) -> [a]
f (a
v, a
t) = [a
v, a
t]
cmdStore :: Server -> FilePath -> [VarName] -> IO (Maybe CmdFailure)
cmdStore :: Server -> [Char] -> [Text] -> IO (Maybe CmdFailure)
cmdStore Server
s [Char]
fname [Text]
vars = Server -> Text -> [Text] -> IO (Maybe CmdFailure)
helpCmd Server
s Text
"store" forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
fname forall a. a -> [a] -> [a]
: [Text]
vars
cmdCall :: Server -> EntryName -> [VarName] -> [VarName] -> IO (Either CmdFailure [Text])
cmdCall :: Server -> Text -> [Text] -> [Text] -> IO (Either CmdFailure [Text])
cmdCall Server
s Text
entry [Text]
outs [Text]
ins =
Server -> Text -> [Text] -> IO (Either CmdFailure [Text])
sendCommand Server
s Text
"call" forall a b. (a -> b) -> a -> b
$ Text
entry forall a. a -> [a] -> [a]
: [Text]
outs forall a. [a] -> [a] -> [a]
++ [Text]
ins
cmdFree :: Server -> [VarName] -> IO (Maybe CmdFailure)
cmdFree :: Server -> [Text] -> IO (Maybe CmdFailure)
cmdFree Server
s = Server -> Text -> [Text] -> IO (Maybe CmdFailure)
helpCmd Server
s Text
"free"
cmdRename :: Server -> VarName -> VarName -> IO (Maybe CmdFailure)
cmdRename :: Server -> Text -> Text -> IO (Maybe CmdFailure)
cmdRename Server
s Text
oldname Text
newname = Server -> Text -> [Text] -> IO (Maybe CmdFailure)
helpCmd Server
s Text
"rename" [Text
oldname, Text
newname]
cmdInputs :: Server -> EntryName -> IO (Either CmdFailure [InputType])
cmdInputs :: Server -> Text -> IO (Either CmdFailure [InputType])
cmdInputs Server
s Text
entry =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map (forall a. (Bool -> Text -> a) -> Text -> a
inOutType Bool -> Text -> InputType
InputType)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Server -> Text -> [Text] -> IO (Either CmdFailure [Text])
sendCommand Server
s Text
"inputs" [Text
entry]
cmdOutputs :: Server -> EntryName -> IO (Either CmdFailure [OutputType])
cmdOutputs :: Server -> Text -> IO (Either CmdFailure [OutputType])
cmdOutputs Server
s Text
entry =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map (forall a. (Bool -> Text -> a) -> Text -> a
inOutType Bool -> Text -> OutputType
OutputType)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Server -> Text -> [Text] -> IO (Either CmdFailure [Text])
sendCommand Server
s Text
"outputs" [Text
entry]
cmdClear :: Server -> IO (Maybe CmdFailure)
cmdClear :: Server -> IO (Maybe CmdFailure)
cmdClear Server
s = Server -> Text -> [Text] -> IO (Maybe CmdFailure)
helpCmd Server
s Text
"clear" []
cmdReport :: Server -> IO (Either CmdFailure [Text])
cmdReport :: Server -> IO (Either CmdFailure [Text])
cmdReport Server
s = Server -> Text -> [Text] -> IO (Either CmdFailure [Text])
sendCommand Server
s Text
"report" []
cmdPauseProfiling :: Server -> IO (Maybe CmdFailure)
cmdPauseProfiling :: Server -> IO (Maybe CmdFailure)
cmdPauseProfiling Server
s = Server -> Text -> [Text] -> IO (Maybe CmdFailure)
helpCmd Server
s Text
"pause_profiling" []
cmdUnpauseProfiling :: Server -> IO (Maybe CmdFailure)
cmdUnpauseProfiling :: Server -> IO (Maybe CmdFailure)
cmdUnpauseProfiling Server
s = Server -> Text -> [Text] -> IO (Maybe CmdFailure)
helpCmd Server
s Text
"unpause_profiling" []
cmdSetTuningParam :: Server -> Text -> Text -> IO (Either CmdFailure [Text])
cmdSetTuningParam :: Server -> Text -> Text -> IO (Either CmdFailure [Text])
cmdSetTuningParam Server
s Text
param Text
value = Server -> Text -> [Text] -> IO (Either CmdFailure [Text])
sendCommand Server
s Text
"set_tuning_param" [Text
param, Text
value]
cmdTuningParams :: Server -> Text -> IO (Either CmdFailure [Text])
cmdTuningParams :: Server -> Text -> IO (Either CmdFailure [Text])
cmdTuningParams Server
s Text
entry = Server -> Text -> [Text] -> IO (Either CmdFailure [Text])
sendCommand Server
s Text
"tuning_params" [Text
entry]
cmdTuningParamClass :: Server -> Text -> IO (Either CmdFailure Text)
cmdTuningParamClass :: Server -> Text -> IO (Either CmdFailure Text)
cmdTuningParamClass Server
s Text
param = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> a
head forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Server -> Text -> [Text] -> IO (Either CmdFailure [Text])
sendCommand Server
s Text
"tuning_param_class" [Text
param]
cmdTypes :: Server -> IO (Either CmdFailure [Text])
cmdTypes :: Server -> IO (Either CmdFailure [Text])
cmdTypes Server
s = Server -> Text -> [Text] -> IO (Either CmdFailure [Text])
sendCommand Server
s Text
"types" []
cmdEntryPoints :: Server -> IO (Either CmdFailure [Text])
cmdEntryPoints :: Server -> IO (Either CmdFailure [Text])
cmdEntryPoints Server
s = Server -> Text -> [Text] -> IO (Either CmdFailure [Text])
sendCommand Server
s Text
"entry_points" []
cmdFields :: Server -> Text -> IO (Either CmdFailure [Text])
cmdFields :: Server -> Text -> IO (Either CmdFailure [Text])
cmdFields Server
s Text
t = Server -> Text -> [Text] -> IO (Either CmdFailure [Text])
sendCommand Server
s Text
"fields" [Text
t]
cmdNew :: Server -> Text -> Text -> [Text] -> IO (Maybe CmdFailure)
cmdNew :: Server -> Text -> Text -> [Text] -> IO (Maybe CmdFailure)
cmdNew Server
s Text
var0 Text
t [Text]
vars = Server -> Text -> [Text] -> IO (Maybe CmdFailure)
helpCmd Server
s Text
"new" forall a b. (a -> b) -> a -> b
$ Text
var0 forall a. a -> [a] -> [a]
: Text
t forall a. a -> [a] -> [a]
: [Text]
vars
cmdProject :: Server -> Text -> Text -> Text -> IO (Maybe CmdFailure)
cmdProject :: Server -> Text -> Text -> Text -> IO (Maybe CmdFailure)
cmdProject Server
s Text
to Text
from Text
field = Server -> Text -> [Text] -> IO (Maybe CmdFailure)
helpCmd Server
s Text
"project" [Text
to, Text
from, Text
field]
cmdMaybe :: (MonadError Text m, MonadIO m) => IO (Maybe CmdFailure) -> m ()
cmdMaybe :: forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
IO (Maybe CmdFailure) -> m ()
cmdMaybe = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmdFailure -> [Text]
failureMsg) forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
cmdEither :: (MonadError Text m, MonadIO m) => IO (Either CmdFailure a) -> m a
cmdEither :: forall (m :: * -> *) a.
(MonadError Text m, MonadIO m) =>
IO (Either CmdFailure a) -> m a
cmdEither = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmdFailure -> [Text]
failureMsg) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO