{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}

-- | This module defines an efficient value representation of the
-- Futhark data format.
module Futhark.Data
  ( Value (..),
    Vector,
    valueText,

    -- * Types of values
    PrimType (..),
    primTypeText,
    primTypeBytes,
    ValueType (..),
    valueTypeTextNoDims,
    valueType,
    valueElemType,
    valueShape,
    valueTypeText,

    -- * Converting values
    GetValue (..),
    PutValue (..),
    PutValue1 (..),
    valueElems,
  )
where

import Control.Monad
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Char (chr, ord)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.List (intersperse)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as TB
import qualified Data.Vector.Storable as SVec
import Data.Vector.Storable.ByteString (byteStringToVector, vectorToByteString)
import Numeric.Half

-- | The value vector type.
type Vector = SVec.Vector

-- | An efficiently represented Futhark value, represented as a shape
-- vector and a value vector, which contains elements in row-major
-- order.  The size of the value vector must be equal to the product
-- of the shape vector.  This is not enforced by the representation,
-- but consuming functions may give unexpected results if this
-- invariant is broken.  Scalars are represented with an empty shape
-- vector.
--
-- Use 'valueText' to get a human-readable representation, and v'put'
-- to obtain binary a representation.
--
-- The 'Eq' instance is the naive one, meaning that no values
-- containing NaNs will be considered equal.  Use the functions from
-- "Futhark.Data.Compare" if this is not what you want.
data Value
  = I8Value (Vector Int) (Vector Int8)
  | I16Value (Vector Int) (Vector Int16)
  | I32Value (Vector Int) (Vector Int32)
  | I64Value (Vector Int) (Vector Int64)
  | U8Value (Vector Int) (Vector Word8)
  | U16Value (Vector Int) (Vector Word16)
  | U32Value (Vector Int) (Vector Word32)
  | U64Value (Vector Int) (Vector Word64)
  | F16Value (Vector Int) (Vector Half)
  | F32Value (Vector Int) (Vector Float)
  | F64Value (Vector Int) (Vector Double)
  | BoolValue (Vector Int) (Vector Bool)
  deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show)

binaryFormatVersion :: Word8
binaryFormatVersion :: Word8
binaryFormatVersion = Word8
2

instance Binary Value where
  put :: Value -> Put
put (I8Value Vector Int
shape Vector Int8
vs) = String -> Vector Int -> Vector Int8 -> Put
forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
"  i8" Vector Int
shape Vector Int8
vs
  put (I16Value Vector Int
shape Vector Int16
vs) = String -> Vector Int -> Vector Int16 -> Put
forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" i16" Vector Int
shape Vector Int16
vs
  put (I32Value Vector Int
shape Vector Int32
vs) = String -> Vector Int -> Vector Int32 -> Put
forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" i32" Vector Int
shape Vector Int32
vs
  put (I64Value Vector Int
shape Vector Int64
vs) = String -> Vector Int -> Vector Int64 -> Put
forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" i64" Vector Int
shape Vector Int64
vs
  put (U8Value Vector Int
shape Vector Word8
vs) = String -> Vector Int -> Vector Word8 -> Put
forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
"  u8" Vector Int
shape Vector Word8
vs
  put (U16Value Vector Int
shape Vector Word16
vs) = String -> Vector Int -> Vector Word16 -> Put
forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" u16" Vector Int
shape Vector Word16
vs
  put (U32Value Vector Int
shape Vector Word32
vs) = String -> Vector Int -> Vector Word32 -> Put
forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" u32" Vector Int
shape Vector Word32
vs
  put (U64Value Vector Int
shape Vector Word64
vs) = String -> Vector Int -> Vector Word64 -> Put
forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" u64" Vector Int
shape Vector Word64
vs
  put (F16Value Vector Int
shape Vector Half
vs) = String -> Vector Int -> Vector Half -> Put
forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" f16" Vector Int
shape Vector Half
vs
  put (F32Value Vector Int
shape Vector Float
vs) = String -> Vector Int -> Vector Float -> Put
forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" f32" Vector Int
shape Vector Float
vs
  put (F64Value Vector Int
shape Vector Double
vs) = String -> Vector Int -> Vector Double -> Put
forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
" f64" Vector Int
shape Vector Double
vs
  -- Bool must be treated specially because the Storable instance
  -- uses four bytes.
  put (BoolValue Vector Int
shape Vector Bool
vs) = String -> Vector Int -> Vector Int8 -> Put
forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
"bool" Vector Int
shape (Vector Int8 -> Put) -> Vector Int8 -> Put
forall a b. (a -> b) -> a -> b
$ (Bool -> Int8) -> Vector Bool -> Vector Int8
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
SVec.map Bool -> Int8
boolToInt8 Vector Bool
vs
    where
      boolToInt8 :: Bool -> Int8
boolToInt8 Bool
True = Int8
1 :: Int8
      boolToInt8 Bool
False = Int8
0

  get :: Get Value
get = do
    Int8
first <- Get Int8
getInt8
    Word8
version <- Get Word8
getWord8
    Int8
rank <- Get Int8
getInt8

    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Char
chr (Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
first) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'b') (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
      String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Input does not begin with ASCII 'b'."
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
version Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
binaryFormatVersion) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
      String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$
        String
"Expecting binary format version 1; found version: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
version
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int8
rank Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int8
0) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
      String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$
        String
"Rank must be non-negative, but is: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int8 -> String
forall a. Show a => a -> String
show Int8
rank

    ByteString
type_f <- Int64 -> Get ByteString
getLazyByteString Int64
4

    [Int]
shape <- Int -> Get Int -> Get [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
rank) (Get Int -> Get [Int]) -> Get Int -> Get [Int]
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Get Int64 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64le
    let num_elems :: Int
num_elems = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int]
shape
        shape' :: Vector Int
shape' = [Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
shape

    case ByteString -> String
LBS.unpack ByteString
type_f of
      String
"  i8" -> (Vector Int8 -> Value) -> Int -> Int -> Get Value
forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Int8 -> Value
I8Value Vector Int
shape') Int
num_elems Int
1
      String
" i16" -> (Vector Int16 -> Value) -> Int -> Int -> Get Value
forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Int16 -> Value
I16Value Vector Int
shape') Int
num_elems Int
2
      String
