module Yi.Eval (
execEditorAction,
getAllNamesInScope,
Evaluator(..),
evaluator,
ghciEvaluator,
publishedActionsEvaluator,
publishedActions,
publishAction,
jumpToErrorE,
jumpToE,
consoleKeymap
) where
import Control.Applicative ((<$>), (<*>))
import Control.Lens hiding (Action)
import Control.Monad hiding (mapM_)
import Data.Array
import Data.Binary
import Data.Default
import Data.Foldable (mapM_)
import qualified Data.HashMap.Strict as M
import Data.List
import Data.Monoid
import Data.Typeable
import qualified Language.Haskell.Interpreter as LHI
import Prelude hiding (error, mapM_)
import System.Directory (doesFileExist)
import Text.Read (readMaybe)
import Yi.Boot.Internal (reload)
import Yi.Buffer
import Yi.Config.Simple.Types
import Yi.Core (errorEditor, runAction)
import Yi.Debug
import Yi.Types (YiVariable,YiConfigVariable)
import Yi.Editor
import Yi.File
import Yi.Hooks
import Yi.Keymap
import Yi.Keymap.Keys
import qualified Yi.Paths (getEvaluatorContextFilename)
import Yi.Regex
import qualified Yi.Rope as R
import Yi.String
import Yi.Utils
execEditorAction :: String -> YiM ()
execEditorAction = runHook execEditorActionImpl
getAllNamesInScope :: YiM [String]
getAllNamesInScope = runHook getAllNamesInScopeImpl
data Evaluator = Evaluator
{ execEditorActionImpl :: String -> YiM ()
, getAllNamesInScopeImpl :: YiM [String]
} deriving (Typeable)
evaluator :: Field Evaluator
evaluator = customVariable
instance Default Evaluator where def = ghciEvaluator
instance YiConfigVariable Evaluator
newtype NamesCache = NamesCache [String] deriving (Typeable, Binary)
instance Default NamesCache where
def = NamesCache []
instance YiVariable NamesCache
ghciEvaluator :: Evaluator
ghciEvaluator = Evaluator { execEditorActionImpl = execAction
, getAllNamesInScopeImpl = getNames
}
where
execAction :: String -> YiM ()
execAction "reload" = reload
execAction 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
]]
when haveUserContext $ do
LHI.loadModules [contextFile]
LHI.setTopLevelModules ["Env"]
LHI.setImportsQ [("Yi", Nothing), ("Yi.Keymap",Just "Yi.Keymap")]
LHI.interpret ("Yi.makeAction (" ++ s ++ ")") (error "as" :: Action)
case res of
Left err -> errorEditor (showT err)
Right action -> runAction action
getNames :: YiM [String]
getNames = do
NamesCache cache <- withEditor $ getEditorDyn
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 $ putEditorDyn $ 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
newtype PublishedActions = PublishedActions {
_publishedActions :: M.HashMap String Action
} deriving(Typeable, Monoid)
instance Default PublishedActions where def = mempty
makeLensesWithSuffix "A" ''PublishedActions
instance YiConfigVariable PublishedActions
publishedActions :: Field (M.HashMap String Action)
publishedActions = customVariable . _publishedActionsA
publishAction :: (YiAction a x, Show x) => String -> a -> ConfigM ()
publishAction s a = publishedActions %= M.insert s (makeAction a)
publishedActionsEvaluator :: Evaluator
publishedActionsEvaluator = Evaluator
{ getAllNamesInScopeImpl = askCfg <&> M.keys . (^. publishedActions)
, execEditorActionImpl = \s ->
askCfg <&> M.lookup s . (^. publishedActions) >>= mapM_ runAction
}
jumpToE :: FilePath
-> Int
-> Int
-> YiM ()
jumpToE filename line column =
openingNewFile filename $ gotoLn line >> moveXorEol column
errorRegex :: Regex
errorRegex = makeRegex ("^(.+):([0-9]+):([0-9]+):.*$" :: String)
parseErrorMessage :: R.YiString -> Maybe (String, Int, Int)
parseErrorMessage ln = do
(_ ,result, _) <- matchOnceText errorRegex (R.toString ln)
case take 3 $ map fst $ elems result of
[_, fname, l, c] -> (,,) <$> return fname <*> readMaybe l <*> readMaybe c
_ -> Nothing
parseErrorMessageB :: BufferM (Maybe (String, Int, Int))
parseErrorMessageB = parseErrorMessage <$> readLnB
jumpToErrorE :: YiM ()
jumpToErrorE = withCurrentBuffer parseErrorMessageB >>= \case
Nothing -> printMsg "Couldn't parse out an error message."
Just (f, l, c) -> jumpToE f l c
prompt :: R.YiString
prompt = "Yi> "
takeCommand :: R.YiString -> R.YiString
takeCommand t = case R.splitAt (R.length prompt) t of
(f, s) -> if f == prompt then s else t
consoleKeymap :: Keymap
consoleKeymap = do
_ <- event (Event KEnter [])
write $ withCurrentBuffer readLnB >>= \x -> case parseErrorMessage x of
Just (f,l,c) -> jumpToE f l c
Nothing -> do
withCurrentBuffer $ do
p <- pointB
botB
p' <- pointB
when (p /= p') $ insertN ("\n" <> prompt <> takeCommand x)
insertN "\n"
pt <- pointB
insertN prompt
bm <- getBookmarkB "errorInsert"
markPointA bm .= pt
execEditorAction . R.toString $ takeCommand x