{-# LANGUAGE CPP, ScopedTypeVariables #-}
{- |
   Module      : Text.Highlighting.Kate.Common
   Copyright   : Copyright (C) 2008 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Parsers used in all the individual syntax parsers.
-}

module Text.Highlighting.Kate.Common where
import Data.ByteString.UTF8 (fromString, toString)
#ifdef _PCRE_LIGHT
import Text.Regex.PCRE.Light
import Data.ByteString (ByteString)
#else
import System.IO.Unsafe (unsafePerformIO)
import Text.Regex.PCRE.ByteString
#endif
import Text.Highlighting.Kate.Types
import Text.ParserCombinators.Parsec hiding (State)
import Data.Char (isDigit, toLower, isSpace)
import Data.List (tails)
import Text.Printf
import Control.Monad.State
import qualified Data.Set as Set

-- | Match filename against a list of globs contained in a semicolon-separated
-- string.
matchGlobs :: String -> String -> Bool
matchGlobs :: [Char] -> [Char] -> Bool
matchGlobs [Char]
fn [Char]
globs = ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (([Char] -> [Char] -> Bool) -> [Char] -> [Char] -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> [Char] -> Bool
matchGlob [Char]
fn) ([Char] -> [[Char]]
splitBySemi ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') [Char]
globs)

-- | Match filename against a glob pattern with asterisks.
matchGlob :: String -> String -> Bool
matchGlob :: [Char] -> [Char] -> Bool
matchGlob (Char
'*':[Char]
xs) [Char]
fn = ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([Char] -> [Char] -> Bool
matchGlob [Char]
xs) ([Char] -> [[Char]]
forall a. [a] -> [[a]]
tails [Char]
fn)
matchGlob (Char
x:[Char]
xs) (Char
y:[Char]
ys) = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
y Bool -> Bool -> Bool
&& [Char] -> [Char] -> Bool
matchGlob [Char]
xs [Char]
ys
matchGlob [Char]
"" [Char]
"" = Bool
True
matchGlob [Char]
_ [Char]
_   = Bool
False

-- | Splits semicolon-separated list
splitBySemi :: String -> [String]
splitBySemi :: [Char] -> [[Char]]
splitBySemi [Char]
"" = []
splitBySemi [Char]
xs =
  let ([Char]
pref, [Char]
suff) = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
';') [Char]
xs
  in  case [Char]
suff of
         []       -> [[Char]
pref]
         (Char
';':[Char]
ys) -> [Char]
pref [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char] -> [[Char]]
splitBySemi [Char]
ys
         [Char]
_        -> [Char] -> [[Char]]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
"The impossible happened (splitBySemi)"

-- | Like >>, but returns the operation on the left.
-- (Suggested by Tillmann Rendel on Haskell-cafe list.)
(>>~) :: (Monad m) => m a -> m b -> m a
m a
a >>~ :: forall (m :: * -> *) a b. Monad m => m a -> m b -> m a
>>~ m b
b = m a
a m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> m b
b m b -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

normalizeHighlighting :: [Token] -> [Token]
normalizeHighlighting :: [Token] -> [Token]
normalizeHighlighting [] = []
normalizeHighlighting ((TokenType
_,[Char]
""):[Token]
xs) = [Token] -> [Token]
normalizeHighlighting [Token]
xs
normalizeHighlighting ((TokenType
NormalTok,[Char]
x):[Token]
xs)
  | (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace [Char]
x = (TokenType
NormalTok,[Char]
x) Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token] -> [Token]
normalizeHighlighting [Token]
xs
normalizeHighlighting ((TokenType
a,[Char]
x):(TokenType
b,[Char]
y):[Token]
xs)
  | TokenType
a TokenType -> TokenType -> Bool
forall a. Eq a => a -> a -> Bool
== TokenType
b = [Token] -> [Token]
normalizeHighlighting ((TokenType
a, [Char]
x[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
y)Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
xs)
normalizeHighlighting (Token
x:[Token]
xs) = Token
x Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token] -> [Token]
normalizeHighlighting [Token]
xs

pushContext :: Context -> KateParser ()
pushContext :: ([Char], [Char]) -> KateParser ()
pushContext ([Char]
lang,[Char]
context) =
                      if [Char]
