{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Mode.Common
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Common functions used by modes.

module Yi.Mode.Common (TokenBasedMode, fundamentalMode,
                 anyExtension, extensionOrContentsMatch, 
                 linearSyntaxMode, hookModes, 
                 applyModeHooks, lookupMode, styleMode,
                 extensionMatches, shebangParser
                ) where

import           Lens.Micro.Platform  ((%~), (&), (.~), (^.))
import           Control.Applicative  ((<|>))
import           Control.Monad        (void)
import qualified Data.Attoparsec.Text as P
import           Data.Maybe           (fromMaybe)
import           System.FilePath      (takeExtension)

import           Yi.Buffer
import qualified Yi.IncrementalParse  as IncrParser (scanner)
import           Yi.Keymap            (YiM)
import           Yi.Lexer.Alex
import           Yi.MiniBuffer        (anyModeByNameM)
import qualified Yi.Rope              as R (YiString, toText)
import           Yi.Search            (makeSimpleSearch)
import           Yi.Style             (StyleName)
import           Yi.Syntax            (ExtHL (ExtHL))
import           Yi.Syntax.Driver     (mkHighlighter)
import           Yi.Syntax.OnlineTree (Tree, manyToks)
import           Yi.Syntax.Tree       (tokenBasedStrokes)

type TokenBasedMode tok = Mode (Tree (Tok tok))

-- TODO: Move this mode to it's own module
-- | The only built in mode of yi
fundamentalMode :: Mode syntax
fundamentalMode :: Mode syntax
fundamentalMode = Mode syntax
forall syntax. Mode syntax
emptyMode
  { modeName :: Text
modeName = Text
"fundamental"
  , modeApplies :: FilePath -> YiString -> Bool
modeApplies = FilePath -> YiString -> Bool
forall a b. a -> b -> Bool
modeAlwaysApplies
  , modeIndent :: syntax -> IndentBehaviour -> BufferM ()
modeIndent = (IndentBehaviour -> BufferM ())
-> syntax -> IndentBehaviour -> BufferM ()
forall a b. a -> b -> a
const IndentBehaviour -> BufferM ()
autoIndentB
  , modePrettify :: syntax -> BufferM ()
modePrettify = BufferM () -> syntax -> BufferM ()
forall a b. a -> b -> a
const BufferM ()
fillParagraph
  , modeGotoDeclaration :: BufferM ()
modeGotoDeclaration = do
       Point
currentPoint <- BufferM Point
pointB
       YiString
currentWord <- BufferM YiString
readCurrentWordB
       Point
currentWordBeginningPoint <- Region -> Point
regionStart (Region -> Point) -> BufferM Region -> BufferM Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextUnit -> BufferM Region
regionOfB TextUnit
unitWord
       Int
_ <- Int -> BufferM Int
gotoLn Int
0
       SearchExp
word <- SearchExp -> BufferM SearchExp
forall (m :: * -> *) a. Monad m => a -> m a
return (SearchExp -> BufferM SearchExp) -> SearchExp -> BufferM SearchExp
forall a b. (a -> b) -> a -> b
$ YiString -> SearchExp
makeSimpleSearch YiString
currentWord
       [Region]
searchResults <- Direction -> SearchExp -> BufferM [Region]
regexB Direction
Forward SearchExp
word
       case [Region]
searchResults of
           (Region
declarationRegion : [Region]
_) -> do
               Point
searchPoint <- Point -> BufferM Point
forall (m :: * -> *) a. Monad m => a -> m a
return (Point -> BufferM Point) -> Point -> BufferM Point
forall a b. (a -> b) -> a -> b
$ Region -> Point
regionStart Region
declarationRegion
               if Point
currentWordBeginningPoint Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
searchPoint
               then Point -> BufferM ()
moveTo Point
searchPoint
               else Point -> BufferM ()
moveTo Point
currentPoint
           [] -> Point -> BufferM ()
moveTo Point
currentPoint
  }

-- | Creates a 'TokenBasedMode' from a 'Lexer' and a function that
-- turns tokens into 'StyleName'.
linearSyntaxMode' :: Show (l s)
                  => Lexer l s (Tok t) i
                  -> (t -> StyleName)
                  -> TokenBasedMode t
linearSyntaxMode' :: Lexer l s (Tok t) i -> (t -> StyleName) -> TokenBasedMode t
linearSyntaxMode' Lexer l s (Tok t) i
scanToken t -> StyleName
tts = TokenBasedMode t
forall syntax. Mode syntax
fundamentalMode
  TokenBasedMode t
-> (TokenBasedMode t -> TokenBasedMode t) -> TokenBasedMode t
forall a b. a -> (a -> b) -> b
& (ExtHL (Tree (Tok t)) -> Identity (ExtHL (Tree (Tok t))))
-> TokenBasedMode t -> Identity (TokenBasedMode t)
forall syntax. Lens' (Mode syntax) (ExtHL syntax)
modeHLA ((ExtHL (Tree (Tok t)) -> Identity (ExtHL (Tree (Tok t))))
 -> TokenBasedMode t -> Identity (TokenBasedMode t))
-> ExtHL (Tree (Tok t)) -> TokenBasedMode t -> TokenBasedMode t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Highlighter
  (Cache (State (l s) (Tok t) (Tree (Tok t))) Tree t) (Tree (Tok t))
-> ExtHL (Tree (Tok t))
forall syntax cache. Highlighter cache syntax -> ExtHL syntax
ExtHL ((Scanner Point Char
 -> Scanner (State (l s) (Tok t) (Tree (Tok t))) (Tree (Tok t)))
-> Highlighter
     (Cache (State (l s) (Tok t) (Tree (Tok t))) Tree t) (Tree (Tok t))
forall state (tree :: * -> *) tt.
(IsTree tree, Show state) =>
(Scanner Point Char -> Scanner state (tree (Tok tt)))
-> Highlighter (Cache state tree tt) (tree (Tok tt))
mkHighlighter ((Scanner Point Char
  -> Scanner (State (l s) (Tok t) (Tree (Tok t))) (Tree (Tok t)))
 -> Highlighter
      (Cache (State (l s) (Tok t) (Tree (Tok t))) Tree t) (Tree (Tok t)))
-> (Scanner Point Char
    -> Scanner (State (l s) (Tok t) (Tree (Tok t))) (Tree (Tok t)))
-> Highlighter
     (Cache (State (l s) (Tok t) (Tree (Tok t))) Tree t) (Tree (Tok t))
forall a b. (a -> b) -> a -> b
$ Parser (Tok t) (Tree (Tok t))
-> Scanner (l s) (Tok t)
-> Scanner (State (l s) (Tok t) (Tree (Tok t))) (Tree (Tok t))
forall st token result.
Parser token result
-> Scanner st token -> Scanner (State st token result) result
IncrParser.scanner Parser (Tok t) (Tree (Tok t))
forall t. P (Tok t) (Tree (Tok t))
manyToks (Scanner (l s) (Tok t)
 -> Scanner (State (l s) (Tok t) (Tree (Tok t))) (Tree (Tok t)))
-> (Scanner Point Char -> Scanner (l s) (Tok t))
-> Scanner Point Char
-> Scanner (State (l s) (Tok t) (Tree (Tok t))) (Tree (Tok t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scanner Point Char -> Scanner (l s) (Tok t)
lexer)
  TokenBasedMode t
-> (TokenBasedMode t -> TokenBasedMode t) -> TokenBasedMode t
forall a b. a -> (a -> b) -> b
& ((Tree (Tok t) -> Point -> Point -> Point -> [Stroke])
 -> Identity (Tree (Tok t) -> Point -> Point -> Point -> [Stroke]))
-> TokenBasedMode t -> Identity (TokenBasedMode t)
forall syntax.
Lens' (Mode syntax) (syntax -> Point -> Point -> Point -> [Stroke])
modeGetStrokesA (((Tree (Tok t) -> Point -> Point -> Point -> [Stroke])
  -> Identity (Tree (Tok t) -> Point -> Point -> Point -> [Stroke]))
 -> TokenBasedMode t -> Identity (TokenBasedMode t))
-> (Tree (Tok t) -> Point -> Point -> Point -> [Stroke])
-> TokenBasedMode t
-> TokenBasedMode t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Tok t -> Stroke)
-> Tree (Tok t) -> Point -> Point -> Point -> [Stroke]
forall (t3 :: * -> *) a b t t2 t1.
Foldable t3 =>
(a -> b) -> t3 a -> t -> t2 -> t1 -> [b]
tokenBasedStrokes Tok t -> Stroke
tokenToStroke
  where
    tokenToStroke :: Tok t -> Stroke
tokenToStroke = (t -> StyleName) -> Span t -> Stroke
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t -> StyleName
tts (Span t -> Stroke) -> (Tok t -> Span t) -> Tok t -> Stroke
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok t -> Span t
forall t. Tok t -> Span t
tokToSpan
    lexer :: Scanner Point Char -> Scanner (l s) (Tok t)
lexer = Lexer l s (Tok t) i -> Scanner Point Char -> Scanner (l s) (Tok t)
forall (l :: * -> *) s t i.
Lexer l s t i -> Scanner Point Char -> Scanner (l s) t
lexScanner Lexer l s (Tok t) i
scanToken

-- | Specialised version of 'linearSyntaxMode'' for the common case,
-- wrapping up into a 'Lexer' with 'commonLexer'.
linearSyntaxMode :: Show s => s -- ^ Starting state
                 -> TokenLexer AlexState s (Tok t) AlexInput
                 -> (t -> StyleName)
                 -> TokenBasedMode t
linearSyntaxMode :: s
-> TokenLexer AlexState s (Tok t) AlexInput
-> (t -> StyleName)
-> TokenBasedMode t
linearSyntaxMode s
initSt TokenLexer AlexState s (Tok t) AlexInput
scanToken =
  Lexer AlexState s (Tok t) AlexInput
-> (t -> StyleName) -> TokenBasedMode t
forall (l :: * -> *) s t i.
Show (l s) =>
Lexer l s (Tok t) i -> (t -> StyleName) -> TokenBasedMode t
linearSyntaxMode' (TokenLexer AlexState s (Tok t) AlexInput
-> s -> Lexer AlexState s (Tok t) AlexInput
forall s t.
(ASI s -> Maybe (Tok t, ASI s))
-> s -> Lexer AlexState s (Tok t) AlexInput
commonLexer TokenLexer AlexState s (Tok t) AlexInput
scanToken s
initSt)

styleMode :: Show (l s) => StyleLexer l s t i
          -> TokenBasedMode t
styleMode :: StyleLexer l s t i -> TokenBasedMode t
styleMode StyleLexer l s t i
l = Lexer l s (Tok t) i -> (t -> StyleName) -> TokenBasedMode t
forall (l :: * -> *) s t i.
Show (l s) =>
Lexer l s (Tok t) i -> (t -> StyleName) -> TokenBasedMode t
linearSyntaxMode' (StyleLexer l s t i
l StyleLexer l s t i
-> Getting
     (Lexer l s (Tok t) i) (StyleLexer l s t i) (Lexer l s (Tok t) i)
-> Lexer l s (Tok t) i
forall s a. s -> Getting a s a -> a
^. Getting
  (Lexer l s (Tok t) i) (StyleLexer l s t i) (Lexer l s (Tok t) i)
forall (l1 :: * -> *) s1 t i1 (l2 :: * -> *) s2 i2.
Lens
  (StyleLexer l1 s1 t i1)
  (StyleLexer l2 s2 t i2)
  (Lexer l1 s1 (Tok t) i1)
  (Lexer l2 s2 (Tok t) i2)
styleLexer) (StyleLexer l s t i
l StyleLexer l s t i
-> Getting (t -> StyleName) (StyleLexer l s t i) (t -> StyleName)
-> t
-> StyleName
forall s a. s -> Getting a s a -> a
^. Getting (t -> StyleName) (StyleLexer l s t i) (t -> StyleName)
forall (l :: * -> *) s t i.
Lens' (StyleLexer l s t i) (t -> StyleName)
tokenToStyle)

-- | Determines if the file's extension is one of the extensions in the list.
extensionMatches :: [String]
                 -> FilePath
                 -> Bool
extensionMatches :: [FilePath] -> FilePath -> Bool
extensionMatches [FilePath]
extensions FilePath
fileName = FilePath
extension FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
extensions'
    where extension :: FilePath
extension = FilePath -> FilePath
takeExtension FilePath
fileName
          extensions' :: [FilePath]
extensions' = [Char
'.' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
ext | FilePath
ext <- [FilePath]
extensions]

-- | When applied to an extensions list, creates a 'Mode.modeApplies' function.
anyExtension :: [String] -- ^ List of extensions
             -> FilePath -- ^ Path to compare against
             -> a        -- ^ File contents. Currently unused but see
                         -- 'extensionOrContentsMatch'.
             -> Bool
anyExtension :: [FilePath] -> FilePath -> a -> Bool
anyExtension [FilePath]
extensions FilePath
fileName a
_contents
    = [FilePath] -> FilePath -> Bool
extensionMatches [FilePath]
extensions FilePath
fileName

-- | When applied to an extensions list and regular expression pattern, creates
-- a 'Mode.modeApplies' function.
extensionOrContentsMatch :: [String] -> P.Parser () -> FilePath -> R.YiString -> Bool
extensionOrContentsMatch :: [FilePath] -> Parser () -> FilePath -> YiString -> Bool
extensionOrContentsMatch [FilePath]
extensions Parser ()
parser FilePath
fileName YiString
contents
    = [FilePath] -> FilePath -> Bool
extensionMatches [FilePath]
extensions FilePath
fileName Bool -> Bool -> Bool
|| Bool
m
    where
        m :: Bool
m = case Parser () -> Text -> Either FilePath ()
forall a. Parser a -> Text -> Either FilePath a
P.parseOnly Parser ()
parser (Text -> Either FilePath ()) -> Text -> Either FilePath ()
forall a b. (a -> b) -> a -> b
$ YiString -> Text
R.toText YiString
contents of
              Left FilePath
_ -> Bool
False
              Right ()
_ -> Bool
True

{- | Generate a parser for shebang patterns
the generated parser will match only if the shebang is at the start of a line

==== __Examples__

> shebangParser "runhaskell"

generates a parser that matches "#!\/usr\/bin\/env runhaskell\\n"
(but also "djsjfaj\\n\\n\\n\\r\\n#!    \/usr\/bin\/env       runhaskell       \\ndkasfkda\\n\\r\\nkasfaj")

__Note:__ You can get @("runhaskell" :: Parser String)@ by using the OverloadedStrings extension

> shebangParser "python"

generates a parser that matches "#!\/usr\/bin\/env python\\n"

__Note:__ it doesn't match "#!\/usr\/bin\/env python2\\n" (that's why the newline is required)

It is also possible to use more complex parsers:

> shebangParser ("python" *> ("2" <|> "3" <|> ""))

generates a parser that matches any of:

  * "#!\/usr\/bin\/env python\\n"
  * "#!\/usr\/bin\/env python2\\n"
  * "#!\/usr\/bin\/env python3\\n"
-}
shebangParser :: P.Parser a -> P.Parser ()
shebangParser :: Parser a -> Parser ()
shebangParser Parser a
p = Parser () -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ()
p'
  where
    p' :: Parser ()
p' = Parser Text Text
"#!" Parser Text Text -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ()
P.skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
"/usr/bin/env " Parser Text Text -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ()
P.skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser () -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p Parser a -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ()
P.skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
P.endOfLine
     Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser ()
P.skip (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True) Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ()
P.skipWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
P.isEndOfLine) Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ()
P.skipWhile Char -> Bool
P.isEndOfLine Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
p'

-- | Adds a hook to all matching hooks in a list
hookModes :: (AnyMode -> Bool) -> BufferM () -> [AnyMode] -> [AnyMode]
hookModes :: (AnyMode -> Bool) -> BufferM () -> [AnyMode] -> [AnyMode]
hookModes AnyMode -> Bool
p BufferM ()
h = (AnyMode -> AnyMode) -> [AnyMode] -> [AnyMode]
forall a b. (a -> b) -> [a] -> [b]
map ((AnyMode -> AnyMode) -> [AnyMode] -> [AnyMode])
-> (AnyMode -> AnyMode) -> [AnyMode] -> [AnyMode]
forall a b. (a -> b) -> a -> b
$ \am :: AnyMode
am@(AnyMode Mode syntax
m) ->
  if AnyMode -> Bool
p AnyMode
am then Mode syntax -> AnyMode
forall syntax. Mode syntax -> AnyMode
AnyMode (Mode syntax
m Mode syntax -> (Mode syntax -> Mode syntax) -> Mode syntax
forall a b. a -> (a -> b) -> b
& (BufferM () -> Identity (BufferM ()))
-> Mode syntax -> Identity (Mode syntax)
forall syntax. Lens' (Mode syntax) (BufferM ())
modeOnLoadA ((BufferM () -> Identity (BufferM ()))
 -> Mode syntax -> Identity (Mode syntax))
-> (BufferM () -> BufferM ()) -> Mode syntax -> Mode syntax
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
h)) else AnyMode
am

-- | Apply a list of mode hooks to a list of AnyModes
applyModeHooks :: [(AnyMode -> Bool, BufferM ())] -> [AnyMode] -> [AnyMode]
applyModeHooks :: [(AnyMode -> Bool, BufferM ())] -> [AnyMode] -> [AnyMode]
applyModeHooks [(AnyMode -> Bool, BufferM ())]
hs [AnyMode]
ms = ((AnyMode -> AnyMode) -> [AnyMode] -> [AnyMode])
-> [AnyMode] -> (AnyMode -> AnyMode) -> [AnyMode]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (AnyMode -> AnyMode) -> [AnyMode] -> [AnyMode]
forall a b. (a -> b) -> [a] -> [b]
map [AnyMode]
ms ((AnyMode -> AnyMode) -> [AnyMode])
-> (AnyMode -> AnyMode) -> [AnyMode]
forall a b. (a -> b) -> a -> b
$ \AnyMode
am -> case ((AnyMode -> Bool, BufferM ()) -> Bool)
-> [(AnyMode -> Bool, BufferM ())]
-> [(AnyMode -> Bool, BufferM ())]
forall a. (a -> Bool) -> [a] -> [a]
filter (((AnyMode -> Bool) -> AnyMode -> Bool
forall a b. (a -> b) -> a -> b
$ AnyMode
am) ((AnyMode -> Bool) -> Bool)
-> ((AnyMode -> Bool, BufferM ()) -> AnyMode -> Bool)
-> (AnyMode -> Bool, BufferM ())
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnyMode -> Bool, BufferM ()) -> AnyMode -> Bool
forall a b. (a, b) -> a
fst) [(AnyMode -> Bool, BufferM ())]
hs of
    [] -> AnyMode
am
    [(AnyMode -> Bool, BufferM ())]
ls -> (forall syntax. Mode syntax -> Mode syntax) -> AnyMode -> AnyMode
onMode ((BufferM () -> Identity (BufferM ()))
-> Mode syntax -> Identity (Mode syntax)
forall syntax. Lens' (Mode syntax) (BufferM ())
modeOnLoadA ((BufferM () -> Identity (BufferM ()))
 -> Mode syntax -> Identity (Mode syntax))
-> (BufferM () -> BufferM ()) -> Mode syntax -> Mode syntax
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \BufferM ()
x -> ((AnyMode -> Bool, BufferM ()) -> BufferM () -> BufferM ())
-> BufferM () -> [(AnyMode -> Bool, BufferM ())] -> BufferM ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) (BufferM () -> BufferM () -> BufferM ())
-> ((AnyMode -> Bool, BufferM ()) -> BufferM ())
-> (AnyMode -> Bool, BufferM ())
-> BufferM ()
-> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnyMode -> Bool, BufferM ()) -> BufferM ()
forall a b. (a, b) -> b
snd) BufferM ()
x [(AnyMode -> Bool, BufferM ())]
ls) AnyMode
am

-- | Check whether a mode of the same name is already in modeTable and
-- returns the original mode, if it isn't the case.
lookupMode :: AnyMode -> YiM AnyMode
lookupMode :: AnyMode -> YiM AnyMode
lookupMode am :: AnyMode
am@(AnyMode Mode syntax
m) = AnyMode -> Maybe AnyMode -> AnyMode
forall a. a -> Maybe a -> a
fromMaybe AnyMode
am (Maybe AnyMode -> AnyMode) -> YiM (Maybe AnyMode) -> YiM AnyMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> YiM (Maybe AnyMode)
anyModeByNameM (Mode syntax -> Text
forall syntax. Mode syntax -> Text
modeName Mode syntax
m)