on 104faf1 help sign in
elk/compiler/Docs.hs
63 lines 2.1 kB history raw
2module Main where
4import Ast
5import Control.Applicative ((<$>), (<*>))
6import Data.List (intercalate)
7import Parse.Library
8import Parse.Modules (moduleDef)
9import Parse.Types (typeAnnotation)
10import Text.Parsec hiding (newline,spaces)
11import System.Environment
12import System.Exit
13import Types.Types
16main = do
17 srcs <- mapM readFile =<< getArgs
18 case mapM docParse srcs of
19 Left err -> putStrLn err >> exitFailure
20 Right ms -> putStrLn (toModules ms)
22toModules ms = wrap (intercalate ",\n " (map toModule ms))
23 where wrap s = "{ \"modules\" : [\n " ++ s ++ "\n ]\n}"
25toModule (name, values) =
26 "{ \"name\" : " ++ show name ++ ",\n " ++
27 "\"values\" : [\n " ++ vs ++ "\n ]\n }"
28 where vs = intercalate ",\n " (map toValue values)
30toValue (name, tipe, desc) =
31 "{ \"name\" : " ++ show name ++
32 ",\n \"type\" : \"" ++ show tipe ++
33 "\",\n \"desc\" : " ++ show desc ++ "\n }"
35docParse :: String -> Either String (String, [(String, Type, String)])
36docParse = setupParser $ do
37 optional freshLine
38 (,) <$> option "Main" moduleName <*> types
39 where
40 skip = manyTill anyChar simpleNewline >> return []
41 end = many1 anyChar >> return []
42 types = concat <$> many (docs <|> try skip <|> end)
43 getName = intercalate "." . fst
44 moduleName = do optional freshLine
45 getName <$> moduleDef `followedBy` freshLine
47docs :: IParser [(String, Type, String)]
48docs = (tipe <$> try typeAnnotation) <|> commentTipe
49 where
50 clip str = case str of { ' ':rest -> rest ; _ -> str }
51 tipe stmt = case stmt of { TypeAnnotation n t -> [(n,t,"")] ; _ -> [] }
52 commentTipe = do
53 cs <- map clip <$> many1 lineComment
54 typ <- optionMaybe (try typeAnnotation)
55 return $ case typ of
56 Just (TypeAnnotation n t) -> [(n, t, intercalate "\n" cs)]
57 _ -> []
60setupParser p source =
61 case iParse p "" source of
62 Right result -> Right result
63 Left err -> Left $ "Parse error at " ++ show err