{-# LANGUAGE OverloadedStrings #-}

-- | Megaparsec-based parser for primitive 'Value's.  The difference
-- between this and the parser defined in "Futhark.Test.Values" is
-- that we don't try to handle both the textual and binary format -
-- only the former.  On the other hand, this parser has (much) better
-- error messages and can be easily used by other parsers (like the
-- ones for FutharkScript or test blocks.
module Futhark.Test.Values.Parser
  ( parsePrimType,
    parseType,
    parsePrimValue,
    parseValue,
  )
where

import Control.Monad.Except
import Data.Functor
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Vector.Storable as SVec
import Data.Void
import Futhark.Test.Values
import qualified Language.Futhark.Syntax as F
import Text.Megaparsec
import Text.Megaparsec.Char.Lexer
  ( binary,
    decimal,
    float,
    hexadecimal,
    signed,
  )

type Parser = Parsec Void T.Text

-- | Parse the name of a primitive type.  Does *not* consume any
-- trailing whitespace, nor does it permit any internal whitespace.
parsePrimType :: Parser F.PrimType
parsePrimType :: Parser PrimType
parsePrimType =
  [Parser PrimType] -> Parser PrimType
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ ParsecT Void Text Identity Text
"i8" ParsecT Void Text Identity Text -> PrimType -> Parser PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntType -> PrimType
F.Signed IntType
F.Int8,
      ParsecT Void Text Identity Text
"i16" ParsecT Void Text Identity Text -> PrimType -> Parser PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntType -> PrimType
F.Signed IntType
F.Int16,
      ParsecT Void Text Identity Text
"i32" ParsecT Void Text Identity Text -> PrimType -> Parser PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntType -> PrimType
F.Signed IntType
F.Int32,
      ParsecT Void Text Identity Text
"i64" ParsecT Void Text Identity Text -> PrimType -> Parser PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntType -> PrimType
F.Signed IntType
F.Int64,
      ParsecT Void Text Identity Text
"u8" ParsecT Void Text Identity Text -> PrimType -> Parser PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntType -> PrimType
F.Unsigned IntType
F.Int8,
      ParsecT Void Text Identity Text
"u16" ParsecT Void Text Identity Text -> PrimType -> Parser PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntType -> PrimType
F.Unsigned IntType
F.Int16,
      ParsecT Void Text Identity Text
"u32" ParsecT Void Text Identity Text -> PrimType -> Parser PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntType -> PrimType
F.Unsigned IntType
F.Int32,
      ParsecT Void Text Identity Text
"u64" ParsecT Void Text Identity Text -> PrimType -> Parser PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntType -> PrimType
F.Unsigned IntType
F.Int64,
      ParsecT Void Text Identity Text
"f32" ParsecT Void Text Identity Text -> PrimType -> Parser PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FloatType -> PrimType
F.FloatType FloatType
F.Float32,
      ParsecT Void Text Identity Text
"f64" ParsecT Void Text Identity Text -> PrimType -> Parser PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FloatType -> PrimType
F.FloatType FloatType
F.Float64,
      ParsecT Void Text Identity Text
"bool" ParsecT Void Text Identity Text -> PrimType -> Parser PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> PrimType
F.Bool
    ]

parseInteger :: Parser Integer
parseInteger :: Parser Integer
parseInteger =
  ParsecT Void Text Identity () -> Parser Integer -> Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed (() -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Parser Integer -> Parser Integer)
-> Parser Integer -> Parser Integer
forall a b. (a -> b) -> a -> b
$
    [Parser Integer] -> Parser Integer
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ ParsecT Void Text Identity Text
"0b" ParsecT Void Text Identity Text -> Parser Integer -> Parser Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
binary,
        ParsecT Void Text Identity Text
"0x" ParsecT Void Text Identity Text -> Parser Integer -> Parser Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
hexadecimal,
        Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
      ]

parseIntConst :: Parser F.PrimValue
parseIntConst :: Parser PrimValue
parseIntConst = do
  Integer
