{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}
module Zinza.Generic (
    Zinza (..),
    GFieldNames, stripFieldPrefix,
    GZinzaType, genericToType, genericToTypeSFP,
    GZinzaValue, genericToValue, genericToValueSFP,
    GZinzaFrom, genericFromValue, genericFromValueSFP,
    ) where

import Data.Char      (isLower, toLower)
import Data.Kind      (Type)
import Data.List      (stripPrefix)
import Data.Proxy     (Proxy (..))
import Data.Semigroup (Semigroup (..))
import GHC.Generics

import qualified Data.Map.Strict as Map

import Zinza.Class
import Zinza.Errors
import Zinza.Pos
import Zinza.Type
import Zinza.Value
import Zinza.Var    (Var)

-- $setup
-- >>> :set -XDeriveGeneric
-- >>> import Data.Proxy (Proxy (..))

-------------------------------------------------------------------------------
-- Field renamer
-------------------------------------------------------------------------------

-- | Field renamer which will automatically strip lowercase prefix from
-- field names.
--
-- >>> data R = R { recFoo :: Int, recBar :: Char } deriving Generic
-- >>> stripFieldPrefix (Proxy :: Proxy R) "recFoo"
-- "foo"
--
-- If whole field is lower case, it's left intact
--
-- >>> newtype Wrapped = Wrap { unwrap :: String } deriving Generic
-- >>> stripFieldPrefix (Proxy :: Proxy Wrapped) "unwrap"
-- "unwrap"
--
stripFieldPrefix
    :: forall a. (Generic a, GFieldNames (Rep a))
    => Proxy a
    -> String -> String
stripFieldPrefix :: forall a.
(Generic a, GFieldNames (Rep a)) =>
Proxy a -> String -> String
stripFieldPrefix Proxy a
_ = case Proxy (Rep a) -> [String]
forall (f :: * -> *). GFieldNames f => Proxy f -> [String]
fieldNames (Proxy (Rep a)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Rep a)) of
    []     -> String -> String
forall a. a -> a
id
    (String
y:[String]
ys) -> \String
fn -> case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
pfx String
fn of
        Just (Char
x:String
xs) -> Char -> Char
toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
        Maybe String
_           -> String
fn -- otherwise don't hcange
      where
        (String
pfx, String
_) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isLower (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ CommonPrefix -> String
getCommonPrefix (CommonPrefix -> String) -> CommonPrefix -> String
forall a b. (a -> b) -> a -> b
$ (CommonPrefix -> String -> CommonPrefix)
-> CommonPrefix -> [String] -> CommonPrefix
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\CommonPrefix
cp String
z -> CommonPrefix
cp CommonPrefix -> CommonPrefix -> CommonPrefix
forall a. Semigroup a => a -> a -> a
<> String -> CommonPrefix
CP String
z) (String -> CommonPrefix
CP String
y) [String]
ys

class GFieldNames (f :: Type -> Type) where
    fieldNames :: Proxy f -> [String]

instance (i ~ D, GFieldNamesSum f) => GFieldNames (M1 i c f) where
    fieldNames :: Proxy (M1 i c f) -> [String]
fieldNames Proxy (M1 i c f)
_ = Proxy f -> [String]
forall (f :: * -> *). GFieldNamesSum f => Proxy f -> [String]
fieldNamesSum (Proxy f
forall {k} (t :: k). Proxy t
Proxy :: Proxy f)

class GFieldNamesSum (f :: Type -> Type) where
    fieldNamesSum :: Proxy f -> [String]

instance (i ~ C, GFieldNamesProd f) => GFieldNamesSum (M1 i c f ) where
    fieldNamesSum :: Proxy (M1 i c f) -> [String]
fieldNamesSum Proxy (M1 i c f)
_ = Proxy f -> [String]
forall (f :: * -> *). GFieldNamesProd f => Proxy f -> [String]
fieldNamesProd (Proxy f
forall {k} (t :: k). Proxy t
Proxy :: Proxy f)

class GFieldNamesProd (f :: Type -> Type) where
    fieldNamesProd :: Proxy f -> [String]

