{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}

-- | Classes applying on 'HyperType's recursively
module Hyper.Class.Recursive
    ( Recursive (..)
    , Recursively (..)
    , RNodes (..)
    , RTraversable (..)
    , RecMethod
    , DefRecMethod
    , proxyArgument
    ) where

import Hyper.Class.Foldable
import Hyper.Class.Functor (HFunctor (..))
import Hyper.Class.Nodes (HNodes (..))
import Hyper.Class.Traversable
import Hyper.Type
import Hyper.Type.Pure (Pure (..))

import Hyper.Internal.Prelude

-- | A class of constraint constructors that apply to all recursive child nodes
class Recursive c where
    -- | Lift a recursive constraint to the next layer
    recurse :: (HNodes h, c h) => proxy (c h) -> Dict (HNodesConstraint h c)

type RecMethod c h = Proxy h -> Dict (HNodesConstraint h c)
type DefRecMethod c h = HNodesConstraint h c => RecMethod c h

-- | A class of 'HyperType's which recursively implement 'HNodes'
class HNodes h => RNodes h where
    recursiveHNodes :: RecMethod RNodes h
    {-# INLINE recursiveHNodes #-}
    default recursiveHNodes :: DefRecMethod RNodes h
    recursiveHNodes Proxy h
_ = forall (a :: Constraint). a => Dict a
Dict

instance RNodes Pure
instance RNodes (Const a)

-- | Helper Proxy combinator that is useful in many instances of 'Recursive'
proxyArgument :: proxy (f h :: Constraint) -> Proxy (h :: HyperType)
proxyArgument :: forall (proxy :: Constraint -> *) (f :: HyperType -> Constraint)
       (h :: HyperType).
proxy (f h) -> Proxy h
proxyArgument proxy (f h)
_ = forall {k} (t :: k). Proxy t
Proxy

instance Recursive RNodes where
    {-# INLINE recurse #-}
    recurse :: forall (h :: HyperType) (proxy :: Constraint -> *).
(HNodes h, RNodes h) =>
proxy (RNodes h) -> Dict (HNodesConstraint h RNodes)
recurse = forall (h :: HyperType). RNodes h => RecMethod RNodes h
recursiveHNodes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (proxy :: Constraint -> *) (f :: HyperType -> Constraint)
       (h :: HyperType).
proxy (f h) -> Proxy h
proxyArgument

-- | A constraint lifted to apply recursively.
--
-- Note that in cases where a constraint has dependencies other than 'RNodes',
-- one will want to create a class such as RTraversable to capture the dependencies,
-- otherwise using it in class contexts will be quite unergonomic.
class RNodes h => Recursively c h where
    recursively :: proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
    {-# INLINE recursively #-}
    default recursively ::
        (c h, HNodesConstraint h (Recursively c)) =>
        proxy (c h) ->
        Dict (c h, HNodesConstraint h (Recursively c))
    recursively proxy (c h)
_ = forall (a :: Constraint). a => Dict a
Dict

instance Recursive (Recursively c) where
    {-# INLINE recurse #-}
    recurse :: forall (h :: HyperType) (proxy :: Constraint -> *).
(HNodes h, Recursively c h) =>
proxy (Recursively c h)
-> Dict (HNodesConstraint h (Recursively c))
recurse proxy (Recursively c h)
p =
        forall (a :: Constraint). a => Dict a
Dict forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ forall (c :: HyperType -> Constraint) (h :: HyperType)
       (proxy :: Constraint -> *).
Recursively c h =>
proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
recursively (forall (proxy :: Constraint -> *) (h :: HyperType).
proxy (Recursively c h) -> Proxy (c h)
p0 proxy (Recursively c h)
p)
        where
            p0 :: proxy (Recursively c h) -> Proxy (c h)
            p0 :: forall (proxy :: Constraint -> *) (h :: HyperType).
proxy (Recursively c h) -> Proxy (c h)
p0 proxy (Recursively c h)
_ = forall {k} (t :: k). Proxy t
Proxy

instance c Pure => Recursively c Pure
instance c (Const a) => Recursively c (Const a)

-- | A class of 'HyperType's which recursively implement 'HTraversable'
class (HTraversable h, Recursively HFunctor h, Recursively HFoldable h) => RTraversable h where
    recursiveHTraversable :: RecMethod RTraversable h
    {-# INLINE recursiveHTraversable #-}
    default recursiveHTraversable :: DefRecMethod RTraversable h
    recursiveHTraversable Proxy h
_ = forall (a :: Constraint). a => Dict a
Dict

instance RTraversable Pure
instance RTraversable (Const a)

instance Recursive RTraversable where
    {-# INLINE recurse #-}
    recurse :: forall (h :: HyperType) (proxy :: Constraint -> *).
(HNodes h, RTraversable h) =>
proxy (RTraversable h) -> Dict (HNodesConstraint h RTraversable)
recurse = forall (h :: HyperType). RTraversable h => RecMethod RTraversable h
recursiveHTraversable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (proxy :: Constraint -> *) (f :: HyperType -> Constraint)
       (h :: HyperType).
proxy (f h) -> Proxy h
proxyArgument