" i32" -> (Vector Int32 -> Value) -> Int -> Int -> Get Value
forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Int32 -> Value
I32Value Vector Int
shape') Int
num_elems Int
4
      String
" i64" -> (Vector Int64 -> Value) -> Int -> Int -> Get Value
forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Int64 -> Value
I64Value Vector Int
shape') Int
num_elems Int
8
      String
"  u8" -> (Vector Word8 -> Value) -> Int -> Int -> Get Value
forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Word8 -> Value
U8Value Vector Int
shape') Int
num_elems Int
1
      String
" u16" -> (Vector Word16 -> Value) -> Int -> Int -> Get Value
forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Word16 -> Value
U16Value Vector Int
shape') Int
num_elems Int
2
      String
" u32" -> (Vector Word32 -> Value) -> Int -> Int -> Get Value
forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Word32 -> Value
U32Value Vector Int
shape') Int
num_elems Int
4
      String
" u64" -> (Vector Word64 -> Value) -> Int -> Int -> Get Value
forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Word64 -> Value
U64Value Vector Int
shape') Int
num_elems Int
8
      String
" f16" -> (Vector Half -> Value) -> Int -> Int -> Get Value
forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Half -> Value
F16Value Vector Int
shape') Int
num_elems Int
2
      String
" f32" -> (Vector Float -> Value) -> Int -> Int -> Get Value
forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Float -> Value
F32Value Vector Int
shape') Int
num_elems Int
4
      String
" f64" -> (Vector Double -> Value) -> Int -> Int -> Get Value
forall {a} {b}.
Storable a =>
(Vector a -> b) -> Int -> Int -> Get b
get' (Vector Int -> Vector Double -> Value
F64Value Vector Int
shape') Int
num_elems Int
8
      -- Bool must be treated specially because the Storable instance
      -- uses four bytes.
      String
"bool" ->
        Vector Int -> Vector Bool -> Value
BoolValue Vector Int
shape'
          (Vector Bool -> Value)
-> (ByteString -> Vector Bool) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int8 -> Bool) -> Vector Int8 -> Vector Bool
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
SVec.map Int8 -> Bool
int8ToBool
          (Vector Int8 -> Vector Bool)
-> (ByteString -> Vector Int8) -> ByteString -> Vector Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Vector Int8
forall a. Storable a => ByteString -> Vector a
byteStringToVector
          (ByteString -> Vector Int8)
-> (ByteString -> ByteString) -> ByteString -> Vector Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.copy
          (ByteString -> Value) -> Get ByteString -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
num_elems
      String
s -> String -> Get Value
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get Value) -> String -> Get Value
forall a b. (a -> b) -> a -> b
$ String
"Cannot parse binary values of type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s
    where
      -- The copy is to ensure that the bytestring is properly
      -- aligned.
      get' :: (Vector a -> b) -> Int -> Int -> Get b
get' Vector a -> b
mk Int
num_elems Int
elem_size =
        Vector a -> b
mk (Vector a -> b) -> (ByteString -> Vector a) -> ByteString -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Vector a
forall a. Storable a => ByteString -> Vector a
byteStringToVector (ByteString -> Vector a)
-> (ByteString -> ByteString) -> ByteString -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.copy (ByteString -> b) -> Get ByteString -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (Int
num_elems Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
elem_size)

      int8ToBool :: Int8 -> Bool
      int8ToBool :: Int8 -> Bool
int8ToBool = (Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int8
0)

putBinaryValue ::
  (SVec.Storable a) =>
  String ->
  Vector Int ->
  Vector a ->
  Put
putBinaryValue :: forall a. Storable a => String -> Vector Int -> Vector a -> Put
putBinaryValue String
tstr Vector Int
shape Vector a
vs = do
  Int8 -> Put
putInt8 (Int8 -> Put) -> Int8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int8) -> Int -> Int8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
'b'
  Word8 -> Put
putWord8 Word8
binaryFormatVersion
  Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Vector Int -> Int
forall a. Storable a => Vector a -> Int
SVec.length Vector Int
shape
  (Char -> Put) -> String -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int8 -> Put
putInt8 (Int8 -> Put) -> (Char -> Int8) -> Char -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int8) -> (Char -> Int) -> Char -> Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) String
tstr
  ByteString -> Put
putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Vector Int -> ByteString
forall a. Storable a => Vector a -> ByteString
vectorToByteString Vector Int
shape
  ByteString -> Put
putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Vector a -> ByteString
forall a. Storable a => Vector a -> ByteString
vectorToByteString Vector a
vs

arrayText :: (SVec.Storable a) => (a -> TB.Builder) -> [Int] -> SVec.Vector a -> TB.Builder
arrayText :: forall a.
Storable a =>
(a -> Builder) -> [Int] -> Vector a -> Builder
arrayText a -> Builder
p [] Vector a
vs =
  a -> Builder
p (a -> Builder) -> a -> Builder
forall a b. (a -> b) -> a -> b
$ Vector a -> a
forall a. Storable a => Vector a -> a
SVec.head Vector a
vs
arrayText a -> Builder
p (Int
d : [Int]
ds) Vector a
vs =
  Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
separator ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (Int -> Builder) -> [Int] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Builder) -> [Int] -> Vector a -> Builder
forall a.
Storable a =>
(a -> Builder) -> [Int] -> Vector a -> Builder
arrayText a -> Builder
p [Int]
ds (Vector a -> Builder) -> (Int -> Vector a) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Vector a
slice) [Int
0 .. Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]"
  where
    slice_size :: Int
slice_size = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int]
ds
    slice :: Int -> Vector a
slice Int
i = Int -> Int -> Vector a -> Vector a
forall a. Storable a => Int -> Int -> Vector a -> Vector a
SVec.slice (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
slice_size) Int
slice_size Vector a
vs
    separator :: Builder
