{-# 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 :: M1 i c a a -> Value (GTag (M1 i c a))
gPinch = 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 i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
gUnpinch :: 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 (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 (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 :: D1 d a a -> Value (GTag (D1 d a))
gPinch = 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 i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
gUnpinch :: 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 (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 (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 (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
datatypeName (forall b. M1 D 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 :: (:*:) a b a -> Value (GTag (a :*: b))
gPinch (a a
a :*: b a
b) = 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 (f :: * -> *) a. GPinchable f => f a -> Value (GTag f)
gPinch b a
b
gUnpinch :: 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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 :: (:+:) a b a -> Value (GTag (a :+: b))
gPinch (L1 a a
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 (f :: * -> *) a. GPinchable f => f a -> Value (GTag f)
gPinch b a
b
gUnpinch :: 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 (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 (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 (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 a. a -> a -> Bounded a
forall (n :: Nat) a. Bounded a => Field n a
maxBound :: Field n a
$cmaxBound :: forall (n :: Nat) a. Bounded a => Field n a
minBound :: Field n a
$cminBound :: forall (n :: Nat) a. Bounded a => 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 a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall (n :: Nat) a. Eq a => 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 a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum 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]
enumFromThenTo :: Field n a -> 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]
enumFromTo :: 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]
enumFromThen :: Field n a -> Field n a -> [Field n a]
$cenumFromThen :: forall (n :: Nat) a.
Enum a =>
Field n a -> Field n a -> [Field n a]
enumFrom :: Field n a -> [Field n a]
$cenumFrom :: forall (n :: Nat) a. Enum a => Field n a -> [Field n a]
fromEnum :: Field n a -> Int
$cfromEnum :: forall (n :: Nat) a. Enum a => Field n a -> Int
toEnum :: Int -> Field n a
$ctoEnum :: forall (n :: Nat) a. Enum a => Int -> Field n a
pred :: Field n a -> Field n a
$cpred :: forall (n :: Nat) a. Enum a => Field n a -> Field n a
succ :: Field n a -> Field n a
$csucc :: forall (n :: Nat) a. Enum a => Field n a -> Field n a
Enum, Field n a -> Bool
(a -> m) -> Field n a -> m
(a -> b -> b) -> b -> Field n a -> b
(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 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 (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 (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
product :: Field n a -> a
$cproduct :: forall (n :: Nat) a. Num a => Field n a -> a
sum :: Field n a -> a
$csum :: forall (n :: Nat) a. Num a => Field n a -> a
minimum :: Field n a -> a
$cminimum :: forall (n :: Nat) a. Ord a => Field n a -> a
maximum :: Field n a -> a
$cmaximum :: forall (n :: Nat) a. Ord a => Field n a -> a
elem :: a -> Field n a -> Bool
$celem :: forall (n :: Nat) a. Eq a => a -> Field n a -> Bool
length :: Field n a -> Int
$clength :: forall (n :: Nat) a. Field n a -> Int
null :: Field n a -> Bool
$cnull :: forall (n :: Nat) a. Field n a -> Bool
toList :: Field n a -> [a]
$ctoList :: forall (n :: Nat) a. Field n a -> [a]
foldl1 :: (a -> a -> a) -> Field n a -> a
$cfoldl1 :: forall (n :: Nat) a. (a -> a -> a) -> Field n a -> a
foldr1 :: (a -> a -> a) -> Field n a -> a
$cfoldr1 :: forall (n :: Nat) a. (a -> a -> a) -> Field n a -> a
foldl' :: (b -> a -> b) -> b -> Field n a -> b
$cfoldl' :: forall (n :: Nat) b a. (b -> a -> b) -> b -> Field n a -> b
foldl :: (b -> a -> b) -> b -> Field n a -> b
$cfoldl :: forall (n :: Nat) b a. (b -> a -> b) -> b -> Field n a -> b
foldr' :: (a -> b -> b) -> b -> Field n a -> b
$cfoldr' :: forall (n :: Nat) a b. (a -> b -> b) -> b -> Field n a -> b
foldr :: (a -> b -> b) -> b -> Field n a -> b
$cfoldr :: forall (n :: Nat) a b. (a -> b -> b) -> b -> Field n a -> b
foldMap' :: (a -> m) -> Field n a -> m
$cfoldMap' :: forall (n :: Nat) m a. Monoid m => (a -> m) -> Field n a -> m
foldMap :: (a -> m) -> Field n a -> m
$cfoldMap :: forall (n :: Nat) m a. Monoid m => (a -> m) -> Field n a -> m
fold :: Field n m -> m
$cfold :: forall (n :: Nat) m. Monoid m => Field n m -> m
Foldable, a -> Field n b -> Field n a
(a -> b) -> Field n a -> Field n b
(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 a b. a -> Field n b -> Field n a
forall a b. (a -> b) -> Field n a -> Field n b
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 (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Field n b -> Field n a
$c<$ :: forall (n :: Nat) a b. a -> Field n b -> Field n a
fmap :: (a -> b) -> Field n a -> Field n b
$cfmap :: forall (n :: Nat) a b. (a -> b) -> Field n a -> Field n b
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 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
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
$cto :: forall (n :: Nat) a x. Rep (Field n a) x -> Field n a
$cfrom :: forall (n :: Nat) a x. Field n a -> Rep (Field n a) x
Generic, b -> Field n a -> Field n a
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 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
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
stimes :: b -> Field n a -> Field n a
$cstimes :: forall (n :: Nat) a b.
(Semigroup a, Integral b) =>
b -> Field n a -> Field n a
sconcat :: NonEmpty (Field n a) -> Field n a
$csconcat :: forall (n :: Nat) a.
Semigroup a =>
NonEmpty (Field n a) -> Field n a
<> :: Field n a -> Field n a -> Field n a
$c<> :: forall (n :: Nat) a.
Semigroup a =>
Field n a -> 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 a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid 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
mconcat :: [Field n a] -> Field n a
$cmconcat :: forall (n :: Nat) a. Monoid a => [Field n a] -> Field n a
mappend :: Field n a -> Field n a -> Field n a
$cmappend :: forall (n :: Nat) a.
Monoid a =>
Field n a -> Field n a -> Field n a
mempty :: Field n a
$cmempty :: forall (n :: Nat) a. Monoid a => Field n a
$cp1Monoid :: forall (n :: Nat) a. Monoid a => Semigroup (Field n a)
Monoid, Field n a -> ()
(Field n a -> ()) -> NFData (Field n a)
forall a. (a -> ()) -> NFData a
forall (n :: Nat) a. NFData a => Field n a -> ()
rnf :: Field n a -> ()
$crnf :: forall (n :: Nat) a. NFData a => 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 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
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
min :: 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
max :: Field n a -> Field n a -> Field n a
$cmax :: forall (n :: Nat) a. Ord a => Field n a -> Field n a -> Field n a
>= :: 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
$c< :: forall (n :: Nat) a. Ord a => Field n a -> Field n a -> Bool
compare :: Field n a -> Field n a -> Ordering
$ccompare :: forall (n :: Nat) a. Ord a => Field n a -> Field n a -> Ordering
$cp1Ord :: forall (n :: Nat) a. Ord a => Eq (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 a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show 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
showList :: [Field n a] -> String -> String
$cshowList :: forall (n :: Nat) a. Show a => [Field n a] -> String -> String
show :: Field n a -> String
$cshow :: forall (n :: Nat) a. Show a => Field n a -> String
showsPrec :: Int -> Field n a -> String -> String
$cshowsPrec :: forall (n :: Nat) a. Show a => Int -> 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)
(a -> f b) -> Field n a -> f (Field n b)
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)
sequence :: Field n (m a) -> m (Field n a)
$csequence :: forall (n :: Nat) (m :: * -> *) a.
Monad m =>
Field n (m a) -> m (Field n a)
mapM :: (a -> m b) -> Field n a -> m (Field n b)
$cmapM :: forall (n :: Nat) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Field n a -> m (Field n b)
sequenceA :: Field n (f a) -> f (Field n a)
$csequenceA :: forall (n :: Nat) (f :: * -> *) a.
Applicative f =>
Field n (f a) -> f (Field n a)
traverse :: (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)
$cp2Traversable :: forall (n :: Nat). Foldable (Field n)
$cp1Traversable :: forall (n :: Nat). Functor (Field n)
Traversable, Typeable)
getField :: Field n a -> a
getField :: Field n a -> a
getField (Field a
a) = a
a
putField :: a -> Field n a
putField :: 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 :: (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 :: 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 :: 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 :: 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 :: 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 a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
Eq, (forall x. Enumeration n -> Rep (Enumeration n) x)
-> (forall x. Rep (Enumeration n) x -> Enumeration n)
-> Generic (Enumeration n)
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
forall (n :: Nat) x. Rep (Enumeration n) x -> Enumeration n
forall (n :: Nat) x. Enumeration n -> Rep (Enumeration n) x
$cto :: forall (n :: Nat) x. Rep (Enumeration n) x -> Enumeration n
$cfrom :: forall (n :: Nat) x. Enumeration n -> Rep (Enumeration n) x
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 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
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
min :: Enumeration n -> Enumeration n -> Enumeration n
$cmin :: forall (n :: Nat). Enumeration n -> Enumeration n -> Enumeration n
max :: Enumeration n -> Enumeration n -> Enumeration n
$cmax :: forall (n :: Nat). Enumeration n -> Enumeration n -> Enumeration n
>= :: 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
$c< :: forall (n :: Nat). Enumeration n -> Enumeration n -> Bool
compare :: Enumeration n -> Enumeration n -> Ordering
$ccompare :: forall (n :: Nat). Enumeration n -> Enumeration n -> Ordering
$cp1Ord :: forall (n :: Nat). Eq (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 a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall (n :: Nat). Int -> Enumeration n -> String -> String
forall (n :: Nat). [Enumeration n] -> String -> String
forall (n :: Nat). Enumeration n -> String
showList :: [Enumeration n] -> String -> String
$cshowList :: forall (n :: Nat). [Enumeration n] -> String -> String
show :: Enumeration n -> String
$cshow :: forall (n :: Nat). Enumeration n -> String
showsPrec :: Int -> Enumeration n -> String -> String
$cshowsPrec :: forall (n :: Nat). Int -> Enumeration n -> String -> String
Show, Typeable)
instance NFData (Enumeration n)
enum :: Enumeration n
enum :: 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 :: K1 i (Enumeration n) a -> Value (GTag (K1 i (Enumeration n)))
gPinch (K1 Enumeration n
Enumeration) = Int32 -> Value TInt32
VInt32 (Int32 -> Value TInt32)
-> (Integer -> Int32) -> Integer -> Value TInt32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Value TInt32) -> Integer -> Value TInt32
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 :: 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 (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 (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
/= :: Void -> Void -> Bool
$c/= :: Void -> Void -> Bool
== :: Void -> Void -> Bool
$c== :: 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
$cto :: forall x. Rep Void x -> Void
$cfrom :: forall x. Void -> Rep Void x
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
min :: Void -> Void -> Void
$cmin :: Void -> Void -> Void
max :: Void -> Void -> Void
$cmax :: Void -> Void -> Void
>= :: Void -> Void -> Bool
$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
compare :: Void -> Void -> Ordering
$ccompare :: Void -> Void -> Ordering
$cp1Ord :: Eq 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
showList :: [Void] -> String -> String
$cshowList :: [Void] -> String -> String
show :: Void -> String
$cshow :: Void -> String
showsPrec :: Int -> Void -> String -> String
$cshowsPrec :: Int -> Void -> String -> String
Show, Typeable)
instance GPinchable (K1 i Void) where
type GTag (K1 i Void) = TStruct
gPinch :: K1 i Void a -> Value (GTag (K1 i Void))
gPinch (K1 Void
Void) = [FieldPair] -> Value TStruct
struct []
gUnpinch :: 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 (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 (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