yi-mode-javascript (empty) → 0.13
raw patch · 7 files changed
+1198/−0 lines, 7 filesdep +arraydep +basedep +binarysetup-changed
Dependencies added: array, base, binary, data-default, dlist, filepath, microlens-platform, mtl, text, yi-core, yi-language, yi-rope
Files
- Setup.hs +4/−0
- src/Yi/Config/Default/JavaScriptMode.hs +10/−0
- src/Yi/Lexer/JavaScript.x +281/−0
- src/Yi/Mode/JavaScript.hs +142/−0
- src/Yi/Syntax/JavaScript.hs +590/−0
- src/Yi/Verifier/JavaScript.hs +124/−0
- yi-mode-javascript.cabal +47/−0
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main :: IO ()+main = defaultMain
+ src/Yi/Config/Default/JavaScriptMode.hs view
@@ -0,0 +1,10 @@+module Yi.Config.Default.JavaScriptMode (configureJavaScriptMode) where++import Lens.Micro.Platform ((%=))+import Yi.Mode.JavaScript+import Yi.Config.Simple (ConfigM)+import Yi.Config.Lens (modeTableA)+import Yi.Types (AnyMode (..))++configureJavaScriptMode :: ConfigM ()+configureJavaScriptMode = modeTableA %= (AnyMode (hooks javaScriptMode) :)
+ src/Yi/Lexer/JavaScript.x view
@@ -0,0 +1,281 @@+-- -*- haskell -*-+--+-- Simple lexer for JavaScript 1.7+-- (C) Copyright 2009 Deniz Dogan+--+-- Note that this mode is for JavaScript 1.7, i.e. Mozilla, not ECMAScript, nor+-- JScript, but it does take much of its information from the ECMAScript+-- specification.+--+-- Things about JavaScript deserve to be mentioned:+-- * JavaScript explicitly forbids nested comments, so we don't have to care+-- about the "level" of nesting in multiline comments+-- * JavaScript supports making variables for which the name clashes with+-- constructors, e.g. Array, but you cannot use "new Array()" to create an+-- array if you do that.+--+-- Sources for reserved words:+-- https://developer.mozilla.org/En/Core_JavaScript_1.5_Reference/Reserved_Words+-- https://developer.mozilla.org/en/New_in_JavaScript_1.6+-- https://developer.mozilla.org/en/New_in_JavaScript_1.7+--+-- Sources for the general syntax:+-- http://en.wikipedia.org/wiki/JavaScript_syntax+-- http://www.ecma-international.org/publications/files/ECMA-ST/Ecma-262.pdf++{+#define NO_ALEX_CONTEXTS+{-# OPTIONS -w #-}++module Yi.Lexer.JavaScript ( initState, alexScanToken, tokenToStyle,+ TT, Token(..), Reserved(..), Operator(..),+ HlState, prefixOperators, infixOperators,+ postfixOperators ) where++import Data.Monoid (Endo(..))+import Yi.Lexer.Alex hiding (tokenToStyle)+import Yi.Style++}++$whitechar = [\ \t\n\r\f\v]++@builtin = true | false | null | undefined+@reservedid = break | case | catch | continue | default | delete | do | else+ | finally | for | function | if | in | instanceof | new | return+ | switch | this | throw | try | typeof | var | void | while | with+ | @builtin++@ops = "+" | "-" | "*" | "/" | "%" | "++" | "--" | "=" | "+="+ | "-=" | "*=" | "/=" | "%=" | "==" | "!=" | ">" | ">=" | "<"+ | "<=" | "===" | "!==" | "&&" |"||" | "!" | "&" | "|" | "^"+ | "<<" | ">>" | ">>>" | "~" | "."++$large = [A-Z \xc0-\xd6 \xd8-\xde]+$small = [a-z \xdf-\xf6 \xf8-\xff]+$special = [\(\)\,\;\[\]\{\}\:\?]++$digit = 0-9+$hexit = [0-9 A-F a-f]+@decimal = $digit++@hexal = "0x" $hexit+++$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\@\\\^\|\-\~\_]+$unisymbol = [] -- TODO+$symbol = [$ascsymbol $unisymbol] # [$special \:\"\']+$graphic = [$small $large $symbol $digit $special \:\"\']+$name = [a-zA-Z0-9\_\$] -- Valid characters for a "name"++-- Octals are sort of "implicit" in JavaScript. "0307" is a valid octal, but+-- "0309" is the exact same thing as "309." Since we don't make any distinction+-- between different types of numbers, we completely disregard octals here, they+-- Just Work (tm).+@number = @decimal | @hexal+@gap = \\ $whitechar+@string1 = $graphic # [\"\\] | " " | @gap+@string2 = $graphic # [\'\\] | " " | @gap++-- @varid represents valid names for variables and functions.+@varid = [$name # [0-9A-Z]] $name*+@const = [$name # [0-9a-z]] $name* -- Constants and constructors++haskell :-++<0> {++$whitechar+ ;+$special { cs $ (Special . head) } -- All of the special symbols are characters++@number { cs $ Number }+@ops { cs $ (Op . opToOp) }+@reservedid { cs $ (Res . resToRes) }+@varid { cs $ ValidName }+@const { cs $ Const }++\" @string1* \" { cs $ Str }+\' @string2* \' { cs $ Str }+\/ [^\/]+ \/ { cs $ Rex }+"//".* { c $ Comment Line }+"/*" { m (subtract 1) $ Comment Start }+"<!--" { m (+1) $ Comment Start }++. { c $ Unknown }++}++<multicomm> {+"*/" { m (+1) $ Comment End }+$whitechar+ ;+[^\*]+ { c $ Comment Text }+. { c $ Comment Text }+}++<htmlcomm> {+"-->" { m (subtract 1) $ Comment End }+$whitechar+ ;+[^\-] { c $ Comment Text }+. { c $ Comment Text }+}+++{++type TT = Tok Token++-- | The @Line@ constructor represents a single-line comment. @Start@ and @End@+-- represent the start and end of a multi-line comment, respectively. @Text@+-- represents the text in a multi-line comment.+data CommentType = Line | Start | End | Text+ deriving (Show, Eq)++-- | The constructors for @Reserved@ have an apostrophe as a suffix because+-- @Default@ is already used. Also note that @Undefined'@ is not intended as+-- some sort of "backup" reserved word for things we don't care about -- it+-- really means the "undefined" built-in in JavaScript.+data Reserved = Break' | Case' | Catch' | Continue' | Default' | Delete' | Do'+ | Else' | Finally' | For' | Function' | If' | In' | InstanceOf'+ | New' | Return' | Switch' | This' | Throw' | Try' | TypeOf'+ | Var' | Void' | While' | With' | True' | False' | Null'+ | Undefined'+ deriving (Show, Eq)++-- | The constructors for @Operator@ have an apostrophe as a suffix because+-- e.g. @LT@ is already used by @Prelude@.+data Operator = Add' | Subtract' | Multiply' | Divide' | Modulo' | Increment'+ | Decrement' | Assign' | AddAssign' | SubtractAssign'+ | MultiplyAssign' | DivideAssign' | ModuloAssign' | Equals'+ | NotEquals' | GT' | GTE' | LT' | LTE' | EqualsType'+ | NotEqualsType' | And' | Or' | Not' | BitAnd' | BitOr' | BitXor'+ | LeftShift' | RightShift' | RightShiftZ' | BitNot' | Qualify'+ deriving (Show, Eq)++-- | Prefix operators. NOTE: Add' is also a valid prefix operator, but since+-- it's completely useless in the real world, we don't care about it here.+-- Doing this makes parsing much, much easier.+prefixOperators = [ Subtract', Increment', Decrement', BitNot', Not' ]++-- | Postfix operators.+postfixOperators = [ Increment', Decrement' ]++-- | Infix operators.+infixOperators = [ Add', Subtract', Multiply', Divide', Modulo', Assign',+ AddAssign', SubtractAssign', MultiplyAssign', DivideAssign',+ ModuloAssign', Equals', NotEquals', GT', GTE', LT', LTE',+ EqualsType', NotEqualsType', And', Or', BitAnd', BitOr',+ BitXor', LeftShift', RightShift', RightShiftZ', Qualify' ]++-- | @HlState@ is 0 when outside of a multi-line comment and -1 when inside one.+type HlState = Int++-- | The different tokens.+data Token = Unknown+ | Res !Reserved+ | Str !String+ | Rex !String+ | Op !Operator+ | Special !Char+ | Number !String+ | ValidName !String+ | Comment !CommentType+ | Const !String+ deriving (Show, Eq)++stateToInit x | x < 0 = multicomm+ | x > 0 = htmlcomm+ | otherwise = 0++initState :: HlState+initState = 0++-- | Takes a 'Token' and returns a style to be used for that type of token.+--+-- TODO: The `elem` check is potentially unnecessarily slow. We could split+-- the Const constructor into two different ones, one for builtins and one for+-- others.+tokenToStyle (Comment Line) = commentStyle+tokenToStyle (Comment _) = blockCommentStyle+tokenToStyle (Const x) | x `elem` builtinConstructors = builtinStyle+ | otherwise = typeStyle+tokenToStyle (Number _) = numberStyle+tokenToStyle (Res _) = keywordStyle+tokenToStyle (Str _) = stringStyle+tokenToStyle (Rex _) = regexStyle+tokenToStyle Unknown = errorStyle+tokenToStyle _ = defaultStyle++builtinConstructors :: [String]+builtinConstructors = [ "Array", "String", "RegExp", "Function", "Date"+ , "Boolean", "Object" ]++-- | Given a @String@ representing an operator, returns an 'Operator' with the+-- appropriate constructor.+opToOp :: String -> Operator+opToOp "+" = Add'+opToOp "-" = Subtract'+opToOp "*" = Multiply'+opToOp "/" = Divide'+opToOp "%" = Modulo'+opToOp "++" = Increment'+opToOp "--" = Decrement'+opToOp "=" = Assign'+opToOp "+=" = AddAssign'+opToOp "-=" = SubtractAssign'+opToOp "*=" = MultiplyAssign'+opToOp "/=" = DivideAssign'+opToOp "%=" = ModuloAssign'+opToOp "==" = Equals'+opToOp "!=" = NotEquals'+opToOp ">" = GT'+opToOp ">=" = GTE'+opToOp "<" = LT'+opToOp "<=" = LTE'+opToOp "===" = EqualsType'+opToOp "!==" = NotEqualsType'+opToOp "&&" = And'+opToOp "||" = Or'+opToOp "!" = Not'+opToOp "&" = BitAnd'+opToOp "|" = BitOr'+opToOp "^" = BitXor'+opToOp "<<" = LeftShift'+opToOp ">>" = RightShift'+opToOp ">>>" = RightShiftZ'+opToOp "~" = BitNot'+opToOp "." = Qualify'++-- | Given a @String@ representing a reserved word, returns a 'Reserved' with+-- the appropriate constructor.+resToRes :: String -> Reserved+resToRes "break" = Break'+resToRes "case" = Case'+resToRes "catch" = Catch'+resToRes "continue" = Continue'+resToRes "default" = Default'+resToRes "delete" = Delete'+resToRes "do" = Do'+resToRes "else" = Else'+resToRes "finally" = Finally'+resToRes "for" = For'+resToRes "function" = Function'+resToRes "if" = If'+resToRes "in" = In'+resToRes "instanceof" = InstanceOf'+resToRes "new" = New'+resToRes "return" = Return'+resToRes "switch" = Switch'+resToRes "this" = This'+resToRes "throw" = Throw'+resToRes "try" = Try'+resToRes "typeof" = TypeOf'+resToRes "var" = Var'+resToRes "void" = Void'+resToRes "while" = While'+resToRes "with" = With'+resToRes "true" = True'+resToRes "false" = False'+resToRes "null" = Null'+resToRes "undefined" = Undefined'++#include "common.hsinc"++}
+ src/Yi/Mode/JavaScript.hs view
@@ -0,0 +1,142 @@+{-# 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)
+ src/Yi/Syntax/JavaScript.hs view
@@ -0,0 +1,590 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Syntax.JavaScript+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- Parser for the JavaScript language as described at+-- <http://publications.lib.chalmers.se/records/fulltext/112284.pdf Dogan 2009>.+--+-- The mode using this parser can be found at "Yi.Mode.JavaScript".++module Yi.Syntax.JavaScript where++import Prelude hiding (elem,error,any,exp)++import Control.Applicative (Alternative ((<|>), many), optional)+import Data.Data (Data)+import Data.Foldable (any, elem, toList)+import Data.Monoid (Endo (..), (<>))+import qualified Data.Text as T (cons)+import Data.Typeable (Typeable)+import Yi.Buffer.Basic (Point (..))+import Yi.Debug (trace)+import Yi.IncrementalParse (P, eof, recoverWith, symbol)+import Yi.Lexer.Alex (Stroke, Tok (..), tokFromT, tokToSpan)+import Yi.Lexer.JavaScript+import Yi.String (showT)+import Yi.Style (StyleName, errorStyle)+import Yi.Syntax.Tree (IsTree (..), sepBy, sepBy1)++-- * Data types, classes and instances++-- | Instances of @Strokable@ are datatypes which can be syntax highlighted.+class Strokable a where+ toStrokes :: a -> Endo [Stroke]++-- | Instances of @Failable@ can represent failure. This is a useful class for+-- future work, since then we can make stroking much easier.+class Failable f where+ stupid :: t -> f t+ hasFailed :: f t -> Bool++type BList a = [a]++type Tree t = BList (Statement t)++type Semicolon t = Maybe t++data Statement t = FunDecl t t (Parameters t) (Block t)+ | VarDecl t (BList (VarDecAss t)) (Semicolon t)+ | Return t (Maybe (Expr t)) (Semicolon t)+ | While t (ParExpr t) (Block t)+ | DoWhile t (Block t) t (ParExpr t) (Semicolon t)+ | For t t (Expr t) (ForContent t) t (Block t)+ | If t (ParExpr t) (Block t) (Maybe (Statement t))+ | Else t (Block t)+ | With t (ParExpr t) (Block t)+ | Comm t+ | Expr (Expr t) (Semicolon t)+ deriving (Show, Data, Typeable, Foldable)++data Parameters t = Parameters t (BList t) t+ | ParErr t+ deriving (Show, Data, Typeable, Foldable)++data ParExpr t = ParExpr t (BList (Expr t)) t+ | ParExprErr t+ deriving (Show, Data, Typeable, Foldable)++data ForContent t = ForNormal t (Expr t) t (Expr t)+ | ForIn t (Expr t)+ | ForErr t+ deriving (Show, Data, Typeable, Foldable)++data Block t = Block t (BList (Statement t)) t+ | BlockOne (Statement t)+ | BlockErr t+ deriving (Show, Data, Typeable, Foldable)++-- | Represents either a variable name or a variable name assigned to an+-- expression. @AssBeg@ is a variable name /maybe/ followed by an assignment.+-- @AssRst@ is an equals sign and an expression. @(AssBeg 'x' (Just (AssRst+-- '=' '5')))@ means @x = 5@.+data VarDecAss t = AssBeg t (Maybe (VarDecAss t))+ | AssRst t (Expr t)+ | AssErr t+ deriving (Show, Data, Typeable, Foldable)++data Expr t = ExprObj t (BList (KeyValue t)) t+ | ExprPrefix t (Expr t)+ | ExprNew t (Expr t)+ | ExprSimple t (Maybe (Expr t))+ | ExprParen t (Expr t) t (Maybe (Expr t))+ | ExprAnonFun t (Parameters t) (Block t)+ | ExprTypeOf t (Expr t)+ | ExprFunCall t (ParExpr t) (Maybe (Expr t))+ | OpExpr t (Expr t)+ | ExprCond t (Expr t) t (Expr t)+ | ExprArr t (Maybe (Array t)) t (Maybe (Expr t))+ | PostExpr t+ | ExprErr t+ deriving (Show, Data, Typeable, Foldable)++data Array t = ArrCont (Expr t) (Maybe (Array t))+ | ArrRest t (Array t) (Maybe (Array t))+ | ArrErr t+ deriving (Show, Data, Typeable, Foldable)++data KeyValue t = KeyValue t t (Expr t)+ | KeyValueErr t+ deriving (Show, Data, Typeable, Foldable)+++instance IsTree Statement where+ subtrees (FunDecl _ _ _ x) = fromBlock x+ subtrees (While _ _ x) = fromBlock x+ subtrees (DoWhile _ x _ _ _) = fromBlock x+ subtrees (For _ _ _ _ _ x) = fromBlock x+ subtrees (If _ _ x mb) = fromBlock x <> maybe [] subtrees mb+ subtrees (Else _ x) = fromBlock x+ subtrees (With _ _ x) = fromBlock x+ subtrees _ = []++instance Failable ForContent where+ stupid = ForErr+ hasFailed t = case t of+ ForErr _ -> True+ _ -> False++instance Failable Block where+ stupid = BlockErr+ hasFailed t = case t of+ BlockErr _ -> True+ _ -> False++instance Failable VarDecAss where+ stupid = AssErr+ hasFailed t = case t of+ AssErr _ -> True+ _ -> False++instance Failable Parameters where+ stupid = ParErr+ hasFailed t = case t of+ ParErr _ -> True+ _ -> False++instance Failable ParExpr where+ stupid = ParExprErr+ hasFailed t = case t of+ ParExprErr _ -> True+ _ -> False++instance Failable Expr where+ stupid = ExprErr+ hasFailed t = case t of+ ExprErr _ -> True+ _ -> False++instance Failable KeyValue where+ stupid = KeyValueErr+ hasFailed t = case t of+ KeyValueErr _ -> True+ _ -> False+++-- | TODO: This code is *screaming* for some generic programming.+--+-- TODO: Somehow fix Failable and failStroker to be more "generic". This will+-- make these instances much nicer and we won't have to make ad-hoc stuff like+-- this.+instance Strokable (Statement TT) where+ toStrokes (FunDecl f n ps blk) =+ let s = if hasFailed blk then error else failStroker [n] in+ s f <> s n <> toStrokes ps <> toStrokes blk+ toStrokes (VarDecl v vs sc) =+ let s = if any hasFailed vs then error else normal in+ s v <> foldMap toStrokes vs <> maybe mempty s sc+ toStrokes (Return t exp sc) = normal t <> maybe mempty toStrokes exp <> maybe mempty normal sc+ toStrokes (While w exp blk) =+ let s = if hasFailed blk || hasFailed blk then error else normal in+ s w <> toStrokes exp <> toStrokes blk+ toStrokes (DoWhile d blk w exp sc) =+ let s1 = if hasFailed blk then error else normal+ s2 = if hasFailed exp then error else normal in+ s1 d <> toStrokes blk <> s2 w <> toStrokes exp <> maybe mempty normal sc+ toStrokes (For f l x c r blk) =+ let s = if hasFailed blk || hasFailed c || hasFailed x+ then error+ else failStroker [f, l, r] in+ s f <> s l <> toStrokes x <> toStrokes c <> s r <> toStrokes blk+ toStrokes (If i x blk e) =+ let s = if hasFailed blk then error else normal in+ s i <> toStrokes x <> toStrokes blk <> maybe mempty toStrokes e+ toStrokes (Else e blk) = normal e <> toStrokes blk+ toStrokes (With w x blk) = normal w <> toStrokes x <> toStrokes blk+ toStrokes (Expr exp sc) = toStrokes exp <> maybe mempty normal sc+ toStrokes (Comm t) = normal t++instance Strokable (ForContent TT) where+ toStrokes (ForNormal s1 x2 s2 x3) =+ let s = if any hasFailed [x2, x3] then error else failStroker [s2] in+ s s1 <> toStrokes x2 <> s s2 <> toStrokes x3+ toStrokes (ForIn i x) =+ let s = if hasFailed x then error else normal in+ s i <> toStrokes x+ toStrokes (ForErr t) = error t++instance Strokable (Block TT) where+ toStrokes (BlockOne stmt) = toStrokes stmt+ toStrokes (Block l stmts r) =+ let s = failStroker [l, r] in+ s l <> foldMap toStrokes stmts <> s r+ toStrokes (BlockErr t) = error t++instance Strokable (VarDecAss TT) where+ toStrokes (AssBeg t x) = normal t <> maybe mempty toStrokes x+ toStrokes (AssRst t exp) =+ let s = if hasFailed exp then error else normal in+ s t <> toStrokes exp+ toStrokes (AssErr t) = error t++instance Strokable (Expr TT) where+ toStrokes (ExprSimple x exp) = normal x <> maybe mempty toStrokes exp+ toStrokes (ExprObj l kvs r) =+ let s = failStroker [l, r] in+ s l <> foldMap toStrokes kvs <> s r+ toStrokes (ExprPrefix t exp) = normal t <> toStrokes exp+ toStrokes (ExprNew t x) = normal t <> toStrokes x+ toStrokes (ExprParen l exp r op) =+ let s = failStroker [l, r] in+ s l <> toStrokes exp <> s r <> maybe mempty toStrokes op+ toStrokes (ExprAnonFun f ps blk) =+ normal f <> toStrokes ps <> toStrokes blk+ toStrokes (ExprTypeOf t x) =+ let s = if hasFailed x then error else normal in+ s t <> toStrokes x+ toStrokes (ExprFunCall n x m) =+ let s = if hasFailed x then error else normal in+ s n <> toStrokes x <> maybe mempty toStrokes m+ toStrokes (OpExpr op exp) =+ let s = if hasFailed exp then error else normal in+ s op <> toStrokes exp+ toStrokes (PostExpr t) = normal t+ toStrokes (ExprCond a x b y) =+ let s = failStroker [a, b] in+ s a <> toStrokes x <> s b <> toStrokes y+ toStrokes (ExprArr l x r m) =+ let s = failStroker [l, r] in+ s l <> maybe mempty toStrokes x <> s r <> maybe mempty toStrokes m+ toStrokes (ExprErr t) = error t++instance Strokable (Parameters TT) where+ toStrokes (Parameters l ps r) = normal l <> foldMap toStrokes ps <> normal r+ toStrokes (ParErr t) = error t++instance Strokable (ParExpr TT) where+ toStrokes (ParExpr l xs r) =+ let s = if isError r || any hasFailed xs+ then error+ else normal in+ s l <> foldMap toStrokes xs <> s r+ toStrokes (ParExprErr t) = error t++instance Strokable (KeyValue TT) where+ toStrokes (KeyValue n c exp) =+ let s = failStroker [n, c] in+ s n <> s c <> toStrokes exp+ toStrokes (KeyValueErr t) = error t++instance Strokable (Tok Token) where+ toStrokes t = if isError t+ then one (modStroke errorStyle . tokenToStroke) t+ else one tokenToStroke t++instance Strokable (Array TT) where+ toStrokes (ArrCont x m) = toStrokes x <> maybe mempty toStrokes m+ toStrokes (ArrRest c a m) = normal c <> toStrokes a <> maybe mempty toStrokes m+ toStrokes (ArrErr t) = error t+++-- * Helper functions.++-- | Normal stroker.+normal :: TT -> Endo [Stroke]+normal = one tokenToStroke++-- | Error stroker.+error :: TT -> Endo [Stroke]+error = one (modStroke errorStyle . tokenToStroke)++one :: (t -> a) -> t -> Endo [a]+one f x = Endo (f x :)++-- | Given a new style and a stroke, return a stroke with the new style appended+-- to the old one.+modStroke :: StyleName -> Stroke -> Stroke+modStroke style = fmap (style <>)+++-- * Stroking functions++-- | Given a list of tokens to check for errors (@xs@) and a list of tokens to+-- stroke (@xs'@), returns normal strokes for @xs'@ if there were no errors.+-- Otherwise returns error strokes for @xs'@.+nError :: [TT] -> [TT] -> Endo [Stroke]+nError xs = foldMap (failStroker xs)++-- | Given a list of @TT@, if any of them is an error, returns an error stroker,+-- otherwise a normal stroker. Using e.g. existentials, we could make this+-- more general and have support for heterogeneous lists of elements which+-- implement Failable, but I haven't had the time to fix this.+failStroker :: [TT] -> TT -> Endo [Stroke]+failStroker xs = if any isError xs then error else normal++-- | Given a @TT@, return a @Stroke@ for it.+tokenToStroke :: TT -> Stroke+tokenToStroke = fmap tokenToStyle . tokToSpan++-- | The main stroking function.+getStrokes :: Tree TT -> Point -> Point -> Point -> [Stroke]+getStrokes t0 _point _begin _end = trace ('\n' `T.cons` showT t0) result+ where+ result = appEndo (foldMap toStrokes t0) []+++-- * The parser++-- | Main parser.+parse :: P TT (Tree TT)+parse = many statement <* eof++-- | Parser for statements such as "return", "while", "do-while", "for", etc.+statement :: P TT (Statement TT)+statement = FunDecl <$> res Function' <*> plzTok name <*> parameters <*> block+ <|> VarDecl <$> res Var' <*> plz varDecAss `sepBy1` spc ',' <*> semicolon+ <|> Return <$> res Return' <*> optional expression <*> semicolon+ <|> While <$> res While' <*> parExpr <*> block+ <|> DoWhile <$> res Do' <*> block <*> plzTok (res While') <*> parExpr <*> semicolon+ <|> For <$> res For' <*> plzSpc '(' <*> plzExpr <*> forContent+ <*> plzSpc ')' <*> block+ <|> If <$> res If' <*> parExpr <*> block <*> optional (Else <$> res Else' <*> block)+ <|> With <$> res With' <*> parExpr <*> block+ <|> Comm <$> comment+ <|> Expr <$> stmtExpr <*> semicolon+ where+ forContent :: P TT (ForContent TT)+ forContent = ForNormal <$> spc ';' <*> plzExpr <*> plzSpc ';' <*> plzExpr+ <|> ForIn <$> res In' <*> plzExpr+ <|> ForErr <$> hate 1 (symbol (const True))+ <|> ForErr <$> hate 2 (pure errorToken)+ varDecAss :: P TT (VarDecAss TT)+ varDecAss = AssBeg <$> name <*> optional (AssRst <$> oper Assign' <*> plzExpr)++-- | Parser for "blocks", i.e. a bunch of statements wrapped in curly brackets+-- /or/ just a single statement.+--+-- Note that this works for JavaScript 1.8 "lambda" style function bodies as+-- well, e.g. "function hello() 5", since expressions are also statements and+-- we don't require a trailing semi-colon.+--+-- TODO: function hello() var x; is not a valid program.+block :: P TT (Block TT)+block = Block <$> spc '{' <*> many statement <*> plzSpc '}'+ <|> BlockOne <$> hate 1 statement+ <|> BlockErr <$> hate 2 (pure errorToken)++-- | Parser for expressions which may be statements. In reality, any expression+-- is also a valid statement, but this is a slight compromise to get rid of+-- the massive performance loss which is introduced when allowing JavaScript+-- objects to be valid statements.+stmtExpr :: P TT (Expr TT)+stmtExpr = ExprSimple <$> simpleTok <*> optional opExpr+ <|> ExprPrefix <$> preOp <*> plzExpr+ <|> ExprNew <$> res New' <*> plz funCall+ <|> funCall+ -- We hate the parenthesized expression just a tad because otherwise+ -- confirm('hello') will be seen as "confirm; ('hello');"+ <|> hate 1 (ExprParen <$> spc '(' <*> plzExpr <*> plzSpc ')'+ <*> optional opExpr)+ <|> ExprErr <$> hate 2 (symbol (const True))+ where+ funCall :: P TT (Expr TT)+ funCall = ExprFunCall <$> name <*> parExpr <*> optional opExpr++-- | The basic idea here is to parse "the rest" of expressions, e.g. @+ 3@ in @x+-- + 3@ or @[i]@ in @x[i]@. Anything which is useful in such a scenario goes+-- here. TODO: This accepts [], but shouldn't, since x[] is invalid.+opExpr :: P TT (Expr TT)+opExpr = OpExpr <$> inOp <*> plzExpr+ <|> ExprCond <$> spc '?' <*> plzExpr <*> plzSpc ':' <*> plzExpr+ <|> PostExpr <$> postOp+ <|> array++-- | Parser for expressions.+expression :: P TT (Expr TT)+expression = ExprObj <$> spc '{' <*> keyValue `sepBy` spc ',' <*> plzSpc '}'+ <|> ExprAnonFun <$> res Function' <*> parameters <*> block+ <|> ExprTypeOf <$> res TypeOf' <*> plzExpr+ <|> stmtExpr+ <|> array+ where+ keyValue :: P TT (KeyValue TT)+ keyValue = KeyValue <$> name <*> plzSpc ':' <*> plzExpr+ <|> KeyValueErr <$> hate 1 (symbol (const True))+ <|> KeyValueErr <$> hate 2 (pure errorToken)++-- | Parses both empty and non-empty arrays. Should probably be split up into+-- further parts to allow for the separation of @[]@ and @[1, 2, 3]@.+array :: P TT (Expr TT)+array = ExprArr <$> spc '[' <*> optional arrayContents <*> plzSpc ']'+ <*> optional opExpr+ where+ arrayContents :: P TT (Array TT)+ arrayContents = ArrCont <$> expression <*> optional arrRest+ arrRest :: P TT (Array TT)+ arrRest = ArrRest <$> spc ',' <*> (arrayContents+ <|> ArrErr <$> hate 1 (symbol (const True))+ <|> ArrErr <$> hate 2 (pure errorToken))+ <*> optional arrRest+++-- * Parsing helpers++-- | Parses a semicolon if it's there.+semicolon :: P TT (Maybe TT)+semicolon = optional $ spc ';'++-- | Parses a comma-separated list of valid identifiers.+parameters :: P TT (Parameters TT)+parameters = Parameters <$> spc '(' <*> plzTok name `sepBy` spc ',' <*> plzSpc ')'+ <|> ParErr <$> hate 1 (symbol (const True))+ <|> ParErr <$> hate 2 (pure errorToken)++parExpr :: P TT (ParExpr TT)+parExpr = ParExpr <$> spc '(' <*> plzExpr `sepBy` spc ',' <*> plzSpc ')'+ <|> ParExprErr <$> hate 1 (symbol (const True))+ <|> ParExprErr <$> hate 2 (pure errorToken)+++-- * Simple parsers++-- | Parses a comment.+comment :: P TT TT+comment = symbol (\t -> case fromTT t of+ Comment _ -> True+ _ -> False)++-- | Parses a prefix operator.+preOp :: P TT TT+preOp = symbol (\t -> case fromTT t of+ Op x -> x `elem` prefixOperators+ _ -> False)++-- | Parses a infix operator.+inOp :: P TT TT+inOp = symbol (\t -> case fromTT t of+ Op x -> x `elem` infixOperators+ _ -> False)++-- | Parses a postfix operator.+postOp :: P TT TT+postOp = symbol (\t -> case fromTT t of+ Op x -> x `elem` postfixOperators+ _ -> False)++-- | Parses any literal.+opTok :: P TT TT+opTok = symbol (\t -> case fromTT t of+ Op _ -> True+ _ -> False)++-- | Parses any literal.+simpleTok :: P TT TT+simpleTok = symbol (\t -> case fromTT t of+ Str _ -> True+ Number _ -> True+ ValidName _ -> True+ Const _ -> True+ Rex _ -> True+ Res y -> y `elem` [True', False', Undefined', Null', This']+ _ -> False)++-- | Parses any string.+strTok :: P TT TT+strTok = symbol (\t -> case fromTT t of+ Str _ -> True+ _ -> False)++-- | Parses any valid number.+numTok :: P TT TT+numTok = symbol (\t -> case fromTT t of+ Number _ -> True+ _ -> False)++-- | Parses any valid identifier.+name :: P TT TT+name = symbol (\t -> case fromTT t of+ ValidName _ -> True+ Const _ -> True+ _ -> False)++-- | Parses any boolean.+boolean :: P TT TT+boolean = symbol (\t -> case fromTT t of+ Res y -> y `elem` [True', False']+ _ -> False)++-- | Parses a reserved word.+res :: Reserved -> P TT TT+res x = symbol (\t -> case fromTT t of+ Res y -> x == y+ _ -> False)++-- | Parses a special token.+spc :: Char -> P TT TT+spc x = symbol (\t -> case fromTT t of+ Special y -> x == y+ _ -> False)++-- | Parses an operator.+oper :: Operator -> P TT TT+oper x = symbol (\t -> case fromTT t of+ Op y -> y == x+ _ -> False)+++-- * Recovery parsers++-- | Expects a token x, recovers with 'errorToken'.+plzTok :: P TT TT -> P TT TT+plzTok x = x+ <|> hate 1 (symbol (const True))+ <|> hate 2 (pure errorToken)++-- | Expects a special token.+plzSpc :: Char -> P TT TT+plzSpc x = plzTok (spc x)++-- | Expects an expression.+plzExpr :: P TT (Expr TT)+plzExpr = plz expression++plz :: Failable f => P TT (f TT) -> P TT (f TT)+plz x = x+ <|> stupid <$> hate 1 (symbol (const True))+ <|> stupid <$> hate 2 (pure errorToken)++-- | General recovery parser, inserts an error token.+anything :: P s TT+anything = recoverWith (pure errorToken)++-- | Weighted recovery.+hate :: Int -> P s a -> P s a+hate n = power n recoverWith+ where+ power 0 _ = id+ power m f = f . power (m - 1) f+++-- * Utility stuff++fromBlock :: Block t -> [Statement t]+fromBlock (Block _ x _) = toList x+fromBlock (BlockOne x) = [x]+fromBlock (BlockErr _) = []++firstTok :: Foldable f => f t -> t+firstTok x = head (toList x)++errorToken :: TT+errorToken = toTT $ Special '!'++isError :: TT -> Bool+isError (Tok (Special '!') _ _) = True+isError _ = False++-- | Better name for 'tokFromT'.+toTT :: t -> Tok t+toTT = tokFromT++-- | Better name for 'tokT'.+fromTT :: Tok t -> t+fromTT = tokT
+ src/Yi/Verifier/JavaScript.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}++-- TODO:+-- ! User configuration.+-- ! Checking for side-effect-less code, e.g. "1;".++module Yi.Verifier.JavaScript where++import Control.Monad (unless)+import Control.Monad.Writer.Lazy (MonadWriter, Writer, tell)+import qualified Data.DList as D (DList, singleton)+import Data.Foldable (toList)+import Data.Function (on)+import Data.List (intercalate)+import Yi.Lexer.Alex (Posn, Tok, tokPosn, tokT)+import Yi.Lexer.JavaScript (TT, Token (..))+import Yi.Syntax.JavaScript hiding (res)+++-- * Types++data Error = MultipleFunctionDeclaration String [Posn]+ deriving Eq++data Warning = UnreachableCode Posn+ deriving Eq++data Report = Err Error+ | Warn Warning+ deriving Eq+++-- * Instances++instance Show Error where+ show (MultipleFunctionDeclaration n ps) =+ "Function `" ++ n ++ "' declared more than once: " ++ intercalate ", " (map show ps)++instance Show Warning where+ show (UnreachableCode pos) =+ "Unreachable code at " ++ show pos++instance Show Report where+ show (Err e) = "EE " ++ show e+ show (Warn w) = "WW " ++ show w+++-- * Main code++-- | The main verifier which calls the sub-verifiers.+verify :: Tree TT -> Writer (D.DList Report) ()+verify t = do+ let topfuns = findFunctions (toList t)+ checkMultipleFuns topfuns+ mapM_ (checkUnreachable . funBody) topfuns++-- | Given a list of function declarations, checks for multiple function+-- declarations, including the functions' subfunctions.+checkMultipleFuns :: [Statement TT] -> Writer (D.DList Report) ()+checkMultipleFuns stmts = do+ let dupFuns = dupsBy (ttEq `on` funName) stmts+ unless (null dupFuns)+ (say (Err (MultipleFunctionDeclaration+ (nameOf $ tokT $ funName $ head dupFuns)+ (map (tokPosn . funName) dupFuns))))+ let subFuns = map (findFunctions . funBody) (findFunctions stmts)+ mapM_ checkMultipleFuns subFuns++checkUnreachable :: [Statement TT] -> Writer (D.DList Report) ()+checkUnreachable stmts = do+ let afterReturn = dropWhile' (not . isReturn) stmts+ unless (null afterReturn)+ (say (Warn (UnreachableCode (tokPosn $ firstTok $ head afterReturn))))+++-- * Helper functions++-- | Given two @Tok t@, compares the @t@s.+ttEq :: Eq t => Tok t -> Tok t -> Bool+ttEq x y = tokT x == tokT y++say :: MonadWriter (D.DList a) m => a -> m ()+say = tell . D.singleton++isReturn :: Statement t -> Bool+isReturn (Return {}) = True+isReturn _ = False++-- | Returns a list of the functions in the given block.+findFunctions :: [Statement t] -> [Statement t]+findFunctions stmts = [ f | f@(FunDecl {}) <- stmts ]++-- | Given a 'FunDecl', returns the token representing the name.+funName :: Statement t -> t+funName (FunDecl _ n _ _) = n+funName _ = undefined++-- | Given a 'FunDecl', returns its inner body as a list.+funBody :: Statement t -> [Statement t]+funBody (FunDecl _ _ _ blk) =+ case blk of+ Block _ stmts _ -> toList stmts+ BlockOne stmt -> [stmt]+ _ -> []+funBody _ = undefined++-- | Given a @ValidName@ returns the string representing the name.+nameOf :: Token -> String+nameOf (ValidName n) = n+nameOf _ = undefined+++-- * Misc++-- | Like 'dropWhile' but drops the first element in the result.+dropWhile' :: (a -> Bool) -> [a] -> [a]+dropWhile' p xs =+ let res = dropWhile p xs in+ if null res then [] else drop 1 res++dupsBy :: (a -> a -> Bool) -> [a] -> [a]+dupsBy p xs = filter (\x -> length (filter (p x) xs) > 1) xs+
+ yi-mode-javascript.cabal view
@@ -0,0 +1,47 @@+-- This file has been generated from package.yaml by hpack version 0.14.0.+--+-- see: https://github.com/sol/hpack++name: yi-mode-javascript+version: 0.13+synopsis: Yi editor javascript mode+category: Yi+homepage: https://github.com/yi-editor/yi#readme+bug-reports: https://github.com/yi-editor/yi/issues+maintainer: Yi developers <yi-devel@googlegroups.com>+license: GPL-2+build-type: Simple+cabal-version: >= 1.10++source-repository head+ type: git+ location: https://github.com/yi-editor/yi++library+ hs-source-dirs:+ src+ ghc-options: -Wall -ferror-spans+ include-dirs:+ src/Yi/Lexer+ build-depends:+ base >= 4.8 && < 5+ , array+ , binary >= 0.7+ , data-default+ , dlist+ , filepath+ , microlens-platform+ , mtl+ , text+ , yi-core+ , yi-language+ , yi-rope+ exposed-modules:+ Yi.Config.Default.JavaScriptMode+ Yi.Mode.JavaScript+ Yi.Syntax.JavaScript+ Yi.Verifier.JavaScript+ Yi.Lexer.JavaScript+ other-modules:+ Paths_yi_mode_javascript+ default-language: Haskell2010