context [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"#stay"
                         then () -> KateParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                         else do SyntaxState
st <- ParsecT [Char] SyntaxState Identity SyntaxState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                                 let contexts :: ContextStack
contexts = SyntaxState -> ContextStack
synStContexts SyntaxState
st
                                 (SyntaxState -> SyntaxState) -> KateParser ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((SyntaxState -> SyntaxState) -> KateParser ())
-> (SyntaxState -> SyntaxState) -> KateParser ()
forall a b. (a -> b) -> a -> b
$ \SyntaxState
st -> SyntaxState
st{ synStContexts :: ContextStack
synStContexts =
                                                ([Char]
lang,[Char]
context) ([Char], [Char]) -> ContextStack -> ContextStack
forall a. a -> [a] -> [a]
: ContextStack
contexts }

popContext :: KateParser ()
popContext :: KateParser ()
popContext = do SyntaxState
st <- ParsecT [Char] SyntaxState Identity SyntaxState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                case SyntaxState -> ContextStack
synStContexts SyntaxState
st of
                    [([Char], [Char])
_]    -> () -> KateParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- stay if we're at the root
                    (([Char], [Char])
_:ContextStack
xs) -> (SyntaxState -> SyntaxState) -> KateParser ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((SyntaxState -> SyntaxState) -> KateParser ())
-> (SyntaxState -> SyntaxState) -> KateParser ()
forall a b. (a -> b) -> a -> b
$ \SyntaxState
st -> SyntaxState
st{ synStContexts :: ContextStack
synStContexts = ContextStack
xs }
                    []     -> [Char] -> KateParser ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Stack empty"

currentContext :: KateParser Context
currentContext :: KateParser ([Char], [Char])
currentContext = do SyntaxState
st <- ParsecT [Char] SyntaxState Identity SyntaxState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                    case SyntaxState -> ContextStack
synStContexts SyntaxState
st of
                         (([Char], [Char])
x:ContextStack
_) -> ([Char], [Char]) -> KateParser ([Char], [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char], [Char])
x
                         []    -> [Char] -> KateParser ([Char], [Char])
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Stack empty"

withChildren :: KateParser Token
             -> KateParser Token
             -> KateParser Token
withChildren :: KateParser Token -> KateParser Token -> KateParser Token
withChildren KateParser Token
parent KateParser Token
child = do
  (TokenType
pAttr, [Char]
pResult) <- KateParser Token
parent
  (TokenType
_, [Char]
cResult) <- Token -> KateParser Token -> KateParser Token
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (TokenType
NormalTok,[Char]
"") KateParser Token
child
  Token -> KateParser Token
forall (m :: * -> *) a. Monad m => a -> m a
return (TokenType
pAttr, [Char]
pResult [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cResult)

pFirstNonSpace :: KateParser ()
pFirstNonSpace :: KateParser ()
pFirstNonSpace = do
  [Char]
rest <- ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  Bool
prevNonspace <- (SyntaxState -> Bool) -> KateParser Bool
forall a. (SyntaxState -> a) -> KateParser a
fromState SyntaxState -> Bool
synStPrevNonspace
  Bool -> KateParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> KateParser ()) -> Bool -> KateParser ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
prevNonspace Bool -> Bool -> Bool
|| [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
rest Bool -> Bool -> Bool
|| Char -> Bool
isSpace ([Char] -> Char
forall a. [a] -> a
head [Char]
rest)

currentColumn :: GenParser tok st Column
currentColumn :: forall tok st. GenParser tok st Int
currentColumn = SourcePos -> Int
sourceColumn (SourcePos -> Int)
-> ParsecT [tok] st Identity SourcePos
-> ParsecT [tok] st Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT [tok] st Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition

pColumn :: Column -> GenParser tok st ()
pColumn :: forall tok st. Int -> GenParser tok st ()
pColumn Int
col = do
  Int
curCol <- GenParser tok st Int
forall tok st. GenParser tok st Int
currentColumn
  Bool -> GenParser tok st ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> GenParser tok st ()) -> Bool -> GenParser tok st ()
forall a b. (a -> b) -> a -> b
$ Int
col Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
curCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) -- parsec's columns start with 1

