2fbfb20 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Thread doc comments through compilation process

2fbfb20Evan Czaplicki11 years ago

elm-compiler.cabal−84

compare with master

unifiedsplit

@@ -136,90 +136,6 @@ Library

136 unordered-containers >= 0.1 && < 0.3

137

138

139−Executable elm-doc

140− ghc-options:

141− -threaded -O2 -W

142−

143− Hs-Source-Dirs:

144− src

145−

146− Main-is:

147− Docs.hs

148−

149− other-modules:

150− Elm.Compiler.Version,

151− AST.Declaration,

152− AST.Expression.General,

153− AST.Helpers,

154− AST.Literal,

155− AST.Module,

156− AST.Pattern,

157− AST.Type,

158− AST.Variable,

159− Parse.Binop,

160− Parse.Declaration,

161− Parse.Expression,

162− Parse.Helpers,

163− Parse.Literal,

164− Parse.Module,

165− Parse.Pattern,

166− Parse.Type

167−

168− Build-depends:

169− aeson >= 0.7 && < 0.9,

170− aeson-pretty >= 0.7 && < 0.8,

171− base >=4.2 && <5,

172− binary >= 0.7.0.0 && < 0.8,

173− bytestring >= 0.9 && < 0.11,

174− cmdargs >= 0.7 && < 0.11,

175− containers >= 0.3 && < 0.6,

176− directory >= 1.0 && < 2.0,

177− filepath >= 1 && < 2.0,

178− indents >= 0.3 && < 0.4,

179− language-glsl >= 0.0.2 && < 0.2,

180− mtl >= 2.2 && < 3,

181− parsec >= 3.1.1 && < 3.5,

182− pretty >= 1.0 && < 2.0,

183− process,

184− text >= 1 && < 2,

185− transformers >= 0.2 && < 0.5,

186− union-find >= 0.2 && < 0.3

187−

188−

189−Executable elm

190− ghc-options:

191− -threaded -O2 -W

192−

193− Hs-Source-Dirs:

194− src

195−

196− Main-is:

197− CommandLineRouter.hs

198−

199− other-modules:

200− Elm.Compiler.Version

201−

202− Build-depends:

203− aeson >= 0.7 && < 0.9,

204− aeson-pretty >= 0.7 && < 0.8,

205− base >=4.2 && <5,

206− binary >= 0.7.0.0 && < 0.8,

207− bytestring >= 0.9 && < 0.11,

208− cmdargs >= 0.7 && < 0.11,

209− containers >= 0.3 && < 0.6,

210− directory >= 1.0 && < 2.0,

211− filepath >= 1 && < 2.0,

212− indents >= 0.3 && < 0.4,

213− language-glsl >= 0.0.2 && < 0.2,

214− mtl >= 2.2 && < 3,

215− parsec >= 3.1.1 && < 3.5,

216− pretty >= 1.0 && < 2.0,

217− process,

218− text >= 1 && < 2,

219− transformers >= 0.2 && < 0.5,

220− union-find >= 0.2 && < 0.3

221−

222−

223Test-Suite compiler-tests

139Test-Suite compiler-tests

224 Type:

140 Type:

225 exitcode-stdio-1.0

141 exitcode-stdio-1.0

src/AST/Declaration.hs+4−3

@@ -41,12 +41,13 @@ type SourceDecl' =

41 Declaration' SourcePort Source.Def Type.Raw Source.Expr

44−type SourceDecl =

44+data SourceDecl

45+ = Comment String

45− A.Located SourceDecl'

