{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}


{-|
Module      : Control.Monad.Lang.Types
Description : Datatypes and instances we use when implementing a LangT
Copyright   : (c) Rohit Ramesh, 2018
License     : GPL-2
Maintainer  : rkr@berkley.edu
Stability   : experimental
Portability : POSIX
-}

module Control.Monad.Analysis.Class where

import EDGPrelude
import Data.Functor.Foldable
import Control.Monad.Error.Class
import Control.Unification
import Data.Dynamic

class MonadAnalyse al k m where
  type AnalysisKey al k :: *

  -- | Retrieve a closed analysis result for a term in keyspace `k`.
  analyseWith :: k -> AnalysisKey al k -> m (Maybe al)

  -- | This lets you retrieve a partially bound term, with values that either
  --   refer to other elements in keyspace `k` or arbitrarily assigned integers
  --   that refer to free terms that aren't found in `k`.
  partiallyAnalyseWith :: k -> AnalysisKey al k -> m (UTerm (Base al) (Either k Int))

type KeyConstraints al k = (Show (AnalysisKey al k), Typeable al)

class (Show k) => AnalysisAccessErr k e where
  unexpectedAnalysisTermFound :: (KeyConstraints al k) => AnalysisKey al k -> e
  unexpectedAnalysisFound :: (KeyConstraints al k) => AnalysisKey al k -> e
  expectedAnalysisTermMissing :: (KeyConstraints al k) => AnalysisKey al k -> e
  expectedAnalysisMissing :: (KeyConstraints al k) => AnalysisKey al k -> e
  incorrectAnalysisType :: (KeyConstraints al k) => AnalysisKey al k -> Dynamic -> e

type ThrowConstraints e al k m = (KeyConstraints al k, AnalysisAccessErr k e, MonadError e m)

throwUnexpectedAnalysisTermFound :: forall e k al m a.
  (ThrowConstraints e al k m) => AnalysisKey al k -> m a
throwUnexpectedAnalysisTermFound
  = throwError @e . unexpectedAnalysisTermFound @k @e @al

throwUnexpectedAnalysisFound :: forall e k al m a.
  (ThrowConstraints e al k m) => AnalysisKey al k -> m a
throwUnexpectedAnalysisFound
  = throwError @e . unexpectedAnalysisFound @k @e @al

throwExpectedAnalysisTermMissing :: forall e k al m a.
  (ThrowConstraints e al k m) => AnalysisKey al k -> m a
throwExpectedAnalysisTermMissing
  = throwError @e . expectedAnalysisTermMissing @k @e @al

throwExpectedAnalysisMissing :: forall e k al m a.
  (ThrowConstraints e al k m) => AnalysisKey al k -> m a
throwExpectedAnalysisMissing
  = throwError @e . expectedAnalysisMissing @k @e @al

throwIncorrectAnalysisType :: forall e k al m a.
  (ThrowConstraints e al k m) => AnalysisKey al k -> Dynamic -> m a
throwIncorrectAnalysisType k
  = throwError @e . incorrectAnalysisType @k @e @al k

instance (Show k) => AnalysisAccessErr k String where
  unexpectedAnalysisFound     k = "Unexpected Analysis Found : " ++ show k
  unexpectedAnalysisTermFound k = "Unexpected Analysis Term Found : " ++ show k
  expectedAnalysisMissing     k = "Expected Analysis Missing : " ++ show k
  expectedAnalysisTermMissing k = "Excepted Analysis Term Missing : " ++ show k

  incorrectAnalysisType :: forall al. (KeyConstraints al k) => AnalysisKey al k -> Dynamic -> String
  incorrectAnalysisType (k :: AnalysisKey al k) d = "Analysis at " ++ show (k :: AnalysisKey al k)
                                         ++ " expected language of type "
                                         ++ (show . typeRep $ (Proxy :: Proxy al))
                                         ++ " instead found " ++ show d


instance (Show k) => AnalysisAccessErr k Void where

  unexpectedAnalysisTermFound :: (KeyConstraints al k) => AnalysisKey al k -> Void
  unexpectedAnalysisFound = error . unexpectedAnalysisFound

  unexpectedAnalysisFound :: (KeyConstraints al k) => AnalysisKey al k -> Void
  unexpectedAnalysisTermFound = error . unexpectedAnalysisFound

  expectedAnalysisMissing ::  (KeyConstraints al k) => AnalysisKey al k -> Void
  expectedAnalysisMissing    = error . expectedAnalysisMissing

  expectedAnalysisTermMissing :: (KeyConstraints al k) => AnalysisKey al k -> Void
  expectedAnalysisTermMissing = error . expectedAnalysisTermMissing

  incorrectAnalysisType :: forall al. (KeyConstraints al k) => AnalysisKey al k -> Dynamic -> Void
  incorrectAnalysisType k d = error $ incorrectAnalysisType @k @String @al k d