{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TupleSections #-}

-- | C manifest data structure and serialisation to JSON.
--
-- A manifest contains machine-readable information about the API of
-- the compiled Futhark program.  Specifically which entry points are
-- available, which types are exposed, and what their C names are.
-- This module documentation is not intended as a full description of
-- the Futhark C API - you will need to consult the Futhark User's
-- Guide to understand most of the information here.
--
-- The type aliases are purely informative and do not actually enforce
-- correct usage.  They are present only because most of the
-- information here is ultimately just text.
module Futhark.Manifest
  ( -- * Type aliases
    CFuncName,
    CTypeName,
    TypeName,

    -- * Manifest
    Manifest (..),
    Input (..),
    Output (..),
    EntryPoint (..),
    Type (..),
    ArrayOps (..),
    RecordField (..),
    RecordOps (..),
    SumVariant (..),
    SumOps (..),
    OpaqueArrayOps (..),
    RecordArrayOps (..),
    OpaqueExtraOps (..),
    OpaqueOps (..),
    manifestToJSON,
    manifestFromJSON,
  )
where

import Control.Applicative
import Control.Monad (guard)
import Data.Aeson (ToJSON (..), object, (.!=), (.:), (.:?))
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Key as JSON
import Data.Aeson.Text (encodeToLazyText)
import Data.Bifunctor (bimap)
import Data.ByteString.Builder (toLazyByteString)
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8Builder)
import Data.Text.Lazy (toStrict)

-- | The name of a C function.
type CFuncName = T.Text

-- | The name of a C type (often of the form @"struct foo*"@).
type CTypeName = T.Text

-- | The name of a Futhark-level type.  This may be an array type
-- (without sizes, just empty brackets), a primitive type, or another
-- string denoting an opaque type.  The latter must have a
-- corresponding entry in 'manifestTypes'.
type TypeName = T.Text

-- | Manifest info for an entry point parameter.
data Input = Input
  { Input -> Text
inputName :: T.Text,
    Input -> Text
inputType :: TypeName,
    Input -> Bool
inputUnique :: Bool
  }
  deriving (Input -> Input -> Bool
(Input -> Input -> Bool) -> (Input -> Input -> Bool) -> Eq Input
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Input -> Input -> Bool
== :: Input -> Input -> Bool
$c/= :: Input -> Input -> Bool
/= :: Input -> Input -> Bool
Eq, Eq Input
Eq Input =>
(Input -> Input -> Ordering)
-> (Input -> Input -> Bool)
-> (Input -> Input -> Bool)
-> (Input -> Input -> Bool)
-> (Input -> Input -> Bool)
-> (Input -> Input -> Input)
-> (Input -> Input -> Input)
-> Ord Input
Input -> Input -> Bool
Input -> Input -> Ordering
Input -> Input -> Input
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 :: Input -> Input -> Ordering
compare :: Input -> Input -> Ordering
$c< :: Input -> Input -> Bool
< :: Input -> Input -> Bool
$c<= :: Input -> Input -> Bool
<= :: Input -> Input -> Bool
$c> :: Input -> Input -> Bool
> :: Input -> Input -> Bool
$c>= :: Input -> Input -> Bool
>= :: Input -> Input -> Bool
$cmax :: Input -> Input -> Input
max :: Input -> Input -> Input
$cmin :: Input -> Input -> Input
min :: Input -> Input -> Input
Ord, Int -> Input -> ShowS
[Input] -> ShowS
Input -> String
(Int -> Input -> ShowS)
-> (Input -> String) -> ([Input] -> ShowS) -> Show Input
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Input -> ShowS
showsPrec :: Int -> Input -> ShowS
$cshow :: Input -> String
show :: Input -> String
$cshowList :: [Input] -> ShowS
showList :: [Input] -> ShowS
Show)

-- | Manifest info for an entry point return value.
data Output = Output
  { Output -> Text
outputType :: TypeName,
    Output -> Bool
outputUnique :: Bool
  }
  deriving (Output -> Output -> Bool
(Output -> Output -> Bool)
-> (Output -> Output -> Bool) -> Eq Output
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Output -> Output -> Bool
== :: Output -> Output -> Bool
$c/= :: Output -> Output -> Bool
/= :: Output -> Output -> Bool
Eq, Eq Output
Eq Output =>
(Output -> Output -> Ordering)
-> (Output -> Output -> Bool)
-> (Output -> Output -> Bool)
-> (Output -> Output -> Bool)
-> (Output -> Output -> Bool)
-> (Output -> Output -> Output)
-> (Output -> Output -> Output)
-> Ord Output
Output -> Output -> Bool
Output -> Output -> Ordering
Output -> Output -> Output
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 :: Output -> Output -> Ordering
compare :: Output -> Output -> Ordering
$c< :: Output -> Output -> Bool
< :: Output -> Output -> Bool
$c<= :: Output -> Output -> Bool
<= :: Output -> Output -> Bool
$c> :: Output -> Output -> Bool
> :: Output -> Output -> Bool
$c>= :: Output -> Output -> Bool
>= :: Output -> Output -> Bool
$cmax :: Output -> Output -> Output
max :: Output -> Output -> Output
$cmin :: Output -> Output -> Output
min :: Output -> Output -> Output
Ord, Int -> Output -> ShowS
[Output] -> ShowS
Output -> String
(Int -> Output -> ShowS)
-> (Output -> String) -> ([Output] -> ShowS) -> Show Output
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Output -> ShowS
showsPrec :: Int -> Output -> ShowS
$cshow :: Output -> String
show :: Output -> String
$cshowList :: [Output] -> ShowS
showList :: [Output] -> ShowS
Show)

-- | Manifest info for an entry point.
data EntryPoint = EntryPoint
  { EntryPoint -> Text
entryPointCFun :: CFuncName,
    EntryPoint -> [Text]
entryPointTuningParams :: [T.Text],
    EntryPoint -> [Output]
entryPointOutputs :: [Output],
    EntryPoint -> [Input]
entryPointInputs :: [Input]
  }
  deriving (EntryPoint -> EntryPoint -> Bool
(EntryPoint -> EntryPoint -> Bool)
-> (EntryPoint -> EntryPoint -> Bool) -> Eq EntryPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EntryPoint -> EntryPoint -> Bool
== :: EntryPoint -> EntryPoint -> Bool
$c/= :: EntryPoint -> EntryPoint -> Bool
/= :: EntryPoint -> EntryPoint -> Bool
Eq, Eq EntryPoint
Eq EntryPoint =>
(EntryPoint -> EntryPoint -> Ordering)
-> (EntryPoint -> EntryPoint -> Bool)
-> (EntryPoint -> EntryPoint -> Bool)
-> (EntryPoint -> EntryPoint -> Bool)
-> (EntryPoint -> EntryPoint -> Bool)
-> (EntryPoint -> EntryPoint -> EntryPoint)
-> (EntryPoint -> EntryPoint -> EntryPoint)
-> Ord EntryPoint
EntryPoint -> EntryPoint -> Bool
EntryPoint -> EntryPoint -> Ordering
EntryPoint -> EntryPoint -> EntryPoint
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 :: EntryPoint -> EntryPoint -> Ordering
compare :: EntryPoint -> EntryPoint -> Ordering
$c< :: EntryPoint -> EntryPoint -> Bool
< :: EntryPoint -> EntryPoint -> Bool
$c<= :: EntryPoint -> EntryPoint -> Bool
<= :: EntryPoint -> EntryPoint -> Bool
$c> :: EntryPoint -> EntryPoint -> Bool
> :: EntryPoint -> EntryPoint -> Bool
$c>= :: EntryPoint -> EntryPoint -> Bool
>= :: EntryPoint -> EntryPoint -> Bool
$cmax :: EntryPoint -> EntryPoint -> EntryPoint
max :: EntryPoint -> EntryPoint -> EntryPoint
$cmin :: EntryPoint -> EntryPoint -> EntryPoint
min :: EntryPoint -> EntryPoint -> EntryPoint
Ord, Int -> EntryPoint -> ShowS
[EntryPoint] -> ShowS
EntryPoint -> String
(Int -> EntryPoint -> ShowS)
-> (EntryPoint -> String)
-> ([EntryPoint] -> ShowS)
-> Show EntryPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntryPoint -> ShowS
showsPrec :: Int -> EntryPoint -> ShowS
$cshow :: EntryPoint -> String
show :: EntryPoint -> String
$cshowList :: [EntryPoint] -> ShowS
showList :: [EntryPoint] -> ShowS
Show)