46+ | Decl (A.Located SourceDecl')

48type ValidDecl =

49type ValidDecl =

49− A.Located (Declaration' ValidPort Valid.Def Type.Raw Valid.Expr)

50+ A.Commented (Declaration' ValidPort Valid.Def Type.Raw Valid.Expr)

52type CanonicalDecl =

53type CanonicalDecl =

src/Canonicalize.hs+1−1

@@ -260,7 +260,7 @@ declaration

260 :: Env.Environment

261 -> D.ValidDecl

262 -> Result.ResultErr D.CanonicalDecl

263−declaration env (A.A region decl) =

263+declaration env (A.A (region,_) decl) =

264 let canonicalize kind _context _pattern env v =

265 kind env v

266 in

src/Canonicalize/Setup.hs+1−1

@@ -288,7 +288,7 @@ declToPatches

288 :: Module.Name

289 -> D.ValidDecl

290 -> (Maybe Node, [Env.Patch])

291−declToPatches moduleName (A.A region decl) =

291+declToPatches moduleName (A.A (region,_) decl) =

292 let local mkPatch x =

293 mkPatch x (Var.local x)

294

src/Docs.hsdeleted−275

@@ -1,275 +0,0 @@

1−{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}

2−module Main where

3−

4−import System.Console.CmdArgs

5−import System.Directory

6−import System.FilePath

7−import System.Exit

8−import System.IO

9−

10−import Control.Applicative ((<$>))

11−import Control.Arrow (second)

12−import Control.Monad (when)

13−import qualified Data.Aeson.Encode.Pretty as Json

14−import qualified Data.ByteString.Lazy.Char8 as BS

15−import qualified Data.Map as Map

16−import qualified Data.Maybe as Maybe

17−import qualified Data.Set as Set

18−

19−import qualified AST.Declaration as Decl

20−import qualified AST.Expression.Source as Source

21−import qualified AST.Variable as Var

22−

23−import Text.Parsec hiding (newline, spaces)

24−import qualified Parse.Declaration as Parse (typeDecl, infixDecl)

25−import qualified Parse.Expression as Parse (typeAnnotation)

26−import qualified Parse.Helpers as Parse

27−import qualified Parse.Module as Parse (header)

28−import qualified Elm.Compiler.Module as Module

29−import qualified Elm.Compiler.Type.Extract as Type

30−import qualified Elm.Docs as Docs

31−

32−

33−-- FLAGS

34−

35−data Flags = Flags

36− { input :: FilePath

37− , output :: Maybe FilePath

38− }

39− deriving (Data,Typeable,Show,Eq)

40−

41−

42−defaultFlags :: Flags

43−defaultFlags = Flags

44− { input = def &= args &= typ "FILE"

45−

46− , output = Nothing &= typFile

47− &= help "file name for generated JSON documentation"

48−

49− } &= help "Generate documentation for Elm"

50− &= summary "Generate documentation for Elm, (c) Evan Czaplicki"

51−

52−

53−-- GENERATE DOCUMENTATION

54−

55−main :: IO ()

56−main =

57− do flags <- cmdArgs defaultFlags

58− let inputFileName = input flags

59−

60− exists <- doesFileExist inputFileName

61− when (not exists) $

62− do hPutStrLn stderr $

63− if null inputFileName

64− then "Error: you must provide a file to document!"

65− else "Error: could not find a file named '" ++ inputFileName ++ "'"

66− exitFailure

67−

68− source <- readFile inputFileName

69− case Parse.iParse documentation source of

70− Right docs ->

71− let json = Json.encodePretty' config docs in

72− case output flags of

73− Nothing -> BS.putStrLn json

74− Just docPath ->

75− do createDirectoryIfMissing True (dropFileName docPath)

76− BS.writeFile docPath json

77−

78− Left err ->

79− do hPutStrLn stderr (show err)

80− exitFailure

81−

82−

83−config :: Json.Config

84−config =

85− Json.Config

86− { Json.confIndent = 2

87− , Json.confCompare = Json.keyOrder keys

88− }

89− where

90− keys =

91− [ "tag", "name", "comment", "aliases", "types"

92− , "values", "func", "args", "type", "cases"

93− ]

94−

95−

96−-- PARSE DOCUMENTATION

97−

98−documentation :: Parse.IParser Docs.Documentation

99−documentation =

100− do optional Parse.freshLine

101− (names, exports) <- Parse.header

102−

103− manyTill (string " " <|> Parse.newline <?> "more whitespace")

104− (lookAhead (string "{-|") <?> "module documentation comment")

105−

106− overview <- docComment

107−

108− decls <- allDeclarations

109−

110− let (aliases, unions, values) = categorizeDeclarations decls

111−

112− return $

113− Docs.Documentation

114− (Module.Name names)

115− overview

116− (filterAliases exports aliases)

117− (filterUnions exports unions)

118− (filterValues exports values)

119−

120−

121−docComment :: Parse.IParser String

122−docComment =

123− do try (string "{-|")

124− contents <- Parse.closeComment

125−

126− let reversed =

127− dropWhile (`elem` " \n\r") . drop 2 $ reverse contents

128−

129− return $ dropWhile (==' ') (reverse reversed)

130−

131−

132−allDeclarations :: Parse.IParser [(String, Decl.SourceDecl)]

133−allDeclarations =

134− Parse.onFreshLines (:) [] declaration

135−

136−

137−declaration :: Parse.IParser (String, Decl.SourceDecl)

138−declaration =

139− uncommentable <|> commented <|> uncommented ""

140− where

141− uncommentable =

142− (,) "" <$> Parse.infixDecl

143−

144− commented =

145− do comment <- docComment

146− Parse.freshLine

147− uncommented comment

148−

149− uncommented comment =

150− (,) comment

151− <$> choice [ Parse.typeDecl, Decl.Definition <$> Parse.typeAnnotation ]

152−

153−

154−-- CATEGORIZE DECLARATIONS

155−

156−data CategoryInfo = CategoryInfo

157− { aliases :: [Docs.Alias]

158− , unions :: [Docs.Union]

159− , values :: Map.Map String Docs.Value

160− , infixes :: Map.Map String (String, Int)

161− }

162−

163−

164−emptyInfo :: CategoryInfo

165−emptyInfo =

166− CategoryInfo [] [] Map.empty Map.empty

167−

168−

169−categorizeDeclarations :: [(String, Decl.SourceDecl)] -> ([Docs.Alias], [Docs.Union], [Docs.Value])

170−categorizeDeclarations decls =

171− (aliases, unions, Map.elems values)

172− where

173− (CategoryInfo aliases unions rawValues infixes) =

174− foldr collectInfo emptyInfo decls

175−

176− values =

177− Map.union

178− (Map.intersectionWith addInfixInfo rawValues infixes)

179− rawValues

180−

181−

182−addInfixInfo :: Docs.Value -> (String, Int) -> Docs.Value

183−addInfixInfo value infixInfo =

184− value { Docs.valueAssocPrec = Just infixInfo }

185−

186−

187−collectInfo :: (String, Decl.SourceDecl) -> CategoryInfo -> CategoryInfo

188−collectInfo (comment, decl) info =

189− case decl of

190− Decl.Definition def ->

191− case def of

192− Source.Definition _ _ ->

193− error (errorMessage "unannotated definitions")

194−

195− Source.TypeAnnotation name tipe ->

196− let value = Docs.Value name comment (Type.fromInternalType tipe) Nothing

197− in

198− info { values = Map.insert name value (values info) }

199−

200− Decl.Datatype name args cases ->

201− let cases' = map (second (map Type.fromInternalType)) cases

202− union = Docs.Union name comment args cases'

203− in

204− info { unions = union : unions info }

205−

206− Decl.TypeAlias name args tipe ->

207− let alias = Docs.Alias name comment args (Type.fromInternalType tipe)

208− in

209− info { aliases = alias : aliases info }

210−

211− Decl.Fixity assoc prec name ->

212− let infixInfo = (Decl.assocToString assoc, prec)

213− in

214− info { infixes = Map.insert name infixInfo (infixes info) }

215−

216− Decl.Port _ ->

217− error (errorMessage "ports")

218−

219−

220−errorMessage :: String -> String

221−errorMessage name =

222− "Unable to deal with annotations on " ++ name ++ " at this time.\n" ++

223− "Please report your use case to <https://github.com/elm-lang/elm-compiler/issues>"

224−

225−

226−-- FILTER OUT UNEXPORTED VALUES, ALIASES, and UNIONS

227−

228−filterValues :: Var.Listing Var.Value -> [Docs.Value] -> [Docs.Value]

229−filterValues (Var.Listing exports open) values =

230− case open of

231− True -> values

232− False ->

233− let names =

234− Set.fromList (Var.getValues exports)

235− in

236− filter (\value -> Set.member (Docs.valueName value) names) values

237−

238−

239−filterAliases :: Var.Listing Var.Value -> [Docs.Alias] -> [Docs.Alias]

240−filterAliases (Var.Listing exports open) aliases =

241− case open of

242− True -> aliases

243− False ->

244− let names =

245− Set.fromList (Var.getAliases exports)

246− in

247− filter (\value -> Set.member (Docs.aliasName value) names) aliases

248−

249−

250−filterUnions :: Var.Listing Var.Value -> [Docs.Union] -> [Docs.Union]

251−filterUnions (Var.Listing exports open) unions =

252− case open of

253− True -> unions

254− False ->

255− Maybe.mapMaybe (filterUnion exportedUnions) unions

256− where

257− exportedUnions =

258− Map.fromList (Var.getUnions exports)

259−

260−

261−filterUnion :: Map.Map String (Var.Listing String) -> Docs.Union -> Maybe Docs.Union

262−filterUnion exportedUnions union =

263− case Map.lookup (Docs.unionName union) exportedUnions of

264− Nothing ->

265− Nothing

266−

267− Just (Var.Listing tags unionOpen)

268− | unionOpen ->

269− Just union

270− | otherwise ->

271− let publicTags =

272− filter (\(tag, _) -> tag `elem` tags) (Docs.unionCases union)

273− in

274− Just (union { Docs.unionCases = publicTags })

275−

src/Elm/Docs.hs+22

@@ -5,6 +5,7 @@ import Control.Applicative ((<$>),(<*>))

5import Control.Monad

6import Data.Aeson ((.:), (.:?), (.=))

7import qualified Data.Aeson as Json

8+import qualified Data.Aeson.Encode.Pretty as Json

8import qualified Data.ByteString.Lazy.Char8 as BS

9import qualified Data.ByteString.Lazy.Char8 as BS

10import qualified Elm.Compiler.Module as Module

11import qualified Elm.Compiler.Module as Module

@@ -44,6 +45,26 @@ data Value = Value

44 }

45 }

48+-- PRETTY JSON

49+

50+prettyJson :: (Json.ToJSON a) => a -> BS.ByteString

51+prettyJson value =

52+ Json.encodePretty' config value

53+

54+

55+config :: Json.Config

56+config =

57+ Json.Config

58+ { Json.confIndent = 2

59+ , Json.confCompare = Json.keyOrder keys

60+ }

61+ where

62+ keys =

63+ [ "tag", "name", "comment", "aliases", "types"

64+ , "values", "func", "args", "type", "cases"

65+ ]

66+

67+

47-- JSON for DOCUMENTATION

68-- JSON for DOCUMENTATION

49instance Json.ToJSON Documentation where

70instance Json.ToJSON Documentation where

@@ -56,6 +77,7 @@ instance Json.ToJSON Documentation where

56 , "values" .= values

77 , "values" .= values

57 ]

