{-# LANGUAGE OverloadedStrings #-}

-- | Convenience functions built 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 -> Text -> IO (Either Text Value)
getValue Server
server Text
vname =
  String
-> (String -> Handle -> IO (Either Text Value))
-> IO (Either Text Value)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"futhark-server-get" ((String -> Handle -> IO (Either Text Value))
 -> IO (Either Text Value))
-> (String -> Handle -> IO (Either Text Value))
-> IO (Either Text 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 -> [Text] -> IO (Maybe CmdFailure)
cmdStore Server
server String
tmpf [Text
vname]
    case Maybe CmdFailure
store_res of
      Just (CmdFailure [Text]
_ [Text]
err) ->
        Either Text Value -> IO (Either Text Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Value -> IO (Either Text Value))
-> Either Text Value -> IO (Either Text Value)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Value
forall a b. a -> Either a b
Left (Text -> Either Text Value) -> Text -> Either Text Value
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [Text]
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 Text Value -> IO (Either Text Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Value -> IO (Either Text Value))
-> Either Text Value -> IO (Either Text Value)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Value
forall a b. a -> Either a b
Left (Text -> Either Text Value) -> Text -> Either Text Value
forall a b. (a -> b) -> a -> b
$ Text
"Cannot load value from generated byte stream:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e
          Right (ByteString
_, ByteOffset
_, Value
val) ->
            Either Text Value -> IO (Either Text Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Value -> IO (Either Text Value))
-> Either Text Value -> IO (Either Text Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either Text 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 -> Text -> Value -> IO (Maybe CmdFailure)
putValue Server
server Text
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 -> [(Text, Text)] -> IO (Maybe CmdFailure)
cmdRestore Server
server String
tmpf [(Text
v, Text
t)]
  where
    t :: Text
t = ValueType -> Text
valueTypeTextNoDims (ValueType -> Text) -> ValueType -> Text
forall a b. (a -> b) -> a -> b
$ Value -> ValueType
valueType Value
val