{-# LANGUAGE OverloadedStrings #-}

-- | Convenience functions builds on top of "Futhark.Data" and
-- "Futhark.Server" for passing non-opaque values in and out of a
-- server instance.
module Futhark.Server.Values (getValue, putValue) where

import qualified Data.Binary as Bin
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text as T
import Futhark.Data (Value, valueType, valueTypeTextNoDims)
import Futhark.Server
import System.IO (hClose)
import System.IO.Temp (withSystemTempFile)

-- | Retrieve a non-opaque value from the server.
getValue :: Server -> VarName -> IO (Either T.Text Value)
getValue :: Server -> VarName -> IO (Either VarName Value)
getValue Server
server VarName
vname =
  String
-> (String -> Handle -> IO (Either VarName Value))
-> IO (Either VarName Value)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"futhark-server-get" ((String -> Handle -> IO (Either VarName Value))
 -> IO (Either VarName Value))
-> (String -> Handle -> IO (Either VarName Value))
-> IO (Either VarName Value)
forall a b. (a -> b) -> a -> b
$ \String
tmpf Handle
tmpf_h -> do
    Handle -> IO ()
hClose Handle
tmpf_h
    Maybe CmdFailure
store_res <- Server -> String -> [VarName] -> IO (Maybe CmdFailure)
cmdStore Server
server String
tmpf [VarName
vname]
    case Maybe CmdFailure
store_res of
      Just (CmdFailure [VarName]
_ [VarName]
err) ->
        Either VarName Value -> IO (Either VarName Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either VarName Value -> IO (Either VarName Value))
-> Either VarName Value -> IO (Either VarName Value)
forall a b. (a -> b) -> a -> b
$ VarName -> Either VarName Value
forall a b. a -> Either a b
Left (VarName -> Either VarName Value)
-> VarName -> Either VarName Value
forall a b. (a -> b) -> a -> b
$ [VarName] -> VarName
T.unlines [VarName]
err
      Maybe CmdFailure
Nothing -> do
        ByteString
bytes <- String -> IO ByteString
LBS.readFile String
tmpf
        case ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, Value)
forall a.
Binary a =>
ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
Bin.decodeOrFail ByteString
bytes of
          Left (ByteString
_, ByteOffset
_, String
e) ->
            Either VarName Value -> IO (Either VarName Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either VarName Value -> IO (Either VarName Value))
-> Either VarName Value -> IO (Either VarName Value)
forall a b. (a -> b) -> a -> b
$ VarName -> Either VarName Value
forall a b. a -> Either a b
Left (VarName -> Either VarName Value)
-> VarName -> Either VarName Value
forall a b. (a -> b) -> a -> b
$ VarName
"Cannot load value from generated byte stream:\n" VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> String -> VarName
T.pack String
e
          Right (ByteString
_, ByteOffset
_, Value
val) ->
            Either VarName Value -> IO (Either VarName Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either VarName Value -> IO (Either VarName Value))
-> Either VarName Value -> IO (Either VarName Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either VarName Value
forall a b. b -> Either a b
Right Value
val

-- | Store a non-opaque value in the server.  A variable with the
-- given name must not already exist (use 'cmdFree' to free it first
-- if necessary).
putValue :: Server -> VarName -> Value -> IO (Maybe CmdFailure)
putValue :: Server -> VarName -> Value -> IO (Maybe CmdFailure)
putValue Server
server VarName
v Value
val =
  String
-> (String -> Handle -> IO (Maybe CmdFailure))
-> IO (Maybe CmdFailure)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"futhark-server-put" ((String -> Handle -> IO (Maybe CmdFailure))
 -> IO (Maybe CmdFailure))
-> (String -> Handle -> IO (Maybe CmdFailure))
-> IO (Maybe CmdFailure)
forall a b. (a -> b) -> a -> b
$ \String
tmpf Handle
tmpf_h -> do
    Handle -> ByteString -> IO ()
LBS.hPutStr Handle
tmpf_h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. Binary a => a -> ByteString
Bin.encode Value
val
    Handle -> IO ()
hClose Handle
tmpf_h
    Server -> String -> [(VarName, VarName)] -> IO (Maybe CmdFailure)
cmdRestore Server
server String
tmpf [(VarName
v, VarName
t)]
  where
    t :: VarName
t = ValueType -> VarName
valueTypeTextNoDims (ValueType -> VarName) -> ValueType -> VarName
forall a b. (a -> b) -> a -> b
$ Value -> ValueType
valueType Value
val