78 ]

80+

59instance Json.FromJSON Documentation where

81instance Json.FromJSON Documentation where

60 parseJSON (Json.Object obj) =

82 parseJSON (Json.Object obj) =

61 Documentation

83 Documentation

src/Nitpick/TopLevelTypes.hs+2−2

@@ -31,7 +31,7 @@ warnMissingAnnotation

31 :: Map.Map String Type.Canonical

32 -> Decl.ValidDecl

33 -> Result.Result Warning.Warning Error.Error ()

34−warnMissingAnnotation typeEnv (A.A region decl) =

34+warnMissingAnnotation typeEnv (A.A (region,_) decl) =

35 case decl of

36 Decl.Definition (Valid.Definition (A.A _ (P.Var name)) _ Nothing) ->

37 case Map.lookup name typeEnv of

@@ -51,7 +51,7 @@ checkMainType

51 -> Result.Result w Error.Error ()

52checkMainType typeEnv decls =

53 case decls of

54− A.A region (Decl.Definition (Valid.Definition (A.A _ (P.Var "main")) _ _)) : _ ->

54+ A.A (region,_) (Decl.Definition (Valid.Definition (A.A _ (P.Var "main")) _ _)) : _ ->

55 case Map.lookup "main" typeEnv of

56 Nothing ->