x <- Parser Integer
parseInteger
  ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Text
"f32" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Text
"f64" ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Text
"."
  [Parser PrimValue] -> Parser PrimValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ (Int8 -> IntValue)
-> Integer -> ParsecT Void Text Identity Text -> Parser PrimValue
forall (f :: * -> *) t a.
(Functor f, Num t) =>
(t -> IntValue) -> Integer -> f a -> f PrimValue
signedV Int8 -> IntValue
F.Int8Value Integer
x ParsecT Void Text Identity Text
"i8",
      (Int16 -> IntValue)
-> Integer -> ParsecT Void Text Identity Text -> Parser PrimValue
forall (f :: * -> *) t a.
(Functor f, Num t) =>
(t -> IntValue) -> Integer -> f a -> f PrimValue
signedV Int16 -> IntValue
F.Int16Value Integer
x ParsecT Void Text Identity Text
"i16",
      (Int32 -> IntValue)
-> Integer -> ParsecT Void Text Identity Text -> Parser PrimValue
forall (f :: * -> *) t a.
(Functor f, Num t) =>
(t -> IntValue) -> Integer -> f a -> f PrimValue
signedV Int32 -> IntValue
F.Int32Value Integer
x ParsecT Void Text Identity Text
"i32",
      (Int64 -> IntValue)
-> Integer -> ParsecT Void Text Identity Text -> Parser PrimValue
forall (f :: * -> *) t a.
(Functor f, Num t) =>
(t -> IntValue) -> Integer -> f a -> f PrimValue
signedV Int64 -> IntValue
F.Int64Value Integer
x ParsecT Void Text Identity Text
"i64",
      (Int8 -> IntValue)
-> Integer -> ParsecT Void Text Identity Text -> Parser PrimValue
forall (f :: * -> *) t a.
(Functor f, Num t) =>
(t -> IntValue) -> Integer -> f a -> f PrimValue
unsignedV Int8 -> IntValue
F.Int8Value Integer
x ParsecT Void Text Identity Text
"u8",
      (Int16 -> IntValue)
-> Integer -> ParsecT Void Text Identity Text -> Parser PrimValue
forall (f :: * -> *) t a.
(Functor f, Num t) =>
(t -> IntValue) -> Integer -> f a -> f PrimValue
unsignedV Int16 -> IntValue
F.Int16Value Integer
x ParsecT Void Text Identity Text
"u16",
      (Int32 -> IntValue)
-> Integer -> ParsecT Void Text Identity Text -> Parser PrimValue
forall (f :: * -> *) t a.
(Functor f, Num t) =>
(t -> IntValue) -> Integer -> f a -> f PrimValue
unsignedV Int32 -> IntValue
F.Int32Value Integer
x ParsecT Void Text Identity Text
"u32",
      (Int64 -> IntValue)
-> Integer -> ParsecT Void Text Identity Text -> Parser PrimValue
forall (f :: * -> *) t a.
(Functor f, Num t) =>
(t -> IntValue) -> Integer -> f a -> f PrimValue
unsignedV Int64 -> IntValue
F.Int64Value Integer
x ParsecT Void Text Identity Text
"u64",
      (Int32 -> IntValue)
-> Integer -> ParsecT Void Text Identity Text -> Parser PrimValue
forall (f :: * -> *) t a.
(Functor f, Num t) =>
(t -> IntValue) -> Integer -> f a -> f PrimValue
signedV Int32 -> IntValue
F.Int32Value Integer
x ParsecT Void Text Identity Text
""
    ]
  where
    signedV :: (t -> IntValue) -> Integer -> f a -> f PrimValue
signedV t -> IntValue
mk Integer
x f a
suffix =
      f a
suffix f a -> PrimValue -> f PrimValue
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntValue -> PrimValue
F.SignedValue (t -> IntValue
mk (Integer -> t
forall a. Num a => Integer -> a
fromInteger Integer
x))
    unsignedV :: (t -> IntValue) -> Integer -> f a -> f PrimValue
