module Text.Highlighting.Illuminate.RXML (lexer) where
import qualified Text.Highlighting.Illuminate.XML as XML
import qualified Text.Highlighting.Illuminate.Ruby as Ruby
#if __GLASGOW_HASKELL__ >= 603
#include "ghcconfig.h"
#elif defined(__GLASGOW_HASKELL__)
#include "config.h"
#endif
#if __GLASGOW_HASKELL__ >= 503
import Data.Array
import Data.Char (ord)
import Data.Array.Base (unsafeAt)
#else
import Array
import Char (ord)
#endif
#if __GLASGOW_HASKELL__ >= 503
import GHC.Exts
#else
import GlaExts
#endif
import Text.Highlighting.Illuminate.Types
import Data.Sequence (Seq, (><), (<|), (|>), singleton, viewl, ViewL(..))
import qualified Data.Sequence as Seq (empty)
import qualified Data.Foldable as F
import Data.List (span, break, splitAt, isPrefixOf)
type AlexInput = (AlexPosn,
Char,
String)
alexInputPrevChar :: AlexInput -> Char
alexInputPrevChar (p,c,s) = c
alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
alexGetChar (p,c,[]) = Nothing
alexGetChar (p,_,(c:s)) = let p' = alexMove p c in p' `seq`
Just (c, (p', c, s))
data AlexPosn = AlexPn !Int !Int !Int
deriving (Eq,Show)
alexStartPos :: AlexPosn
alexStartPos = AlexPn 0 1 1
alexMove :: AlexPosn -> Char -> AlexPosn
alexMove (AlexPn a l c) '\t' = AlexPn (a+1) l (((c+7) `div` 8)*8+1)
alexMove (AlexPn a l c) '\n' = AlexPn (a+1) (l+1) 1
alexMove (AlexPn a l c) _ = AlexPn (a+1) l (c+1)
data AlexState = AlexState {
alex_pos :: !AlexPosn,
alex_inp :: String,
alex_chr :: !Char,
alex_scd :: !Int
, alex_ust :: AlexUserState
}
runAlex :: String -> Alex a -> Either String a
runAlex input (Alex f)
= case f (AlexState {alex_pos = alexStartPos,
alex_inp = input,
alex_chr = '\n',
alex_ust = alexInitUserState,
alex_scd = 0}) of Left msg -> Left msg
Right ( _, a ) -> Right a
newtype Alex a = Alex { unAlex :: AlexState -> Either String (AlexState, a) }
instance Monad Alex where
m >>= k = Alex $ \s -> case unAlex m s of
Left msg -> Left msg
Right (s',a) -> unAlex (k a) s'
return a = Alex $ \s -> Right (s,a)
alexGetInput :: Alex AlexInput
alexGetInput
= Alex $ \s@AlexState{alex_pos=pos,alex_chr=c,alex_inp=inp} ->
Right (s, (pos,c,inp))
alexSetInput :: AlexInput -> Alex ()
alexSetInput (pos,c,inp)
= Alex $ \s -> case s{alex_pos=pos,alex_chr=c,alex_inp=inp} of
s@(AlexState{}) -> Right (s, ())
alexError :: String -> Alex a
alexError message = Alex $ \s -> Left message
alexGetStartCode :: Alex Int
alexGetStartCode = Alex $ \s@AlexState{alex_scd=sc} -> Right (s, sc)
alexSetStartCode :: Int -> Alex ()
alexSetStartCode sc = Alex $ \s -> Right (s{alex_scd=sc}, ())
alexMonadScan = do
inp <- alexGetInput
sc <- alexGetStartCode
case alexScan inp sc of
AlexEOF -> alexEOF
AlexError inp' -> alexError "lexical error"
AlexSkip inp' len -> do
alexSetInput inp'
alexMonadScan
AlexToken inp' len action -> do
alexSetInput inp'
action inp len
type AlexAction result = AlexInput -> Int -> result
skip input len = alexMonadScan
begin code input len = do alexSetStartCode code; alexMonadScan
(action `andBegin` code) input len = do alexSetStartCode code; action input len
token t input len = return (t input len)
alexEOF = return $ singleton (EOF,"")
type AlexUserState = [(Int,TokenType)]
alexInitUserState = [(0,Plain)]
tok :: TokenType -> AlexInput -> Int -> Alex Tokens
tok t (_,_,s) len = return $ singleton (t, take len s)
getUserState :: Alex AlexUserState
getUserState = Alex $ \s@AlexState{alex_ust=ust} -> Right (s, ust)
setUserState :: AlexUserState -> Alex ()
setUserState newstate = Alex $ \s -> Right (s{alex_ust=newstate}, ())
modifyUserState :: (AlexUserState -> AlexUserState) -> Alex ()
modifyUserState fn = Alex $ \s@AlexState{alex_ust=ust} -> Right (s{alex_ust = fn ust}, ())
plain :: AlexInput -> Int -> Alex Tokens
plain (_,_,s) len = do
((_,defaultToken) : _) <- getUserState
return $ singleton (defaultToken, take len s)
pushContext :: (Int, TokenType) -> b -> Alex b
pushContext newcontext toks = do
modifyUserState (newcontext :)
alexSetStartCode $ fst newcontext
return toks
popContext :: b -> Alex b
popContext toks = do
contexts <- getUserState
case contexts of
[] -> error "Empty contexts stack!"
[x] -> return toks
(x:y:xs) -> do
setUserState (y:xs)
alexSetStartCode $ fst y
return toks
scanForStop :: String -> String -> Int
scanForStop stop ('\n':xs) = 1 +
let (sps, xs') = span (`elem` " \t") xs
offset = length sps + length stop
in if stop `isPrefixOf` xs'
then case (takeWhile (`elem` " \t") $ drop (length stop) xs') of
('\n':_) -> offset
[] -> offset
_ -> offset + scanForStop stop (drop offset xs')
else length sps + scanForStop stop xs'
scanForStop stop (_:xs) = 1 + scanForStop stop xs
scanForStop stop [] = 0
hereDoc :: Tokens -> Alex Tokens
hereDoc toks = Alex $ \s ->
let inp = alex_inp s
unescape ('\\':x:xs) = x : unescape xs
unescape (x:xs) = x : unescape xs
unescape [] = []
unstring = tail . init . unescape
in case viewl toks of
((tt,str) :< empty) | tt `elem` [String, VarId] ->
let stop = if tt == String then unstring str else str
off = scanForStop stop inp
(res, newinp) = splitAt off inp
newpos = foldl alexMove (alex_pos s) res
s' = s{alex_pos = newpos, alex_inp = newinp, alex_chr = '\n'}
in Right (s', toks |> (String, res))
_ -> Left "hereDoc expecting String or VarId"
(==>) :: (AlexInput -> Int -> Alex a) -> (a -> Alex b) -> (AlexInput -> Int -> Alex b)
(act1 ==> act2) inp len = do
res <- act1 inp len
act2 res
scanner :: Scanner
scanner str = runAlex str $ do
let loop acc = do toks <- alexMonadScan
case viewl toks of
((t,_) :< _) | t == EOF -> return acc
_ -> loop (acc >< toks)
loop Seq.empty
tokenizeWith :: Lexer -> AlexInput -> Int -> Alex Tokens
tokenizeWith lx (_,_,s) len = do
case (scan lx) (take len s) of
Left e -> fail e
Right r -> return r
scanWith :: Lexer -> Tokens -> Alex Tokens
scanWith lx toks = Alex $ \s ->
case (scan lx) (alex_inp s) of
Left e -> Left e
Right r -> Right (s', toks >< r)
where s' = s{alex_pos = newpos, alex_inp = newinp, alex_chr = lastchar}
parsed_chars = F.concatMap snd r
newpos = foldl alexMove (alex_pos s) parsed_chars
lastchar = if null parsed_chars then '\n' else last parsed_chars
newinp = drop (length parsed_chars) (alex_inp s)
alex_base :: AlexAddr
alex_base = AlexA# "\xc5\xff\xff\xff\xdd\xff\xff\xff\xde\xff\xff\xff\xfa\xff\xff\xff\xfb\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xc9\xff\xff\xff\xfd\xff\xff\xff\xcc\xff\xff\xff\xff\xff\xff\xff"#
alex_table :: AlexAddr
alex_table = AlexA# "\x00\x00\x08\x00\x04\x00\x03\x00\xff\xff\xff\xff\x06\x00\xff\xff\x0a\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x07\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
alex_check :: AlexAddr
alex_check = AlexA# "\xff\xff\x3c\x00\x25\x00\x25\x00\x0a\x00\x0a\x00\x3d\x00\x0a\x00\x3c\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x25\x00\xff\xff\x25\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x3e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
alex_deflt :: AlexAddr
alex_deflt = AlexA# "\x09\x00\x02\x00\x02\x00\x02\x00\x02\x00\xff\xff\xff\xff\xff\xff\x09\x00\x09\x00\x09\x00"#
alex_accept = listArray (0::Int,10) [[],[],[(AlexAcc (alex_action_0))],[],[],[(AlexAcc (alex_action_1))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[],[(AlexAcc (alex_action_3))],[]]
lexer :: Lexer
lexer = Lexer { name = "RXML"
, aliases = ["rxml"]
, filenames = ["*.xml.erb","*.rxml"]
, scan = scanner }
erb :: Int
erb = 1
alex_action_0 = tokenizeWith Ruby.lexer
alex_action_1 = tok Tag ==> popContext
alex_action_2 = tok Tag ==> pushContext (erb, Plain)
alex_action_3 = tokenizeWith XML.lexer
data AlexAddr = AlexA# Addr#
#if __GLASGOW_HASKELL__ < 503
uncheckedShiftL# = shiftL#
#endif
alexIndexInt16OffAddr (AlexA# arr) off =
#ifdef WORDS_BIGENDIAN
narrow16Int# i
where
i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)
high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
low = int2Word# (ord# (indexCharOffAddr# arr off'))
off' = off *# 2#
#else
indexInt16OffAddr# arr off
#endif
alexIndexInt32OffAddr (AlexA# arr) off =
#ifdef WORDS_BIGENDIAN
narrow32Int# i
where
i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`
(b2 `uncheckedShiftL#` 16#) `or#`
(b1 `uncheckedShiftL#` 8#) `or#` b0)
b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))
b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))
b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))
b0 = int2Word# (ord# (indexCharOffAddr# arr off'))
off' = off *# 4#
#else
indexInt32OffAddr# arr off
#endif
#if __GLASGOW_HASKELL__ < 503
quickIndex arr i = arr ! i
#else
quickIndex = unsafeAt
#endif
data AlexReturn a
= AlexEOF
| AlexError !AlexInput
| AlexSkip !AlexInput !Int
| AlexToken !AlexInput !Int a
alexScan input (I# (sc))
= alexScanUser undefined input (I# (sc))
alexScanUser user input (I# (sc))
= case alex_scan_tkn user input 0# input sc AlexNone of
(AlexNone, input') ->
case alexGetChar input of
Nothing ->
AlexEOF
Just _ ->
AlexError input'
(AlexLastSkip input len, _) ->
AlexSkip input len
(AlexLastAcc k input len, _) ->
AlexToken input len k
alex_scan_tkn user orig_input len input s last_acc =
input `seq`
let
new_acc = check_accs (alex_accept `quickIndex` (I# (s)))
in
new_acc `seq`
case alexGetChar input of
Nothing -> (new_acc, input)
Just (c, new_input) ->
let
base = alexIndexInt32OffAddr alex_base s
(I# (ord_c)) = ord c
offset = (base +# ord_c)
check = alexIndexInt16OffAddr alex_check offset
new_s = if (offset >=# 0#) && (check ==# ord_c)
then alexIndexInt16OffAddr alex_table offset
else alexIndexInt16OffAddr alex_deflt s
in
case new_s of
1# -> (new_acc, input)
_ -> alex_scan_tkn user orig_input (len +# 1#)
new_input new_s new_acc
where
check_accs [] = last_acc
check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len))
check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len))
check_accs (AlexAccPred a pred : rest)
| pred user orig_input (I# (len)) input
= AlexLastAcc a input (I# (len))
check_accs (AlexAccSkipPred pred : rest)
| pred user orig_input (I# (len)) input
= AlexLastSkip input (I# (len))
check_accs (_ : rest) = check_accs rest
data AlexLastAcc a
= AlexNone
| AlexLastAcc a !AlexInput !Int
| AlexLastSkip !AlexInput !Int
data AlexAcc a user
= AlexAcc a
| AlexAccSkip
| AlexAccPred a (AlexAccPred user)
| AlexAccSkipPred (AlexAccPred user)
type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool
alexAndPred p1 p2 user in1 len in2
= p1 user in1 len in2 && p2 user in1 len in2
alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input
alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input
alexRightContext (I# (sc)) user _ _ input =
case alex_scan_tkn user input 0# input sc AlexNone of
(AlexNone, _) -> False
_ -> True
iUnbox (I# (i)) = i