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

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 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 :: forall (e :: HyperType) (t :: HyperType) (v0 :: HyperType)
       (v1 :: HyperType).
(InferOf e ~ ANode t) =>
Iso (InferResult v0 # e) (InferResult v1 # e) (v0 # t) (v1 # t)
inferResult = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (c :: HyperType -> Constraint) (n :: HyperType) r.
HNodesConstraint (HFlip InferResult e) c =>
HWitness (HFlip InferResult e) n -> Proxy c -> (c n => r) -> r
hLiftConstraint (HWitness HWitnessType (HFlip InferResult e) n
w) = forall (h :: HyperType) (c :: HyperType -> Constraint)
       (n :: HyperType) r.
(HNodes h, HNodesConstraint h c) =>
HWitness h n -> Proxy c -> (c n => r) -> r
hLiftConstraint (forall (h :: HyperType) (n :: HyperType).
HWitnessType h n -> HWitness h n
HWitness @(InferOf e) HWitnessType (HFlip InferResult e) n
w)

instance HFunctor (InferOf e) => HFunctor (HFlip InferResult e) where
    hmap :: forall (p :: HyperType) (q :: HyperType).
(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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (h :: HyperType) (p :: HyperType) (q :: HyperType).
HFunctor h =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> q # n)
-> (h # p) -> h # q
hmap (forall (n :: HyperType).
HWitness (HFlip InferResult e) n -> (p # n) -> q # n
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (h :: HyperType) (n :: HyperType).
HWitnessType h n -> HWitness h n
HWitness forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. 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 a (p :: HyperType).
Monoid a =>
(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 (h :: HyperType) a (p :: HyperType).
(HFoldable h, Monoid a) =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> a)
-> (h # p) -> a
hfoldMap (forall (n :: HyperType).
HWitness (HFlip InferResult e) n -> (p # n) -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (h :: HyperType) (n :: HyperType).
HWitnessType h n -> HWitness h n
HWitness forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. forall (h1 :: HyperType) (n1 :: HyperType) (h2 :: HyperType)
       (n2 :: HyperType).
Iso
  (HWitness h1 n1)
  (HWitness h2 n2)
  (HWitnessType h1 n1)
  (HWitnessType h2 n2)
_HWitness)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (f :: * -> *) (p :: HyperType).
Applicative f =>
(HFlip InferResult e # ContainedH f p)
-> f (HFlip InferResult e # p)
hsequence = (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) forall (h :: HyperType) (f :: * -> *) (p :: HyperType).
(HTraversable h, Applicative f) =>
(h # ContainedH f p) -> f (h # p)
hsequence