instance (GFieldNamesProd f, GFieldNamesProd g) => GFieldNamesProd (f :*: g) where
    fieldNamesProd :: Proxy (f :*: g) -> [String]
fieldNamesProd Proxy (f :*: g)
_ = Proxy f -> [String]
forall (f :: * -> *). GFieldNamesProd f => Proxy f -> [String]
fieldNamesProd (Proxy f
forall {k} (t :: k). Proxy t
Proxy :: Proxy f) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Proxy g -> [String]
forall (f :: * -> *). GFieldNamesProd f => Proxy f -> [String]
fieldNamesProd (Proxy g
forall {k} (t :: k). Proxy t
Proxy :: Proxy g)

instance (i ~ S, Selector c) => GFieldNamesProd (M1 i c f) where
    fieldNamesProd :: Proxy (M1 i c f) -> [String]
fieldNamesProd Proxy (M1 i c f)
_ = [M1 i c f () -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
selName (M1 i c f ()
forall a. HasCallStack => a
undefined :: M1 i c f ())]

-------------------------------------------------------------------------------
-- Common prefix
-------------------------------------------------------------------------------

newtype CommonPrefix = CP { CommonPrefix -> String
getCommonPrefix :: String }

instance Data.Semigroup.Semigroup CommonPrefix where
    CP String
a <> :: CommonPrefix -> CommonPrefix -> CommonPrefix
<> CP String
b = String -> CommonPrefix
CP (String -> String -> String
forall a. Eq a => [a] -> [a] -> [a]
commonPrefix String
a String
b)

commonPrefix :: Eq a => [a] -> [a] -> [a]
commonPrefix :: forall a. Eq a => [a] -> [a] -> [a]
commonPrefix xs :: [a]
xs@[]  [a]
_      = [a]
xs
commonPrefix [a]
_      ys :: [a]
ys@[]  = [a]
ys
commonPrefix (a
x:[a]
xs) (a
y:[a]
ys)
    | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y    = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
commonPrefix [a]
xs [a]
ys
    | Bool
otherwise = []

-------------------------------------------------------------------------------
-- Generic toType
-------------------------------------------------------------------------------

-- | Generically derive 'toType' function.
genericToType
    :: forall a. (Generic a, GZinzaType (Rep a))
    => (String -> String)  -- ^ field renamer
    -> Proxy a -> Ty
genericToType :: forall a.
(Generic a, GZinzaType (Rep a)) =>
(String -> String) -> Proxy a -> Ty
genericToType String -> String
namer Proxy a
_ = Map String (String, Ty) -> Ty
TyRecord (Map String (String, Ty) -> Ty) -> Map String (String, Ty) -> Ty
forall a b. (a -> b) -> a -> b
$ [(String, (String, Ty))] -> Map String (String, Ty)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (String -> String
namer String
fn, (String
fn, Ty
ty))
    | (String
fn, Ty
ty) <- Proxy (Rep a) -> [(String, Ty)]
forall (f :: * -> *). GZinzaType f => Proxy f -> [(String, Ty)]
gtoType (Proxy (Rep a)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Rep a))
    ]

-- | 'genericToType' with 'stripFieldPrefix'.
genericToTypeSFP
    :: forall a. (Generic a, GZinzaType (Rep a), GFieldNames (Rep a))
    => Proxy a -> Ty
genericToTypeSFP :: forall a.
(Generic a, GZinzaType (Rep a), GFieldNames (Rep a)) =>
Proxy a -> Ty
genericToTypeSFP Proxy a
p = (String -> String) -> Proxy a -> Ty
forall a.
(Generic a, GZinzaType (Rep a)) =>
(String -> String) -> Proxy a -> Ty
genericToType (Proxy a -> String -> String
forall a.
(Generic a, GFieldNames (Rep a)) =>
Proxy a -> String -> String
stripFieldPrefix Proxy a
p) Proxy a
p

class GZinzaType (f :: Type -> Type) where
    gtoType :: Proxy f -> [(String, Ty)]

instance (i ~ D, GZinzaTypeSum f) => GZinzaType (M1 i c f) where
    gtoType :: Proxy (M1 i c f) -> [(String, Ty)]
