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