{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE StrictData #-}

module Data.SpirV.Headers.Enum
  ( decode
  , SpirvJson(..)
  , Spv(..)
  , Meta(..)
  , Enum(..)
  , Type(..)
  ) where

import Prelude hiding (Enum)

import Data.Aeson (eitherDecodeFileStrict)
import Data.Aeson.Types (FromJSON(..), Options(..), defaultOptions, genericParseJSON)
import Data.Char (toUpper)
import Data.Map.Strict (Map)
import Data.Text (Text)
import Data.Word (Word32)
import GHC.Generics (Generic)

decode :: FilePath -> IO (Either String Spv)
decode :: String -> IO (Either String Spv)
decode String
fp = (SpirvJson -> Spv) -> Either String SpirvJson -> Either String Spv
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SpirvJson -> Spv
spv (Either String SpirvJson -> Either String Spv)
-> IO (Either String SpirvJson) -> IO (Either String Spv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Either String SpirvJson)
forall a. FromJSON a => String -> IO (Either String a)
eitherDecodeFileStrict String
fp

newtype SpirvJson = SpirvJson
  { SpirvJson -> Spv
spv :: Spv
  }
  deriving (SpirvJson -> SpirvJson -> Bool
(SpirvJson -> SpirvJson -> Bool)
-> (SpirvJson -> SpirvJson -> Bool) -> Eq SpirvJson
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpirvJson -> SpirvJson -> Bool
== :: SpirvJson -> SpirvJson -> Bool
$c/= :: SpirvJson -> SpirvJson -> Bool
/= :: SpirvJson -> SpirvJson -> Bool
Eq, Int -> SpirvJson -> ShowS
[SpirvJson] -> ShowS
SpirvJson -> String
(Int -> SpirvJson -> ShowS)
-> (SpirvJson -> String)
-> ([SpirvJson] -> ShowS)
-> Show SpirvJson
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpirvJson -> ShowS
showsPrec :: Int -> SpirvJson -> ShowS
$cshow :: SpirvJson -> String
show :: SpirvJson -> String
$cshowList :: [SpirvJson] -> ShowS
showList :: [SpirvJson] -> ShowS
Show, (forall x. SpirvJson -> Rep SpirvJson x)
-> (forall x. Rep SpirvJson x -> SpirvJson) -> Generic SpirvJson
forall x. Rep SpirvJson x -> SpirvJson
forall x. SpirvJson -> Rep SpirvJson x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SpirvJson -> Rep SpirvJson x
from :: forall x. SpirvJson -> Rep SpirvJson x
$cto :: forall x. Rep SpirvJson x -> SpirvJson
to :: forall x. Rep SpirvJson x -> SpirvJson
Generic)

instance FromJSON SpirvJson

data Spv = Spv
  { Spv -> Meta
meta :: Meta
  , Spv -> [Enum]
enum :: [Enum]
  }
  deriving (Spv -> Spv -> Bool
(Spv -> Spv -> Bool) -> (Spv -> Spv -> Bool) -> Eq Spv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Spv -> Spv -> Bool
== :: Spv -> Spv -> Bool
$c/= :: Spv -> Spv -> Bool
/= :: Spv -> Spv -> Bool
Eq, Int -> Spv -> ShowS
[Spv] -> ShowS
Spv -> String
(Int -> Spv -> ShowS)
-> (Spv -> String) -> ([Spv] -> ShowS) -> Show Spv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Spv -> ShowS
showsPrec :: Int -> Spv -> ShowS
$cshow :: Spv -> String
show :: Spv -> String
$cshowList :: [Spv] -> ShowS
showList :: [Spv] -> ShowS
Show, (forall x. Spv -> Rep Spv x)
-> (forall x. Rep Spv x -> Spv) -> Generic Spv
forall x. Rep Spv x -> Spv
forall x. Spv -> Rep Spv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Spv -> Rep Spv x
from :: forall x. Spv -> Rep Spv x
$cto :: forall x. Rep Spv x -> Spv
to :: forall x. Rep Spv x -> Spv
Generic)

instance FromJSON Spv

data Meta = Meta
  { Meta -> [[Text]]
comment :: [[Text]]
  , Meta -> Int
magicNumber :: Int
  , Meta -> Int
version :: Int
  , Meta -> Int
revision :: Int
  , Meta -> Word32
opCodeMask :: Word32
  , Meta -> Int
wordCountShift :: Int
  }
  deriving (Meta -> Meta -> Bool
(Meta -> Meta -> Bool) -> (Meta -> Meta -> Bool) -> Eq Meta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Meta -> Meta -> Bool
== :: Meta -> Meta -> Bool
$c/= :: Meta -> Meta -> Bool
/= :: Meta -> Meta -> Bool
Eq, Int -> Meta -> ShowS
[Meta] -> ShowS
Meta -> String
(Int -> Meta -> ShowS)
-> (Meta -> String) -> ([Meta] -> ShowS) -> Show Meta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Meta -> ShowS
showsPrec :: Int -> Meta -> ShowS
$cshow :: Meta -> String
show :: Meta -> String
$cshowList :: [Meta] -> ShowS
showList :: [Meta] -> ShowS
Show, (forall x. Meta -> Rep Meta x)
-> (forall x. Rep Meta x -> Meta) -> Generic Meta
forall x. Rep Meta x -> Meta
forall x. Meta -> Rep Meta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Meta -> Rep Meta x
from :: forall x. Meta -> Rep Meta x
$cto :: forall x. Rep Meta x -> Meta
to :: forall x. Rep Meta x -> Meta
Generic)

instance FromJSON Meta where
  parseJSON :: Value -> Parser Meta
parseJSON = Options -> Value -> Parser Meta
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
pascalCase

data Enum = Enum
  { Enum -> Text
name :: Text
  , Enum -> Type
type_ :: Type
  , Enum -> Map Text Word32
values :: Map Text Word32
  }
  deriving (Enum -> Enum -> Bool
(Enum -> Enum -> Bool) -> (Enum -> Enum -> Bool) -> Eq Enum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Enum -> Enum -> Bool
== :: Enum -> Enum -> Bool
$c/= :: Enum -> Enum -> Bool
/= :: Enum -> Enum -> Bool
Eq, Int -> Enum -> ShowS
[Enum] -> ShowS
Enum -> String
(Int -> Enum -> ShowS)
-> (Enum -> String) -> ([Enum] -> ShowS) -> Show Enum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Enum -> ShowS
showsPrec :: Int -> Enum -> ShowS
$cshow :: Enum -> String
show :: Enum -> String
$cshowList :: [Enum] -> ShowS
showList :: [Enum] -> ShowS
Show, (forall x. Enum -> Rep Enum x)
-> (forall x. Rep Enum x -> Enum) -> Generic Enum
forall x. Rep Enum x -> Enum
forall x. Enum -> Rep Enum x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Enum -> Rep Enum x
from :: forall x. Enum -> Rep Enum x
$cto :: forall x. Rep Enum x -> Enum
to :: forall x. Rep Enum x -> Enum
Generic)

instance FromJSON Enum where
  parseJSON :: Value -> Parser Enum
parseJSON = Options -> Value -> Parser Enum
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
pascalCase

data Type
  = Value
  | Bit
  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, 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, (forall x. Type -> Rep Type x)
-> (forall x. Rep Type x -> Type) -> Generic Type
forall x. Rep Type x -> Type
forall x. Type -> Rep Type x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Type -> Rep Type x
from :: forall x. Type -> Rep Type x
$cto :: forall x. Rep Type x -> Type
to :: forall x. Rep Type x -> Type
Generic)

instance FromJSON Type

pascalCase :: Options
pascalCase :: Options
pascalCase = Options
defaultOptions
  { fieldLabelModifier = \case
      [] -> []
      String
"type_" -> String
"Type"
      Char
x : String
xs -> Char -> Char
toUpper Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
  }