{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Options.Harg.Het.Prod
( (:*) (..),
Tagged (..),
)
where
import qualified Barbies as B
import Data.Aeson ((.!=), (.:?))
import qualified Data.Aeson as JSON
import Data.Functor.Identity (Identity)
import Data.Kind (Type)
import Data.Proxy (Proxy (..))
import qualified Data.Text as Tx
import GHC.Generics (Generic)
import GHC.TypeLits (KnownSymbol, symbolVal)
data
( (a :: (Type -> Type) -> Type)
:* (b :: (Type -> Type) -> Type)
)
(f :: Type -> Type)
= a f :* b f
deriving ((forall x. (:*) a b f -> Rep ((:*) a b f) x)
-> (forall x. Rep ((:*) a b f) x -> (:*) a b f)
-> Generic ((:*) a b f)
forall x. Rep ((:*) a b f) x -> (:*) a b f
forall x. (:*) a b f -> Rep ((:*) a b f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (a :: (* -> *) -> *) (b :: (* -> *) -> *) (f :: * -> *) x.
Rep ((:*) a b f) x -> (:*) a b f
forall (a :: (* -> *) -> *) (b :: (* -> *) -> *) (f :: * -> *) x.
(:*) a b f -> Rep ((:*) a b f) x
$cto :: forall (a :: (* -> *) -> *) (b :: (* -> *) -> *) (f :: * -> *) x.
Rep ((:*) a b f) x -> (:*) a b f
$cfrom :: forall (a :: (* -> *) -> *) (b :: (* -> *) -> *) (f :: * -> *) x.
(:*) a b f -> Rep ((:*) a b f) x
Generic, (forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> (:*) a b f -> (:*) a b g)
-> FunctorB (a :* b)
forall k (b :: (k -> *) -> *).
(forall (f :: k -> *) (g :: k -> *).
(forall (a :: k). f a -> g a) -> b f -> b g)
-> FunctorB b
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a) -> (:*) a b f -> (:*) a b g
forall (a :: (* -> *) -> *) (b :: (* -> *) -> *) (f :: * -> *)
(g :: * -> *).
(FunctorB a, FunctorB b) =>
(forall a. f a -> g a) -> (:*) a b f -> (:*) a b g
bmap :: (forall a. f a -> g a) -> (:*) a b f -> (:*) a b g
$cbmap :: forall (a :: (* -> *) -> *) (b :: (* -> *) -> *) (f :: * -> *)
(g :: * -> *).
(FunctorB a, FunctorB b) =>
(forall a. f a -> g a) -> (:*) a b f -> (:*) a b g
B.FunctorB, FunctorB (a :* b)
FunctorB (a :* b) =>
(forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative e =>
(forall a. f a -> e (g a)) -> (:*) a b f -> e ((:*) a b g))
-> TraversableB (a :* b)
forall k (b :: (k -> *) -> *).
FunctorB b =>
(forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g))
-> TraversableB b
forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative e =>
(forall a. f a -> e (g a)) -> (:*) a b f -> e ((:*) a b g)
forall (a :: (* -> *) -> *) (b :: (* -> *) -> *).
(TraversableB a, TraversableB b) =>
FunctorB (a :* b)
forall (a :: (* -> *) -> *) (b :: (* -> *) -> *) (e :: * -> *)
(f :: * -> *) (g :: * -> *).
(TraversableB a, TraversableB b, Applicative e) =>
(forall a. f a -> e (g a)) -> (:*) a b f -> e ((:*) a b g)
btraverse :: (forall a. f a -> e (g a)) -> (:*) a b f -> e ((:*) a b g)
$cbtraverse :: forall (a :: (* -> *) -> *) (b :: (* -> *) -> *) (e :: * -> *)
(f :: * -> *) (g :: * -> *).
(TraversableB a, TraversableB b, Applicative e) =>
(forall a. f a -> e (g a)) -> (:*) a b f -> e ((:*) a b g)
$cp1TraversableB :: forall (a :: (* -> *) -> *) (b :: (* -> *) -> *).
(TraversableB a, TraversableB b) =>
FunctorB (a :* b)
B.TraversableB, FunctorB (a :* b)
FunctorB (a :* b) =>
(forall (f :: * -> *). (forall a. f a) -> (:*) a b f)
-> (forall (f :: * -> *) (g :: * -> *).
(:*) a b f -> (:*) a b g -> (:*) a b (Product f g))
-> ApplicativeB (a :* b)
forall k (b :: (k -> *) -> *).
FunctorB b =>
(forall (f :: k -> *). (forall (a :: k). f a) -> b f)
-> (forall (f :: k -> *) (g :: k -> *).
b f -> b g -> b (Product f g))
-> ApplicativeB b
forall (f :: * -> *). (forall a. f a) -> (:*) a b f
forall (f :: * -> *) (g :: * -> *).
(:*) a b f -> (:*) a b g -> (:*) a b (Product f g)
forall (a :: (* -> *) -> *) (b :: (* -> *) -> *).
(ApplicativeB a, ApplicativeB b) =>
FunctorB (a :* b)
forall (a :: (* -> *) -> *) (b :: (* -> *) -> *) (f :: * -> *).
(ApplicativeB a, ApplicativeB b) =>
(forall a. f a) -> (:*) a b f
forall (a :: (* -> *) -> *) (b :: (* -> *) -> *) (f :: * -> *)
(g :: * -> *).
(ApplicativeB a, ApplicativeB b) =>
(:*) a b f -> (:*) a b g -> (:*) a b (Product f g)
bprod :: (:*) a b f -> (:*) a b g -> (:*) a b (Product f g)
$cbprod :: forall (a :: (* -> *) -> *) (b :: (* -> *) -> *) (f :: * -> *)
(g :: * -> *).
(ApplicativeB a, ApplicativeB b) =>
(:*) a b f -> (:*) a b g -> (:*) a b (Product f g)
bpure :: (forall a. f a) -> (:*) a b f
$cbpure :: forall (a :: (* -> *) -> *) (b :: (* -> *) -> *) (f :: * -> *).
(ApplicativeB a, ApplicativeB b) =>
(forall a. f a) -> (:*) a b f
$cp1ApplicativeB :: forall (a :: (* -> *) -> *) (b :: (* -> *) -> *).
(ApplicativeB a, ApplicativeB b) =>
FunctorB (a :* b)
B.ApplicativeB)
infixr 4 :*
deriving instance
( Show (a Identity),
Show (b Identity)
) =>
Show ((a :* b) Identity)
newtype
Tagged
(t :: k)
(a :: (Type -> Type) -> Type)
(f :: Type -> Type) = Tagged
{ Tagged t a f -> a f
unTagged :: a f
}
deriving ((forall x. Tagged t a f -> Rep (Tagged t a f) x)
-> (forall x. Rep (Tagged t a f) x -> Tagged t a f)
-> Generic (Tagged t a f)
forall x. Rep (Tagged t a f) x -> Tagged t a f
forall x. Tagged t a f -> Rep (Tagged t a f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (t :: k) (a :: (* -> *) -> *) (f :: * -> *) x.
Rep (Tagged t a f) x -> Tagged t a f
forall k (t :: k) (a :: (* -> *) -> *) (f :: * -> *) x.
Tagged t a f -> Rep (Tagged t a f) x
$cto :: forall k (t :: k) (a :: (* -> *) -> *) (f :: * -> *) x.
Rep (Tagged t a f) x -> Tagged t a f
$cfrom :: forall k (t :: k) (a :: (* -> *) -> *) (f :: * -> *) x.
Tagged t a f -> Rep (Tagged t a f) x
Generic)
deriving newtype instance JSON.FromJSON (a f) => JSON.FromJSON (Tagged t a f)
instance B.FunctorB a => B.FunctorB (Tagged t a) where
bmap :: (forall a. f a -> g a) -> Tagged t a f -> Tagged t a g
bmap nat :: forall a. f a -> g a
nat (Tagged x :: a f
x) = a g -> Tagged t a g
forall k (t :: k) (a :: (* -> *) -> *) (f :: * -> *).
a f -> Tagged t a f
Tagged ((forall a. f a -> g a) -> a f -> a g
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FunctorB b =>
(forall (a :: k). f a -> g a) -> b f -> b g
B.bmap forall a. f a -> g a
nat a f
x)
instance B.TraversableB a => B.TraversableB (Tagged t a) where
btraverse :: (forall a. f a -> e (g a)) -> Tagged t a f -> e (Tagged t a g)
btraverse nat :: forall a. f a -> e (g a)
nat (Tagged x :: a f
x) = a g -> Tagged t a g
forall k (t :: k) (a :: (* -> *) -> *) (f :: * -> *).
a f -> Tagged t a f
Tagged (a g -> Tagged t a g) -> e (a g) -> e (Tagged t a g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. f a -> e (g a)) -> a f -> e (a 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 a f
x
instance B.ApplicativeB a => B.ApplicativeB (Tagged t a) where
bprod :: Tagged t a f -> Tagged t a g -> Tagged t a (Product f g)
bprod (Tagged l :: a f
l) (Tagged r :: a g
r) = a (Product f g) -> Tagged t a (Product f g)
forall k (t :: k) (a :: (* -> *) -> *) (f :: * -> *).
a f -> Tagged t a f
Tagged (a f -> a g -> a (Product f g)
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
ApplicativeB b =>
b f -> b g -> b (Product f g)
B.bprod a f
l a g
r)
bpure :: (forall a. f a) -> Tagged t a f
bpure f :: forall a. f a
f = a f -> Tagged t a f
forall k (t :: k) (a :: (* -> *) -> *) (f :: * -> *).
a f -> Tagged t a f
Tagged ((forall a. f a) -> a f
forall k (b :: (k -> *) -> *) (f :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a) -> b f
B.bpure forall a. f a
f)
instance
( JSON.FromJSON (a Maybe),
JSON.FromJSON (b' Maybe),
B.ApplicativeB a,
B.ApplicativeB b',
KnownSymbol ta,
b' ~ (Tagged tb b :* c)
) =>
JSON.FromJSON ((Tagged ta a :* (Tagged tb b :* c)) Maybe)
where
parseJSON :: Value -> Parser ((:*) (Tagged ta a) (Tagged tb b :* c) Maybe)
parseJSON =
String
-> (Object -> Parser ((:*) (Tagged ta a) (Tagged tb b :* c) Maybe))
-> Value
-> Parser ((:*) (Tagged ta a) (Tagged tb b :* c) Maybe)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject ":*" ((Object -> Parser ((:*) (Tagged ta a) (Tagged tb b :* c) Maybe))
-> Value -> Parser ((:*) (Tagged ta a) (Tagged tb b :* c) Maybe))
-> (Object -> Parser ((:*) (Tagged ta a) (Tagged tb b :* c) Maybe))
-> Value
-> Parser ((:*) (Tagged ta a) (Tagged tb b :* c) Maybe)
forall a b. (a -> b) -> a -> b
$
\o :: Object
o ->
Tagged ta a Maybe
-> (:*) (Tagged tb b) c Maybe
-> (:*) (Tagged ta a) (Tagged tb b :* c) Maybe
forall (a :: (* -> *) -> *) (b :: (* -> *) -> *) (f :: * -> *).
a f -> b f -> (:*) a b f
(:*)
(Tagged ta a Maybe
-> (:*) (Tagged tb b) c Maybe
-> (:*) (Tagged ta a) (Tagged tb b :* c) Maybe)
-> Parser (Tagged ta a Maybe)
-> Parser
((:*) (Tagged tb b) c Maybe
-> (:*) (Tagged ta a) (Tagged tb b :* c) Maybe)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe (Tagged ta a Maybe))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? String -> Text
Tx.pack (Proxy ta -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy ta
forall k (t :: k). Proxy t
Proxy :: Proxy ta)) Parser (Maybe (Tagged ta a Maybe))
-> Tagged ta a Maybe -> Parser (Tagged ta a Maybe)
forall a. Parser (Maybe a) -> a -> Parser a
.!= (forall a. Maybe a) -> Tagged ta a Maybe
forall k (b :: (k -> *) -> *) (f :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a) -> b f
B.bpure forall a. Maybe a
Nothing
Parser
((:*) (Tagged tb b) c Maybe
-> (:*) (Tagged ta a) (Tagged tb b :* c) Maybe)
-> Parser ((:*) (Tagged tb b) c Maybe)
-> Parser ((:*) (Tagged ta a) (Tagged tb b :* c) Maybe)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser ((:*) (Tagged tb b) c Maybe)
forall a. FromJSON a => Value -> Parser a
JSON.parseJSON (Object -> Value
JSON.Object Object
o)
instance
( JSON.FromJSON (a Maybe),
JSON.FromJSON (b Maybe),
B.ApplicativeB a,
B.ApplicativeB b,
KnownSymbol ta,
KnownSymbol tb
) =>
JSON.FromJSON ((Tagged ta a :* Tagged tb b) Maybe)
where
parseJSON :: Value -> Parser ((:*) (Tagged ta a) (Tagged tb b) Maybe)
parseJSON =
String
-> (Object -> Parser ((:*) (Tagged ta a) (Tagged tb b) Maybe))
-> Value
-> Parser ((:*) (Tagged ta a) (Tagged tb b) Maybe)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject ":*" ((Object -> Parser ((:*) (Tagged ta a) (Tagged tb b) Maybe))
-> Value -> Parser ((:*) (Tagged ta a) (Tagged tb b) Maybe))
-> (Object -> Parser ((:*) (Tagged ta a) (Tagged tb b) Maybe))
-> Value
-> Parser ((:*) (Tagged ta a) (Tagged tb b) Maybe)
forall a b. (a -> b) -> a -> b
$
\o :: Object
o ->
Tagged ta a Maybe
-> Tagged tb b Maybe -> (:*) (Tagged ta a) (Tagged tb b) Maybe
forall (a :: (* -> *) -> *) (b :: (* -> *) -> *) (f :: * -> *).
a f -> b f -> (:*) a b f
(:*)
(Tagged ta a Maybe
-> Tagged tb b Maybe -> (:*) (Tagged ta a) (Tagged tb b) Maybe)
-> Parser (Tagged ta a Maybe)
-> Parser
(Tagged tb b Maybe -> (:*) (Tagged ta a) (Tagged tb b) Maybe)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe (Tagged ta a Maybe))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? String -> Text
Tx.pack (Proxy ta -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy ta
forall k (t :: k). Proxy t
Proxy :: Proxy ta)) Parser (Maybe (Tagged ta a Maybe))
-> Tagged ta a Maybe -> Parser (Tagged ta a Maybe)
forall a. Parser (Maybe a) -> a -> Parser a
.!= (forall a. Maybe a) -> Tagged ta a Maybe
forall k (b :: (k -> *) -> *) (f :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a) -> b f
B.bpure forall a. Maybe a
Nothing
Parser
(Tagged tb b Maybe -> (:*) (Tagged ta a) (Tagged tb b) Maybe)
-> Parser (Tagged tb b Maybe)
-> Parser ((:*) (Tagged ta a) (Tagged tb b) Maybe)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe (Tagged tb b Maybe))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? String -> Text
Tx.pack (Proxy tb -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy tb
forall k (t :: k). Proxy t
Proxy :: Proxy tb)) Parser (Maybe (Tagged tb b Maybe))
-> Tagged tb b Maybe -> Parser (Tagged tb b Maybe)
forall a. Parser (Maybe a) -> a -> Parser a
.!= (forall a. Maybe a) -> Tagged tb b Maybe
forall k (b :: (k -> *) -> *) (f :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a) -> b f
B.bpure forall a. Maybe a
Nothing