-- | The names of the C functions implementing the operations on some
-- array type.
data ArrayOps = ArrayOps
  { ArrayOps -> Text
arrayFree :: CFuncName,
    ArrayOps -> Text
arrayShape :: CFuncName,
    ArrayOps -> Text
arrayValues :: CFuncName,
    ArrayOps -> Text
arrayNew :: CFuncName,
    ArrayOps -> Text
arrayNewRaw :: CFuncName,
    ArrayOps -> Text
arrayValuesRaw :: CFuncName,
    ArrayOps -> Text
arrayIndex :: CFuncName
  }
  deriving (ArrayOps -> ArrayOps -> Bool
(ArrayOps -> ArrayOps -> Bool)
-> (ArrayOps -> ArrayOps -> Bool) -> Eq ArrayOps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArrayOps -> ArrayOps -> Bool
== :: ArrayOps -> ArrayOps -> Bool
$c/= :: ArrayOps -> ArrayOps -> Bool
/= :: ArrayOps -> ArrayOps -> Bool
Eq, Eq ArrayOps
Eq ArrayOps =>
(ArrayOps -> ArrayOps -> Ordering)
-> (ArrayOps -> ArrayOps -> Bool)
-> (ArrayOps -> ArrayOps -> Bool)
-> (ArrayOps -> ArrayOps -> Bool)
-> (ArrayOps -> ArrayOps -> Bool)
-> (ArrayOps -> ArrayOps -> ArrayOps)
-> (ArrayOps -> ArrayOps -> ArrayOps)
-> Ord ArrayOps
ArrayOps -> ArrayOps -> Bool
ArrayOps -> ArrayOps -> Ordering
ArrayOps -> ArrayOps -> ArrayOps
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 :: ArrayOps -> ArrayOps -> Ordering
compare :: ArrayOps -> ArrayOps -> Ordering
$c< :: ArrayOps -> ArrayOps -> Bool
< :: ArrayOps -> ArrayOps -> Bool
$c<= :: ArrayOps -> ArrayOps -> Bool
<= :: ArrayOps -> ArrayOps -> Bool
$c> :: ArrayOps -> ArrayOps -> Bool
> :: ArrayOps -> ArrayOps -> Bool
$c>= :: ArrayOps -> ArrayOps -> Bool
>= :: ArrayOps -> ArrayOps -> Bool
$cmax :: ArrayOps -> ArrayOps -> ArrayOps
max :: ArrayOps -> ArrayOps -> ArrayOps
$cmin :: ArrayOps -> ArrayOps -> ArrayOps
min :: ArrayOps -> ArrayOps -> ArrayOps
Ord, Int -> ArrayOps -> ShowS
[ArrayOps] -> ShowS
ArrayOps -> String
(Int -> ArrayOps -> ShowS)
-> (ArrayOps -> String) -> ([ArrayOps] -> ShowS) -> Show ArrayOps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArrayOps -> ShowS
showsPrec :: Int -> ArrayOps -> ShowS
$cshow :: ArrayOps -> String
show :: ArrayOps -> String
$cshowList :: [ArrayOps] -> ShowS
showList :: [ArrayOps] -> ShowS
Show)

-- | Information about a record field. Also used for fields of record
-- arrays; see 'RecordArrayOps'.
data RecordField = RecordField
  { -- | The original name of the field.  This may be a name that is
    -- not a valid C identifier.
    RecordField -> Text
recordFieldName :: T.Text,
    -- | The type of the field.
    RecordField -> Text
recordFieldType :: TypeName,
    -- | The name of the projection function.
    RecordField -> Text
recordFieldProject :: CFuncName
  }
  deriving (RecordField -> RecordField -> Bool
(RecordField -> RecordField -> Bool)
-> (RecordField -> RecordField -> Bool) -> Eq RecordField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RecordField -> RecordField -> Bool
== :: RecordField -> RecordField -> Bool
$c/= :: RecordField -> RecordField -> Bool
/= :: RecordField -> RecordField -> Bool
Eq, Eq RecordField
Eq RecordField =>
(RecordField -> RecordField -> Ordering)
-> (RecordField -> RecordField -> Bool)
-> (RecordField -> RecordField -> Bool)
-> (RecordField -> RecordField -> Bool)
-> (RecordField -> RecordField -> Bool)
-> (RecordField -> RecordField -> RecordField)
-> (RecordField -> RecordField -> RecordField)
-> Ord RecordField
RecordField -> RecordField -> Bool
RecordField -> RecordField -> Ordering
RecordField -> RecordField -> RecordField
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 :: RecordField -> RecordField -> Ordering
compare :: RecordField -> RecordField -> Ordering
$c< :: RecordField -> RecordField -> Bool
< :: RecordField -> RecordField -> Bool
$c<= :: RecordField -> RecordField -> Bool
<= :: RecordField -> RecordField -> Bool
$c> :: RecordField -> RecordField -> Bool
> :: RecordField -> RecordField -> Bool
$c>= :: RecordField -> RecordField -> Bool
>= :: RecordField -> RecordField -> Bool
$cmax :: RecordField -> RecordField -> RecordField
max :: RecordField -> RecordField -> RecordField
$cmin :: RecordField -> RecordField -> RecordField
min :: RecordField -> RecordField -> RecordField
Ord, Int -> RecordField -> ShowS
[RecordField] -> ShowS
RecordField -> String
(Int -> RecordField -> ShowS)
-> (RecordField -> String)
-> ([RecordField] -> ShowS)
-> Show RecordField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RecordField -> ShowS
showsPrec :: Int -> RecordField -> ShowS
$cshow :: RecordField -> String
show :: RecordField -> String
$cshowList :: [RecordField] -> ShowS
showList :: [RecordField] -> ShowS
Show)

-- | Some opaque types are records, from which we can extract fields,
-- and also construct them from values for their fields.  Beyond that,
-- they support the usual opaque operations.  These record facilities
-- can be ignored if you wish, and the types treated as ordinary
-- opaque types.
data RecordOps = RecordOps
  { -- | Note that the ordering of fields here is semantically
    -- significant - it is also the order that the "new" function
    -- expects.
    RecordOps -> [RecordField]
recordFields :: [RecordField],
    RecordOps -> Text
recordNew :: CFuncName
  }
  deriving (RecordOps -> RecordOps -> Bool
(RecordOps -> RecordOps -> Bool)
-> (RecordOps -> RecordOps -> Bool) -> Eq RecordOps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RecordOps -> RecordOps -> Bool
== :: RecordOps -> RecordOps -> Bool
$c/= :: RecordOps -> RecordOps -> Bool
/= :: RecordOps -> RecordOps -> Bool
Eq, Eq RecordOps
Eq RecordOps =>
(RecordOps -> RecordOps -> Ordering)
-> (RecordOps -> RecordOps -> Bool)
-> (RecordOps -> RecordOps -> Bool)
-> (RecordOps -> RecordOps -> Bool)
-> (RecordOps -> RecordOps -> Bool)
-> (RecordOps -> RecordOps -> RecordOps)
-> (RecordOps -> RecordOps -> RecordOps)
-> Ord RecordOps
RecordOps -> RecordOps -> Bool
RecordOps -> RecordOps -> Ordering
RecordOps -> RecordOps -> RecordOps
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 :: RecordOps -> RecordOps -> Ordering
compare :: RecordOps -> RecordOps -> Ordering
$c< :: RecordOps -> RecordOps -> Bool
< :: RecordOps -> RecordOps -> Bool
$c<= :: RecordOps -> RecordOps -> Bool
<= :: RecordOps -> RecordOps -> Bool
$c> :: RecordOps -> RecordOps -> Bool
> :: RecordOps -> RecordOps -> Bool
$c>= :: RecordOps -> RecordOps -> Bool
>= :: RecordOps -> RecordOps -> Bool
$cmax :: RecordOps -> RecordOps -> RecordOps
max :: RecordOps -> RecordOps -> RecordOps
$cmin :: RecordOps -> RecordOps -> RecordOps
min :: RecordOps -> RecordOps -> RecordOps
Ord, Int -> RecordOps -> ShowS
[RecordOps] -> ShowS
RecordOps -> String
(Int -> RecordOps -> ShowS)
-> (RecordOps -> String)
-> ([RecordOps] -> ShowS)
-> Show RecordOps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RecordOps -> ShowS
showsPrec :: Int -> RecordOps -> ShowS
$cshow :: RecordOps -> String
show :: RecordOps -> String
$cshowList :: [RecordOps] -> ShowS
showList :: [RecordOps] -> ShowS
Show)