pGetCapture :: Int -> KateParser String
pGetCapture :: Int -> ParsecT [Char] SyntaxState Identity [Char]
pGetCapture Int
capNum = do
  [[Char]]
captures <- ParsecT [Char] SyntaxState Identity SyntaxState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState ParsecT [Char] SyntaxState Identity SyntaxState
-> (SyntaxState -> ParsecT [Char] SyntaxState Identity [[Char]])
-> ParsecT [Char] SyntaxState Identity [[Char]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [[Char]] -> ParsecT [Char] SyntaxState Identity [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> ParsecT [Char] SyntaxState Identity [[Char]])
-> (SyntaxState -> [[Char]])
-> SyntaxState
-> ParsecT [Char] SyntaxState Identity [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SyntaxState -> [[Char]]
synStCaptures
  if [[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
captures Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
capNum
     then [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Not enough captures"
     else [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ParsecT [Char] SyntaxState Identity [Char])
-> [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]]
captures [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
!! (Int
capNum Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

pDetectChar :: Bool -> Char -> KateParser String
pDetectChar :: Bool -> Char -> ParsecT [Char] SyntaxState Identity [Char]
pDetectChar Bool
dynamic Char
ch = do
  if Bool
dynamic Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
ch
     then Int -> ParsecT [Char] SyntaxState Identity [Char]
pGetCapture ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char
ch]) ParsecT [Char] SyntaxState Identity [Char]
-> ([Char] -> ParsecT [Char] SyntaxState Identity [Char])
-> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] SyntaxState Identity [Char]
 -> ParsecT [Char] SyntaxState Identity [Char])
-> ([Char] -> ParsecT [Char] SyntaxState Identity [Char])
-> [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string
     else Char -> ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
ch ParsecT [Char] SyntaxState Identity Char
-> (Char -> ParsecT [Char] SyntaxState Identity [Char])
-> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ParsecT [Char] SyntaxState Identity [Char])
-> (Char -> [Char])
-> Char
-> ParsecT [Char] SyntaxState Identity [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[])

pDetect2Chars :: Bool -> Char -> Char -> KateParser [Char]
pDetect2Chars :: Bool -> Char -> Char -> ParsecT [Char] SyntaxState Identity [Char]
pDetect2Chars Bool
dynamic Char
ch1 Char
ch2 = ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] SyntaxState Identity [Char]
 -> ParsecT [Char] SyntaxState Identity [Char])
-> ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall a b. (a -> b) -> a -> b
$ do
  [Char
c1] <- Bool -> Char -> ParsecT [Char] SyntaxState Identity [Char]
pDetectChar Bool
dynamic Char
ch1
  [Char
c2] <- Bool -> Char -> ParsecT [Char] SyntaxState Identity [Char]
pDetectChar Bool
dynamic Char
ch2
  [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c1, Char
c2]

pKeyword :: [Char] -> Set.Set [Char] -> KateParser [Char]
pKeyword :: [Char] -> Set [Char] -> ParsecT [Char] SyntaxState Identity [Char]
pKeyword [Char]
delims Set [Char]
kws = ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] SyntaxState Identity [Char]
 -> ParsecT [Char] SyntaxState Identity [Char])
-> ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall a b. (a -> b) -> a -> b
$ do
  ParsecT [Char] SyntaxState Identity Char -> KateParser ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ([Char] -> ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
delims)
  Char
prevChar <- (SyntaxState -> Char) -> ParsecT [Char] SyntaxState Identity Char
forall a. (SyntaxState -> a) -> KateParser a
fromState SyntaxState -> Char
synStPrevChar
  Bool
caseSensitive <- (SyntaxState -> Bool) -> KateParser Bool
forall a. (SyntaxState -> a) -> KateParser a
fromState SyntaxState -> Bool
synStKeywordCaseSensitive
  Bool -> KateParser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> KateParser ()) -> Bool -> KateParser ()
forall a b. (a -> b) -> a -> b
$ Char
prevChar Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
delims
  [Char]
word <- ParsecT [Char] SyntaxState Identity Char
-> ParsecT [Char] SyntaxState Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ([Char] -> ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
delims)
  let word' :: [Char]
word' = if Bool
caseSensitive
                 then [Char]
word
                 else (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
word
  if [Char]
word' [Char] -> Set [Char] -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set [Char]
kws
     then [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
word
     else [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Keyword not in list"

pString :: Bool -> [Char] -> KateParser String
pString :: Bool -> [Char] -> ParsecT [Char] SyntaxState Identity [Char]
pString Bool
dynamic [Char]
str =
  if Bool
dynamic
     then [Char] -> ParsecT [Char] SyntaxState Identity [Char]
subDynamic [Char]
str ParsecT [Char] SyntaxState Identity [Char]
-> ([Char] -> ParsecT [Char] SyntaxState Identity [Char])
-> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] SyntaxState Identity [Char]
 -> ParsecT [Char] SyntaxState Identity [Char])
-> ([Char] -> ParsecT [Char] SyntaxState Identity [Char])
-> [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string
     else ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] SyntaxState Identity [Char]
 -> ParsecT [Char] SyntaxState Identity [Char])
-> ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
str

pAnyChar :: [Char] -> KateParser [Char]
pAnyChar :: [Char] -> ParsecT [Char] SyntaxState Identity [Char]
pAnyChar [Char]
chars = [Char] -> ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
chars ParsecT [Char] SyntaxState Identity Char
-> (Char -> ParsecT [Char] SyntaxState Identity [Char])
-> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ParsecT [Char] SyntaxState Identity [Char])
-> (Char -> [Char])
-> Char
-> ParsecT [Char] SyntaxState Identity [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[])

pDefault :: KateParser [Char]
pDefault :: ParsecT [Char] SyntaxState Identity [Char]
pDefault = (Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[]) (Char -> [Char])
-> ParsecT [Char] SyntaxState Identity Char
-> ParsecT [Char] SyntaxState Identity [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar

subDynamic :: [Char] -> KateParser [Char]
subDynamic :: [Char] -> ParsecT [Char] SyntaxState Identity [Char]
subDynamic (Char
'%':Char
x:[Char]
xs) | Char -> Bool
isDigit Char
x = do
  [[Char]]
captures <- ParsecT [Char] SyntaxState Identity SyntaxState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState ParsecT [Char] SyntaxState Identity SyntaxState
-> (SyntaxState -> ParsecT [Char] SyntaxState Identity [[Char]])
-> ParsecT [Char] SyntaxState Identity [[Char]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [[Char]] -> ParsecT [Char] SyntaxState Identity [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> ParsecT [Char] SyntaxState Identity [[Char]])
-> (SyntaxState -> [[Char]])
-> SyntaxState
-> ParsecT [Char] SyntaxState Identity [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SyntaxState -> [[Char]]
synStCaptures
  let capNum :: Int
capNum = [Char] -> Int
forall a. Read a => [Char] -> a
read [Char
x]
  let escapeRegexChar :: Char -> [Char]
escapeRegexChar Char
c | Char
c Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
"^$\\[](){}*+.?" = [Char
'\\',Char
c]
                        | Bool
otherwise = [Char
c]
  let escapeRegex :: [Char] -> [Char]
escapeRegex = (Char -> [Char]) -> [Char] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
escapeRegexChar
  let replacement :: [Char]
replacement = if [[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
captures Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
capNum
                       then [Char
'%',Char
x]
                       else [[Char]]
captures [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
!! (Int
capNum Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  [Char] -> ParsecT [Char] SyntaxState Identity [Char]
subDynamic [Char]
xs ParsecT [Char] SyntaxState Identity [Char]
-> ([Char] -> ParsecT [Char] SyntaxState Identity [Char])
-> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ParsecT [Char] SyntaxState Identity [Char])
-> ([Char] -> [Char])
-> [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]
escapeRegex [Char]
replacement [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)
subDynamic (Char
x:[Char]
xs) = [Char] -> ParsecT [Char] SyntaxState Identity [Char]
subDynamic [Char]
xs ParsecT [Char] SyntaxState Identity [Char]
-> ([Char] -> ParsecT [Char] SyntaxState Identity [Char])
-> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ParsecT [Char] SyntaxState Identity [Char])
-> ([Char] -> [Char])
-> [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
xChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)
subDynamic [Char]
"" = [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""

-- convert octal escapes to the form pcre wants.  Note:
-- need at least pcre 8.34 for the form \o{dddd}.
-- So we prefer \ddd or \x{...}.
convertOctal :: String -> String
convertOctal :: [Char] -> [Char]
convertOctal [] = [Char]
""
convertOctal (Char
'\\':Char
'0':Char
x:Char
y:Char
z:[Char]
rest)
  | (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isOctalDigit [Char
x,Char
y,Char
z] = Char
'\\'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
xChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
yChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
zChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
convertOctal [Char]
rest
convertOctal (Char
'\\':Char
x:Char
y:Char
z:[Char]
rest)
  | (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isOctalDigit [Char
x,Char
y,Char
z] =Char
'\\'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
xChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
yChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
zChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
convertOctal [Char]
rest
convertOctal (Char
'\\':Char
'o':Char
'{':[Char]
zs) =
  case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'}') [Char]
zs of
       ([Char]
ds, Char
'}':[Char]
rest) | (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isOctalDigit [Char]
ds Bool -> Bool -> Bool
&& Bool -> Bool
not ([Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ds) ->
            case ReadS Int
forall a. Read a => ReadS a
reads (Char
'0'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'o'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
ds) of
                 ((Int
n :: Int,[]):[(Int, [Char])]
_) -> [Char] -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"\\x{%x}" Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
convertOctal [Char]
rest
                 [(Int, [Char])]
_          -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"Unable to read octal number: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
ds
       ([Char], [Char])
_  -> Char
'\\'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'o'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
'{'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
convertOctal [Char]
zs
convertOctal (Char
x:[Char]
xs) = Char
x Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
convertOctal [Char]
xs

isOctalDigit :: Char -> Bool
isOctalDigit :: Char -> Bool
isOctalDigit Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'1' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'2' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'3'
              Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'4' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'5' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'6' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'7'

compileRegex :: Bool -> String -> Regex
compileRegex :: Bool -> [Char] -> Regex
compileRegex Bool
caseSensitive [Char]
regexpStr =
#ifdef _PCRE_LIGHT
  let opts :: [PCREOption]
opts = [PCREOption
anchored, PCREOption
utf8] [PCREOption] -> [PCREOption] -> [PCREOption]
forall a. [a] -> [a] -> [a]
++ [PCREOption
caseless | Bool -> Bool
not Bool
caseSensitive]
  in  ByteString -> [PCREOption] -> Regex
compile ([Char] -> ByteString
fromString (Char
'.' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
convertOctal [Char]
regexpStr)) [PCREOption]
opts
#else
  let opts = compAnchored + compUTF8 +
               if caseSensitive then 0 else compCaseless
  in  case unsafePerformIO $ compile opts (execNotEmpty)
           (fromString ('.' : convertOctal regexpStr)) of
            Left e  -> error $ "Error compiling regex: " ++ show regexpStr ++
                               "\n" ++ show e
            Right r -> r
#endif

matchRegex :: Regex -> String -> KateParser (Maybe [String])
#ifdef _PCRE_LIGHT
matchRegex :: Regex -> [Char] -> KateParser (Maybe [[Char]])
matchRegex Regex
r [Char]
s = Maybe [[Char]] -> KateParser (Maybe [[Char]])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [[Char]] -> KateParser (Maybe [[Char]]))
-> Maybe [[Char]] -> KateParser (Maybe [[Char]])
forall a b. (a -> b) -> a -> b
$ Maybe [ByteString] -> Maybe [[Char]]
toString' (Maybe [ByteString] -> Maybe [[Char]])
-> Maybe [ByteString] -> Maybe [[Char]]
forall a b. (a -> b) -> a -> b
$ Regex -> ByteString -> [PCREExecOption] -> Maybe [ByteString]
match Regex
r ([Char] -> ByteString
fromString [Char]
s) [PCREExecOption
exec_notempty]
    where toString' :: Maybe [ByteString] -> Maybe [String]
          toString' :: Maybe [ByteString] -> Maybe [[Char]]
toString' (Just [ByteString]
xs) = [[Char]] -> Maybe [[Char]]
forall a. a -> Maybe a
Just ([[Char]] -> Maybe [[Char]]) -> [[Char]] -> Maybe [[Char]]
forall a b. (a -> b) -> a -> b
$ (ByteString -> [Char]) -> [ByteString] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> [Char]
toString [ByteString]
xs
          toString' Maybe [ByteString]
Nothing = Maybe [[Char]]
forall a. Maybe a
Nothing
#else
matchRegex r s = case unsafePerformIO (regexec r (fromString s)) of
                      Right (Just (_, mat, _ , capts)) -> return $
                                       Just $ map toString (mat : capts)
                      Right Nothing -> return Nothing
                      Left matchError -> fail $ show matchError
#endif

pRegExpr :: Regex -> KateParser String
pRegExpr :: Regex -> ParsecT [Char] SyntaxState Identity [Char]
pRegExpr Regex
regex = do
  [Char]
rest <- ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  Char
prevChar <- (SyntaxState -> Char) -> ParsecT [Char] SyntaxState Identity Char
forall a. (SyntaxState -> a) -> KateParser a
fromState SyntaxState -> Char
synStPrevChar
  -- Note: we keep one preceding character, so initial \b can match or not...
  let target :: [Char]
target = if Char
prevChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
                  then Char
' 'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
rest
                  else Char
prevCharChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
rest
  Maybe [[Char]]
matches <- Regex -> [Char] -> KateParser (Maybe [[Char]])
matchRegex Regex
regex [Char]
target
  case Maybe [[Char]]
matches of
        Just ([Char]
x:[[Char]]
xs) | [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
x -> [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Regex matched null string!"
                    | Bool
otherwise -> do
                          Bool -> KateParser () -> KateParser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
xs) (KateParser () -> KateParser ()) -> KateParser () -> KateParser ()
forall a b. (a -> b) -> a -> b
$
                            (SyntaxState -> SyntaxState) -> KateParser ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\SyntaxState
st -> SyntaxState
st {synStCaptures :: [[Char]]
synStCaptures = [[Char]]
xs})
                          Int
-> ParsecT [Char] SyntaxState Identity Char
-> ParsecT [Char] SyntaxState Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count ([Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
        Maybe [[Char]]
_           -> ParsecT [Char] SyntaxState Identity [Char]
forall tok st a. GenParser tok st a
pzero

pRegExprDynamic :: [Char] -> KateParser String
pRegExprDynamic :: [Char] -> ParsecT [Char] SyntaxState Identity [Char]
pRegExprDynamic [Char]
regexpStr = do
  [Char]
regexpStr' <- [Char] -> ParsecT [Char] SyntaxState Identity [Char]
subDynamic [Char]
regexpStr
  Bool
caseSensitive <- SyntaxState -> Bool
synStCaseSensitive (SyntaxState -> Bool)
-> ParsecT [Char] SyntaxState Identity SyntaxState
-> KateParser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT [Char] SyntaxState Identity SyntaxState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Regex -> ParsecT [Char] SyntaxState Identity [Char]
pRegExpr (Regex -> ParsecT [Char] SyntaxState Identity [Char])
-> Regex -> ParsecT [Char] SyntaxState Identity [Char]
forall a b. (a -> b) -> a -> b
$ Bool -> [Char] -> Regex
compileRegex Bool
caseSensitive [Char]
regexpStr'

integerRegex :: Regex
integerRegex :: Regex
integerRegex =
  Bool -> [Char] -> Regex
compileRegex Bool
True [Char]
"\\b[-+]?(0[Xx][0-9A-Fa-f]+|0[Oo][0-7]+|[0-9]+)\\b"

pInt :: KateParser String
pInt :: ParsecT [Char] SyntaxState Identity [Char]
pInt = Regex -> ParsecT [Char] SyntaxState Identity [Char]
pRegExpr Regex
integerRegex

floatRegex :: Regex
floatRegex :: Regex
floatRegex = Bool -> [Char] -> Regex
compileRegex Bool
True [Char]
"\\b[-+]?(([0-9]+\\.[0-9]*|[0-9]*\\.[0-9]+)([Ee][-+]?[0-9]+)?|[0-9]+[Ee][-+]?[0-9]+)\\b"

pFloat :: KateParser String
pFloat :: ParsecT [Char] SyntaxState Identity [Char]
pFloat = Regex -> ParsecT [Char] SyntaxState Identity [Char]
pRegExpr Regex
floatRegex

octRegex :: Regex
octRegex :: Regex
octRegex = Bool -> [Char] -> Regex
compileRegex Bool
True [Char]
"\\b[-+]?0[Oo][0-7]+\\b"

pHlCOct :: KateParser String
pHlCOct :: ParsecT [Char] SyntaxState Identity [Char]
pHlCOct = Regex -> ParsecT [Char] SyntaxState Identity [Char]
pRegExpr Regex
octRegex

hexRegex :: Regex
hexRegex :: Regex
hexRegex = Bool -> [Char] -> Regex
compileRegex Bool
True [Char]
"\\b[-+]?0[Xx][0-9A-Fa-f]+\\b"

pHlCHex :: KateParser String
pHlCHex :: ParsecT [Char] SyntaxState Identity [Char]
pHlCHex = Regex -> ParsecT [Char] SyntaxState Identity [Char]
pRegExpr Regex
hexRegex

pHlCStringChar :: KateParser [Char]
pHlCStringChar :: ParsecT [Char] SyntaxState Identity [Char]
pHlCStringChar = ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] SyntaxState Identity [Char]
 -> ParsecT [Char] SyntaxState Identity [Char])
-> ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
  ([Char] -> ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"abefnrtv\"'?\\" ParsecT [Char] SyntaxState Identity Char
-> (Char -> ParsecT [Char] SyntaxState Identity [Char])
-> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return  ([Char] -> ParsecT [Char] SyntaxState Identity [Char])
-> (Char -> [Char])
-> Char
-> ParsecT [Char] SyntaxState Identity [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Char
x -> [Char
'\\',Char
x]))
    ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do Char
a <- (Char -> Bool) -> ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'x' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'X')
            [Char]
b <- ParsecT [Char] SyntaxState Identity Char
-> ParsecT [Char] SyntaxState Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
            [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\\'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
aChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
b))
    ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do Char
a <- Char -> ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0'
            [Char]
b <- ParsecT [Char] SyntaxState Identity Char
-> ParsecT [Char] SyntaxState Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
octDigit
            [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\\'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
aChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
b))

pHlCChar :: KateParser [Char]
pHlCChar :: ParsecT [Char] SyntaxState Identity [Char]
pHlCChar = ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] SyntaxState Identity [Char]
 -> ParsecT [Char] SyntaxState Identity [Char])
-> ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
  [Char]
c <- ParsecT [Char] SyntaxState Identity [Char]
pHlCStringChar
  Char -> ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
  [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\'' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'")

pRangeDetect :: Char -> Char -> KateParser [Char]
pRangeDetect :: Char -> Char -> ParsecT [Char] SyntaxState Identity [Char]
pRangeDetect Char
startChar Char
endChar = ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] SyntaxState Identity [Char]
 -> ParsecT [Char] SyntaxState Identity [Char])
-> ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
startChar
  [Char]
body <- ParsecT [Char] SyntaxState Identity Char
-> ParsecT [Char] SyntaxState Identity Char
-> ParsecT [Char] SyntaxState Identity [Char]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ((Char -> Bool) -> ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
endChar)) (Char -> ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
endChar)
  [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ParsecT [Char] SyntaxState Identity [Char])
