{-# 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 :: 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
    -- Given a list of possible columns to indent to, removes any
    -- duplicates from it and cycles between the resulting
    -- indentations.
    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)

--------------------------------------------------------------------------------

-- 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 (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

-- | The "compiler."
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)

-- | Returns the JS verifier buffer, creating it if necessary.
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

-- | Creates a new empty buffer and returns it.
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

-- | Given a filename, a BufferRef and a list of errors, prints the
-- errors in that buffer.
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)