unsignedV t -> IntValue
mk Integer
x f a
suffix =
      f a
suffix f a -> PrimValue -> f PrimValue
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IntValue -> PrimValue
F.UnsignedValue (t -> IntValue
mk (Integer -> t
forall a. Num a => Integer -> a
fromInteger Integer
x))

parseFloatConst :: Parser F.PrimValue
parseFloatConst :: Parser PrimValue
parseFloatConst =
  [Parser PrimValue] -> Parser PrimValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ ParsecT Void Text Identity Text
"f32.nan" ParsecT Void Text Identity Text -> PrimValue -> Parser PrimValue
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FloatValue -> PrimValue
F.FloatValue (Float -> FloatValue
F.Float32Value (Float
0 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
0)),
      ParsecT Void Text Identity Text
"f64.nan" ParsecT Void Text Identity Text -> PrimValue -> Parser PrimValue
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FloatValue -> PrimValue
F.FloatValue (Double -> FloatValue
F.Float64Value (Double
0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0)),
      ParsecT Void Text Identity Text
"f32.inf" ParsecT Void Text Identity Text -> PrimValue -> Parser PrimValue
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FloatValue -> PrimValue
F.FloatValue (Float -> FloatValue
F.Float32Value (Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
0)),
      ParsecT Void Text Identity Text
"f64.inf" ParsecT Void Text Identity Text -> PrimValue -> Parser PrimValue
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FloatValue -> PrimValue
F.FloatValue (Double -> FloatValue
F.Float64Value (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0)),
      ParsecT Void Text Identity Text
"-f32.inf" ParsecT Void Text Identity Text -> PrimValue -> Parser PrimValue
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FloatValue -> PrimValue
F.FloatValue (Float -> FloatValue
F.Float32Value (-Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
0)),
      ParsecT Void Text Identity Text
"-f64.inf" ParsecT Void Text Identity Text -> PrimValue -> Parser PrimValue
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FloatValue -> PrimValue
F.FloatValue (Double -> FloatValue
F.Float64Value (-Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0)),
      Parser PrimValue
numeric
    ]
  where
    numeric :: Parser PrimValue
numeric = do
      Double
x <-
        ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Double
-> ParsecT Void Text Identity Double
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
signed (() -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (ParsecT Void Text Identity Double
 -> ParsecT Void Text Identity Double)
-> ParsecT Void Text Identity Double
-> ParsecT Void Text Identity Double
forall a b. (a -> b) -> a -> b
$ [ParsecT Void Text Identity Double]
-> ParsecT Void Text Identity Double
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ParsecT Void Text Identity Double
-> ParsecT Void Text Identity Double
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Double
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
float, Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Integer -> Double)
-> Parser Integer -> ParsecT Void Text Identity Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal]
      [Parser PrimValue] -> Parser PrimValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
        [ (Float -> FloatValue)
-> Double -> ParsecT Void Text Identity Text -> Parser PrimValue
forall (f :: * -> *) t a.
(Functor f, Fractional t) =>
(t -> FloatValue) -> Double -> f a -> f PrimValue
floatV Float -> FloatValue
F.Float32Value Double
x ParsecT Void Text Identity Text
"f32",
          (Double -> FloatValue)
-> Double -> ParsecT Void Text Identity Text -> Parser PrimValue
forall (f :: * -> *) t a.
(Functor f, Fractional t) =>
(t -> FloatValue) -> Double -> f a -> f PrimValue
floatV Double -> FloatValue
F.Float64Value Double
x ParsecT Void Text Identity Text
"f64",
          (Double -> FloatValue)
-> Double -> ParsecT Void Text Identity Text -> Parser PrimValue
forall (f :: * -> *) t a.
(Functor f, Fractional t) =>
(t -> FloatValue) -> Double -> f a -> f PrimValue
floatV Double -> FloatValue
F.Float64Value Double
x ParsecT Void Text Identity Text
""
        ]

    floatV :: (t -> FloatValue) -> Double -> f a -> f PrimValue
floatV t -> FloatValue
mk Double
x f a
suffix =
      f a
