{-# LANGUAGE OverloadedStrings #-}
module Futhark.Data.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.Data
import Text.Megaparsec
import Text.Megaparsec.Char.Lexer
( binary,
decimal,
float,
hexadecimal,
signed,
)
parsePrimType :: Parsec Void T.Text PrimType
parsePrimType :: Parsec Void Text PrimType
parsePrimType =
[Parsec Void Text PrimType] -> Parsec Void Text 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 -> Parsec Void Text PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> PrimType
I8,
ParsecT Void Text Identity Text
"i16" ParsecT Void Text Identity Text
-> PrimType -> Parsec Void Text PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> PrimType
I16,
ParsecT Void Text Identity Text
"i32" ParsecT Void Text Identity Text
-> PrimType -> Parsec Void Text PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> PrimType
I32,
ParsecT Void Text Identity Text
"i64" ParsecT Void Text Identity Text
-> PrimType -> Parsec Void Text PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> PrimType
I64,
ParsecT Void Text Identity Text
"u8" ParsecT Void Text Identity Text
-> PrimType -> Parsec Void Text PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> PrimType
U8,
ParsecT Void Text Identity Text
"u16" ParsecT Void Text Identity Text
-> PrimType -> Parsec Void Text PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> PrimType
U16,
ParsecT Void Text Identity Text
"u32" ParsecT Void Text Identity Text
-> PrimType -> Parsec Void Text PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> PrimType
U32,
ParsecT Void Text Identity Text
"u64" ParsecT Void Text Identity Text
-> PrimType -> Parsec Void Text PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> PrimType
U64,
ParsecT Void Text Identity Text
"f32" ParsecT Void Text Identity Text
-> PrimType -> Parsec Void Text PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> PrimType
F32,
ParsecT Void Text Identity Text
"f64" ParsecT Void Text Identity Text
-> PrimType -> Parsec Void Text PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> PrimType
F64,
ParsecT Void Text Identity Text
"bool" ParsecT Void Text Identity Text
-> PrimType -> Parsec Void Text PrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> PrimType
Bool
]
parseInteger :: Parsec Void T.Text Integer
parseInteger :: Parsec Void Text Integer
parseInteger =
ParsecT Void Text Identity ()
-> Parsec Void Text Integer -> Parsec Void Text 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 ()) (Parsec Void Text Integer -> Parsec Void Text Integer)
-> Parsec Void Text Integer -> Parsec Void Text Integer
forall a b. (a -> b) -> a -> b
$
[Parsec Void Text Integer] -> Parsec Void Text 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
-> Parsec Void Text Integer -> Parsec Void Text Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text 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
-> Parsec Void Text Integer -> Parsec Void Text Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
hexadecimal,
Parsec Void Text Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
]
scalar :: SVec.Storable a => (Vector Int -> Vector a -> Value) -> a -> Value
scalar :: (Vector Int -> Vector a -> Value) -> a -> Value
scalar Vector Int -> Vector a -> Value
f a
x = Vector Int -> Vector a -> Value
f Vector Int
forall a. Monoid a => a
mempty (a -> Vector a
forall a. Storable a => a -> Vector a
SVec.singleton a
x)
parseIntConst :: Parsec Void T.Text Value
parseIntConst :: Parsec Void Text Value
parseIntConst = do
Integer
x <- Parsec Void Text 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
"." 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
"e"
[Parsec Void Text Value] -> Parsec Void Text Value
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ (Vector Int -> Vector Int8 -> Value)
-> Integer
-> ParsecT Void Text Identity Text
-> Parsec Void Text Value
forall (f :: * -> *) a a.
(Functor f, Storable a, Num a) =>
(Vector Int -> Vector a -> Value) -> Integer -> f a -> f Value
intV Vector Int -> Vector Int8 -> Value
I8Value Integer
x ParsecT Void Text Identity Text
"i8",
(Vector Int -> Vector Int16 -> Value)
-> Integer
-> ParsecT Void Text Identity Text
-> Parsec Void Text Value
forall (f :: * -> *) a a.
(Functor f, Storable a, Num a) =>
(Vector Int -> Vector a -> Value) -> Integer -> f a -> f Value
intV Vector Int -> Vector Int16 -> Value
I16Value Integer
x ParsecT Void Text Identity Text
"i16",
(Vector Int -> Vector Int32 -> Value)
-> Integer
-> ParsecT Void Text Identity Text
-> Parsec Void Text Value
forall (f :: * -> *) a a.
(Functor f, Storable a, Num a) =>
(Vector Int -> Vector a -> Value) -> Integer -> f a -> f Value
intV Vector Int -> Vector Int32 -> Value
I32Value Integer
x ParsecT Void Text Identity Text
"i32",
(Vector Int -> Vector Int64 -> Value)
-> Integer
-> ParsecT Void Text Identity Text
-> Parsec Void Text Value
forall (f :: * -> *) a a.
(Functor f, Storable a, Num a) =>
(Vector Int -> Vector a -> Value) -> Integer -> f a -> f Value
intV Vector Int -> Vector Int64 -> Value
I64Value Integer
x ParsecT Void Text Identity Text
"i64",
(Vector Int -> Vector Word8 -> Value)
-> Integer
-> ParsecT Void Text Identity Text
-> Parsec Void Text Value
forall (f :: * -> *) a a.
(Functor f, Storable a, Num a) =>
(Vector Int -> Vector a -> Value) -> Integer -> f a -> f Value
intV Vector Int -> Vector Word8 -> Value
U8Value Integer
x ParsecT Void Text Identity Text
"u8",
(Vector Int -> Vector Word16 -> Value)
-> Integer
-> ParsecT Void Text Identity Text
-> Parsec Void Text Value
forall (f :: * -> *) a a.
(Functor f, Storable a, Num a) =>
(Vector Int -> Vector a -> Value) -> Integer -> f a -> f Value
intV Vector Int -> Vector Word16 -> Value
U16Value Integer
x ParsecT Void Text Identity Text
"u16",
(Vector Int -> Vector Word32 -> Value)
-> Integer
-> ParsecT Void Text Identity Text
-> Parsec Void Text Value
forall (f :: * -> *) a a.
(Functor f, Storable a, Num a) =>
(Vector Int -> Vector a -> Value) -> Integer -> f a -> f Value
intV Vector Int -> Vector Word32 -> Value
U32Value Integer
x ParsecT Void Text Identity Text
"u32",
(Vector Int -> Vector Word64 -> Value)
-> Integer
-> ParsecT Void Text Identity Text
-> Parsec Void Text Value
forall (f :: * -> *) a a.
(Functor f, Storable a, Num a) =>
(Vector Int -> Vector a -> Value) -> Integer -> f a -> f Value
intV Vector Int -> Vector Word64 -> Value
U64Value Integer
x ParsecT Void Text Identity Text
"u64",
(Vector Int -> Vector Int32 -> Value)
-> Integer
-> ParsecT Void Text Identity Text
-> Parsec Void Text Value
forall (f :: * -> *) a a.
(Functor f, Storable a, Num a) =>
(Vector Int -> Vector a -> Value) -> Integer -> f a -> f Value
intV Vector Int -> Vector Int32 -> Value
I32Value Integer
x ParsecT Void Text Identity Text
""
]
where
intV :: (Vector Int -> Vector a -> Value) -> Integer -> f a -> f Value
intV Vector Int -> Vector a -> Value
mk Integer
x f a
suffix =
f a
suffix f a -> Value -> f Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Vector Int -> Vector a -> Value) -> a -> Value
forall a.
Storable a =>
(Vector Int -> Vector a -> Value) -> a -> Value
scalar Vector Int -> Vector a -> Value
mk (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x)
parseFloatConst :: Parsec Void T.Text Value
parseFloatConst :: Parsec Void Text Value
parseFloatConst =
[Parsec Void Text Value] -> Parsec Void Text Value
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 -> Value -> Parsec Void Text Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Vector Int -> Vector Float -> Value) -> Float -> Value
forall a.
Storable a =>
(Vector Int -> Vector a -> Value) -> a -> Value
scalar Vector Int -> Vector Float -> Value
F32Value (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 -> Value -> Parsec Void Text Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Vector Int -> Vector Double -> Value) -> Double -> Value
forall a.
Storable a =>
(Vector Int -> Vector a -> Value) -> a -> Value
scalar Vector Int -> Vector Double -> Value
F64Value (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 -> Value -> Parsec Void Text Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Vector Int -> Vector Float -> Value) -> Float -> Value
forall a.
Storable a =>
(Vector Int -> Vector a -> Value) -> a -> Value
scalar Vector Int -> Vector Float -> Value
F32Value (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 -> Value -> Parsec Void Text Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Vector Int -> Vector Double -> Value) -> Double -> Value
forall a.
Storable a =>
(Vector Int -> Vector a -> Value) -> a -> Value
scalar Vector Int -> Vector Double -> Value
F64Value (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 -> Value -> Parsec Void Text Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Vector Int -> Vector Float -> Value) -> Float -> Value
forall a.
Storable a =>
(Vector Int -> Vector a -> Value) -> a -> Value
scalar Vector Int -> Vector Float -> Value
F32Value (-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 -> Value -> Parsec Void Text Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Vector Int -> Vector Double -> Value) -> Double -> Value
forall a.
Storable a =>
(Vector Int -> Vector a -> Value) -> a -> Value
scalar Vector Int -> Vector Double -> Value
F64Value (-Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0),
Parsec Void Text Value
numeric
]
where
numeric :: Parsec Void Text Value
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)
-> Parsec Void Text Integer -> ParsecT Void Text Identity Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal]
[Parsec Void Text Value] -> Parsec Void Text Value
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ (Vector Int -> Vector Float -> Value)
-> Double
-> ParsecT Void Text Identity Text
-> Parsec Void Text Value
forall (f :: * -> *) a a.
(Functor f, Storable a, Fractional a) =>
(Vector Int -> Vector a -> Value) -> Double -> f a -> f Value
floatV Vector Int -> Vector Float -> Value
F32Value Double
x ParsecT Void Text Identity Text
"f32",
(Vector Int -> Vector Double -> Value)
-> Double
-> ParsecT Void Text Identity Text
-> Parsec Void Text Value
forall (f :: * -> *) a a.
(Functor f, Storable a, Fractional a) =>
(Vector Int -> Vector a -> Value) -> Double -> f a -> f Value
floatV Vector Int -> Vector Double -> Value
F64Value Double
x ParsecT Void Text Identity Text
"f64",
(Vector Int -> Vector Double -> Value)
-> Double
-> ParsecT Void Text Identity Text
-> Parsec Void Text Value
forall (f :: * -> *) a a.
(Functor f, Storable a, Fractional a) =>
(Vector Int -> Vector a -> Value) -> Double -> f a -> f Value
floatV Vector Int -> Vector Double -> Value
F64Value Double
x ParsecT Void Text Identity Text
""
]
floatV :: (Vector Int -> Vector a -> Value) -> Double -> f a -> f Value
floatV Vector Int -> Vector a -> Value
mk Double
x f a
suffix =
f a
suffix f a -> Value -> f Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Vector Int -> Vector a -> Value) -> a -> Value
forall a.
Storable a =>
(Vector Int -> Vector a -> Value) -> a -> Value
scalar Vector Int -> Vector a -> Value
mk (Double -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double
x :: Double))
parsePrimValue :: Parsec Void T.Text Value
parsePrimValue :: Parsec Void Text Value
parsePrimValue =
[Parsec Void Text Value] -> Parsec Void Text Value
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ Parsec Void Text Value -> Parsec Void Text Value
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parsec Void Text Value
parseIntConst,
Parsec Void Text Value
parseFloatConst,
ParsecT Void Text Identity Text
"true" ParsecT Void Text Identity Text -> Value -> Parsec Void Text Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Vector Int -> Vector Bool -> Value
BoolValue Vector Int
forall a. Monoid a => a
mempty (Bool -> Vector Bool
forall a. Storable a => a -> Vector a
SVec.singleton Bool
True),
ParsecT Void Text Identity Text
"false" ParsecT Void Text Identity Text -> Value -> Parsec Void Text Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Vector Int -> Vector Bool -> Value
BoolValue Vector Int
forall a. Monoid a => a
mempty (Bool -> Vector Bool
forall a. Storable a => a -> Vector a
SVec.singleton Bool
False)
]
lexeme :: Parsec Void T.Text () -> Parsec Void T.Text a -> Parsec Void T.Text a
lexeme :: ParsecT Void Text Identity ()
-> Parsec Void Text a -> Parsec Void Text a
lexeme ParsecT Void Text Identity ()
sep Parsec Void Text a
p = Parsec Void Text a
p Parsec Void Text a
-> ParsecT Void Text Identity () -> Parsec Void Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
sep
inBrackets :: Parsec Void T.Text () -> Parsec Void T.Text a -> Parsec Void T.Text a
inBrackets :: ParsecT Void Text Identity ()
-> Parsec Void Text a -> Parsec Void Text a
inBrackets ParsecT Void Text Identity ()
sep = ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> Parsec Void Text a
-> Parsec Void Text 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 ()
-> Parsec Void Text a -> Parsec Void Text 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 ()
-> Parsec Void Text a -> Parsec Void Text a
lexeme ParsecT Void Text Identity ()
sep ParsecT Void Text Identity Text
"]")
parseType :: Parsec Void T.Text ValueType
parseType :: Parsec Void Text 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)
-> Parsec Void Text PrimType -> Parsec Void Text ValueType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec Void Text PrimType
parsePrimType
where
parseDim :: ParsecT Void Text Identity Int
parseDim = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int)
-> Parsec Void Text 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
-> Parsec Void Text Integer -> Parsec Void Text Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Integer
parseInteger Parsec Void Text Integer
-> ParsecT Void Text Identity Text -> Parsec Void Text Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Text
"]")
parseEmpty :: Parsec Void T.Text Value
parseEmpty :: Parsec Void Text Value
parseEmpty = do
ValueType [Int]
dims PrimType
t <- Parsec Void Text 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 -> Parsec Void Text Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Parsec Void Text Value)
-> Value -> Parsec Void Text Value
forall a b. (a -> b) -> a -> b
$ case PrimType
t of
PrimType
I8 -> Vector Int -> Vector Int8 -> Value
I8Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Int8
forall a. Monoid a => a
mempty
PrimType
I16 -> Vector Int -> Vector Int16 -> Value
I16Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Int16
forall a. Monoid a => a
mempty
PrimType
I32 -> Vector Int -> Vector Int32 -> Value
I32Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Int32
forall a. Monoid a => a
mempty
PrimType
I64 -> Vector Int -> Vector Int64 -> Value
I64Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Int64
forall a. Monoid a => a
mempty
PrimType
U8 -> Vector Int -> Vector Word8 -> Value
U8Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Word8
forall a. Monoid a => a
mempty
PrimType
U16 -> Vector Int -> Vector Word16 -> Value
U16Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Word16
forall a. Monoid a => a
mempty
PrimType
U32 -> Vector Int -> Vector Word32 -> Value
U32Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Word32
forall a. Monoid a => a
mempty
PrimType
U64 -> Vector Int -> Vector Word64 -> Value
U64Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Word64
forall a. Monoid a => a
mempty
PrimType
F32 -> Vector Int -> Vector Float -> Value
F32Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Float
forall a. Monoid a => a
mempty
PrimType
F64 -> Vector Int -> Vector Double -> Value
F64Value ([Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
SVec.fromList [Int]
dims) Vector Double
forall a. Monoid a => a
mempty
PrimType
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
parseValue :: Parsec Void T.Text () -> Parsec Void T.Text Value
parseValue :: ParsecT Void Text Identity () -> Parsec Void Text Value
parseValue ParsecT Void Text Identity ()
sep =
[Parsec Void Text Value] -> Parsec Void Text Value
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ ParsecT Void Text Identity ()
-> Parsec Void Text Value -> Parsec Void Text Value
forall a.
ParsecT Void Text Identity ()
-> Parsec Void Text a -> Parsec Void Text a
lexeme ParsecT Void Text Identity ()
sep Parsec Void Text Value
parsePrimValue,
Parsec Void Text [Value] -> Parsec Void Text Value
forall v.
PutValue v =>
Parsec Void Text v -> Parsec Void Text Value
putValue' (Parsec Void Text [Value] -> Parsec Void Text Value)
-> Parsec Void Text [Value] -> Parsec Void Text Value
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity ()
-> Parsec Void Text [Value] -> Parsec Void Text [Value]
forall a.
ParsecT Void Text Identity ()
-> Parsec Void Text a -> Parsec Void Text a
inBrackets ParsecT Void Text Identity ()
sep (ParsecT Void Text Identity () -> Parsec Void Text Value
parseValue ParsecT Void Text Identity ()
sep Parsec Void Text Value
-> ParsecT Void Text Identity Text -> Parsec Void Text [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 ()
-> Parsec Void Text a -> Parsec Void Text a
lexeme ParsecT Void Text Identity ()
sep ParsecT Void Text Identity Text
","),
ParsecT Void Text Identity ()
-> Parsec Void Text Value -> Parsec Void Text Value
forall a.
ParsecT Void Text Identity ()
-> Parsec Void Text a -> Parsec Void Text a
lexeme ParsecT Void Text Identity ()
sep (Parsec Void Text Value -> Parsec Void Text Value)
-> Parsec Void Text Value -> Parsec Void Text Value
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Text
"empty(" ParsecT Void Text Identity Text
-> Parsec Void Text Value -> Parsec Void Text Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Value
parseEmpty Parsec Void Text Value
-> ParsecT Void Text Identity Text -> Parsec Void Text Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Text
")"
]
where
putValue' :: PutValue v => Parsec Void T.Text v -> Parsec Void T.Text Value
putValue' :: Parsec Void Text v -> Parsec Void Text Value
putValue' Parsec Void Text v
p = do
Int
o <- ParsecT Void Text Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
v
x <- Parsec Void Text v
p
case v -> Maybe Value
forall t. PutValue t => t -> Maybe Value
putValue v
x of
Maybe Value
Nothing ->
ParseError Text Void -> Parsec Void Text Value
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ParseError s e -> m a
parseError (ParseError Text Void -> Parsec Void Text Value)
-> (ErrorFancy Void -> ParseError Text Void)
-> ErrorFancy Void
-> Parsec Void Text 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 -> Parsec Void Text Value)
-> ErrorFancy Void -> Parsec Void Text 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 -> Parsec Void Text Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v