{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module      : Prosidy.Compile.Core.Interpret
Description : Internal module declaring the 'Context' and 'Interpret' classes. 
Copyright   : ©2020 James Alexander Feldman-Crough
License     : MPL-2.0
Maintainer  : alex@fldcr.com
-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE TypeFamilies #-}
module Prosidy.Compile.Core.Interpret
    ( Context(..)
    , Interpret(..)
    , interpret
    )
where

import           Control.Applicative            ( Alternative )
import           Prosidy.Compile.Core.Rules     ( RuleFor
                                                , Rules
                                                , Rule(..)
                                                , runRules
                                                )
import           Data.Void.HKT                  ( Void
                                                , absurd
                                                )

-- | A base class for interpreters of 'Rules'.
class (forall i. Alternative (t i)) => Context t where
    -- | Access the current focus of an interpreter. This function is similar
    -- in purpose to 'Control.Monad.Trans.Reader.ask'.
    runSelf :: t i i

    -- | A type for expressions that can be lifted by the interpreter.
    --
    -- This type defaults to an uninhabited type. Only override this type
    -- if you intend on overriding 'liftRule', as well.
    type Local t :: * -> *

    -- | Lift an expression of type 'Local' into the interpreter. 
    --
    -- By default, 'Local' is left as an uninhabted type and escaping via
    -- 'liftRule' can never happen. Override both 'Local' and 'liftRule' to
    -- permit arbitrary computation.
    liftRule :: Local t a -> t i a

    type Local t = Void t
    default liftRule :: Local t a ~ Void t a => Local t a -> t i a
    liftRule = Local t a -> t i a
forall a b. Uninhabited a => a -> b
absurd

-- | Instructs a 'Context' how to interpret a single rule.
class Context t => Interpret t i where
    -- | Evaluate a single rule into the context.
    runRule :: RuleFor i (Local t) a -> t i a

    default runRule :: (RuleFor i ~ Void i) => RuleFor i (Local t) a -> t i a
    runRule = RuleFor i (Local t) a -> t i a
forall a b. Uninhabited a => a -> b
absurd

-- | Evaluate 'Rules' into a contextual interpreter.
interpret :: forall t i a. Interpret t i => Rules i (Local t) a -> t i a
interpret :: Rules i (Local t) a -> t i a
interpret = (forall b. Rule i (Local t) b -> t i b)
-> Rules i (Local t) a -> t i a
forall (g :: * -> *) t (f :: * -> *) a.
Alternative g =>
(forall b. Rule t f b -> g b) -> Rules t f a -> g a
runRules ((forall b. Rule i (Local t) b -> t i b)
 -> Rules i (Local t) a -> t i a)
-> (forall b. Rule i (Local t) b -> t i b)
-> Rules i (Local t) a
-> t i a
forall a b. (a -> b) -> a -> b
$ \x :: Rule i (Local t) b
x -> case Rule i (Local t) b
x of
    RuleFor r :: RuleFor i (Local t) b
r -> RuleFor i (Local t) b -> t i b
forall (t :: * -> * -> *) i a.
Interpret t i =>
RuleFor i (Local t) a -> t i a
runRule RuleFor i (Local t) b
r
    Escape  f :: Local t b
f -> Local t b -> t i b
forall (t :: * -> * -> *) a i. Context t => Local t a -> t i a
liftRule Local t b
f
    Self    s :: i -> b
s -> i -> b
s (i -> b) -> t i i -> t i b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t i i
forall (t :: * -> * -> *) i. Context t => t i i
runSelf