HyperFree.hs

{-# LANGUAGE UndecidableInstances #-}

-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.

module Control.HyperFree where

import Control.Applicative (Alternative)
import Control.Monad (MonadPlus)
import Control.Monad.Base (MonadBase)
import Control.Monad.IO.Class (MonadIO)
import Data.Kind (Type)

type Signature = (ASignature -> Type -> Type) -> ASignature -> Type -> Type
newtype ASignature = ASignature Signature

type family GetSignature (h :: ASignature) :: Signature where
    GetSignature ('ASignature t) = t

type FreeType = (Type -> Type) -> Type -> Type

newtype HyperFree (f :: FreeType) (e :: ASignature) (a :: Type) = HyperFree
    {unHyperFree :: f (e # f) a}

type e # f = (GetSignature e) (HyperFree f) e

deriving newtype instance Functor (f (e # f)) => Functor (HyperFree f e)
deriving newtype instance Applicative (f (e # f)) => Applicative (HyperFree f e)
deriving newtype instance Alternative (f (e # f)) => Alternative (HyperFree f e)
deriving newtype instance Monad (f (e # f)) => Monad (HyperFree f e)
deriving newtype instance MonadPlus (f (e # f)) => MonadPlus (HyperFree f e)
deriving newtype instance (MonadBase b (f (e # f)), Monad b) => MonadBase b (HyperFree f e)
deriving newtype instance MonadIO (f (e # f)) => MonadIO (HyperFree f e)
deriving newtype instance MonadFail (f (e # f)) => MonadFail (HyperFree f e)

deriving stock instance Foldable (f (e # f)) => Foldable (HyperFree f e)
deriving stock instance Traversable (f (e # f)) => Traversable (HyperFree f e)

deriving newtype instance Eq (f (e # f) a) => Eq (HyperFree f e a)
deriving newtype instance Ord (f (e # f) a) => Ord (HyperFree f e a)
deriving newtype instance Read (f (e # f) a) => Read (HyperFree f e a)
deriving newtype instance Show (f (e # f) a) => Show (HyperFree f e a)