57 return ()

src/Parse/Declaration.hs+4−1

@@ -12,7 +12,10 @@ import qualified Parse.Type as Type

13declaration :: IParser D.SourceDecl

14declaration =

15+ choice

16+ [ D.Comment <$> docComment

15− addLocation (typeDecl <|> infixDecl <|> port <|> definition)

17+ , D.Decl <$> addLocation (typeDecl <|> infixDecl <|> port <|> definition)

18+ ]

18-- TYPE ANNOTATIONS and DEFINITIONS

21-- TYPE ANNOTATIONS and DEFINITIONS

src/Parse/Helpers.hs+11

@@ -376,6 +376,17 @@ lineComment =

376 return ("--" ++ comment)

377

378

379+docComment :: IParser String

380+docComment =

381+ do try (string "{-|")

382+ contents <- closeComment

383+

384+ let reversed =

385+ dropWhile (`elem` " \n\r") . drop 2 $ reverse contents

386+

387+ return $ dropWhile (==' ') (reverse reversed)

388+

389+

379multiComment :: IParser String

390multiComment :: IParser String

380multiComment =

391multiComment =

381 (++) <$> try (string "{-") <*> closeComment

392 (++) <$> try (string "{-") <*> closeComment

src/Reporting/Annotation.hs+4

@@ -16,6 +16,10 @@ type Located a =

