git.iko.soy/elk
on a3801ac help sign in
elk/compiler/Docs.hs
76 lines 2.6 kB history raw
2module Main where
4import Ast
5import Control.Applicative ((<$>), (<*>))
6import Data.List (intercalate)
7import Data.Maybe (catMaybes)
8import Types.Types ((==>), Type ( ADT, VarT ) )
9import Parse.Types (datatype)
10import Parse.Library
11import Parse.Modules (moduleDef)
12import Text.Parsec hiding (newline,spaces)
13import System.Environment
14import System.Exit
17main = do
18 srcs <- mapM readFile =<< getArgs
19 case mapM docParse srcs of
20 Left err -> putStrLn err >> exitFailure
21 Right ms -> putStrLn (toModules ms)
23toModules ms = wrap (intercalate ",\n " (map toModule ms))
24 where wrap s = "{ \"modules\" : [\n " ++ s ++ "\n ]\n}"
26toModule (name, values) =
27 "{ \"name\" : " ++ show name ++ ",\n " ++
28 "\"values\" : [\n " ++ vs ++ "\n ]\n }"
29 where vs = intercalate ",\n " (map toValue values)
31toValue (name, tipe, desc) =
32 "{ \"name\" : " ++ show name ++
33 ",\n \"type\" : " ++ show tipe ++
34 ",\n \"desc\" : " ++ show desc ++ "\n }"
36docParse :: String -> Either String (String, [(String, String, String)])
37docParse = setupParser $ do
38 optional freshLine
39 (names, exports) <- option (["Main"],[]) moduleDef
40 info <- many (try (annotation exports) <|> try skip <|> end)
41 return (intercalate "." names, concat info)
42 where
43 skip = manyTill anyChar simpleNewline >> return []
44 end = many1 anyChar >> return []
46annotation :: [String] -> IParser [(String, String, String)]
47annotation exports =
48 do description <- comment
49 extras <- option [] (lookAhead adt)
50 varName <- try typeDef <|> name
51 varType <- tipe
52 return $ extras ++ export varName varType description
53 where
54 comment = concatMap clip <$> many lineComment
55 clip str = case str of { ' ':rest -> rest ; _ -> str } ++ "\n"
57 name = do v <- lowVar <|> parens symOp
58 whitespace ; hasType ; whitespace ; return v
60 tipe = manyTill anyChar (try (simpleNewline >> notFollowedBy (string " ")))
62 export name tipe desc =
63 if null exports || name `elem` exports then [(name,tipe,desc)] else []
65 typeDef = lookAhead ((string "data" <|> string "type") >> whitespace >> capVar)
67 adt = do
68 (Datatype name tvs constructors) <- datatype
69 let toType (cName, typeArgs) =
70 (cName, show $ foldr (==>) (ADT name $ map VarT tvs) typeArgs, "")
71 return $ map toType constructors
73setupParser p source =
74 case iParse p "" source of
75 Right result -> Right result
76 Left err -> Left $ "Parse error at " ++ show err