58 lines
1.9 KiB
Haskell
58 lines
1.9 KiB
Haskell
module Parse.Parser (parseProgram, parseDependencies, parseInfix) where
|
|
|
|
import Ast
|
|
import Control.Applicative ((<$>), (<*>))
|
|
import Control.Monad
|
|
import Data.Char (isSymbol, isDigit)
|
|
import Data.List (foldl',intercalate)
|
|
import Text.Parsec hiding (newline,spaces)
|
|
|
|
import Parse.Library
|
|
import Parse.Binops (infixStmt, OpTable)
|
|
import Parse.Expr
|
|
import Parse.Types
|
|
import Parse.Modules
|
|
import Parse.Foreign
|
|
|
|
statement = choice (typeAlias:defs) <|> def <?> "datatype or variable definition"
|
|
where defs = map ((:[]) <$>) [ foreignDef, datatype ]
|
|
|
|
freshDef = commitIf (freshLine >> (letter <|> char '_')) $ do
|
|
freshLine
|
|
statement <?> "another datatype or variable definition"
|
|
|
|
defs1 = do d <- statement <?> "at least one datatype or variable definition"
|
|
concat <$> (d:) <$> many freshDef
|
|
|
|
program = do
|
|
optional freshLine
|
|
(names,exports) <- option (["Main"],[]) (moduleDef `followedBy` freshLine)
|
|
is <- (do try (lookAhead $ reserved "import")
|
|
imports `followedBy` freshLine) <|> return []
|
|
statements <- defs1
|
|
optional freshLine ; optional spaces ; eof
|
|
return $ Module names exports is statements
|
|
|
|
parseProgram = setupParser program
|
|
|
|
parseDependencies :: String -> Either String (String, [String])
|
|
parseDependencies =
|
|
setupParser $ do
|
|
optional skip
|
|
(,) <$> option "Main" moduleName <*> option [] imprts
|
|
where
|
|
skip = try (manyTill anyChar (try (string "/**")))
|
|
imprts = fmap (map fst) imports `followedBy` freshLine
|
|
getName = intercalate "." . fst
|
|
moduleName = do optional freshLine
|
|
getName <$> moduleDef `followedBy` freshLine
|
|
|
|
parseInfix :: String -> Either String OpTable
|
|
parseInfix = setupParser . many $ do
|
|
manyTill (whitespace <|> (anyChar >> return ())) freshLine
|
|
infixStmt
|
|
|
|
setupParser p source =
|
|
case iParse p "" source of
|
|
Right result -> Right result
|
|
Left err -> Left $ "Parse error at " ++ show err
|