{-# LANGUAGE Rank2Types #-}

-- | This module contains GHC-specific functions
module Control.Recursion.GHC ( transverse
                             , cotransverse
                             , hoist
                             ) where

import           Control.Recursion

-- | Should satisfy:
--
-- @
-- 'transverse' 'sequenceA' = 'pure'
-- @
transverse :: (Recursive s, Corecursive t, Functor f)
           => (forall a. Base s (f a) -> f (Base t a))
           -> s
           -> f t
transverse η = cata (fmap embed . η)

cotransverse :: (Recursive s, Corecursive t, Functor f)
             => (forall a. f (Base s a) -> Base t (f a))
             -> f s
             -> t
cotransverse η = ana (η . fmap project)

hoist :: (Recursive s, Corecursive t)
      => (forall a. Base s a -> Base t a)
      -> s
      -> t
hoist η = cata (embed . η)
{-# NOINLINE [0] hoist #-}

hoistMu :: (forall a. f a -> g a) -> Mu f -> Mu g
hoistMu η (Mu f) = Mu (f . (. η))

hoistNu :: (forall a. f a -> g a) -> Nu f -> Nu g
hoistNu ν (Nu f x) = Nu (ν . f) x

{-# RULES
  "hoist/hoistMu" forall (η :: forall a. f a -> f a) (f :: forall a. (f a -> a) -> a). hoist η (Mu f) = hoistMu η (Mu f);
     #-}

{-# RULES
  "hoist/hoistNu" forall (η :: forall a. f a -> f a) (f :: a -> f a) x. hoist η (Nu f x) = hoistNu η (Nu f x);
     #-}