yi-mode-javascript-0.14.1/src/0000755000000000000000000000000013136407445014270 5ustar0000000000000000yi-mode-javascript-0.14.1/src/Yi/0000755000000000000000000000000013136407445014651 5ustar0000000000000000yi-mode-javascript-0.14.1/src/Yi/Config/0000755000000000000000000000000013136407445016056 5ustar0000000000000000yi-mode-javascript-0.14.1/src/Yi/Config/Default/0000755000000000000000000000000013136407445017442 5ustar0000000000000000yi-mode-javascript-0.14.1/src/Yi/Lexer/0000755000000000000000000000000013136407445015730 5ustar0000000000000000yi-mode-javascript-0.14.1/src/Yi/Mode/0000755000000000000000000000000013136407445015535 5ustar0000000000000000yi-mode-javascript-0.14.1/src/Yi/Syntax/0000755000000000000000000000000013136407445016137 5ustar0000000000000000yi-mode-javascript-0.14.1/src/Yi/Verifier/0000755000000000000000000000000013136407445016424 5ustar0000000000000000yi-mode-javascript-0.14.1/src/Yi/Config/Default/JavaScriptMode.hs0000644000000000000000000000054413136407445022654 0ustar0000000000000000module 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) :)yi-mode-javascript-0.14.1/src/Yi/Mode/JavaScript.hs0000644000000000000000000001261713136407445020146 0ustar0000000000000000{-# 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) yi-mode-javascript-0.14.1/src/Yi/Syntax/JavaScript.hs0000644000000000000000000005204113136407445020543 0ustar0000000000000000{-# 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 -- . -- -- 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 qualified Prelude 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 _ = [] uniplate = Prelude.error "uniplate not implemented in IsTree (Yi.Syntax.JavaScript.Statement)" emptyNode = Prelude.error "emptyNode not implemented in IsTree (Yi.Syntax.JavaScript.Statement)" 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 yi-mode-javascript-0.14.1/src/Yi/Verifier/JavaScript.hs0000644000000000000000000000725013136407445021032 0ustar0000000000000000{-# 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-0.14.1/src/Yi/Lexer/JavaScript.x0000644000000000000000000002272613136407445020200 0ustar0000000000000000-- -*- 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 (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" } yi-mode-javascript-0.14.1/Setup.hs0000644000000000000000000000012613136407445015134 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main :: IO () main = defaultMain yi-mode-javascript-0.14.1/yi-mode-javascript.cabal0000644000000000000000000000231113137144536020171 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.17.0. -- -- see: https://github.com/sol/hpack name: yi-mode-javascript version: 0.14.1 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 license: GPL-2 build-type: Simple cabal-version: >= 1.10 extra-source-files: src/Yi/Lexer/common.hsinc 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 build-tools: alex >= 3.0.3 && < 3.2.0 || >= 3.2.1 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 yi-mode-javascript-0.14.1/src/Yi/Lexer/common.hsinc0000644000000000000000000000705013136407445020250 0ustar0000000000000000-- -*- Haskell -*- -- The include file for alex-generated syntax highlighters. Because alex -- declares its own types, any wrapper must have the highlighter in scope... -- so it must be included. Doubleplusyuck. #define IBOX(n) (I# (n)) #define GEQ_(x, y) (tagToEnum# (x >=# y)) #define EQ_(x, y) (tagToEnum# (x ==# y)) -- | Scan one token. Return (maybe) a token and a new state. alexScanToken :: (AlexState HlState, AlexInput) -> Maybe (Tok Token, (AlexState HlState, AlexInput)) alexScanToken (AlexState state lookedOfs pos, inp@(_prevCh,_bs,str)) = let (scn,lookahead) = alexScanUser' state inp (stateToInit state) lookedOfs' = max lookedOfs (posnOfs pos +~ Size lookahead) in case scn of AlexEOF -> Nothing AlexError inp' -> Nothing AlexSkip inp' len -> let chunk = take (fromIntegral len) str in alexScanToken (AlexState state lookedOfs' (moveStr pos chunk), inp') AlexToken inp' len act -> let (state', tokValue) = act chunk state chunk = take (fromIntegral len) str newPos = moveStr pos chunk in Just (Tok tokValue (posnOfs newPos ~- posnOfs pos) pos, (AlexState state' lookedOfs' newPos, inp')) alexScan' input (I# (sc)) = alexScanUser' undefined input (I# (sc)) alexScanUser' user input (I# (sc)) = case alex_scan_tkn' user input 0# input sc AlexNone of (AlexNone, input', lookahead) -> case alexGetByte input of Nothing -> (AlexEOF, lookahead) Just _ -> (AlexError input', lookahead) (AlexLastSkip input'' len, _, lookahead) -> (AlexSkip input'' len, lookahead) #if MIN_TOOL_VERSION_alex(3,2,0) (AlexLastAcc k input'' len, _, lookahead) -> (AlexToken input'' len (alex_actions ! k), lookahead) #else (AlexLastAcc k input'' len, _, lookahead) -> (AlexToken input'' len k, lookahead) #endif -- Same as alex_scan_tkn, but also return the length of lookahead. alex_scan_tkn' user orig_input len input s last_acc = input `seq` -- strict in the input let new_acc = check_accs (alex_accept `quickIndex` IBOX(s)) in new_acc `seq` case alexGetByte input of Nothing -> (new_acc, input, IBOX(len)) Just (c, new_input) -> let base = alexIndexInt32OffAddr alex_base s ord_c = case fromIntegral c of (I# x) -> x offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset new_s = if GEQ_(offset, 0#) && EQ_(check, ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s new_len = if c < 0x80 || c >= 0xC0 then len +# 1# else len in case new_s of -1# -> (new_acc, input, IBOX(new_len)) -- on an error, we want to keep the input *before* the -- character that failed, not after. -- (but still, we looked after) _ -> alex_scan_tkn' user orig_input new_len new_input new_s new_acc where check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input IBOX(len) check_accs (AlexAccSkip) = AlexLastSkip input IBOX(len) #ifndef NO_ALEX_CONTEXTS check_accs (AlexAccPred a predx rest) | predx user orig_input IBOX(len) input = AlexLastAcc a input IBOX(len) | otherwise = check_accs rest check_accs (AlexAccSkipPred predx rest) | predx user orig_input IBOX(len) input = AlexLastSkip input IBOX(len) | otherwise = check_accs rest #endif c = actionConst m = actionAndModify ms = actionStringAndModify cs = actionStringConst