separator
      | [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
ds = Builder
", "
      | Bool
otherwise = Builder
",\n"

-- | Construct a textual representation of the value as a strict text.
valueText :: Value -> T.Text
valueText :: Value -> Text
valueText Value
v
  | [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product (Value -> [Int]
valueShape Value
v) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 =
      Text
"empty(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dims Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PrimType -> Text
primTypeText (Value -> PrimType
valueElemType Value
v) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  where
    dims :: Text
dims = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
brackets (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) ([Int] -> [Text]) -> [Int] -> [Text]
forall a b. (a -> b) -> a -> b
$ Value -> [Int]
valueShape Value
v
    brackets :: a -> a
brackets a
s = a
"[" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"]"
valueText Value
v =
  case Value
v of
    I8Value Vector Int
shape Vector Int8
vs -> (Int8 -> Builder) -> Vector Int -> Vector Int8 -> Text
forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f Int8 -> Builder
forall {a}. Show a => a -> Builder
pNum Vector Int
shape Vector Int8
vs
    I16Value Vector Int
shape Vector Int16
vs -> (Int16 -> Builder) -> Vector Int -> Vector Int16 -> Text
forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f Int16 -> Builder
forall {a}. Show a => a -> Builder
pNum Vector Int
shape Vector Int16
vs
    I32Value Vector Int
shape Vector Int32
vs -> (Int32 -> Builder) -> Vector Int -> Vector Int32 -> Text
forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f Int32 -> Builder
forall {a}. Show a => a -> Builder
pNum Vector Int
shape Vector Int32
vs
    I64Value Vector Int
shape Vector Int64
vs -> (Int64 -> Builder) -> Vector Int -> Vector Int64 -> Text
forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f Int64 -> Builder
forall {a}. Show a => a -> Builder
pNum Vector Int
shape Vector Int64
vs
    U8Value Vector Int
shape Vector Word8
vs -> (Word8 -> Builder) -> Vector Int -> Vector Word8 -> Text
forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f Word8 -> Builder
forall {a}. Show a => a -> Builder
pNum Vector Int
shape Vector Word8
vs
    U16Value Vector Int
shape Vector Word16
vs -> (Word16 -> Builder) -> Vector Int -> Vector Word16 -> Text
forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f Word16 -> Builder
forall {a}. Show a => a -> Builder
pNum Vector Int
shape Vector Word16
vs
    U32Value Vector Int
shape Vector Word32
vs -> (Word32 -> Builder) -> Vector Int -> Vector Word32 -> Text
forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f Word32 -> Builder
forall {a}. Show a => a -> Builder
pNum Vector Int
shape Vector Word32
vs
    U64Value Vector Int
shape Vector Word64
vs -> (Word64 -> Builder) -> Vector Int -> Vector Word64 -> Text
forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f Word64 -> Builder
forall {a}. Show a => a -> Builder
pNum Vector Int
shape Vector Word64
vs
    F16Value Vector Int
shape Vector Half
vs -> (Half -> Builder) -> Vector Int -> Vector Half -> Text
forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f Half -> Builder
forall {a}. (RealFloat a, Show a) => a -> Builder
pF16 Vector Int
shape Vector Half
vs
    F32Value Vector Int
shape Vector Float
vs -> (Float -> Builder) -> Vector Int -> Vector Float -> Text
forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f Float -> Builder
forall {a}. (RealFloat a, Show a) => a -> Builder
pF32 Vector Int
shape Vector Float
vs
    F64Value Vector Int
shape Vector Double
vs -> (Double -> Builder) -> Vector Int -> Vector Double -> Text
forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f Double -> Builder
forall {a}. (RealFloat a, Show a) => a -> Builder
pF64 Vector Int
shape Vector Double
vs
    BoolValue Vector Int
shape Vector Bool
vs -> (Bool -> Builder) -> Vector Int -> Vector Bool -> Text
forall {a}.
Storable a =>
(a -> Builder) -> Vector Int -> Vector a -> Text
f Bool -> Builder
forall {a}. IsString a => Bool -> a
pBool Vector Int
shape Vector Bool
vs
  where
    suffix :: Text
suffix = PrimType -> Text
primTypeText (PrimType -> Text) -> PrimType -> Text
forall a b. (a -> b) -> a -> b
$ Value -> PrimType
valueElemType Value
v
    pNum :: a -> Builder
pNum a
x = String -> Builder
TB.fromString (a -> String
forall a. Show a => a -> String
show a
x) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TB.fromText Text
suffix
    pF16 :: a -> Builder
pF16 a
x
      | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x, a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 = Builder
"f16.inf"
      | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x, a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = Builder
"-f16.inf"
      | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x = Builder
"f16.nan"
      | Bool
otherwise = a -> Builder
forall {a}. Show a => a -> Builder
pNum a
x
    pF32 :: a -> Builder
pF32 a
x
      | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x, a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 = Builder
"f32.inf"
      | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x, a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = Builder
"-f32.inf"
      | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x = Builder
"f32.nan"
      | Bool
otherwise = a -> Builder
forall {a}. Show a => a -> Builder
pNum a
x
    pF64 :: a -> Builder
pF64 a
x
      | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x, a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 = Builder
"f64.inf"
      | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x, a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = Builder
"-f64.inf"
      | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x = Builder
"f64.nan"
      | Bool
otherwise = a -> Builder
forall {a}. Show a => a -> Builder
pNum a
x

    pBool :: Bool -> a
pBool Bool
True = a
"true"
    pBool Bool
False = a
"false"

    f :: (a -> Builder) -> Vector Int -> Vector a -> Text
f a -> Builder
p Vector Int
shape Vector a
vs = Text -> Text
LT.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
TB.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ (a -> Builder) -> [Int] -> Vector a -> Builder
forall a.
Storable a =>
(a -> Builder) -> [Int] -> Vector a -> Builder
arrayText a -> Builder
p (Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape) Vector a
vs

-- | The scalar types supported by the value format.
data PrimType = I8 | I16 | I32 | I64 | U8 | U16 | U32 | U64 | F16 | F32 | F64 | Bool
  deriving (PrimType -> PrimType -> Bool
(PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> Bool) -> Eq PrimType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrimType -> PrimType -> Bool
== :: PrimType -> PrimType -> Bool
$c/= :: PrimType -> PrimType -> Bool
/= :: PrimType -> PrimType -> Bool
Eq, Eq PrimType
Eq PrimType =>
(PrimType -> PrimType -> Ordering)
-> (PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> PrimType)
-> (PrimType -> PrimType -> PrimType)
-> Ord PrimType
PrimType -> PrimType -> Bool
PrimType -> PrimType -> Ordering
PrimType -> PrimType -> PrimType
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 :: PrimType -> PrimType -> Ordering
compare :: PrimType -> PrimType -> Ordering
$c< :: PrimType -> PrimType -> Bool
< :: PrimType -> PrimType -> Bool
$c<= :: PrimType -> PrimType -> Bool
<= :: PrimType -> PrimType -> Bool
$c> :: PrimType -> PrimType -> Bool
> :: PrimType -> PrimType -> Bool
$c>= :: PrimType -> PrimType -> Bool
>= :: PrimType -> PrimType -> Bool
$cmax :: PrimType -> PrimType -> PrimType
max :: PrimType -> PrimType -> PrimType
$cmin :: PrimType -> PrimType -> PrimType
min :: PrimType -> PrimType -> PrimType
Ord, Int -> PrimType -> ShowS
[PrimType] -> ShowS
PrimType -> String
(Int -> PrimType -> ShowS)
-> (PrimType -> String) -> ([PrimType] -> ShowS) -> Show PrimType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrimType -> ShowS
showsPrec :: Int -> PrimType -> ShowS
$cshow :: PrimType -> String
show :: PrimType -> String
$cshowList :: [PrimType] -> ShowS
showList :: [PrimType] -> ShowS
Show, Int -> PrimType
PrimType -> Int
PrimType -> [PrimType]
PrimType -> PrimType
PrimType -> PrimType -> [PrimType]
PrimType -> PrimType -> PrimType -> [PrimType]
(PrimType -> PrimType)
-> (PrimType -> PrimType)
-> (Int -> PrimType)
-> (PrimType -> Int)
-> (PrimType -> [PrimType])
-> (PrimType -> PrimType -> [PrimType])
-> (PrimType -> PrimType -> [PrimType])
-> (PrimType -> PrimType -> PrimType -> [PrimType])
-> Enum PrimType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PrimType -> PrimType
succ :: PrimType -> PrimType
$cpred :: PrimType -> PrimType
pred :: PrimType -> PrimType
$ctoEnum :: Int -> PrimType
toEnum :: Int -> PrimType
$cfromEnum :: PrimType -> Int
fromEnum :: PrimType -> Int
$cenumFrom :: PrimType -> [PrimType]
enumFrom :: PrimType -> [PrimType]
$cenumFromThen :: PrimType -> PrimType -> [PrimType]
enumFromThen :: PrimType -> PrimType -> [PrimType]
$cenumFromTo :: PrimType -> PrimType -> [PrimType]
enumFromTo :: PrimType -> PrimType -> [PrimType]
$cenumFromThenTo :: PrimType -> PrimType -> PrimType -> [PrimType]
enumFromThenTo :: PrimType -> PrimType -> PrimType -> [PrimType]
Enum, PrimType
PrimType -> PrimType -> Bounded PrimType
forall a. a -> a -> Bounded a
$cminBound :: PrimType
minBound :: PrimType
$cmaxBound :: PrimType
maxBound :: PrimType
Bounded)

-- | Textual primitive type as a strict text.
primTypeText :: PrimType -> T.Text
primTypeText :: PrimType -> Text
primTypeText PrimType
I8 = Text
"i8"
primTypeText PrimType
I16 = Text
"i16"
primTypeText PrimType
I32 = Text
"i32"
primTypeText PrimType
I64 = Text
"i64"
primTypeText PrimType
U8 = Text
"u8"
primTypeText PrimType
U16 = Text
"u16"
primTypeText PrimType
U32 = Text
"u32"
primTypeText PrimType
U64 = Text
"u64"
primTypeText PrimType
F16 = Text
"f16"
primTypeText PrimType
F32 = Text
"f32"
primTypeText PrimType
F64 = Text
"f64"
primTypeText PrimType
Bool = Text
"bool"

-- | The number of bytes taken up by a single element of this type.
primTypeBytes :: PrimType -> Int
primTypeBytes :: PrimType -> Int
primTypeBytes PrimType
I8 = Int
1
primTypeBytes PrimType
I16 = Int
2
primTypeBytes PrimType
I32 = Int
4
primTypeBytes PrimType
I64 = Int
8
primTypeBytes PrimType
U8 = Int
1
primTypeBytes PrimType
U16 = Int
2
primTypeBytes PrimType
U32 = Int
4
primTypeBytes PrimType
U64 = Int
8
primTypeBytes PrimType
F16 = Int
2
primTypeBytes PrimType
F32 = Int
4
primTypeBytes PrimType
F64 = Int
8
primTypeBytes PrimType
Bool = Int
1

-- | The type of a simple Futhark value, comprising a shape and an
-- element type.
data ValueType = ValueType [Int] PrimType
  deriving (ValueType -> ValueType -> Bool
(ValueType -> ValueType -> Bool)
-> (ValueType -> ValueType -> Bool) -> Eq ValueType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValueType -> ValueType -> Bool
== :: ValueType -> ValueType -> Bool
$c/= :: ValueType -> ValueType -> Bool
/= :: ValueType -> ValueType -> Bool
Eq, Eq ValueType
Eq ValueType =>
(ValueType -> ValueType -> Ordering)
-> (ValueType -> ValueType -> Bool)
-> (ValueType -> ValueType -> Bool)
-> (ValueType -> ValueType -> Bool)
-> (ValueType -> ValueType -> Bool)
-> (ValueType -> ValueType -> ValueType)
-> (ValueType -> ValueType -> ValueType)
-> Ord ValueType
ValueType -> ValueType -> Bool
ValueType -> ValueType -> Ordering
ValueType -> ValueType -> ValueType
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 :: ValueType -> ValueType -> Ordering
compare :: ValueType -> ValueType -> Ordering
$c< :: ValueType -> ValueType -> Bool
< :: ValueType -> ValueType -> Bool
$c<= :: ValueType -> ValueType -> Bool
<= :: ValueType -> ValueType -> Bool
$c> :: ValueType -> ValueType -> Bool
> :: ValueType -> ValueType -> Bool
$c>= :: ValueType -> ValueType -> Bool
>= :: ValueType -> ValueType -> Bool
$cmax :: ValueType -> ValueType -> ValueType
max :: ValueType -> ValueType -> ValueType
$cmin :: ValueType -> ValueType -> ValueType
min :: ValueType -> ValueType -> ValueType
Ord, Int -> ValueType -> ShowS
[ValueType] -> ShowS
ValueType -> String
(Int -> ValueType -> ShowS)
-> (ValueType -> String)
-> ([ValueType] -> ShowS)
-> Show ValueType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValueType -> ShowS
showsPrec :: Int -> ValueType -> ShowS
$cshow :: ValueType -> String
show :: ValueType -> String
$cshowList :: [ValueType] -> ShowS
showList :: [ValueType] -> ShowS
Show)

-- | Prettyprint a value type as a strict text.
valueTypeText :: ValueType -> T.Text
valueTypeText :: ValueType -> Text
valueTypeText (ValueType [Int]
ds PrimType
t) = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ((Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
forall {a}. Show a => a -> Text
pprDim [Int]
ds) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PrimType -> Text
primTypeText PrimType
t
  where
    pprDim :: a -> Text
pprDim a
d = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
d) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"

-- | Prettyprint a value type with empty dimensions as a strict text.
-- This is needed for Futhark server programs, whose types are
-- un-sized.
valueTypeTextNoDims :: ValueType -> T.Text
valueTypeTextNoDims :: ValueType -> Text
valueTypeTextNoDims (ValueType [Int]
dims PrimType
t) =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat (Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
dims) Text
"[]") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PrimType -> Text
primTypeText PrimType
t

-- | Get the type of a value.
valueType :: Value -> ValueType
valueType :: Value -> ValueType
valueType Value
v = [Int] -> PrimType -> ValueType
ValueType (Value -> [Int]
valueShape Value
v) (PrimType -> ValueType) -> PrimType -> ValueType
forall a b. (a -> b) -> a -> b
$ Value -> PrimType
valueElemType Value
v

-- | Get the element type of a value.
valueElemType :: Value -> PrimType
valueElemType :: Value -> PrimType
valueElemType I8Value {} = PrimType
I8
valueElemType I16Value {} = PrimType
I16
valueElemType I32Value {} = PrimType
I32
valueElemType I64Value {} = PrimType
I64
valueElemType U8Value {} = PrimType
U8
valueElemType U16Value {} = PrimType
U16
valueElemType U32Value {} = PrimType
U32
valueElemType U64Value {} = PrimType
U64
valueElemType F16Value {} = PrimType
F16
valueElemType F32Value {} = PrimType
F32
valueElemType F64Value {} = PrimType
F64
valueElemType BoolValue {} = PrimType
Bool

-- | The shape of a value.  Empty list in case of a scalar.
valueShape :: Value -> [Int]
valueShape :: Value -> [Int]
valueShape (I8Value Vector Int
shape Vector Int8
_) = Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (I16Value Vector Int
shape Vector Int16
_) = Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (I32Value Vector Int
shape Vector Int32
_) = Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (I64Value Vector Int
shape Vector Int64
_) = Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (U8Value Vector Int
shape Vector Word8
_) = Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (U16Value Vector Int
shape Vector Word16
_) = Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (U32Value Vector Int
shape Vector Word32
_) = Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (U64Value Vector Int
shape Vector Word64
_) = Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (F16Value Vector Int
shape Vector Half
_) = Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (F32Value Vector Int
shape Vector Float
_) = Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (F64Value Vector Int
shape Vector Double
_) = Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape
valueShape (BoolValue Vector Int
shape Vector Bool
_) = Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape

-- Conversions

-- | Produce a list of the immediate elements of the value.  That is,
-- a 2D array will produce a list of 1D values.  A zero-dimensional
-- value will produce an empty list.  While lists are of course
-- inefficient, the actual values are just slices of the original
-- value, which makes them fairly space-efficient (but beware space
-- leaks).
valueElems :: Value -> [Value]
valueElems :: Value -> [Value]
valueElems Value
v
  | Int
n : [Int]
ns <- Value -> [Int]
valueShape Value
v =
      let k :: Int
k = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int]
ns
          slices :: (Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector a -> a
mk Vector a
vs =
            [ Vector Int -> Vector a -> a
mk ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
ns) (Vector a -> a) -> Vector a -> a
forall a b. (a -> b) -> a -> b
$
                Int -> Int -> Vector a -> Vector a
forall a. Storable a => Int -> Int -> Vector a -> Vector a
SVec.slice (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) Int
k Vector a
vs
              | Int
i <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
            ]
       in case Value
