Shim.hs

module Yi.Mode.Shim where

import Control.Monad.State
import Data.Char
import Data.List
import qualified Data.List.PointedList.Circular as PL
import FastString
import Outputable hiding (char)

import Shim.Hsinfo as Hsinfo
import SrcLoc
import Yi
import Yi.Buffer
import Yi.GHC

import qualified Shim.Hsinfo as Hsinfo

jumpToSrcLoc :: SrcLoc -> YiM ()
jumpToSrcLoc locn =
    if isGoodSrcLoc locn
       then jumpToE (unpackFS $ srcLocFile locn) (srcLocLine locn) (srcLocCol locn)
       else msgEditor $ show (ppr locn defaultUserStyle)

jumpToNextNote :: YiM ()
jumpToNextNote = do
  note <- withEditor $ do
    (%=) notesA (fmap PL.next)
    uses notesA (fmap PL.focus)
  case note of
    Nothing -> msgEditor "No note!"
    Just n -> jumpToSrcLoc $ srcSpanStart $ srcSpan n

-- | Position of the cursor
cursorPos :: BufferM (Maybe String, Int, Int)
cursorPos = (,,) <$> gets file <*> curLn <*> curCol

-- | Type of the symbol at current position
typeAtPos :: YiM String
typeAtPos = do
  (Just filename,line,col) <- withBuffer cursorPos
  withShim $ Hsinfo.findTypeOfPos filename line col Nothing

-- | Annotate the current function with its type
annotType :: YiM ()
annotType = do
  t <- typeAtPos
  withBuffer $ do
     moveToSol
     insertN $ t ++ "\n"

-- | Update a line of the form "-- expr = value" with the new value of expr
annotValue :: YiM ()
annotValue = do
  lnReg <- withBuffer $ regionOfB Yi.Line
  Just sourcefile <- withBuffer $ gets file
  ln <- withBuffer $ readRegionB lnReg
  let lhs = takeWhile (/= '=') $ dropWhile (== '-') $ dropWhile isSpace ln
  newVal <- withShim $ do
               ses <- getSessionFor sourcefile
               evaluate ses lhs
  withBuffer $ replaceRegionB lnReg ("--" ++ lhs ++ "= " ++ newVal)

jumpToDefinition :: YiM ()
jumpToDefinition = do
  (Just filename,line,col) <- withBuffer cursorPos
  locn <- withShim $ Hsinfo.findDefinition filename line col Nothing
  jumpToSrcLoc locn

-- NOTE: source argument to Hsinfo functions can be used to provide
-- source text, apparently.
minorMode :: Mode syntax -> Mode syntax
minorMode m = m
   {
    modeName = modeName m ++ "+shim",
    modeKeymap = modeKeymap m . (<||)
      ((ctrl (char 'c') ?>> choice
       [ctrl (char 't') ?>>! typeAtPos,
        char '!' ?>> char 't' ?>>! annotType,
        char '!' ?>> char '=' ?>>! annotType,
        ctrl (char 'd') ?>>! jumpToDefinition,
        ctrl (char 'l') ?>>! do
            withEditor $ withOtherWindow $ switchToBufferWithNameE "*messages*"
            msgEditor "Loading..."
            Just filename <- withBuffer $ gets file
            runShimThread $ void (Hsinfo.load filename True Nothing)
            return ()
         ]
       ) <|> (ctrl (char 'x') ?>> char '`' ?>>! jumpToNextNote))
   }