{-# language DataKinds             #-}
{-# language FlexibleContexts      #-}
{-# language FlexibleInstances     #-}
{-# language GADTs                 #-}
{-# language MultiParamTypeClasses #-}
{-# language PartialTypeSignatures #-}
{-# language PolyKinds             #-}
{-# language QuantifiedConstraints #-}
{-# language ScopedTypeVariables   #-}
{-# language TypeApplications      #-}
{-# language TypeFamilies          #-}
{-# language TypeOperators         #-}
{-# language UndecidableInstances  #-}
module Generics.Kind.Derive.Json where

import           Control.Applicative
import           Control.Monad
import           Data.Aeson
import           Data.Aeson.Types
import           Data.Kind
import           Data.Proxy
import           GHC.Generics        (Meta (..))
import           GHC.TypeLits
import           Generics.Kind

gtoJSON' :: forall t. (GenericK t, GToJSONK (RepK t) 'LoT0)
         => t -> Value
gtoJSON' :: forall t.
(GenericK @(*) t, GToJSONK @(*) (RepK @(*) t) 'LoT0) =>
t -> Value
gtoJSON' t
x = forall k (f :: LoT k -> *) (x :: LoT k).
GToJSONK @k f x =>
f x -> Value
gtoJSON (forall k (f :: k) (x :: LoT k).
GenericK @k f =>
(:@@:) @k f x -> RepK @k f x
fromK @_ @t @'LoT0 t
x)

gfromJSON' :: forall t. (GenericK t, GFromJSONK (RepK t) 'LoT0)
           => Value -> Parser t
gfromJSON' :: forall t.
(GenericK @(*) t, GFromJSONK @(*) (RepK @(*) t) 'LoT0) =>
Value -> Parser t
gfromJSON' Value
v = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k (f :: k) (x :: LoT k).
GenericK @k f =>
RepK @k f x -> (:@@:) @k f x
toK @_ @t @'LoT0) (forall k (f :: LoT k -> *) (x :: LoT k).
GFromJSONK @k f x =>
Value -> Parser (f x)
gfromJSON Value
v)

class GToJSONK (f :: LoT k -> Type) (x :: LoT k) where
  gtoJSON :: f x -> Value
class GFromJSONK (f :: LoT k -> Type) (x :: LoT k) where
  gfromJSON :: Value -> Parser (f x)

instance ToJSON (Interpret t x)
         => GToJSONK (Field t) x where
  gtoJSON :: Field @k t x -> Value
gtoJSON (Field Interpret @k @(*) t x
t) = forall a. ToJSON a => a -> Value
toJSON Interpret @k @(*) t x
t
instance FromJSON (Interpret t x)
         => GFromJSONK (Field t) x where
  gfromJSON :: Value -> Parser (Field @k t x)
gfromJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {d} (t :: Atom @LiftedRep d (*)) (x :: LoT d).
Interpret @d @(*) t x -> Field @d t x
Field forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON

instance GToJSONK U1 x where
  gtoJSON :: U1 @(LoT k) x -> Value
gtoJSON U1 @(LoT k) x
U1 = Value
Null
instance GFromJSONK U1 x where
  gfromJSON :: Value -> Parser (U1 @(LoT k) x)
gfromJSON Value
Null = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k (p :: k). U1 @k p
U1
  gfromJSON Value
_    = forall (f :: * -> *) a. Alternative f => f a
empty

instance (GToJSONK f x, GToJSONK g x)
         => GToJSONK (f :+: g) x where
  gtoJSON :: (:+:) @(LoT k) f g x -> Value
gtoJSON (L1 f x
f) = forall k (f :: LoT k -> *) (x :: LoT k).
GToJSONK @k f x =>
f x -> Value
gtoJSON f x
f
  gtoJSON (R1 g x
g) = forall k (f :: LoT k -> *) (x :: LoT k).
GToJSONK @k f x =>
f x -> Value
gtoJSON g x
g
instance (GFromJSONK f x, GFromJSONK g x)
         => GFromJSONK (f :+: g) x where
  gfromJSON :: Value -> Parser ((:+:) @(LoT k) f g x)
gfromJSON Value
v = (forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> (:+:) @k f g p
L1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k (f :: LoT k -> *) (x :: LoT k).
GFromJSONK @k f x =>
Value -> Parser (f x)
gfromJSON Value
v) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall k (f :: k -> *) (g :: k -> *) (p :: k).
g p -> (:+:) @k f g p
R1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k (f :: LoT k -> *) (x :: LoT k).
GFromJSONK @k f x =>
Value -> Parser (f x)
gfromJSON Value
v)

instance (GToJSONK f x, GToJSONK g x)
         => GToJSONK (f :*: g) x where
  gtoJSON :: (:*:) @(LoT k) f g x -> Value
gtoJSON (f x
f :*: g x
g) = forall a. ToJSON a => a -> Value
toJSON (forall k (f :: LoT k -> *) (x :: LoT k).
GToJSONK @k f x =>
f x -> Value
gtoJSON f x
f, forall k (f :: LoT k -> *) (x :: LoT k).
GToJSONK @k f x =>
f x -> Value
gtoJSON g x
g)
instance (GFromJSONK f x, GFromJSONK g x)
         => GFromJSONK (f :*: g) x where
  gfromJSON :: Value -> Parser ((:*:) @(LoT k) f g x)
gfromJSON Value
v = do (Value
f, Value
g) <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
                   forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) @k f g p
(:*:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k (f :: LoT k -> *) (x :: LoT k).
GFromJSONK @k f x =>
Value -> Parser (f x)
gfromJSON Value
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall k (f :: LoT k -> *) (x :: LoT k).
GFromJSONK @k f x =>
Value -> Parser (f x)
gfromJSON Value
g

instance forall name f x i fx st.
         (GToJSONK f x, KnownSymbol name)
         => GToJSONK (M1 i ('MetaCons name fx st) f) x where
  gtoJSON :: M1 @(LoT k) i ('MetaCons name fx st) f x -> Value
gtoJSON (M1 f x
f) = forall a. ToJSON a => a -> Value
toJSON (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy @k t
Proxy @name, forall k (f :: LoT k -> *) (x :: LoT k).
GToJSONK @k f x =>
f x -> Value
gtoJSON f x
f)
instance forall name f x i fx st.
         (GFromJSONK f x, KnownSymbol name)
         => GFromJSONK (M1 i ('MetaCons name fx st) f) x where
  gfromJSON :: Value -> Parser (M1 @(LoT k) i ('MetaCons name fx st) f x)
gfromJSON Value
v = do (String
name, Value
f) <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
                   forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ String
name forall a. Eq a => a -> a -> Bool
== forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy @k t
Proxy @name)
                   forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 @k i c f p
M1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k (f :: LoT k -> *) (x :: LoT k).
GFromJSONK @k f x =>
Value -> Parser (f x)
gfromJSON Value
f

instance GToJSONK f x
         => GToJSONK (M1 i ('MetaData _1 _2 _3 _4) f) x where
  gtoJSON :: M1 @(LoT k) i ('MetaData _1 _2 _3 _4) f x -> Value
gtoJSON (M1 f x
f) = forall k (f :: LoT k -> *) (x :: LoT k).
GToJSONK @k f x =>
f x -> Value
gtoJSON f x
f
instance GFromJSONK f x
         => GFromJSONK (M1 i ('MetaData _1 _2 _3 _4) f) x where
  gfromJSON :: Value -> Parser (M1 @(LoT k) i ('MetaData _1 _2 _3 _4) f x)
gfromJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 @k i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: LoT k -> *) (x :: LoT k).
GFromJSONK @k f x =>
Value -> Parser (f x)
gfromJSON

instance GToJSONK f x
         => GToJSONK (M1 i ('MetaSel _1 _2 _3 _4) f) x where
  gtoJSON :: M1 @(LoT k) i ('MetaSel _1 _2 _3 _4) f x -> Value
gtoJSON (M1 f x
f) = forall k (f :: LoT k -> *) (x :: LoT k).
GToJSONK @k f x =>
f x -> Value
gtoJSON f x
f
instance GFromJSONK f x
         => GFromJSONK (M1 i ('MetaSel _1 _2 _3 _4) f) x where
  gfromJSON :: Value -> Parser (M1 @(LoT k) i ('MetaSel _1 _2 _3 _4) f x)
gfromJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 @k i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: LoT k -> *) (x :: LoT k).
GFromJSONK @k f x =>
Value -> Parser (f x)
gfromJSON

instance (Interpret c x => GToJSONK f x)
         => GToJSONK (c :=>: f) x where
  gtoJSON :: (:=>:) @k c f x -> Value
gtoJSON (SuchThat f x
f) = forall k (f :: LoT k -> *) (x :: LoT k).
GToJSONK @k f x =>
f x -> Value
gtoJSON f x
f
instance (Interpret c x, GFromJSONK f x)
         => GFromJSONK (c :=>: f) x where
  gfromJSON :: Value -> Parser ((:=>:) @k c f x)
gfromJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {d} (c :: Atom @LiftedRep d Constraint) (x :: LoT d)
       (f :: LoT d -> *).
Interpret @d @Constraint c x =>
f x -> (:=>:) @d c f x
SuchThat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: LoT k -> *) (x :: LoT k).
GFromJSONK @k f x =>
Value -> Parser (f x)
gfromJSON

instance (forall t. GToJSONK f (t ':&&: x))
         => GToJSONK (Exists k f) x where
  gtoJSON :: Exists @k k f x -> Value
gtoJSON (Exists f ((':&&:) @k @k t x)
x) = forall k (f :: LoT k -> *) (x :: LoT k).
GToJSONK @k f x =>
f x -> Value
gtoJSON f ((':&&:) @k @k t x)
x
instance (forall t. GFromJSONK f (t ':&&: x))
         => GFromJSONK (Exists k f) x where
  gfromJSON :: Value -> Parser (Exists @k k f x)
gfromJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (t :: k) d (f :: LoT (k -> d) -> *) (x :: LoT d).
f ((':&&:) @k @d t x) -> Exists @d k f x
Exists forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (f :: LoT k -> *) (x :: LoT k).
GFromJSONK @k f x =>
Value -> Parser (f x)
gfromJSON