-- | Classes applying on 'HyperType's recursively

{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}

module Hyper.Class.Recursive
    ( Recursive(..)
    , Recursively(..)
    , RNodes(..), RTraversable(..)
    , 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)

-- | A class of 'HyperType's which recursively implement 'HNodes'
class HNodes h => RNodes h where
    recursiveHNodes :: proxy h -> Dict (HNodesConstraint h RNodes)
    {-# INLINE recursiveHNodes #-}
    default recursiveHNodes ::
        HNodesConstraint h RNodes =>
        proxy h -> Dict (HNodesConstraint h RNodes)
    recursiveHNodes proxy h
_ = Dict (HNodesConstraint h RNodes)
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 :: proxy (f h) -> Proxy h
proxyArgument proxy (f h)
_ = Proxy h
forall k (t :: k). Proxy t
Proxy

instance Recursive RNodes where
    {-# INLINE recurse #-}
    recurse :: proxy (RNodes h) -> Dict (HNodesConstraint h RNodes)
recurse = Proxy h -> Dict (HNodesConstraint h RNodes)
forall (h :: HyperType) (proxy :: HyperType -> *).
RNodes h =>
proxy h -> Dict (HNodesConstraint h RNodes)
recursiveHNodes (Proxy h -> Dict (HNodesConstraint h RNodes))
-> (proxy (RNodes h) -> Proxy h)
-> proxy (RNodes h)
-> Dict (HNodesConstraint h RNodes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy (RNodes h) -> Proxy h
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)
_ = Dict (c h, HNodesConstraint h (Recursively c))
forall (a :: Constraint). a => Dict a
Dict

instance Recursive (Recursively c) where
    {-# INLINE recurse #-}
    recurse :: proxy (Recursively c h)
-> Dict (HNodesConstraint h (Recursively c))
recurse proxy (Recursively c h)
p =
        Dict (c h, HNodesConstraint h (Recursively c))
-> ((c h, HNodesConstraint h (Recursively c)) =>
    Dict (HNodesConstraint h (Recursively c)))
-> Dict (HNodesConstraint h (Recursively c))
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (Proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
forall (c :: HyperType -> Constraint) (h :: HyperType)
       (proxy :: Constraint -> *).
Recursively c h =>
proxy (c h) -> Dict (c h, HNodesConstraint h (Recursively c))
recursively (proxy (Recursively c h) -> Proxy (c h)
forall (proxy :: Constraint -> *) (h :: HyperType).
proxy (Recursively c h) -> Proxy (c h)
p0 proxy (Recursively c h)
p)) (c h, HNodesConstraint h (Recursively c)) =>
Dict (HNodesConstraint h (Recursively c))
forall (a :: Constraint). a => Dict a
Dict
        where
            p0 :: proxy (Recursively c h) -> Proxy (c h)
            p0 :: proxy (Recursively c h) -> Proxy (c h)
p0 proxy (Recursively c h)
_ = Proxy (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 :: proxy h -> Dict (HNodesConstraint h RTraversable)
    {-# INLINE recursiveHTraversable #-}
    default recursiveHTraversable ::
        HNodesConstraint h RTraversable =>
        proxy h -> Dict (HNodesConstraint h RTraversable)
    recursiveHTraversable proxy h
_ = Dict (HNodesConstraint h RTraversable)
forall (a :: Constraint). a => Dict a
Dict

instance RTraversable Pure
instance RTraversable (Const a)

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