-- | Information about a variant of a sum type.
data SumVariant = SumVariant
  { -- | The name of the constructor. This may be a name that is not a
    -- valid C identifier.
    SumVariant -> Text
sumVariantName :: T.Text,
    -- | The payload of this variant; also corresponding to the
    -- arguments of the constructor and destructor functions.
    SumVariant -> [Text]
sumVariantPayload :: [TypeName],
    SumVariant -> Text
sumVariantConstruct :: CFuncName,
    -- | Note that despite the name, "destruction" does not entail
    -- freeing the sum type value.
    SumVariant -> Text
sumVariantDestruct :: CFuncName
  }
  deriving (SumVariant -> SumVariant -> Bool
(SumVariant -> SumVariant -> Bool)
-> (SumVariant -> SumVariant -> Bool) -> Eq SumVariant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SumVariant -> SumVariant -> Bool
== :: SumVariant -> SumVariant -> Bool
$c/= :: SumVariant -> SumVariant -> Bool
/= :: SumVariant -> SumVariant -> Bool
Eq, Eq SumVariant
Eq SumVariant =>
(SumVariant -> SumVariant -> Ordering)
-> (SumVariant -> SumVariant -> Bool)
-> (SumVariant -> SumVariant -> Bool)
-> (SumVariant -> SumVariant -> Bool)
-> (SumVariant -> SumVariant -> Bool)
-> (SumVariant -> SumVariant -> SumVariant)
-> (SumVariant -> SumVariant -> SumVariant)
-> Ord SumVariant
SumVariant -> SumVariant -> Bool
SumVariant -> SumVariant -> Ordering
SumVariant -> SumVariant -> SumVariant
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 :: SumVariant -> SumVariant -> Ordering
compare :: SumVariant -> SumVariant -> Ordering
$c< :: SumVariant -> SumVariant -> Bool
< :: SumVariant -> SumVariant -> Bool
$c<= :: SumVariant -> SumVariant -> Bool
<= :: SumVariant -> SumVariant -> Bool
$c> :: SumVariant -> SumVariant -> Bool
> :: SumVariant -> SumVariant -> Bool
$c>= :: SumVariant -> SumVariant -> Bool
>= :: SumVariant -> SumVariant -> Bool
$cmax :: SumVariant -> SumVariant -> SumVariant
max :: SumVariant -> SumVariant -> SumVariant
$cmin :: SumVariant -> SumVariant -> SumVariant
min :: SumVariant -> SumVariant -> SumVariant
Ord, Int -> SumVariant -> ShowS
[SumVariant] -> ShowS
SumVariant -> String
(Int -> SumVariant -> ShowS)
-> (SumVariant -> String)
-> ([SumVariant] -> ShowS)
-> Show SumVariant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SumVariant -> ShowS
showsPrec :: Int -> SumVariant -> ShowS
$cshow :: SumVariant -> String
show :: SumVariant -> String
$cshowList :: [SumVariant] -> ShowS
showList :: [SumVariant] -> ShowS
Show)

-- | Some opaque types are sum types, from which we can (try to)
-- extract the payload of a constructor, as well as construct them
-- from payloads. As with records, we can ignore these facilities and
-- simply treat them as completely opaque.
data SumOps = SumOps
  { SumOps -> [SumVariant]
sumVariants :: [SumVariant],
    -- | This function returns an integer that identifies which
    -- variant a value is an instance of. This integer is a valid
    -- index in 'sumVariants'.
    SumOps -> Text
sumVariant :: CFuncName
  }
  deriving (SumOps -> SumOps -> Bool
(SumOps -> SumOps -> Bool)
-> (SumOps -> SumOps -> Bool) -> Eq SumOps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SumOps -> SumOps -> Bool
== :: SumOps -> SumOps -> Bool
$c/= :: SumOps -> SumOps -> Bool
/= :: SumOps -> SumOps -> Bool
Eq, Eq SumOps
Eq SumOps =>
(SumOps -> SumOps -> Ordering)
-> (SumOps -> SumOps -> Bool)
-> (SumOps -> SumOps -> Bool)
-> (SumOps -> SumOps -> Bool)
-> (SumOps -> SumOps -> Bool)
-> (SumOps -> SumOps -> SumOps)
-> (SumOps -> SumOps -> SumOps)
-> Ord SumOps
SumOps -> SumOps -> Bool
SumOps -> SumOps -> Ordering
SumOps -> SumOps -> SumOps
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 :: SumOps -> SumOps -> Ordering
compare :: SumOps -> SumOps -> Ordering
$c< :: SumOps -> SumOps -> Bool
< :: SumOps -> SumOps -> Bool
$c<= :: SumOps -> SumOps -> Bool
<= :: SumOps -> SumOps -> Bool
$c> :: SumOps -> SumOps -> Bool
> :: SumOps -> SumOps -> Bool
$c>= :: SumOps -> SumOps -> Bool
>= :: SumOps -> SumOps -> Bool
$cmax :: SumOps -> SumOps -> SumOps
max :: SumOps -> SumOps -> SumOps
$cmin :: SumOps -> SumOps -> SumOps
min :: SumOps -> SumOps -> SumOps
Ord, Int -> SumOps -> ShowS
[SumOps] -> ShowS
SumOps -> String
(Int -> SumOps -> ShowS)
-> (SumOps -> String) -> ([SumOps] -> ShowS) -> Show SumOps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SumOps -> ShowS
showsPrec :: Int -> SumOps -> ShowS
$cshow :: SumOps -> String
show :: SumOps -> String
$cshowList :: [SumOps] -> ShowS
showList :: [SumOps] -> ShowS
Show)

-- | Some opaque types are arrays of opaque types. These still support
-- some array-like operations, but their types are somewhat different.
-- Note that arrays of primitives are 'TypeArray's, and arrays of
-- records support 'RecordArrayOps'.
data OpaqueArrayOps = OpaqueArrayOps
  { OpaqueArrayOps -> Int
opaqueArrayRank :: Int,
    OpaqueArrayOps -> Text
opaqueArrayElemType :: TypeName,
    OpaqueArrayOps -> Text
opaqueArrayIndex :: CFuncName,
    OpaqueArrayOps -> Text
opaqueArrayShape :: CFuncName
  }
  deriving (OpaqueArrayOps -> OpaqueArrayOps -> Bool
(OpaqueArrayOps -> OpaqueArrayOps -> Bool)
-> (OpaqueArrayOps -> OpaqueArrayOps -> Bool) -> Eq OpaqueArrayOps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpaqueArrayOps -> OpaqueArrayOps -> Bool
== :: OpaqueArrayOps -> OpaqueArrayOps -> Bool
$c/= :: OpaqueArrayOps -> OpaqueArrayOps -> Bool
/= :: OpaqueArrayOps -> OpaqueArrayOps -> Bool
Eq, Eq OpaqueArrayOps
Eq OpaqueArrayOps =>
(OpaqueArrayOps -> OpaqueArrayOps -> Ordering)
-> (OpaqueArrayOps -> OpaqueArrayOps -> Bool)
-> (OpaqueArrayOps -> OpaqueArrayOps -> Bool)
-> (OpaqueArrayOps -> OpaqueArrayOps -> Bool)
-> (OpaqueArrayOps -> OpaqueArrayOps -> Bool)
-> (OpaqueArrayOps -> OpaqueArrayOps -> OpaqueArrayOps)
-> (OpaqueArrayOps -> OpaqueArrayOps -> OpaqueArrayOps)
-> Ord OpaqueArrayOps
OpaqueArrayOps -> OpaqueArrayOps -> Bool
OpaqueArrayOps -> OpaqueArrayOps -> Ordering
OpaqueArrayOps -> OpaqueArrayOps -> OpaqueArrayOps
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 :: OpaqueArrayOps -> OpaqueArrayOps -> Ordering
compare :: OpaqueArrayOps -> OpaqueArrayOps -> Ordering
$c< :: OpaqueArrayOps -> OpaqueArrayOps -> Bool
< :: OpaqueArrayOps -> OpaqueArrayOps -> Bool
$c<= :: OpaqueArrayOps -> OpaqueArrayOps -> Bool
<= :: OpaqueArrayOps -> OpaqueArrayOps -> Bool
$c> :: OpaqueArrayOps -> OpaqueArrayOps -> Bool
> :: OpaqueArrayOps -> OpaqueArrayOps -> Bool
$c>= :: OpaqueArrayOps -> OpaqueArrayOps -> Bool
>= :: OpaqueArrayOps -> OpaqueArrayOps -> Bool
$cmax :: OpaqueArrayOps -> OpaqueArrayOps -> OpaqueArrayOps
max :: OpaqueArrayOps -> OpaqueArrayOps -> OpaqueArrayOps
$cmin :: OpaqueArrayOps -> OpaqueArrayOps -> OpaqueArrayOps
min :: OpaqueArrayOps -> OpaqueArrayOps -> OpaqueArrayOps
Ord, Int -> OpaqueArrayOps -> ShowS
[OpaqueArrayOps] -> ShowS
OpaqueArrayOps -> String
(Int -> OpaqueArrayOps -> ShowS)
-> (OpaqueArrayOps -> String)
-> ([OpaqueArrayOps] -> ShowS)
-> Show OpaqueArrayOps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpaqueArrayOps -> ShowS
showsPrec :: Int -> OpaqueArrayOps -> ShowS
$cshow :: OpaqueArrayOps -> String
show :: OpaqueArrayOps -> String
$cshowList :: [OpaqueArrayOps] -> ShowS
showList :: [OpaqueArrayOps] -> ShowS
Show)