v of
            I8Value Vector Int
_ Vector Int8
vs -> (Vector Int -> Vector Int8 -> Value) -> Vector Int8 -> [Value]
forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Int8 -> Value
I8Value Vector Int8
vs
            I16Value Vector Int
_ Vector Int16
vs -> (Vector Int -> Vector Int16 -> Value) -> Vector Int16 -> [Value]
forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Int16 -> Value
I16Value Vector Int16
vs
            I32Value Vector Int
_ Vector Int32
vs -> (Vector Int -> Vector Int32 -> Value) -> Vector Int32 -> [Value]
forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Int32 -> Value
I32Value Vector Int32
vs
            I64Value Vector Int
_ Vector Int64
vs -> (Vector Int -> Vector Int64 -> Value) -> Vector Int64 -> [Value]
forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Int64 -> Value
I64Value Vector Int64
vs
            U8Value Vector Int
_ Vector Word8
vs -> (Vector Int -> Vector Word8 -> Value) -> Vector Word8 -> [Value]
forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Word8 -> Value
U8Value Vector Word8
vs
            U16Value Vector Int
_ Vector Word16
vs -> (Vector Int -> Vector Word16 -> Value) -> Vector Word16 -> [Value]
forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Word16 -> Value
U16Value Vector Word16
vs
            U32Value Vector Int
