    {-# 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
      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
      prevInd  <- getNextNonBlankLineB Backward >>= indentOfB
      solPnt   <- pointAt moveToSol
      let 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 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
      _ <- YiM Bool
    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 :: 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 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 mb of
        Maybe BufferRef
    Nothing -> YiM BufferRef
    mkJSBuffer
        Just BufferRef
    b  -> do 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 stillExists
                        then return b
                        else 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)