-- | Some opaque types are arrays of records. The 'RecordField's here
-- will contain array types, and the projection functions will
-- retrieve arrays.
data RecordArrayOps = RecordArrayOps
  { RecordArrayOps -> Int
recordArrayRank :: Int,
    RecordArrayOps -> Text
recordArrayElemType :: TypeName,
    RecordArrayOps -> [RecordField]
recordArrayFields :: [RecordField],
    RecordArrayOps -> Text
recordArrayZip :: CFuncName,
    RecordArrayOps -> Text
recordArrayIndex :: CFuncName,
    RecordArrayOps -> Text
recordArrayShape :: CFuncName
  }
  deriving (RecordArrayOps -> RecordArrayOps -> Bool
(RecordArrayOps -> RecordArrayOps -> Bool)
-> (RecordArrayOps -> RecordArrayOps -> Bool) -> Eq RecordArrayOps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RecordArrayOps -> RecordArrayOps -> Bool
== :: RecordArrayOps -> RecordArrayOps -> Bool
$c/= :: RecordArrayOps -> RecordArrayOps -> Bool
/= :: RecordArrayOps -> RecordArrayOps -> Bool
Eq, Eq RecordArrayOps
Eq RecordArrayOps =>
(RecordArrayOps -> RecordArrayOps -> Ordering)
-> (RecordArrayOps -> RecordArrayOps -> Bool)
-> (RecordArrayOps -> RecordArrayOps -> Bool)
-> (RecordArrayOps -> RecordArrayOps -> Bool)
-> (RecordArrayOps -> RecordArrayOps -> Bool)
-> (RecordArrayOps -> RecordArrayOps -> RecordArrayOps)
-> (RecordArrayOps -> RecordArrayOps -> RecordArrayOps)
-> Ord RecordArrayOps
RecordArrayOps -> RecordArrayOps -> Bool
RecordArrayOps -> RecordArrayOps -> Ordering
RecordArrayOps -> RecordArrayOps -> RecordArrayOps
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 :: RecordArrayOps -> RecordArrayOps -> Ordering
compare :: RecordArrayOps -> RecordArrayOps -> Ordering
$c< :: RecordArrayOps -> RecordArrayOps -> Bool
< :: RecordArrayOps -> RecordArrayOps -> Bool
$c<= :: RecordArrayOps -> RecordArrayOps -> Bool
<= :: RecordArrayOps -> RecordArrayOps -> Bool
$c> :: RecordArrayOps -> RecordArrayOps -> Bool
> :: RecordArrayOps -> RecordArrayOps -> Bool
$c>= :: RecordArrayOps -> RecordArrayOps -> Bool
>= :: RecordArrayOps -> RecordArrayOps -> Bool
$cmax :: RecordArrayOps -> RecordArrayOps -> RecordArrayOps
max :: RecordArrayOps -> RecordArrayOps -> RecordArrayOps
$cmin :: RecordArrayOps -> RecordArrayOps -> RecordArrayOps
min :: RecordArrayOps -> RecordArrayOps -> RecordArrayOps
Ord, Int -> RecordArrayOps -> ShowS
[RecordArrayOps] -> ShowS
RecordArrayOps -> String
(Int -> RecordArrayOps -> ShowS)
-> (RecordArrayOps -> String)
-> ([RecordArrayOps] -> ShowS)
-> Show RecordArrayOps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RecordArrayOps -> ShowS
showsPrec :: Int -> RecordArrayOps -> ShowS
$cshow :: RecordArrayOps -> String
show :: RecordArrayOps -> String
$cshowList :: [RecordArrayOps] -> ShowS
showList :: [RecordArrayOps] -> ShowS
Show)

-- | Some opaque types have a known structure, which allows additional
-- operations.
data OpaqueExtraOps
  = OpaqueRecord RecordOps
  | OpaqueSum SumOps
  | OpaqueArray OpaqueArrayOps
  | OpaqueRecordArray RecordArrayOps
  deriving (OpaqueExtraOps -> OpaqueExtraOps -> Bool
(OpaqueExtraOps -> OpaqueExtraOps -> Bool)
-> (OpaqueExtraOps -> OpaqueExtraOps -> Bool) -> Eq OpaqueExtraOps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpaqueExtraOps -> OpaqueExtraOps -> Bool
== :: OpaqueExtraOps -> OpaqueExtraOps -> Bool
$c/= :: OpaqueExtraOps -> OpaqueExtraOps -> Bool
/= :: OpaqueExtraOps -> OpaqueExtraOps -> Bool
Eq, Eq OpaqueExtraOps
Eq OpaqueExtraOps =>
(OpaqueExtraOps -> OpaqueExtraOps -> Ordering)
-> (OpaqueExtraOps -> OpaqueExtraOps -> Bool)
-> (OpaqueExtraOps -> OpaqueExtraOps -> Bool)
-> (OpaqueExtraOps -> OpaqueExtraOps -> Bool)
-> (OpaqueExtraOps -> OpaqueExtraOps -> Bool)
-> (OpaqueExtraOps -> OpaqueExtraOps -> OpaqueExtraOps)
-> (OpaqueExtraOps -> OpaqueExtraOps -> OpaqueExtraOps)
-> Ord OpaqueExtraOps
OpaqueExtraOps -> OpaqueExtraOps -> Bool
OpaqueExtraOps -> OpaqueExtraOps -> Ordering
OpaqueExtraOps -> OpaqueExtraOps -> OpaqueExtraOps
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 :: OpaqueExtraOps -> OpaqueExtraOps -> Ordering
compare :: OpaqueExtraOps -> OpaqueExtraOps -> Ordering
$c< :: OpaqueExtraOps -> OpaqueExtraOps -> Bool
< :: OpaqueExtraOps -> OpaqueExtraOps -> Bool
$c<= :: OpaqueExtraOps -> OpaqueExtraOps -> Bool
<= :: OpaqueExtraOps -> OpaqueExtraOps -> Bool
$c> :: OpaqueExtraOps -> OpaqueExtraOps -> Bool
> :: OpaqueExtraOps -> OpaqueExtraOps -> Bool
$c>= :: OpaqueExtraOps -> OpaqueExtraOps -> Bool
>= :: OpaqueExtraOps -> OpaqueExtraOps -> Bool
$cmax :: OpaqueExtraOps -> OpaqueExtraOps -> OpaqueExtraOps
max :: OpaqueExtraOps -> OpaqueExtraOps -> OpaqueExtraOps
$cmin :: OpaqueExtraOps -> OpaqueExtraOps -> OpaqueExtraOps
min :: OpaqueExtraOps -> OpaqueExtraOps -> OpaqueExtraOps
Ord, Int -> OpaqueExtraOps -> ShowS
[OpaqueExtraOps] -> ShowS
OpaqueExtraOps -> String
(Int -> OpaqueExtraOps -> ShowS)
-> (OpaqueExtraOps -> String)
-> ([OpaqueExtraOps] -> ShowS)
-> Show OpaqueExtraOps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpaqueExtraOps -> ShowS
showsPrec :: Int -> OpaqueExtraOps -> ShowS
$cshow :: OpaqueExtraOps -> String
show :: OpaqueExtraOps -> String
$cshowList :: [OpaqueExtraOps] -> ShowS
showList :: [OpaqueExtraOps] -> ShowS
Show)