16 Annotated R.Region a

19+type Commented a =

20+ Annotated (R.Region, Maybe String) a

21+

22+

19-- CREATE

23-- CREATE

21at :: R.Position -> R.Position -> a -> Located a

25at :: R.Position -> R.Position -> a -> Located a

src/Validate.hs+33−20

@@ -27,31 +27,39 @@ declarations

27 -> [D.SourceDecl]

28 -> Result.Result wrn Error.Error [D.ValidDecl]

29declarations isRoot sourceDecls =

30− do validDecls <- validateDecls sourceDecls

30+ do validDecls <- validateDecls Nothing sourceDecls

31 (\_ _ -> validDecls)

32 <$> declDuplicates validDecls

33 <*> T.traverse (checkDecl isRoot) validDecls

36validateDecls

37+ :: Maybe String

37− :: [D.SourceDecl]

38+ -> [D.SourceDecl]

38 -> Result.Result wrn Error.Error [D.ValidDecl]

39 -> Result.Result wrn Error.Error [D.ValidDecl]

39−validateDecls sourceDecls =

40+validateDecls maybeComment sourceDecls =

40 case sourceDecls of

41 case sourceDecls of

41 [] ->

42 [] ->

42 return []

43 return []

44− decl : decls ->

45+ sourceDecl : decls ->

46+ case sourceDecl of

47+ D.Comment comment ->

48+ validateDecls (Just comment) decls

49+

50+ D.Decl decl ->

45− validateDeclsHelp decl decls

51+ validateDeclsHelp maybeComment decl decls

48validateDeclsHelp

54validateDeclsHelp

55+ :: Maybe String

49− :: D.SourceDecl

56+ -> A.Located D.SourceDecl'

50 -> [D.SourceDecl]

57 -> [D.SourceDecl]

51 -> Result.Result wrn Error.Error [D.ValidDecl]

58 -> Result.Result wrn Error.Error [D.ValidDecl]

52−validateDeclsHelp (A.A region decl) decls =

59+validateDeclsHelp comment (A.A region decl) decls =

53 let addRest validDecl =

60 let addRest validDecl =

61+ (:) (A.A (region, comment) validDecl)

54− (:) (A.A region validDecl) <$> validateDecls decls

62+ <$> validateDecls Nothing decls

55 in

63 in

56 case decl of

64 case decl of

57 D.Datatype name tvars ctors ->

65 D.Datatype name tvars ctors ->

@@ -64,21 +72,23 @@ validateDeclsHelp (A.A region decl) decls =

64 addRest (D.Fixity assoc prec op)

72 addRest (D.Fixity assoc prec op)

66 D.Definition def ->

74 D.Definition def ->

67− defHelp def decls

75+ defHelp comment def decls

69 D.Port port ->

77 D.Port port ->

70− portHelp region port decls

78+ portHelp comment region port decls

73-- VALIDATE DEFINITIONS IN DECLARATIONS

81-- VALIDATE DEFINITIONS IN DECLARATIONS

75defHelp

83defHelp

84+ :: Maybe String

76− :: Source.Def

85+ -> Source.Def

77 -> [D.SourceDecl]

86 -> [D.SourceDecl]

