{-# LANGUAGE NoImplicitPrelude, CPP, OverloadedStrings, DoAndIfThenElse, FlexibleContexts #-}

{- |
Description:    Generates inspections when asked for by the frontend.

-}
module IHaskell.Eval.Inspect (inspect) where

import           IHaskellPrelude

import qualified Prelude as P

import           Data.List.Split (splitOn)

#if MIN_VERSION_ghc(9,0,0)
import qualified Control.Monad.Catch as MC
#else
import           Exception (ghandle)
#endif

import           IHaskell.Eval.Evaluate (Interpreter)
import           IHaskell.Display
import           IHaskell.Eval.Util (getType)

-- | Characters used in Haskell operators.
operatorChars :: String
operatorChars :: String
operatorChars = String
"!#$%&*+./<=>?@\\^|-~:"

-- | Whitespace characters.
whitespace :: String
whitespace :: String
whitespace = String
" \t\n"

-- | Compute the identifier that is being queried.
getIdentifier :: String -> Int -> String
getIdentifier :: String -> Int -> String
getIdentifier String
code Int
_pos = String
identifier
  where
    chunks :: [String]
chunks = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
whitespace String
code
    lastChunk :: String
lastChunk = [String] -> String
forall a. HasCallStack => [a] -> a
P.last [String]
chunks :: String
    identifier :: String
identifier =
      if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
operatorChars) String
lastChunk
        then String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lastChunk String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
        else String
lastChunk

inspect :: String -- ^ Code in the cell
        -> Int    -- ^ Cursor position in the cell
        -> Interpreter (Maybe Display)
inspect :: String -> Int -> Interpreter (Maybe Display)
inspect String
code Int
pos = do
  let identifier :: String
identifier = String -> Int -> String
getIdentifier String
code Int
pos
      handler :: SomeException -> Interpreter (Maybe a)
      handler :: forall a. SomeException -> Interpreter (Maybe a)
handler SomeException
_ = Maybe a -> Ghc (Maybe a)
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
#if MIN_VERSION_ghc(9,0,0)
  Maybe String
response <- (SomeException -> Ghc (Maybe String))
-> Ghc (Maybe String) -> Ghc (Maybe String)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
MC.handle SomeException -> Ghc (Maybe String)
forall a. SomeException -> Interpreter (Maybe a)
handler (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> Ghc String -> Ghc (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Ghc String
forall (m :: * -> *). GhcMonad m => String -> m String
getType String
identifier)
#else
  response <- ghandle handler (Just <$> getType identifier)
#endif
  let prefix :: String
prefix = String
identifier String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :: "
      fmt :: String -> Display
fmt String
str = [DisplayData] -> Display
Display [String -> DisplayData
plain (String -> DisplayData) -> String -> DisplayData
forall a b. (a -> b) -> a -> b
$ String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str]
  Maybe Display -> Interpreter (Maybe Display)
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Display -> Interpreter (Maybe Display))
-> Maybe Display -> Interpreter (Maybe Display)
forall a b. (a -> b) -> a -> b
$ String -> Display
fmt (String -> Display) -> Maybe String -> Maybe Display
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
response