-- | The names of the C functions implementing the operations on some
-- opaque type.
data OpaqueOps = OpaqueOps
  { OpaqueOps -> Text
opaqueFree :: CFuncName,
    OpaqueOps -> Text
opaqueStore :: CFuncName,
    OpaqueOps -> Text
opaqueRestore :: CFuncName
  }
  deriving (OpaqueOps -> OpaqueOps -> Bool
(OpaqueOps -> OpaqueOps -> Bool)
-> (OpaqueOps -> OpaqueOps -> Bool) -> Eq OpaqueOps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpaqueOps -> OpaqueOps -> Bool
== :: OpaqueOps -> OpaqueOps -> Bool
$c/= :: OpaqueOps -> OpaqueOps -> Bool
/= :: OpaqueOps -> OpaqueOps -> Bool
Eq, Eq OpaqueOps
Eq OpaqueOps =>
(OpaqueOps -> OpaqueOps -> Ordering)
-> (OpaqueOps -> OpaqueOps -> Bool)
-> (OpaqueOps -> OpaqueOps -> Bool)
-> (OpaqueOps -> OpaqueOps -> Bool)
-> (OpaqueOps -> OpaqueOps -> Bool)
-> (OpaqueOps -> OpaqueOps -> OpaqueOps)
-> (OpaqueOps -> OpaqueOps -> OpaqueOps)
-> Ord OpaqueOps
OpaqueOps -> OpaqueOps -> Bool
OpaqueOps -> OpaqueOps -> Ordering
OpaqueOps -> OpaqueOps -> OpaqueOps
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 :: OpaqueOps -> OpaqueOps -> Ordering
compare :: OpaqueOps -> OpaqueOps -> Ordering
$c< :: OpaqueOps -> OpaqueOps -> Bool
< :: OpaqueOps -> OpaqueOps -> Bool
$c<= :: OpaqueOps -> OpaqueOps -> Bool
<= :: OpaqueOps -> OpaqueOps -> Bool
$c> :: OpaqueOps -> OpaqueOps -> Bool
> :: OpaqueOps -> OpaqueOps -> Bool
$c>= :: OpaqueOps -> OpaqueOps -> Bool
>= :: OpaqueOps -> OpaqueOps -> Bool
$cmax :: OpaqueOps -> OpaqueOps -> OpaqueOps
max :: OpaqueOps -> OpaqueOps -> OpaqueOps
$cmin :: OpaqueOps -> OpaqueOps -> OpaqueOps
min :: OpaqueOps -> OpaqueOps -> OpaqueOps
Ord, Int -> OpaqueOps -> ShowS
[OpaqueOps] -> ShowS
OpaqueOps -> String
(Int -> OpaqueOps -> ShowS)
-> (OpaqueOps -> String)
-> ([OpaqueOps] -> ShowS)
-> Show OpaqueOps
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpaqueOps -> ShowS
showsPrec :: Int -> OpaqueOps -> ShowS
$cshow :: OpaqueOps -> String
show :: OpaqueOps -> String
$cshowList :: [OpaqueOps] -> ShowS
showList :: [OpaqueOps] -> ShowS
Show)

-- | Manifest info for a non-scalar type. Scalar types are not part of
-- the manifest for a program. Although this representation allows a
-- type to be both a a record and a sum type, this will never actually
-- happen.
data Type
  = -- | ctype, Futhark elemtype, rank.
    TypeArray CTypeName TypeName Int ArrayOps
  | TypeOpaque CTypeName OpaqueOps (Maybe OpaqueExtraOps)
  deriving (Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
/= :: Type -> Type -> Bool
Eq, Eq Type
Eq Type =>
(Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
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 :: Type -> Type -> Ordering
compare :: Type -> Type -> Ordering
$c< :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
>= :: Type -> Type -> Bool
$cmax :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
min :: Type -> Type -> Type
Ord, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Type -> ShowS
showsPrec :: Int -> Type -> ShowS
$cshow :: Type -> String
show :: Type -> String
$cshowList :: [Type] -> ShowS
showList :: [Type] -> ShowS
Show)

-- | A manifest for a compiled program.
data Manifest = Manifest
  { -- | A mapping from Futhark entry points to how they are
    -- represented in C.
    Manifest -> Map Text EntryPoint
manifestEntryPoints :: M.Map T.Text EntryPoint,
    -- | A mapping from Futhark type name to how they are represented
    -- at the C level.  Should not contain any of the primitive scalar
    -- types.  For array types, these have empty dimensions,
    -- e.g. @[]i32@.
    Manifest -> Map Text Type
manifestTypes :: M.Map TypeName Type,
    -- | The compiler backend used to
    -- compile the program, e.g. @c@.
    Manifest -> Text
manifestBackend :: T.Text,
    -- | The version of the compiler used to compile the program.
    Manifest -> Text
manifestVersion :: T.Text
  }
  deriving (Manifest -> Manifest -> Bool
(Manifest -> Manifest -> Bool)
-> (Manifest -> Manifest -> Bool) -> Eq Manifest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Manifest -> Manifest -> Bool
== :: Manifest -> Manifest -> Bool
$c/= :: Manifest -> Manifest -> Bool
/= :: Manifest -> Manifest -> Bool
Eq, Eq Manifest
Eq Manifest =>
(Manifest -> Manifest -> Ordering)
-> (Manifest -> Manifest -> Bool)
-> (Manifest -> Manifest -> Bool)
-> (Manifest -> Manifest -> Bool)
-> (Manifest -> Manifest -> Bool)
-> (Manifest -> Manifest -> Manifest)
-> (Manifest -> Manifest -> Manifest)
-> Ord Manifest
Manifest -> Manifest -> Bool
Manifest -> Manifest -> Ordering
Manifest -> Manifest -> Manifest
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 :: Manifest -> Manifest -> Ordering
compare :: Manifest -> Manifest -> Ordering
$c< :: Manifest -> Manifest -> Bool
< :: Manifest -> Manifest -> Bool
$c<= :: Manifest -> Manifest -> Bool
<= :: Manifest -> Manifest -> Bool
$c> :: Manifest -> Manifest -> Bool
> :: Manifest -> Manifest -> Bool
$c>= :: Manifest -> Manifest -> Bool
>= :: Manifest -> Manifest -> Bool
$cmax :: Manifest -> Manifest -> Manifest
max :: Manifest -> Manifest -> Manifest
$cmin :: Manifest -> Manifest -> Manifest
min :: Manifest -> Manifest -> Manifest
Ord, Int -> Manifest -> ShowS
[Manifest] -> ShowS
Manifest -> String
(Int -> Manifest -> ShowS)
-> (Manifest -> String) -> ([Manifest] -> ShowS) -> Show Manifest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Manifest -> ShowS
showsPrec :: Int -> Manifest -> ShowS
$cshow :: Manifest -> String
show :: Manifest -> String
$cshowList :: [Manifest] -> ShowS
showList :: [Manifest] -> ShowS
Show)

instance JSON.ToJSON ArrayOps where
  toJSON :: ArrayOps -> Value
toJSON (ArrayOps {Text
arrayFree :: ArrayOps -> Text
arrayFree :: Text
arrayFree, Text
arrayShape :: ArrayOps -> Text
arrayShape :: Text
arrayShape, Text
arrayValues :: ArrayOps -> Text
arrayValues :: Text
arrayValues, Text
arrayNew :: ArrayOps -> Text
arrayNew :: Text
arrayNew, Text
arrayNewRaw :: ArrayOps -> Text
arrayNewRaw :: Text
arrayNewRaw, Text
arrayValuesRaw :: ArrayOps -> Text
arrayValuesRaw :: Text
arrayValuesRaw, Text
arrayIndex :: ArrayOps -> Text
arrayIndex :: Text
arrayIndex}) =
    [Pair] -> Value
object
      [ (Key
"free", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
arrayFree),
        (Key
"shape", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
arrayShape),
        (Key
"values", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
arrayValues),
        (Key
"new", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
arrayNew),
        (Key
"new_raw", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
arrayNewRaw),
        (Key
"values_raw", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
arrayValuesRaw),
        (Key
"index", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
arrayIndex)
      ]

instance JSON.ToJSON RecordField where
  toJSON :: RecordField -> Value
toJSON (RecordField Text
name Text
typename Text
project) =
    [Pair] -> Value
object
      [ (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
name),
        (Key
"type", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
typename),
        (Key
"project", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
project)
      ]

instance JSON.ToJSON RecordOps where
  toJSON :: RecordOps -> Value
toJSON (RecordOps [RecordField]
fields Text
new) =
    [Pair] -> Value
object
      [ (Key
"fields", [RecordField] -> Value
forall a. ToJSON a => a -> Value
toJSON [RecordField]
fields),
        (Key
"new", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
new)
      ]

instance JSON.ToJSON SumVariant where
  toJSON :: SumVariant -> Value
toJSON (SumVariant Text
name [Text]
payload Text
construct Text
destruct) =
    [Pair] -> Value
object
      [ (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
name),
        (Key
"payload", [Text] -> Value
forall a. ToJSON a => a -> Value
toJSON [Text]
payload),
        (Key
"construct", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
construct),
        (Key
"destruct", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
destruct)
      ]

instance JSON.ToJSON SumOps where
  toJSON :: SumOps -> Value
toJSON (SumOps [SumVariant]
variants Text
variant) =
    [Pair] -> Value
object
      [ (Key
"variants", [SumVariant] -> Value
forall a. ToJSON a => a -> Value
toJSON [SumVariant]
variants),
        (Key
"variant", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
variant)
      ]

instance JSON.ToJSON OpaqueArrayOps where
  toJSON :: OpaqueArrayOps -> Value
toJSON (OpaqueArrayOps Int
rank Text
elemtype Text
index Text
shape) =
    [Pair] -> Value
object
      [ (Key
"rank", Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
rank),
        (Key
"elemtype", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
elemtype),
        (Key
"index", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
index),
        (Key
"shape", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
shape)
      ]

instance JSON.ToJSON RecordArrayOps where
  toJSON :: RecordArrayOps -> Value
toJSON (RecordArrayOps Int
rank Text
elemtype [RecordField]
fields Text
zip_f Text
index Text
shape) =
    [Pair] -> Value
object
      [ (Key
"rank", Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
rank),
        (Key
"elemtype", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
elemtype),
        (Key
"fields", [RecordField] -> Value
forall a. ToJSON a => a -> Value
toJSON [RecordField]
fields),
        (Key
"zip", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
zip_f),
        (Key
"index", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
index),
        (Key
"shape", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
shape)
      ]

instance JSON.ToJSON OpaqueOps where
  toJSON :: OpaqueOps -> Value
toJSON (OpaqueOps Text
free Text
store Text
restore) =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ (Key
"free", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
free),
        (Key
"store", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
store),
        (Key
"restore", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
restore)
      ]

