packages feed

futhark-server-1.0.0.0: src/Futhark/Server/Values.hs

{-# 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 vname =
  withSystemTempFile "futhark-server-get" $ \tmpf tmpf_h -> do
    hClose tmpf_h
    store_res <- cmdStore server tmpf [vname]
    case store_res of
      Just (CmdFailure _ err) ->
        pure $ Left $ T.unlines err
      Nothing -> do
        bytes <- LBS.readFile tmpf
        case Bin.decodeOrFail bytes of
          Left (_, _, e) ->
            pure $ Left $ "Cannot load value from generated byte stream:\n" <> T.pack e
          Right (_, _, val) ->
            pure $ Right 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 v val =
  withSystemTempFile "futhark-server-put" $ \tmpf tmpf_h -> do
    LBS.hPutStr tmpf_h $ Bin.encode val
    hClose tmpf_h
    cmdRestore server tmpf [(v, t)]
  where
    t = valueTypeTextNoDims $ valueType val