-- -*- haskell -*- 
--
-- Lexical syntax for illiterate Haskell 98.
--
-- (c) Simon Marlow 2003, with the caveat that much of this is
-- translated directly from the syntax in the Haskell 98 report.
--

{
{-# OPTIONS -w  #-}
module Yi.Syntax.Haskell ( highlighter ) where

import qualified Data.ByteString.Char8
import qualified Yi.Syntax
import Yi.Vty

}

$whitechar = [\ \t\n\r\f\v]
$special   = [\(\)\,\;\[\]\`\{\}]

$ascdigit  = 0-9
$unidigit  = [] -- TODO
$digit     = [$ascdigit $unidigit]

$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~]
$unisymbol = [] -- TODO
$symbol    = [$ascsymbol $unisymbol] # [$special \_\:\"\']

$large     = [A-Z \xc0-\xd6 \xd8-\xde]
$small     = [a-z \xdf-\xf6 \xf8-\xff \_]
$alpha     = [$small $large]

$graphic   = [$small $large $symbol $digit $special \:\"\']

$octit     = 0-7
$hexit     = [0-9 A-F a-f]
$idchar    = [$alpha $digit \']
$symchar   = [$symbol \:]
$nl        = [\n\r]

@reservedid = 
        as|case|class|data|default|deriving|do|else|hiding|if|
        import|in|infix|infixl|infixr|instance|let|module|newtype|
        of|qualified|then|type|where|forall|mdo|foreign|export|dynamic|
        safe|threadsafe|unsafe|stdcall|ccall|dotnet

@reservedop =
        ".." | ":" | "::" | "=" | \\ | "|" | "<-" | "->" | "@" | "~" | "=>"

@varid  = $small $idchar*
@conid  = $large $idchar*
@varsym = $symbol $symchar*
@consym = \: $symchar*

@decimal     = $digit+
@octal       = $octit+
@hexadecimal = $hexit+
@exponent    = [eE] [\-\+] @decimal

$cntrl   = [$large \@\[\\\]\^\_]
@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
$charesc = [abfnrtv\\\"\'\&]
@escape  = \\ ($charesc | @ascii | @decimal | o @octal | x @hexadecimal)
@gap     = \\ $whitechar+ \\
@string  = $graphic # [\"\\] | " " | @escape | @gap

haskell :-

<0> $white+                                     { c attr } -- whitespace

<nestcomm> {
  "{-"                                          { m (subtract 1) redA }
  "-}"                                          { m (+1) redA }
  .                                             { c redA }
}

<0> {
  "--"\-* $symbol $symchar*                     { c attr }
  "--"\-*[^\n]*                                 { c redA }

 "{-"                                           { m (subtract 1) redA }

 $special                                       { c attr }

 @reservedid                                    { c (setFG blue (setBold attr)) }
 @varid                                         { c attr }
 @conid                                         { c greenA }

 @reservedop                                    { c yellowA }
 @varsym                                        { c yellowA }
 @consym                                        { c greenA }

 @decimal 
  | 0[oO] @octal
  | 0[xX] @hexadecimal                          { c attr }

 @decimal \. @decimal @exponent?
  | @decimal @exponent                          { c attr }

 \' ($graphic # [\'\\] | " " | @escape) \'      { c greenA }
 \" @string* \"                                 { c greenA }
 .                                              { c (setBold redA) }
}

{

redA = setFG red attr ; greenA = setFG green attr ; yellowA = setFG yellow attr

type HlState = Int

stateToInit x | x < 0     = nestcomm
              | otherwise = 0

initState = 0

#include "alex.hsinc"
}