instance JSON.ToJSON Manifest where
  toJSON :: Manifest -> Value
toJSON (Manifest Map Text EntryPoint
entry_points Map Text Type
types Text
backend Text
version) =
    [Pair] -> Value
object
      [ (Key
"backend", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
backend),
        (Key
"version", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
version),
        ( Key
"entry_points",
          [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ ((Text, EntryPoint) -> Pair) -> [(Text, EntryPoint)] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Key)
-> (EntryPoint -> Value) -> (Text, EntryPoint) -> Pair
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> Key
JSON.fromText EntryPoint -> Value
onEntryPoint) ([(Text, EntryPoint)] -> [Pair]) -> [(Text, EntryPoint)] -> [Pair]
forall a b. (a -> b) -> a -> b
$ Map Text EntryPoint -> [(Text, EntryPoint)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text EntryPoint
entry_points
        ),
        ( Key
"types",
          [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ ((Text, Type) -> Pair) -> [(Text, Type)] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Key) -> (Type -> Value) -> (Text, Type) -> Pair
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> Key
JSON.fromText Type -> Value
onType) ([(Text, Type)] -> [Pair]) -> [(Text, Type)] -> [Pair]
forall a b. (a -> b) -> a -> b
$ Map Text Type -> [(Text, Type)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text Type
types
        )
      ]
    where
      onEntryPoint :: EntryPoint -> Value
onEntryPoint (EntryPoint Text
cfun [Text]
tuning_params [Output]
outputs [Input]
inputs) =
        [Pair] -> Value
