module PascalParser where

import Text.ParserCombinators.Parsec
import Control.Monad

data PascalUnit =
    Program Identificator Implementation FunctionBody
    | Unit Identificator Interface Implementation (Maybe Initialize) (Maybe Finalize)
    deriving Show

data Interface = Interface Uses TypesAndVars
    deriving Show
data Implementation = Implementation Uses TypesAndVars Functions
    deriving Show
data Functions = Functions [Function]
    deriving Show
data Function = Function String
    deriving Show
data Identificator = Identificator String
    deriving Show
data FunctionBody = FunctionBody String
    deriving Show
data TypesAndVars = TypesAndVars String
    deriving Show
data Initialize = Initialize Functions
    deriving Show
data Finalize = Finalize Functions
    deriving Show
data Uses = Uses [Identificator]
    deriving Show

parsePascalUnit :: String -> Either ParseError PascalUnit
parsePascalUnit = parse pascalUnit "unit"
    where
    comments = skipMany (comment >> spaces)
    identificator = do
        spaces
        l <- letter <|> oneOf "_"
        ls <- many (alphaNum <|> oneOf "_")
        spaces
        return $ Identificator (l:ls)

    pascalUnit = do
        spaces
        comments
        u <- choice [program, unit]
        comments
        spaces
        return u

    comment = choice [
            char '{' >> manyTill anyChar (try $ char '}')
            , string "(*" >> manyTill anyChar (try $ string "*)")
            , string "//" >> manyTill anyChar (try newline)
            ]

    unit = do
        name <- unitName
        spaces
        comments
        int <- string "interface" >> interface
        manyTill anyChar (try $ string "implementation")
        spaces
        comments
        impl <- implementation
        return $ Unit name int impl Nothing Nothing
        where
            unitName = between (string "unit") (char ';') identificator

    interface = do
        spaces
        comments
        u <- uses
        return $ Interface u (TypesAndVars "")

    program = do
        name <- programName
        spaces
        comments
        impl <- implementation
        return $ Program name impl (FunctionBody "")
        where
            programName = between (string "program") (char ';') identificator

    implementation = do
        u <- uses
        manyTill anyChar (try $ string "end.")
        return $ Implementation u (TypesAndVars "") (Functions [])

    uses = liftM Uses (option [] u)
        where
            u = do
                string "uses"
                spaces
                u <- (identificator >>= \i -> spaces >> return i) `sepBy1` (char ',' >> spaces)
                char ';'
                spaces
                return u