{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}
-- |
-- Module : Yi.Mode.JavaScript
-- License : GPL-2
-- Maintainer : yi-devel@googlegroups.com
-- Stability : experimental
-- Portability : portable
--
-- Module defining the 'Mode' for JavaScript. 'javaScriptMode' uses
-- the parser defined at "Yi.Syntax.JavaScript".
module Yi.Mode.JavaScript (javaScriptMode, hooks) where
import Lens.Micro.Platform ((%~))
import Control.Monad.Writer.Lazy (execWriter)
import Data.Binary (Binary)
import Data.Default (Default)
import Data.DList as D (toList)
import Data.Foldable as F (toList)
import Data.List (nub)
import Data.Maybe (isJust)
import Data.Monoid ((<>))
import qualified Data.Text as T (unlines)
import Data.Typeable (Typeable)
import System.FilePath.Posix (takeBaseName)
import Yi.Buffer
import Yi.Core (withSyntax)
import Yi.Editor
import Yi.Event (Event (..), Key (..))
import Yi.File (fwriteE)
import Yi.IncrementalParse (scanner)
import Yi.Interact (choice)
import Yi.Keymap (Action (..), YiM, topKeymapA)
import Yi.Keymap.Keys (ctrlCh, important, (?>>), (?>>!))
import Yi.Lexer.Alex (AlexState, CharScanner, Tok, commonLexer, lexScanner)
import Yi.Lexer.JavaScript (HlState, TT, Token, alexScanToken, initState)
import Yi.Mode.Common (anyExtension)
import Yi.Monad (gets)
import qualified Yi.Rope as R (fromString, fromText)
import Yi.String (showT)
import Yi.Syntax (ExtHL (..), Scanner, mkHighlighter)
import Yi.Syntax.JavaScript (Tree, getStrokes, parse)
import Yi.Syntax.Tree (getLastPath)
import Yi.Types (YiVariable)
import Yi.Verifier.JavaScript (verify)
javaScriptAbstract :: Mode syntax
javaScriptAbstract = emptyMode
{ modeApplies = anyExtension ["js"]
, modeName = "javascript"
, modeToggleCommentSelection = Just (toggleCommentB "//")
}
javaScriptMode :: Mode (Tree TT)
javaScriptMode = javaScriptAbstract
{ modeIndent = jsSimpleIndent
, modeHL = ExtHL $ mkHighlighter (scanner parse . jsLexer)
, modeGetStrokes = getStrokes
}
jsSimpleIndent :: Tree TT -> IndentBehaviour -> BufferM ()
jsSimpleIndent t behave = do
indLevel <- shiftWidth <$> indentSettingsB
prevInd <- getNextNonBlankLineB Backward >>= indentOfB
solPnt <- pointAt moveToSol
let path = getLastPath (F.toList t) solPnt
case path of
Nothing -> indentTo [indLevel, 0]
Just _ -> indentTo [prevInd,
prevInd + indLevel,
prevInd - indLevel]
where
-- Given a list of possible columns to indent to, removes any
-- duplicates from it and cycles between the resulting
-- indentations.
indentTo :: [Int] -> BufferM ()
indentTo = cycleIndentsB behave . nub
jsLexer :: CharScanner -> Scanner (AlexState HlState) (Tok Token)
jsLexer = lexScanner (commonLexer alexScanToken initState)
--------------------------------------------------------------------------------
-- tta :: Yi.Lexer.Alex.Tok Token -> Maybe (Yi.Syntax.Span String)
-- tta = sequenceA . tokToSpan . (fmap Main.tokenToText)
-- | Hooks for the JavaScript mode.
hooks :: Mode (Tree TT) -> Mode (Tree TT)
hooks mode = mode
{ modeKeymap = topKeymapA %~ important (choice m)
, modeFollow = YiA . jsCompile
}
where
m = [ ctrlCh 'c' ?>> ctrlCh 'l' ?>>! withSyntax modeFollow
, Event KEnter [] ?>>! newlineAndIndentB
]
newtype JSBuffer = JSBuffer (Maybe BufferRef)
deriving (Default, Typeable, Binary)
instance YiVariable JSBuffer
-- | The "compiler."
jsCompile :: Tree TT -> YiM ()
jsCompile tree = do
_ <- fwriteE
Just filename <- withCurrentBuffer $ gets file
buf <- getJSBuffer
withOtherWindow $ withEditor $ switchToBufferE buf
jsErrors filename buf (D.toList $ execWriter $ verify tree)
-- | Returns the JS verifier buffer, creating it if necessary.
getJSBuffer :: YiM BufferRef
getJSBuffer = withOtherWindow $ do
JSBuffer mb <- withEditor getEditorDyn
case mb of
Nothing -> mkJSBuffer
Just b -> do stillExists <- isJust <$> findBuffer b
if stillExists
then return b
else mkJSBuffer
-- | Creates a new empty buffer and returns it.
mkJSBuffer :: YiM BufferRef
mkJSBuffer = stringToNewBuffer (MemBuffer "js") mempty
-- | Given a filename, a BufferRef and a list of errors, prints the
-- errors in that buffer.
jsErrors :: Show a => String -> BufferRef -> [a] -> YiM ()
jsErrors fname buf errs =
let problems = T.unlines $ map item errs
item x = "* " <> showT x
str = if null errs
then "No problems found!"
else "Problems in "
<> R.fromString (takeBaseName fname)
<> ":\n" <> R.fromText problems
in withGivenBuffer buf (replaceBufferContent str)