{-# LANGUAGE CPP, ScopedTypeVariables #-}
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
matchGlobs :: String -> String -> Bool
matchGlobs :: String -> String -> Bool
matchGlobs String
fn String
globs = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String -> String -> Bool) -> String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> Bool
matchGlob String
fn) (String -> [String]
splitBySemi (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') String
globs)
matchGlob :: String -> String -> Bool
matchGlob :: String -> String -> Bool
matchGlob (Char
'*':String
xs) String
fn = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
matchGlob String
xs) (String -> [String]
forall a. [a] -> [[a]]
tails String
fn)
matchGlob (Char
x:String
xs) (Char
y:String
ys) = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
y Bool -> Bool -> Bool
&& String -> String -> Bool
matchGlob String
xs String
ys
matchGlob String
"" String
"" = Bool
True
matchGlob String
_ String
_ = Bool
False
splitBySemi :: String -> [String]
splitBySemi :: String -> [String]
splitBySemi String
"" = []
splitBySemi String
xs =
let (String
pref, String
suff) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
';') String
xs
in case String
suff of
[] -> [String
pref]
(Char
';':String
ys) -> String
pref String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
splitBySemi String
ys
String
_ -> String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"The impossible happened (splitBySemi)"
(>>~) :: (Monad m) => m a -> m b -> m a
m a
a >>~ :: 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
_,String
""):[Token]
xs) = [Token] -> [Token]
normalizeHighlighting [Token]
xs
normalizeHighlighting ((TokenType
NormalTok,String
x):[Token]
xs)
| (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
x = (TokenType
NormalTok,String
x) Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token] -> [Token]
normalizeHighlighting [Token]
xs
normalizeHighlighting ((TokenType
a,String
x):(TokenType
b,String
y):[Token]
xs)
| TokenType
a TokenType -> TokenType -> Bool
forall a. Eq a => a -> a -> Bool
== TokenType
b = [Token] -> [Token]
normalizeHighlighting ((TokenType
a, String
xString -> String -> String
forall a. [a] -> [a] -> [a]
++String
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 :: (String, String) -> KateParser ()
pushContext (String
lang,String
context) =
if String
context String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"#stay"
then () -> KateParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do SyntaxState
st <- ParsecT String 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 =
(String
lang,String
context) (String, String) -> ContextStack -> ContextStack
forall a. a -> [a] -> [a]
: ContextStack
contexts }
popContext :: KateParser ()
popContext :: KateParser ()
popContext = do SyntaxState
st <- ParsecT String SyntaxState Identity SyntaxState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
case SyntaxState -> ContextStack
synStContexts SyntaxState
st of
[(String, String)
_] -> () -> KateParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
((String, String)
_: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 }
[] -> String -> KateParser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Stack empty"
currentContext :: KateParser Context
currentContext :: KateParser (String, String)
currentContext = do SyntaxState
st <- ParsecT String SyntaxState Identity SyntaxState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
case SyntaxState -> ContextStack
synStContexts SyntaxState
st of
((String, String)
x:ContextStack
_) -> (String, String) -> KateParser (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String, String)
x
[] -> String -> KateParser (String, String)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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, String
pResult) <- KateParser Token
parent
(TokenType
_, String
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,String
"") KateParser Token
child
Token -> KateParser Token
forall (m :: * -> *) a. Monad m => a -> m a
return (TokenType
pAttr, String
pResult String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cResult)
pFirstNonSpace :: KateParser ()
pFirstNonSpace :: KateParser ()
pFirstNonSpace = do
String
rest <- ParsecT String SyntaxState Identity String
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
|| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest Bool -> Bool -> Bool
|| Char -> Bool
isSpace (String -> Char
forall a. [a] -> a
head String
rest)
currentColumn :: GenParser tok st Column
currentColumn :: GenParser tok st Column
currentColumn = SourcePos -> Column
sourceColumn (SourcePos -> Column)
-> ParsecT [tok] st Identity SourcePos -> GenParser tok st Column
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 :: Column -> GenParser tok st ()
pColumn Column
col = do
Column
curCol <- GenParser tok st Column
forall tok st. GenParser tok st Column
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
$ Column
col Column -> Column -> Bool
forall a. Eq a => a -> a -> Bool
== (Column
curCol Column -> Column -> Column
forall a. Num a => a -> a -> a
- Column
1)
pGetCapture :: Int -> KateParser String
pGetCapture :: Column -> ParsecT String SyntaxState Identity String
pGetCapture Column
capNum = do
[String]
captures <- ParsecT String SyntaxState Identity SyntaxState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState ParsecT String SyntaxState Identity SyntaxState
-> (SyntaxState -> ParsecT String SyntaxState Identity [String])
-> ParsecT String SyntaxState Identity [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> ParsecT String SyntaxState Identity [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> ParsecT String SyntaxState Identity [String])
-> (SyntaxState -> [String])
-> SyntaxState
-> ParsecT String SyntaxState Identity [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SyntaxState -> [String]
synStCaptures
if [String] -> Column
forall (t :: * -> *) a. Foldable t => t a -> Column
length [String]
captures Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
< Column
capNum
then String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not enough captures"
else String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String SyntaxState Identity String)
-> String -> ParsecT String SyntaxState Identity String
forall a b. (a -> b) -> a -> b
$ [String]
captures [String] -> Column -> String
forall a. [a] -> Column -> a
!! (Column
capNum Column -> Column -> Column
forall a. Num a => a -> a -> a
- Column
1)
pDetectChar :: Bool -> Char -> KateParser String
pDetectChar :: Bool -> Char -> ParsecT String SyntaxState Identity String
pDetectChar Bool
dynamic Char
ch = do
if Bool
dynamic Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
ch
then Column -> ParsecT String SyntaxState Identity String
pGetCapture (String -> Column
forall a. Read a => String -> a
read [Char
ch]) ParsecT String SyntaxState Identity String
-> (String -> ParsecT String SyntaxState Identity String)
-> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String)
-> (String -> ParsecT String SyntaxState Identity String)
-> String
-> ParsecT String SyntaxState Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT String SyntaxState Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string
else Char -> ParsecT String SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
ch ParsecT String SyntaxState Identity Char
-> (Char -> ParsecT String SyntaxState Identity String)
-> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String SyntaxState Identity String)
-> (Char -> String)
-> Char
-> ParsecT String SyntaxState Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
forall a. a -> [a] -> [a]
:[])
pDetect2Chars :: Bool -> Char -> Char -> KateParser [Char]
pDetect2Chars :: Bool -> Char -> Char -> ParsecT String SyntaxState Identity String
pDetect2Chars Bool
dynamic Char
ch1 Char
ch2 = ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String)
-> ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
forall a b. (a -> b) -> a -> b
$ do
[Char
c1] <- Bool -> Char -> ParsecT String SyntaxState Identity String
pDetectChar Bool
dynamic Char
ch1
[Char
c2] <- Bool -> Char -> ParsecT String SyntaxState Identity String
pDetectChar Bool
dynamic Char
ch2
String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return [Char
c1, Char
c2]
pKeyword :: [Char] -> Set.Set [Char] -> KateParser [Char]
pKeyword :: String -> Set String -> ParsecT String SyntaxState Identity String
pKeyword String
delims Set String
kws = ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String)
-> ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
forall a b. (a -> b) -> a -> b
$ do
ParsecT String 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 (String -> ParsecT String SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
delims)
Char
prevChar <- (SyntaxState -> Char) -> ParsecT String 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 -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
delims
String
word <- ParsecT String SyntaxState Identity Char
-> ParsecT String SyntaxState Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
delims)
let word' :: String
word' = if Bool
caseSensitive
then String
word
else (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
word
if String
word' String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
kws
then String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
word
else String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Keyword not in list"
pString :: Bool -> [Char] -> KateParser String
pString :: Bool -> String -> ParsecT String SyntaxState Identity String
pString Bool
dynamic String
str =
if Bool
dynamic
then String -> ParsecT String SyntaxState Identity String
subDynamic String
str ParsecT String SyntaxState Identity String
-> (String -> ParsecT String SyntaxState Identity String)
-> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String)
-> (String -> ParsecT String SyntaxState Identity String)
-> String
-> ParsecT String SyntaxState Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParsecT String SyntaxState Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string
else ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String)
-> ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String SyntaxState Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
str
pAnyChar :: [Char] -> KateParser [Char]
pAnyChar :: String -> ParsecT String SyntaxState Identity String
pAnyChar String
chars = String -> ParsecT String SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
chars ParsecT String SyntaxState Identity Char
-> (Char -> ParsecT String SyntaxState Identity String)
-> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String SyntaxState Identity String)
-> (Char -> String)
-> Char
-> ParsecT String SyntaxState Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
forall a. a -> [a] -> [a]
:[])
pDefault :: KateParser [Char]
pDefault :: ParsecT String SyntaxState Identity String
pDefault = (Char -> String -> String
forall a. a -> [a] -> [a]
:[]) (Char -> String)
-> ParsecT String SyntaxState Identity Char
-> ParsecT String SyntaxState Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT String SyntaxState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
subDynamic :: [Char] -> KateParser [Char]
subDynamic :: String -> ParsecT String SyntaxState Identity String
subDynamic (Char
'%':Char
x:String
xs) | Char -> Bool
isDigit Char
x = do
[String]
captures <- ParsecT String SyntaxState Identity SyntaxState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState ParsecT String SyntaxState Identity SyntaxState
-> (SyntaxState -> ParsecT String SyntaxState Identity [String])
-> ParsecT String SyntaxState Identity [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> ParsecT String SyntaxState Identity [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> ParsecT String SyntaxState Identity [String])
-> (SyntaxState -> [String])
-> SyntaxState
-> ParsecT String SyntaxState Identity [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SyntaxState -> [String]
synStCaptures
let capNum :: Column
capNum = String -> Column
forall a. Read a => String -> a
read [Char
x]
let escapeRegexChar :: Char -> String
escapeRegexChar Char
c | Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"^$\\[](){}*+.?" = [Char
'\\',Char
c]
| Bool
otherwise = [Char
c]
let escapeRegex :: String -> String
escapeRegex = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escapeRegexChar
let replacement :: String
replacement = if [String] -> Column
forall (t :: * -> *) a. Foldable t => t a -> Column
length [String]
captures Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
< Column
capNum
then [Char
'%',Char
x]
else [String]
captures [String] -> Column -> String
forall a. [a] -> Column -> a
!! (Column
capNum Column -> Column -> Column
forall a. Num a => a -> a -> a
- Column
1)
String -> ParsecT String SyntaxState Identity String
subDynamic String
xs ParsecT String SyntaxState Identity String
-> (String -> ParsecT String SyntaxState Identity String)
-> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String SyntaxState Identity String)
-> (String -> String)
-> String
-> ParsecT String SyntaxState Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String
escapeRegex String
replacement String -> String -> String
forall a. [a] -> [a] -> [a]
++)
subDynamic (Char
x:String
xs) = String -> ParsecT String SyntaxState Identity String
subDynamic String
xs ParsecT String SyntaxState Identity String
-> (String -> ParsecT String SyntaxState Identity String)
-> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String SyntaxState Identity String)
-> (String -> String)
-> String
-> ParsecT String SyntaxState Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:)
subDynamic String
"" = String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
convertOctal :: String -> String
convertOctal :: String -> String
convertOctal [] = String
""
convertOctal (Char
'\\':Char
'0':Char
x:Char
y:Char
z:String
rest)
| (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isOctalDigit [Char
x,Char
y,Char
z] = Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:Char
yChar -> String -> String
forall a. a -> [a] -> [a]
:Char
zChar -> String -> String
forall a. a -> [a] -> [a]
: String -> String
convertOctal String
rest
convertOctal (Char
'\\':Char
x:Char
y:Char
z:String
rest)
| (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isOctalDigit [Char
x,Char
y,Char
z] =Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:Char
yChar -> String -> String
forall a. a -> [a] -> [a]
:Char
zChar -> String -> String
forall a. a -> [a] -> [a]
: String -> String
convertOctal String
rest
convertOctal (Char
'\\':Char
'o':Char
'{':String
zs) =
case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'}') String
zs of
(String
ds, Char
'}':String
rest) | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isOctalDigit String
ds Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ds) ->
case ReadS Column
forall a. Read a => ReadS a
reads (Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'o'Char -> String -> String
forall a. a -> [a] -> [a]
:String
ds) of
((Column
n :: Int,[]):[(Column, String)]
_) -> String -> Column -> String
forall r. PrintfType r => String -> r
printf String
"\\x{%x}" Column
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
convertOctal String
rest
[(Column, String)]
_ -> String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"Unable to read octal number: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ds
(String, String)
_ -> Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'o'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'{'Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
convertOctal String
zs
convertOctal (Char
x:String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
convertOctal String
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 -> String -> Regex
compileRegex Bool
caseSensitive String
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 (String -> ByteString
fromString (Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
convertOctal String
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 -> String -> KateParser (Maybe [String])
matchRegex Regex
r String
s = Maybe [String] -> KateParser (Maybe [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [String] -> KateParser (Maybe [String]))
-> Maybe [String] -> KateParser (Maybe [String])
forall a b. (a -> b) -> a -> b
$ Maybe [ByteString] -> Maybe [String]
toString' (Maybe [ByteString] -> Maybe [String])
-> Maybe [ByteString] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ Regex -> ByteString -> [PCREExecOption] -> Maybe [ByteString]
match Regex
r (String -> ByteString
fromString String
s) [PCREExecOption
exec_notempty]
where toString' :: Maybe [ByteString] -> Maybe [String]
toString' :: Maybe [ByteString] -> Maybe [String]
toString' (Just [ByteString]
xs) = [String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ (ByteString -> String) -> [ByteString] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
toString [ByteString]
xs
toString' Maybe [ByteString]
Nothing = Maybe [String]
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 String SyntaxState Identity String
pRegExpr Regex
regex = do
String
rest <- ParsecT String SyntaxState Identity String
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
Char
prevChar <- (SyntaxState -> Char) -> ParsecT String SyntaxState Identity Char
forall a. (SyntaxState -> a) -> KateParser a
fromState SyntaxState -> Char
synStPrevChar
let target :: String
target = if Char
prevChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
then Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
rest
else Char
prevCharChar -> String -> String
forall a. a -> [a] -> [a]
:String
rest
Maybe [String]
matches <- Regex -> String -> KateParser (Maybe [String])
matchRegex Regex
regex String
target
case Maybe [String]
matches of
Just (String
x:[String]
xs) | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x -> String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Regex matched null string!"
| Bool
otherwise -> do
Bool -> KateParser () -> KateParser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
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 :: [String]
synStCaptures = [String]
xs})
Column
-> ParsecT String SyntaxState Identity Char
-> ParsecT String SyntaxState Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
Column -> ParsecT s u m a -> ParsecT s u m [a]
count (String -> Column
forall (t :: * -> *) a. Foldable t => t a -> Column
length String
x Column -> Column -> Column
forall a. Num a => a -> a -> a
- Column
1) ParsecT String SyntaxState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
Maybe [String]
_ -> ParsecT String SyntaxState Identity String
forall tok st a. GenParser tok st a
pzero
pRegExprDynamic :: [Char] -> KateParser String
pRegExprDynamic :: String -> ParsecT String SyntaxState Identity String
pRegExprDynamic String
regexpStr = do
String
regexpStr' <- String -> ParsecT String SyntaxState Identity String
subDynamic String
regexpStr
Bool
caseSensitive <- SyntaxState -> Bool
synStCaseSensitive (SyntaxState -> Bool)
-> ParsecT String SyntaxState Identity SyntaxState
-> KateParser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT String SyntaxState Identity SyntaxState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
Regex -> ParsecT String SyntaxState Identity String
pRegExpr (Regex -> ParsecT String SyntaxState Identity String)
-> Regex -> ParsecT String SyntaxState Identity String
forall a b. (a -> b) -> a -> b
$ Bool -> String -> Regex
compileRegex Bool
caseSensitive String
regexpStr'
integerRegex :: Regex
integerRegex :: Regex
integerRegex =
Bool -> String -> Regex
compileRegex Bool
True String
"\\b[-+]?(0[Xx][0-9A-Fa-f]+|0[Oo][0-7]+|[0-9]+)\\b"
pInt :: KateParser String
pInt :: ParsecT String SyntaxState Identity String
pInt = Regex -> ParsecT String SyntaxState Identity String
pRegExpr Regex
integerRegex
floatRegex :: Regex
floatRegex :: Regex
floatRegex = Bool -> String -> Regex
compileRegex Bool
True String
"\\b[-+]?(([0-9]+\\.[0-9]*|[0-9]*\\.[0-9]+)([Ee][-+]?[0-9]+)?|[0-9]+[Ee][-+]?[0-9]+)\\b"
pFloat :: KateParser String
pFloat :: ParsecT String SyntaxState Identity String
pFloat = Regex -> ParsecT String SyntaxState Identity String
pRegExpr Regex
floatRegex
octRegex :: Regex
octRegex :: Regex
octRegex = Bool -> String -> Regex
compileRegex Bool
True String
"\\b[-+]?0[Oo][0-7]+\\b"
pHlCOct :: KateParser String
pHlCOct :: ParsecT String SyntaxState Identity String
pHlCOct = Regex -> ParsecT String SyntaxState Identity String
pRegExpr Regex
octRegex
hexRegex :: Regex
hexRegex :: Regex
hexRegex = Bool -> String -> Regex
compileRegex Bool
True String
"\\b[-+]?0[Xx][0-9A-Fa-f]+\\b"
pHlCHex :: KateParser String
pHlCHex :: ParsecT String SyntaxState Identity String
pHlCHex = Regex -> ParsecT String SyntaxState Identity String
pRegExpr Regex
hexRegex
pHlCStringChar :: KateParser [Char]
pHlCStringChar :: ParsecT String SyntaxState Identity String
pHlCStringChar = ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String)
-> ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
forall a b. (a -> b) -> a -> b
$ do
Char -> ParsecT String SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
(String -> ParsecT String SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"abefnrtv\"'?\\" ParsecT String SyntaxState Identity Char
-> (Char -> ParsecT String SyntaxState Identity String)
-> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String SyntaxState Identity String)
-> (Char -> String)
-> Char
-> ParsecT String SyntaxState Identity String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Char
x -> [Char
'\\',Char
x]))
ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
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 String 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')
String
b <- ParsecT String SyntaxState Identity Char
-> ParsecT String SyntaxState Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String SyntaxState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
aChar -> String -> String
forall a. a -> [a] -> [a]
:String
b))
ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
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 String SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0'
String
b <- ParsecT String SyntaxState Identity Char
-> ParsecT String SyntaxState Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String SyntaxState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
octDigit
String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
aChar -> String -> String
forall a. a -> [a] -> [a]
:String
b))
pHlCChar :: KateParser [Char]
pHlCChar :: ParsecT String SyntaxState Identity String
pHlCChar = ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String)
-> ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
forall a b. (a -> b) -> a -> b
$ do
Char -> ParsecT String SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
String
c <- ParsecT String SyntaxState Identity String
pHlCStringChar
Char -> ParsecT String SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''
String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'")
pRangeDetect :: Char -> Char -> KateParser [Char]
pRangeDetect :: Char -> Char -> ParsecT String SyntaxState Identity String
pRangeDetect Char
startChar Char
endChar = ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String)
-> ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
forall a b. (a -> b) -> a -> b
$ do
Char -> ParsecT String SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
startChar
String
body <- ParsecT String SyntaxState Identity Char
-> ParsecT String SyntaxState Identity Char
-> ParsecT String SyntaxState Identity String
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 String 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 String SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
endChar)
String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT String SyntaxState Identity String)
-> String -> ParsecT String SyntaxState Identity String
forall a b. (a -> b) -> a -> b
$ Char
startChar Char -> String -> String
forall a. a -> [a] -> [a]
: (String
body String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
endChar])
pLineContinue :: KateParser String
pLineContinue :: ParsecT String SyntaxState Identity String
pLineContinue = ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String)
-> ParsecT String SyntaxState Identity String
-> ParsecT String SyntaxState Identity String
forall a b. (a -> b) -> a -> b
$ do
Char -> ParsecT String 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 }
String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"\\"
pDetectSpaces :: KateParser [Char]
pDetectSpaces :: ParsecT String SyntaxState Identity String
pDetectSpaces = ParsecT String SyntaxState Identity Char
-> ParsecT String SyntaxState Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT String SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ((Char -> Bool) -> ParsecT String SyntaxState Identity Char)
-> (Char -> Bool) -> ParsecT String 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')
pDetectIdentifier :: KateParser [Char]
pDetectIdentifier :: ParsecT String SyntaxState Identity String
pDetectIdentifier = do
Char
first <- ParsecT String SyntaxState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String SyntaxState Identity Char
-> ParsecT String SyntaxState Identity Char
-> ParsecT String 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 String SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'
String
rest <- ParsecT String SyntaxState Identity Char
-> ParsecT String SyntaxState Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String SyntaxState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT String SyntaxState Identity Char
-> ParsecT String SyntaxState Identity Char
-> ParsecT String 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 String SyntaxState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_')
String -> ParsecT String SyntaxState Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
firstChar -> String -> String
forall a. a -> [a] -> [a]
:String
rest)
fromState :: (SyntaxState -> a) -> KateParser a
fromState :: (SyntaxState -> a) -> KateParser a
fromState SyntaxState -> a
f = SyntaxState -> a
f (SyntaxState -> a)
-> ParsecT String SyntaxState Identity SyntaxState -> KateParser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT String SyntaxState Identity SyntaxState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
mkParseSourceLine :: KateParser Token
-> String
-> State SyntaxState SourceLine
mkParseSourceLine :: KateParser Token -> String -> State SyntaxState [Token]
mkParseSourceLine KateParser Token
parseExpression String
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 :: Column
synStLineNumber = SyntaxState -> Column
synStLineNumber SyntaxState
st Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
1 }
SyntaxState
st <- StateT SyntaxState Identity SyntaxState
forall s (m :: * -> *). MonadState s m => m s
get
let lineName :: String
lineName = String
"line " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Column -> String
forall a. Show a => a -> String
show (SyntaxState -> Column
synStLineNumber SyntaxState
st)
let pline :: ParsecT String SyntaxState Identity (SyntaxState, [Token])
pline = do [Token]
ts <- KateParser Token
-> KateParser () -> ParsecT String 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 String SyntaxState Identity SyntaxState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
(SyntaxState, [Token])
-> ParsecT String SyntaxState Identity (SyntaxState, [Token])
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxState
s, [Token]
ts)
let (SyntaxState
newst, [Token]
result) = case ParsecT String SyntaxState Identity (SyntaxState, [Token])
-> SyntaxState
-> String
-> String
-> Either ParseError (SyntaxState, [Token])
forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser ParsecT String SyntaxState Identity (SyntaxState, [Token])
pline SyntaxState
st String
lineName String
ln of
Left ParseError
_ -> (SyntaxState
st, [(TokenType
ErrorTok,String
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