Eval.hs

{-# LANGUAGE CPP, ScopedTypeVariables, TypeOperators, DeriveDataTypeable, GeneralizedNewtypeDeriving, TemplateHaskell, RecordWildCards #-}

module Yi.Eval (
        -- * Main (generic) evaluation interface
        execEditorAction,
        getAllNamesInScope,
        Evaluator(..),
        evaluator,
        -- ** Standard evaluators
        ghciEvaluator,
        publishedActionsEvaluator,
        publishedActions,
        publishAction,
        -- * Eval\/Interpretation
        jumpToErrorE,
        jumpToE,
        consoleKeymap,
) where

import Prelude hiding (error)
import Control.Applicative
import Control.Monad
import Control.Lens hiding (Action)
import Data.Array
import Data.List
import Data.Monoid
import Data.Typeable
import Data.Binary
import Data.Default
import qualified Language.Haskell.Interpreter as LHI
import System.Directory(doesFileExist)
import qualified Data.HashMap.Strict as M

import {-# source #-} Yi.Boot (reload)
import Yi.Config.Simple.Types
import Yi.Core
import Yi.File
import Yi.Hooks
import Yi.Regex
import qualified Yi.Paths(getEvaluatorContextFilename)
import Yi.Utils
import Yi.Debug

-- | Runs the action, as written by the user.
--
-- The behaviour of this function can be customised by modifying the 'Evaluator' variable.
execEditorAction :: String -> YiM ()
execEditorAction = runHook execEditorActionImpl

-- | Lists the action names in scope, for use by 'execEditorAction'.
--
-- The behaviour of this function can be customised by modifying the 'Evaluator' variable.
getAllNamesInScope :: YiM [String]
getAllNamesInScope = runHook getAllNamesInScopeImpl

{- | Config variable for customising the behaviour of 'execEditorAction' and 'getAllNamesInScope'.

Set this variable using 'evaluator'. See 'ghciEvaluator' and 'finiteListEvaluator' for two implementation.
-}
data Evaluator = Evaluator {
  execEditorActionImpl :: String -> YiM (), -- ^ implementation of 'execEditorAction'
  getAllNamesInScopeImpl :: YiM [String] -- ^ implementation of 'getAllNamesInScope'
 }
 deriving(Typeable)

-- | The evaluator to use for 'execEditorAction' and 'getAllNamesInScope'.
evaluator :: Field Evaluator
evaluator = customVariable

instance Default Evaluator where def = ghciEvaluator
instance YiConfigVariable Evaluator

------------------------- Evaluator based on GHCi
newtype NamesCache = NamesCache [String] deriving (Typeable, Binary)
instance Default NamesCache where
    def = NamesCache []
instance YiVariable NamesCache

{- | Evaluator implemented by calling GHCi. This evaluator can run arbitrary expressions in the class 'YiAction'.

The following two imports are always present:

> import Yi
> import qualified Yi.Keymap as Yi.Keymap

Also, if the file

> $HOME/.config/yi/local/Env.hs

exists, it is imported unqualified.
-}
ghciEvaluator :: Evaluator
ghciEvaluator = Evaluator{..} where
    execEditorActionImpl :: String -> YiM ()
    execEditorActionImpl "reload" = reload
    execEditorActionImpl s = do
       contextFile <- Yi.Paths.getEvaluatorContextFilename
       haveUserContext <- io $ doesFileExist contextFile
       res <- io $ LHI.runInterpreter $ do
           LHI.set [LHI.searchPath LHI.:= []]
           LHI.set [LHI.languageExtensions LHI.:= [LHI.OverloadedStrings,
                                                   LHI.NoImplicitPrelude -- use Yi prelude instead.
                                                  ]]
           when haveUserContext $ do
              LHI.loadModules [contextFile]
              LHI.setTopLevelModules ["Env"]

           LHI.setImportsQ [("Yi", Nothing), ("Yi.Keymap",Just "Yi.Keymap")] -- Yi.Keymap: Action lives there
           LHI.interpret ("Yi.makeAction ("++s++")") (error "as" :: Action)
       case res of
           Left err -> errorEditor (show err)
           Right action -> runAction action

    getAllNamesInScopeImpl :: YiM [String]
    getAllNamesInScopeImpl = do
       NamesCache cache <- withEditor $ use dynA
       result <-if null cache then do
            res <-io $ LHI.runInterpreter $ do
                LHI.set [LHI.searchPath LHI.:= []]
                LHI.getModuleExports "Yi"
            return $ case res of
               Left err ->[show err]
               Right exports -> flattenExports exports
          else return $ sort cache
       withEditor $ assign dynA (NamesCache result)
       return result


    flattenExports :: [LHI.ModuleElem] -> [String]
    flattenExports = concatMap flattenExport

    flattenExport :: LHI.ModuleElem -> [String]
    flattenExport (LHI.Fun x) = [x]
    flattenExport (LHI.Class _ xs) = xs
    flattenExport (LHI.Data _ xs) = xs

------------------- PublishedActions evaluator
newtype PublishedActions = PublishedActions {
    publishedActions_ :: M.HashMap String Action
  } deriving(Typeable, Monoid)
instance Default PublishedActions where def = mempty
makeLensesWithSuffix "A" ''PublishedActions
instance YiConfigVariable PublishedActions

-- | Accessor for the published actions. Consider using 'publishAction'.
publishedActions :: Field (M.HashMap String Action)
publishedActions = customVariable . publishedActions_A

-- | Publish the given action, by the given name. This will overwrite any existing actions by the same name.
publishAction :: (YiAction a x, Show x) => String -> a -> ConfigM ()
publishAction s a = (%=) publishedActions (M.insert s (makeAction a))

{- | Evaluator based on a fixed list of published actions. Has a few differences from 'ghciEvaluator':

  * expressions can't be evaluated

  * all suggested actions are actually valued

  * (related to the above) doesn't contain junk actions from Prelude

  * doesn't require GHCi backend, so uses less memory
-}
publishedActionsEvaluator :: Evaluator
publishedActionsEvaluator = Evaluator{..} where
    getAllNamesInScopeImpl = (M.keys . (^. publishedActions)) <$> askCfg
    execEditorActionImpl s =
        ((M.lookup s . (^. publishedActions)) <$> askCfg) >>=
        maybe (return ()) runAction


------------------- Miscellaneous interpreter

jumpToE :: String -> Int -> Int -> YiM ()
jumpToE filename line column = do
  void $ editFile filename
  withBuffer $ do _ <- gotoLn line
                  moveXorEol column

errorRegex :: Regex
errorRegex = makeRegex "^(.+):([0-9]+):([0-9]+):.*$"

parseErrorMessage :: String -> Maybe (String, Int, Int)
parseErrorMessage ln = do
  (_,result,_) <- matchOnceText errorRegex ln
  let [_,filename,line,col] = take 3 $ map fst $ elems result
  return (filename, read line, read col)

parseErrorMessageB :: BufferM (String, Int, Int)
parseErrorMessageB = do
  ln <- readLnB
  let Just location = parseErrorMessage ln
  return location

jumpToErrorE :: YiM ()
jumpToErrorE = do
  (f,l,c) <- withBuffer parseErrorMessageB
  jumpToE f l c

prompt :: String
prompt = "Yi> "

takeCommand :: String -> String
takeCommand x | prompt `isPrefixOf` x = drop (length prompt) x
              | otherwise = x

consoleKeymap :: Keymap
consoleKeymap = do _ <- event (Event KEnter [])
                   write $ do x <- withBuffer readLnB
                              case parseErrorMessage x of
                                Just (f,l,c) -> jumpToE f l c
                                Nothing -> do withBuffer $ do
                                                p <- pointB
                                                botB
                                                p' <- pointB
                                                when (p /= p') $
                                                   insertN ("\n" ++ prompt ++ takeCommand x)
                                                insertN "\n"
                                                pt <- pointB
                                                insertN prompt
                                                bm <- getBookmarkB "errorInsert"
                                                setMarkPointB bm pt
                                              execEditorAction $ takeCommand x