_ Vector Word32
vs -> (Vector Int -> Vector Word32 -> Value) -> Vector Word32 -> [Value]
forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Word32 -> Value
U32Value Vector Word32
vs
            U64Value Vector Int
_ Vector Word64
vs -> (Vector Int -> Vector Word64 -> Value) -> Vector Word64 -> [Value]
forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Word64 -> Value
U64Value Vector Word64
vs
            F16Value Vector Int
_ Vector Half
vs -> (Vector Int -> Vector Half -> Value) -> Vector Half -> [Value]
forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Half -> Value
F16Value Vector Half
vs
            F32Value Vector Int
_ Vector Float
vs -> (Vector Int -> Vector Float -> Value) -> Vector Float -> [Value]
forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Float -> Value
F32Value Vector Float
vs
            F64Value Vector Int
_ Vector Double
vs -> (Vector Int -> Vector Double -> Value) -> Vector Double -> [Value]
forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Double -> Value
F64Value Vector Double
vs
            BoolValue Vector Int
_ Vector Bool
vs -> (Vector Int -> Vector Bool -> Value) -> Vector Bool -> [Value]
forall {a} {a}.
Storable a =>
(Vector Int -> Vector a -> a) -> Vector a -> [a]
slices Vector Int -> Vector Bool -> Value
BoolValue Vector Bool
vs
  | Bool