gtoType Proxy (M1 i c f)
_ = Proxy f -> [(String, Ty)]
forall (f :: * -> *). GZinzaTypeSum f => Proxy f -> [(String, Ty)]
gtoTypeSum (Proxy f
forall {k} (t :: k). Proxy t
Proxy :: Proxy f)

class GZinzaTypeSum (f :: Type -> Type) where
    gtoTypeSum :: Proxy f -> [(String, Ty)]

instance (i ~ C, GZinzaTypeProd f) => GZinzaTypeSum (M1 i c f ) where
    gtoTypeSum :: Proxy (M1 i c f) -> [(String, Ty)]
gtoTypeSum Proxy (M1 i c f)
_ = Proxy f -> [(String, Ty)]
forall (f :: * -> *). GZinzaTypeProd f => Proxy f -> [(String, Ty)]
gtoTypeProd (Proxy f
forall {k} (t :: k). Proxy t
Proxy :: Proxy f)

class GZinzaTypeProd (f :: Type -> Type) where
    gtoTypeProd :: Proxy f -> [(String, Ty)]

instance (GZinzaTypeProd f, GZinzaTypeProd g) => GZinzaTypeProd (f :*: g) where
    gtoTypeProd :: Proxy (f :*: g) -> [(String, Ty)]
gtoTypeProd Proxy (f :*: g)
_ = Proxy f -> [(String, Ty)]
forall (f :: * -> *). GZinzaTypeProd f => Proxy f -> [(String, Ty)]
gtoTypeProd (Proxy f
forall {k} (t :: k). Proxy t
Proxy :: Proxy f) [(String, Ty)] -> [(String, Ty)] -> [(String, Ty)]
forall a. [a] -> [a] -> [a]
++ Proxy g -> [(String, Ty)]
forall (f :: * -> *). GZinzaTypeProd f => Proxy f -> [(String, Ty)]
gtoTypeProd (Proxy g
forall {k} (t :: k). Proxy t
Proxy :: Proxy g)

instance (i ~ S, Selector c, GZinzaTypeLeaf f) => GZinzaTypeProd (M1 i c f) where
    gtoTypeProd :: Proxy (M1 i c f) -> [(String, Ty)]
gtoTypeProd Proxy (M1 i c f)
_ = [(M1 i c f () -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
selName (M1 i c f ()
forall a. HasCallStack => a
undefined :: M1 i c f ()), Proxy f -> Ty
forall (f :: * -> *). GZinzaTypeLeaf f => Proxy f -> Ty
gtoTypeLeaf (Proxy f
forall {k} (t :: k). Proxy t
Proxy :: Proxy f))]

class GZinzaTypeLeaf (f :: Type -> Type) where
    gtoTypeLeaf :: Proxy f -> Ty

instance (i ~ R, Zinza a) => GZinzaTypeLeaf (K1 i a) where
    gtoTypeLeaf :: Proxy (K1 i a) -> Ty
gtoTypeLeaf Proxy (K1 i a)
_ = Proxy a -> Ty
forall a. Zinza a => Proxy a -> Ty
toType (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

-------------------------------------------------------------------------------
-- Generic toValue
-------------------------------------------------------------------------------

-- | Generically derive 'toValue' function.
genericToValue
    :: forall a. (Generic a, GZinzaValue (Rep a))
    => (String -> String)  -- ^ field renamer
    -> a -> Value
genericToValue :: forall a.
(Generic a, GZinzaValue (Rep a)) =>
(String -> String) -> a -> Value
genericToValue String -> String
namer a
x = Map String Value -> Value
VRecord (Map String Value -> Value) -> Map String Value -> Value
forall a b. (a -> b) -> a -> b
$ [(String, Value)] -> Map String Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (String -> String
namer String
fn, Value
e)
    | (String
fn, Value
e) <- Rep a () -> [(String, Value)]
forall (f :: * -> *). GZinzaValue f => f () -> [(String, Value)]
gtoValue (a -> Rep a ()
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
x)
    ]

-- | 'genericToValue' with 'stripFieldPrefix'.
genericToValueSFP
    :: forall a. (Generic a, GZinzaValue (Rep a), GFieldNames (Rep a))
    => a -> Value
