content: {-|
  
  QuickCheck generators for streams of tokens and functions for
  converting them to text that should lex back to the same token stream.
  
  This supports a simple unlex-lex test in which we generate text for a
  stream of tokens, lex it, and insist that the result equals the
  original.  -}
  
  module TokenGen where
  
  import Control.Monad (liftM2)
  import Data.Char (isControl, isAscii, isPrint)
  import qualified Data.Set as DS
  import Test.QuickCheck
  import Text.Printf (printf)
  
  import Language.Java.Lexer (Token(..))
  
  instance Arbitrary Token where
    arbitrary = token
    
  token :: Gen Token
  token = frequency [ (length allKeywords, keyword),
                      (length allSeparators, separator),
                      (8, literal),
                      (1, identifier),
                      (length allOperators, operator) ]
  
  keyword :: Gen Token
  keyword = elements allKeywords
  
  separator :: Gen Token
  separator = elements allSeparators
              
  literal :: Gen Token
  literal = oneof [
    -- Note that the numbers are always positive in tokens generated by
    -- the lexer, so we have to be careful not to generate negative
    -- contents.
    fmap IntTok nonNegative,
    fmap LongTok nonNegative,
    fmap DoubleTok nonNegative,
    fmap FloatTok nonNegative,
    fmap CharTok javaChar,
    fmap StringTok javaString,
    fmap BoolTok arbitrary,
    return NullTok
    ]
          
  nonNegative :: (Arbitrary a, Num a) => Gen a
  nonNegative = fmap abs arbitrary
  
  identifier :: Gen Token
  identifier = fmap IdentTok identText
  
  identText :: Gen String
  identText = liftM2 (:) first rest `suchThat` (not . isKeyword)
    where first = javaLetter
          rest = sized (\s -> resize (min s 12) $ listOf javaLetterOrDigit)
          javaLetter = elements allJavaLetters
          javaLetterOrDigit = frequency [(length allJavaLetters, javaLetter), (10, digit)]
          digit = elements ['0'..'9']
          allJavaLetters = "$_" ++ ['A'..'Z'] ++ ['a'..'z']
          isKeyword = flip DS.member allKeywordNames
          allKeywordNames = DS.fromList $ map unlex allKeywords
  
  operator :: Gen Token
  operator = elements allOperators
  
  -- An Alex lexer appears to support characters only in the range \x00
  -- to \xff, or at least that's what is implied by the definition of
  -- the character class '.' in the Alex documentation. We'll limit it
  -- to the ASCII range for now.
  javaChar :: Gen Char
  javaChar = elements $ takeWhile isAscii $ map toEnum [0..]
  
  javaString :: Gen String
  javaString = listOf javaChar
  
  -- | Gives the corresponding Java source text for a token.
  unlex :: Token -> String
  -- The duplication between here and the lexer is a little
  -- unsatisfying, but it's not really going to be a maintenance problem
  -- in practice. These are aspects of the language that aren't likely
  -- to change.
  unlex t = case t of
    KW_Abstract     -> "abstract"
    KW_Assert       -> "assert"
    KW_Boolean      -> "boolean"
    KW_Break        -> "break"
    KW_Byte         -> "byte"
    KW_Case         -> "case"
    KW_Catch        -> "catch"
    KW_Char         -> "char"
    KW_Class        -> "class"
    KW_Const        -> "const"
    KW_Continue     -> "continue"
    KW_Default      -> "default"
    KW_Do           -> "do"
    KW_Double       -> "double"
    KW_Else         -> "else"
    KW_Enum         -> "enum"
    KW_Extends      -> "extends"
    KW_Final        -> "final"
    KW_Finally      -> "finally"
    KW_Float        -> "float"
    KW_For          -> "for"
    KW_Goto         -> "goto"
    KW_If           -> "if"
    KW_Implements   -> "implements"
    KW_Import       -> "import"
    KW_Instanceof   -> "instanceof"
    KW_Int          -> "int"
    KW_Interface    -> "interface"
    KW_Long         -> "long"
    KW_Native       -> "native"
    KW_New          -> "new"
    KW_Package      -> "package"
    KW_Private      -> "private"
    KW_Protected    -> "protected"
    KW_Public       -> "public"
    KW_Return       -> "return"
    KW_Short        -> "short"
    KW_Static       -> "static"
    KW_Strictfp     -> "strictfp"
    KW_Super        -> "super"
    KW_Switch       -> "switch"
    KW_Synchronized -> "synchronized"
    KW_This         -> "this"
    KW_Throw        -> "throw"
    KW_Throws       -> "throws"
    KW_Transient    -> "transient"
    KW_Try          -> "try"
    KW_Void         -> "void"
    KW_Volatile     -> "volatile"
    KW_While        -> "while"
    OpenParen       -> "("
    CloseParen      -> ")"
    OpenSquare      -> "["
    CloseSquare     -> "]"
    OpenCurly       -> "{"
    CloseCurly      -> "}"
    SemiColon       -> ";"
    Comma           -> ","
    Period          -> "."
    IntTok i        -> show i
    LongTok l       -> show l ++ "L"
    DoubleTok d     -> show d ++ "D"
    FloatTok f      -> show f ++ "F"
    CharTok c       -> "'" ++ unlexChar InChar c ++ "'"
    StringTok s     -> "\"" ++ concatMap (unlexChar InString) s ++ "\""
    BoolTok b       -> if b then "true" else "false"
    NullTok         -> "null"
    IdentTok id     -> id
    Op_Equal        -> "="
    Op_GThan        -> ">"
    Op_LThan        -> "<"
    Op_Bang         -> "!"
    Op_Tilde        -> "~"
    Op_Query        -> "?"
    Op_Colon        -> ":"
    Op_Equals       -> "=="
    Op_LThanE       -> "<="
    Op_GThanE       -> ">="
    Op_BangE        -> "!="
    Op_AAnd         -> "&&"
    Op_OOr          -> "||"
    Op_PPlus        -> "++"
    Op_MMinus       -> "--"
    Op_Plus         -> "+"
    Op_Minus        -> "-"
    Op_Star         -> "*"
    Op_Slash        -> "/"
    Op_And          -> "&"
    Op_Or           -> "|"
    Op_Caret        -> "^"
    Op_Percent      -> "%"
    Op_LShift       -> "<<"
    Op_RShift       -> ">>"
    Op_RRShift      -> ">>>"
    Op_PlusE        -> "+="
    Op_MinusE       -> "-="
    Op_StarE        -> "*="
    Op_SlashE       -> "/="
    Op_AndE         -> "&="
    Op_OrE          -> "|="
    Op_CaretE       -> "^="
    Op_PercentE     -> "%="
    Op_LShiftE      -> "<<="
    Op_RShiftE      -> ">>="
    Op_RRShiftE     -> ">>>="
    Op_AtSign       -> "@"
    
  data CharContext = InChar | InString
  
  unlexChar :: CharContext -> Char -> String
  unlexChar cc c =
    case c of
      '\b' -> "\\b"
      '\t' -> "\\t"
      '\n' -> "\\n"
      '\f' -> "\\f"
      '\r' -> "\\r"
      '"'  -> case cc of
        InChar   -> "\""
        InString -> "\\\""
      '\'' -> case cc of
        InChar   -> "\\'"
        InString -> "'"
      '\\' -> "\\\\"
      _ ->
        if isControl c || not (isAscii c) || not (isPrint c)
        then asUnicodeEscape c
        else c:[]
      where asUnicodeEscape c =
              printf "\\u%04x" (fromEnum c)
  
  allKeywords :: [Token]
  allKeywords = [
    KW_Abstract,
    KW_Assert,
    KW_Boolean,
    KW_Break,
    KW_Byte,
    KW_Case,
    KW_Catch,
    KW_Char,
    KW_Class,
    KW_Const,
    KW_Continue,
    KW_Default,
    KW_Do,
    KW_Double,
    KW_Else,
    KW_Enum,
    KW_Extends,
    KW_Final,
    KW_Finally,
    KW_Float,
    KW_For,
    KW_Goto,
    KW_If,
    KW_Implements,
    KW_Import,
    KW_Instanceof,
    KW_Int,
    KW_Interface,
    KW_Long,
    KW_Native,
    KW_New,
    KW_Package,
    KW_Private,
    KW_Protected,
    KW_Public,
    KW_Return,
    KW_Short,
    KW_Static,
    KW_Strictfp,
    KW_Super,
    KW_Switch,
    KW_Synchronized,
    KW_This,
    KW_Throw,
    KW_Throws,
    KW_Transient,
    KW_Try,
    KW_Void,
    KW_Volatile,
    KW_While
    ]
  
  allSeparators :: [Token]
  allSeparators = [
    OpenParen,
    CloseParen,
    OpenSquare,
    CloseSquare,
    OpenCurly,
    CloseCurly,
    SemiColon,
    Comma,
    Period
    ]
              
  allOperators :: [Token]
  allOperators = [
    Op_Equal,
    Op_GThan,
    Op_LThan,
    Op_Bang,
    Op_Tilde,
    Op_Query,
    Op_Colon,
    Op_Equals,
    Op_LThanE,
    Op_GThanE,
    Op_BangE,
    Op_AAnd,
    Op_OOr,
    Op_PPlus,
    Op_MMinus,
    Op_Plus,
    Op_Minus,
    Op_Star,
    Op_Slash,
    Op_And,
    Op_Or,
    Op_Caret,
    Op_Percent,
    Op_LShift,
    Op_RShift,
    Op_RRShift,
    Op_PlusE,
    Op_MinusE,
    Op_StarE,
    Op_SlashE,
    Op_AndE,
    Op_OrE,
    Op_CaretE,
    Op_PercentE,
    Op_LShiftE,
    Op_RShiftE,
    Op_RRShiftE,
    Op_AtSign
    ]
  