otherwise =
      []

-- | A class for Haskell values that can be retrieved from 'Value'.
-- This is a convenience facility - don't expect it to be fast.
class GetValue t where
  getValue :: Value -> Maybe t

instance (GetValue t) => GetValue [t] where
  getValue :: Value -> Maybe [t]
getValue Value
v
    | [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Int] -> Bool) -> [Int] -> Bool
forall a b. (a -> b) -> a -> b
$ Value -> [Int]
valueShape Value
v = Maybe [t]
forall a. Maybe a
Nothing
    | Bool
otherwise = (Value -> Maybe t) -> [Value] -> Maybe [t]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Maybe t
forall t. GetValue t => Value -> Maybe t
getValue ([Value] -> Maybe [t]) -> [Value] -> Maybe [t]
forall a b. (a -> b) -> a -> b
$ Value -> [Value]
valueElems Value
v

instance GetValue Bool where
  getValue :: Value -> Maybe Bool
getValue (BoolValue Vector Int
shape Vector Bool
vs)
    | [] <- Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Vector Bool
vs Vector Bool -> Int -> Bool
forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = Maybe Bool
forall a. Maybe a
Nothing

instance GetValue Int8 where
  getValue :: Value -> Maybe Int8
getValue (I8Value Vector Int
shape Vector Int8
vs)
    | [] <- Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        Int8 -> Maybe Int8
forall a. a -> Maybe a
Just (Int8 -> Maybe Int8) -> Int8 -> Maybe Int8
forall a b. (a -> b) -> a -> b
$ Vector Int8
vs Vector Int8 -> Int -> Int8
forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = Maybe Int8
forall a. Maybe a
Nothing

instance GetValue Int16 where
  getValue :: Value -> Maybe Int16
getValue (I16Value Vector Int
shape Vector Int16
vs)
    | [] <- Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        Int16 -> Maybe Int16
forall a. a -> Maybe a
Just (Int16 -> Maybe Int16) -> Int16 -> Maybe Int16
forall a b. (a -> b) -> a -> b
$ Vector Int16
vs Vector Int16 -> Int -> Int16
forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = Maybe Int16
forall a. Maybe a
Nothing

instance GetValue Int32 where
  getValue :: Value -> Maybe Int32
getValue (I32Value Vector Int
shape Vector Int32
vs)
    | [] <- Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        Int32 -> Maybe Int32
forall a. a -> Maybe a
Just (Int32 -> Maybe Int32) -> Int32 -> Maybe Int32
forall a b. (a -> b) -> a -> b
$ Vector Int32
vs Vector Int32 -> Int -> Int32
forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = Maybe Int32
forall a. Maybe a
Nothing

instance GetValue Int64 where
  getValue :: Value -> Maybe Int64
getValue (I64Value Vector Int
shape Vector Int64
vs)
    | [] <- Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64) -> Int64 -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ Vector Int64
vs Vector Int64 -> Int -> Int64
forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = Maybe Int64
forall a. Maybe a
Nothing

instance GetValue Word8 where
  getValue :: Value -> Maybe Word8
getValue (U8Value Vector Int
shape Vector Word8
vs)
    | [] <- Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$ Vector Word8
vs Vector Word8 -> Int -> Word8
forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = Maybe Word8
forall a. Maybe a
Nothing

instance GetValue Word16 where
  getValue :: Value -> Maybe Word16
getValue (U16Value Vector Int
shape Vector Word16
vs)
    | [] <- Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        Word16 -> Maybe Word16
forall a. a -> Maybe a
Just (Word16 -> Maybe Word16) -> Word16 -> Maybe Word16
forall a b. (a -> b) -> a -> b
$ Vector Word16
vs Vector Word16 -> Int -> Word16
forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = Maybe Word16
forall a. Maybe a
Nothing

instance GetValue Word32 where
  getValue :: Value -> Maybe Word32
getValue (U32Value Vector Int
shape Vector Word32
vs)
    | [] <- Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> Maybe Word32) -> Word32 -> Maybe Word32
forall a b. (a -> b) -> a -> b
$ Vector Word32
vs Vector Word32 -> Int -> Word32
forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = Maybe Word32
forall a. Maybe a
Nothing

instance GetValue Word64 where
  getValue :: Value -> Maybe Word64
getValue (U64Value Vector Int
shape Vector Word64
vs)
    | [] <- Vector Int -> [Int]
forall a. Storable a => Vector a -> [a]
SVec.toList Vector Int
shape =
        Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Vector Word64
vs Vector Word64 -> Int -> Word64
forall a. Storable a => Vector a -> Int -> a
SVec.! Int
0
  getValue Value
_ = Maybe Word64
forall a. Maybe a
Nothing

-- | A class for Haskell values that can be converted to 'Value'.
-- This is a convenience facility - don't expect it to be fast.
class PutValue t where
  -- | This may fail for cases such as irregular arrays.
  putValue :: t -> Maybe Value

instance PutValue Int8 where
  putValue :: Int8 -> Maybe Value
putValue = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> (Int8 -> Value) -> Int8 -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Value
forall t. PutValue1 t => t -> Value
putValue1

instance PutValue Int16 where
  putValue :: Int16 -> Maybe Value
putValue = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> (Int16 -> Value) -> Int16 -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Value
forall t. PutValue1 t => t -> Value
putValue1