-> [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall a b. (a -> b) -> a -> b
$ Char
startChar Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: ([Char]
body [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
endChar])

pLineContinue :: KateParser String
pLineContinue :: ParsecT [Char] SyntaxState Identity [Char]
pLineContinue = ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT [Char] SyntaxState Identity [Char]
 -> ParsecT [Char] SyntaxState Identity [Char])
-> ParsecT [Char] SyntaxState Identity [Char]
-> ParsecT [Char] SyntaxState Identity [Char]
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
  KateParser ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  (SyntaxState -> SyntaxState) -> KateParser ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((SyntaxState -> SyntaxState) -> KateParser ())
-> (SyntaxState -> SyntaxState) -> KateParser ()
forall a b. (a -> b) -> a -> b
$ \SyntaxState
st -> SyntaxState
st{ synStContinuation :: Bool
synStContinuation = Bool
True }
  [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"\\"

pDetectSpaces :: KateParser [Char]
pDetectSpaces :: ParsecT [Char] SyntaxState Identity [Char]
pDetectSpaces = ParsecT [Char] SyntaxState Identity Char
-> ParsecT [Char] SyntaxState Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ((Char -> Bool) -> ParsecT [Char] SyntaxState Identity Char)
-> (Char -> Bool) -> ParsecT [Char] SyntaxState Identity Char
forall a b. (a -> b) -> a -> b
$ \Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')

-- http://docs.kde.org/stable/en/applications/kate/kate-highlight-rules-detailled.html says this is
-- [a-zA-Z_][a-zA-Z0-9_]*
pDetectIdentifier :: KateParser [Char]
pDetectIdentifier :: ParsecT [Char] SyntaxState Identity [Char]
pDetectIdentifier = do
  Char
first <- ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT [Char] SyntaxState Identity Char
-> ParsecT [Char] SyntaxState Identity Char
-> ParsecT [Char] SyntaxState Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'
  [Char]
rest <- ParsecT [Char] SyntaxState Identity Char
-> ParsecT [Char] SyntaxState Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT [Char] SyntaxState Identity Char
-> ParsecT [Char] SyntaxState Identity Char
-> ParsecT [Char] SyntaxState Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT [Char] SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_')
  [Char] -> ParsecT [Char] SyntaxState Identity [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
firstChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
rest)

fromState :: (SyntaxState -> a) -> KateParser a
fromState :: forall a. (SyntaxState -> a) -> KateParser a
fromState SyntaxState -> a
f = SyntaxState -> a
f (SyntaxState -> a)
-> ParsecT [Char] SyntaxState Identity SyntaxState
-> ParsecT [Char] SyntaxState Identity a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT [Char] SyntaxState Identity SyntaxState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState

mkParseSourceLine :: KateParser Token    -- ^ parseExpressionInternal
                  -> String
                  -> State SyntaxState SourceLine
mkParseSourceLine :: KateParser Token -> [Char] -> State SyntaxState [Token]
mkParseSourceLine KateParser Token
parseExpression [Char]
ln = do
  (SyntaxState -> SyntaxState) -> StateT SyntaxState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SyntaxState -> SyntaxState) -> StateT SyntaxState Identity ())