suffix f a -> PrimValue -> f PrimValue
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FloatValue -> PrimValue
F.FloatValue (t -> FloatValue
mk (Double -> t
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double
x :: Double)))

-- | Parse a primitive value.  Does *not* consume any trailing
-- whitespace, nor does it permit any internal whitespace.
parsePrimValue :: Parser F.PrimValue
parsePrimValue :: Parser PrimValue
parsePrimValue =
  [Parser PrimValue] -> Parser PrimValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Parser PrimValue -> Parser PrimValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser PrimValue
parseIntConst,
      Parser PrimValue
parseFloatConst,
      ParsecT Void Text Identity Text
"true" ParsecT Void Text Identity Text -> PrimValue -> Parser PrimValue
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool -> PrimValue
F.BoolValue Bool
True,
      ParsecT Void Text Identity Text
"false" ParsecT Void Text Identity Text -> PrimValue -> Parser PrimValue
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool -> PrimValue
F.BoolValue Bool
False
    ]

lexeme :: Parser () -> Parser a -> Parser a
lexeme :: ParsecT Void Text Identity () -> Parser a -> Parser a
lexeme ParsecT Void Text Identity ()
sep Parser a
p = Parser a
p Parser a -> ParsecT Void Text Identity () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
sep

inBrackets :: Parser () -> Parser a -> Parser a
inBrackets :: ParsecT Void Text Identity () -> Parser a -> Parser a
inBrackets ParsecT Void Text Identity ()
sep = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. ParsecT Void Text Identity () -> Parser a -> Parser a
lexeme ParsecT Void Text Identity ()
sep ParsecT Void Text Identity Text
"[") (ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. ParsecT Void Text Identity () -> Parser a -> Parser a
lexeme ParsecT Void Text Identity ()
sep ParsecT Void Text Identity Text
"]")

-- | Parse a type.  Does *not* consume any trailing whitespace, nor
-- does it permit any internal whitespace.
parseType :: Parser ValueType
parseType :: Parser ValueType
parseType = [Int] -> PrimType -> ValueType
ValueType ([Int] -> PrimType -> ValueType)
-> ParsecT Void Text Identity [Int]
-> ParsecT Void Text Identity (PrimType -> ValueType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Int -> ParsecT Void Text Identity [Int]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity Int
parseDim ParsecT Void Text Identity (PrimType -> ValueType)
-> Parser PrimType -> Parser ValueType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PrimType
parsePrimType
  where
    parseDim :: ParsecT Void Text Identity Int
parseDim = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int)
-> Parser Integer -> ParsecT Void Text Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity Text
"[" ParsecT Void Text Identity Text -> Parser Integer -> Parser Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
parseInteger Parser Integer -> ParsecT Void Text Identity Text -> Parser Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Text
"]")

parseEmpty :: Parser Value
parseEmpty :: Parser Value
parseEmpty = do
  ValueType [Int]
