{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Pinch.Internal.Generic
( Field(..)
, getField
, putField
, field
, Enumeration(..)
, enum
, Void(..)
) where
import Control.Applicative
import Control.DeepSeq (NFData)
import Data.Proxy (Proxy (..))
import Data.Typeable (Typeable)
import GHC.Generics
import GHC.TypeLits
import qualified Data.HashMap.Strict as HM
import Pinch.Internal.Pinchable
import Pinch.Internal.TType
import Pinch.Internal.Value (Value (..))
class Combinable t where
combine :: Value t -> Value t -> Value t
instance Combinable TStruct where
combine :: Value TStruct -> Value TStruct -> Value TStruct
combine (VStruct HashMap Int16 SomeValue
as) (VStruct HashMap Int16 SomeValue
bs) = HashMap Int16 SomeValue -> Value TStruct
VStruct (HashMap Int16 SomeValue -> Value TStruct)
-> HashMap Int16 SomeValue -> Value TStruct
forall a b. (a -> b) -> a -> b
$ HashMap Int16 SomeValue
as HashMap Int16 SomeValue
-> HashMap Int16 SomeValue -> HashMap Int16 SomeValue
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
`HM.union` HashMap Int16 SomeValue
bs
instance {-# OVERLAPPABLE #-} GPinchable a => GPinchable (M1 i c a) where
type GTag (M1 i c a) = GTag a
gPinch :: forall a. M1 i c a a -> Value (GTag (M1 i c a))
gPinch = a a -> Value (GTag a)
forall a. a a -> Value (GTag a)
forall (f :: * -> *) a. GPinchable f => f a -> Value (GTag f)
gPinch (a a -> Value (GTag a))
-> (M1 i c a a -> a a) -> M1 i c a a -> Value (GTag a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 i c a a -> a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
gUnpinch :: forall a. Value (GTag (M1 i c a)) -> Parser (M1 i c a a)
gUnpinch = (a a -> M1 i c a a) -> Parser (a a) -> Parser (M1 i c a a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Parser (a a) -> Parser (M1 i c a a))
-> (Value (GTag a) -> Parser (a a))
-> Value (GTag a)
-> Parser (M1 i c a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value (GTag a) -> Parser (a a)
forall a. Value (GTag a) -> Parser (a a)
forall (f :: * -> *) a.
GPinchable f =>
Value (GTag f) -> Parser (f a)
gUnpinch
instance (Datatype d, GPinchable a) => GPinchable (D1 d a) where
type GTag (D1 d a) = GTag a
gPinch :: forall a. D1 d a a -> Value (GTag (D1 d a))
gPinch = a a -> Value (GTag a)
forall a. a a -> Value (GTag a)
forall (f :: * -> *) a. GPinchable f => f a -> Value (GTag f)
gPinch (a a -> Value (GTag a))
-> (D1 d a a -> a a) -> D1 d a a -> Value (GTag a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D1 d a a -> a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
gUnpinch :: forall a. Value (GTag (D1 d a)) -> Parser (D1 d a a)
gUnpinch Value (GTag (D1 d a))
v =
Parser (a a)
-> (String -> Parser (D1 d a a))
-> (a a -> Parser (D1 d a a))
-> Parser (D1 d a a)
forall a b.
Parser a -> (String -> Parser b) -> (a -> Parser b) -> Parser b
parserCatch (Value (GTag a) -> Parser (a a)
forall a. Value (GTag a) -> Parser (a a)
forall (f :: * -> *) a.
GPinchable f =>
Value (GTag f) -> Parser (f a)
gUnpinch Value (GTag a)
Value (GTag (D1 d a))
v)
(\String
msg -> String -> Parser (D1 d a a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (D1 d a a)) -> String -> Parser (D1 d a a)
forall a b. (a -> b) -> a -> b
$ String
"Failed to read '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"': " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg)
(D1 d a a -> Parser (D1 d a a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (D1 d a a -> Parser (D1 d a a))
-> (a a -> D1 d a a) -> a a -> Parser (D1 d a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a a -> D1 d a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1)
where
name :: String
name = M1 D d a Any -> String
forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
t d f a -> String
datatypeName (D1 d a b
forall {b}. D1 d a b
forall a. HasCallStack => a
undefined :: D1 d a b)
instance
( GPinchable a
, GPinchable b
, GTag a ~ GTag b
, Combinable (GTag a)
) => GPinchable (a :*: b) where
type GTag (a :*: b) = GTag a
gPinch :: forall a. (:*:) a b a -> Value (GTag (a :*: b))
gPinch (a a
a :*: b a
b) = a a -> Value (GTag a)
forall a. a a -> Value (GTag a)
forall (f :: * -> *) a. GPinchable f => f a -> Value (GTag f)
gPinch a a
a Value (GTag b) -> Value (GTag b) -> Value (GTag b)
forall t. Combinable t => Value t -> Value t -> Value t
`combine` b a -> Value (GTag b)
forall a. b a -> Value (GTag b)
forall (f :: * -> *) a. GPinchable f => f a -> Value (GTag f)
gPinch b a
b
gUnpinch :: forall a. Value (GTag (a :*: b)) -> Parser ((:*:) a b a)
gUnpinch Value (GTag (a :*: b))
m = a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (a a -> b a -> (:*:) a b a)
-> Parser (a a) -> Parser (b a -> (:*:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value (GTag a) -> Parser (a a)
forall a. Value (GTag a) -> Parser (a a)
forall (f :: * -> *) a.
GPinchable f =>
Value (GTag f) -> Parser (f a)
gUnpinch Value (GTag a)
Value (GTag (a :*: b))
m Parser (b a -> (:*:) a b a) -> Parser (b a) -> Parser ((:*:) a b a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value (GTag b) -> Parser (b a)
forall a. Value (GTag b) -> Parser (b a)
forall (f :: * -> *) a.
GPinchable f =>
Value (GTag f) -> Parser (f a)
gUnpinch Value (GTag b)
Value (GTag (a :*: b))
m
instance
( GPinchable a
, GPinchable b
, GTag a ~ GTag b
) => GPinchable (a :+: b) where
type GTag (a :+: b) = GTag a
gPinch :: forall a. (:+:) a b a -> Value (GTag (a :+: b))
gPinch (L1 a a
a) = a a -> Value (GTag a)
forall a. a a -> Value (GTag a)
forall (f :: * -> *) a. GPinchable f => f a -> Value (GTag f)
gPinch a a
a
gPinch (R1 b a
b) = b a -> Value (GTag b)
forall a. b a -> Value (GTag b)
forall (f :: * -> *) a. GPinchable f => f a -> Value (GTag f)
gPinch b a
b
gUnpinch :: forall a. Value (GTag (a :+: b)) -> Parser ((:+:) a b a)
gUnpinch Value (GTag (a :+: b))
m = a a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (a a -> (:+:) a b a) -> Parser (a a) -> Parser ((:+:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value (GTag a) -> Parser (a a)
forall a. Value (GTag a) -> Parser (a a)
forall (f :: * -> *) a.
GPinchable f =>
Value (GTag f) -> Parser (f a)
gUnpinch Value (GTag a)
Value (GTag (a :+: b))
m Parser ((:+:) a b a)
-> Parser ((:+:) a b a) -> Parser ((:+:) a b a)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> b a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (b a -> (:+:) a b a) -> Parser (b a) -> Parser ((:+:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value (GTag b) -> Parser (b a)
forall a. Value (GTag b) -> Parser (b a)
forall (f :: * -> *) a.
GPinchable f =>
Value (GTag f) -> Parser (f a)
gUnpinch Value (GTag b)
Value (GTag (a :+: b))
m
newtype Field (n :: Nat) a = Field a
deriving
(Field n a
Field n a -> Field n a -> Bounded (Field n a)
forall (n :: Nat) a. Bounded a => Field n a
forall a. a -> a -> Bounded a
$cminBound :: forall (n :: Nat) a. Bounded a => Field n a
minBound :: Field n a
$cmaxBound :: forall (n :: Nat) a. Bounded a => Field n a
maxBound :: Field n a
Bounded, Field n a -> Field n a -> Bool
(Field n a -> Field n a -> Bool)
-> (Field n a -> Field n a -> Bool) -> Eq (Field n a)
forall (n :: Nat) a. Eq a => Field n a -> Field n a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (n :: Nat) a. Eq a => Field n a -> Field n a -> Bool
== :: Field n a -> Field n a -> Bool
$c/= :: forall (n :: Nat) a. Eq a => Field n a -> Field n a -> Bool
/= :: Field n a -> Field n a -> Bool
Eq, Int -> Field n a
Field n a -> Int
Field n a -> [Field n a]
Field n a -> Field n a
Field n a -> Field n a -> [Field n a]
Field n a -> Field n a -> Field n a -> [Field n a]
(Field n a -> Field n a)
-> (Field n a -> Field n a)
-> (Int -> Field n a)
-> (Field n a -> Int)
-> (Field n a -> [Field n a])
-> (Field n a -> Field n a -> [Field n a])
-> (Field n a -> Field n a -> [Field n a])
-> (Field n a -> Field n a -> Field n a -> [Field n a])
-> Enum (Field n a)
forall (n :: Nat) a. Enum a => Int -> Field n a
forall (n :: Nat) a. Enum a => Field n a -> Int
forall (n :: Nat) a. Enum a => Field n a -> [Field n a]
forall (n :: Nat) a. Enum a => Field n a -> Field n a
forall (n :: Nat) a.
Enum a =>
Field n a -> Field n a -> [Field n a]
forall (n :: Nat) a.
Enum a =>
Field n a -> Field n a -> Field n a -> [Field n a]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: forall (n :: Nat) a. Enum a => Field n a -> Field n a
succ :: Field n a -> Field n a
$cpred :: forall (n :: Nat) a. Enum a => Field n a -> Field n a
pred :: Field n a -> Field n a
$ctoEnum :: forall (n :: Nat) a. Enum a => Int -> Field n a
toEnum :: Int -> Field n a
$cfromEnum :: forall (n :: Nat) a. Enum a => Field n a -> Int
fromEnum :: Field n a -> Int
$cenumFrom :: forall (n :: Nat) a. Enum a => Field n a -> [Field n a]
enumFrom :: Field n a -> [Field n a]
$cenumFromThen :: forall (n :: Nat) a.
Enum a =>
Field n a -> Field n a -> [Field n a]
enumFromThen :: Field n a -> Field n a -> [Field n a]
$cenumFromTo :: forall (n :: Nat) a.
Enum a =>
Field n a -> Field n a -> [Field n a]
enumFromTo :: Field n a -> Field n a -> [Field n a]
$cenumFromThenTo :: forall (n :: Nat) a.
Enum a =>
Field n a -> Field n a -> Field n a -> [Field n a]
enumFromThenTo :: Field n a -> Field n a -> Field n a -> [Field n a]
Enum, (forall m. Monoid m => Field n m -> m)
-> (forall m a. Monoid m => (a -> m) -> Field n a -> m)
-> (forall m a. Monoid m => (a -> m) -> Field n a -> m)
-> (forall a b. (a -> b -> b) -> b -> Field n a -> b)
-> (forall a b. (a -> b -> b) -> b -> Field n a -> b)
-> (forall b a. (b -> a -> b) -> b -> Field n a -> b)
-> (forall b a. (b -> a -> b) -> b -> Field n a -> b)
-> (forall a. (a -> a -> a) -> Field n a -> a)
-> (forall a. (a -> a -> a) -> Field n a -> a)
-> (forall a. Field n a -> [a])
-> (forall a. Field n a -> Bool)
-> (forall a. Field n a -> Int)
-> (forall a. Eq a => a -> Field n a -> Bool)
-> (forall a. Ord a => Field n a -> a)
-> (forall a. Ord a => Field n a -> a)
-> (forall a. Num a => Field n a -> a)
-> (forall a. Num a => Field n a -> a)
-> Foldable (Field n)
forall (n :: Nat) a. Eq a => a -> Field n a -> Bool
forall (n :: Nat) a. Num a => Field n a -> a
forall (n :: Nat) a. Ord a => Field n a -> a
forall (n :: Nat) m. Monoid m => Field n m -> m
forall (n :: Nat) a. Field n a -> Bool
forall (n :: Nat) a. Field n a -> Int
forall (n :: Nat) a. Field n a -> [a]
forall (n :: Nat) a. (a -> a -> a) -> Field n a -> a
forall (n :: Nat) m a. Monoid m => (a -> m) -> Field n a -> m
forall (n :: Nat) b a. (b -> a -> b) -> b -> Field n a -> b
forall (n :: Nat) a b. (a -> b -> b) -> b -> Field n a -> b
forall a. Eq a => a -> Field n a -> Bool
forall a. Num a => Field n a -> a
forall a. Ord a => Field n a -> a
forall m. Monoid m => Field n m -> m
forall a. Field n a -> Bool
forall a. Field n a -> Int
forall a. Field n a -> [a]
forall a. (a -> a -> a) -> Field n a -> a
forall m a. Monoid m => (a -> m) -> Field n a -> m
forall b a. (b -> a -> b) -> b -> Field n a -> b
forall a b. (a -> b -> b) -> b -> Field n a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall (n :: Nat) m. Monoid m => Field n m -> m
fold :: forall m. Monoid m => Field n m -> m
$cfoldMap :: forall (n :: Nat) m a. Monoid m => (a -> m) -> Field n a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Field n a -> m
$cfoldMap' :: forall (n :: Nat) m a. Monoid m => (a -> m) -> Field n a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Field n a -> m
$cfoldr :: forall (n :: Nat) a b. (a -> b -> b) -> b -> Field n a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Field n a -> b
$cfoldr' :: forall (n :: Nat) a b. (a -> b -> b) -> b -> Field n a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Field n a -> b
$cfoldl :: forall (n :: Nat) b a. (b -> a -> b) -> b -> Field n a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Field n a -> b
$cfoldl' :: forall (n :: Nat) b a. (b -> a -> b) -> b -> Field n a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Field n a -> b
$cfoldr1 :: forall (n :: Nat) a. (a -> a -> a) -> Field n a -> a
foldr1 :: forall a. (a -> a -> a) -> Field n a -> a
$cfoldl1 :: forall (n :: Nat) a. (a -> a -> a) -> Field n a -> a
foldl1 :: forall a. (a -> a -> a) -> Field n a -> a
$ctoList :: forall (n :: Nat) a. Field n a -> [a]
toList :: forall a. Field n a -> [a]
$cnull :: forall (n :: Nat) a. Field n a -> Bool
null :: forall a. Field n a -> Bool
$clength :: forall (n :: Nat) a. Field n a -> Int
length :: forall a. Field n a -> Int
$celem :: forall (n :: Nat) a. Eq a => a -> Field n a -> Bool
elem :: forall a. Eq a => a -> Field n a -> Bool
$cmaximum :: forall (n :: Nat) a. Ord a => Field n a -> a
maximum :: forall a. Ord a => Field n a -> a
$cminimum :: forall (n :: Nat) a. Ord a => Field n a -> a
minimum :: forall a. Ord a => Field n a -> a
$csum :: forall (n :: Nat) a. Num a => Field n a -> a
sum :: forall a. Num a => Field n a -> a
$cproduct :: forall (n :: Nat) a. Num a => Field n a -> a
product :: forall a. Num a => Field n a -> a
Foldable, (forall a b. (a -> b) -> Field n a -> Field n b)
-> (forall a b. a -> Field n b -> Field n a) -> Functor (Field n)
forall (n :: Nat) a b. a -> Field n b -> Field n a
forall (n :: Nat) a b. (a -> b) -> Field n a -> Field n b
forall a b. a -> Field n b -> Field n a
forall a b. (a -> b) -> Field n a -> Field n b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (n :: Nat) a b. (a -> b) -> Field n a -> Field n b
fmap :: forall a b. (a -> b) -> Field n a -> Field n b
$c<$ :: forall (n :: Nat) a b. a -> Field n b -> Field n a
<$ :: forall a b. a -> Field n b -> Field n a
Functor, (forall x. Field n a -> Rep (Field n a) x)
-> (forall x. Rep (Field n a) x -> Field n a)
-> Generic (Field n a)
forall (n :: Nat) a x. Rep (Field n a) x -> Field n a
forall (n :: Nat) a x. Field n a -> Rep (Field n a) x
forall x. Rep (Field n a) x -> Field n a
forall x. Field n a -> Rep (Field n a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (n :: Nat) a x. Field n a -> Rep (Field n a) x
from :: forall x. Field n a -> Rep (Field n a) x
$cto :: forall (n :: Nat) a x. Rep (Field n a) x -> Field n a
to :: forall x. Rep (Field n a) x -> Field n a
Generic, NonEmpty (Field n a) -> Field n a
Field n a -> Field n a -> Field n a
(Field n a -> Field n a -> Field n a)
-> (NonEmpty (Field n a) -> Field n a)
-> (forall b. Integral b => b -> Field n a -> Field n a)
-> Semigroup (Field n a)
forall (n :: Nat) a.
Semigroup a =>
NonEmpty (Field n a) -> Field n a
forall (n :: Nat) a.
Semigroup a =>
Field n a -> Field n a -> Field n a
forall (n :: Nat) a b.
(Semigroup a, Integral b) =>
b -> Field n a -> Field n a
forall b. Integral b => b -> Field n a -> Field n a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: forall (n :: Nat) a.
Semigroup a =>
Field n a -> Field n a -> Field n a
<> :: Field n a -> Field n a -> Field n a
$csconcat :: forall (n :: Nat) a.
Semigroup a =>
NonEmpty (Field n a) -> Field n a
sconcat :: NonEmpty (Field n a) -> Field n a
$cstimes :: forall (n :: Nat) a b.
(Semigroup a, Integral b) =>
b -> Field n a -> Field n a
stimes :: forall b. Integral b => b -> Field n a -> Field n a
Semigroup, Semigroup (Field n a)
Field n a
Semigroup (Field n a) =>
Field n a
-> (Field n a -> Field n a -> Field n a)
-> ([Field n a] -> Field n a)
-> Monoid (Field n a)
[Field n a] -> Field n a
Field n a -> Field n a -> Field n a
forall (n :: Nat) a. Monoid a => Semigroup (Field n a)
forall (n :: Nat) a. Monoid a => Field n a
forall (n :: Nat) a. Monoid a => [Field n a] -> Field n a
forall (n :: Nat) a.
Monoid a =>
Field n a -> Field n a -> Field n a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: forall (n :: Nat) a. Monoid a => Field n a
mempty :: Field n a
$cmappend :: forall (n :: Nat) a.
Monoid a =>
Field n a -> Field n a -> Field n a
mappend :: Field n a -> Field n a -> Field n a
$cmconcat :: forall (n :: Nat) a. Monoid a => [Field n a] -> Field n a
mconcat :: [Field n a] -> Field n a
Monoid, Field n a -> ()
(Field n a -> ()) -> NFData (Field n a)
forall (n :: Nat) a. NFData a => Field n a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall (n :: Nat) a. NFData a => Field n a -> ()
rnf :: Field n a -> ()
NFData, Eq (Field n a)
Eq (Field n a) =>
(Field n a -> Field n a -> Ordering)
-> (Field n a -> Field n a -> Bool)
-> (Field n a -> Field n a -> Bool)
-> (Field n a -> Field n a -> Bool)
-> (Field n a -> Field n a -> Bool)
-> (Field n a -> Field n a -> Field n a)
-> (Field n a -> Field n a -> Field n a)
-> Ord (Field n a)
Field n a -> Field n a -> Bool
Field n a -> Field n a -> Ordering
Field n a -> Field n a -> Field n a
forall (n :: Nat) a. Ord a => Eq (Field n a)
forall (n :: Nat) a. Ord a => Field n a -> Field n a -> Bool
forall (n :: Nat) a. Ord a => Field n a -> Field n a -> Ordering
forall (n :: Nat) a. Ord a => Field n a -> Field n a -> Field n a
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 :: forall (n :: Nat) a. Ord a => Field n a -> Field n a -> Ordering
compare :: Field n a -> Field n a -> Ordering
$c< :: forall (n :: Nat) a. Ord a => Field n a -> Field n a -> Bool
< :: Field n a -> Field n a -> Bool
$c<= :: forall (n :: Nat) a. Ord a => Field n a -> Field n a -> Bool
<= :: Field n a -> Field n a -> Bool
$c> :: forall (n :: Nat) a. Ord a => Field n a -> Field n a -> Bool
> :: Field n a -> Field n a -> Bool
$c>= :: forall (n :: Nat) a. Ord a => Field n a -> Field n a -> Bool
>= :: Field n a -> Field n a -> Bool
$cmax :: forall (n :: Nat) a. Ord a => Field n a -> Field n a -> Field n a
max :: Field n a -> Field n a -> Field n a
$cmin :: forall (n :: Nat) a. Ord a => Field n a -> Field n a -> Field n a
min :: Field n a -> Field n a -> Field n a
Ord, Int -> Field n a -> String -> String
[Field n a] -> String -> String
Field n a -> String
(Int -> Field n a -> String -> String)
-> (Field n a -> String)
-> ([Field n a] -> String -> String)
-> Show (Field n a)
forall (n :: Nat) a. Show a => Int -> Field n a -> String -> String
forall (n :: Nat) a. Show a => [Field n a] -> String -> String
forall (n :: Nat) a. Show a => Field n a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall (n :: Nat) a. Show a => Int -> Field n a -> String -> String
showsPrec :: Int -> Field n a -> String -> String
$cshow :: forall (n :: Nat) a. Show a => Field n a -> String
show :: Field n a -> String
$cshowList :: forall (n :: Nat) a. Show a => [Field n a] -> String -> String
showList :: [Field n a] -> String -> String
Show,
Functor (Field n)
Foldable (Field n)
(Functor (Field n), Foldable (Field n)) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Field n a -> f (Field n b))
-> (forall (f :: * -> *) a.
Applicative f =>
Field n (f a) -> f (Field n a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Field n a -> m (Field n b))
-> (forall (m :: * -> *) a.
Monad m =>
Field n (m a) -> m (Field n a))
-> Traversable (Field n)
forall (n :: Nat). Functor (Field n)
forall (n :: Nat). Foldable (Field n)
forall (n :: Nat) (m :: * -> *) a.
Monad m =>
Field n (m a) -> m (Field n a)
forall (n :: Nat) (f :: * -> *) a.
Applicative f =>
Field n (f a) -> f (Field n a)
forall (n :: Nat) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Field n a -> m (Field n b)
forall (n :: Nat) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Field n a -> f (Field n b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Field n (m a) -> m (Field n a)
forall (f :: * -> *) a.
Applicative f =>
Field n (f a) -> f (Field n a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Field n a -> m (Field n b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Field n a -> f (Field n b)
$ctraverse :: forall (n :: Nat) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Field n a -> f (Field n b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Field n a -> f (Field n b)
$csequenceA :: forall (n :: Nat) (f :: * -> *) a.
Applicative f =>
Field n (f a) -> f (Field n a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Field n (f a) -> f (Field n a)
$cmapM :: forall (n :: Nat) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Field n a -> m (Field n b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Field n a -> m (Field n b)
$csequence :: forall (n :: Nat) (m :: * -> *) a.
Monad m =>
Field n (m a) -> m (Field n a)
sequence :: forall (m :: * -> *) a. Monad m => Field n (m a) -> m (Field n a)
Traversable, Typeable)
getField :: Field n a -> a
getField :: forall (n :: Nat) a. Field n a -> a
getField (Field a
a) = a
a
putField :: a -> Field n a
putField :: forall a (n :: Nat). a -> Field n a
putField = a -> Field n a
forall (n :: Nat) a. a -> Field n a
Field
field :: Functor f => (a -> f b) -> Field n a -> f (Field n b)
field :: forall (f :: * -> *) a b (n :: Nat).
Functor f =>
(a -> f b) -> Field n a -> f (Field n b)
field a -> f b
f (Field a
a) = b -> Field n b
forall (n :: Nat) a. a -> Field n a
Field (b -> Field n b) -> f b -> f (Field n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
instance {-# OVERLAPPABLE #-} (Pinchable a, KnownNat n)
=> GPinchable (K1 i (Field n a)) where
type GTag (K1 i (Field n a)) = TStruct
gPinch :: forall a. K1 i (Field n a) a -> Value (GTag (K1 i (Field n a)))
gPinch (K1 (Field a
a)) = [FieldPair] -> Value TStruct
struct [Int16
n Int16 -> a -> FieldPair
forall a. Pinchable a => Int16 -> a -> FieldPair
.= a
a]
where
n :: Int16
n = Integer -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int16) -> Integer -> Int16
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n)
gUnpinch :: forall a.
Value (GTag (K1 i (Field n a))) -> Parser (K1 i (Field n a) a)
gUnpinch Value (GTag (K1 i (Field n a)))
m = Field n a -> K1 i (Field n a) a
forall k i c (p :: k). c -> K1 i c p
K1 (Field n a -> K1 i (Field n a) a)
-> (a -> Field n a) -> a -> K1 i (Field n a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Field n a
forall (n :: Nat) a. a -> Field n a
Field (a -> K1 i (Field n a) a)
-> Parser a -> Parser (K1 i (Field n a) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value TStruct
Value (GTag (K1 i (Field n a)))
m Value TStruct -> Int16 -> Parser a
forall a. Pinchable a => Value TStruct -> Int16 -> Parser a
.: Int16
n
where
n :: Int16
n = Integer -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int16) -> Integer -> Int16
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n)
instance
(Pinchable a, KnownNat n)
=> GPinchable (K1 i (Field n (Maybe a))) where
type GTag (K1 i (Field n (Maybe a))) = TStruct
gPinch :: forall a.
K1 i (Field n (Maybe a)) a
-> Value (GTag (K1 i (Field n (Maybe a))))
gPinch (K1 (Field Maybe a
a)) = [FieldPair] -> Value TStruct
struct [Int16
n Int16 -> Maybe a -> FieldPair
forall a. Pinchable a => Int16 -> Maybe a -> FieldPair
?= Maybe a
a]
where
n :: Int16
n = Integer -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int16) -> Integer -> Int16
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n)
gUnpinch :: forall a.
Value (GTag (K1 i (Field n (Maybe a))))
-> Parser (K1 i (Field n (Maybe a)) a)
gUnpinch Value (GTag (K1 i (Field n (Maybe a))))
m = Field n (Maybe a) -> K1 i (Field n (Maybe a)) a
forall k i c (p :: k). c -> K1 i c p
K1 (Field n (Maybe a) -> K1 i (Field n (Maybe a)) a)
-> (Maybe a -> Field n (Maybe a))
-> Maybe a
-> K1 i (Field n (Maybe a)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Field n (Maybe a)
forall (n :: Nat) a. a -> Field n a
Field (Maybe a -> K1 i (Field n (Maybe a)) a)
-> Parser (Maybe a) -> Parser (K1 i (Field n (Maybe a)) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value TStruct
Value (GTag (K1 i (Field n (Maybe a))))
m Value TStruct -> Int16 -> Parser (Maybe a)
forall a. Pinchable a => Value TStruct -> Int16 -> Parser (Maybe a)
.:? Int16
n
where
n :: Int16
n = Integer -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int16) -> Integer -> Int16
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n)
data Enumeration (n :: Nat) = Enumeration
deriving
(Enumeration n -> Enumeration n -> Bool
(Enumeration n -> Enumeration n -> Bool)
-> (Enumeration n -> Enumeration n -> Bool) -> Eq (Enumeration n)
forall (n :: Nat). Enumeration n -> Enumeration n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (n :: Nat). Enumeration n -> Enumeration n -> Bool
== :: Enumeration n -> Enumeration n -> Bool
$c/= :: forall (n :: Nat). Enumeration n -> Enumeration n -> Bool
/= :: Enumeration n -> Enumeration n -> Bool
Eq, (forall x. Enumeration n -> Rep (Enumeration n) x)
-> (forall x. Rep (Enumeration n) x -> Enumeration n)
-> Generic (Enumeration n)
forall (n :: Nat) x. Rep (Enumeration n) x -> Enumeration n
forall (n :: Nat) x. Enumeration n -> Rep (Enumeration n) x
forall x. Rep (Enumeration n) x -> Enumeration n
forall x. Enumeration n -> Rep (Enumeration n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (n :: Nat) x. Enumeration n -> Rep (Enumeration n) x
from :: forall x. Enumeration n -> Rep (Enumeration n) x
$cto :: forall (n :: Nat) x. Rep (Enumeration n) x -> Enumeration n
to :: forall x. Rep (Enumeration n) x -> Enumeration n
Generic, Eq (Enumeration n)
Eq (Enumeration n) =>
(Enumeration n -> Enumeration n -> Ordering)
-> (Enumeration n -> Enumeration n -> Bool)
-> (Enumeration n -> Enumeration n -> Bool)
-> (Enumeration n -> Enumeration n -> Bool)
-> (Enumeration n -> Enumeration n -> Bool)
-> (Enumeration n -> Enumeration n -> Enumeration n)
-> (Enumeration n -> Enumeration n -> Enumeration n)
-> Ord (Enumeration n)
Enumeration n -> Enumeration n -> Bool
Enumeration n -> Enumeration n -> Ordering
Enumeration n -> Enumeration n -> Enumeration n
forall (n :: Nat). Eq (Enumeration n)
forall (n :: Nat). Enumeration n -> Enumeration n -> Bool
forall (n :: Nat). Enumeration n -> Enumeration n -> Ordering
forall (n :: Nat). Enumeration n -> Enumeration n -> Enumeration n
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 :: forall (n :: Nat). Enumeration n -> Enumeration n -> Ordering
compare :: Enumeration n -> Enumeration n -> Ordering
$c< :: forall (n :: Nat). Enumeration n -> Enumeration n -> Bool
< :: Enumeration n -> Enumeration n -> Bool
$c<= :: forall (n :: Nat). Enumeration n -> Enumeration n -> Bool
<= :: Enumeration n -> Enumeration n -> Bool
$c> :: forall (n :: Nat). Enumeration n -> Enumeration n -> Bool
> :: Enumeration n -> Enumeration n -> Bool
$c>= :: forall (n :: Nat). Enumeration n -> Enumeration n -> Bool
>= :: Enumeration n -> Enumeration n -> Bool
$cmax :: forall (n :: Nat). Enumeration n -> Enumeration n -> Enumeration n
max :: Enumeration n -> Enumeration n -> Enumeration n
$cmin :: forall (n :: Nat). Enumeration n -> Enumeration n -> Enumeration n
min :: Enumeration n -> Enumeration n -> Enumeration n
Ord, Int -> Enumeration n -> String -> String
[Enumeration n] -> String -> String
Enumeration n -> String
(Int -> Enumeration n -> String -> String)
-> (Enumeration n -> String)
-> ([Enumeration n] -> String -> String)
-> Show (Enumeration n)
forall (n :: Nat). Int -> Enumeration n -> String -> String
forall (n :: Nat). [Enumeration n] -> String -> String
forall (n :: Nat). Enumeration n -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall (n :: Nat). Int -> Enumeration n -> String -> String
showsPrec :: Int -> Enumeration n -> String -> String
$cshow :: forall (n :: Nat). Enumeration n -> String
show :: Enumeration n -> String
$cshowList :: forall (n :: Nat). [Enumeration n] -> String -> String
showList :: [Enumeration n] -> String -> String
Show, Typeable)
instance NFData (Enumeration n)
enum :: Enumeration n
enum :: forall (n :: Nat). Enumeration n
enum = Enumeration n
forall (n :: Nat). Enumeration n
Enumeration
instance KnownNat n => GPinchable (K1 i (Enumeration n)) where
type GTag (K1 i (Enumeration n)) = TEnum
gPinch :: forall a.
K1 i (Enumeration n) a -> Value (GTag (K1 i (Enumeration n)))
gPinch (K1 Enumeration n
Enumeration) = Int32 -> Value TEnum
Int32 -> Value (GTag (K1 i (Enumeration n)))
VInt32 (Int32 -> Value (GTag (K1 i (Enumeration n))))
-> (Integer -> Int32)
-> Integer
-> Value (GTag (K1 i (Enumeration n)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Value (GTag (K1 i (Enumeration n))))
-> Integer -> Value (GTag (K1 i (Enumeration n)))
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n)
gUnpinch :: forall a.
Value (GTag (K1 i (Enumeration n)))
-> Parser (K1 i (Enumeration n) a)
gUnpinch (VInt32 Int32
i)
| Int32
i Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
val = K1 i (Enumeration n) a -> Parser (K1 i (Enumeration n) a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Enumeration n -> K1 i (Enumeration n) a
forall k i c (p :: k). c -> K1 i c p
K1 Enumeration n
forall (n :: Nat). Enumeration n
Enumeration)
| Bool
otherwise = String -> Parser (K1 i (Enumeration n) a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (K1 i (Enumeration n) a))
-> String -> Parser (K1 i (Enumeration n) a)
forall a b. (a -> b) -> a -> b
$ String
"Couldn't match enum value " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int32 -> String
forall a. Show a => a -> String
show Int32
i
where
val :: Int32
val = Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int32) -> Integer -> Int32
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall {k} (t :: k). Proxy t
Proxy :: Proxy n)
data Void = Void
deriving
(Void -> Void -> Bool
(Void -> Void -> Bool) -> (Void -> Void -> Bool) -> Eq Void
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Void -> Void -> Bool
== :: Void -> Void -> Bool
$c/= :: Void -> Void -> Bool
/= :: Void -> Void -> Bool
Eq, (forall x. Void -> Rep Void x)
-> (forall x. Rep Void x -> Void) -> Generic Void
forall x. Rep Void x -> Void
forall x. Void -> Rep Void x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Void -> Rep Void x
from :: forall x. Void -> Rep Void x
$cto :: forall x. Rep Void x -> Void
to :: forall x. Rep Void x -> Void
Generic, Eq Void
Eq Void =>
(Void -> Void -> Ordering)
-> (Void -> Void -> Bool)
-> (Void -> Void -> Bool)
-> (Void -> Void -> Bool)
-> (Void -> Void -> Bool)
-> (Void -> Void -> Void)
-> (Void -> Void -> Void)
-> Ord Void
Void -> Void -> Bool
Void -> Void -> Ordering
Void -> Void -> Void
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 :: Void -> Void -> Ordering
compare :: Void -> Void -> Ordering
$c< :: Void -> Void -> Bool
< :: Void -> Void -> Bool
$c<= :: Void -> Void -> Bool
<= :: Void -> Void -> Bool
$c> :: Void -> Void -> Bool
> :: Void -> Void -> Bool
$c>= :: Void -> Void -> Bool
>= :: Void -> Void -> Bool
$cmax :: Void -> Void -> Void
max :: Void -> Void -> Void
$cmin :: Void -> Void -> Void
min :: Void -> Void -> Void
Ord, Int -> Void -> String -> String
[Void] -> String -> String
Void -> String
(Int -> Void -> String -> String)
-> (Void -> String) -> ([Void] -> String -> String) -> Show Void
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Void -> String -> String
showsPrec :: Int -> Void -> String -> String
$cshow :: Void -> String
show :: Void -> String
$cshowList :: [Void] -> String -> String
showList :: [Void] -> String -> String
Show, Typeable)
instance GPinchable (K1 i Void) where
type GTag (K1 i Void) = TStruct
gPinch :: forall a. K1 i Void a -> Value (GTag (K1 i Void))
gPinch (K1 Void
Void) = [FieldPair] -> Value TStruct
struct []
gUnpinch :: forall a. Value (GTag (K1 i Void)) -> Parser (K1 i Void a)
gUnpinch (VStruct HashMap Int16 SomeValue
m) | HashMap Int16 SomeValue -> Bool
forall k v. HashMap k v -> Bool
HM.null HashMap Int16 SomeValue
m = K1 i Void a -> Parser (K1 i Void a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (K1 i Void a -> Parser (K1 i Void a))
-> K1 i Void a -> Parser (K1 i Void a)
forall a b. (a -> b) -> a -> b
$ Void -> K1 i Void a
forall k i c (p :: k). c -> K1 i c p
K1 Void
Void
gUnpinch Value (GTag (K1 i Void))
x = String -> Parser (K1 i Void a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (K1 i Void a)) -> String -> Parser (K1 i Void a)
forall a b. (a -> b) -> a -> b
$
String
"Failed to read response. Expected void, got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value TStruct -> String
forall a. Show a => a -> String
show Value TStruct
Value (GTag (K1 i Void))
x