{
{-# OPTIONS_GHC -Wnot #-}
{-# LANGUAGE Trustworthy #-}
module Config.Lexer
( scanTokens
) where
import Config.LexerUtils
import Config.Tokens
import Data.Text (Text)
import qualified Data.Text as Text
}
$uniupper = \x1
$unilower = \x2
$unidigit = \x3
$unisymbol = \x4
$unispace = \x5
$uniother = \x6
$asciialpha = [A-Z a-z]
$digit = [0-9]
$octdigit = [0-7]
$hexdigit = [0-9a-fA-F]
$bindigit = [0-1]
$white_no_nl = $white # \n
$charesc = [abfnrtv\\\"']
$cntrl = [A-Z@\[\\\]\^_]
@decimal = $digit+
@octal = $octdigit+
@binary = $bindigit+
@hexadecimal = $hexdigit+
-- Copied from Haskell 2010
@ascii = \^ $cntrl
| NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL
| BS | HT | LF | VT | FF | CR | SO | SI
| DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB
| CAN | EM | SUB | ESC | FS | GS | RS | US
| SP | DEL
@escape = $charesc
| @ascii
| @decimal
| o @octal
| x @hexadecimal
@alpha = $unilower | $uniupper | $asciialpha
@atom = @alpha (@alpha | [$digit $unidigit \. _ \-])*
config :-
<0> {
$white+ ;
"--" .* ;
"{" { token (const OpenMap) }
"}" { token (const CloseMap) }
"[" { token (const OpenList) }
"," { token (const Comma) }
"]" { token (const CloseList) }
"*" { token (const Bullet) }
"-"? "0x" @hexadecimal { token (number 2 16) }
"-"? @decimal { token (number 0 10) }
"-"? "0o" @octal { token (number 2 8) }
"-"? "0b" @binary { token (number 2 2) }
@atom { token Atom }
@atom $white_no_nl* \: { token section }
\" { startString }
}
<stringlit> {
\" { endString }
[^ \" \\ ]+ { addString }
\\ @escape { addCharLit }
\\ & ;
\\ . { badEscape }
\n { untermString }
}
<0,comment> {
"{-" { startComment }
}
<comment> {
"-}" { endComment }
\" { startCommentString }
. ;
\n ;
}
<commentstring> {
\" { endCommentString }
\n { token (const ErrorUntermCommentString) }
\\ \" ;
. ;
}
{
-- | Attempt to produce a token stream from an input file.
-- In the case of an error the line and column of the error
-- are returned instead.
scanTokens ::
Text {- ^ Source text -} ->
[Located Token] {- ^ Tokens with position -}
scanTokens str = go InNormal (Located alexStartPos str)
where
go st inp =
case alexScan inp (stateToInt st) of
AlexEOF ->
case st of
_ | posColumn (locPosition inp) /= 1 -> [Located (locPosition inp) ErrorUntermFile]
InComment startPosn _ -> [Located startPosn ErrorUntermComment]
InCommentString startPosn _ -> [Located startPosn ErrorUntermCommentString]
InString startPosn b -> [Located startPosn (ErrorUntermString (getStringLit b))]
InNormal -> [Located (locPosition inp){posColumn=0} EOF]
AlexError err -> [fmap (ErrorChar . Text.head) err]
AlexSkip inp' len -> go st inp'
AlexToken inp' len act ->
case act (fmap (Text.take len) inp) st of
(st', Nothing) -> go st' inp'
(st', Just x ) -> x : go st' inp'
-- | Compute the Alex state corresponding to a particular 'LexerMode'
stateToInt :: LexerMode -> Int
stateToInt InNormal{} = 0
stateToInt InComment{} = comment
stateToInt InCommentString{} = commentstring
stateToInt InString{} = stringlit
}