Get elm-doc to extract comments!

compiler/Docs.hs

@@ -19,31 +19,44 @@ main = do
     Left err -> putStrLn err >> exitFailure
     Right ms -> putStrLn (toModules ms)
 
-toModules ms =
-  "{ \"modules\" : [\n    " ++ intercalate ",\n    " (map toModule ms) ++ "\n  ]\n}"
+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)
+    "{ \"name\" : " ++ show name ++ ",\n      " ++
+    "\"values\" : [\n        " ++ vs ++ "\n      ]\n    }"
+  where vs = intercalate ",\n        " (map toValue values)
 
-toValue (name, tipe) =
-    "{ \"name\" : " ++ show name ++ ",\n          \"type\" : \"" ++ show tipe ++ "\"\n        }"
+toValue (name, tipe, desc) =
+    "{ \"name\" : " ++ show name ++
+    ",\n          \"type\" : \"" ++ show tipe ++
+    ",\n          \"desc\" : " ++ show desc ++ "\n        }"
 
-
-docParse :: String -> Either String (String, [(String, Type)])
+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 []
-      tipe = get <$> try typeAnnotation
-      get stmt = case stmt of { TypeAnnotation n t -> [(n,t)] ; _ -> [] }
-      types = concat <$> many (tipe <|> try skip <|> end)
+      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

compiler/Language/Elm.hs

@@ -14,7 +14,7 @@
      at <https://github.com/tazjin/Elm/tree/master/Examples>
 -}
 module Language.Elm (
-    ElmSource (..),
+    compile, toHtml,
     runtimeLocation
     ) where
 
@@ -30,52 +30,21 @@ import Paths_Elm
 import qualified Data.Text as TS
 import qualified Data.Text.Lazy as TL
 
+-- |This function compiles Elm code to three separate parts: HTML, CSS,
+--  and JavaScript. The HTML is only the contents of the body, so the three
+--  parts must be combined in a basic HTML skeleton.
+compile :: String -> String
+compile source = either showErr jsModule modul
+  where modul = buildFromSource source
+
+-- |This function compiles Elm code into a full HTML page.
+toHtml :: String -- ^ Location of elm-min.js as expected by the browser
+       -> String -- ^ The page title
+       -> String -- ^ The elm source code
+       -> Html
+toHtml = generateHtml
+
 -- |The absolute path to Elm's runtime system.
 runtimeLocation :: IO FilePath
 runtimeLocation = getDataFileName "elm-runtime.js"
 
-class ElmSource a where
-  -- |This function compiles Elm code to three separate parts: HTML, CSS,
-  --  and JavaScript. The HTML is only the contents of the body, so the three
-  --  parts must be combined in a basic HTML skeleton.
-  compile :: a -> String
-
-  -- |This function compiles Elm code into a full HTML page.
-  toHtml :: String -- ^ Location of elm-min.js as expected by the browser
-         -> String -- ^ The page title
-         -> a      -- ^ The elm source code
-         -> Html
-
-instance ElmSource String where
-  compile = compileHelper
-  toHtml = generateHtml
-
-instance ElmSource Elm where
-  compile = compileHelper . TL.unpack . renderElm
-  toHtml elmL title  = generateHtml elmL title  . TL.unpack . renderElm
-
--- |Strict text
-instance ElmSource TS.Text where
-  compile = compileHelper . TS.unpack
-  toHtml elmL title = generateHtml elmL title . TS.unpack
-
--- |Lazy text
-instance ElmSource TL.Text where
-  compile = compileHelper . TL.unpack
-  toHtml elmL title = generateHtml elmL title . TL.unpack
-
--- | (urlRenderFn, urlRenderFn -> Elm)
-instance ElmSource (t, t -> Elm) where
-  compile (f, s) = compileHelper $ TL.unpack $ renderElm $ s f  
-  toHtml elmL title (f, s) = generateHtml elmL title $ TL.unpack $ renderElm $ s f
-
--- | to be used without URL interpolation
-instance ElmSource (t -> Elm) where
-  compile s = compileHelper $ TL.unpack $ renderElm $ s undefined
-  toHtml l t s = generateHtml l t $ TL.unpack $ renderElm $ s undefined
-
-
--- build helper to avoid boilerplate repetition
-compileHelper :: String -> String
-compileHelper source = either showErr jsModule modul
-  where modul = buildFromSource source