    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE StrictData #-}

    -- | Haskell code for interacting with a Futhark server program.  This
    -- module presents a low-level interface.  See
    -- <https://futhark.readthedocs.io/en/latest/server-protocol.html the
    -- documentation of the server protocol> for the meaning of the
    -- commands.  See also "Futhark.Server.Values" for higher-level
    -- functions for loading data into a server.
    --
    -- Error messages produced by the server will be returned as a
    -- 'CmdFailure'.  However, certain errors (such as if the server
    -- process terminates unexpectedly, or temporary files cannot be
    -- created) will result in an IO exception.
    --
    -- Many of the functions here are documented only as the server
    -- protocol command they correspond to.  See the protocol
    -- documentation for details.
    module Futhark.Server
      ( -- * Server creation
        Server,
        ServerCfg (..),
        newServerCfg,
        withServer,

        -- * Commands
        Cmd,
        CmdFailure (..),
        VarName,
        TypeName,
        EntryName,
        InputType (..),
        OutputType (..),

        -- ** Main commands
        cmdRestore,
        cmdStore,
        cmdCall,
        cmdFree,
        cmdRename,
        cmdInputs,
        cmdOutputs,
        cmdClear,

        -- ** Interrogation
        cmdTypes,
        cmdEntryPoints,

        -- ** Records
        cmdNew,
        cmdProject,
        cmdFields,

        -- ** Auxiliary
        cmdReport,
        cmdPauseProfiling,
        cmdUnpauseProfiling,
        cmdSetTuningParam,
        cmdTuningParams,
        cmdTuningParamClass,

        -- * Utility
        cmdMaybe,
        cmdEither,

        -- * Raw
        startServer,
        stopServer,
        abortServer,
        sendCommand,
      )
    where

    import Control.Exception
    import Control.Monad
    import Control.Monad.Except (MonadError (..))
    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

    -- | The name of a command.
    type Cmd = Text

    -- | A handle to a running server.
    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
      }

    -- | Configuration of the server.  Use 'newServerCfg' to conveniently
    -- create a sensible default configuration.
    data ServerCfg = ServerCfg
      { -- | Path to the server executable.
        ServerCfg -> [Char]
    cfgProg :: FilePath,
        -- | Command line options to pass to the
        -- server executable.
        ServerCfg -> [[Char]]
    cfgProgOpts :: [String],
        -- | If true, print a running log of server communication to stderr.
        ServerCfg -> Bool
    cfgDebug :: Bool,
        -- | A function that is invoked on every line of output sent by the
        -- server, except the @%%% OK@ and @%%% FAILURE@ prompts.  This
        -- can be used to e.g. print or gather logging messages as they
        -- arrive, instead of waiting for the command to finish.  The name
        -- of the command leading to the message is also provided.  The
        -- default function does nothing.
        ServerCfg -> Text -> Text -> IO ()
    cfgOnLine :: Cmd -> Text -> IO ()
      }

    -- | Create a server config with the given 'cfgProg' and 'cfgProgOpts'.
    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
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
        }

    -- | Start up a server.  Make sure that 'stopServer' is eventually
    -- called on the server.  If this does not happen, then temporary
    -- files may be left on the file system.  You almost certainly wish to
    -- use 'bracket' or similar to avoid this.  Calls 'error' if startup
    -- fails.
    startServer :: ServerCfg -> IO Server
    startServer :: ServerCfg -> IO Server
    startServer (ServerCfg [Char]
    prog [[Char]]
    options Bool
    debug Text -> Text -> IO ()
    on_line_f) = do
      tmpdir <- IO [Char]
    getCanonicalTemporaryDirectory
      (err_log_f, err_log_h) <- openTempFile tmpdir "futhark-server-stderr.log"
      (Just stdin, Just stdout, Nothing, phandle) <-
        P.createProcess
          ( (P.proc prog options)
              { P.std_err = P.UseHandle err_log_h,
                P.std_in = P.CreatePipe,
                P.std_out = P.CreatePipe
              }
          )

      code <- P.getProcessExitCode phandle
      case code of
        Just (ExitFailure Int
    e) ->
          [Char] -> IO Server
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> IO Server) -> [Char] -> IO Server
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Cannot start " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    prog [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ": error " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    e
        Just ExitCode
    ExitSuccess ->
          [Char] -> IO Server
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> IO Server) -> [Char] -> IO Server
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Cannot start " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    prog [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ": terminated immediately, but reported success."
        Maybe ExitCode
    Nothing -> 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
                  }
          IO [Text] -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Text -> Server -> IO [Text]
    responseLines Text
    "startup" Server
    server) IO () -> (IOError -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` Server -> IOError -> IO ()
    forall a. Server -> IOError -> IO a
    onStartupError Server
    server
          Server -> IO Server
    forall a. a -> IO a
    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
          code <- ProcessHandle -> IO ExitCode
    P.waitForProcess (ProcessHandle -> IO ExitCode) -> ProcessHandle -> IO ExitCode
    forall a b. (a -> b) -> a -> b
    $ Server -> ProcessHandle
    serverProc Server
    s
          stderr_s <- readFile $ serverErrLog s
          removeFile $ serverErrLog s
          error $
            "Command failed with "
              ++ show code
              ++ ":\n"
              ++ unwords (prog : options)
              ++ "\nStderr:\n"
              ++ stderr_s

    -- | Shut down a server.  It may not be used again.  Calls 'error' if
    -- the server process terminates with a failing exit code
    -- (i.e. anything but 'ExitSuccess').
    stopServer :: Server -> IO ()
    stopServer :: Server -> IO ()
    stopServer Server
    s = (IO () -> IO () -> IO ()) -> IO () -> IO () -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO a
    finally ([Char] -> IO ()
    removeFile (Server -> [Char]
    serverErrLog Server
    s)) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      Handle -> IO ()
    hClose (Handle -> IO ()) -> Handle -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Server -> Handle
    serverStdin Server
    s
      code <- ProcessHandle -> IO ExitCode
    P.waitForProcess (ProcessHandle -> IO ExitCode) -> ProcessHandle -> IO ExitCode
    forall a b. (a -> b) -> a -> b
    $ Server -> ProcessHandle
    serverProc Server
    s
      case code of
        ExitCode
    ExitSuccess -> () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
        ExitFailure Int
    _ -> do
          stderr_s <- [Char] -> IO [Char]
    readFile ([Char] -> IO [Char]) -> [Char] -> IO [Char]
    forall a b. (a -> b) -> a -> b
    $ Server -> [Char]
    serverErrLog Server
    s
          error stderr_s

    -- | Terminate the server process.  You'll still need to call
    -- 'stopServer' unless used inside 'withServer', which does it for
    -- you.
    abortServer :: Server -> IO ()
    abortServer :: Server -> IO ()
    abortServer = ProcessHandle -> IO ()
    P.terminateProcess (ProcessHandle -> IO ())
    -> (Server -> ProcessHandle) -> Server -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Server -> ProcessHandle
    serverProc

    -- | Start a server, execute an action, then shut down the server.
    -- The 'Server' may not be returned from the action.
    withServer :: ServerCfg -> (Server -> IO a) -> IO a
    withServer :: forall a. ServerCfg -> (Server -> IO a) -> IO a
    withServer ServerCfg
    cfg Server -> IO a
    m = ((forall a. IO a -> IO a) -> IO a) -> IO a
    forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
    mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
    -> ((forall a. IO a -> IO a) -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \forall a. IO a -> IO a
    restore -> do
      server <- ServerCfg -> IO Server
    startServer ServerCfg
    cfg
      x <- restore (m server) `catch` mException server
      stopServer server
      pure x
      where
        mException :: Server -> SomeException -> IO b
    mException Server
    server SomeException
    e = do
          -- Anything that goes wrong here is probably less interesting
          -- than the original exception.
          Server -> IO ()
    stopServer Server
    server IO () -> (SomeException -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` SomeException -> SomeException -> IO ()
    forall a. SomeException -> SomeException -> IO a
    stopServerException SomeException
    e
          SomeException -> IO b
    forall a e. (HasCallStack, Exception e) => e -> a
    throw SomeException
    e
        stopServerException :: SomeException -> SomeException -> IO a
        stopServerException :: forall a. SomeException -> SomeException -> IO a
    stopServerException SomeException
    e SomeException
    _ = SomeException -> IO a
    forall a e. (HasCallStack, Exception e) => e -> a
    throw SomeException
    e

    -- Read lines of response until the next %%% OK (which is what
    -- indicates that the server is ready for new instructions).
    responseLines :: Cmd -> Server -> IO [Text]
    responseLines :: Text -> Server -> IO [Text]
    responseLines Text
    cmd Server
    s = do
      l <- Handle -> IO Text
    T.hGetLine (Handle -> IO Text) -> Handle -> IO Text
    forall a b. (a -> b) -> a -> b
    $ Server -> Handle
    serverStdout Server
    s
      when (serverDebug s) $
        T.hPutStrLn stderr $
          "<<< " <> l
      case l of
        Text
    "%%% OK" -> [Text] -> IO [Text]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
        Text
    _ -> do
          Server -> Text -> Text -> IO ()
    serverOnLine Server
    s Text
    cmd Text
    l
          (Text
    l Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    :) ([Text] -> [Text]) -> IO [Text] -> IO [Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> Server -> IO [Text]
    responseLines Text
    cmd Server
    s

    -- | The command failed, and this is why.  The first 'Text' is any
    -- output before the failure indicator, and the second Text is the
    -- output after the indicator.
    data CmdFailure = CmdFailure {CmdFailure -> [Text]
    failureLog :: [Text], CmdFailure -> [Text]
    failureMsg :: [Text]}
      deriving (CmdFailure -> CmdFailure -> Bool
    (CmdFailure -> CmdFailure -> Bool)
    -> (CmdFailure -> CmdFailure -> Bool) -> Eq CmdFailure
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CmdFailure -> CmdFailure -> Bool
    == :: CmdFailure -> CmdFailure -> Bool
    $c/= :: CmdFailure -> CmdFailure -> Bool
    /= :: CmdFailure -> CmdFailure -> Bool
    Eq, Eq CmdFailure
    Eq CmdFailure =>
    (CmdFailure -> CmdFailure -> Ordering)
    -> (CmdFailure -> CmdFailure -> Bool)
    -> (CmdFailure -> CmdFailure -> Bool)
    -> (CmdFailure -> CmdFailure -> Bool)
    -> (CmdFailure -> CmdFailure -> Bool)
    -> (CmdFailure -> CmdFailure -> CmdFailure)
    -> (CmdFailure -> CmdFailure -> CmdFailure)
    -> Ord 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
    $ccompare :: CmdFailure -> CmdFailure -> Ordering
    compare :: CmdFailure -> CmdFailure -> Ordering
    $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
    >= :: CmdFailure -> CmdFailure -> Bool
    $cmax :: CmdFailure -> CmdFailure -> CmdFailure
    max :: CmdFailure -> CmdFailure -> CmdFailure
    $cmin :: CmdFailure -> CmdFailure -> CmdFailure
    min :: CmdFailure -> CmdFailure -> CmdFailure
    Ord, Int -> CmdFailure -> [Char] -> [Char]
    [CmdFailure] -> [Char] -> [Char]
    CmdFailure -> [Char]
    (Int -> CmdFailure -> [Char] -> [Char])
    -> (CmdFailure -> [Char])
    -> ([CmdFailure] -> [Char] -> [Char])
    -> Show CmdFailure
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> CmdFailure -> [Char] -> [Char]
    showsPrec :: Int -> CmdFailure -> [Char] -> [Char]
    $cshow :: CmdFailure -> [Char]
    show :: CmdFailure -> [Char]
    $cshowList :: [CmdFailure] -> [Char] -> [Char]
    showList :: [CmdFailure] -> [Char] -> [Char]
    Show)

    -- Figure out whether the response is a failure, and if so, return the
    -- failure message.
    checkForFailure :: [Text] -> Either CmdFailure [Text]
    checkForFailure :: [Text] -> Either CmdFailure [Text]
    checkForFailure [] = [Text] -> Either CmdFailure [Text]
    forall a b. b -> Either a b
    Right []
    checkForFailure (Text
    "%%% FAILURE" : [Text]
    ls) = CmdFailure -> Either CmdFailure [Text]
    forall a b. a -> Either a b
    Left (CmdFailure -> Either CmdFailure [Text])
    -> CmdFailure -> Either CmdFailure [Text]
    forall a b. (a -> b) -> a -> b
    $ [Text] -> [Text] -> CmdFailure
    CmdFailure [Text]
    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) -> CmdFailure -> Either CmdFailure [Text]
    forall a b. a -> Either a b
    Left (CmdFailure -> Either CmdFailure [Text])
    -> CmdFailure -> Either CmdFailure [Text]
    forall a b. (a -> b) -> a -> b
    $ [Text] -> [Text] -> CmdFailure
    CmdFailure (Text
    l Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    xs) [Text]
    ys
        Right [Text]
    ls' -> [Text] -> Either CmdFailure [Text]
    forall a b. b -> Either a b
    Right ([Text] -> Either CmdFailure [Text])
    -> [Text] -> Either CmdFailure [Text]
    forall a b. (a -> b) -> a -> b
    $ Text
    l Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    ls'

    -- Words with spaces in them must be quoted.
    quoteWord :: Text -> Text
    quoteWord :: Text -> Text
    quoteWord Text
    t
      | Just Char
    _ <- (Char -> Bool) -> Text -> Maybe Char
    T.find (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ') Text
    t =
          Text
    "\"" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\""
      | Bool
    otherwise = Text
    t

    -- | Send an arbitrary command to the server.  This is only useful
    -- when the server protocol has been extended without this module
    -- having been similarly extended.  Be careful not to send invalid
    -- commands.
    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 ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Text -> Text) -> [Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Text
    quoteWord ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Text
    cmd Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    args

      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Server -> Bool
    serverDebug Server
    s) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          Text
    ">>> " Text -> Text -> 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 (Handle -> IO ()) -> Handle -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Server -> Handle
    serverStdin Server
    s
      [Text] -> Either CmdFailure [Text]
    checkForFailure ([Text] -> Either CmdFailure [Text])
    -> IO [Text] -> IO (Either CmdFailure [Text])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> Server -> IO [Text]
    responseLines Text
    cmd Server
    s IO [Text] -> (IOError -> IO [Text]) -> IO [Text]
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` IOError -> IO [Text]
    forall a. IOError -> IO a
    onError
      where
        onError :: IOError -> IO a
        onError :: forall a. IOError -> IO a
    onError IOError
    e = do
          code <- ProcessHandle -> IO (Maybe ExitCode)
    P.getProcessExitCode (ProcessHandle -> IO (Maybe ExitCode))
    -> ProcessHandle -> IO (Maybe ExitCode)
    forall a b. (a -> b) -> a -> b
    $ Server -> ProcessHandle
    serverProc Server
    s
          let code_msg =
                case Maybe ExitCode
    code of
                  Just (ExitFailure Int
    x) ->
                    [Char]
    "\nServer process exited unexpectedly with exit code: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    x
                  Just ExitCode
    ExitSuccess -> [Char]
    forall a. Monoid a => a
    mempty
                  Maybe ExitCode
    Nothing -> [Char]
    forall a. Monoid a => a
    mempty
          stderr_s <- readFile $ serverErrLog s
          error $
            "After sending command "
              ++ show cmd
              ++ " to server process:"
              ++ show e
              ++ code_msg
              ++ "\nServer stderr:\n"
              ++ stderr_s

    -- | The name of a server-side variable.
    type VarName = Text

    -- | The name of a server-side type.
    type TypeName = Text

    -- | The name of an entry point.
    type EntryName = Text

    -- | The type of an input of an entry point.  If 'inputConsumed', then
    -- the value passed in a 'cmdCall' must not be used again (nor any of
    -- its aliases).
    data InputType = InputType
      { InputType -> Bool
    inputConsumed :: Bool,
        InputType -> Text
    inputType :: TypeName
      }

    -- | The type of an output of an entry point.  If 'outputUnique', then
    -- the value returned does not alias any of the inputs.  See the
    -- Futhark language manual itself for more details - the implications
    -- are quite subtle (but you can ignore them unless you manually use
    -- type annotations to make some entry point parameters unique).
    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'
        Just (Char, Text)
    _ -> Bool -> Text -> a
    f Bool
    False Text
    t
        Maybe (Char, Text)
    Nothing -> 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 =
      (CmdFailure -> Maybe CmdFailure)
    -> ([Text] -> Maybe CmdFailure)
    -> Either CmdFailure [Text]
    -> Maybe CmdFailure
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either CmdFailure -> Maybe CmdFailure
    forall a. a -> Maybe a
    Just (Maybe CmdFailure -> [Text] -> Maybe CmdFailure
    forall a b. a -> b -> a
    const Maybe CmdFailure
    forall a. Maybe a
    Nothing) (Either CmdFailure [Text] -> Maybe CmdFailure)
    -> IO (Either CmdFailure [Text]) -> IO (Maybe CmdFailure)
    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

    -- | @restore filename var0 type0 var1 type1...@.
    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" ([Text] -> IO (Maybe CmdFailure))
    -> [Text] -> IO (Maybe CmdFailure)
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Text
    T.pack [Char]
    fname Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : ((Text, Text) -> [Text]) -> [(Text, Text)] -> [Text]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Text, Text) -> [Text]
    forall {a}. (a, a) -> [a]
    f [(Text, Text)]
    vars
      where
        f :: (a, a) -> [a]
    f (a
    v, a
    t) = [a
    v, a
    t]

    -- | @store filename vars...@.
    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" ([Text] -> IO (Maybe CmdFailure))
    -> [Text] -> IO (Maybe CmdFailure)
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Text
    T.pack [Char]
    fname Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    vars

    -- | @call entrypoint outs... ins...@.
    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" ([Text] -> IO (Either CmdFailure [Text]))
    -> [Text] -> IO (Either CmdFailure [Text])
    forall a b. (a -> b) -> a -> b
    $ Text
    entry Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    outs [Text] -> [Text] -> [Text]
    forall a. [a] -> [a] -> [a]
    ++ [Text]
    ins

    -- | @free vars...@.
    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"

    -- | @rename oldname newname@.
    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]

    -- | @inputs entryname@, with uniqueness represented as True.
    cmdInputs :: Server -> EntryName -> IO (Either CmdFailure [InputType])
    cmdInputs :: Server -> Text -> IO (Either CmdFailure [InputType])
    cmdInputs Server
    s Text
    entry =
      ([Text] -> [InputType])
    -> Either CmdFailure [Text] -> Either CmdFailure [InputType]
    forall a b. (a -> b) -> Either CmdFailure a -> Either CmdFailure b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Text -> InputType) -> [Text] -> [InputType]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Bool -> Text -> InputType) -> Text -> InputType
    forall a. (Bool -> Text -> a) -> Text -> a
    inOutType Bool -> Text -> InputType
    InputType)) (Either CmdFailure [Text] -> Either CmdFailure [InputType])
    -> IO (Either CmdFailure [Text])
    -> IO (Either CmdFailure [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]

    -- | @outputs entryname@, with uniqueness represented as True.
    cmdOutputs :: Server -> EntryName -> IO (Either CmdFailure [OutputType])
    cmdOutputs :: Server -> Text -> IO (Either CmdFailure [OutputType])
    cmdOutputs Server
    s Text
    entry =
      ([Text] -> [OutputType])
    -> Either CmdFailure [Text] -> Either CmdFailure [OutputType]
    forall a b. (a -> b) -> Either CmdFailure a -> Either CmdFailure b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Text -> OutputType) -> [Text] -> [OutputType]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Bool -> Text -> OutputType) -> Text -> OutputType
    forall a. (Bool -> Text -> a) -> Text -> a
    inOutType Bool -> Text -> OutputType
    OutputType)) (Either CmdFailure [Text] -> Either CmdFailure [OutputType])
    -> IO (Either CmdFailure [Text])
    -> IO (Either CmdFailure [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]

    -- | @clear@
    cmdClear :: Server -> IO (Maybe CmdFailure)
    cmdClear :: Server -> IO (Maybe CmdFailure)
    cmdClear Server
    s = Server -> Text -> [Text] -> IO (Maybe CmdFailure)
    helpCmd Server
    s Text
    "clear" []

    -- | @report@
    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" []

    -- | @pause_profiling@
    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" []

    -- | @unpause_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" []

    -- | @set_tuning_param param value@
    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]

    -- | @tuning_params@
    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]

    -- | @tuning_param_class param@
    cmdTuningParamClass :: Server -> Text -> IO (Either CmdFailure Text)
    cmdTuningParamClass :: Server -> Text -> IO (Either CmdFailure Text)
    cmdTuningParamClass Server
    s Text
    param = ([Text] -> Text)
    -> Either CmdFailure [Text] -> Either CmdFailure Text
    forall a b. (a -> b) -> Either CmdFailure a -> Either CmdFailure b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Text] -> Text
    forall a. HasCallStack => [a] -> a
    head (Either CmdFailure [Text] -> Either CmdFailure Text)
    -> IO (Either CmdFailure [Text]) -> IO (Either CmdFailure Text)
    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]

    -- | @types@
    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" []

    -- | @entry_points@
    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" []

    -- | @fields type@
    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]

    -- | @new var0 type var1...@
    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" ([Text] -> IO (Maybe CmdFailure))
    -> [Text] -> IO (Maybe CmdFailure)
    forall a b. (a -> b) -> a -> b
    $ Text
    var0 Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : Text
    t Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    vars

    -- | @project to from field@
    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]

    -- | Turn a 'Maybe'-producing command into a monadic action.
    cmdMaybe :: (MonadError Text m, MonadIO m) => IO (Maybe CmdFailure) -> m ()
    cmdMaybe :: forall (m :: * -> *).
    (MonadError Text m, MonadIO m) =>
    IO (Maybe CmdFailure) -> m ()
    cmdMaybe = m () -> (CmdFailure -> m ()) -> Maybe CmdFailure -> m ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()) (Text -> m ()
    forall a. Text -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> m ()) -> (CmdFailure -> Text) -> CmdFailure -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> Text
    T.unlines ([Text] -> Text) -> (CmdFailure -> [Text]) -> CmdFailure -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmdFailure -> [Text]
    failureMsg) (Maybe CmdFailure -> m ())
    -> (IO (Maybe CmdFailure) -> m (Maybe CmdFailure))
    -> IO (Maybe CmdFailure)
    -> m ()
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< IO (Maybe CmdFailure) -> m (Maybe CmdFailure)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO

    -- | Turn an 'Either'-producing command into a monadic action.
    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 = (CmdFailure -> m a) -> (a -> m a) -> Either CmdFailure a -> m a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Text -> m a
    forall a. Text -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> m a) -> (CmdFailure -> Text) -> CmdFailure -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> Text
    T.unlines ([Text] -> Text) -> (CmdFailure -> [Text]) -> CmdFailure -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CmdFailure -> [Text]
    failureMsg) a -> m a
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either CmdFailure a -> m a)
    -> (IO (Either CmdFailure a) -> m (Either CmdFailure a))
    -> IO (Either CmdFailure a)
    -> m a
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< IO (Either CmdFailure a) -> m (Either CmdFailure a)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO