{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Options.Harg.Nested
( Nested (..),
nested,
getNested,
fromNested,
)
where
import qualified Barbies as B
import qualified Data.Aeson as JSON
import Data.Coerce (Coercible, coerce)
import Data.Functor.Identity (Identity (..))
import qualified Data.Generic.HKD as HKD
import Data.Kind (Type)
import GHC.Generics (Generic)
instance
JSON.GFromJSON JSON.Zero (HKD.HKD_ f structure) =>
JSON.FromJSON (HKD.HKD structure f)
where
parseJSON :: Value -> Parser (HKD structure f)
parseJSON =
(GHKD_ f (Rep structure) Void -> HKD structure f)
-> Parser (GHKD_ f (Rep structure) Void)
-> Parser (HKD structure f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GHKD_ f (Rep structure) Void -> HKD structure f
forall structure (f :: * -> *).
HKD_ f structure Void -> HKD structure f
HKD.HKD
(Parser (GHKD_ f (Rep structure) Void) -> Parser (HKD structure f))
-> (Value -> Parser (GHKD_ f (Rep structure) Void))
-> Value
-> Parser (HKD structure f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options
-> FromArgs Zero Void
-> Value
-> Parser (GHKD_ f (Rep structure) Void)
forall arity (f :: * -> *) a.
GFromJSON arity f =>
Options -> FromArgs arity a -> Value -> Parser (f a)
JSON.gParseJSON Options
JSON.defaultOptions FromArgs Zero Void
forall a. FromArgs Zero a
JSON.NoFromArgs
newtype Nested (b :: Type) (f :: Type -> Type)
= Nested (HKD.HKD b f)
type family
Nest
(a :: Type)
(f :: Type -> Type) =
(res :: Type) | res -> a
where
Nest (a -> b) f = a -> Nest b f
Nest (HKD.HKD a f) f = Nested a f
nested ::
forall b f k.
( HKD.Build b f k,
Coercible (HKD.HKD b f) (Nested b f),
Coercible k (Nest k f)
) =>
Nest k f
nested :: Nest k f
nested = k -> Nest k f
forall a b. Coercible a b => a -> b
coerce @k @(Nest k f) k
hkd
where
hkd :: k
hkd = Build b f k => k
forall structure (f :: * -> *) k. Build structure f k => k
HKD.build @b @f @k
getNested ::
HKD.Construct f b =>
Nested b f ->
f b
getNested :: Nested b f -> f b
getNested (Nested hkd :: HKD b f
hkd) = HKD b f -> f b
forall (f :: * -> *) structure.
Construct f structure =>
HKD structure f -> f structure
HKD.construct HKD b f
hkd
fromNested ::
HKD.Construct Identity b =>
Nested b Identity ->
b
fromNested :: Nested b Identity -> b
fromNested =
Identity b -> b
forall a. Identity a -> a
runIdentity (Identity b -> b)
-> (Nested b Identity -> Identity b) -> Nested b Identity -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nested b Identity -> Identity b
forall (f :: * -> *) b. Construct f b => Nested b f -> f b
getNested
deriving newtype instance Generic (HKD.HKD b f) => Generic (Nested b f)
deriving newtype instance JSON.FromJSON (HKD.HKD b f) => JSON.FromJSON (Nested b f)
deriving newtype instance B.FunctorB (HKD.HKD b) => B.FunctorB (Nested b)
deriving newtype instance B.ApplicativeB (HKD.HKD b) => B.ApplicativeB (Nested b)
instance (B.TraversableB (HKD.HKD b)) => B.TraversableB (Nested b) where
btraverse :: (forall a. f a -> e (g a)) -> Nested b f -> e (Nested b g)
btraverse nat :: forall a. f a -> e (g a)
nat (Nested hkd :: HKD b f
hkd) = HKD b g -> Nested b g
forall b (f :: * -> *). HKD b f -> Nested b f
Nested (HKD b g -> Nested b g) -> e (HKD b g) -> e (Nested b g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. f a -> e (g a)) -> HKD b f -> e (HKD b g)
forall k (b :: (k -> *) -> *) (e :: * -> *) (f :: k -> *)
(g :: k -> *).
(TraversableB b, Applicative e) =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
B.btraverse forall a. f a -> e (g a)
nat HKD b f
hkd