instance PutValue Int32 where
  putValue :: Int32 -> Maybe Value
putValue = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> (Int32 -> Value) -> Int32 -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Value
forall t. PutValue1 t => t -> Value
putValue1

instance PutValue Int64 where
  putValue :: Int64 -> Maybe Value
putValue = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> (Int64 -> Value) -> Int64 -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Value
forall t. PutValue1 t => t -> Value
putValue1

instance PutValue Word8 where
  putValue :: Word8 -> Maybe Value
putValue = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> (Word8 -> Value) -> Word8 -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Value
forall t. PutValue1 t => t -> Value
putValue1

instance PutValue Word16 where
  putValue :: Word16 -> Maybe Value
putValue = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value)
-> (Word16 -> Value) -> Word16 -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Value
forall t. PutValue1 t => t -> Value
putValue1

instance PutValue Word32 where
  putValue :: Word32 -> Maybe Value
putValue = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value)
-> (Word32 -> Value) -> Word32 -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Value
forall t. PutValue1 t => t -> Value
putValue1

instance PutValue Word64 where
  putValue :: Word64 -> Maybe Value
putValue = Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value)
-> (Word64 -> Value) -> Word64 -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Value
forall t. PutValue1 t => t -> Value
putValue1

instance PutValue [Value] where
  putValue :: [Value] -> Maybe Value
putValue [] = Maybe Value
forall a. Maybe a
Nothing
  putValue (Value
x : [Value]
xs) = do
    let res_shape :: Vector Int
res_shape = [Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList ([Int] -> Vector Int) -> [Int] -> Vector Int
forall a b. (a -> b) -> a -> b
$ [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Value
x Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
xs) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Value -> [Int]
valueShape Value
x
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (Value -> Bool) -> [Value] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> ValueType
valueType Value
x) (ValueType -> Bool) -> (Value -> ValueType) -> Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ValueType
valueType) [Value]
xs
    Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ case Value
x of
      I8Value {} -> Vector Int -> Vector Int8 -> Value
I8Value Vector Int
res_shape (Vector Int8 -> Value) -> Vector Int8 -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Vector Int8) -> [Value] -> Vector Int8
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Vector Int8
forall {b}. Storable b => Value -> Vector b
getVec (Value
x Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
xs)
      I16Value {} -> Vector Int -> Vector Int16 -> Value
I16Value Vector Int
res_shape (Vector Int16 -> Value) -> Vector Int16 -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Vector Int16) -> [Value] -> Vector Int16
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Vector Int16
forall {b}. Storable b => Value -> Vector b
getVec (Value
x Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
xs)
      I32Value {} -> Vector Int -> Vector Int32 -> Value
I32Value Vector Int
res_shape (Vector Int32 -> Value) -> Vector Int32 -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Vector Int32) -> [Value] -> Vector Int32
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Vector Int32
forall {b}. Storable b => Value -> Vector b
getVec (Value
x Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
xs)
      I64Value {} -> Vector Int -> Vector Int64 -> Value
I64Value Vector Int
res_shape (Vector Int64 -> Value) -> Vector Int64 -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Vector Int64) -> [Value] -> Vector Int64
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Vector Int64
forall {b}. Storable b => Value -> Vector b
getVec (Value
x Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
xs)
      U8Value {} -> Vector Int -> Vector Word8 -> Value
U8Value Vector Int
res_shape (Vector Word8 -> Value) -> Vector Word8 -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Vector Word8) -> [Value] -> Vector Word8
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Vector Word8
forall {b}. Storable b => Value -> Vector b
getVec (Value
x Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
xs)
      U16Value {} -> Vector Int -> Vector Word16 -> Value
U16Value Vector Int
res_shape (Vector Word16 -> Value) -> Vector Word16 -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Vector Word16) -> [Value] -> Vector Word16
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Vector Word16
forall {b}. Storable b => Value -> Vector b
getVec (Value
x Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
xs)
      U32Value {} -> Vector Int -> Vector Word32 -> Value
U32Value Vector Int
res_shape (Vector Word32 -> Value) -> Vector Word32 -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Vector Word32) -> [Value] -> Vector Word32
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Vector Word32
forall {b}. Storable b => Value -> Vector b
getVec (Value
x Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
xs)
      U64Value {} -> Vector Int -> Vector Word64 -> Value
U64Value Vector Int
res_shape (Vector Word64 -> Value) -> Vector Word64 -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Vector Word64) -> [Value] -> Vector Word64
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Vector Word64
forall {b}. Storable b => Value -> Vector b
getVec (Value
x Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
xs)
      F16Value {} -> Vector Int -> Vector Half -> Value
F16Value Vector Int
res_shape (Vector Half -> Value) -> Vector Half -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Vector Half) -> [Value] -> Vector Half
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Vector Half
forall {b}. Storable b => Value -> Vector b
getVec (Value
x Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
xs)
      F32Value {} -> Vector Int -> Vector Float -> Value
F32Value Vector Int
res_shape (Vector Float -> Value) -> Vector Float -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Vector Float) -> [Value] -> Vector Float
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Vector Float
forall {b}. Storable b => Value -> Vector b
getVec (Value
x Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
xs)
      F64Value {} -> Vector Int -> Vector Double -> Value
F64Value Vector Int
res_shape (Vector Double -> Value) -> Vector Double -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Vector Double) -> [Value] -> Vector Double
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Vector Double
forall {b}. Storable b => Value -> Vector b
getVec (Value
x Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
xs)
      BoolValue {} -> Vector Int -> Vector Bool -> Value
BoolValue Vector Int
res_shape (Vector Bool -> Value) -> Vector Bool -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Vector Bool) -> [Value] -> Vector Bool
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Value -> Vector Bool
forall {b}. Storable b => Value -> Vector b
getVec (Value
x Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
xs)
    where
      getVec :: Value -> Vector b