78 -> Result.Result wrn Error.Error [D.ValidDecl]

87 -> Result.Result wrn Error.Error [D.ValidDecl]

79−defHelp (A.A region def) decls =

88+defHelp comment (A.A region def) decls =

80 let addRest def' rest =

89 let addRest def' rest =

81− (:) (A.A region (D.Definition def')) <$> validateDecls rest

90+ (:) (A.A (region, comment) (D.Definition def'))

91+ <$> validateDecls Nothing rest

82 in

92 in

83 case def of

93 case def of

84 Source.Definition pat expr ->

94 Source.Definition pat expr ->

@@ -88,7 +98,8 @@ defHelp (A.A region def) decls =

89 Source.TypeAnnotation name tipe ->

99 Source.TypeAnnotation name tipe ->

90 case decls of

100 case decls of

101+ D.Decl (A.A _ (D.Definition (A.A _

91− A.A _ (D.Definition (A.A _ (Source.Definition pat@(A.A _ (Pattern.Var name')) expr))) : rest

102+ (Source.Definition pat@(A.A _ (Pattern.Var name')) expr)))) : rest

92 | name == name' ->

103 | name == name' ->

93 do expr' <- Validate.expression expr

104 do expr' <- Validate.expression expr

94 let def' = Valid.Definition pat expr' (Just tipe)

105 let def' = Valid.Definition pat expr' (Just tipe)

@@ -101,13 +112,15 @@ defHelp (A.A region def) decls =

101-- VALIDATE PORTS IN DECLARATIONS

112-- VALIDATE PORTS IN DECLARATIONS

102

113

103portHelp

114portHelp

115+ :: Maybe String

104− :: R.Region

116+ -> R.Region

105 -> D.SourcePort

117 -> D.SourcePort

106 -> [D.SourceDecl]

118 -> [D.SourceDecl]

107 -> Result.Result wrn Error.Error [D.ValidDecl]

119 -> Result.Result wrn Error.Error [D.ValidDecl]

108−portHelp region port decls =

120+portHelp comment region port decls =

109 let addRest port' rest =

121 let addRest port' rest =

110− (:) (A.A region (D.Port port')) <$> validateDecls rest

122+ (:) (A.A (region,comment) (D.Port port'))

123+ <$> validateDecls Nothing rest

111 in

124 in

112 case port of

125 case port of

113 D.PortDefinition name _ ->

126 D.PortDefinition name _ ->

@@ -115,7 +128,7 @@ portHelp region port decls =

115

128

116 D.PortAnnotation name tipe ->

129 D.PortAnnotation name tipe ->

117 case decls of

130 case decls of

118− A.A _ (D.Port (D.PortDefinition name' expr)) : rest

131+ D.Decl (A.A _ (D.Port (D.PortDefinition name' expr))) : rest

119 | name == name' ->

132 | name == name' ->

120 do expr' <- Validate.expression expr

133 do expr' <- Validate.expression expr

121 let port' = D.Out name expr' tipe

134 let port' = D.Out name expr' tipe

@@ -305,7 +318,7 @@ declDuplicates decls =

305

318

306

319

307extractValues :: D.ValidDecl -> ([A.Located String], [A.Located String])

320extractValues :: D.ValidDecl -> ([A.Located String], [A.Located String])

308−extractValues (A.A region decl) =

321+extractValues (A.A (region, _) decl) =

309 case decl of

322 case decl of

310 D.Definition (Valid.Definition pattern _ _) ->

323 D.Definition (Valid.Definition pattern _ _) ->

311 ( Pattern.boundVars pattern

324 ( Pattern.boundVars pattern

@@ -341,7 +354,7 @@ extractValues (A.A region decl) =

341-- UNBOUND TYPE VARIABLES

354-- UNBOUND TYPE VARIABLES

342

355

343checkDecl :: Bool -> D.ValidDecl -> Result.Result wrn Error.Error ()

356checkDecl :: Bool -> D.ValidDecl -> Result.Result wrn Error.Error ()

344−checkDecl isRoot (A.A region decl) =

357+checkDecl isRoot (A.A (region,_) decl) =

345 case decl of

358 case decl of

346 D.Definition _ ->

359 D.Definition _ ->

347 return ()

360 return ()