parse.hs

import           Control.Monad
import           Text.ParserCombinators.Parsec

-- TODO const/pointer
data Ty = Ty String deriving (Show)

data FnTy = FnTy String [(Ty, String)] Ty deriving (Show)
data StructTy = StructTy String [(Ty, String)] deriving (Show)

data Stmt = Fn FnTy | Struct StructTy deriving (Show)

parseStmt :: Parser Stmt
parseStmt = liftM Struct parseStruct <|> liftM Fn parseFunction

spaced :: Parser a -> Parser a
spaced = between spaces spaces

parseStruct :: Parser StructTy
parseStruct = do
  string "struct"
  name <- spaced (many1 letter)
  fields <- between (char '{') (string "};") parseFields
  return (StructTy name fields)
      where
        parseFields = spaced $ parseNamedTy `endBy` (char ';' >> spaces)

parseNamedTy :: Parser (Ty, String)
parseNamedTy = do
  ty <- parseTy
  fieldName <- spaced (many1 letter)
  return (ty, fieldName)

parseFunction :: Parser FnTy
parseFunction = do
  retTy <- parseTy
  spaces
  name <- many1 letter
  args <- between (char '(') (char ')') parseArgs
  char ';'
  return $ FnTy name args retTy
      where
        parseArgs = parseNamedTy `sepBy` (char ',' >> spaces)

-- TODO - handle const, pointer
parseTy :: Parser Ty
parseTy = liftM Ty (many1 letter)

p :: Parser a -> String -> a
p parser s = x where
    Right x = parse parser "" s

-- e.g.
-- .............................
-- Ty "int"
-- (Ty "int","apple")
-- FnTy "apple" [(Ty "int","a"),(Ty "double","b")] (Ty "void")
-- StructTy "A" [(Ty "int","apple"),(Ty "double","berry")]
-- Struct (StructTy "A" [(Ty "int","apple"),(Ty "double","berry")])
-- Fn (FnTy "apple" [(Ty "int","a"),(Ty "double","b")] (Ty "void"))
main :: IO ()
main = do
  print $ p parseTy "int"

  print $ p parseNamedTy "int apple"

  print $ p parseFunction "void apple(int a, double b);"

  print $ p parseStruct "struct A { int apple; double berry; };"
  print $ p parseStmt "struct A { int apple; double berry; };"
  print $ p parseStmt "void apple(int a, double b);"