63 lines
2 KiB
Haskell
63 lines
2 KiB
Haskell
|
|
module Main where
|
|
|
|
import Ast
|
|
import Control.Applicative ((<$>), (<*>))
|
|
import Data.List (intercalate)
|
|
import Parse.Library
|
|
import Parse.Modules (moduleDef)
|
|
import Parse.Types (typeAnnotation)
|
|
import Text.Parsec hiding (newline,spaces)
|
|
import System.Environment
|
|
import System.Exit
|
|
import Types.Types
|
|
|
|
|
|
main = do
|
|
srcs <- mapM readFile =<< getArgs
|
|
case mapM docParse srcs of
|
|
Left err -> putStrLn err >> exitFailure
|
|
Right ms -> putStrLn (toModules ms)
|
|
|
|
toModules ms = wrap (intercalate ",\n " (map toModule ms))
|
|
where wrap s = "{ \"modules\" : [\n " ++ s ++ "\n ]\n}"
|
|
|
|
toModule (name, values) =
|
|
"{ \"name\" : " ++ show name ++ ",\n " ++
|
|
"\"values\" : [\n " ++ vs ++ "\n ]\n }"
|
|
where vs = intercalate ",\n " (map toValue values)
|
|
|
|
toValue (name, tipe, desc) =
|
|
"{ \"name\" : " ++ show name ++
|
|
",\n \"type\" : \"" ++ show tipe ++
|
|
",\n \"desc\" : " ++ show desc ++ "\n }"
|
|
|
|
docParse :: String -> Either String (String, [(String, Type, String)])
|
|
docParse = setupParser $ do
|
|
optional freshLine
|
|
(,) <$> option "Main" moduleName <*> types
|
|
where
|
|
skip = manyTill anyChar simpleNewline >> return []
|
|
end = many1 anyChar >> return []
|
|
types = concat <$> many (docs <|> try skip <|> end)
|
|
getName = intercalate "." . fst
|
|
moduleName = do optional freshLine
|
|
getName <$> moduleDef `followedBy` freshLine
|
|
|
|
docs :: IParser [(String, Type, String)]
|
|
docs = (tipe <$> try typeAnnotation) <|> commentTipe
|
|
where
|
|
clip str = case str of { ' ':rest -> rest ; _ -> str }
|
|
tipe stmt = case stmt of { TypeAnnotation n t -> [(n,t,"")] ; _ -> [] }
|
|
commentTipe = do
|
|
cs <- map clip <$> many1 lineComment
|
|
typ <- optionMaybe (try typeAnnotation)
|
|
return $ case typ of
|
|
Just (TypeAnnotation n t) -> [(n, t, intercalate "\n" cs)]
|
|
_ -> []
|
|
|
|
|
|
setupParser p source =
|
|
case iParse p "" source of
|
|
Right result -> Right result
|
|
Left err -> Left $ "Parse error at " ++ show err
|