object
          [ (Key
"cfun", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
cfun),
            (Key
"tuning_params", [Text] -> Value
forall a. ToJSON a => a -> Value
toJSON [Text]
tuning_params),
            (Key
"outputs", [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (Output -> Value) -> [Output] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Output -> Value
onOutput [Output]
outputs),
            (Key
"inputs", [Value] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ (Input -> Value) -> [Input] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Input -> Value
onInput [Input]
inputs)
          ]

      onOutput :: Output -> Value
onOutput (Output Text
t Bool
u) =
        [Pair] -> Value
object
          [ (Key
"type", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t),
            (Key
"unique", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
u)
          ]

      onInput :: Input -> Value
onInput (Input Text
p Text
t Bool
u) =
        [Pair] -> Value
object
          [ (Key
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
p),
            (Key
"type", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t),
            (Key
"unique", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
u)
          ]

      onType :: Type -> Value
onType (TypeArray Text
t Text
et Int
rank ArrayOps
ops) =
        [Pair] -> Value
object
          [ (Key
"kind", Value
"array"),
            (Key
"ctype", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t),
            (Key
"rank", Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
rank),
            (Key
"elemtype", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
et),
            (Key
"ops", ArrayOps -> Value
forall a. ToJSON a => a -> Value
toJSON ArrayOps
ops)
          ]
      onType (TypeOpaque Text
t OpaqueOps
ops Maybe OpaqueExtraOps
extra_ops) =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
          [ (Key
"kind", Value
"opaque"),
            (Key
"ctype", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t),
            (Key
"ops", OpaqueOps -> Value
forall a. ToJSON a => a -> Value
toJSON OpaqueOps
ops)
          ]
            [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ case Maybe OpaqueExtraOps
extra_ops of
              Maybe OpaqueExtraOps
Nothing -> []
              Just (OpaqueRecord RecordOps
recordops) ->
                [(Key
"record", RecordOps -> Value
forall a. ToJSON a => a -> Value
toJSON RecordOps
recordops)]
              Just (OpaqueSum SumOps
sumops) ->
                [(Key
"sum", SumOps -> Value
forall a. ToJSON a => a -> Value
toJSON SumOps
sumops)]
              Just (OpaqueArray OpaqueArrayOps
arrayops) ->
                [(Key
"opaque_array", OpaqueArrayOps -> Value
forall a. ToJSON a => a -> Value
toJSON OpaqueArrayOps
arrayops)]
              Just (OpaqueRecordArray RecordArrayOps
arrayops) ->
                [(Key
"record_array", RecordArrayOps -> Value
forall a. ToJSON a => a -> Value
toJSON RecordArrayOps
arrayops)]

instance JSON.FromJSON ArrayOps where
  parseJSON :: Value -> Parser ArrayOps
parseJSON = String -> (Object -> Parser ArrayOps) -> Value -> Parser ArrayOps
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"ArrayOps" ((Object -> Parser ArrayOps) -> Value -> Parser ArrayOps)
-> (Object -> Parser ArrayOps) -> Value -> Parser ArrayOps
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text -> Text -> Text -> Text -> Text -> Text -> Text -> ArrayOps
ArrayOps
      (Text -> Text -> Text -> Text -> Text -> Text -> Text -> ArrayOps)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> Text -> Text -> Text -> ArrayOps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"free"
      Parser (Text -> Text -> Text -> Text -> Text -> Text -> ArrayOps)
-> Parser Text
-> Parser (Text -> Text -> Text -> Text -> Text -> ArrayOps)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"shape"
      Parser (Text -> Text -> Text -> Text -> Text -> ArrayOps)
-> Parser Text -> Parser (Text -> Text -> Text -> Text -> ArrayOps)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"values"
      Parser (Text -> Text -> Text -> Text -> ArrayOps)
-> Parser Text -> Parser (Text -> Text -> Text -> ArrayOps)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"new"
      Parser (Text -> Text -> Text -> ArrayOps)
-> Parser Text -> Parser (Text -> Text -> ArrayOps)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"new_raw"
      Parser (Text -> Text -> ArrayOps)
-> Parser Text -> Parser (Text -> ArrayOps)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"values_raw"
      Parser (Text -> ArrayOps) -> Parser Text -> Parser ArrayOps
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index"

instance JSON.FromJSON RecordField where
  parseJSON :: Value -> Parser RecordField
parseJSON = String
-> (Object -> Parser RecordField) -> Value -> Parser RecordField
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"RecordField" ((Object -> Parser RecordField) -> Value -> Parser RecordField)
-> (Object -> Parser RecordField) -> Value -> Parser RecordField
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text -> Text -> Text -> RecordField
RecordField (Text -> Text -> Text -> RecordField)
-> Parser Text -> Parser (Text -> Text -> RecordField)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name" Parser (Text -> Text -> RecordField)
-> Parser Text -> Parser (Text -> RecordField)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" Parser (Text -> RecordField) -> Parser Text -> Parser RecordField
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project"

instance JSON.FromJSON RecordOps where
  parseJSON :: Value -> Parser RecordOps
parseJSON = String -> (Object -> Parser RecordOps) -> Value -> Parser RecordOps
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"RecordOps" ((Object -> Parser RecordOps) -> Value -> Parser RecordOps)
-> (Object -> Parser RecordOps) -> Value -> Parser RecordOps
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    [RecordField] -> Text -> RecordOps
RecordOps ([RecordField] -> Text -> RecordOps)
-> Parser [RecordField] -> Parser (Text -> RecordOps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser [RecordField]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fields" Parser (Text -> RecordOps) -> Parser Text -> Parser RecordOps
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"new"

instance JSON.FromJSON SumVariant where
  parseJSON :: Value -> Parser SumVariant
parseJSON = String
-> (Object -> Parser SumVariant) -> Value -> Parser SumVariant
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"SumVariant" ((Object -> Parser SumVariant) -> Value -> Parser SumVariant)
-> (Object -> Parser SumVariant) -> Value -> Parser SumVariant
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text -> [Text] -> Text -> Text -> SumVariant
SumVariant
      (Text -> [Text] -> Text -> Text -> SumVariant)
-> Parser Text -> Parser ([Text] -> Text -> Text -> SumVariant)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser ([Text] -> Text -> Text -> SumVariant)
-> Parser [Text] -> Parser (Text -> Text -> SumVariant)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"payload"
      Parser (Text -> Text -> SumVariant)
-> Parser Text -> Parser (Text -> SumVariant)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"construct"
      Parser (Text -> SumVariant) -> Parser Text -> Parser SumVariant
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"destruct"

instance JSON.FromJSON SumOps where
  parseJSON :: Value -> Parser SumOps
parseJSON = String -> (Object -> Parser SumOps) -> Value -> Parser SumOps
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"SumOps" ((Object -> Parser SumOps) -> Value -> Parser SumOps)
-> (Object -> Parser SumOps) -> Value -> Parser SumOps
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    [SumVariant] -> Text -> SumOps
SumOps ([SumVariant] -> Text -> SumOps)
-> Parser [SumVariant] -> Parser (Text -> SumOps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser [SumVariant]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"variants" Parser (Text -> SumOps) -> Parser Text -> Parser SumOps
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"variant"

instance JSON.FromJSON OpaqueArrayOps where
  parseJSON :: Value -> Parser OpaqueArrayOps
parseJSON = String
-> (Object -> Parser OpaqueArrayOps)
-> Value
-> Parser OpaqueArrayOps
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"OpaqueArrayOps" ((Object -> Parser OpaqueArrayOps)
 -> Value -> Parser OpaqueArrayOps)
-> (Object -> Parser OpaqueArrayOps)
-> Value
-> Parser OpaqueArrayOps
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Int -> Text -> Text -> Text -> OpaqueArrayOps
OpaqueArrayOps
      (Int -> Text -> Text -> Text -> OpaqueArrayOps)
-> Parser Int -> Parser (Text -> Text -> Text -> OpaqueArrayOps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rank"
      Parser (Text -> Text -> Text -> OpaqueArrayOps)
-> Parser Text -> Parser (Text -> Text -> OpaqueArrayOps)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"elemtype"
      Parser (Text -> Text -> OpaqueArrayOps)
-> Parser Text -> Parser (Text -> OpaqueArrayOps)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index"
      Parser (Text -> OpaqueArrayOps)
-> Parser Text -> Parser OpaqueArrayOps
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"shape"

instance JSON.FromJSON RecordArrayOps where
  parseJSON :: Value -> Parser RecordArrayOps
parseJSON = String
-> (Object -> Parser RecordArrayOps)
-> Value
-> Parser RecordArrayOps
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"RecordArrayOps" ((Object -> Parser RecordArrayOps)
 -> Value -> Parser RecordArrayOps)
-> (Object -> Parser RecordArrayOps)
-> Value
-> Parser RecordArrayOps
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Int
-> Text -> [RecordField] -> Text -> Text -> Text -> RecordArrayOps
RecordArrayOps
      (Int
 -> Text -> [RecordField] -> Text -> Text -> Text -> RecordArrayOps)
-> Parser Int
-> Parser
     (Text -> [RecordField] -> Text -> Text -> Text -> RecordArrayOps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rank"
      Parser
  (Text -> [RecordField] -> Text -> Text -> Text -> RecordArrayOps)
-> Parser Text
-> Parser ([RecordField] -> Text -> Text -> Text -> RecordArrayOps)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"elemtype"
      Parser ([RecordField] -> Text -> Text -> Text -> RecordArrayOps)
-> Parser [RecordField]
-> Parser (Text -> Text -> Text -> RecordArrayOps)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [RecordField]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fields"
      Parser (Text -> Text -> Text -> RecordArrayOps)
-> Parser Text -> Parser (Text -> Text -> RecordArrayOps)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"zip"
      Parser (Text -> Text -> RecordArrayOps)
-> Parser Text -> Parser (Text -> RecordArrayOps)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index"
      Parser (Text -> RecordArrayOps)
-> Parser Text -> Parser RecordArrayOps
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"shape"

instance JSON.FromJSON OpaqueOps where
  parseJSON :: Value -> Parser OpaqueOps
parseJSON = String -> (Object -> Parser OpaqueOps) -> Value -> Parser OpaqueOps
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"OpaqueOps" ((Object -> Parser OpaqueOps) -> Value -> Parser OpaqueOps)
-> (Object -> Parser OpaqueOps) -> Value -> Parser OpaqueOps
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text -> Text -> Text -> OpaqueOps
OpaqueOps
      (Text -> Text -> Text -> OpaqueOps)
-> Parser Text -> Parser (Text -> Text -> OpaqueOps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"free"
      Parser (Text -> Text -> OpaqueOps)
-> Parser Text -> Parser (Text -> OpaqueOps)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"store"
      Parser (Text -> OpaqueOps) -> Parser Text -> Parser OpaqueOps
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"restore"

instance JSON.FromJSON EntryPoint where
  parseJSON :: Value -> Parser EntryPoint
parseJSON = String
-> (Object -> Parser EntryPoint) -> Value -> Parser EntryPoint
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"EntryPoint" ((Object -> Parser EntryPoint) -> Value -> Parser EntryPoint)
-> (Object -> Parser EntryPoint) -> Value -> Parser EntryPoint
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text -> [Text] -> [Output] -> [Input] -> EntryPoint
EntryPoint
      (Text -> [Text] -> [Output] -> [Input] -> EntryPoint)
-> Parser Text
-> Parser ([Text] -> [Output] -> [Input] -> EntryPoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cfun"
      Parser ([Text] -> [Output] -> [Input] -> EntryPoint)
-> Parser [Text] -> Parser ([Output] -> [Input] -> EntryPoint)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [Text]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tuning_params"
      Parser ([Output] -> [Input] -> EntryPoint)
-> Parser [Output] -> Parser ([Input] -> EntryPoint)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [Output]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"outputs"
      Parser ([Input] -> EntryPoint)
-> Parser [Input] -> Parser EntryPoint
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [Input]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"inputs"

instance JSON.FromJSON Output where
  parseJSON :: Value -> Parser Output
parseJSON = String -> (Object -> Parser Output) -> Value -> Parser Output
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Output" ((Object -> Parser Output) -> Value -> Parser Output)
-> (Object -> Parser Output) -> Value -> Parser Output
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text -> Bool -> Output
Output (Text -> Bool -> Output) -> Parser Text -> Parser (Bool -> Output)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" Parser (Bool -> Output) -> Parser Bool -> Parser Output
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"unique"

instance JSON.FromJSON Input where
  parseJSON :: Value -> Parser Input
parseJSON = String -> (Object -> Parser Input) -> Value -> Parser Input
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Input" ((Object -> Parser Input) -> Value -> Parser Input)
-> (Object -> Parser Input) -> Value -> Parser Input
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text -> Text -> Bool -> Input
Input (Text -> Text -> Bool -> Input)
-> Parser Text -> Parser (Text -> Bool -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name" Parser (Text -> Bool -> Input)
-> Parser Text -> Parser (Bool -> Input)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" Parser (Bool -> Input) -> Parser Bool -> Parser Input
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"unique"

instance JSON.FromJSON Type where
  parseJSON :: Value -> Parser Type
parseJSON = String -> (Object -> Parser Type) -> Value -> Parser Type
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Type" ((Object -> Parser Type) -> Value -> Parser Type)
-> (Object -> Parser Type) -> Value -> Parser Type
forall a b. (a -> b) -> a -> b
$ \Object
ty -> Object -> Parser Type
pArray Object
ty Parser Type -> Parser Type -> Parser Type
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object -> Parser Type
pOpaque Object
ty
    where
      pArray :: Object -> Parser Type
pArray Object
ty = do
        Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> (Text -> Bool) -> Text -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"array" :: T.Text)) (Text -> Parser ()) -> Parser Text -> Parser ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
ty Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind")
        Text -> Text -> Int -> ArrayOps -> Type
TypeArray
          (Text -> Text -> Int -> ArrayOps -> Type)
-> Parser Text -> Parser (Text -> Int -> ArrayOps -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
ty Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ctype"
          Parser (Text -> Int -> ArrayOps -> Type)
-> Parser Text -> Parser (Int -> ArrayOps -> Type)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
ty Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"elemtype"
          Parser (Int -> ArrayOps -> Type)
-> Parser Int -> Parser (ArrayOps -> Type)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
ty Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rank"
          Parser (ArrayOps -> Type) -> Parser ArrayOps -> Parser Type
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
ty Object -> Key -> Parser ArrayOps
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ops"
      pOpaque :: Object -> Parser Type
pOpaque Object
ty = do
        Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> (Text -> Bool) -> Text -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
"opaque" :: T.Text)) (Text -> Parser ()) -> Parser Text -> Parser ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
ty Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kind")
        Text -> OpaqueOps -> Maybe OpaqueExtraOps -> Type
TypeOpaque
          (Text -> OpaqueOps -> Maybe OpaqueExtraOps -> Type)
-> Parser Text
-> Parser (OpaqueOps -> Maybe OpaqueExtraOps -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
ty Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ctype"
          Parser (OpaqueOps -> Maybe OpaqueExtraOps -> Type)
-> Parser OpaqueOps -> Parser (Maybe OpaqueExtraOps -> Type)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
ty Object -> Key -> Parser OpaqueOps
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ops"
          Parser (Maybe OpaqueExtraOps -> Type)
-> Parser (Maybe OpaqueExtraOps) -> Parser Type
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Maybe RecordOps
-> Maybe SumOps
-> Maybe OpaqueArrayOps
-> Maybe RecordArrayOps
-> Maybe OpaqueExtraOps
f
                  (Maybe RecordOps
 -> Maybe SumOps
 -> Maybe OpaqueArrayOps
 -> Maybe RecordArrayOps
 -> Maybe OpaqueExtraOps)
-> Parser (Maybe RecordOps)
-> Parser
     (Maybe SumOps
      -> Maybe OpaqueArrayOps
      -> Maybe RecordArrayOps
      -> Maybe OpaqueExtraOps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
ty Object -> Key -> Parser (Maybe RecordOps)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"record"
                  Parser
  (Maybe SumOps
   -> Maybe OpaqueArrayOps
   -> Maybe RecordArrayOps
   -> Maybe OpaqueExtraOps)
-> Parser (Maybe SumOps)
-> Parser
     (Maybe OpaqueArrayOps
      -> Maybe RecordArrayOps -> Maybe OpaqueExtraOps)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
ty Object -> Key -> Parser (Maybe SumOps)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sum"
                  Parser
  (Maybe OpaqueArrayOps
   -> Maybe RecordArrayOps -> Maybe OpaqueExtraOps)
-> Parser (Maybe OpaqueArrayOps)
-> Parser (Maybe RecordArrayOps -> Maybe OpaqueExtraOps)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
ty Object -> Key -> Parser (Maybe OpaqueArrayOps)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"opaque_array"
                  Parser (Maybe RecordArrayOps -> Maybe OpaqueExtraOps)
-> Parser (Maybe RecordArrayOps) -> Parser (Maybe OpaqueExtraOps)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
ty Object -> Key -> Parser (Maybe RecordArrayOps)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"record_array"
              )
        where
          f :: Maybe RecordOps
-> Maybe SumOps
-> Maybe OpaqueArrayOps
-> Maybe RecordArrayOps
-> Maybe OpaqueExtraOps
f (Just RecordOps
x) Maybe SumOps
_ Maybe OpaqueArrayOps
_ Maybe RecordArrayOps
_ = OpaqueExtraOps -> Maybe OpaqueExtraOps
forall a. a -> Maybe a
Just (RecordOps -> OpaqueExtraOps
OpaqueRecord RecordOps
x)
          f Maybe RecordOps
_ (Just SumOps
x) Maybe OpaqueArrayOps
_ Maybe RecordArrayOps
_ = OpaqueExtraOps -> Maybe OpaqueExtraOps
forall a. a -> Maybe a
Just (SumOps -> OpaqueExtraOps
OpaqueSum SumOps
x)
          f Maybe RecordOps
_ Maybe SumOps
_ (Just OpaqueArrayOps
x) Maybe RecordArrayOps
_ = OpaqueExtraOps -> Maybe OpaqueExtraOps
forall a. a -> Maybe a
Just (OpaqueArrayOps -> OpaqueExtraOps
OpaqueArray OpaqueArrayOps
x)
          f Maybe RecordOps
_ Maybe SumOps
_ Maybe OpaqueArrayOps
_ (Just RecordArrayOps
x) = OpaqueExtraOps -> Maybe OpaqueExtraOps
forall a. a -> Maybe a
Just (RecordArrayOps -> OpaqueExtraOps
OpaqueRecordArray RecordArrayOps
x)
          f Maybe RecordOps
_ Maybe SumOps
_ Maybe OpaqueArrayOps
_ Maybe RecordArrayOps
_ = Maybe OpaqueExtraOps
forall a. Maybe a
Nothing

instance JSON.FromJSON Manifest where
  parseJSON :: Value -> Parser Manifest
parseJSON = String -> (Object -> Parser Manifest) -> Value -> Parser Manifest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Manifest" ((Object -> Parser Manifest) -> Value -> Parser Manifest)
-> (Object -> Parser Manifest) -> Value -> Parser Manifest
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Map Text EntryPoint -> Map Text Type -> Text -> Text -> Manifest
Manifest
      (Map Text EntryPoint -> Map Text Type -> Text -> Text -> Manifest)
-> Parser (Map Text EntryPoint)
-> Parser (Map Text Type -> Text -> Text -> Manifest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Map Text EntryPoint)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"entry_points"
      Parser (Map Text Type -> Text -> Text -> Manifest)
-> Parser (Map Text Type) -> Parser (Text -> Text -> Manifest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Map Text Type)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"types"
      Parser (Text -> Text -> Manifest)
-> Parser Text -> Parser (Text -> Manifest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"backend"
      Parser (Text -> Manifest) -> Parser Text -> Parser Manifest
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"version" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
"" -- Temporary workaround for older manifests.

-- | Serialise a manifest to JSON.
manifestToJSON :: Manifest -> T.Text
manifestToJSON :: Manifest -> Text
manifestToJSON = Text -> Text
toStrict (Text -> Text) -> (Manifest -> Text) -> Manifest -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Manifest -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText

-- | Read a manifest from JSON.  Returns 'Nothing' if the text does
-- not describe a 'Manifest'.
manifestFromJSON :: T.Text -> Maybe Manifest
manifestFromJSON :: Text -> Maybe Manifest
manifestFromJSON = ByteString -> Maybe Manifest
forall a. FromJSON a => ByteString -> Maybe a
JSON.decode (ByteString -> Maybe Manifest)
-> (Text -> ByteString) -> Text -> Maybe Manifest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> (Text -> Builder) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
encodeUtf8Builder