module Hint.Typecheck (
      typeOf, typeChecks, kindOf, normalizeType, onCompilationError, typeChecksWithDetails
) where

import Control.Monad.Catch

import Hint.Base
import Hint.Parsers
import Hint.Conversions

import qualified Hint.GHC as GHC

-- | Returns a string representation of the type of the expression.
typeOf :: MonadInterpreter m => String -> m String
typeOf :: forall (m :: * -> *). MonadInterpreter m => String -> m String
typeOf String
expr =
    do -- First, make sure the expression has no syntax errors,
       -- for this is the only way we have to "intercept" this
       -- kind of errors
       (String -> m ParseResult) -> String -> m ()
forall (m :: * -> *).
MonadInterpreter m =>
(String -> m ParseResult) -> String -> m ()
failOnParseError String -> m ParseResult
forall (m :: * -> *). MonadInterpreter m => String -> m ParseResult
parseExpr String
expr
       --
       Type
type_ <- m (Maybe Type) -> m Type
forall (m :: * -> *) a. MonadInterpreter m => m (Maybe a) -> m a
mayFail (RunGhc1 m String (Maybe Type)
forall (m :: * -> *) a b. MonadInterpreter m => RunGhc1 m a b
runGhc1 forall {n :: * -> *}.
(MonadIO n, MonadMask n) =>
String -> GhcT n (Maybe Type)
forall (m :: * -> *). GhcMonad m => String -> m (Maybe Type)
exprType String
expr)
       Type -> m String
forall (m :: * -> *). MonadInterpreter m => Type -> m String
typeToString Type
type_

-- | Tests if the expression type checks.
--
-- NB. Be careful if there is `-fdefer-type-errors` involved.
-- Perhaps unsurprisingly, that can falsely make @typeChecks@ and @getType@
-- return @True@ and @Right _@ respectively.
typeChecks :: MonadInterpreter m => String -> m Bool
typeChecks :: forall (m :: * -> *). MonadInterpreter m => String -> m Bool
typeChecks String
expr = (Bool
True Bool -> m String -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). MonadInterpreter m => String -> m String
typeOf String
expr)
                              m Bool -> (InterpreterError -> m Bool) -> m Bool
forall (m :: * -> *) a.
MonadInterpreter m =>
m a -> (InterpreterError -> m a) -> m a
`catchIE`
                              ([GhcError] -> m Bool) -> InterpreterError -> m Bool
