{-# LANGUAGE TemplateHaskell, UndecidableInstances, FlexibleInstances #-}

module Hyper.Infer.Result
    ( InferResult(..), _InferResult
    , inferResult
    ) where

import Hyper
import Hyper.Class.Infer
import Hyper.Internal.Prelude

-- | A 'HyperType' for an inferred term - the output of 'Hyper.Infer.infer'
newtype InferResult v e =
    InferResult (InferOf (GetHyperType e) # v)
    deriving stock (forall x. InferResult v e -> Rep (InferResult v e) x)
-> (forall x. Rep (InferResult v e) x -> InferResult v e)
-> Generic (InferResult v e)
forall x. Rep (InferResult v e) x -> InferResult v e
forall x. InferResult v e -> Rep (InferResult v e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (v :: HyperType) (e :: AHyperType) x.
Rep (InferResult v e) x -> InferResult v e
forall (v :: HyperType) (e :: AHyperType) x.
InferResult v e -> Rep (InferResult v e) x
$cto :: forall (v :: HyperType) (e :: AHyperType) x.
Rep (InferResult v e) x -> InferResult v e
$cfrom :: forall (v :: HyperType) (e :: AHyperType) x.
InferResult v e -> Rep (InferResult v e) x
Generic
makePrisms ''InferResult
makeCommonInstances [''InferResult]

-- An iso for the common case where the infer result of a term is a single value.
inferResult ::
    InferOf e ~ ANode t =>
    Iso (InferResult v0 # e)
        (InferResult v1 # e)
        (v0 # t)
        (v1 # t)
inferResult :: Iso (InferResult v0 # e) (InferResult v1 # e) (v0 # t) (v1 # t)
inferResult = p (ANode t ('AHyperType v0)) (f (ANode t ('AHyperType v1)))
-> p (InferResult v0 # e) (f (InferResult v1 # e))
forall (v :: HyperType) (e :: AHyperType) (v :: HyperType)
       (e :: AHyperType).
Iso
  (InferResult v e)
  (InferResult v e)
  (InferOf (GetHyperType e) # v)
  (InferOf (GetHyperType e) # v)
_InferResult (p (ANode t ('AHyperType v0)) (f (ANode t ('AHyperType v1)))
 -> p (InferResult v0 # e) (f (InferResult v1 # e)))
-> (p (v0 # t) (f (v1 # t))
    -> p (ANode t ('AHyperType v0)) (f (ANode t ('AHyperType v1))))
-> p (v0 # t) (f (v1 # t))
-> p (InferResult v0 # e) (f (InferResult v1 # e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p (v0 # t) (f (v1 # t))
-> p (ANode t ('AHyperType v0)) (f (ANode t ('AHyperType v1)))
forall (c0 :: HyperType) (k0 :: HyperType) (c1 :: HyperType)
       (k1 :: HyperType).
Iso (ANode c0 # k0) (ANode c1 # k1) (k0 # c0) (k1 # c1)
_ANode

instance HNodes (InferOf e) => HNodes (HFlip InferResult e) where
    type HNodesConstraint (HFlip InferResult e) c = HNodesConstraint (InferOf e) c
    type HWitnessType (HFlip InferResult e) = HWitnessType (InferOf e)
    hLiftConstraint :: HWitness (HFlip InferResult e) n -> Proxy c -> (c n => r) -> r
hLiftConstraint (HWitness HWitnessType (HFlip InferResult e) n
w) = HWitness (InferOf e) n -> Proxy c -> (c n => r) -> r
forall (h :: HyperType) (c :: HyperType -> Constraint)
       (n :: HyperType) r.
(HNodes h, HNodesConstraint h c) =>
HWitness h n -> Proxy c -> (c n => r) -> r
hLiftConstraint (HWitnessType (InferOf e) n -> HWitness (InferOf e) n
forall (h2 :: HyperType) (n2 :: HyperType).
HWitnessType h2 n2 -> HWitness h2 n2
HWitness @(InferOf e) HWitnessType (HFlip InferResult e) n
HWitnessType (InferOf e) n
w)

instance HFunctor (InferOf e) => HFunctor (HFlip InferResult e) where
    hmap :: (forall (n :: HyperType).
 HWitness (HFlip InferResult e) n -> (p # n) -> q # n)
-> (HFlip InferResult e # p) -> HFlip InferResult e # q
hmap forall (n :: HyperType).
HWitness (HFlip InferResult e) n -> (p # n) -> q # n
f = ((InferResult p # e) -> Identity (InferResult q # e))
-> (HFlip InferResult e # p) -> Identity (HFlip InferResult e # q)
forall (f0 :: HyperType -> HyperType) (x0 :: HyperType)
       (k0 :: HyperType) (f1 :: HyperType -> HyperType) (x1 :: HyperType)
       (k1 :: HyperType).
Iso (HFlip f0 x0 # k0) (HFlip f1 x1 # k1) (f0 k0 # x0) (f1 k1 # x1)
_HFlip (((InferResult p # e) -> Identity (InferResult q # e))
 -> (HFlip InferResult e # p) -> Identity (HFlip InferResult e # q))
-> (((InferOf e # p) -> Identity (InferOf e # q))
    -> (InferResult p # e) -> Identity (InferResult q # e))
-> ((InferOf e # p) -> Identity (InferOf e # q))
-> (HFlip InferResult e # p)
-> Identity (HFlip InferResult e # q)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((InferOf e # p) -> Identity (InferOf e # q))
-> (InferResult p # e) -> Identity (InferResult q # e)
forall (v :: HyperType) (e :: AHyperType) (v :: HyperType)
       (e :: AHyperType).
Iso
  (InferResult v e)
  (InferResult v e)
  (InferOf (GetHyperType e) # v)
  (InferOf (GetHyperType e) # v)
_InferResult (((InferOf e # p) -> Identity (InferOf e # q))
 -> (HFlip InferResult e # p) -> Identity (HFlip InferResult e # q))
-> ((InferOf e # p) -> InferOf e # q)
-> (HFlip InferResult e # p)
-> HFlip InferResult e # q
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall (n :: HyperType).
 HWitness (InferOf e) n -> (p # n) -> q # n)
-> (InferOf e # p) -> InferOf e # q
forall (h :: HyperType) (p :: HyperType) (q :: HyperType).
HFunctor h =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> q # n)
-> (h # p) -> h # q
hmap (HWitness (HFlip InferResult e) n -> (p # n) -> q # n
forall (n :: HyperType).
HWitness (HFlip InferResult e) n -> (p # n) -> q # n
f (HWitness (HFlip InferResult e) n -> (p # n) -> q # n)
-> (HWitness (InferOf e) n -> HWitness (HFlip InferResult e) n)
-> HWitness (InferOf e) n
-> (p # n)
-> q # n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWitnessType (InferOf e) n -> HWitness (HFlip InferResult e) n
forall (h2 :: HyperType) (n2 :: HyperType).
HWitnessType h2 n2 -> HWitness h2 n2
HWitness (HWitnessType (InferOf e) n -> HWitness (HFlip InferResult e) n)
-> (HWitness (InferOf e) n -> HWitnessType (InferOf e) n)
-> HWitness (InferOf e) n
-> HWitness (HFlip InferResult e) n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HWitness (InferOf e) n
-> Getting
     (HWitnessType (InferOf e) n)
     (HWitness (InferOf e) n)
     (HWitnessType (InferOf e) n)
-> HWitnessType (InferOf e) n
forall s a. s -> Getting a s a -> a
^. Getting
  (HWitnessType (InferOf e) n)
  (HWitness (InferOf e) n)
  (HWitnessType (InferOf e) n)
forall (h1 :: HyperType) (n1 :: HyperType) (h2 :: HyperType)
       (n2 :: HyperType).
Iso
  (HWitness h1 n1)
  (HWitness h2 n2)
  (HWitnessType h1 n1)
  (HWitnessType h2 n2)
_HWitness))

instance HFoldable (InferOf e) => HFoldable (HFlip InferResult e) where
    hfoldMap :: (forall (n :: HyperType).
 HWitness (HFlip InferResult e) n -> (p # n) -> a)
-> (HFlip InferResult e # p) -> a
hfoldMap forall (n :: HyperType).
HWitness (HFlip InferResult e) n -> (p # n) -> a
f = (forall (n :: HyperType). HWitness (InferOf e) n -> (p # n) -> a)
-> (InferOf e # p) -> a
forall (h :: HyperType) a (p :: HyperType).
(HFoldable h, Monoid a) =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> a)
-> (h # p) -> a
hfoldMap (HWitness (HFlip InferResult e) n -> (p # n) -> a
forall (n :: HyperType).
HWitness (HFlip InferResult e) n -> (p # n) -> a
f (HWitness (HFlip InferResult e) n -> (p # n) -> a)
-> (HWitness (InferOf e) n -> HWitness (HFlip InferResult e) n)
-> HWitness (InferOf e) n
-> (p # n)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HWitnessType (InferOf e) n -> HWitness (HFlip InferResult e) n
forall (h2 :: HyperType) (n2 :: HyperType).
HWitnessType h2 n2 -> HWitness h2 n2
HWitness (HWitnessType (InferOf e) n -> HWitness (HFlip InferResult e) n)
-> (HWitness (InferOf e) n -> HWitnessType (InferOf e) n)
-> HWitness (InferOf e) n
-> HWitness (HFlip InferResult e) n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HWitness (InferOf e) n
-> Getting
     (HWitnessType (InferOf e) n)
     (HWitness (InferOf e) n)
     (HWitnessType (InferOf e) n)
-> HWitnessType (InferOf e) n
forall s a. s -> Getting a s a -> a
^. Getting
  (HWitnessType (InferOf e) n)
  (HWitness (InferOf e) n)
  (HWitnessType (InferOf e) n)
forall (h1 :: HyperType) (n1 :: HyperType) (h2 :: HyperType)
       (n2 :: HyperType).
Iso
  (HWitness h1 n1)
  (HWitness h2 n2)
  (HWitnessType h1 n1)
  (HWitnessType h2 n2)
_HWitness)) ((InferOf e # p) -> a)
-> ((HFlip InferResult e # p) -> InferOf e # p)
-> (HFlip InferResult e # p)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HFlip InferResult e # p)
-> Getting
     (InferOf e # p) (HFlip InferResult e # p) (InferOf e # p)
-> InferOf e # p
forall s a. s -> Getting a s a -> a
^. ((InferResult p # e) -> Const (InferOf e # p) (InferResult p # e))
-> (HFlip InferResult e # p)
-> Const (InferOf e # p) (HFlip InferResult e # p)
forall (f0 :: HyperType -> HyperType) (x0 :: HyperType)
       (k0 :: HyperType) (f1 :: HyperType -> HyperType) (x1 :: HyperType)
       (k1 :: HyperType).
Iso (HFlip f0 x0 # k0) (HFlip f1 x1 # k1) (f0 k0 # x0) (f1 k1 # x1)
_HFlip (((InferResult p # e) -> Const (InferOf e # p) (InferResult p # e))
 -> (HFlip InferResult e # p)
 -> Const (InferOf e # p) (HFlip InferResult e # p))
-> (((InferOf e # p) -> Const (InferOf e # p) (InferOf e # p))
    -> (InferResult p # e)
    -> Const (InferOf e # p) (InferResult p # e))
-> Getting
     (InferOf e # p) (HFlip InferResult e # p) (InferOf e # p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((InferOf e # p) -> Const (InferOf e # p) (InferOf e # p))
-> (InferResult p # e) -> Const (InferOf e # p) (InferResult p # e)
forall (v :: HyperType) (e :: AHyperType) (v :: HyperType)
       (e :: AHyperType).
Iso
  (InferResult v e)
  (InferResult v e)
  (InferOf (GetHyperType e) # v)
  (InferOf (GetHyperType e) # v)
_InferResult)

instance HTraversable (InferOf e) => HTraversable (HFlip InferResult e) where
    hsequence :: (HFlip InferResult e # ContainedH f p)
-> f (HFlip InferResult e # p)
hsequence = (((InferResult (ContainedH f p) # e) -> f (InferResult p # e))
-> (HFlip InferResult e # ContainedH f p)
-> f (HFlip InferResult e # p)
forall (f0 :: HyperType -> HyperType) (x0 :: HyperType)
       (k0 :: HyperType) (f1 :: HyperType -> HyperType) (x1 :: HyperType)
       (k1 :: HyperType).
Iso (HFlip f0 x0 # k0) (HFlip f1 x1 # k1) (f0 k0 # x0) (f1 k1 # x1)
_HFlip (((InferResult (ContainedH f p) # e) -> f (InferResult p # e))
 -> (HFlip InferResult e # ContainedH f p)
 -> f (HFlip InferResult e # p))
-> (((InferOf e # ContainedH f p) -> f (InferOf e # p))
    -> (InferResult (ContainedH f p) # e) -> f (InferResult p # e))
-> ((InferOf e # ContainedH f p) -> f (InferOf e # p))
-> (HFlip InferResult e # ContainedH f p)
-> f (HFlip InferResult e # p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((InferOf e # ContainedH f p) -> f (InferOf e # p))
-> (InferResult (ContainedH f p) # e) -> f (InferResult p # e)
forall (v :: HyperType) (e :: AHyperType) (v :: HyperType)
       (e :: AHyperType).
Iso
  (InferResult v e)
  (InferResult v e)
  (InferOf (GetHyperType e) # v)
  (InferOf (GetHyperType e) # v)
_InferResult) (InferOf e # ContainedH f p) -> f (InferOf e # p)
forall (h :: HyperType) (f :: * -> *) (p :: HyperType).
(HTraversable h, Applicative f) =>
(h # ContainedH f p) -> f (h # p)
hsequence