-> (SyntaxState -> SyntaxState) -> StateT SyntaxState Identity ()
forall a b. (a -> b) -> a -> b
$ \SyntaxState
st -> SyntaxState
st{ synStLineNumber :: Int
synStLineNumber = SyntaxState -> Int
synStLineNumber SyntaxState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
  SyntaxState
st <- StateT SyntaxState Identity SyntaxState
forall s (m :: * -> *). MonadState s m => m s
get
  let lineName :: [Char]
lineName = [Char]
"line " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (SyntaxState -> Int
synStLineNumber SyntaxState
st)
  let pline :: ParsecT [Char] SyntaxState Identity (SyntaxState, [Token])
pline = do [Token]
ts <- KateParser Token
-> KateParser () -> ParsecT [Char] SyntaxState Identity [Token]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill KateParser Token
parseExpression KateParser ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
                 SyntaxState
s  <- ParsecT [Char] SyntaxState Identity SyntaxState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                 (SyntaxState, [Token])
-> ParsecT [Char] SyntaxState Identity (SyntaxState, [Token])
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxState
s, [Token]
ts)
  let (SyntaxState
newst, [Token]
result) = case ParsecT [Char] SyntaxState Identity (SyntaxState, [Token])
-> SyntaxState
-> [Char]
-> [Char]
-> Either ParseError (SyntaxState, [Token])
forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser ParsecT [Char] SyntaxState Identity (SyntaxState, [Token])
pline SyntaxState
st [Char]
lineName [Char]
ln of
                              Left ParseError
_      -> (SyntaxState
st, [(TokenType
ErrorTok,[Char]
ln)])
                              Right (SyntaxState
s,[Token]
r) -> (SyntaxState
s,[Token]
r)
  SyntaxState -> StateT SyntaxState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (SyntaxState -> StateT SyntaxState Identity ())
-> SyntaxState -> StateT SyntaxState Identity ()
forall a b. (a -> b) -> a -> b
$! SyntaxState
newst
  [Token] -> State SyntaxState [Token]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Token] -> State SyntaxState [Token])
-> [Token] -> State SyntaxState [Token]
forall a b. (a -> b) -> a -> b
$! [Token] -> [Token]
normalizeHighlighting [Token]
result