forall (m :: * -> *) a.
MonadInterpreter m =>
([GhcError] -> m a) -> InterpreterError -> m a
onCompilationError (\[GhcError]
_ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

-- | Similar to @typeChecks@, but gives more information, e.g. the type errors.
typeChecksWithDetails :: MonadInterpreter m => String -> m (Either [GhcError] String)
typeChecksWithDetails :: forall (m :: * -> *).
MonadInterpreter m =>
String -> m (Either [GhcError] String)
typeChecksWithDetails String
expr = (String -> Either [GhcError] String
forall a b. b -> Either a b
Right (String -> Either [GhcError] String)
-> m String -> m (Either [GhcError] String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m String
forall (m :: * -> *). MonadInterpreter m => String -> m String
typeOf String
expr)
                              m (Either [GhcError] String)
-> (InterpreterError -> m (Either [GhcError] String))
-> m (Either [GhcError] String)
forall (m :: * -> *) a.
MonadInterpreter m =>
m a -> (InterpreterError -> m a) -> m a
`catchIE`
                              ([GhcError] -> m (Either [GhcError] String))
-> InterpreterError -> m (Either [GhcError] String)
forall (m :: * -> *) a.
MonadInterpreter m =>
([GhcError] -> m a) -> InterpreterError -> m a
onCompilationError (Either [GhcError] String -> m (Either [GhcError] String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [GhcError] String -> m (Either [GhcError] String))
-> ([GhcError] -> Either [GhcError] String)
-> [GhcError]
-> m (Either [GhcError] String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GhcError] -> Either [GhcError] String
forall a b. a -> Either a b
Left)

-- | Returns a string representation of the kind of the type expression.
kindOf :: MonadInterpreter m => String -> m String
kindOf :: forall (m :: * -> *). MonadInterpreter m => String -> m String
kindOf String
type_expr =
    do -- First, make sure the expression has no syntax errors,
       -- for this is the only way we have to "intercept" this
       -- kind of errors
       (String -> m ParseResult) -> String -> m ()
forall (m :: * -> *).
MonadInterpreter m =>
(String -> m ParseResult) -> String -> m ()
failOnParseError String -> m ParseResult
forall (m :: * -> *). MonadInterpreter m => String -> m ParseResult
parseType String
type_expr
       --
       (Type
_, Type
kind) <- m (Maybe (Type, Type)) -> m (Type, Type)
forall (m :: * -> *) a. MonadInterpreter m => m (Maybe a) -> m a
mayFail (m (Maybe (Type, Type)) -> m (Type, Type))
-> m (Maybe (Type, Type)) -> m (Type, Type)
forall a b. (a -> b) -> a -> b
$ RunGhc1 m String (Maybe (Type, Type))
forall (m :: * -> *) a b. MonadInterpreter m => RunGhc1 m a b
runGhc1 forall {n :: * -> *}.
(MonadIO n, MonadMask n) =>
String -> GhcT n (Maybe (Type, Type))
forall (m :: * -> *).
GhcMonad m =>
String -> m (Maybe (Type, Type))
typeKind String
type_expr
       --
       Type -> m String
forall (m :: * -> *). MonadInterpreter m => Type -> m String
kindToString Type
kind

-- | Returns a string representation of the normalized type expression.
-- This is what the @:kind!@ GHCi command prints after @=@.
normalizeType :: MonadInterpreter m => String -> m String
normalizeType :: forall (m :: * -> *). MonadInterpreter m => String -> m String
normalizeType String
type_expr =
    do -- First, make sure the expression has no syntax errors,
       -- for this is the only way we have to "intercept" this
       -- kind of errors
       (String -> m ParseResult) -> String -> m ()
forall (m :: * -> *).
MonadInterpreter m =>
(String -> m ParseResult) -> String -> m ()
failOnParseError String -> m ParseResult
forall (m :: * -> *). MonadInterpreter m => String -> m ParseResult
parseType String
type_expr
       --
       (Type
ty, Type
_) <- m (Maybe (Type, Type)) -> m (Type, Type)
forall (m :: * -> *) a. MonadInterpreter m => m (Maybe a) -> m a
mayFail (m (Maybe (Type, Type)) -> m (Type, Type))
-> m (Maybe (Type, Type)) -> m (Type, Type)
forall a b. (a -> b) -> a -> b
$ RunGhc1 m String (Maybe (Type, Type))
forall (m :: * -> *) a b. MonadInterpreter m => RunGhc1 m a b
runGhc1 forall {n :: * -> *}.
(MonadIO n, MonadMask n) =>
String -> GhcT n (Maybe (Type, Type))
forall (m :: * -> *).
GhcMonad m =>
String -> m (Maybe (Type, Type))
typeKind String
type_expr
       --
       Type -> m String
forall (m :: * -> *). MonadInterpreter m => Type -> m String
typeToString Type
ty

-- add a bogus Maybe, in order to use it with mayFail
exprType :: GHC.GhcMonad m => String -> m (Maybe GHC.Type)
exprType :: forall (m :: * -> *). GhcMonad m => String -> m (Maybe Type)
exprType = (Type -> Maybe Type) -> m Type -> m (Maybe Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> Maybe Type
forall a. a -> Maybe a
Just (m Type -> m (Maybe Type))
-> (String -> m Type) -> String -> m (Maybe Type)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcRnExprMode -> String -> m Type
forall (m :: * -> *).
GhcMonad m =>
TcRnExprMode -> String -> m Type
GHC.exprType TcRnExprMode
GHC.TM_Inst

-- add a bogus Maybe, in order to use it with mayFail
typeKind :: GHC.GhcMonad m => String -> m (Maybe (GHC.Type, GHC.Kind))
typeKind :: forall (m :: * -> *).
GhcMonad m =>
String -> m (Maybe (Type, Type))
typeKind = ((Type, Type) -> Maybe (Type, Type))
-> m (Type, Type) -> m (Maybe (Type, Type))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Type, Type) -> Maybe (Type, Type)
forall a. a -> Maybe a
Just (m (Type, Type) -> m (Maybe (Type, Type)))
-> (String -> m (Type, Type)) -> String -> m (Maybe (Type, Type))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> m (Type, Type)
forall (m :: * -> *).
GhcMonad m =>
Bool -> String -> m (Type, Type)
GHC.typeKind Bool
True

onCompilationError :: MonadInterpreter m
                   => ([GhcError] -> m a)
                   -> (InterpreterError -> m a)
onCompilationError :: forall (m :: * -> *) a.
MonadInterpreter m =>
([GhcError] -> m a) -> InterpreterError -> m a
onCompilationError [GhcError] -> m a
recover InterpreterError
interp_error
    = case InterpreterError
interp_error of
          WontCompile [GhcError]
errs -> [GhcError] -> m a
recover [GhcError]
errs
          InterpreterError
otherErr         -> InterpreterError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM InterpreterError
otherErr