getVec (I8Value Vector Int
_ Vector Int8
vec) = Vector Int8 -> Vector b
forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Int8
vec
      getVec (I16Value Vector Int
_ Vector Int16
vec) = Vector Int16 -> Vector b
forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Int16
vec
      getVec (I32Value Vector Int
_ Vector Int32
vec) = Vector Int32 -> Vector b
forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Int32
vec
      getVec (I64Value Vector Int
_ Vector Int64
vec) = Vector Int64 -> Vector b
forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Int64
vec
      getVec (U8Value Vector Int
_ Vector Word8
vec) = Vector Word8 -> Vector b
forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Word8
vec
      getVec (U16Value Vector Int
_ Vector Word16
vec) = Vector Word16 -> Vector b
forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Word16
vec
      getVec (U32Value Vector Int
_ Vector Word32
vec) = Vector Word32 -> Vector b
forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Word32
vec
      getVec (U64Value Vector Int
_ Vector Word64
vec) = Vector Word64 -> Vector b
forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Word64
vec
      getVec (F16Value Vector Int
_ Vector Half
vec) = Vector Half -> Vector b
forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Half
vec
      getVec (F32Value Vector Int
_ Vector Float
vec) = Vector Float -> Vector b
forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Float
vec
      getVec (F64Value Vector Int
_ Vector Double
vec) = Vector Double -> Vector b
forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Double
vec
      getVec (BoolValue Vector Int
_ Vector Bool
vec) = Vector Bool -> Vector b
forall a b. (Storable a, Storable b) => Vector a -> Vector b
SVec.unsafeCast Vector Bool
vec

instance PutValue T.Text where
  putValue :: Text -> Maybe Value
putValue = ByteString -> Maybe Value
forall t. PutValue t => t -> Maybe Value
putValue (ByteString -> Maybe Value)
-> (Text -> ByteString) -> Text -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

instance PutValue BS.ByteString where
  putValue :: ByteString -> Maybe Value
putValue ByteString
bs =
    Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Vector Int -> Vector Word8 -> Value
U8Value Vector Int
size (Vector Word8 -> Value) -> Vector Word8 -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Vector Word8
forall a. Storable a => ByteString -> Vector a
byteStringToVector ByteString
bs
    where
      size :: Vector Int
size = [Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs)]

instance PutValue LBS.ByteString where
  putValue :: ByteString -> Maybe Value
putValue = ByteString -> Maybe Value
forall t. PutValue t => t -> Maybe Value
putValue (ByteString -> Maybe Value)
-> (ByteString -> ByteString) -> ByteString -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict

-- | Like 'PutValue', but only for scalars and a few other simple
-- things that cannot fail.
class PutValue1 t where
  putValue1 :: t -> Value

instance PutValue1 Int8 where
  putValue1 :: Int8 -> Value
putValue1 = Vector Int -> Vector Int8 -> Value
I8Value Vector Int
forall a. Monoid a => a
mempty (Vector Int8 -> Value) -> (Int8 -> Vector Int8) -> Int8 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Vector Int8
forall a. Storable a => a -> Vector a
SVec.singleton

instance PutValue1 Int16 where
  putValue1 :: Int16 -> Value
putValue1 = Vector Int -> Vector Int16 -> Value
I16Value Vector Int
forall a. Monoid a => a
mempty (Vector Int16 -> Value)
-> (Int16 -> Vector Int16) -> Int16 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Vector Int16
forall a. Storable a => a -> Vector a
SVec.singleton

instance PutValue1 Int32 where
  putValue1 :: Int32 -> Value
putValue1 = Vector Int -> Vector Int32 -> Value
I32Value Vector Int
forall a. Monoid a => a
mempty (Vector Int32 -> Value)
-> (Int32 -> Vector Int32) -> Int32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Vector Int32
forall a. Storable a => a -> Vector a
SVec.singleton

instance PutValue1 Int64 where
  putValue1 :: Int64 -> Value
putValue1 = Vector Int -> Vector Int64 -> Value
I64Value Vector Int
forall a. Monoid a => a
mempty (Vector Int64 -> Value)
-> (Int64 -> Vector Int64) -> Int64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Vector Int64
forall a. Storable a => a -> Vector a
SVec.singleton

instance PutValue1 Word8 where
  putValue1 :: Word8 -> Value
putValue1 = Vector Int -> Vector Word8 -> Value
U8Value Vector Int
forall a. Monoid a => a
mempty (Vector Word8 -> Value)
-> (Word8 -> Vector Word8) -> Word8 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Vector Word8
forall a. Storable a => a -> Vector a
SVec.singleton

instance PutValue1 Word16 where
  putValue1 :: Word16 -> Value
putValue1 = Vector Int -> Vector Word16 -> Value
U16Value Vector Int
forall a. Monoid a => a
mempty (Vector Word16 -> Value)
-> (Word16 -> Vector Word16) -> Word16 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Vector Word16
forall a. Storable a => a -> Vector a
SVec.singleton

instance PutValue1 Word32 where
  putValue1 :: Word32 -> Value
putValue1 = Vector Int -> Vector Word32 -> Value
U32Value Vector Int
forall a. Monoid a => a
mempty (Vector Word32 -> Value)
-> (Word32 -> Vector Word32) -> Word32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Vector Word32
forall a. Storable a => a -> Vector a
SVec.singleton

instance PutValue1 Word64 where
  putValue1 :: Word64 -> Value
putValue1 = Vector Int -> Vector Word64 -> Value
U64Value Vector Int
forall a. Monoid a => a
mempty (Vector Word64 -> Value)
-> (Word64 -> Vector Word64) -> Word64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Vector Word64
forall a. Storable a => a -> Vector a
SVec.singleton

instance PutValue1 T.Text where
  putValue1 :: Text -> Value
putValue1 = ByteString -> Value
forall t. PutValue1 t => t -> Value
putValue1 (ByteString -> Value) -> (Text -> ByteString) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

instance PutValue1 BS.ByteString where
  putValue1 :: ByteString -> Value
putValue1 ByteString
bs = Vector Int -> Vector Word8 -> Value
U8Value Vector Int
size (Vector Word8 -> Value) -> Vector Word8 -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Vector Word8
forall a. Storable a => ByteString -> Vector a
byteStringToVector ByteString
bs
    where
      size :: Vector Int
size = [Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs)]

instance PutValue1 LBS.ByteString where
  putValue1 :: ByteString -> Value
putValue1 = ByteString -> Value
forall t. PutValue1 t => t -> Value
putValue1 (ByteString -> Value)
-> (ByteString -> ByteString) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict