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, isJust)
import System.FilePath (takeExtension)
import qualified Data.Text as T (Text)
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))
fundamentalMode :: Mode syntax
fundamentalMode = emptyMode
{ modeName = "fundamental"
, modeApplies = modeAlwaysApplies
, modeIndent = const autoIndentB
, modePrettify = const fillParagraph
, modeGotoDeclaration = do
currentPoint <- pointB
currentWord <- readCurrentWordB
currentWordBeginningPoint <- regionStart <$> regionOfB unitWord
_ <- gotoLn 0
word <- return $ makeSimpleSearch currentWord
searchResults <- regexB Forward word
case searchResults of
(declarationRegion : _) -> do
searchPoint <- return $ regionStart declarationRegion
if currentWordBeginningPoint /= searchPoint
then moveTo searchPoint
else moveTo currentPoint
[] -> moveTo currentPoint
}
linearSyntaxMode' :: Show (l s)
=> Lexer l s (Tok t) i
-> (t -> StyleName)
-> TokenBasedMode t
linearSyntaxMode' scanToken tts = fundamentalMode
& modeHLA .~ ExtHL (mkHighlighter $ IncrParser.scanner manyToks . lexer)
& modeGetStrokesA .~ tokenBasedStrokes tokenToStroke
where
tokenToStroke = fmap tts . tokToSpan
lexer = lexScanner scanToken
linearSyntaxMode :: Show s => s
-> TokenLexer AlexState s (Tok t) AlexInput
-> (t -> StyleName)
-> TokenBasedMode t
linearSyntaxMode initSt scanToken =
linearSyntaxMode' (commonLexer scanToken initSt)
styleMode :: Show (l s) => StyleLexer l s t i
-> TokenBasedMode t
styleMode l = linearSyntaxMode' (l ^. styleLexer) (l ^. tokenToStyle)
extensionMatches :: [String]
-> FilePath
-> Bool
extensionMatches extensions fileName = extension `elem` extensions'
where extension = takeExtension fileName
extensions' = ['.' : ext | ext <- extensions]
anyExtension :: [String]
-> FilePath
-> a
-> Bool
anyExtension extensions fileName _contents
= extensionMatches extensions fileName
extensionOrContentsMatch :: [String] -> P.Parser () -> FilePath -> R.YiString -> Bool
extensionOrContentsMatch extensions parser fileName contents
= extensionMatches extensions fileName || m
where
m = case P.parseOnly parser $ R.toText contents of
Left _ -> False
Right _ -> True
shebangParser :: P.Parser a -> P.Parser ()
shebangParser p = void p'
where
p' = "#!" *> P.skipWhile (== ' ') *> "/usr/bin/env " *> P.skipWhile (== ' ') *> p *> P.skipWhile (== ' ') *> P.endOfLine
<|> P.skip (const True) *> P.skipWhile (not . P.isEndOfLine) *> P.skipWhile P.isEndOfLine *> p'
hookModes :: (AnyMode -> Bool) -> BufferM () -> [AnyMode] -> [AnyMode]
hookModes p h = map $ \am@(AnyMode m) ->
if p am then AnyMode (m & modeOnLoadA %~ (>> h)) else am
applyModeHooks :: [(AnyMode -> Bool, BufferM ())] -> [AnyMode] -> [AnyMode]
applyModeHooks hs ms = flip map ms $ \am -> case filter (($ am) . fst) hs of
[] -> am
ls -> onMode (modeOnLoadA %~ \x -> foldr ((>>) . snd) x ls) am
lookupMode :: AnyMode -> YiM AnyMode
lookupMode am@(AnyMode m) = fromMaybe am <$> anyModeByNameM (modeName m)