{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ApplicativeDo #-}
module Strongweak.Generic.Strengthen where
import Strongweak.Strengthen
import Data.Validation
import Data.List.NonEmpty
import GHC.Generics
strengthenGeneric
:: (Generic w, Generic s, GStrengthenD (Rep w) (Rep s))
=> w -> Validation (NonEmpty StrengthenError) s
strengthenGeneric :: forall w s.
(Generic w, Generic s, GStrengthenD (Rep w) (Rep s)) =>
w -> Validation (NonEmpty StrengthenError) s
strengthenGeneric = (Rep s Any -> s)
-> Validation (NonEmpty StrengthenError) (Rep s Any)
-> Validation (NonEmpty StrengthenError) s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep s Any -> s
forall a x. Generic a => Rep a x -> a
to (Validation (NonEmpty StrengthenError) (Rep s Any)
-> Validation (NonEmpty StrengthenError) s)
-> (w -> Validation (NonEmpty StrengthenError) (Rep s Any))
-> w
-> Validation (NonEmpty StrengthenError) s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep w Any -> Validation (NonEmpty StrengthenError) (Rep s Any)
forall {k} (w :: k -> *) (s :: k -> *) (p :: k).
GStrengthenD w s =>
w p -> Validation (NonEmpty StrengthenError) (s p)
gstrengthenD (Rep w Any -> Validation (NonEmpty StrengthenError) (Rep s Any))
-> (w -> Rep w Any)
-> w
-> Validation (NonEmpty StrengthenError) (Rep s Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> Rep w Any
forall a x. Generic a => a -> Rep a x
from
class GStrengthenD w s where
gstrengthenD :: w p -> Validation (NonEmpty StrengthenError) (s p)
instance (GStrengthenC w s, Datatype dw, Datatype ds) => GStrengthenD (D1 dw w) (D1 ds s) where
gstrengthenD :: forall (p :: k).
D1 dw w p -> Validation (NonEmpty StrengthenError) (D1 ds s p)
gstrengthenD = (s p -> D1 ds s p)
-> Validation (NonEmpty StrengthenError) (s p)
-> Validation (NonEmpty StrengthenError) (D1 ds s p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s p -> D1 ds s p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Validation (NonEmpty StrengthenError) (s p)
-> Validation (NonEmpty StrengthenError) (D1 ds s p))
-> (D1 dw w p -> Validation (NonEmpty StrengthenError) (s p))
-> D1 dw w p
-> Validation (NonEmpty StrengthenError) (D1 ds s p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> String -> w p -> Validation (NonEmpty StrengthenError) (s p)
forall {k} (w :: k -> *) (s :: k -> *) (p :: k).
GStrengthenC w s =>
String
-> String -> w p -> Validation (NonEmpty StrengthenError) (s p)
gstrengthenC (forall {k} (d :: k). Datatype d => String
forall (d :: Meta). Datatype d => String
datatypeName' @dw) (forall {k} (d :: k). Datatype d => String
forall (d :: Meta). Datatype d => String
datatypeName' @ds) (w p -> Validation (NonEmpty StrengthenError) (s p))
-> (D1 dw w p -> w p)
-> D1 dw w p
-> Validation (NonEmpty StrengthenError) (s p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D1 dw w p -> w p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
class GStrengthenC w s where
gstrengthenC :: String -> String -> w p -> Validation (NonEmpty StrengthenError) (s p)
instance GStrengthenC V1 V1 where
gstrengthenC :: forall (p :: k).
String
-> String -> V1 p -> Validation (NonEmpty StrengthenError) (V1 p)
gstrengthenC String
_ String
_ = V1 p -> Validation (NonEmpty StrengthenError) (V1 p)
forall err a. a -> Validation err a
Success
instance (GStrengthenS w s, Constructor cw, Constructor cs) => GStrengthenC (C1 cw w) (C1 cs s) where
gstrengthenC :: forall (p :: k).
String
-> String
-> C1 cw w p
-> Validation (NonEmpty StrengthenError) (C1 cs s p)
gstrengthenC String
dw String
ds = (s p -> C1 cs s p)
-> Validation (NonEmpty StrengthenError) (s p)
-> Validation (NonEmpty StrengthenError) (C1 cs s p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s p -> C1 cs s p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Validation (NonEmpty StrengthenError) (s p)
-> Validation (NonEmpty StrengthenError) (C1 cs s p))
-> (C1 cw w p -> Validation (NonEmpty StrengthenError) (s p))
-> C1 cw w p
-> Validation (NonEmpty StrengthenError) (C1 cs s p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> String
-> String
-> String
-> w p
-> Validation (NonEmpty StrengthenError) (s p)
forall {k} (w :: k -> *) (s :: k -> *) (p :: k).
GStrengthenS w s =>
String
-> String
-> String
-> String
-> w p
-> Validation (NonEmpty StrengthenError) (s p)
gstrengthenS String
dw String
ds (forall {k} (c :: k). Constructor c => String
forall (c :: Meta). Constructor c => String
conName' @cw) (forall {k} (c :: k). Constructor c => String
forall (c :: Meta). Constructor c => String
conName' @cs) (w p -> Validation (NonEmpty StrengthenError) (s p))
-> (C1 cw w p -> w p)
-> C1 cw w p
-> Validation (NonEmpty StrengthenError) (s p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C1 cw w p -> w p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
instance (GStrengthenC lw ls, GStrengthenC rw rs) => GStrengthenC (lw :+: rw) (ls :+: rs) where
gstrengthenC :: forall (p :: k).
String
-> String
-> (:+:) lw rw p
-> Validation (NonEmpty StrengthenError) ((:+:) ls rs p)
gstrengthenC String
dw String
ds = \case L1 lw p
l -> ls p -> (:+:) ls rs p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (ls p -> (:+:) ls rs p)
-> Validation (NonEmpty StrengthenError) (ls p)
-> Validation (NonEmpty StrengthenError) ((:+:) ls rs p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> String -> lw p -> Validation (NonEmpty StrengthenError) (ls p)
forall {k} (w :: k -> *) (s :: k -> *) (p :: k).
GStrengthenC w s =>
String
-> String -> w p -> Validation (NonEmpty StrengthenError) (s p)
gstrengthenC String
dw String
ds lw p
l
R1 rw p
r -> rs p -> (:+:) ls rs p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (rs p -> (:+:) ls rs p)
-> Validation (NonEmpty StrengthenError) (rs p)
-> Validation (NonEmpty StrengthenError) ((:+:) ls rs p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> String -> rw p -> Validation (NonEmpty StrengthenError) (rs p)
forall {k} (w :: k -> *) (s :: k -> *) (p :: k).
GStrengthenC w s =>
String
-> String -> w p -> Validation (NonEmpty StrengthenError) (s p)
gstrengthenC String
dw String
ds rw p
r
class GStrengthenS w s where
gstrengthenS :: String -> String -> String -> String -> w p -> Validation (NonEmpty StrengthenError) (s p)
instance GStrengthenS U1 U1 where
gstrengthenS :: forall (p :: k).
String
-> String
-> String
-> String
-> U1 p
-> Validation (NonEmpty StrengthenError) (U1 p)
gstrengthenS String
_ String
_ String
_ String
_ = U1 p -> Validation (NonEmpty StrengthenError) (U1 p)
forall err a. a -> Validation err a
Success
instance GStrengthenS (S1 mw (Rec0 w)) (S1 ms (Rec0 w)) where
gstrengthenS :: forall (p :: k).
String
-> String
-> String
-> String
-> S1 mw (Rec0 w) p
-> Validation (NonEmpty StrengthenError) (S1 ms (Rec0 w) p)
gstrengthenS String
_ String
_ String
_ String
_ = S1 ms (Rec0 w) p
-> Validation (NonEmpty StrengthenError) (S1 ms (Rec0 w) p)
forall err a. a -> Validation err a
Success (S1 ms (Rec0 w) p
-> Validation (NonEmpty StrengthenError) (S1 ms (Rec0 w) p))
-> (S1 mw (Rec0 w) p -> S1 ms (Rec0 w) p)
-> S1 mw (Rec0 w) p
-> Validation (NonEmpty StrengthenError) (S1 ms (Rec0 w) p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec0 w p -> S1 ms (Rec0 w) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Rec0 w p -> S1 ms (Rec0 w) p)
-> (S1 mw (Rec0 w) p -> Rec0 w p)
-> S1 mw (Rec0 w) p
-> S1 ms (Rec0 w) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S1 mw (Rec0 w) p -> Rec0 w p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
instance {-# OVERLAPS #-} (Strengthen w s, Selector mw, Selector ms) => GStrengthenS (S1 mw (Rec0 w)) (S1 ms (Rec0 s)) where
gstrengthenS :: forall (p :: k).
String
-> String
-> String
-> String
-> S1 mw (Rec0 w) p
-> Validation (NonEmpty StrengthenError) (S1 ms (Rec0 s) p)
gstrengthenS String
dw String
ds String
cw String
cs (M1 (K1 w
w)) =
case w -> Validation (NonEmpty StrengthenError) s
forall w s.
Strengthen w s =>
w -> Validation (NonEmpty StrengthenError) s
strengthen w
w of
Failure (StrengthenError
e :| [StrengthenError]
es) -> NonEmpty StrengthenError
-> Validation (NonEmpty StrengthenError) (S1 ms (Rec0 s) p)
forall err a. err -> Validation err a
Failure (NonEmpty StrengthenError
-> Validation (NonEmpty StrengthenError) (S1 ms (Rec0 s) p))
-> NonEmpty StrengthenError
-> Validation (NonEmpty StrengthenError) (S1 ms (Rec0 s) p)
forall a b. (a -> b) -> a -> b
$ String
-> String
-> String
-> String
-> String
-> String
-> StrengthenError
-> StrengthenError
StrengthenErrorField String
dw String
ds String
cw String
cs (forall {k} (s :: k). Selector s => String
forall (s :: Meta). Selector s => String
selName' @mw) (forall {k} (s :: k). Selector s => String
forall (s :: Meta). Selector s => String
selName' @ms) StrengthenError
e StrengthenError -> [StrengthenError] -> NonEmpty StrengthenError
forall a. a -> [a] -> NonEmpty a
:| [StrengthenError]
es
Success s
s -> S1 ms (Rec0 s) p
-> Validation (NonEmpty StrengthenError) (S1 ms (Rec0 s) p)
forall err a. a -> Validation err a
Success (S1 ms (Rec0 s) p
-> Validation (NonEmpty StrengthenError) (S1 ms (Rec0 s) p))
-> S1 ms (Rec0 s) p
-> Validation (NonEmpty StrengthenError) (S1 ms (Rec0 s) p)
forall a b. (a -> b) -> a -> b
$ Rec0 s p -> S1 ms (Rec0 s) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Rec0 s p -> S1 ms (Rec0 s) p) -> Rec0 s p -> S1 ms (Rec0 s) p
forall a b. (a -> b) -> a -> b
$ s -> Rec0 s p
forall k i c (p :: k). c -> K1 i c p
K1 s
s
instance (GStrengthenS lw ls, GStrengthenS rw rs) => GStrengthenS (lw :*: rw) (ls :*: rs) where
gstrengthenS :: forall (p :: k).
String
-> String
-> String
-> String
-> (:*:) lw rw p
-> Validation (NonEmpty StrengthenError) ((:*:) ls rs p)
gstrengthenS String
dw String
ds String
cw String
cs (lw p
l :*: rw p
r) = do
ls p
l' <- String
-> String
-> String
-> String
-> lw p
-> Validation (NonEmpty StrengthenError) (ls p)
forall {k} (w :: k -> *) (s :: k -> *) (p :: k).
GStrengthenS w s =>
String
-> String
-> String
-> String
-> w p
-> Validation (NonEmpty StrengthenError) (s p)
gstrengthenS String
dw String
ds String
cw String
cs lw p
l
rs p
r' <- String
-> String
-> String
-> String
-> rw p
-> Validation (NonEmpty StrengthenError) (rs p)
forall {k} (w :: k -> *) (s :: k -> *) (p :: k).
GStrengthenS w s =>
String
-> String
-> String
-> String
-> w p
-> Validation (NonEmpty StrengthenError) (s p)
gstrengthenS String
dw String
ds String
cw String
cs rw p
r
return $ ls p
l' ls p -> rs p -> (:*:) ls rs p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: rs p
r'
conName' :: forall c. Constructor c => String
conName' :: forall {k} (c :: k). Constructor c => String
conName' = forall (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
Constructor c =>
t c f a -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName @c Any c Any Any
forall a. HasCallStack => a
undefined
datatypeName' :: forall d. Datatype d => String
datatypeName' :: forall {k} (d :: k). Datatype d => String
datatypeName' = forall (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
Datatype d =>
t d f a -> String
forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> String
datatypeName @d Any d Any Any
forall a. HasCallStack => a
undefined
selName' :: forall s. Selector s => String
selName' :: forall {k} (s :: k). Selector s => String
selName' = forall (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
(a :: k1).
Selector s =>
t s f a -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName @s Any s Any Any
forall a. HasCallStack => a
undefined