2013-03-14 08:04:51 +00:00
|
|
|
|
|
|
|
module Main where
|
|
|
|
|
|
|
|
import Ast
|
|
|
|
import Control.Applicative ((<$>), (<*>))
|
2013-03-17 05:24:18 +00:00
|
|
|
import Data.List (intercalate)
|
2013-05-05 01:19:54 +00:00
|
|
|
import Data.Maybe (catMaybes)
|
2013-03-14 08:04:51 +00:00
|
|
|
import Parse.Library
|
|
|
|
import Parse.Modules (moduleDef)
|
2013-03-17 05:24:18 +00:00
|
|
|
import Text.Parsec hiding (newline,spaces)
|
2013-03-14 08:04:51 +00:00
|
|
|
import System.Environment
|
|
|
|
import System.Exit
|
|
|
|
|
|
|
|
|
|
|
|
main = do
|
|
|
|
srcs <- mapM readFile =<< getArgs
|
|
|
|
case mapM docParse srcs of
|
|
|
|
Left err -> putStrLn err >> exitFailure
|
|
|
|
Right ms -> putStrLn (toModules ms)
|
|
|
|
|
2013-03-21 09:29:23 +00:00
|
|
|
toModules ms = wrap (intercalate ",\n " (map toModule ms))
|
|
|
|
where wrap s = "{ \"modules\" : [\n " ++ s ++ "\n ]\n}"
|
2013-03-14 08:04:51 +00:00
|
|
|
|
|
|
|
toModule (name, values) =
|
2013-03-21 09:29:23 +00:00
|
|
|
"{ \"name\" : " ++ show name ++ ",\n " ++
|
|
|
|
"\"values\" : [\n " ++ vs ++ "\n ]\n }"
|
|
|
|
where vs = intercalate ",\n " (map toValue values)
|
2013-03-14 08:04:51 +00:00
|
|
|
|
2013-03-21 09:29:23 +00:00
|
|
|
toValue (name, tipe, desc) =
|
|
|
|
"{ \"name\" : " ++ show name ++
|
2013-05-05 01:19:54 +00:00
|
|
|
",\n \"type\" : " ++ show tipe ++
|
|
|
|
",\n \"desc\" : " ++ show desc ++ "\n }"
|
2013-03-14 08:04:51 +00:00
|
|
|
|
2013-05-05 01:19:54 +00:00
|
|
|
docParse :: String -> Either String (String, [(String, String, String)])
|
2013-03-14 08:04:51 +00:00
|
|
|
docParse = setupParser $ do
|
2013-05-05 01:19:54 +00:00
|
|
|
optional freshLine
|
2013-05-16 20:11:40 +00:00
|
|
|
(names, exports) <- option (["Main"],[]) moduleDef
|
|
|
|
info <- many (annotation exports <|> try skip <|> end)
|
2013-05-05 01:19:54 +00:00
|
|
|
return (intercalate "." names, catMaybes info)
|
2013-03-21 13:27:04 +00:00
|
|
|
where
|
2013-05-05 01:19:54 +00:00
|
|
|
skip = manyTill anyChar simpleNewline >> return Nothing
|
|
|
|
end = many1 anyChar >> return Nothing
|
|
|
|
|
2013-05-16 20:11:40 +00:00
|
|
|
annotation :: [String] -> IParser (Maybe (String, String, String))
|
|
|
|
annotation exports =
|
|
|
|
try ((\c n t -> export (n,t,c)) <$> comment <*> name <*> tipe)
|
2013-03-21 09:29:23 +00:00
|
|
|
where
|
2013-05-16 20:11:40 +00:00
|
|
|
comment = concatMap clip <$> many lineComment
|
|
|
|
clip str = case str of { ' ':rest -> rest ; _ -> str } ++ "\n"
|
2013-05-05 01:19:54 +00:00
|
|
|
|
2013-05-16 20:11:40 +00:00
|
|
|
name = do v <- lowVar <|> parens symOp
|
|
|
|
whitespace ; hasType ; whitespace ; return v
|
|
|
|
|
|
|
|
tipe = manyTill anyChar (try (simpleNewline >> notFollowedBy (string " ")))
|
2013-05-05 01:19:54 +00:00
|
|
|
|
|
|
|
export info@(name,_,_) =
|
|
|
|
if null exports || name `elem` exports then Just info else Nothing
|
|
|
|
|
2013-03-21 09:29:23 +00:00
|
|
|
|
|
|
|
|
2013-03-14 08:04:51 +00:00
|
|
|
setupParser p source =
|
|
|
|
case iParse p "" source of
|
|
|
|
Right result -> Right result
|
|
|
|
Left err -> Left $ "Parse error at " ++ show err
|