dims PrimType
t <- Parser ValueType
parseType
  Bool
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int]
dims Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (ParsecT Void Text Identity () -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Void Text Identity ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected at least one empty dimension"
  Value -> Parser Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ case PrimType
t of
    F.Signed IntType
F.Int8 -> Vector Int -> Vector Int8 -> Value
Int8Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Int8
forall a. Monoid a => a
mempty
    F.Signed IntType
F.Int16 -> Vector Int -> Vector Int16 -> Value
Int16Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Int16
forall a. Monoid a => a
mempty
    F.Signed IntType
F.Int32 -> Vector Int -> Vector Int32 -> Value
Int32Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Int32
forall a. Monoid a => a
mempty
    F.Signed IntType
F.Int64 -> Vector Int -> Vector Int64 -> Value
Int64Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Int64
forall a. Monoid a => a
mempty
    F.Unsigned IntType
F.Int8 -> Vector Int -> Vector Word8 -> Value
Word8Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Word8
forall a. Monoid a => a
mempty
    F.Unsigned IntType
F.Int16 -> Vector Int -> Vector Word16 -> Value
Word16Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Word16
forall a. Monoid a => a
mempty
    F.Unsigned IntType
F.Int32 -> Vector Int -> Vector Word32 -> Value
Word32Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Word32
forall a. Monoid a => a
mempty
    F.Unsigned IntType
F.Int64 -> Vector Int -> Vector Word64 -> Value
Word64Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Word64
forall a. Monoid a => a
mempty
    F.FloatType FloatType
F.Float32 -> Vector Int -> Vector Float -> Value
Float32Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Float
forall a. Monoid a => a
mempty
    F.FloatType FloatType
F.Float64 -> Vector Int -> Vector Double -> Value
Float64Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Double
forall a. Monoid a => a
mempty
    PrimType
F.Bool -> Vector Int -> Vector Bool -> Value
BoolValue ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Bool
forall a. Monoid a => a
mempty

-- | Parse a value, given a post-lexeme parser for whitespace.
parseValue :: Parser () -> Parser Value
parseValue :: ParsecT Void Text Identity () -> Parser Value
parseValue ParsecT Void Text Identity ()
sep =
  [Parser Value] -> Parser Value
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ Parser PrimValue -> Parser Value
forall v. PutValue v => Parser v -> Parser Value
putValue' (Parser PrimValue -> Parser Value)
-> Parser PrimValue -> Parser Value
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity ()
-> Parser PrimValue -> Parser PrimValue
forall a. ParsecT Void Text Identity () -> Parser a -> Parser a
lexeme ParsecT Void Text Identity ()
sep Parser PrimValue
parsePrimValue,
      Parser [Value] -> Parser Value
forall v. PutValue v => Parser v -> Parser Value
putValue' (Parser [Value] -> Parser Value) -> Parser [Value] -> Parser Value
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity () -> Parser [Value] -> Parser [Value]
forall a. ParsecT Void Text Identity () -> Parser a -> Parser a
inBrackets ParsecT Void Text Identity ()
sep (ParsecT Void Text Identity () -> Parser Value
parseValue ParsecT Void Text Identity ()
sep Parser Value -> ParsecT Void Text Identity Text -> Parser [Value]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a. ParsecT Void Text Identity () -> Parser a -> Parser a
lexeme ParsecT Void Text Identity ()
sep ParsecT Void Text Identity Text
","),
      ParsecT Void Text Identity () -> Parser Value -> Parser Value
forall a. ParsecT Void Text Identity () -> Parser a -> Parser a
lexeme ParsecT Void Text Identity ()
sep (Parser Value -> Parser Value) -> Parser Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Text
"empty(" ParsecT Void Text Identity Text -> Parser Value -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Value
parseEmpty Parser Value -> ParsecT Void Text Identity Text -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Text
")"
    ]
  where
    putValue' :: PutValue v => Parser v -> Parser Value
    putValue' :: Parser v -> Parser Value
putValue' Parser v
p = do
      Int
o <- ParsecT Void Text Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
      v
x <- Parser v
p
      case v -> Maybe Value
forall t. PutValue t => t -> Maybe Value
putValue v
x of
        Maybe Value
Nothing ->
          ParseError Text Void -> Parser Value
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ParseError s e -> m a
parseError (ParseError Text Void -> Parser Value)
-> (ErrorFancy Void -> ParseError Text Void)
-> ErrorFancy Void
-> Parser Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Set (ErrorFancy Void) -> ParseError Text Void
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError Int
o (Set (ErrorFancy Void) -> ParseError Text Void)
-> (ErrorFancy Void -> Set (ErrorFancy Void))
-> ErrorFancy Void
-> ParseError Text Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorFancy Void -> Set (ErrorFancy Void)
forall a. a -> Set a
S.singleton (ErrorFancy Void -> Parser Value)
-> ErrorFancy Void -> Parser Value
forall a b. (a -> b) -> a -> b
$
            String -> ErrorFancy Void
forall e. String -> ErrorFancy e
ErrorFail String
"array is irregular or has elements of multiple types."
        Just Value
v ->
          Value -> Parser Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v