a parser for java class declaration.

java.hs

import qualified Text.Parsec as P
import Control.Applicative
import Control.Monad (liftM, liftM2, msum)

data AST =
  ClassDeclaration AST AST (Maybe AST) (Maybe AST) (Maybe AST) |
  Identifier String |
  Keyword String |
  Comment String |
  ClassModifiers [AST] |
  Super AST |
  Interfaces [AST] |
  TypeArgumentList [AST] |
  TypeArgument AST (Maybe AST) |
  TypePath AST (Maybe AST) |
  ComplexType [AST] Int |
  Ignore deriving Show

main = do
  src <- readFile "test.txt"
  mapM (print . parse) $ lines src

-- p1 >:> p2 = (:) <$> p1 <*> p2
(>++>) = liftM2 (++)
(>:>) = liftM2 (:)
liftConcat = liftM $ concat

parse :: String -> AST
parse xs = either (error . show) id $ P.parse parse' "parseExpr" xs
parse' =
  class_declaration

class_declaration = do
  spaceMany
  modifiers <- class_modifiers
  spaceMany >> P.string "class" >> space
  name <- identifier
  arglist <- P.optionMaybe type_argument_list
  super' <- P.optionMaybe super
  interfaces' <- P.optionMaybe interfaces
  spaceMany >> P.string "{"
  return $ ClassDeclaration modifiers name arglist super' interfaces'

identifier =
  (P.oneOf "$_" <|> P.letter)
  >:> (P.many $ P.oneOf "$_" <|> P.letter <|> P.digit)
  >>= return . Identifier

space = P.try $ 
  P.many1 $ space_chars <|> comment

space_chars = P.try $
  P.many1 P.space
  >> return Ignore

spaceMany = P.try $
  P.skipMany space
  >> return Ignore

comment = P.try $
  P.string "/*"
  >++> P.many (P.noneOf "*")
  >++> P.many1 (P.char '*')
  >++> (liftConcat $ P.many comment1)
  >++> P.string "/"
  >>= return . Comment

comment1 = P.try $
  P.many (P.noneOf "/*")
  >++> P.many (P.noneOf "*")
  >++> P.many1 (P.char '*')

class_modifiers =
  class_modifier `P.sepEndBy` space
  >>= return . ClassModifiers

class_modifier_keyword = ["protected", "private", "public", "abstract", "static", "final", "strictfp"]
class_modifier =
  (msum $ map (P.try . P.string) class_modifier_keyword)
  >>= return . Keyword

super = P.try $
  space >> P.string "extends" >> space
  >> type_ >>= return . Super

comma = P.try $ spaceMany >> P.char ',' >> spaceMany

interfaces = P.try $
  space >> P.string "implements" >> space
  >> type_ `P.sepBy1` comma
  >>= return . Interfaces

type_ = complex_type <|> primitive_type

complex_type = do
  types <- complex_type' `P.sepBy1` P.char '.'
  array <- P.many $ P.string "[]"
  return $ ComplexType types $ length array

complex_type' = do
  name <- identifier
  arglist <- P.optionMaybe type_argument_list
  return $ TypePath name arglist

primitive_type =
  (msum $ map (P.try . P.string) ["short", "byte", "char", "long", "int"])
  >>= return . Keyword


type_argument_list = P.try $ do
  P.char '<'
  list <- type_argument `P.sepBy1` (spaceMany >> P.char ',' >> spaceMany)
  P.char '>'
  return $ TypeArgumentList list

type_argument = do
  type' <- type_
  option <- P.optionMaybe type_option
  return $ TypeArgument type' option

type_option = P.try $
  space >> (P.string "super" <|> P.string "extends") >> space
  >> type_ >>= return . Super