{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | 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.
module Futhark.Manifest
  ( Manifest (..),
    Input (..),
    Output (..),
    EntryPoint (..),
    Type (..),
    ArrayOps (..),
    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)

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

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

-- | Manifest info for an entry point.
data EntryPoint = EntryPoint
  { EntryPoint -> Text
entryPointCFun :: 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
/= :: EntryPoint -> EntryPoint -> Bool
$c/= :: EntryPoint -> EntryPoint -> Bool
== :: EntryPoint -> EntryPoint -> Bool
$c== :: 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
min :: EntryPoint -> EntryPoint -> EntryPoint
$cmin :: EntryPoint -> EntryPoint -> EntryPoint
max :: EntryPoint -> EntryPoint -> EntryPoint
$cmax :: EntryPoint -> EntryPoint -> EntryPoint
>= :: EntryPoint -> EntryPoint -> Bool
$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
compare :: EntryPoint -> EntryPoint -> Ordering
$ccompare :: EntryPoint -> EntryPoint -> Ordering
$cp1Ord :: Eq 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
showList :: [EntryPoint] -> ShowS
$cshowList :: [EntryPoint] -> ShowS
show :: EntryPoint -> String
$cshow :: EntryPoint -> String
showsPrec :: Int -> EntryPoint -> ShowS
$cshowsPrec :: Int -> EntryPoint -> ShowS
Show)

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

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

-- | Manifest info for a non-scalar type.  Scalar types are not part
-- of the manifest for a program.
data Type
  = -- | ctype, Futhark elemtype, rank.
    TypeArray T.Text T.Text Int ArrayOps
  | TypeOpaque T.Text OpaqueOps
  deriving (Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: 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
min :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$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
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
$cp1Ord :: Eq 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
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> 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 T.Text 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
/= :: Manifest -> Manifest -> Bool
$c/= :: Manifest -> Manifest -> Bool
== :: Manifest -> Manifest -> Bool
$c== :: 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
min :: Manifest -> Manifest -> Manifest
$cmin :: Manifest -> Manifest -> Manifest
max :: Manifest -> Manifest -> Manifest
$cmax :: Manifest -> Manifest -> Manifest
>= :: Manifest -> Manifest -> Bool
$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
compare :: Manifest -> Manifest -> Ordering
$ccompare :: Manifest -> Manifest -> Ordering
$cp1Ord :: Eq 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
showList :: [Manifest] -> ShowS
$cshowList :: [Manifest] -> ShowS
show :: Manifest -> String
$cshow :: Manifest -> String
showsPrec :: Int -> Manifest -> ShowS
$cshowsPrec :: Int -> Manifest -> ShowS
Show)

instance JSON.ToJSON ArrayOps where
  toJSON :: ArrayOps -> Value
toJSON (ArrayOps Text
free Text
shape Text
values Text
new) =
    [Pair] -> Value
object
      [ (Key
"free", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
free),
        (Key
"shape", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
shape),
        (Key
"values", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
values),
        (Key
"new", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
new)
      ]

instance JSON.ToJSON OpaqueOps where
  toJSON :: OpaqueOps -> Value
toJSON (OpaqueOps Text
free Text
store Text
restore) =
    [Pair] -> Value
object
      [ (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 (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 (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 [Output]
outputs [Input]
inputs) =
        [Pair] -> Value
object
          [ (Key
"cfun", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
cfun),
            (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) =
        [Pair] -> Value
object
          [ (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)
          ]

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 -> ArrayOps
ArrayOps (Text -> Text -> Text -> Text -> ArrayOps)
-> Parser Text -> Parser (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 -> ArrayOps)
-> Parser Text -> Parser (Text -> Text -> ArrayOps)
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 -> ArrayOps)
-> Parser Text -> Parser (Text -> ArrayOps)
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 -> ArrayOps) -> Parser Text -> Parser ArrayOps
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 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 (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 (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 -> [Output] -> [Input] -> EntryPoint
EntryPoint (Text -> [Output] -> [Input] -> EntryPoint)
-> Parser Text -> Parser ([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 ([Output] -> [Input] -> EntryPoint)
-> Parser [Output] -> Parser ([Input] -> EntryPoint)
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 (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 (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 (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 (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 (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 (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 (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 (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 -> Type
TypeOpaque (Text -> OpaqueOps -> Type)
-> Parser Text -> Parser (OpaqueOps -> 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 -> Type) -> Parser OpaqueOps -> Parser Type
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"

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 (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 (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 (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