{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Override.Internal where
import GHC.Generics
import GHC.TypeLits (Symbol)
newtype Override a (xs :: [*]) = Override a
unOverride :: Override a xs -> a
unOverride :: forall a (xs :: [*]). Override a xs -> a
unOverride (Override a
a) = a
a
override :: a -> proxy xs -> Override a xs
override :: forall a (proxy :: [*] -> *) (xs :: [*]).
a -> proxy xs -> Override a xs
override a
a proxy xs
_ = a -> Override a xs
forall a (xs :: [*]). a -> Override a xs
Override a
a
data As (o :: k) n
data With (o :: k) (w :: * -> *)
newtype Overridden (ms :: Maybe Symbol) a (xs :: [*]) = Overridden a
unOverridden :: Overridden ms a xs -> a
unOverridden :: forall (ms :: Maybe Symbol) a (xs :: [*]). Overridden ms a xs -> a
unOverridden (Overridden a
a) = a
a
overridden
:: forall a (ms :: Maybe Symbol) (xs :: [*]) proxy0 proxy1.
a -> proxy0 ms -> proxy1 xs -> Overridden ms a xs
overridden :: forall a (ms :: Maybe Symbol) (xs :: [*])
(proxy0 :: Maybe Symbol -> *) (proxy1 :: [*] -> *).
a -> proxy0 ms -> proxy1 xs -> Overridden ms a xs
overridden a
a proxy0 ms
_ proxy1 xs
_ = a -> Overridden ms a xs
forall (ms :: Maybe Symbol) a (xs :: [*]). a -> Overridden ms a xs
Overridden a
a
instance (Generic a, GOverride xs (Rep a)) => Generic (Override a xs) where
type Rep (Override a xs) = OverrideRep xs (Rep a)
from :: forall x. Override a xs -> Rep (Override a xs) x
from = forall (xs :: [*]) (f :: * -> *) x.
GOverride xs f =>
f x -> OverrideRep xs f x
overrideFrom @xs (Rep a x -> OverrideRep xs (Rep a) x)
-> (Override a xs -> Rep a x)
-> Override a xs
-> OverrideRep xs (Rep a) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from (a -> Rep a x) -> (Override a xs -> a) -> Override a xs -> Rep a x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Override a xs -> a
forall a (xs :: [*]). Override a xs -> a
unOverride
to :: forall x. Rep (Override a xs) x -> Override a xs
to = a -> Override a xs
forall a (xs :: [*]). a -> Override a xs
Override (a -> Override a xs)
-> (OverrideRep xs (Rep a) x -> a)
-> OverrideRep xs (Rep a) x
-> Override a xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep a x -> a
forall a x. Generic a => Rep a x -> a
to (Rep a x -> a)
-> (OverrideRep xs (Rep a) x -> Rep a x)
-> OverrideRep xs (Rep a) x
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (xs :: [*]) (f :: * -> *) x.
GOverride xs f =>
OverrideRep xs f x -> f x
overrideTo @xs
class GOverride (xs :: [*]) (f :: * -> *) where
type OverrideRep xs f :: * -> *
overrideFrom :: f x -> OverrideRep xs f x
overrideTo :: OverrideRep xs f x -> f x
instance (GOverride xs f) => GOverride xs (M1 D c f) where
type OverrideRep xs (M1 D c f) = M1 D c (OverrideRep xs f)
overrideFrom :: forall x. M1 D c f x -> OverrideRep xs (M1 D c f) x
overrideFrom (M1 f x
x) = OverrideRep xs f x -> M1 D c (OverrideRep xs f) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall (xs :: [*]) (f :: * -> *) x.
GOverride xs f =>
f x -> OverrideRep xs f x
overrideFrom @xs f x
x)
overrideTo :: forall x. OverrideRep xs (M1 D c f) x -> M1 D c f x
overrideTo (M1 OverrideRep xs f x
x) = f x -> M1 D c f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall (xs :: [*]) (f :: * -> *) x.
GOverride xs f =>
OverrideRep xs f x -> f x
overrideTo @xs OverrideRep xs f x
x)
instance (GOverride xs f) => GOverride xs (M1 C c f) where
type OverrideRep xs (M1 C c f) = M1 C c (OverrideRep xs f)
overrideFrom :: forall x. M1 C c f x -> OverrideRep xs (M1 C c f) x
overrideFrom (M1 f x
x) = OverrideRep xs f x -> M1 C c (OverrideRep xs f) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall (xs :: [*]) (f :: * -> *) x.
GOverride xs f =>
f x -> OverrideRep xs f x
overrideFrom @xs f x
x)
overrideTo :: forall x. OverrideRep xs (M1 C c f) x -> M1 C c f x
overrideTo (M1 OverrideRep xs f x
x) = f x -> M1 C c f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall (xs :: [*]) (f :: * -> *) x.
GOverride xs f =>
OverrideRep xs f x -> f x
overrideTo @xs OverrideRep xs f x
x)
instance (GOverride xs f, GOverride xs g) => GOverride xs (f :*: g) where
type OverrideRep xs (f :*: g) = OverrideRep xs f :*: OverrideRep xs g
overrideFrom :: forall x. (:*:) f g x -> OverrideRep xs (f :*: g) x
overrideFrom (f x
f :*: g x
g) = forall (xs :: [*]) (f :: * -> *) x.
GOverride xs f =>
f x -> OverrideRep xs f x
overrideFrom @xs f x
f OverrideRep xs f x
-> OverrideRep xs g x
-> (:*:) (OverrideRep xs f) (OverrideRep xs g) x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall (xs :: [*]) (f :: * -> *) x.
GOverride xs f =>
f x -> OverrideRep xs f x
overrideFrom @xs g x
g
overrideTo :: forall x. OverrideRep xs (f :*: g) x -> (:*:) f g x
overrideTo (OverrideRep xs f x
f :*: OverrideRep xs g x
g) = forall (xs :: [*]) (f :: * -> *) x.
GOverride xs f =>
OverrideRep xs f x -> f x
overrideTo @xs OverrideRep xs f x
f f x -> g x -> (:*:) f g x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall (xs :: [*]) (f :: * -> *) x.
GOverride xs f =>
OverrideRep xs f x -> f x
overrideTo @xs OverrideRep xs g x
g
instance (GOverride xs f, GOverride xs g) => GOverride xs (f :+: g) where
type OverrideRep xs (f :+: g) = OverrideRep xs f :+: OverrideRep xs g
overrideFrom :: forall x. (:+:) f g x -> OverrideRep xs (f :+: g) x
overrideFrom = \case
L1 f x
f -> OverrideRep xs f x -> (:+:) (OverrideRep xs f) (OverrideRep xs g) x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (OverrideRep xs f x
-> (:+:) (OverrideRep xs f) (OverrideRep xs g) x)
-> OverrideRep xs f x
-> (:+:) (OverrideRep xs f) (OverrideRep xs g) x
forall a b. (a -> b) -> a -> b
$ forall (xs :: [*]) (f :: * -> *) x.
GOverride xs f =>
f x -> OverrideRep xs f x
overrideFrom @xs f x
f
R1 g x
g -> OverrideRep xs g x -> (:+:) (OverrideRep xs f) (OverrideRep xs g) x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (OverrideRep xs g x
-> (:+:) (OverrideRep xs f) (OverrideRep xs g) x)
-> OverrideRep xs g x
-> (:+:) (OverrideRep xs f) (OverrideRep xs g) x
forall a b. (a -> b) -> a -> b
$ forall (xs :: [*]) (f :: * -> *) x.
GOverride xs f =>
f x -> OverrideRep xs f x
overrideFrom @xs g x
g
overrideTo :: forall x. OverrideRep xs (f :+: g) x -> (:+:) f g x
overrideTo = \case
L1 OverrideRep xs f x
f -> f x -> (:+:) f g x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f x -> (:+:) f g x) -> f x -> (:+:) f g x
forall a b. (a -> b) -> a -> b
$ forall (xs :: [*]) (f :: * -> *) x.
GOverride xs f =>
OverrideRep xs f x -> f x
overrideTo @xs OverrideRep xs f x
f
R1 OverrideRep xs g x
g -> g x -> (:+:) f g x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g x -> (:+:) f g x) -> g x -> (:+:) f g x
forall a b. (a -> b) -> a -> b
$ forall (xs :: [*]) (f :: * -> *) x.
GOverride xs f =>
OverrideRep xs f x -> f x
overrideTo @xs OverrideRep xs g x
g
instance GOverride xs (M1 S ('MetaSel ms su ss ds) (K1 R c)) where
type OverrideRep xs (M1 S ('MetaSel ms su ss ds) (K1 R c)) =
M1 S ('MetaSel ms su ss ds) (K1 R (Overridden ms c xs))
overrideFrom :: forall x.
M1 S ('MetaSel ms su ss ds) (K1 R c) x
-> OverrideRep xs (M1 S ('MetaSel ms su ss ds) (K1 R c)) x
overrideFrom (M1 (K1 c
x)) = K1 R (Overridden ms c xs) x
-> M1 S ('MetaSel ms su ss ds) (K1 R (Overridden ms c xs)) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Overridden ms c xs -> K1 R (Overridden ms c xs) x
forall k i c (p :: k). c -> K1 i c p
K1 (forall (ms :: Maybe Symbol) a (xs :: [*]). a -> Overridden ms a xs
Overridden @ms c
x))
overrideTo :: forall x.
OverrideRep xs (M1 S ('MetaSel ms su ss ds) (K1 R c)) x
-> M1 S ('MetaSel ms su ss ds) (K1 R c) x
overrideTo (M1 (K1 (Overridden c
x))) = K1 R c x -> M1 S ('MetaSel ms su ss ds) (K1 R c) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (c -> K1 R c x
forall k i c (p :: k). c -> K1 i c p
K1 c
x)
instance GOverride xs U1 where
type OverrideRep xs U1 = U1
overrideFrom :: forall x. U1 x -> OverrideRep xs U1 x
overrideFrom U1 x
U1 = OverrideRep xs U1 x
forall k (p :: k). U1 p
U1
overrideTo :: forall x. OverrideRep xs U1 x -> U1 x
overrideTo U1 x
OverrideRep xs U1 x
U1 = U1 x
forall k (p :: k). U1 p
U1
type family Using (ms :: Maybe Symbol) (a :: *) (xs :: [*]) where
Using ms a '[] = a
Using ('Just o) a (As o n ': xs) = n
Using ('Just o) a (With o w ': xs) = w a
Using ms a (As a n ': xs) = n
Using ms a (With a w ': xs) = w a
Using ms (f a0) (As f g ': xs) = g a0
Using ms (f a0 a1) (As f g ': xs) = g a0 a1
Using ms (f a0 a1 a2) (As f g ': xs) = g a0 a1 a2
Using ms (f a0 a1 a2 a3) (As f g ': xs) = g a0 a1 a2 a3
Using ms (f a0 a1 a2 a3 a4) (As f g ': xs) = g a0 a1 a2 a3 a4
Using ms (f a0 a1 a2 a3 a4 a5) (As f g ': xs) = g a0 a1 a2 a3 a4 a5
Using ms (f a0 a1 a2 a3 a4 a5 a6) (As f g ': xs) = g a0 a1 a2 a3 a4 a5 a6
Using ms (f a0 a1 a2 a3 a4 a5 a6 a7) (As f g ': xs) = g a0 a1 a2 a3 a4 a5 a6 a7
Using ms (f a0 a1 a2 a3 a4 a5 a6 a7 a8) (As f g ': xs) = g a0 a1 a2 a3 a4 a5 a6 a7 a8
Using ms (f a0 a1 a2 a3 a4 a5 a6 a7 a8 a9) (As f g ': xs) = g a0 a1 a2 a3 a4 a5 a6 a7 a8 a9
Using ms a (x ': xs) = Using ms a xs