-- | Provide a way to access Compiler/Typechecker as a black box,
-- | according to Seminal's algorithm
module Seminal.Compiler.TypeChecker (
    TypeCheckStatus (..),
    ErrorType (..), isScopeError, isTypecheckError, getTypeCheckError,
    Seminal.Compiler.TypeChecker.typecheckModule
) where

import Seminal.Compiler.API
import Text.Printf (printf)
import Data.Functor ((<&>))
import Data.Text (pack, strip, unpack)

-- | Defines the possible outcomes of the typechecking process of the compiler
data TypeCheckStatus =
    -- | Indicated the Code typechecks
    Success |
    -- | An error happened while typechecking
    Error ErrorType
    deriving (Int -> TypeCheckStatus -> ShowS
[TypeCheckStatus] -> ShowS
TypeCheckStatus -> String
(Int -> TypeCheckStatus -> ShowS)
-> (TypeCheckStatus -> String)
-> ([TypeCheckStatus] -> ShowS)
-> Show TypeCheckStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeCheckStatus -> ShowS
showsPrec :: Int -> TypeCheckStatus -> ShowS
$cshow :: TypeCheckStatus -> String
show :: TypeCheckStatus -> String
$cshowList :: [TypeCheckStatus] -> ShowS
showList :: [TypeCheckStatus] -> ShowS
Show, TypeCheckStatus -> TypeCheckStatus -> Bool
(TypeCheckStatus -> TypeCheckStatus -> Bool)
-> (TypeCheckStatus -> TypeCheckStatus -> Bool)
-> Eq TypeCheckStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeCheckStatus -> TypeCheckStatus -> Bool
== :: TypeCheckStatus -> TypeCheckStatus -> Bool
$c/= :: TypeCheckStatus -> TypeCheckStatus -> Bool
/= :: TypeCheckStatus -> TypeCheckStatus -> Bool
Eq)

data ErrorType =
    -- | Indicates an error occured while typechecking
    TypeCheckError String |
    -- | A type or variable could not be resolved
    -- | It comes with the compiler's error message
    ScopeError String

getTypeCheckError :: TypeCheckStatus -> Maybe ErrorType
getTypeCheckError :: TypeCheckStatus -> Maybe ErrorType
getTypeCheckError (Error ErrorType
e) = ErrorType -> Maybe ErrorType
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorType
e
getTypeCheckError TypeCheckStatus
_ = Maybe ErrorType
forall a. Maybe a
Nothing

isScopeError :: ErrorType -> Bool
isScopeError :: ErrorType -> Bool
isScopeError (ScopeError String
_) = Bool
True
isScopeError ErrorType
_ = Bool
False

isTypecheckError :: ErrorType -> Bool
isTypecheckError :: ErrorType -> Bool
isTypecheckError (TypeCheckError String
_) = Bool
True
isTypecheckError ErrorType
_ = Bool
False 

instance Eq ErrorType where
    TypeCheckError String
_ == :: ErrorType -> ErrorType -> Bool
== TypeCheckError String
_ = Bool
True
    ScopeError String
_ == ScopeError String
_ = Bool
True
    ErrorType
_ == ErrorType
_ = Bool
False

-- | Pretty-print of Error types
instance Show ErrorType where
    show :: ErrorType -> String
show (TypeCheckError String
err) = String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Typecheck Error:\n%s" String
err
    show (ScopeError String
err) = String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Scope Error:\n%s" String
err
    
-- | Typecheck Module
typecheckModule :: ParsedModule -> Ghc TypeCheckStatus
typecheckModule :: ParsedModule -> Ghc TypeCheckStatus
typecheckModule ParsedModule
parsedModule = do
    Either String TypecheckedModule
maybeT <- (SourceError -> Ghc (Either String TypecheckedModule))
-> Ghc (Either String TypecheckedModule)
-> Ghc (Either String TypecheckedModule)
forall (m :: * -> *) a.
MonadCatch m =>
(SourceError -> m a) -> m a -> m a
handleSourceError (Either String TypecheckedModule
-> Ghc (Either String TypecheckedModule)
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String TypecheckedModule
 -> Ghc (Either String TypecheckedModule))
-> (SourceError -> Either String TypecheckedModule)
-> SourceError
-> Ghc (Either String TypecheckedModule)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String TypecheckedModule
forall a b. a -> Either a b
Left (String -> Either String TypecheckedModule)
-> (SourceError -> String)
-> SourceError
-> Either String TypecheckedModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceError -> String
forall a. Show a => a -> String
show) (ParsedModule -> Ghc TypecheckedModule
forall (m :: * -> *).
GhcMonad m =>
ParsedModule -> m TypecheckedModule
Seminal.Compiler.API.typecheckModule ParsedModule
parsedModule Ghc TypecheckedModule
-> (TypecheckedModule -> Either String TypecheckedModule)
-> Ghc (Either String TypecheckedModule)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> TypecheckedModule -> Either String TypecheckedModule
forall a b. b -> Either a b
Right)
    TypeCheckStatus -> Ghc TypeCheckStatus
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeCheckStatus -> Ghc TypeCheckStatus)
-> TypeCheckStatus -> Ghc TypeCheckStatus
forall a b. (a -> b) -> a -> b
$ case Either String TypecheckedModule
maybeT of
        Right TypecheckedModule
_ -> TypeCheckStatus
Success
        Left String
errMsg -> ErrorType -> TypeCheckStatus
Error (if (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
`isContainedIn` String
errMsg) [String
"not in scope", String
"Not in scope"]
            then String -> ErrorType
ScopeError String
strippedMsg
            else String -> ErrorType
TypeCheckError String
strippedMsg)
                where strippedMsg :: String
strippedMsg = Text -> String
unpack (Text -> Text
strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
errMsg)