-- | Lift Functors to HyperTypes
{-# LANGUAGE TemplateHaskell, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
module Hyper.Type.Functor
    ( F(..), _F, W_F(..)
    ) where

import Control.Lens (iso, mapped)
import Hyper
import Hyper.Class.Monad (HMonad(..))

import Hyper.Internal.Prelude

-- | Lift a 'Functor', or type constructor of kind @Type -> Type@ to a 'Hyper.Type.HyperType'.
--
-- * @F Maybe@ can be used to encode structures with missing values
-- * @F (Either Text)@ can be used to encode results of parsing where structure components
--   may fail to parse.
newtype F f h = F (f (h :# F f))
    deriving stock (forall x. F f h -> Rep (F f h) x)
-> (forall x. Rep (F f h) x -> F f h) -> Generic (F f h)
forall x. Rep (F f h) x -> F f h
forall x. F f h -> Rep (F f h) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) (h :: AHyperType) x. Rep (F f h) x -> F f h
forall (f :: * -> *) (h :: AHyperType) x. F f h -> Rep (F f h) x
$cto :: forall (f :: * -> *) (h :: AHyperType) x. Rep (F f h) x -> F f h
$cfrom :: forall (f :: * -> *) (h :: AHyperType) x. F f h -> Rep (F f h) x
Generic

-- | An 'Iso' from 'F' to its content.
--
-- Using `_F` rather than the 'F' data constructor is recommended,
-- because it helps the type inference know that @F f@ is parameterized with a 'Hyper.Type.HyperType'.
_F ::
    Iso (F f0 # k0)
        (F f1 # k1)
        (f0 (k0 # F f0))
        (f1 (k1 # F f1))
_F :: p (f0 (k0 # F f0)) (f (f1 (k1 # F f1)))
-> p (F f0 # k0) (f (F f1 # k1))
_F = ((F f0 # k0) -> f0 (k0 # F f0))
-> (f1 (k1 # F f1) -> F f1 # k1)
-> Iso (F f0 # k0) (F f1 # k1) (f0 (k0 # F f0)) (f1 (k1 # F f1))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(F f0 ('AHyperType k0 :# F f0)
x) -> f0 (k0 # F f0)
f0 ('AHyperType k0 :# F f0)
x) f1 (k1 # F f1) -> F f1 # k1
forall (f :: * -> *) (h :: AHyperType). f (h :# F f) -> F f h
F

makeCommonInstances [''F]
makeHTraversableApplyAndBases ''F

instance Monad f => HMonad (F f) where
    hjoin :: (HCompose (F f) (F f) # p) -> F f # p
hjoin =
        ( (f (HCompose (F f) p # F f) -> Identity (f (p # F f)))
-> (F f # HCompose (F f) p) -> Identity (F f # p)
forall (f0 :: * -> *) (k0 :: HyperType) (f1 :: * -> *)
       (k1 :: HyperType).
Iso (F f0 # k0) (F f1 # k1) (f0 (k0 # F f0)) (f1 (k1 # F f1))
_F ((f (HCompose (F f) p # F f) -> Identity (f (p # F f)))
 -> (F f # HCompose (F f) p) -> Identity (F f # p))
-> (f (HCompose (F f) p # F f) -> f (p # F f))
-> (F f # HCompose (F f) p)
-> F f # p
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~
            ( f (HCompose (F f) p # F f)
-> ((HCompose (F f) p # F f) -> f (p # F f)) -> f (p # F f)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                ( ((HCompose p (F f) # F f) -> Identity (p # F f))
-> f (HCompose p (F f) # F f) -> Identity (f (p # F f))
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped (((HCompose p (F f) # F f) -> Identity (p # F f))
 -> f (HCompose p (F f) # F f) -> Identity (f (p # F f)))
-> ((HCompose p (F f) # F f) -> p # F f)
-> f (HCompose p (F f) # F f)
-> f (p # F f)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (p # HCompose (F f) (F f)) -> p # F f
forall (p :: HyperType).
Recursively HFunctor p =>
(p # HCompose (F f) (F f)) -> p # F f
t ((p # HCompose (F f) (F f)) -> p # F f)
-> ((HCompose p (F f) # F f) -> p # HCompose (F f) (F f))
-> (HCompose p (F f) # F f)
-> p # F f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HCompose p (F f) # F f)
-> Getting
     (p # HCompose (F f) (F f))
     (HCompose p (F f) # F f)
     (p # HCompose (F f) (F f))
-> p # HCompose (F f) (F f)
forall s a. s -> Getting a s a -> a
^. Getting
  (p # HCompose (F f) (F f))
  (HCompose p (F f) # F f)
  (p # HCompose (F f) (F f))
forall (a0 :: HyperType) (b0 :: HyperType) (h0 :: HyperType)
       (a1 :: HyperType) (b1 :: HyperType) (h1 :: HyperType).
Iso
  (HCompose a0 b0 # h0)
  (HCompose a1 b1 # h1)
  (a0 # HCompose b0 h0)
  (a1 # HCompose b1 h1)
_HCompose)
                ) (f (HCompose p (F f) # F f) -> f (p # F f))
-> ((HCompose (F f) p # F f) -> f (HCompose p (F f) # F f))
-> (HCompose (F f) p # F f)
-> f (p # F f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HCompose (F f) p # F f)
-> Getting
     (f (HCompose p (F f) # F f))
     (HCompose (F f) p # F f)
     (f (HCompose p (F f) # F f))
-> f (HCompose p (F f) # F f)
forall s a. s -> Getting a s a -> a
^. ((F f # HCompose p (F f))
 -> Const (f (HCompose p (F f) # F f)) (F f # HCompose p (F f)))
-> (HCompose (F f) p # F f)
-> Const (f (HCompose p (F f) # F f)) (HCompose (F f) p # F f)
forall (a0 :: HyperType) (b0 :: HyperType) (h0 :: HyperType)
       (a1 :: HyperType) (b1 :: HyperType) (h1 :: HyperType).
Iso
  (HCompose a0 b0 # h0)
  (HCompose a1 b1 # h1)
  (a0 # HCompose b0 h0)
  (a1 # HCompose b1 h1)
_HCompose (((F f # HCompose p (F f))
  -> Const (f (HCompose p (F f) # F f)) (F f # HCompose p (F f)))
 -> (HCompose (F f) p # F f)
 -> Const (f (HCompose p (F f) # F f)) (HCompose (F f) p # F f))
-> ((f (HCompose p (F f) # F f)
     -> Const (f (HCompose p (F f) # F f)) (f (HCompose p (F f) # F f)))
    -> (F f # HCompose p (F f))
    -> Const (f (HCompose p (F f) # F f)) (F f # HCompose p (F f)))
-> Getting
     (f (HCompose p (F f) # F f))
     (HCompose (F f) p # F f)
     (f (HCompose p (F f) # F f))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (HCompose p (F f) # F f)
 -> Const (f (HCompose p (F f) # F f)) (f (HCompose p (F f) # F f)))
-> (F f # HCompose p (F f))
-> Const (f (HCompose p (F f) # F f)) (F f # HCompose p (F f))
forall (f0 :: * -> *) (k0 :: HyperType) (f1 :: * -> *)
       (k1 :: HyperType).
Iso (F f0 # k0) (F f1 # k1) (f0 (k0 # F f0)) (f1 (k1 # F f1))
_F)
            )
        ) ((F f # HCompose (F f) p) -> F f # p)
-> ((HCompose (F f) (F f) # p) -> F f # HCompose (F f) p)
-> (HCompose (F f) (F f) # p)
-> F f # p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HCompose (F f) (F f) # p)
-> Getting
     (F f # HCompose (F f) p)
     (HCompose (F f) (F f) # p)
     (F f # HCompose (F f) p)
-> F f # HCompose (F f) p
forall s a. s -> Getting a s a -> a
^. Getting
  (F f # HCompose (F f) p)
  (HCompose (F f) (F f) # p)
  (F f # HCompose (F f) p)
forall (a0 :: HyperType) (b0 :: HyperType) (h0 :: HyperType)
       (a1 :: HyperType) (b1 :: HyperType) (h1 :: HyperType).
Iso
  (HCompose a0 b0 # h0)
  (HCompose a1 b1 # h1)
  (a0 # HCompose b0 h0)
  (a1 # HCompose b1 h1)
_HCompose)
        where
            t ::
                forall p.
                Recursively HFunctor p =>
                p # HCompose (F f) (F f) ->
                p # F f
            t :: (p # HCompose (F f) (F f)) -> p # F f
t =
                Dict (HFunctor p, HNodesConstraint p (Recursively HFunctor))
-> ((HFunctor p, HNodesConstraint p (Recursively HFunctor)) =>
    (p # HCompose (F f) (F f)) -> p # F f)
-> (p # HCompose (F f) (F f))
-> p # F f
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (Proxy (HFunctor p)
-> Dict (HFunctor p, HNodesConstraint p (Recursively HFunctor))
forall (c :: HyperType -> Constraint) (h :: HyperType)
       (proxy :: Constraint -> *).
Recursively c h =>
proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
recursively (Proxy (HFunctor p)
forall k (t :: k). Proxy t
Proxy @(HFunctor p))) (((HFunctor p, HNodesConstraint p (Recursively HFunctor)) =>
  (p # HCompose (F f) (F f)) -> p # F f)
 -> (p # HCompose (F f) (F f)) -> p # F f)
-> ((HFunctor p, HNodesConstraint p (Recursively HFunctor)) =>
    (p # HCompose (F f) (F f)) -> p # F f)
-> (p # HCompose (F f) (F f))
-> p # F f
forall a b. (a -> b) -> a -> b
$
                (forall (n :: HyperType).
 HWitness p n -> (HCompose (F f) (F f) # n) -> F f # n)
-> (p # HCompose (F f) (F f)) -> p # F f
forall (h :: HyperType) (p :: HyperType) (q :: HyperType).
HFunctor h =>
(forall (n :: HyperType). HWitness h n -> (p # n) -> q # n)
-> (h # p) -> h # q
hmap (Proxy (Recursively HFunctor)
forall k (t :: k). Proxy t
Proxy @(Recursively HFunctor) Proxy (Recursively HFunctor)
-> (Recursively HFunctor n =>
    (HCompose (F f) (F f) # n) -> F f # n)
-> HWitness p n
-> (HCompose (F f) (F f) # n)
-> F f # n
forall (h :: HyperType) (c :: HyperType -> Constraint)
       (n :: HyperType) r.
(HNodes h, HNodesConstraint h c) =>
Proxy c -> (c n => r) -> HWitness h n -> r
#> Recursively HFunctor n => (HCompose (F f) (F f) # n) -> F f # n
forall (h :: HyperType) (p :: HyperType).
(HMonad h, Recursively HFunctor p) =>
(HCompose h h # p) -> h # p
hjoin)

instance RNodes (F f)
instance c (F f) => Recursively c (F f)
instance Traversable f => RTraversable (F f)