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