{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}
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 :: Mode syntax
javaScriptAbstract = Mode syntax
forall syntax. Mode syntax
emptyMode
{ modeApplies :: FilePath -> YiString -> Bool
modeApplies = [FilePath] -> FilePath -> YiString -> Bool
forall a. [FilePath] -> FilePath -> a -> Bool
anyExtension [FilePath
"js"]
, modeName :: Text
modeName = Text
"javascript"
, modeToggleCommentSelection :: Maybe (BufferM ())
modeToggleCommentSelection = BufferM () -> Maybe (BufferM ())
forall a. a -> Maybe a
Just (YiString -> BufferM ()
toggleCommentB YiString
"//")
}
javaScriptMode :: Mode (Tree TT)
javaScriptMode :: Mode (Tree TT)
javaScriptMode = Mode (Tree TT)
forall syntax. Mode syntax
javaScriptAbstract
{ modeIndent :: Tree TT -> IndentBehaviour -> BufferM ()
modeIndent = Tree TT -> IndentBehaviour -> BufferM ()
jsSimpleIndent
, modeHL :: ExtHL (Tree TT)
modeHL = Highlighter
(Cache (State (AlexState HlState) TT (Tree TT)) (Tree TT))
(Tree TT)
-> ExtHL (Tree TT)
forall syntax cache. Highlighter cache syntax -> ExtHL syntax
ExtHL (Highlighter
(Cache (State (AlexState HlState) TT (Tree TT)) (Tree TT))
(Tree TT)
-> ExtHL (Tree TT))
-> Highlighter
(Cache (State (AlexState HlState) TT (Tree TT)) (Tree TT))
(Tree TT)
-> ExtHL (Tree TT)
forall a b. (a -> b) -> a -> b
$ (Scanner Point Char
-> Scanner (State (AlexState HlState) TT (Tree TT)) (Tree TT))
-> Highlighter
(Cache (State (AlexState HlState) TT (Tree TT)) (Tree TT))
(Tree TT)
forall state result.
Show state =>
(Scanner Point Char -> Scanner state result)
-> Highlighter (Cache state result) result
mkHighlighter (Parser TT (Tree TT)
-> Scanner (AlexState HlState) TT
-> Scanner (State (AlexState HlState) TT (Tree TT)) (Tree TT)
forall st token result.
Parser token result
-> Scanner st token -> Scanner (State st token result) result
scanner Parser TT (Tree TT)
parse (Scanner (AlexState HlState) TT
-> Scanner (State (AlexState HlState) TT (Tree TT)) (Tree TT))
-> (Scanner Point Char -> Scanner (AlexState HlState) TT)
-> Scanner Point Char
-> Scanner (State (AlexState HlState) TT (Tree TT)) (Tree TT)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scanner Point Char -> Scanner (AlexState HlState) TT
jsLexer)
, modeGetStrokes :: Tree TT -> Point -> Point -> Point -> [Stroke]
modeGetStrokes = Tree TT -> Point -> Point -> Point -> [Stroke]
getStrokes
}
jsSimpleIndent :: Tree TT -> IndentBehaviour -> BufferM ()
jsSimpleIndent :: Tree TT -> IndentBehaviour -> BufferM ()
jsSimpleIndent Tree TT
t IndentBehaviour
behave = do
HlState
indLevel <- IndentSettings -> HlState
shiftWidth (IndentSettings -> HlState)
-> BufferM IndentSettings -> BufferM HlState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM IndentSettings
indentSettingsB
HlState
prevInd <- Direction -> BufferM YiString
getNextNonBlankLineB Direction
Backward BufferM YiString
-> (YiString -> BufferM HlState) -> BufferM HlState
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= YiString -> BufferM HlState
indentOfB
Point
solPnt <- BufferM () -> BufferM Point
forall a. BufferM a -> BufferM Point
pointAt BufferM ()
moveToSol
let path :: Maybe (Tree TT)
path = Tree TT -> Point -> Maybe (Tree TT)
forall (tree :: * -> *) t.
IsTree tree =>
[tree (Tok t)] -> Point -> Maybe [tree (Tok t)]
getLastPath (Tree TT -> Tree TT
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Tree TT
t) Point
solPnt
case Maybe (Tree TT)
path of
Maybe (Tree TT)
Nothing -> [HlState] -> BufferM ()
indentTo [HlState
indLevel, HlState
0]
Just Tree TT
_ -> [HlState] -> BufferM ()
indentTo [HlState
prevInd,
HlState
prevInd HlState -> HlState -> HlState
forall a. Num a => a -> a -> a
+ HlState
indLevel,
HlState
prevInd HlState -> HlState -> HlState
forall a. Num a => a -> a -> a
- HlState
indLevel]
where
indentTo :: [Int] -> BufferM ()
indentTo :: [HlState] -> BufferM ()
indentTo = IndentBehaviour -> [HlState] -> BufferM ()
cycleIndentsB IndentBehaviour
behave ([HlState] -> BufferM ())
-> ([HlState] -> [HlState]) -> [HlState] -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [HlState] -> [HlState]
forall a. Eq a => [a] -> [a]
nub
jsLexer :: CharScanner -> Scanner (AlexState HlState) (Tok Token)
jsLexer :: Scanner Point Char -> Scanner (AlexState HlState) TT
jsLexer = Lexer AlexState HlState TT AlexInput
-> Scanner Point Char -> Scanner (AlexState HlState) TT
forall (l :: * -> *) s t i.
Lexer l s t i -> Scanner Point Char -> Scanner (l s) t
lexScanner ((ASI HlState -> Maybe (TT, ASI HlState))
-> HlState -> Lexer AlexState HlState TT AlexInput
forall s t.
(ASI s -> Maybe (Tok t, ASI s))
-> s -> Lexer AlexState s (Tok t) AlexInput
commonLexer ASI HlState -> Maybe (TT, ASI HlState)
alexScanToken HlState
initState)
hooks :: Mode (Tree TT) -> Mode (Tree TT)
hooks :: Mode (Tree TT) -> Mode (Tree TT)
hooks Mode (Tree TT)
mode = Mode (Tree TT)
mode
{ modeKeymap :: KeymapSet -> KeymapSet
modeKeymap = (Keymap -> Identity Keymap) -> KeymapSet -> Identity KeymapSet
Lens' KeymapSet Keymap
topKeymapA ((Keymap -> Identity Keymap) -> KeymapSet -> Identity KeymapSet)
-> (Keymap -> Keymap) -> KeymapSet -> KeymapSet
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Keymap -> Keymap -> Keymap
forall (f :: * -> *) w e a.
MonadInteract f w e =>
f a -> f a -> f a
important ([Keymap] -> Keymap
forall (m :: * -> *) w e a.
(MonadInteract m w e, MonadFail m) =>
[m a] -> m a
choice [Keymap]
m)
, modeFollow :: Tree TT -> Action
modeFollow = YiM () -> Action
forall a. Show a => YiM a -> Action
YiA (YiM () -> Action) -> (Tree TT -> YiM ()) -> Tree TT -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree TT -> YiM ()
jsCompile
}
where
m :: [Keymap]
m = [ Char -> Event
ctrlCh Char
'c' Event -> Keymap -> Keymap
forall (m :: * -> *) action a.
MonadInteract m action Event =>
Event -> m a -> m a
?>> Char -> Event
ctrlCh Char
'l' Event -> YiM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! (forall syntax. Mode syntax -> syntax -> Action) -> YiM ()
forall x a.
(Show x, YiAction a x) =>
(forall syntax. Mode syntax -> syntax -> a) -> YiM ()
withSyntax forall syntax. Mode syntax -> syntax -> Action
modeFollow
, Key -> [Modifier] -> Event
Event Key
KEnter [] Event -> BufferM () -> Keymap
forall (m :: * -> *) a x.
(MonadInteract m Action Event, YiAction a x, Show x) =>
Event -> a -> m ()
?>>! BufferM ()
newlineAndIndentB
]
newtype JSBuffer = JSBuffer (Maybe BufferRef)
deriving (JSBuffer
JSBuffer -> Default JSBuffer
forall a. a -> Default a
def :: JSBuffer
$cdef :: JSBuffer
Default, Typeable, Get JSBuffer
[JSBuffer] -> Put
JSBuffer -> Put
(JSBuffer -> Put)
-> Get JSBuffer -> ([JSBuffer] -> Put) -> Binary JSBuffer
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [JSBuffer] -> Put
$cputList :: [JSBuffer] -> Put
get :: Get JSBuffer
$cget :: Get JSBuffer
put :: JSBuffer -> Put
$cput :: JSBuffer -> Put
Binary)
instance YiVariable JSBuffer
jsCompile :: Tree TT -> YiM ()
jsCompile :: Tree TT -> YiM ()
jsCompile Tree TT
tree = do
Bool
_ <- YiM Bool
fwriteE
Just FilePath
filename <- BufferM (Maybe FilePath) -> YiM (Maybe FilePath)
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM (Maybe FilePath) -> YiM (Maybe FilePath))
-> BufferM (Maybe FilePath) -> YiM (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ (FBuffer -> Maybe FilePath) -> BufferM (Maybe FilePath)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Maybe FilePath
file
BufferRef
buf <- YiM BufferRef
getJSBuffer
YiM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => m a -> m a
withOtherWindow (YiM () -> YiM ()) -> YiM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferRef -> EditorM ()
switchToBufferE BufferRef
buf
FilePath -> BufferRef -> [Report] -> YiM ()
forall a. Show a => FilePath -> BufferRef -> [a] -> YiM ()
jsErrors FilePath
filename BufferRef
buf (DList Report -> [Report]
forall a. DList a -> [a]
D.toList (DList Report -> [Report]) -> DList Report -> [Report]
forall a b. (a -> b) -> a -> b
$ Writer (DList Report) () -> DList Report
forall w a. Writer w a -> w
execWriter (Writer (DList Report) () -> DList Report)
-> Writer (DList Report) () -> DList Report
forall a b. (a -> b) -> a -> b
$ Tree TT -> Writer (DList Report) ()
verify Tree TT
tree)
getJSBuffer :: YiM BufferRef
getJSBuffer :: YiM BufferRef
getJSBuffer = YiM BufferRef -> YiM BufferRef
forall (m :: * -> *) a. MonadEditor m => m a -> m a
withOtherWindow (YiM BufferRef -> YiM BufferRef) -> YiM BufferRef -> YiM BufferRef
forall a b. (a -> b) -> a -> b
$ do
JSBuffer Maybe BufferRef
mb <- EditorM JSBuffer -> YiM JSBuffer
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM JSBuffer
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
case Maybe BufferRef
mb of
Maybe BufferRef
Nothing -> YiM BufferRef
mkJSBuffer
Just BufferRef
b -> do Bool
stillExists <- Maybe FBuffer -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FBuffer -> Bool) -> YiM (Maybe FBuffer) -> YiM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferRef -> YiM (Maybe FBuffer)
forall (m :: * -> *).
MonadEditor m =>
BufferRef -> m (Maybe FBuffer)
findBuffer BufferRef
b
if Bool
stillExists
then BufferRef -> YiM BufferRef
forall (m :: * -> *) a. Monad m => a -> m a
return BufferRef
b
else YiM BufferRef
mkJSBuffer
mkJSBuffer :: YiM BufferRef
mkJSBuffer :: YiM BufferRef
mkJSBuffer = BufferId -> YiString -> YiM BufferRef
forall (m :: * -> *).
MonadEditor m =>
BufferId -> YiString -> m BufferRef
stringToNewBuffer (Text -> BufferId
MemBuffer Text
"js") YiString
forall a. Monoid a => a
mempty
jsErrors :: Show a => String -> BufferRef -> [a] -> YiM ()
jsErrors :: FilePath -> BufferRef -> [a] -> YiM ()
jsErrors FilePath
fname BufferRef
buf [a]
errs =
let problems :: Text
problems = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map a -> Text
forall a. Show a => a -> Text
item [a]
errs
item :: a -> Text
item a
x = Text
"* " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
showT a
x
str :: YiString
str = if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
errs
then YiString
"No problems found!"
else YiString
"Problems in "
YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> FilePath -> YiString
R.fromString (FilePath -> FilePath
takeBaseName FilePath
fname)
YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> YiString
":\n" YiString -> YiString -> YiString
forall a. Semigroup a => a -> a -> a
<> Text -> YiString
R.fromText Text
problems
in BufferRef -> BufferM () -> YiM ()
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
buf (YiString -> BufferM ()
replaceBufferContent YiString
str)