{ module Lexer where } %wrapper "posn" $digit = 0-9 $alpha = [a-zA-Z] $sp = \32 $htab = \9 $sp = \32 $bslash = \\ $dquote = \" $vchar = \33 - \126 $qtext = [ $vchar # [ $dquote $bslash ] ] @crlf = \38 \13 \38 \10 @wsp = ( $htab | $sp ) @fws = ( @wsp* @crlf )? @wsp+ @quoted_pair = \\ ( $vchar | $white ) @qcontent = ( $qtext | @quoted_pair ) @quoted_string = $dquote ( (@fws)? @qcontent)* (@fws)? $dquote @atext = ( $alpha | [$digit] | \! | \# | \$ | \% | \& | \' | \* | \+ | \- | \/ | \= | \? | \^ | \_ | \` | \{ | \| | \} | \~ ) @atom = @atext+ @word = ( @atom | @quoted_string ) @phrase = @word+ @display_name = @phrase @dot_atom_text = @atext+ ( \. @atext+)* @dot_atom = @dot_atom_text @local_part = ( @dot_atom | @quoted_string ) @dtext = [ \33 - \90 \94 - \126 ] @domain_literal = \[ ( (@fws)? @dtext )* (@fws)? \] @domain = ( @dot_atom | @domain_literal ) @addr_spec = @local_part \@ @domain @angle_addr = \< @addr_spec \> tokens :- $white+ ; -- delete whitespace \(.*\) ; -- delete comments From: { from } \, { comma } @display_name { display_name } @angle_addr { angle_address } @addr_spec { address_specification } { -- Each action has type :: AlexPosn -> String -> Token from :: AlexPosn -> String -> Token from p s = TokenFrom p comma :: AlexPosn -> String -> Token comma p s = TokenComma p display_name :: AlexPosn -> String -> Token display_name p s = TokenDisplayName p s angle_address :: AlexPosn -> String -> Token angle_address p s = TokenAngleAddress p s address_specification :: AlexPosn -> String -> Token address_specification p s = TokenAddressSpecification p s -- The token type: data Token = TokenFrom AlexPosn | TokenComma AlexPosn | TokenDisplayName AlexPosn String | TokenAngleAddress AlexPosn String | TokenAddressSpecification AlexPosn String deriving (Eq,Show) lex str = go (alexStartPos,'\n',[],str) where go inp@(pos,_,_,str) = case alexScan inp 0 of AlexEOF -> [] AlexError ((AlexPn _ line column),_,_,_) -> error $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column) ++ ". Error occurred while processing " ++ (words str)!!0 AlexSkip inp' len -> go inp' AlexToken inp' len act -> act pos (take len str) : go inp' }