{-# 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 :: forall syntax. Mode syntax
javaScriptAbstract = Mode syntax
forall syntax. Mode syntax
emptyMode
  { modeApplies = anyExtension ["js"]
  , modeName = "javascript"
  , modeToggleCommentSelection = Just (toggleCommentB "//")
  }

javaScriptMode :: Mode (Tree TT)
javaScriptMode :: Mode (Tree TT)
javaScriptMode = Mode (Tree TT)
forall syntax. Mode syntax
javaScriptAbstract
  { modeIndent = jsSimpleIndent
  , modeHL = ExtHL $ mkHighlighter (scanner parse . jsLexer)
  , modeGetStrokes = getStrokes
  }

jsSimpleIndent :: Tree TT -> IndentBehaviour -> BufferM ()
jsSimpleIndent :: Tree TT -> IndentBehaviour -> BufferM ()
jsSimpleIndent Tree TT
t IndentBehaviour
behave = do
  Int
indLevel <- IndentSettings -> Int
shiftWidth (IndentSettings -> Int) -> BufferM IndentSettings -> BufferM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM IndentSettings
indentSettingsB
  Int
prevInd  <- Direction -> BufferM YiString
getNextNonBlankLineB Direction
Backward BufferM YiString -> (YiString -> BufferM Int) -> BufferM Int
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= YiString -> BufferM Int
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 a. [a] -> [a]
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 -> [Int] -> BufferM ()
indentTo [Int
indLevel, Int
0]
    Just Tree TT
_  -> [Int] -> BufferM ()
indentTo [Int
prevInd,
                         Int
prevInd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indLevel,
                         Int
prevInd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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 :: [Int] -> BufferM ()
indentTo = IndentBehaviour -> [Int] -> BufferM ()
cycleIndentsB IndentBehaviour
behave ([Int] -> BufferM ()) -> ([Int] -> [Int]) -> [Int] -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub

jsLexer :: CharScanner -> Scanner (AlexState HlState) (Tok Token)
jsLexer :: Scanner Point Char -> Scanner (AlexState Int) TT
jsLexer = Lexer AlexState Int TT AlexInput
-> Scanner Point Char -> Scanner (AlexState Int) TT
forall (l :: * -> *) s t i.
Lexer l s t i -> Scanner Point Char -> Scanner (l s) t
lexScanner ((ASI Int -> Maybe (TT, ASI Int))
-> Int -> Lexer AlexState Int TT AlexInput
forall s t.
(ASI s -> Maybe (Tok t, ASI s))
-> s -> Lexer AlexState s (Tok t) AlexInput
commonLexer ASI Int -> Maybe (TT, ASI Int)
alexScanToken Int
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 = topKeymapA %~ important (choice m)
  , modeFollow = YiA . 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 Mode syntax -> syntax -> Action
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
$cdef :: JSBuffer
def :: 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
$cput :: JSBuffer -> Put
put :: JSBuffer -> Put
$cget :: Get JSBuffer
get :: Get JSBuffer
$cputList :: [JSBuffer] -> Put
putList :: [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 String
filename <- BufferM (Maybe String) -> YiM (Maybe String)
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM (Maybe String) -> YiM (Maybe String))
-> BufferM (Maybe String) -> YiM (Maybe String)
forall a b. (a -> b) -> a -> b
$ (FBuffer -> Maybe String) -> BufferM (Maybe String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Maybe String
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 a. EditorM a -> YiM a
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
  String -> BufferRef -> [Report] -> YiM ()
forall a. Show a => String -> BufferRef -> [a] -> YiM ()
jsErrors String
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 a. EditorM a -> YiM a
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 a. a -> YiM a
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 :: forall a. Show a => String -> BufferRef -> [a] -> YiM ()
jsErrors String
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 a. [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
<> String -> YiString
R.fromString (String -> String
takeBaseName String
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)