genericToValueSFP :: forall a.
(Generic a, GZinzaValue (Rep a), GFieldNames (Rep a)) =>
a -> Value
genericToValueSFP = (String -> String) -> a -> Value
forall a.
(Generic a, GZinzaValue (Rep a)) =>
(String -> String) -> a -> Value
genericToValue (Proxy a -> String -> String
forall a.
(Generic a, GFieldNames (Rep a)) =>
Proxy a -> String -> String
stripFieldPrefix (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a))

class GZinzaValue (f :: Type -> Type) where
    gtoValue :: f () -> [(Var, Value)]

instance (i ~ D, GZinzaValueSum f) => GZinzaValue (M1 i c f) where
    gtoValue :: M1 i c f () -> [(String, Value)]
gtoValue = f () -> [(String, Value)]
forall (f :: * -> *). GZinzaValueSum f => f () -> [(String, Value)]
gtoValueSum (f () -> [(String, Value)])
-> (M1 i c f () -> f ()) -> M1 i c f () -> [(String, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  M1 i c f () -> f ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1

class GZinzaValueSum (f :: Type -> Type) where
    gtoValueSum :: f () -> [(Var, Value)]

instance (i ~ C, GZinzaValueProd f) => GZinzaValueSum (M1 i c f) where
    gtoValueSum :: M1 i c f () -> [(String, Value)]
gtoValueSum = f () -> [(String, Value)]
forall (f :: * -> *).
GZinzaValueProd f =>
f () -> [(String, Value)]
gtoValueProd (f () -> [(String, Value)])
-> (M1 i c f () -> f ()) -> M1 i c f () -> [(String, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 i c f () -> f ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1

class GZinzaValueProd (f :: Type -> Type) where
    gtoValueProd :: f () -> [(Var, Value)]

instance (GZinzaValueProd f, GZinzaValueProd g) => GZinzaValueProd (f :*: g) where
    gtoValueProd :: (:*:) f g () -> [(String, Value)]
gtoValueProd (f ()
f :*: g ()
g) = f () -> [(String, Value)]
forall (f :: * -> *).
GZinzaValueProd f =>
f () -> [(String, Value)]
gtoValueProd f ()
f [(String, Value)] -> [(String, Value)] -> [(String, Value)]
forall a. [a] -> [a] -> [a]
++ g () -> [(String, Value)]
forall (f :: * -> *).
GZinzaValueProd f =>
f () -> [(String, Value)]
gtoValueProd g ()
g

instance (i ~ S, Selector c, GZinzaValueLeaf f) => GZinzaValueProd (M1 i c f) where
    gtoValueProd :: M1 i c f () -> [(String, Value)]
gtoValueProd (M1 f ()
x) = [(M1 i c f () -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
selName (M1 i c f ()
forall a. HasCallStack => a
undefined :: M1 i c f ()), f () -> Value
forall a. f a -> Value
forall (f :: * -> *) a. GZinzaValueLeaf f => f a -> Value
gtoValueLeaf f ()
x)]

class GZinzaValueLeaf f where
    gtoValueLeaf :: f a -> Value

instance (i ~ R, Zinza a) => GZinzaValueLeaf (K1 i a) where
    gtoValueLeaf :: forall a. K1 i a a -> Value
gtoValueLeaf (K1 a
a) = a -> Value
forall a. Zinza a => a -> Value
toValue a
a

-------------------------------------------------------------------------------
-- Generic fromValue
-------------------------------------------------------------------------------

genericFromValue
    :: forall a. (Generic a, GZinzaFrom (Rep a))
    => (String -> String) -- ^ field renamer
    -> Loc -> Value -> Either RuntimeError a
genericFromValue :: forall a.
(Generic a, GZinzaFrom (Rep a)) =>
(String -> String) -> Loc -> Value -> Either RuntimeError a
genericFromValue String -> String
namer Loc
l v :: Value
v@(VRecord Map String Value
m) = do
    Rep a ()
g <- Loc
-> Ty -> (String -> Maybe Value) -> Either RuntimeError (Rep a ())
forall (f :: * -> *).
GZinzaFrom f =>
Loc -> Ty -> (String -> Maybe Value) -> Either RuntimeError (f ())
gfromValue Loc
l (Value -> Ty
valueType Value
v) ((String -> Maybe Value) -> Either RuntimeError (Rep a ()))
-> (String -> Maybe Value) -> Either RuntimeError (Rep a ())
forall a b. (a -> b) -> a -> b
$ \String
n -> String -> Map String Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String -> String
namer String
n) Map String Value
m
    a -> Either RuntimeError a
forall a. a -> Either RuntimeError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rep a () -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to Rep a ()
g)
genericFromValue String -> String
_ Loc
l Value
v = RuntimeError -> Either RuntimeError a
forall a. RuntimeError -> Either RuntimeError a
forall (m :: * -> *) a. ThrowRuntime m => RuntimeError -> m a
throwRuntime (RuntimeError -> Either RuntimeError a)
-> RuntimeError -> Either RuntimeError a
forall a b. (a -> b) -> a -> b
$ Loc -> Ty -> RuntimeError
NotRecord Loc
l (Value -> Ty
valueType Value
v)

-- | 'genericFromValue' with 'stripFieldPrefix'.
genericFromValueSFP
    :: forall a. (Generic a, GZinzaFrom (Rep a), GFieldNames (Rep a))
    => Loc -> Value -> Either RuntimeError a
genericFromValueSFP :: forall a.
(Generic a, GZinzaFrom (Rep a), GFieldNames (Rep a)) =>
Loc -> Value -> Either RuntimeError a
genericFromValueSFP = (String -> String) -> Loc -> Value -> Either RuntimeError a
forall a.
(Generic a, GZinzaFrom (Rep a)) =>
(String -> String) -> Loc -> Value -> Either RuntimeError a
genericFromValue (Proxy a -> String -> String
forall a.
(Generic a, GFieldNames (Rep a)) =>
Proxy a -> String -> String
stripFieldPrefix (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a))

class GZinzaFrom (f :: Type -> Type) where
    gfromValue :: Loc -> Ty -> (Var -> Maybe Value) -> Either RuntimeError (f ())

instance (i ~ D, GZinzaFromSum f) => GZinzaFrom (M1 i c f) where
    gfromValue :: Loc
-> Ty
-> (String -> Maybe Value)
-> Either RuntimeError (M1 i c f ())
gfromValue Loc
l Ty
ty = (f () -> M1 i c f ())
-> Either RuntimeError (f ()) -> Either RuntimeError (M1 i c f ())
forall a b.
(a -> b) -> Either RuntimeError a -> Either RuntimeError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f () -> M1 i c f ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Either RuntimeError (f ()) -> Either RuntimeError (M1 i c f ()))
-> ((String -> Maybe Value) -> Either RuntimeError (f ()))
-> (String -> Maybe Value)
-> Either RuntimeError (M1 i c f ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> Ty -> (String -> Maybe Value) -> Either RuntimeError (f ())
forall (f :: * -> *).
GZinzaFromSum f =>
Loc -> Ty -> (String -> Maybe Value) -> Either RuntimeError (f ())
gfromValueSum Loc
l Ty
ty

class GZinzaFromSum (f :: Type -> Type) where
    gfromValueSum :: Loc -> Ty -> (Var -> Maybe Value) -> Either RuntimeError (f ())

instance (i ~ C, GZinzaFromProd f) => GZinzaFromSum (M1 i c f) where
    gfromValueSum :: Loc
-> Ty
-> (String -> Maybe Value)
-> Either RuntimeError (M1 i c f ())
gfromValueSum Loc
l Ty
ty = (f () -> M1 i c f ())
-> Either RuntimeError (f ()) -> Either RuntimeError (M1 i c f ())
forall a b.
(a -> b) -> Either RuntimeError a -> Either RuntimeError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f () -> M1 i c f ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Either RuntimeError (f ()) -> Either RuntimeError (M1 i c f ()))
-> ((String -> Maybe Value) -> Either RuntimeError (f ()))
-> (String -> Maybe Value)
-> Either RuntimeError (M1 i c f ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> Ty -> (String -> Maybe Value) -> Either RuntimeError (f ())
forall (f :: * -> *).
GZinzaFromProd f =>
Loc -> Ty -> (String -> Maybe Value) -> Either RuntimeError (f ())
gfromValueProd Loc
l Ty
ty

class GZinzaFromProd (f :: Type -> Type) where
    gfromValueProd ::  Loc -> Ty -> (Var -> Maybe Value) -> Either RuntimeError (f ())

instance (GZinzaFromProd f, GZinzaFromProd g) => GZinzaFromProd (f :*: g) where
    gfromValueProd :: Loc
-> Ty
-> (String -> Maybe Value)
-> Either RuntimeError ((:*:) f g ())
gfromValueProd Loc
l Ty
ty String -> Maybe Value
v = f () -> g () -> (:*:) f g ()
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
        (f () -> g () -> (:*:) f g ())
-> Either RuntimeError (f ())
-> Either RuntimeError (g () -> (:*:) f g ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Loc -> Ty -> (String -> Maybe Value) -> Either RuntimeError (f ())
forall (f :: * -> *).
GZinzaFromProd f =>
Loc -> Ty -> (String -> Maybe Value) -> Either RuntimeError (f ())
gfromValueProd Loc
l Ty
ty String -> Maybe Value
v
        Either RuntimeError (g () -> (:*:) f g ())
-> Either RuntimeError (g ()) -> Either RuntimeError ((:*:) f g ())
forall a b.
Either RuntimeError (a -> b)
-> Either RuntimeError a -> Either RuntimeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Loc -> Ty -> (String -> Maybe Value) -> Either RuntimeError (g ())
forall (f :: * -> *).
GZinzaFromProd f =>
Loc -> Ty -> (String -> Maybe Value) -> Either RuntimeError (f ())
gfromValueProd Loc
l Ty
ty String -> Maybe Value
v

instance (i ~ S, Selector c, GZinzaFromLeaf f) => GZinzaFromProd (M1 i c f) where
    gfromValueProd :: Loc
-> Ty
-> (String -> Maybe Value)
-> Either RuntimeError (M1 i c f ())
gfromValueProd Loc
l Ty
ty String -> Maybe Value
f = case String -> Maybe Value
f String
n of
        Maybe Value
Nothing -> RuntimeError -> Either RuntimeError (M1 i c f ())
forall a. RuntimeError -> Either RuntimeError a
forall (m :: * -> *) a. ThrowRuntime m => RuntimeError -> m a
throwRuntime (RuntimeError -> Either RuntimeError (M1 i c f ()))
-> RuntimeError -> Either RuntimeError (M1 i c f ())
forall a b. (a -> b) -> a -> b
$ Loc -> String -> Ty -> RuntimeError
FieldNotInRecord Loc
l String
n Ty
ty
        Just Value
v  -> f () -> M1 i c f ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f () -> M1 i c f ())
-> Either RuntimeError (f ()) -> Either RuntimeError (M1 i c f ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Loc -> Value -> Either RuntimeError (f ())
forall (f :: * -> *).
GZinzaFromLeaf f =>
Loc -> Value -> Either RuntimeError (f ())
gfromValueLeaf Loc
l Value
v
      where
        n :: String
n = M1 i c f () -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
selName (M1 i c f ()
forall a. HasCallStack => a
undefined :: M1 i c f ())

class GZinzaFromLeaf f where
    gfromValueLeaf :: Loc -> Value -> Either RuntimeError (f ())

instance (i ~ R, Zinza a) => GZinzaFromLeaf (K1 i a) where
    gfromValueLeaf :: Loc -> Value -> Either RuntimeError (K1 i a ())
gfromValueLeaf Loc
l = (a -> K1 i a ())
-> Either RuntimeError a -> Either RuntimeError (K1 i a ())
forall a b.
(a -> b) -> Either RuntimeError a -> Either RuntimeError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> K1 i a ()
forall k i c (p :: k). c -> K1 i c p
K1 (Either RuntimeError a -> Either RuntimeError (K1 i a ()))
-> (Value -> Either RuntimeError a)
-> Value
-> Either RuntimeError (K1 i a ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> Value -> Either RuntimeError a
forall a. Zinza a => Loc -> Value -> Either RuntimeError a
fromValue Loc
l