{-# OPTIONS_GHC -fno-warn-missing-methods #-}
{-# LANGUAGE StrictData            #-}
{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TypeSynonymInstances  #-}
module Skylighting.Tokenizer (
    tokenize
  , TokenizerConfig(..)
  ) where

import Control.Applicative
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.State.Strict
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.UTF8 as UTF8
import Data.CaseInsensitive (mk)
import Data.Char (isAlphaNum, isAscii, isDigit, isLetter, isSpace, ord)
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import Data.Maybe (catMaybes)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8', encodeUtf8)
import Debug.Trace
import Skylighting.Regex
import Skylighting.Types
import Data.List.NonEmpty (NonEmpty((:|)), (<|), toList)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#endif

newtype Captures = Captures{ Captures -> IntMap ByteString
unCaptures :: IntMap.IntMap ByteString }
  deriving (Int -> Captures -> ShowS
[Captures] -> ShowS
Captures -> [Char]
(Int -> Captures -> ShowS)
-> (Captures -> [Char]) -> ([Captures] -> ShowS) -> Show Captures
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Captures -> ShowS
showsPrec :: Int -> Captures -> ShowS
$cshow :: Captures -> [Char]
show :: Captures -> [Char]
$cshowList :: [Captures] -> ShowS
showList :: [Captures] -> ShowS
Show)

newtype ContextStack =
  ContextStack{ ContextStack -> NonEmpty (Context, Captures)
unContextStack :: NonEmpty (Context, Captures) }
  deriving (Int -> ContextStack -> ShowS
[ContextStack] -> ShowS
ContextStack -> [Char]
(Int -> ContextStack -> ShowS)
-> (ContextStack -> [Char])
-> ([ContextStack] -> ShowS)
-> Show ContextStack
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContextStack -> ShowS
showsPrec :: Int -> ContextStack -> ShowS
$cshow :: ContextStack -> [Char]
show :: ContextStack -> [Char]
$cshowList :: [ContextStack] -> ShowS
showList :: [ContextStack] -> ShowS
Show)

data TokenizerState = TokenizerState{
    TokenizerState -> ByteString
input               :: ByteString
  , TokenizerState -> Bool
endline             :: Bool
  , TokenizerState -> Char
prevChar            :: Char
  , TokenizerState -> ContextStack
contextStack        :: ContextStack
  , TokenizerState -> Captures
captures            :: Captures
  , TokenizerState -> Int
column              :: Int
  , TokenizerState -> Bool
lineContinuation    :: Bool
  , TokenizerState -> Maybe Int
firstNonspaceColumn :: Maybe Int
  , TokenizerState -> Int
loopCounter         :: Int
    -- ^ number of consecutive rule-matching iterations without
    -- consuming any input; used to guard against endless loops
}

-- | Configuration options for 'tokenize'.
data TokenizerConfig = TokenizerConfig{
    TokenizerConfig -> SyntaxMap
syntaxMap   :: SyntaxMap  -- ^ Syntax map to use
  , TokenizerConfig -> Bool
traceOutput :: Bool       -- ^ Generate trace output for debugging
} deriving (Int -> TokenizerConfig -> ShowS
[TokenizerConfig] -> ShowS
TokenizerConfig -> [Char]
(Int -> TokenizerConfig -> ShowS)
-> (TokenizerConfig -> [Char])
-> ([TokenizerConfig] -> ShowS)
-> Show TokenizerConfig
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TokenizerConfig -> ShowS
showsPrec :: Int -> TokenizerConfig -> ShowS
$cshow :: TokenizerConfig -> [Char]
show :: TokenizerConfig -> [Char]
$cshowList :: [TokenizerConfig] -> ShowS
showList :: [TokenizerConfig] -> ShowS
Show)

data Result e a = Success a
                | Failure
                | Error e
     deriving ((forall a b. (a -> b) -> Result e a -> Result e b)
-> (forall a b. a -> Result e b -> Result e a)
-> Functor (Result e)
forall a b. a -> Result e b -> Result e a
forall a b. (a -> b) -> Result e a -> Result e b
forall e a b. a -> Result e b -> Result e a
forall e a b. (a -> b) -> Result e a -> Result e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall e a b. (a -> b) -> Result e a -> Result e b
fmap :: forall a b. (a -> b) -> Result e a -> Result e b
$c<$ :: forall e a b. a -> Result e b -> Result e a
<$ :: forall a b. a -> Result e b -> Result e a
Functor)

deriving instance (Show a, Show e) => Show (Result e a)

newtype TokenizerM a = TM { forall a.
TokenizerM a
-> TokenizerConfig
-> TokenizerState
-> (TokenizerState, Result [Char] a)
runTokenizerM :: TokenizerConfig
                                          -> TokenizerState
                                          -> (TokenizerState, Result String a) }

mapsnd :: (a -> b) -> (c, a) -> (c, b)
mapsnd :: forall a b c. (a -> b) -> (c, a) -> (c, b)
mapsnd a -> b
f (c
x, a
y) = (c
x, a -> b
f a
y)

instance Functor TokenizerM where
  fmap :: forall a b. (a -> b) -> TokenizerM a -> TokenizerM b
fmap a -> b
f (TM TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
g) = (TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] b))
-> TokenizerM b
forall a.
(TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
TM (\TokenizerConfig
c TokenizerState
s -> (Result [Char] a -> Result [Char] b)
-> (TokenizerState, Result [Char] a)
-> (TokenizerState, Result [Char] b)
forall a b c. (a -> b) -> (c, a) -> (c, b)
mapsnd ((a -> b) -> Result [Char] a -> Result [Char] b
forall a b. (a -> b) -> Result [Char] a -> Result [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
g TokenizerConfig
c TokenizerState
s))

instance Applicative TokenizerM where
  pure :: forall a. a -> TokenizerM a
pure a
x = (TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
forall a.
(TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
TM (\TokenizerConfig
_ TokenizerState
s -> (TokenizerState
s, a -> Result [Char] a
forall e a. a -> Result e a
Success a
x))
  (TM TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] (a -> b))
f) <*> :: forall a b. TokenizerM (a -> b) -> TokenizerM a -> TokenizerM b
<*> (TM TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
y) = (TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] b))
-> TokenizerM b
forall a.
(TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
TM (\TokenizerConfig
c TokenizerState
s ->
                           case (TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] (a -> b))
f TokenizerConfig
c TokenizerState
s) of
                              (TokenizerState
s', Result [Char] (a -> b)
Failure   ) -> (TokenizerState
s', Result [Char] b
forall e a. Result e a
Failure)
                              (TokenizerState
s', Error [Char]
e   ) -> (TokenizerState
s', [Char] -> Result [Char] b
forall e a. e -> Result e a
Error [Char]
e)
                              (TokenizerState
s', Success a -> b
f') ->
                                  case (TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
y TokenizerConfig
c TokenizerState
s') of
                                    (TokenizerState
s'', Result [Char] a
Failure   ) -> (TokenizerState
s'', Result [Char] b
forall e a. Result e a
Failure)
                                    (TokenizerState
s'', Error [Char]
e'  ) -> (TokenizerState
s'', [Char] -> Result [Char] b
forall e a. e -> Result e a
Error [Char]
e')
                                    (TokenizerState
s'', Success a
y') -> (TokenizerState
s'', b -> Result [Char] b
forall e a. a -> Result e a
Success (a -> b
f' a
y')))


instance Monad TokenizerM where
  return :: forall a. a -> TokenizerM a
return = a -> TokenizerM a
forall a. a -> TokenizerM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  (TM TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
x) >>= :: forall a b. TokenizerM a -> (a -> TokenizerM b) -> TokenizerM b
>>= a -> TokenizerM b
f = (TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] b))
-> TokenizerM b
forall a.
(TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
TM (\TokenizerConfig
c TokenizerState
s ->
                       case TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
x TokenizerConfig
c TokenizerState
s of
                            (TokenizerState
s', Result [Char] a
Failure   ) -> (TokenizerState
s', Result [Char] b
forall e a. Result e a
Failure)
                            (TokenizerState
s', Error [Char]
e   ) -> (TokenizerState
s', [Char] -> Result [Char] b
forall e a. e -> Result e a
Error [Char]
e)
                            (TokenizerState
s', Success a
x') -> TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] b)
g TokenizerConfig
c TokenizerState
s'
                              where TM TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] b)
g = a -> TokenizerM b
f a
x')

instance Alternative TokenizerM where
  empty :: forall a. TokenizerM a
empty = (TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
forall a.
(TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
TM (\TokenizerConfig
_ TokenizerState
s -> (TokenizerState
s, Result [Char] a
forall e a. Result e a
Failure))
  <|> :: forall a. TokenizerM a -> TokenizerM a -> TokenizerM a
(<|>) (TM TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
x) (TM TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
y) = (TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
forall a.
(TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
TM (\TokenizerConfig
c TokenizerState
s ->
                           case TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
x TokenizerConfig
c TokenizerState
s of
                                (TokenizerState
_, Result [Char] a
Failure   )  -> TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
y TokenizerConfig
c TokenizerState
s
                                (TokenizerState
s', Error [Char]
e   ) -> (TokenizerState
s', [Char] -> Result [Char] a
forall e a. e -> Result e a
Error [Char]
e)
                                (TokenizerState
s', Success a
x') -> (TokenizerState
s', a -> Result [Char] a
forall e a. a -> Result e a
Success a
x'))
  many :: forall a. TokenizerM a -> TokenizerM [a]
many (TM TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
x) = (TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] [a]))
-> TokenizerM [a]
forall a.
(TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
TM (\TokenizerConfig
c TokenizerState
s ->
                    case TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
x TokenizerConfig
c TokenizerState
s of
                       (TokenizerState
_, Result [Char] a
Failure   )  -> (TokenizerState
s, [a] -> Result [Char] [a]
forall e a. a -> Result e a
Success [])
                       (TokenizerState
s', Error [Char]
e   ) -> (TokenizerState
s', [Char] -> Result [Char] [a]
forall e a. e -> Result e a
Error [Char]
e)
                       (TokenizerState
s', Success a
x') -> (Result [Char] [a] -> Result [Char] [a])
-> (TokenizerState, Result [Char] [a])
-> (TokenizerState, Result [Char] [a])
forall a b c. (a -> b) -> (c, a) -> (c, b)
mapsnd (([a] -> [a]) -> Result [Char] [a] -> Result [Char] [a]
forall a b. (a -> b) -> Result [Char] a -> Result [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x'a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) (TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] [a])
g TokenizerConfig
c TokenizerState
s')
                         where TM TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] [a])
g = TokenizerM a -> TokenizerM [a]
forall a. TokenizerM a -> TokenizerM [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
forall a.
(TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
TM TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
x))
  some :: forall a. TokenizerM a -> TokenizerM [a]
some TokenizerM a
x = (:) (a -> [a] -> [a]) -> TokenizerM a -> TokenizerM ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenizerM a
x TokenizerM ([a] -> [a]) -> TokenizerM [a] -> TokenizerM [a]
forall a b. TokenizerM (a -> b) -> TokenizerM a -> TokenizerM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TokenizerM a -> TokenizerM [a]
forall a. TokenizerM a -> TokenizerM [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many TokenizerM a
x

instance MonadPlus TokenizerM where
  mzero :: forall a. TokenizerM a
mzero = TokenizerM a
forall a. TokenizerM a
forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: forall a. TokenizerM a -> TokenizerM a -> TokenizerM a
mplus = TokenizerM a -> TokenizerM a -> TokenizerM a
forall a. TokenizerM a -> TokenizerM a -> TokenizerM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance MonadReader TokenizerConfig TokenizerM where
  ask :: TokenizerM TokenizerConfig
ask = (TokenizerConfig
 -> TokenizerState
 -> (TokenizerState, Result [Char] TokenizerConfig))
-> TokenizerM TokenizerConfig
forall a.
(TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
TM (\TokenizerConfig
c TokenizerState
s -> (TokenizerState
s, TokenizerConfig -> Result [Char] TokenizerConfig
forall e a. a -> Result e a
Success TokenizerConfig
c))
  local :: forall a.
(TokenizerConfig -> TokenizerConfig)
-> TokenizerM a -> TokenizerM a
local TokenizerConfig -> TokenizerConfig
f (TM TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
x) = (TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
forall a.
(TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
TM (TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
x (TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> (TokenizerConfig -> TokenizerConfig)
-> TokenizerConfig
-> TokenizerState
-> (TokenizerState, Result [Char] a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenizerConfig -> TokenizerConfig
f)

instance MonadState TokenizerState TokenizerM where
  get :: TokenizerM TokenizerState
get = (TokenizerConfig
 -> TokenizerState
 -> (TokenizerState, Result [Char] TokenizerState))
-> TokenizerM TokenizerState
forall a.
(TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
TM (\TokenizerConfig
_ TokenizerState
s -> (TokenizerState
s, TokenizerState -> Result [Char] TokenizerState
forall e a. a -> Result e a
Success TokenizerState
s))
  put :: TokenizerState -> TokenizerM ()
put TokenizerState
x = (TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] ()))
-> TokenizerM ()
forall a.
(TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
TM (\TokenizerConfig
_ TokenizerState
_ -> (TokenizerState
x, () -> Result [Char] ()
forall e a. a -> Result e a
Success ()))

instance MonadError String TokenizerM where
  throwError :: forall a. [Char] -> TokenizerM a
throwError [Char]
e = (TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
forall a.
(TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
TM (\TokenizerConfig
_ TokenizerState
s -> (TokenizerState
s, [Char] -> Result [Char] a
forall e a. e -> Result e a
Error [Char]
e))
  catchError :: forall a. TokenizerM a -> ([Char] -> TokenizerM a) -> TokenizerM a
catchError (TM TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
x) [Char] -> TokenizerM a
f = (TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
forall a.
(TokenizerConfig
 -> TokenizerState -> (TokenizerState, Result [Char] a))
-> TokenizerM a
TM (\TokenizerConfig
c TokenizerState
s -> case TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
x TokenizerConfig
c TokenizerState
s of
                                      (TokenizerState
_, Error [Char]
e) -> let TM TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
y = [Char] -> TokenizerM a
f [Char]
e in TokenizerConfig
-> TokenizerState -> (TokenizerState, Result [Char] a)
y TokenizerConfig
c TokenizerState
s
                                      (TokenizerState, Result [Char] a)
z            -> (TokenizerState, Result [Char] a)
z)

-- | Tokenize some text using 'Syntax'.
-- Note that the syntax definitions are assumed to have their
-- keyword lists already resolved into word sets (as is the case
-- for the bundled syntax definitions and for definitions loaded
-- with the functions in Skylighting.Loader).  If you construct a
-- syntax map yourself from syntaxes parsed with
-- 'Skylighting.Parser.parseSyntaxDefinition', apply
-- 'Skylighting.Parser.resolveKeywords' to each syntax first.
tokenize :: TokenizerConfig -> Syntax -> Text -> Either String [SourceLine]
tokenize :: TokenizerConfig -> Syntax -> Text -> Either [Char] [SourceLine]
tokenize TokenizerConfig
config Syntax
syntax Text
inp =
  Either [Char] ContextStack
eitherStack Either [Char] ContextStack
-> (ContextStack -> Either [Char] [SourceLine])
-> Either [Char] [SourceLine]
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(!ContextStack
stack) ->
    case TokenizerM [SourceLine]
-> TokenizerConfig
-> TokenizerState
-> (TokenizerState, Result [Char] [SourceLine])
forall a.
TokenizerM a
-> TokenizerConfig
-> TokenizerState
-> (TokenizerState, Result [Char] a)
runTokenizerM TokenizerM [SourceLine]
action TokenizerConfig
config (ContextStack -> TokenizerState
startingState ContextStack
stack) of
       (TokenizerState
_, Success [SourceLine]
ls) -> [SourceLine] -> Either [Char] [SourceLine]
forall a b. b -> Either a b
Right [SourceLine]
ls
       (TokenizerState
_, Error [Char]
e)    -> [Char] -> Either [Char] [SourceLine]
forall a b. a -> Either a b
Left [Char]
e
       (TokenizerState
_, Result [Char] [SourceLine]
Failure)    -> [Char] -> Either [Char] [SourceLine]
forall a b. a -> Either a b
Left [Char]
"Could not tokenize code"
  where
    action :: TokenizerM [SourceLine]
action = ((ByteString, Int) -> TokenizerM SourceLine)
-> [(ByteString, Int)] -> TokenizerM [SourceLine]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ByteString, Int) -> TokenizerM SourceLine
tokenizeLine ([ByteString] -> [Int] -> [(ByteString, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (ByteString -> [ByteString]
BS.lines (Text -> ByteString
encodeUtf8 Text
inp)) [Int
1..])
    eitherStack :: Either [Char] ContextStack
eitherStack = case Text -> Syntax -> Maybe Context
lookupContext (Syntax -> Text
sStartingContext Syntax
syntax) Syntax
syntax of
                    Just Context
c  -> ContextStack -> Either [Char] ContextStack
forall a b. b -> Either a b
Right (ContextStack -> Either [Char] ContextStack)
-> ContextStack -> Either [Char] ContextStack
forall a b. (a -> b) -> a -> b
$ NonEmpty (Context, Captures) -> ContextStack
ContextStack ((Context
c, IntMap ByteString -> Captures
Captures IntMap ByteString
forall a. Monoid a => a
mempty) (Context, Captures)
-> [(Context, Captures)] -> NonEmpty (Context, Captures)
forall a. a -> [a] -> NonEmpty a
:| [])
                    Maybe Context
Nothing -> [Char] -> Either [Char] ContextStack
forall a b. a -> Either a b
Left [Char]
"No starting context specified"
    startingState :: ContextStack -> TokenizerState
startingState ContextStack
stack =
      TokenizerState{ input :: ByteString
input = ByteString
BS.empty
                    , endline :: Bool
endline = Text -> Bool
Text.null Text
inp
                    , prevChar :: Char
prevChar = Char
'\n'
                    , contextStack :: ContextStack
contextStack = ContextStack
stack
                    , captures :: Captures
captures = IntMap ByteString -> Captures
Captures IntMap ByteString
forall a. Monoid a => a
mempty
                    , column :: Int
column = Int
0
                    , lineContinuation :: Bool
lineContinuation = Bool
False
                    , firstNonspaceColumn :: Maybe Int
firstNonspaceColumn = Maybe Int
forall a. Maybe a
Nothing
                    , loopCounter :: Int
loopCounter = Int
0
                    }

info :: String -> TokenizerM ()
info :: [Char] -> TokenizerM ()
info [Char]
s = do
  tr <- (TokenizerConfig -> Bool) -> TokenizerM Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks TokenizerConfig -> Bool
traceOutput
  when tr $ trace s (return ())

infoContextStack :: TokenizerM ()
infoContextStack :: TokenizerM ()
infoContextStack = do
  tr <- (TokenizerConfig -> Bool) -> TokenizerM Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks TokenizerConfig -> Bool
traceOutput
  when tr $ do
    ContextStack stack <- gets contextStack
    info $ "CONTEXT STACK " ++ show (map (cName . fst) $ toList stack)

popContextStack :: TokenizerM ()
popContextStack :: TokenizerM ()
popContextStack = do
  ContextStack cs <- (TokenizerState -> ContextStack) -> TokenizerM ContextStack
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TokenizerState -> ContextStack
contextStack
  case cs of
       ((Context, Captures)
_ :| []) -> [Char] -> TokenizerM ()
info [Char]
"WARNING: Tried to pop only element on context stack!"
       ((Context, Captures)
_ :| ((Context, Captures)
x:[(Context, Captures)]
xs)) -> do
         (TokenizerState -> TokenizerState) -> TokenizerM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TokenizerState
st -> TokenizerState
st{ contextStack = ContextStack (x :| xs) })
         TokenizerM ()
infoContextStack

pushContextStack :: Context -> TokenizerM ()
pushContextStack :: Context -> TokenizerM ()
pushContextStack Context
cont = do
  (TokenizerState -> TokenizerState) -> TokenizerM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\TokenizerState
st -> TokenizerState
st{ contextStack =
                      ContextStack
                       (((cont, Captures mempty) <|) . unContextStack
                         $ contextStack st) } )
  TokenizerM ()
infoContextStack

currentContext :: TokenizerM Context
currentContext :: TokenizerM Context
currentContext = do
  ContextStack ((c,_) :| _) <- (TokenizerState -> ContextStack) -> TokenizerM ContextStack
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TokenizerState -> ContextStack
contextStack
  return c

doContextSwitch :: ContextSwitch -> TokenizerM ()
doContextSwitch :: ContextSwitch -> TokenizerM ()
doContextSwitch ContextSwitch
Pop = TokenizerM ()
popContextStack
doContextSwitch (Push (!Text
syn,!Text
c)) = do
  syntaxes <- (TokenizerConfig -> SyntaxMap) -> TokenizerM SyntaxMap
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks TokenizerConfig -> SyntaxMap
syntaxMap
  case Map.lookup syn syntaxes >>= lookupContext c of
       Just !Context
con -> Context -> TokenizerM ()
pushContextStack Context
con
       Maybe Context
Nothing   -> [Char] -> TokenizerM ()
forall a. [Char] -> TokenizerM a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char] -> TokenizerM ()) -> [Char] -> TokenizerM ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown syntax or context: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Text, Text) -> [Char]
forall a. Show a => a -> [Char]
show (Text
syn, Text
c)

doContextSwitches :: [ContextSwitch] -> TokenizerM ()
doContextSwitches :: [ContextSwitch] -> TokenizerM ()
doContextSwitches = (ContextSwitch -> TokenizerM ())
-> [ContextSwitch] -> TokenizerM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ContextSwitch -> TokenizerM ()
doContextSwitch

addCaptures :: TokenizerM ()
addCaptures :: TokenizerM ()
addCaptures = do
  capts <- (TokenizerState -> Captures) -> TokenizerM Captures
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TokenizerState -> Captures
captures
  if IntMap.null (unCaptures capts)
     then return ()
     else do
       ContextStack ((c,_) :| cs) <- gets contextStack
       info $ "Adding captures to " <> show (cName c) <> ": " <> show capts
       modify $ \TokenizerState
st -> TokenizerState
st{ contextStack = ContextStack ((c,capts) :| cs) }

getCapture :: Int -> TokenizerM Text
getCapture :: Int -> TokenizerM Text
getCapture Int
capnum = do
  ContextStack ((_,Captures capts) :| _) <- (TokenizerState -> ContextStack) -> TokenizerM ContextStack
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TokenizerState -> ContextStack
contextStack
  info $ "Retrieving capture " <> show capnum
  res <- case IntMap.lookup capnum capts of
          Maybe ByteString
Nothing -> do
            [Char] -> TokenizerM ()
info [Char]
"Not found"
            TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
          Just ByteString
x  -> ByteString -> TokenizerM Text
decodeBS ByteString
x
  info $ "Got " <> show res
  return res

lookupContext :: Text -> Syntax -> Maybe Context
lookupContext :: Text -> Syntax -> Maybe Context
lookupContext Text
name Syntax
syntax | Text -> Bool
Text.null Text
name =
  if Text -> Bool
Text.null (Syntax -> Text
sStartingContext Syntax
syntax)
     then Maybe Context
forall a. Maybe a
Nothing
     else Text -> Syntax -> Maybe Context
lookupContext (Syntax -> Text
sStartingContext Syntax
syntax) Syntax
syntax
lookupContext Text
name Syntax
syntax = Text -> Map Text Context -> Maybe Context
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name (Map Text Context -> Maybe Context)
-> Map Text Context -> Maybe Context
forall a b. (a -> b) -> a -> b
$ Syntax -> Map Text Context
sContexts Syntax
syntax

tokenizeLine :: (ByteString, Int) -> TokenizerM [Token]
tokenizeLine :: (ByteString, Int) -> TokenizerM SourceLine
tokenizeLine (!ByteString
ln, !Int
linenum) = do
  -- column and firstNonspaceColumn restart on every physical line;
  -- a line continuation only suppresses the previous line's
  -- lineEndContext (KDE abstracthighlighter.cpp, highlightLine).
  let !mbFirstNonspace :: Maybe Int
mbFirstNonspace = (Char -> Bool) -> ByteString -> Maybe Int
BS.findIndex (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) (ByteString -> Maybe Int) -> ByteString -> Maybe Int
forall a b. (a -> b) -> a -> b
$! ByteString
ln
  (TokenizerState -> TokenizerState) -> TokenizerM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TokenizerState -> TokenizerState) -> TokenizerM ())
-> (TokenizerState -> TokenizerState) -> TokenizerM ()
forall a b. (a -> b) -> a -> b
$ \TokenizerState
st -> TokenizerState
st{ input = ln
                    , endline = BS.null ln
                    , prevChar = '\n'
                    , lineContinuation = False
                    , column = 0
                    , firstNonspaceColumn = mbFirstNonspace
                    , loopCounter = 0 }
  if ByteString -> Bool
BS.null ByteString
ln
     then do
       -- Empty lines get only the lineEmptyContext switches (which
       -- default to the lineEndContext switches), applied for
       -- successive top contexts until #stay; the lineEndContext is
       -- not applied separately (KDE abstracthighlighter.cpp).
       Int -> TokenizerM ()
handleEmptyLine Int
loopLimit
       SourceLine -> TokenizerM SourceLine
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return []
     else do
       ts <- SourceLine -> SourceLine
normalizeHighlighting (SourceLine -> SourceLine)
-> ([Maybe (TokenType, Text)] -> SourceLine)
-> [Maybe (TokenType, Text)]
-> SourceLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (TokenType, Text)] -> SourceLine
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (TokenType, Text)] -> SourceLine)
-> TokenizerM [Maybe (TokenType, Text)] -> TokenizerM SourceLine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenizerM (Maybe (TokenType, Text))
-> TokenizerM [Maybe (TokenType, Text)]
forall a. TokenizerM a -> TokenizerM [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many TokenizerM (Maybe (TokenType, Text))
getToken
       eol <- gets endline
       if eol
          then do
            checkLineEnd
            return ts
          else do  -- fail if we haven't consumed whole line
            col <- gets column
            throwError $ "Could not match anything at line " ++
              show linenum ++ " column " ++ show col

-- | Limit on iterations that make no progress, to avoid endless
-- loops with broken syntax definitions, as in KDE's
-- abstracthighlighter.cpp.
loopLimit :: Int
loopLimit :: Int
loopLimit = Int
1024

-- | Apply line-empty context switches for successive top contexts
-- until a context with no switches (#stay) is on top, guarding
-- against endless loops (KDE abstracthighlighter.cpp, highlightLine).
handleEmptyLine :: Int -> TokenizerM ()
handleEmptyLine :: Int -> TokenizerM ()
handleEmptyLine Int
counter = do
  cur <- TokenizerM Context
currentContext
  case cLineEmptyContext cur of
    [] -> () -> TokenizerM ()
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- #stay
    [ContextSwitch]
switches
      | Int
counter Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> [Char] -> TokenizerM ()
info ([Char] -> TokenizerM ()) -> [Char] -> TokenizerM ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Endless switch context transitions " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
          [Char]
"for line empty context, aborting highlighting of line."
      | Bool
otherwise -> do
          before <- (TokenizerState -> NonEmpty Context)
-> TokenizerM (NonEmpty Context)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (((Context, Captures) -> Context)
-> NonEmpty (Context, Captures) -> NonEmpty Context
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Context, Captures) -> Context
forall a b. (a, b) -> a
fst (NonEmpty (Context, Captures) -> NonEmpty Context)
-> (TokenizerState -> NonEmpty (Context, Captures))
-> TokenizerState
-> NonEmpty Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextStack -> NonEmpty (Context, Captures)
unContextStack (ContextStack -> NonEmpty (Context, Captures))
-> (TokenizerState -> ContextStack)
-> TokenizerState
-> NonEmpty (Context, Captures)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenizerState -> ContextStack
contextStack)
          doContextSwitches switches
          after <- gets (fmap fst . unContextStack . contextStack)
          -- if the stack is unchanged (e.g. #pop of the initial
          -- context), stop:
          when (before /= after) $ handleEmptyLine (counter - 1)

getToken :: TokenizerM (Maybe Token)
getToken :: TokenizerM (Maybe (TokenType, Text))
getToken = do
  inp <- (TokenizerState -> ByteString) -> TokenizerM ByteString
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TokenizerState -> ByteString
input
  gets endline >>= guard . not
  !context <- currentContext
  counter <- gets loopCounter
  if counter > loopLimit
     -- too many iterations without consuming input (e.g. a cycle of
     -- context switches): abort highlighting of this line, giving
     -- the rest of it the context's attribute, as in KDE's
     -- abstracthighlighter.cpp.
     then do
       info "Endless state transitions, aborting highlighting of line."
       t <- decodeBS inp
       modify $ \TokenizerState
st -> TokenizerState
st{ input = BS.empty
                         , endline = True
                         , prevChar = Text.last t
                         , column = column st + Text.length t }
       return $ Just (cAttribute context, t)
     else getToken' context inp counter

getToken' :: Context -> ByteString -> Int -> TokenizerM (Maybe Token)
getToken' :: Context
-> ByteString -> Int -> TokenizerM (Maybe (TokenType, Text))
getToken' Context
context ByteString
inp Int
counter = do
  (TokenizerState -> TokenizerState) -> TokenizerM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TokenizerState -> TokenizerState) -> TokenizerM ())
-> (TokenizerState -> TokenizerState) -> TokenizerM ()
forall a b. (a -> b) -> a -> b
$ \TokenizerState
st -> TokenizerState
st{ loopCounter = counter + 1 }
  [TokenizerM (Maybe (TokenType, Text))]
-> TokenizerM (Maybe (TokenType, Text))
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ((Rule -> TokenizerM (Maybe (TokenType, Text)))
-> [Rule] -> [TokenizerM (Maybe (TokenType, Text))]
forall a b. (a -> b) -> [a] -> [b]
map (\Rule
r -> Rule -> ByteString -> TokenizerM (Maybe (TokenType, Text))
tryRule Rule
r ByteString
inp) (Context -> [Rule]
cRules Context
context)) TokenizerM (Maybe (TokenType, Text))
-> TokenizerM (Maybe (TokenType, Text))
-> TokenizerM (Maybe (TokenType, Text))
forall a. TokenizerM a -> TokenizerM a -> TokenizerM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     case Context -> [ContextSwitch]
cFallthroughContext Context
context of
           [] | Context -> Bool
cFallthrough Context
context -> Maybe (TokenType, Text)
forall a. Maybe a
Nothing Maybe (TokenType, Text)
-> TokenizerM () -> TokenizerM (Maybe (TokenType, Text))
forall a b. a -> TokenizerM b -> TokenizerM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [ContextSwitch] -> TokenizerM ()
doContextSwitches [ContextSwitch
Pop]
              | Bool
otherwise -> do
                  t <- TokenizerM Text
normalChunk
                  let mbtok = (TokenType, Text) -> Maybe (TokenType, Text)
forall a. a -> Maybe a
Just (Context -> TokenType
cAttribute Context
context, Text
t)
                  info $ "FALLTHROUGH " ++ show mbtok
                  return mbtok
           [ContextSwitch]
cs -> Maybe (TokenType, Text)
forall a. Maybe a
Nothing Maybe (TokenType, Text)
-> TokenizerM () -> TokenizerM (Maybe (TokenType, Text))
forall a b. a -> TokenizerM b -> TokenizerM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [ContextSwitch] -> TokenizerM ()
doContextSwitches [ContextSwitch]
cs

takeChars :: Int -> TokenizerM Text
takeChars :: Int -> TokenizerM Text
takeChars Int
0 = TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
takeChars Int
numchars = do
  inp <- (TokenizerState -> ByteString) -> TokenizerM ByteString
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TokenizerState -> ByteString
input
  let (bs,rest) = UTF8.splitAt numchars inp
  guard $ not (BS.null bs)
  !t <- decodeBS bs
  modify $ \TokenizerState
st -> TokenizerState
st{ input = rest,
                      endline = BS.null rest,
                      prevChar = Text.last t,
                      column = column st + numchars,
                      loopCounter = 0 }  -- input was consumed: progress
  return t

tryRule :: Rule -> ByteString -> TokenizerM (Maybe Token)
tryRule :: Rule -> ByteString -> TokenizerM (Maybe (TokenType, Text))
tryRule Rule
_    ByteString
""  = TokenizerM (Maybe (TokenType, Text))
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
tryRule Rule
rule ByteString
inp = do
  [Char] -> TokenizerM ()
info ([Char] -> TokenizerM ()) -> [Char] -> TokenizerM ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Trying rule " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Rule -> [Char]
forall a. Show a => a -> [Char]
show Rule
rule
  case Rule -> Maybe Int
rColumn Rule
rule of
       Maybe Int
Nothing -> () -> TokenizerM ()
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just Int
n  -> (TokenizerState -> Int) -> TokenizerM Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TokenizerState -> Int
column TokenizerM Int -> (Int -> TokenizerM ()) -> TokenizerM ()
forall a b. TokenizerM a -> (a -> TokenizerM b) -> TokenizerM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> TokenizerM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> TokenizerM ()) -> (Int -> Bool) -> Int -> TokenizerM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n)

  Bool -> TokenizerM () -> TokenizerM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Rule -> Bool
rFirstNonspace Rule
rule) (TokenizerM () -> TokenizerM ()) -> TokenizerM () -> TokenizerM ()
forall a b. (a -> b) -> a -> b
$ do
    !firstNonspace <- (TokenizerState -> Maybe Int) -> TokenizerM (Maybe Int)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TokenizerState -> Maybe Int
firstNonspaceColumn
    !col <- gets column
    guard (firstNonspace == Just col)

  oldstate <- if Rule -> Bool
rLookahead Rule
rule
                 then TokenizerState -> Maybe TokenizerState
forall a. a -> Maybe a
Just (TokenizerState -> Maybe TokenizerState)
-> TokenizerM TokenizerState -> TokenizerM (Maybe TokenizerState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenizerM TokenizerState
forall s (m :: * -> *). MonadState s m => m s
get -- needed for lookahead rules
                 else Maybe TokenizerState -> TokenizerM (Maybe TokenizerState)
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TokenizerState
forall a. Maybe a
Nothing

  -- reset regex captures
  modify $ \TokenizerState
st -> TokenizerState
st{ captures = Captures mempty }

  let attr = Rule -> TokenType
rAttribute Rule
rule
  let delims = Rule -> Set Char
rWordDelimiters Rule
rule
  mbtok <- case rMatcher rule of
                DetectChar Char
c -> TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
attr (TokenizerM Text -> TokenizerM (Maybe (TokenType, Text)))
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$ Bool -> Char -> ByteString -> TokenizerM Text
detectChar (Rule -> Bool
rDynamic Rule
rule) Char
c ByteString
inp
                Detect2Chars Char
c Char
d -> TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
attr (TokenizerM Text -> TokenizerM (Maybe (TokenType, Text)))
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$
                                      Bool -> Char -> Char -> ByteString -> TokenizerM Text
detect2Chars (Rule -> Bool
rDynamic Rule
rule) Char
c Char
d ByteString
inp
                AnyChar Set Char
cs -> TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
attr (TokenizerM Text -> TokenizerM (Maybe (TokenType, Text)))
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$ Set Char -> ByteString -> TokenizerM Text
anyChar Set Char
cs ByteString
inp
                RangeDetect Char
c Char
d -> TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
attr (TokenizerM Text -> TokenizerM (Maybe (TokenType, Text)))
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$ Char -> Char -> ByteString -> TokenizerM Text
rangeDetect Char
c Char
d ByteString
inp
                RegExpr RE
re -> TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
attr (TokenizerM Text -> TokenizerM (Maybe (TokenType, Text)))
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$ Bool -> RE -> ByteString -> TokenizerM Text
regExpr (Rule -> Bool
rDynamic Rule
rule) RE
re ByteString
inp
                Matcher
Int -> TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
attr (TokenizerM Text -> TokenizerM (Maybe (TokenType, Text)))
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$ Set Char -> ByteString -> TokenizerM Text
parseInt Set Char
delims ByteString
inp
                Matcher
HlCOct -> TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
attr (TokenizerM Text -> TokenizerM (Maybe (TokenType, Text)))
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$ Set Char -> ByteString -> TokenizerM Text
parseOct Set Char
delims ByteString
inp
                Matcher
HlCHex -> TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
attr (TokenizerM Text -> TokenizerM (Maybe (TokenType, Text)))
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$ Set Char -> ByteString -> TokenizerM Text
parseHex Set Char
delims ByteString
inp
                Matcher
HlCStringChar -> TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
attr (TokenizerM Text -> TokenizerM (Maybe (TokenType, Text)))
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$ ByteString -> TokenizerM Text
parseCStringChar ByteString
inp
                Matcher
HlCChar -> TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
attr (TokenizerM Text -> TokenizerM (Maybe (TokenType, Text)))
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$ ByteString -> TokenizerM Text
parseCChar ByteString
inp
                Matcher
Float -> TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
attr (TokenizerM Text -> TokenizerM (Maybe (TokenType, Text)))
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$ Set Char -> ByteString -> TokenizerM Text
parseFloat Set Char
delims ByteString
inp
                Keyword KeywordAttr
_kwattr (Left Text
listname) ->
                  [Char] -> TokenizerM (Maybe (TokenType, Text))
forall a. [Char] -> TokenizerM a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char] -> TokenizerM (Maybe (TokenType, Text)))
-> [Char] -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$ [Char]
"Keyword with unresolved list " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
listname
                Keyword KeywordAttr
kwattr (Right WordSet Text
kws) ->
                  TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
attr (TokenizerM Text -> TokenizerM (Maybe (TokenType, Text)))
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$ KeywordAttr -> WordSet Text -> ByteString -> TokenizerM Text
keyword KeywordAttr
kwattr WordSet Text
kws ByteString
inp
                StringDetect Text
s -> TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
attr (TokenizerM Text -> TokenizerM (Maybe (TokenType, Text)))
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$
                                    Bool -> Bool -> Text -> ByteString -> TokenizerM Text
stringDetect (Rule -> Bool
rDynamic Rule
rule) (Rule -> Bool
rCaseSensitive Rule
rule)
                                                 Text
s ByteString
inp
                WordDetect Text
s -> TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
attr (TokenizerM Text -> TokenizerM (Maybe (TokenType, Text)))
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$
                                    Bool -> Set Char -> Text -> ByteString -> TokenizerM Text
wordDetect (Rule -> Bool
rCaseSensitive Rule
rule)
                                      Set Char
delims Text
s ByteString
inp
                LineContinue Char
c -> TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
attr (TokenizerM Text -> TokenizerM (Maybe (TokenType, Text)))
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> TokenizerM Text
lineContinue Char
c ByteString
inp
                Matcher
DetectSpaces -> TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
attr (TokenizerM Text -> TokenizerM (Maybe (TokenType, Text)))
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$ ByteString -> TokenizerM Text
detectSpaces ByteString
inp
                Matcher
DetectIdentifier -> TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
attr (TokenizerM Text -> TokenizerM (Maybe (TokenType, Text)))
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$ ByteString -> TokenizerM Text
detectIdentifier ByteString
inp
                IncludeRules (Text, Text)
cname -> Maybe TokenType
-> (Text, Text)
-> ByteString
-> TokenizerM (Maybe (TokenType, Text))
includeRules
                   (if Rule -> Bool
rIncludeAttribute Rule
rule then TokenType -> Maybe TokenType
forall a. a -> Maybe a
Just TokenType
attr else Maybe TokenType
forall a. Maybe a
Nothing)
                   (Text, Text)
cname ByteString
inp
  mbchildren <- do
    inp' <- gets input
    msum (map (\Rule
r -> Rule -> ByteString -> TokenizerM (Maybe (TokenType, Text))
tryRule Rule
r ByteString
inp') (rChildren rule)) <|> return Nothing

  mbtok' <- case mbtok of
                 Maybe (TokenType, Text)
Nothing -> Maybe (TokenType, Text) -> TokenizerM (Maybe (TokenType, Text))
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (TokenType, Text)
forall a. Maybe a
Nothing
                 Just (TokenType
tt, Text
s)
                   | Rule -> Bool
rLookahead Rule
rule -> do
                     (oldinput, oldendline, oldprevChar, oldColumn,
                      oldLoopCounter) <-
                         case Maybe TokenizerState
oldstate of
                              Maybe TokenizerState
Nothing -> [Char] -> TokenizerM (ByteString, Bool, Char, Int, Int)
forall a. [Char] -> TokenizerM a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
                                    [Char]
"oldstate not saved with lookahead rule"
                              Just TokenizerState
st -> (ByteString, Bool, Char, Int, Int)
-> TokenizerM (ByteString, Bool, Char, Int, Int)
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return
                                    (TokenizerState -> ByteString
input TokenizerState
st, TokenizerState -> Bool
endline TokenizerState
st,
                                     TokenizerState -> Char
prevChar TokenizerState
st, TokenizerState -> Int
column TokenizerState
st,
                                     TokenizerState -> Int
loopCounter TokenizerState
st)
                     -- restore loopCounter too: a lookahead match makes
                     -- no progress, so it must not reset the
                     -- endless-loop guard (takeChars reset it):
                     modify $ \TokenizerState
st -> TokenizerState
st{ input = oldinput
                                       , endline = oldendline
                                       , prevChar = oldprevChar
                                       , column = oldColumn
                                       , loopCounter = oldLoopCounter }
                     return Nothing
                   | Bool
otherwise -> do
                     case Maybe (TokenType, Text)
mbchildren of
                          Maybe (TokenType, Text)
Nothing -> Maybe (TokenType, Text) -> TokenizerM (Maybe (TokenType, Text))
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TokenType, Text) -> TokenizerM (Maybe (TokenType, Text)))
-> Maybe (TokenType, Text) -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$ (TokenType, Text) -> Maybe (TokenType, Text)
forall a. a -> Maybe a
Just (TokenType
tt, Text
s)
                          Just (TokenType
_, Text
cresult) -> Maybe (TokenType, Text) -> TokenizerM (Maybe (TokenType, Text))
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (TokenType, Text) -> TokenizerM (Maybe (TokenType, Text)))
-> Maybe (TokenType, Text) -> TokenizerM (Maybe (TokenType, Text))
forall a b. (a -> b) -> a -> b
$ (TokenType, Text) -> Maybe (TokenType, Text)
forall a. a -> Maybe a
Just (TokenType
tt, Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cresult)

  info $ takeWhile (/=' ') (show (rMatcher rule)) ++ " MATCHED " ++ show mbtok'
  doContextSwitches (rContextSwitch rule)
  -- Add any captures to the context on top of the stack
  addCaptures
  return mbtok'


withAttr :: TokenType -> TokenizerM Text -> TokenizerM (Maybe Token)
withAttr :: TokenType
-> TokenizerM Text -> TokenizerM (Maybe (TokenType, Text))
withAttr TokenType
tt TokenizerM Text
p = do
  res <- TokenizerM Text
p
  if Text.null res
     then return Nothing
     else return $ Just (tt, res)

wordDetect :: Bool -> Set.Set Char -> Text -> ByteString
           -> TokenizerM Text
wordDetect :: Bool -> Set Char -> Text -> ByteString -> TokenizerM Text
wordDetect Bool
caseSensitive Set Char
delims Text
s ByteString
inp = do
  t <- if Bool
caseSensitive
          then do -- fast path: compare bytes without decoding
            Bool -> TokenizerM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> TokenizerM ()) -> Bool -> TokenizerM ()
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
s ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
inp
            Text -> TokenizerM Text
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
          else do
            t <- ByteString -> TokenizerM Text
decodeBS (ByteString -> TokenizerM Text) -> ByteString -> TokenizerM Text
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
UTF8.take (Text -> Int
Text.length Text
s) ByteString
inp
            -- we assume here that the case fold will not change length,
            -- which is safe for ASCII keywords and the like...
            guard $ mk s == mk t
            return t
  guard $ not (Text.null t)
  let isDelim = (Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
delims)
  -- KDE requires a word delimiter (or start of line) before the
  -- word, or as its first character (this is why \n<DOCTYPE!
  -- matches \b<DOCTYPE!/b):
  prev <- gets prevChar
  guard $ isDelim prev || isDelim (Text.head t)
  let c = HasCallStack => Text -> Char
Text -> Char
Text.last Text
t
  let rest = Int -> ByteString -> ByteString
UTF8.drop (Text -> Int
Text.length Text
s) ByteString
inp
  let d = case ByteString -> Maybe (Char, ByteString)
UTF8.uncons ByteString
rest of
               Maybe (Char, ByteString)
Nothing    -> Char
'\n'
               Just (Char
x,ByteString
_) -> Char
x
  -- ... and a word delimiter (or end of line) after the word, or
  -- as its last character:
  guard $ isDelim d || isDelim c
  takeChars (Text.length t)

stringDetect :: Bool -> Bool -> Text -> ByteString -> TokenizerM Text
stringDetect :: Bool -> Bool -> Text -> ByteString -> TokenizerM Text
stringDetect Bool
dynamic Bool
caseSensitive Text
s ByteString
inp = do
  s' <- if Bool
dynamic
        then do
          dynStr <- Text -> TokenizerM Text
subDynamicText Text
s
          info $ "Dynamic string: " ++ show dynStr
          return dynStr
        else Text -> TokenizerM Text
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s
  if caseSensitive
     then -- fast path: compare bytes without decoding
          guard $ encodeUtf8 s' `BS.isPrefixOf` inp
     else do
       t <- decodeBS $ UTF8.take (Text.length s') inp
       -- we assume here that the case fold will not change length,
       -- which is safe for ASCII keywords and the like...
       guard $ mk s' == mk t
  takeChars (Text.length s')

subDynamicText :: Text -> TokenizerM Text
subDynamicText :: Text -> TokenizerM Text
subDynamicText Text
t = do
  let substitute :: Text -> TokenizerM Text
substitute Text
x = case Text -> Maybe (Char, Text)
Text.uncons Text
x of
        Just (Char
c, Text
rest) | Char -> Bool
isDigit Char
c -> let capNum :: Int
capNum = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'
                                      in (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rest) (Text -> Text) -> TokenizerM Text -> TokenizerM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> TokenizerM Text
getCapture Int
capNum
        Maybe (Char, Text)
_ -> Text -> TokenizerM Text
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TokenizerM Text) -> Text -> TokenizerM Text
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
Text.cons Char
'%' Text
x
  case (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'%') Text
t of
    []     -> Text -> TokenizerM Text
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
Text.empty
    Text
x:[Text]
rest -> (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.concat ([Text] -> Text) -> TokenizerM [Text] -> TokenizerM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> TokenizerM Text) -> [Text] -> TokenizerM [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> TokenizerM Text
substitute [Text]
rest

-- This assumes that nothing significant will happen
-- in the middle of a string of spaces or a string
-- of alphanumerics.  This seems true  for all normal
-- programming languages, and the optimization speeds
-- things up a lot, relative to just parsing one char.
normalChunk :: TokenizerM Text
normalChunk :: TokenizerM Text
normalChunk = do
  inp <- (TokenizerState -> ByteString) -> TokenizerM ByteString
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TokenizerState -> ByteString
input
  case UTF8.uncons inp of
    Maybe (Char, ByteString)
Nothing -> TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    Just (Char
c, ByteString
_)
      | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' ->
        let bs :: ByteString
bs = (Char -> Bool) -> ByteString -> ByteString
BS.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') ByteString
inp
        in  Int -> TokenizerM Text
takeChars (ByteString -> Int
BS.length ByteString
bs)
      | Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c ->
        let (ByteString
bs, ByteString
_) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
UTF8.span Char -> Bool
isAlphaNum ByteString
inp
        in  Int -> TokenizerM Text
takeChars (ByteString -> Int
UTF8.length ByteString
bs)
      | Bool
otherwise -> Int -> TokenizerM Text
takeChars Int
1

includeRules :: Maybe TokenType -> ContextName -> ByteString
             -> TokenizerM (Maybe Token)
includeRules :: Maybe TokenType
-> (Text, Text)
-> ByteString
-> TokenizerM (Maybe (TokenType, Text))
includeRules Maybe TokenType
mbattr (Text
syn, Text
con) ByteString
inp = do
  syntaxes <- (TokenizerConfig -> SyntaxMap) -> TokenizerM SyntaxMap
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks TokenizerConfig -> SyntaxMap
syntaxMap
  case Map.lookup syn syntaxes >>= lookupContext con of
       Maybe Context
Nothing  -> do
          cur <- TokenizerM Context
currentContext
          throwError $ "IncludeRules in " ++ Text.unpack (cSyntax cur) ++
           " requires undefined context " ++
           Text.unpack con ++ "##" ++ Text.unpack syn
       Just Context
c   -> do
         mbtok <- [TokenizerM (Maybe (TokenType, Text))]
-> TokenizerM (Maybe (TokenType, Text))
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ((Rule -> TokenizerM (Maybe (TokenType, Text)))
-> [Rule] -> [TokenizerM (Maybe (TokenType, Text))]
forall a b. (a -> b) -> [a] -> [b]
map (\Rule
r -> Rule -> ByteString -> TokenizerM (Maybe (TokenType, Text))
tryRule Rule
r ByteString
inp) (Context -> [Rule]
cRules Context
c))
         modify $ \TokenizerState
st -> TokenizerState
st{ captures = Captures mempty }
         return $ case (mbtok, mbattr) of
                    (Just (TokenType
NormalTok, Text
xs), Just TokenType
attr) -> (TokenType, Text) -> Maybe (TokenType, Text)
forall a. a -> Maybe a
Just (TokenType
attr, Text
xs)
                    (Maybe (TokenType, Text), Maybe TokenType)
_                                 -> Maybe (TokenType, Text)
mbtok

-- | Apply line-end context switches for successive top contexts
-- until a context with no switches (#stay) is on top, guarding
-- against endless loops (KDE abstracthighlighter.cpp, highlightLine).
checkLineEnd :: TokenizerM ()
checkLineEnd :: TokenizerM ()
checkLineEnd = do
  lineCont' <- (TokenizerState -> Bool) -> TokenizerM Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TokenizerState -> Bool
lineContinuation
  unless lineCont' $ go loopLimit
 where
  go :: a -> TokenizerM ()
go a
counter = do
    c <- TokenizerM Context
currentContext
    unless (null (cLineEndContext c)) $
      if counter <= 0
         then info $ "Endless switch context transitions " ++
                "for line end context, aborting highlighting of line."
         else do
           info $ "checkLineEnd for " ++ show (cName c) ++
                  " cLineEndContext = " ++ show (cLineEndContext c)
           before <- gets (fmap fst . unContextStack . contextStack)
           doContextSwitches (cLineEndContext c)
           after <- gets (fmap fst . unContextStack . contextStack)
           -- if the stack is unchanged (e.g. #pop of the initial
           -- context), stop:
           when (before /= after) $ go (counter - 1)

detectChar :: Bool -> Char -> ByteString -> TokenizerM Text
detectChar :: Bool -> Char -> ByteString -> TokenizerM Text
detectChar Bool
dynamic Char
c ByteString
inp = do
  c' <- if Bool
dynamic Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'
           then Char -> TokenizerM Char
getDynamicChar Char
c
           else Char -> TokenizerM Char
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
  case UTF8.uncons inp of
    Just (Char
x,ByteString
_) | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c' -> Int -> TokenizerM Text
takeChars Int
1
    Maybe (Char, ByteString)
_          -> TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

getDynamicChar :: Char -> TokenizerM Char
getDynamicChar :: Char -> TokenizerM Char
getDynamicChar Char
c = do
  let capNum :: Int
capNum = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'
  res <- Int -> TokenizerM Text
getCapture Int
capNum
  case Text.uncons res of
       Maybe (Char, Text)
Nothing    -> TokenizerM Char
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
       Just (Char
d,Text
_) -> Char -> TokenizerM Char
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
d

detect2Chars :: Bool -> Char -> Char -> ByteString -> TokenizerM Text
detect2Chars :: Bool -> Char -> Char -> ByteString -> TokenizerM Text
detect2Chars Bool
dynamic Char
c Char
d ByteString
inp = do
  c' <- if Bool
dynamic Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'
           then Char -> TokenizerM Char
getDynamicChar Char
c
           else Char -> TokenizerM Char
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
  d' <- if dynamic && d >= '0' && d <= '9'
           then getDynamicChar d
           else return d
  case UTF8.uncons inp of
    Just (Char
x, ByteString
rest) | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c' ->
      case ByteString -> Maybe (Char, ByteString)
UTF8.uncons ByteString
rest of
        Just (Char
y, ByteString
_) | Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
d' -> Int -> TokenizerM Text
takeChars Int
2
        Maybe (Char, ByteString)
_ -> TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    Maybe (Char, ByteString)
_ -> TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

rangeDetect :: Char -> Char -> ByteString -> TokenizerM Text
rangeDetect :: Char -> Char -> ByteString -> TokenizerM Text
rangeDetect Char
c Char
d ByteString
inp = do
  case ByteString -> Maybe (Char, ByteString)
UTF8.uncons ByteString
inp of
    Just (Char
x, ByteString
rest)
      | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c -> case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
UTF8.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
d) ByteString
rest of
                       (ByteString
in_t, ByteString
out_t)
                         | ByteString -> Bool
BS.null ByteString
out_t -> TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
                         | Bool
otherwise -> do
                              t <- ByteString -> TokenizerM Text
decodeBS ByteString
in_t
                              takeChars (Text.length t + 2)
    Maybe (Char, ByteString)
_ -> TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- NOTE: currently limited to ASCII
detectSpaces :: ByteString -> TokenizerM Text
detectSpaces :: ByteString -> TokenizerM Text
detectSpaces ByteString
inp = do
  case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (\Char
c -> Char -> Bool
isSpace Char
c) ByteString
inp of
       (ByteString
t, ByteString
_)
         | ByteString -> Bool
BS.null ByteString
t -> TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
         | Bool
otherwise -> Int -> TokenizerM Text
takeChars (ByteString -> Int
BS.length ByteString
t)

-- NOTE: limited to ASCII as per kate documentation
detectIdentifier :: ByteString -> TokenizerM Text
detectIdentifier :: ByteString -> TokenizerM Text
detectIdentifier ByteString
inp = do
  case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
inp of
    Just (Char
c, ByteString
t) | (Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isLetter Char
c) Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' ->
      Int -> TokenizerM Text
takeChars (Int -> TokenizerM Text) -> Int -> TokenizerM Text
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> Int
BS.length ByteString
t) Int -> Int
forall a. a -> a
id
                ((Char -> Bool) -> ByteString -> Maybe Int
BS.findIndex (\Char
d -> Bool -> Bool
not (Char -> Bool
isAscii Char
d) Bool -> Bool -> Bool
||
                                     Bool -> Bool
not (Char -> Bool
isAlphaNum Char
d Bool -> Bool -> Bool
|| Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')) ByteString
t)
    Maybe (Char, ByteString)
_ -> TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

lineContinue :: Char -> ByteString -> TokenizerM Text
lineContinue :: Char -> ByteString -> TokenizerM Text
lineContinue Char
c ByteString
inp = do
  if ByteString
inp ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== [Char] -> ByteString
UTF8.fromString [Char
c]
     then do
       (TokenizerState -> TokenizerState) -> TokenizerM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TokenizerState -> TokenizerState) -> TokenizerM ())
-> (TokenizerState -> TokenizerState) -> TokenizerM ()
forall a b. (a -> b) -> a -> b
$ \TokenizerState
st -> TokenizerState
st{ lineContinuation = True }
       Int -> TokenizerM Text
takeChars Int
1
     else TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

anyChar :: Set.Set Char -> ByteString -> TokenizerM Text
anyChar :: Set Char -> ByteString -> TokenizerM Text
anyChar Set Char
cs ByteString
inp = do
  case ByteString -> Maybe (Char, ByteString)
UTF8.uncons ByteString
inp of
     Just (Char
x, ByteString
_) | Char
x Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
cs -> Int -> TokenizerM Text
takeChars Int
1
     Maybe (Char, ByteString)
_           -> TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

regExpr :: Bool -> RE -> ByteString -> TokenizerM Text
regExpr :: Bool -> RE -> ByteString -> TokenizerM Text
regExpr Bool
dynamic RE
re ByteString
inp = do
  -- return $! traceShowId $! (reStr, inp)
  let reStr :: ByteString
reStr = RE -> ByteString
reString RE
re
  Bool -> TokenizerM () -> TokenizerM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> ByteString -> ByteString
BS.take Int
2 ByteString
reStr ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"\\b") (TokenizerM () -> TokenizerM ()) -> TokenizerM () -> TokenizerM ()
forall a b. (a -> b) -> a -> b
$ ByteString -> TokenizerM ()
wordBoundary ByteString
inp
  (regex, groups) <- case RE -> Either [Char] (Regex, IntMap Regex)
compileRE RE
re of
            Right (Regex, IntMap Regex)
r  -> (Regex, IntMap Regex) -> TokenizerM (Regex, IntMap Regex)
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex, IntMap Regex)
r
            Left [Char]
e   -> [Char] -> TokenizerM (Regex, IntMap Regex)
forall a. [Char] -> TokenizerM a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char] -> TokenizerM (Regex, IntMap Regex))
-> [Char] -> TokenizerM (Regex, IntMap Regex)
forall a b. (a -> b) -> a -> b
$
              [Char]
"Error compiling regex " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
              ByteString -> [Char]
UTF8.toString ByteString
reStr [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
e
  mbmatch <- if dynamic
                then do
                  regex' <- subDynamic regex
                  -- the capturing groups have to be recomputed after
                  -- dynamic substitution (matchRegex does this):
                  return $ matchRegex regex' inp
                else return $ matchRegexWithGroups groups regex inp
  case mbmatch of
        Just (ByteString
matchedBytes, IntMap (Int, Int)
capts) -> do
          Bool -> TokenizerM () -> TokenizerM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (IntMap (Int, Int) -> Bool
forall a. IntMap a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null IntMap (Int, Int)
capts) (TokenizerM () -> TokenizerM ()) -> TokenizerM () -> TokenizerM ()
forall a b. (a -> b) -> a -> b
$
            (TokenizerState -> TokenizerState) -> TokenizerM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TokenizerState -> TokenizerState) -> TokenizerM ())
-> (TokenizerState -> TokenizerState) -> TokenizerM ()
forall a b. (a -> b) -> a -> b
$ \TokenizerState
st -> TokenizerState
st{ captures = Captures $
                                  IntMap.map (toSlice inp) capts }
          Int -> TokenizerM Text
takeChars (ByteString -> Int
UTF8.length ByteString
matchedBytes)
        Maybe (ByteString, IntMap (Int, Int))
_ -> TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

toSlice :: ByteString -> (Int, Int) -> ByteString
toSlice :: ByteString -> (Int, Int) -> ByteString
toSlice ByteString
bs (Int
off, Int
len) = Int -> ByteString -> ByteString
BS.take Int
len (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
off ByteString
bs

wordBoundary :: ByteString -> TokenizerM ()
wordBoundary :: ByteString -> TokenizerM ()
wordBoundary ByteString
inp = do
  case ByteString -> Maybe (Char, ByteString)
UTF8.uncons ByteString
inp of
       Maybe (Char, ByteString)
Nothing -> () -> TokenizerM ()
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       Just (Char
d, ByteString
_) -> do
         c <- (TokenizerState -> Char) -> TokenizerM Char
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TokenizerState -> Char
prevChar
         guard $ isWordBoundary c d

isWordBoundary :: Char -> Char -> Bool
isWordBoundary :: Char -> Char -> Bool
isWordBoundary Char
c Char
d = Char -> Bool
isWordChar Char
c Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Bool
isWordChar Char
d

-- In KDE, Int, Float, HlCOct, and HlCHex rules match only if the
-- preceding character is a word delimiter (or we are at the start
-- of the line, which we detect via prevChar == '\n', since '\n'
-- is always a delimiter).  Nothing is required of the character
-- following the match.
precededByWordDelim :: Set.Set Char -> TokenizerM ()
precededByWordDelim :: Set Char -> TokenizerM ()
precededByWordDelim Set Char
delims = do
  c <- (TokenizerState -> Char) -> TokenizerM Char
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TokenizerState -> Char
prevChar
  guard $ c `Set.member` delims

decodeBS :: ByteString -> TokenizerM Text
decodeBS :: ByteString -> TokenizerM Text
decodeBS ByteString
bs = case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
bs of
                    Left UnicodeException
_ -> [Char] -> TokenizerM Text
forall a. [Char] -> TokenizerM a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char]
"ByteString " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
                                ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
bs [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"is not UTF8")
                    Right Text
t -> Text -> TokenizerM Text
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t

-- Substitute out %1, %2, etc. in regex string, escaping
-- appropriately..
subDynamic :: Regex -> TokenizerM Regex
subDynamic :: Regex -> TokenizerM Regex
subDynamic (MatchDynamic Int
capNum) = do
  replacement <- Int -> TokenizerM Text
getCapture Int
capNum
  return $ mconcat $ map (MatchChar . (==)) $ Text.unpack replacement
subDynamic (MatchAlt Regex
r1 Regex
r2) =
  Regex -> Regex -> Regex
MatchAlt (Regex -> Regex -> Regex)
-> TokenizerM Regex -> TokenizerM (Regex -> Regex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Regex -> TokenizerM Regex
subDynamic Regex
r1 TokenizerM (Regex -> Regex) -> TokenizerM Regex -> TokenizerM Regex
forall a b. TokenizerM (a -> b) -> TokenizerM a -> TokenizerM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Regex -> TokenizerM Regex
subDynamic Regex
r2
subDynamic (MatchConcat Regex
r1 Regex
r2) =
  Regex -> Regex -> Regex
MatchConcat (Regex -> Regex -> Regex)
-> TokenizerM Regex -> TokenizerM (Regex -> Regex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Regex -> TokenizerM Regex
subDynamic Regex
r1 TokenizerM (Regex -> Regex) -> TokenizerM Regex -> TokenizerM Regex
forall a b. TokenizerM (a -> b) -> TokenizerM a -> TokenizerM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Regex -> TokenizerM Regex
subDynamic Regex
r2
subDynamic (MatchSome Regex
r) =
  Regex -> Regex
MatchSome (Regex -> Regex) -> TokenizerM Regex -> TokenizerM Regex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Regex -> TokenizerM Regex
subDynamic Regex
r
subDynamic (MatchCapture Int
i Regex
r) =
  Int -> Regex -> Regex
MatchCapture Int
i (Regex -> Regex) -> TokenizerM Regex -> TokenizerM Regex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Regex -> TokenizerM Regex
subDynamic Regex
r
subDynamic (AssertPositive Direction
dir Regex
r) =
  Direction -> Regex -> Regex
AssertPositive Direction
dir (Regex -> Regex) -> TokenizerM Regex -> TokenizerM Regex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Regex -> TokenizerM Regex
subDynamic Regex
r
subDynamic (AssertNegative Direction
dir Regex
r) =
  Direction -> Regex -> Regex
AssertNegative Direction
dir (Regex -> Regex) -> TokenizerM Regex -> TokenizerM Regex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Regex -> TokenizerM Regex
subDynamic Regex
r
subDynamic Regex
x = Regex -> TokenizerM Regex
forall a. a -> TokenizerM a
forall (m :: * -> *) a. Monad m => a -> m a
return Regex
x

keyword :: KeywordAttr -> WordSet Text -> ByteString -> TokenizerM Text
keyword :: KeywordAttr -> WordSet Text -> ByteString -> TokenizerM Text
keyword KeywordAttr
kwattr WordSet Text
kws ByteString
inp = do
  prev <- (TokenizerState -> Char) -> TokenizerM Char
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TokenizerState -> Char
prevChar
  guard $ prev `Set.member` (keywordDelims kwattr)
  let (w,_) = UTF8.break (`Set.member` (keywordDelims kwattr)) inp
  guard $ not (BS.null w)
  w' <- decodeBS w
  let numchars = Text -> Int
Text.length Text
w'
  if w' `inWordSet` kws
     then takeChars numchars
     else mzero

normalizeHighlighting :: [Token] -> [Token]
normalizeHighlighting :: SourceLine -> SourceLine
normalizeHighlighting [] = []
normalizeHighlighting ((!TokenType
t,!Text
x):SourceLine
xs)
  | Text -> Bool
Text.null Text
x = SourceLine -> SourceLine
normalizeHighlighting SourceLine
xs
  | Bool
otherwise =
    (TokenType
t, Text
matchedText) (TokenType, Text) -> SourceLine -> SourceLine
forall a. a -> [a] -> [a]
: SourceLine -> SourceLine
normalizeHighlighting SourceLine
rest
    where (SourceLine
matches, SourceLine
rest) = ((TokenType, Text) -> Bool)
-> SourceLine -> (SourceLine, SourceLine)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\(TokenType
z,Text
_) -> TokenType
z TokenType -> TokenType -> Bool
forall a. Eq a => a -> a -> Bool
== TokenType
t) SourceLine
xs
          !matchedText :: Text
matchedText = [Text] -> Text
Text.concat (Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((TokenType, Text) -> Text) -> SourceLine -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (TokenType, Text) -> Text
forall a b. (a, b) -> b
snd SourceLine
matches)


parseCStringChar :: ByteString -> TokenizerM Text
parseCStringChar :: ByteString -> TokenizerM Text
parseCStringChar ByteString
inp = do
  case Parser (ByteString, ())
-> ByteString -> Either [Char] (ByteString, ())
forall a. Parser a -> ByteString -> Either [Char] a
A.parseOnly (Parser () -> Parser (ByteString, ())
forall a. Parser a -> Parser (ByteString, a)
A.match Parser ()
pCStringChar) ByteString
inp of
       Left [Char]
_      -> TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
       Right (ByteString
r,()
_) -> Int -> TokenizerM Text
takeChars (ByteString -> Int
BS.length ByteString
r) -- assumes ascii

pCStringChar :: A.Parser ()
pCStringChar :: Parser ()
pCStringChar = do
  _ <- Char -> Parser Char
A.char Char
'\\'
  next <- A.anyChar
  case next of
       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' -> () () -> Parser ByteString ByteString -> Parser ()
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile1 ([Char] -> Char -> Bool
A.inClass [Char]
"0-9a-fA-F")
         | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' -> () () -> Parser ByteString ByteString -> Parser ()
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile ([Char] -> Char -> Bool
A.inClass [Char]
"0-7")
         | [Char] -> Char -> Bool
A.inClass [Char]
"abefnrtv\"'?\\" Char
c -> () -> Parser ()
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         | Bool
otherwise -> Parser ()
forall a. Parser ByteString a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

parseCChar :: ByteString -> TokenizerM Text
parseCChar :: ByteString -> TokenizerM Text
parseCChar ByteString
inp = do
  case Parser (ByteString, ())
-> ByteString -> Either [Char] (ByteString, ())
forall a. Parser a -> ByteString -> Either [Char] a
A.parseOnly (Parser () -> Parser (ByteString, ())
forall a. Parser a -> Parser (ByteString, a)
A.match Parser ()
pCChar) ByteString
inp of
       Left [Char]
_      -> TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
       Right (ByteString
r,()
_) -> Int -> TokenizerM Text
takeChars (ByteString -> Int
BS.length ByteString
r) -- assumes ascii

pCChar :: A.Parser ()
pCChar :: Parser ()
pCChar = do
  () () -> Parser Char -> Parser ()
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
A.char Char
'\''
  Parser ()
pCStringChar Parser () -> Parser () -> Parser ()
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () () -> Parser Char -> Parser ()
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Char -> Bool) -> Parser Char
A.satisfy (\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
'\\')
  () () -> Parser Char -> Parser ()
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
A.char Char
'\''

-- Like KDE's Int rule: a sequence of one or more decimal digits.
-- No sign, and no hex or octal forms.
parseInt :: Set.Set Char -> ByteString -> TokenizerM Text
parseInt :: Set Char -> ByteString -> TokenizerM Text
parseInt Set Char
delims ByteString
inp = do
  Set Char -> TokenizerM ()
precededByWordDelim Set Char
delims
  case Parser (ByteString, ())
-> ByteString -> Either [Char] (ByteString, ())
forall a. Parser a -> ByteString -> Either [Char] a
A.parseOnly (Parser () -> Parser (ByteString, ())
forall a. Parser a -> Parser (ByteString, a)
A.match (Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile1 ([Char] -> Char -> Bool
A.inClass [Char]
"0-9"))) ByteString
inp of
       Left [Char]
_      -> TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
       Right (ByteString
r,()
_) -> Int -> TokenizerM Text
takeChars (ByteString -> Int
BS.length ByteString
r) -- assumes ascii

-- Like KDE's HlCOct rule: a C-style octal, 0 followed by one or
-- more octal digits.  No sign, and no "0o" prefix.
parseOct :: Set.Set Char -> ByteString -> TokenizerM Text
parseOct :: Set Char -> ByteString -> TokenizerM Text
parseOct Set Char
delims ByteString
inp = do
  Set Char -> TokenizerM ()
precededByWordDelim Set Char
delims
  case Parser (ByteString, ())
-> ByteString -> Either [Char] (ByteString, ())
forall a. Parser a -> ByteString -> Either [Char] a
A.parseOnly (Parser () -> Parser (ByteString, ())
forall a. Parser a -> Parser (ByteString, a)
A.match Parser ()
pOct) ByteString
inp of
       Left [Char]
_      -> TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
       Right (ByteString
r,()
_) -> Int -> TokenizerM Text
takeChars (ByteString -> Int
BS.length ByteString
r) -- assumes ascii

pOct :: A.Parser ()
pOct :: Parser ()
pOct = do
  _ <- Char -> Parser Char
A.char Char
'0'
  _ <- A.takeWhile1 (A.inClass "0-7")
  return ()

-- Like KDE's HlCHex rule: 0x or 0X followed by one or more hex
-- digits.  No sign.
parseHex :: Set.Set Char -> ByteString -> TokenizerM Text
parseHex :: Set Char -> ByteString -> TokenizerM Text
parseHex Set Char
delims ByteString
inp = do
  Set Char -> TokenizerM ()
precededByWordDelim Set Char
delims
  case Parser (ByteString, ())
-> ByteString -> Either [Char] (ByteString, ())
forall a. Parser a -> ByteString -> Either [Char] a
A.parseOnly (Parser () -> Parser (ByteString, ())
forall a. Parser a -> Parser (ByteString, a)
A.match Parser ()
pHex) ByteString
inp of
       Left [Char]
_      -> TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
       Right (ByteString
r,()
_) -> Int -> TokenizerM Text
takeChars (ByteString -> Int
BS.length ByteString
r) -- assumes ascii

pHex :: A.Parser ()
pHex :: Parser ()
pHex = do
  _ <- Char -> Parser Char
A.char Char
'0'
  _ <- A.satisfy (A.inClass "Xx")
  _ <- A.takeWhile1 (A.inClass "0-9a-fA-F")
  return ()

-- Like KDE's Float rule: optional digits, a mandatory '.', and
-- optional digits (at least one digit is required on one side of
-- the dot), followed by an optional exponent (e or E, an optional
-- sign, and digits); if the exponent is not complete, the match
-- ends before the e/E.  No leading sign, and "5e2" is not a Float.
parseFloat :: Set.Set Char -> ByteString -> TokenizerM Text
parseFloat :: Set Char -> ByteString -> TokenizerM Text
parseFloat Set Char
delims ByteString
inp = do
  Set Char -> TokenizerM ()
precededByWordDelim Set Char
delims
  case Parser (ByteString, ())
-> ByteString -> Either [Char] (ByteString, ())
forall a. Parser a -> ByteString -> Either [Char] a
A.parseOnly (Parser () -> Parser (ByteString, ())
forall a. Parser a -> Parser (ByteString, a)
A.match Parser ()
pFloat) ByteString
inp of
       Left [Char]
_      -> TokenizerM Text
forall a. TokenizerM a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
       Right (ByteString
r,()
_) -> Int -> TokenizerM Text
takeChars (ByteString -> Int
BS.length ByteString
r)  -- assumes all ascii
  where pFloat :: A.Parser ()
        pFloat :: Parser ()
pFloat = do
          before <- (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile ([Char] -> Char -> Bool
A.inClass [Char]
"0-9")
          _ <- A.char '.'
          after <- A.takeWhile (A.inClass "0-9")
          guard $ not (BS.null before && BS.null after)
          A.option () $ do
            _ <- A.satisfy (A.inClass "Ee")
            _ <- A.option '+' (A.satisfy (A.inClass "+-"))
            void $ A.takeWhile1 (A.inClass "0-9")