cb6a361 · elk · git.iko.soy

elm-compiler.cabal+4

@@ -67,6 +67,9 @@ Library

6767 Canonicalize.Type,

6868 Canonicalize.Variable,

6969 Compile,

70+ Docs.AST,

71+ Docs.Centralize,

72+ Docs.Check,

7073 Elm.Compiler.Imports,

7174 Elm.Compiler.Type.Extract,

7275 Elm.Compiler.Version,

@@ -89,6 +92,7 @@ Library

8992 Reporting.Annotation,

9093 Reporting.Error,

9194 Reporting.Error.Canonicalize,

95+ Reporting.Error.Docs,

9296 Reporting.Error.Syntax,

9397 Reporting.Error.Type,

9498 Reporting.PrettyPrint,

src/AST/Declaration.hs+1−1

@@ -51,7 +51,7 @@ type ValidDecl =

5151

5252

5353type CanonicalDecl =

54− A.Located (Declaration' CanonicalPort Canonical.Def Type.Canonical Canonical.Expr)

54+ A.Commented (Declaration' CanonicalPort Canonical.Def Type.Canonical Canonical.Expr)

5555

5656

5757-- PORTS

src/AST/Module.hs+10−2

@@ -19,6 +19,7 @@ import qualified AST.Declaration as Decl

1919import qualified AST.Expression.Canonical as Canonical

2020import qualified AST.Type as Type

2121import qualified AST.Variable as Var

22+import qualified Docs.AST as Docs

2223import qualified Elm.Compiler.Version as Compiler

2324import qualified Reporting.Annotation as A

2425

@@ -39,6 +40,7 @@ type CanonicalAdt = (Var.Canonical, AdtInfo Var.Canonical)

3940

4041type SourceModule =

4142 Module

43+ String

4244 [UserImport]

4345 (Var.Listing (A.Located Var.Value))

4446 [Decl.SourceDecl]

@@ -46,23 +48,26 @@ type SourceModule =

4648

4749type ValidModule =

4850 Module

51+ String

4952 ([DefaultImport], [UserImport])

5053 (Var.Listing (A.Located Var.Value))

5154 [Decl.ValidDecl]

5255

5356

5457type CanonicalModule =

55− Module [Name] [Var.Value] CanonicalBody

58+ Module Docs.Centralized [Name] [Var.Value] CanonicalBody

5659

5760

58−data Module imports exports body = Module

61+data Module docs imports exports body = Module

5962 { names :: Name

6063 , path :: FilePath

64+ , docs :: A.Located (Maybe docs)

6165 , exports :: exports

6266 , imports :: imports

6367 , body :: body

6468 }

6569

70+

6671data CanonicalBody = CanonicalBody

6772 { program :: Canonical.Expr

6873 , types :: Types

@@ -78,6 +83,7 @@ data CanonicalBody = CanonicalBody

7883{-| Basic info needed to identify modules and determine dependencies. -}

7984data Header imports = Header

8085 { _names :: Name

86+ , _docs :: A.Located (Maybe String)

8187 , _exports :: Var.Listing (A.Located Var.Value)

8288 , _imports :: imports

8389 }

@@ -126,6 +132,7 @@ data Interface = Interface

126132 , iPorts :: [String]

127133 }

128134

135+

129136toInterface :: CanonicalModule -> Interface

130137toInterface modul =

131138 let body' = body modul in

@@ -140,6 +147,7 @@ toInterface modul =

140147 , iPorts = ports body'

141148 }

142149

150+

143151instance Binary Interface where

144152 get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get

145153 put modul = do

src/Canonicalize.hs+12−7

@@ -18,6 +18,8 @@ import qualified AST.Module as Module

1818import qualified AST.Pattern as P

1919import qualified AST.Type as Type

2020import qualified AST.Variable as Var

21+import qualified Docs.AST as Docs

22+import qualified Docs.Centralize as Docs

2123import qualified Reporting.Annotation as A

2224import qualified Reporting.Error as Error

2325import qualified Reporting.Error.Canonicalize as CError

@@ -40,8 +42,9 @@ module'

4042 -> Module.ValidModule

4143 -> R.Result Warning.Warning Error.Error Module.CanonicalModule

4244module' interfaces modul =

43− let (Result.Result uses rawResults) =

44− moduleHelp interfaces modul

45+ let

46+ (Result.Result uses rawResults) =

47+ moduleHelp interfaces modul

4548 in

4649 case rawResults of

4750 Result.Ok (env, almostCanonicalModule) ->

@@ -54,6 +57,7 @@ module' interfaces modul =

5457

5558type AlmostCanonicalModule =

5659 Module.Module

60+ Docs.Centralized

5761 ([Module.DefaultImport], [Module.UserImport])

5862 [Var.Value]

5963 Module.CanonicalBody

@@ -63,7 +67,7 @@ moduleHelp

6367 :: Module.Interfaces

6468 -> Module.ValidModule

6569 -> Result.ResultErr (Env.Environment, AlmostCanonicalModule)

66−moduleHelp interfaces modul@(Module.Module _ _ exports _ decls) =

70+moduleHelp interfaces modul@(Module.Module _ _ comment exports _ decls) =

6771 canonicalModule

6872 <$> canonicalDeclsResult

6973 <*> resolveExports locals exports

@@ -71,7 +75,8 @@ moduleHelp interfaces modul@(Module.Module _ _ exports _ decls) =

7175 canonicalModule (env, canonicalDecls) canonicalExports =

7276 (,) env $

7377 modul

74− { Module.exports = canonicalExports

78+ { Module.docs = A.map (fmap (Docs.centralize canonicalDecls)) comment

79+ , Module.exports = canonicalExports

7580 , Module.body = body canonicalDecls

7681 }

7782

@@ -116,7 +121,7 @@ filterImports

116121 :: Set.Set Module.Name

117122 -> AlmostCanonicalModule

118123 -> R.Result Warning.Warning e Module.CanonicalModule

119−filterImports uses modul@(Module.Module _ _ _ (defaults, imports) _) =

124+filterImports uses modul@(Module.Module _ _ _ _ (defaults, imports) _) =

120125 do reducedImports <-

121126 Maybe.catMaybes <$> T.traverse checkImport imports

122127

@@ -262,8 +267,8 @@ declaration

262267 :: Env.Environment

263268 -> D.ValidDecl

264269 -> Result.ResultErr D.CanonicalDecl

265−declaration env (A.A (region,_) decl) =

266− A.A region <$>

270+declaration env (A.A ann@(region,_) decl) =

271+ A.A ann <$>

267272 case decl of

268273 D.Definition (Valid.Definition pat expr typ) ->

269274 D.Definition <$> (

src/Canonicalize/Declaration.hs+1−1

@@ -18,7 +18,7 @@ toExpr moduleName decls =

1818

1919

2020toDefs :: Module.Name -> D.CanonicalDecl -> [Canonical.Def]

21−toDefs moduleName (A.A region decl) =

21+toDefs moduleName (A.A (region,_) decl) =

2222 let typeVar = Var.fromModule moduleName

2323

2424 loc expr =

src/Canonicalize/Setup.hs+1−1

@@ -27,7 +27,7 @@ environment

2727 :: Module.Interfaces

2828 -> Module.ValidModule

2929 -> Result.ResultErr Env.Environment

30−environment interfaces modul@(Module.Module _ _ _ (defaults, imports) decls) =

30+environment interfaces modul@(Module.Module _ _ _ _ (defaults, imports) decls) =

3131 let moduleName =

3232 Module.names modul

3333

src/Docs/AST.hsnew file+44

@@ -0,0 +1,44 @@

1+module Docs.AST where

2+

3+import qualified Data.Map as Map

4+

5+import qualified Elm.Compiler.Type as Type

6+import qualified Reporting.Annotation as A

7+

8+

9+-- FULL DOCUMENTATION

10+

11+data Docs t = Docs

12+ { comment :: String

13+ , aliases :: Map.Map String (A.Located Alias)

14+ , types :: Map.Map String (A.Located Union)

15+ , values :: Map.Map String (A.Located (Value t))

16+ }

17+

18+

19+type Centralized = Docs (Maybe Type.Type)

20+

21+type Checked = Docs (Type.Type)

22+

23+

24+-- VALUE DOCUMENTATION

25+

26+data Alias = Alias

27+ { aliasComment :: Maybe String

28+ , aliasArgs :: [String]

29+ , aliasType :: Type.Type

30+ }

31+

32+

33+data Union = Union

34+ { unionComment :: Maybe String

35+ , unionArgs :: [String]

36+ , unionCases :: [(String, [Type.Type])]

37+ }

38+

39+

40+data Value t = Value

41+ { valueComment :: Maybe String

42+ , valueType :: t

43+ , valueAssocPrec :: Maybe (String,Int)

44+ }

src/Docs/Centralize.hsnew file+100

@@ -0,0 +1,100 @@

1+module Docs.Centralize (centralize) where

2+

3+import Control.Arrow (second)

4+import qualified Data.Map as Map

5+

6+import qualified AST.Declaration as D

7+import qualified AST.Expression.Canonical as Canonical

8+import qualified AST.Pattern as P

9+import qualified Docs.AST as Docs

10+import qualified Elm.Compiler.Type as Type

11+import qualified Elm.Compiler.Type.Extract as Extract

12+import qualified Reporting.Annotation as A

13+

14+

15+-- CENTRALIZE DOCUMENTATION

16+

17+centralize :: [D.CanonicalDecl] -> String -> Docs.Centralized

18+centralize decls comment =

19+ let

20+ (Raw aliases types valueInfo fixities) =

21+ toRawDocs decls

22+

23+ values =

24+ Map.fromList (map (toValue fixities) (Map.toList valueInfo))

25+ in

26+ Docs.Docs comment aliases types values

27+

28+

29+toValue

30+ :: Map.Map String (String, Int)

31+ -> ( String, A.Located (Maybe String, Maybe Type.Type) )

32+ -> ( String, A.Located (Docs.Value (Maybe Type.Type)) )

33+toValue fixities (name, A.A region (maybeComment, maybeType)) =

34+ ( name

35+ , A.A region (Docs.Value maybeComment maybeType (Map.lookup name fixities))

36+ )

37+

38+

39+-- GATHER INFORMATION

40+

41+data Raw = Raw

42+ { rawAliases :: Map.Map String (A.Located Docs.Alias)

43+ , rawTypes :: Map.Map String (A.Located Docs.Union)

44+ , rawValues :: Map.Map String (A.Located (Maybe String, Maybe Type.Type))

45+ , rawFixities :: Map.Map String (String, Int)

46+ }

47+

48+

49+toRawDocs :: [D.CanonicalDecl] -> Raw

50+toRawDocs decls =

51+ foldr addDeclToDocs (Raw Map.empty Map.empty Map.empty Map.empty) decls

52+

53+

54+addDeclToDocs :: D.CanonicalDecl -> Raw -> Raw

55+addDeclToDocs (A.A (region,maybeComment) decl) docs =

56+ case decl of

57+ D.Definition (Canonical.Definition (A.A subregion (P.Var name)) _ maybeType) ->

58+ let

59+ info =

60+ ( maybeComment

61+ , fmap (Extract.fromInternalType . A.drop) maybeType

62+ )

63+

64+ newValues =

65+ Map.insert name (A.A subregion info) (rawValues docs)

66+ in

67+ docs { rawValues = newValues }

68+

69+ D.Definition _ ->

70+ docs

71+

72+ D.Datatype name args ctors ->

73+ let

74+ ctors' =

75+ map (second (map Extract.fromInternalType)) ctors

76+

77+ union =

78+ A.A region (Docs.Union maybeComment args ctors')

79+ in

80+ docs { rawTypes = Map.insert name union (rawTypes docs) }

81+

82+ D.TypeAlias name args tipe ->

83+ let

84+ alias =

85+ A.A region (Docs.Alias maybeComment args (Extract.fromInternalType tipe))

86+ in

87+ docs { rawAliases = Map.insert name alias (rawAliases docs) }

88+

89+ D.Port _ ->

90+ docs

91+

92+ D.Fixity assoc precedence name ->

93+ let

94+ fixity =

95+ (D.assocToString assoc, precedence)

96+ in

97+ docs

98+ { rawFixities =

99+ Map.insert name fixity (rawFixities docs)

100+ }

src/Docs/Check.hsnew file+130

@@ -0,0 +1,130 @@

1+module Docs.Check (check) where

2+

3+import Control.Applicative ((<$>),(<*>))

4+import qualified Data.Map as Map

5+import qualified Data.Set as Set

6+import qualified Data.Traversable as T

7+import Text.Parsec ((<|>), choice, many, string)

8+

9+import qualified AST.Variable as Var

10+import qualified Docs.AST as Docs

11+import qualified Elm.Compiler.Type as Type

12+import Elm.Utils ((|>))

13+import Parse.Helpers

14+ ( anyUntil, commaSep1, iParse, parens, simpleNewline, symOp, var

15+ , whitespace

16+ )

17+import qualified Reporting.Annotation as A

18+import qualified Reporting.Error.Docs as Error

19+import qualified Reporting.Region as R

20+import qualified Reporting.Result as R

21+

22+

23+-- CHECK DOCUMENTATION

24+

25+check :: [Var.Value] -> A.Located (Maybe Docs.Centralized) -> R.Result w Error.Error Docs.Checked

26+check exports (A.A region maybeDocs) =

27+ case maybeDocs of

28+ Nothing ->

29+ R.throw region Error.NoDocs

30+

31+ Just docs ->

32+ checkHelp region exports docs

33+

34+

35+checkHelp :: R.Region -> [Var.Value] -> Docs.Centralized -> R.Result w Error.Error Docs.Checked

36+checkHelp region exports (Docs.Docs comment aliases types values) =

37+ let

38+ docNames =

39+ Set.fromList (commentedNames comment)

40+

41+ checkCategory checkValue dict =

42+ dict

43+ |> Map.filterWithKey (\key _ -> Set.member key docNames)

44+ |> Map.mapWithKey checkValue

45+ |> T.traverse id

46+

47+ checkValue name value =

48+ const

49+ <$> hasType name value

50+ <*> hasComment Docs.valueComment name value

51+ in

52+ (\() -> Docs.Docs comment)

53+ <$> checkComment region exports docNames

54+ <*> checkCategory (hasComment Docs.aliasComment) aliases

55+ <*> checkCategory (hasComment Docs.unionComment) types

56+ <*> checkCategory checkValue values

57+

58+

59+hasComment

60+ :: (a -> Maybe String)

61+ -> String

62+ -> A.Located a

63+ -> R.Result w Error.Error (A.Located a)

64+hasComment getComment name (A.A region value) =

65+ case getComment value of

66+ Nothing ->

67+ R.throw region (Error.NoComment name)

68+

69+ Just _ ->

70+ R.ok (A.A region value)

71+

72+

73+hasType

74+ :: String

75+ -> A.Located (Docs.Value (Maybe Type.Type))

76+ -> R.Result w Error.Error (A.Located (Docs.Value Type.Type))

77+hasType name (A.A region value) =

78+ case Docs.valueType value of

79+ Just tipe ->

80+ R.ok (A.A region (value { Docs.valueType = tipe }))

81+

82+ Nothing ->

83+ R.throw region (Error.NoType name)

84+

85+

86+-- CHECK MODULE COMMENT

87+

88+checkComment :: R.Region -> [Var.Value] -> Set.Set String -> R.Result w Error.Error ()

89+checkComment region exports docNames =

90+ let

91+ exportNames =

92+ Set.fromList (map valueName exports)

93+

94+ onlyInDocs =

95+ Set.toList (Set.difference docNames exportNames)

96+

97+ onlyInExports =

98+ Set.toList (Set.difference exportNames docNames)

99+ in

100+ (\_ _ -> ())

101+ <$> T.traverse (R.throw region . Error.OnlyInDocs) onlyInDocs

102+ <*> T.traverse (R.throw region . Error.OnlyInExports) onlyInExports

103+

104+

105+commentedNames :: String -> [String]

106+commentedNames comment =

107+ let

108+ nameParser =

109+ choice

110+ [ do string "@docs"

111+ whitespace

112+ commaSep1 (var <|> parens symOp)

113+ , do anyUntil simpleNewline

114+ return []

115+ ]

116+ in

117+ case iParse (concat <$> many nameParser) comment of

118+ Left _ ->

119+ []

120+

121+ Right names ->

122+ names

123+

124+

125+valueName :: Var.Value -> String

126+valueName value =

127+ case value of

128+ Var.Value name -> name

129+ Var.Alias name -> name

130+ Var.Union name _ -> name

src/Elm/Compiler.hs+56−18

@@ -1,7 +1,8 @@

11{-# OPTIONS_GHC -Wall #-}

22module Elm.Compiler

33 ( version, rawVersion

4− , parseDependencies, compile

4+ , parseDependencies

5+ , compile, Context(..), Result(..)

56 , Dealiaser, dummyDealiaser

67 , Error, errorToString, errorToJson, printError

78 , Warning, warningToString, warningToJson, printWarning

@@ -12,8 +13,10 @@ import qualified Data.Map as Map

1213

1314import qualified AST.Module as Module

1415import qualified Compile

16+import qualified Docs.Check as Docs

1517import qualified Elm.Compiler.Module as PublicModule

1618import qualified Elm.Compiler.Version as Version

19+import qualified Elm.Docs as Docs

1720import qualified Generate.JavaScript as JS

1821import qualified Parse.Module as Parse

1922import qualified Parse.Parse as Parse

@@ -50,7 +53,7 @@ parseDependencies sourceCode =

5053 Result.Err msgs ->

5154 Left $ map (Error . A.map Error.Syntax) msgs

5255

53− Result.Ok (Module.Header names _exports imports) ->

56+ Result.Ok (Module.Header names _docs _exports imports) ->

5457 Right

5558 ( PublicModule.Name names

5659 , map (PublicModule.Name . fst . A.drop) imports

@@ -61,26 +64,61 @@ parseDependencies sourceCode =

6164

6265{-| Compiles Elm source code to JavaScript. -}

6366compile

64− :: String

65− -> String

66− -> Bool

67+ :: Context

6768 -> String

6869 -> Map.Map PublicModule.Name PublicModule.Interface

69− -> (Dealiaser, [Warning], Either [Error] (PublicModule.Interface, String))

70−compile user packageName isRoot source interfaces =

71− let unwrappedInterfaces =

72− Map.mapKeysMonotonic (\(PublicModule.Name name) -> name) interfaces

70+ -> (Dealiaser, [Warning], Either [Error] Result)

7371

74− (Result.Result (dealiaser, warnings) rawResult) =

75− Compile.compile user packageName isRoot unwrappedInterfaces source

76− in

77− (,,) (maybe dummyDealiaser Dealiaser dealiaser) (map Warning warnings) $

78− case rawResult of

79− Result.Ok modul ->

80− Right (Module.toInterface modul, JS.generate modul)

72+compile context source interfaces =

73+ let

74+ (Context user packageName isRoot isExposed) =

75+ context

76+

77+ unwrappedInterfaces =

78+ Map.mapKeysMonotonic (\(PublicModule.Name name) -> name) interfaces

8179

82− Result.Err errors ->

83− Left (map Error errors)

80+ (Result.Result (dealiaser, warnings) rawResult) =

81+ do modul <- Compile.compile user packageName isRoot unwrappedInterfaces source

82+ docs <- docsGen isExposed modul

83+ return (Result docs (Module.toInterface modul) (JS.generate modul))

84+ in

85+ ( maybe dummyDealiaser Dealiaser dealiaser

86+ , map Warning warnings

87+ , Result.destruct (Left . map Error) Right rawResult

88+ )

89+

90+

91+data Context = Context

92+ { _user :: String

93+ , _packageName :: String

94+ , _isRoot :: Bool

95+ , _isExposed :: Bool

96+ }

97+

98+

99+data Result = Result

100+ { _docs :: Maybe Docs.Documentation

101+ , _interface :: PublicModule.Interface

102+ , _js :: String

103+ }

104+

105+

106+docsGen

107+ :: Bool

108+ -> Module.CanonicalModule

109+ -> Result.Result w Error.Error (Maybe Docs.Documentation)

110+docsGen isExposed modul =

111+ if not isExposed then

112+ Result.ok Nothing

113+ else

114+ let

115+ getChecked =

116+ Docs.check (Module.exports modul) (Module.docs modul)

117+

118+ toDocs checked =

119+ Docs.fromCheckedDocs (PublicModule.Name (Module.names modul)) checked

120+ in

121+ (Just . toDocs) `fmap` Result.mapError Error.Docs getChecked

84122

85123

86124-- DEALIASER

src/Elm/Docs.hs+27−1

@@ -7,9 +7,12 @@ import Data.Aeson ((.:), (.:?), (.=))

77import qualified Data.Aeson as Json

88import qualified Data.Aeson.Encode.Pretty as Json

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

10+import qualified Data.Map as Map

1011

12+import qualified Docs.AST as Docs

1113import qualified Elm.Compiler.Module as Module

1214import qualified Elm.Compiler.Type as Type

15+import qualified Reporting.Annotation as A

1316

1417

1518data Documentation = Documentation

@@ -41,10 +44,33 @@ data Value = Value

4144 { valueName :: String

4245 , valueComment :: String

4346 , valueType :: Type.Type

44− , valueAssocPrec :: Maybe (String,Int)

47+ , valueFix :: Maybe (String,Int)

4548 }

4649

4750

51+-- FROM CHECKED DOCS

52+

53+fromCheckedDocs :: Module.Name -> Docs.Checked -> Documentation

54+fromCheckedDocs name (Docs.Docs comment aliases unions values) =

55+ let

56+ unwrap cmnt =

57+ maybe "" id cmnt

58+

59+ toAlias (name, (A.A _ (Docs.Alias cmnt args tipe))) =

60+ Alias name (unwrap cmnt) args tipe

61+

62+ toUnion (name, (A.A _ (Docs.Union cmnt args cases))) =

63+ Union name (unwrap cmnt) args cases

64+

65+ toValue (name, (A.A _ (Docs.Value cmnt tipe fix))) =

66+ Value name (unwrap cmnt) tipe fix

67+ in

68+ Documentation name comment

69+ (map toAlias (Map.toList aliases))

70+ (map toUnion (Map.toList unions))

71+ (map toValue (Map.toList values))

72+

73+

4874-- PRETTY JSON

4975

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

src/Generate/JavaScript.hs+1−1

@@ -344,7 +344,7 @@ flattenLets defs lexpr@(A.A _ expr) =

344344 _ -> (defs, lexpr)

345345

346346

347−generate :: CanonicalModule -> String

347+generate :: Module.CanonicalModule -> String

348348generate modul =

349349 show . prettyPrint $ setup "Elm" (names ++ ["make"]) ++

350350 [ assign ("Elm" : names ++ ["make"]) (function [localRuntime] programStmts) ]

src/Parse/Declaration.hs+2−2

@@ -6,14 +6,14 @@ import Text.Parsec ( (<|>), (<?>), choice, digit, optionMaybe, string, try )

66

77import qualified AST.Declaration as D

88import qualified Parse.Expression as Expr

9−import Parse.Helpers

9+import Parse.Helpers as Help

1010import qualified Parse.Type as Type

1111

1212

1313declaration :: IParser D.SourceDecl

1414declaration =

1515 choice

16− [ D.Comment <$> docComment

16+ [ D.Comment <$> Help.docComment

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

1818 ]

1919

src/Parse/Helpers.hs+2−2

@@ -1,7 +1,7 @@

11module Parse.Helpers where

22

33import Prelude hiding (until)

4−import Control.Applicative ((<$>),(<*>))

4+import Control.Applicative ((<$>),(<*>),(<*))

55import Control.Monad (guard, join)

66import Control.Monad.State (State)

77import Data.Char (isUpper)

@@ -390,7 +390,7 @@ docComment =

390390

391391multiComment :: IParser String

392392multiComment =

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

393+ (++) <$> try (string "{-" <* notFollowedBy (string "|")) <*> closeComment

394394

395395

396396closeComment :: IParser String

src/Parse/Module.hs+6−1

@@ -26,8 +26,13 @@ header =

2626 do optional freshLine

2727 (names, exports) <-

2828 option (["Main"], Var.openListing) (moduleDecl `followedBy` freshLine)

29+ docs <-

30+ choice

31+ [ addLocation (Just <$> docComment) `followedBy` freshLine

32+ , addLocation (return Nothing)

33+ ]

2934 imports' <- imports

30− return (Module.Header names exports imports')

35+ return (Module.Header names docs exports imports')

3136

3237

3338moduleDecl :: IParser ([String], Var.Listing (A.Located Var.Value))

src/Parse/Parse.hs+4−4

@@ -26,7 +26,7 @@ program

2626 -> String

2727 -> Result.Result wrn Error.Error M.ValidModule

2828program needsDefaults isRoot table src =

29− do (M.Module names filePath exports imports sourceDecls) <-

29+ do (M.Module names filePath docs exports imports sourceDecls) <-

3030 parseWithTable table src programParser

3131

3232 validDecls <- Validate.declarations isRoot sourceDecls

@@ -34,19 +34,19 @@ program needsDefaults isRoot table src =

3434 let ammendedImports =

3535 (if needsDefaults then Imports.defaults else [], imports)

3636

37− return (M.Module names filePath exports ammendedImports validDecls)

37+ return (M.Module names filePath docs exports ammendedImports validDecls)

3838

3939

4040-- HEADERS AND DECLARATIONS

4141

4242programParser :: IParser M.SourceModule

4343programParser =

44− do (M.Header names exports imports) <- Module.header

44+ do (M.Header names docs exports imports) <- Module.header

4545 decls <- declarations

4646 optional freshLine

4747 optional spaces

4848 eof

49− return $ M.Module names "" exports imports decls

49+ return $ M.Module names "" docs exports imports decls

5050

5151

5252declarations :: IParser [D.SourceDecl]

src/Reporting/Error.hs+8

@@ -8,6 +8,7 @@ import Prelude hiding (print)

88

99import qualified Reporting.Annotation as A

1010import qualified Reporting.Error.Canonicalize as Canonicalize

11+import qualified Reporting.Error.Docs as Docs

1112import qualified Reporting.Error.Syntax as Syntax

1213import qualified Reporting.Error.Type as Type

1314import qualified Reporting.PrettyPrint as P

@@ -20,6 +21,7 @@ data Error

2021 = Syntax Syntax.Error

2122 | Canonicalize Canonicalize.Error

2223 | Type Type.Error

24+ | Docs Docs.Error

2325

2426

2527-- TO REPORT

@@ -36,6 +38,9 @@ toReport dealiaser err =

3638 Type typeError ->

3739 Type.toReport dealiaser typeError

3840

41+ Docs docsError ->

42+ Docs.toReport docsError

43+

3944

4045-- TO STRING

4146

@@ -70,6 +75,9 @@ toJson dealiaser filePath (A.A region err) =

7075

7176 Type typeError ->

7277 Report.toJson [] (Type.toReport dealiaser typeError)

78+

79+ Docs docsError ->

80+ Report.toJson [] (Docs.toReport docsError)

7381 in

7482 Json.object $

7583 [ "file" .= filePath

src/Reporting/Error/Docs.hsnew file+57

@@ -0,0 +1,57 @@

1+{-# OPTIONS_GHC -Wall #-}

2+module Reporting.Error.Docs where

3+

4+import qualified Reporting.Report as Report

5+

6+

7+data Error

8+ = NoDocs

9+ | OnlyInDocs String

10+ | OnlyInExports String

11+ | NoComment String

12+ | NoType String

13+

14+

15+-- TO REPORT

16+

17+toReport :: Error -> Report.Report

18+toReport err =

19+ case err of

20+ NoDocs ->

21+ Report.simple "NO MODULE DOCUMENTATION"

22+ ( "You must have a documentation comment between the module declaration and the\n"

23+ ++ "imports."

24+ )

25+ "Learn how at <http://package.elm-lang.org/help/documentation-format>"

26+

27+ OnlyInDocs name ->

28+ Report.simple "UNDEFINED DOCUMENTATION"

29+ ("Your module documentation includes `" ++ name ++ "` which is not exported.")

30+ "Is it misspelled? Should it be exported?"

31+

32+ OnlyInExports name ->

33+ Report.simple "MISSING DOCUMENTATION"

34+ ("Your module exports `" ++ name ++ "` but it is not in the module documentation.")

35+ ( "It needs to be listed in the module documentation.\n"

36+ ++ "Learn how at <http://package.elm-lang.org/help/documentation-format>"

37+ )

38+

39+ NoComment name ->

40+ Report.simple "MISSING COMMENT"

41+ ("The value `" ++ name ++ "` does not have a documentation comment.")

42+ ( "Documentation comments start with {-| and end with -}. They should provide a\n"

43+ ++ "clear description of how they work, and ideally a small code example. This is\n"

44+ ++ "extremely valuable for users checking out your package!\n\n"

45+ ++ "If you think the docs are clearer without any words, you can use an empty\n"

46+ ++ "comment {-|-} which should be used sparingly. Maybe you have a section of 20\n"

47+ ++ "values all with the exact same type. The docs may read better if they are all\n"

48+ ++ "described in one place\n\n"

49+ ++ "Learn more at <http://package.elm-lang.org/help/documentation-format>"

50+ )

51+

52+ NoType name ->

53+ Report.simple "MISSING ANNOTATION"

54+ ("The value `" ++ name ++ "` does not have a type annotation.")

55+ ( "Adding type annotations is best practice and it gives you a chance to name\n"

56+ ++ "types and type variables so they are as easy as possible to understand!"

57+ )

src/Reporting/Result.hs+10

@@ -75,6 +75,16 @@ addDealiaser dealiaser (Result (_, warnings) rawResult) =

7575 Result (Just dealiaser, warnings) rawResult

7676

7777

78+destruct :: (e -> b) -> (a -> b) -> RawResult e a -> b

79+destruct errFunc okFunc rawResult =

80+ case rawResult of

81+ Ok answer ->

82+ okFunc answer

83+

84+ Err errors ->

85+ errFunc errors

86+

87+

7888-- EXTRA FANCY HELPERS

7989

8090instance M.Functor (Result w e) where

src/Type/Inference.hs+3−3

@@ -23,7 +23,7 @@ import System.IO.Unsafe

2323

2424infer

2525 :: Interfaces

26− -> CanonicalModule

26+ -> Module.CanonicalModule

2727 -> Except [A.Located Error.Error] (Map.Map String Type.Canonical)

2828infer interfaces modul =

2929 either throwError return $ unsafePerformIO $ runExceptT $

@@ -40,7 +40,7 @@ infer interfaces modul =

4040

4141genConstraints

4242 :: Interfaces

43− -> CanonicalModule

43+ -> Module.CanonicalModule

4444 -> IO (Env.TypeDict, T.TypeConstraint)

4545genConstraints interfaces modul =

4646 do env <-

@@ -77,7 +77,7 @@ canonicalizeValues env (moduleName, iface) =

7777 return (Module.nameToString moduleName ++ "." ++ name, tipe')

7878

7979

80−canonicalizeAdts :: Interfaces -> CanonicalModule -> [CanonicalAdt]

80+canonicalizeAdts :: Interfaces -> Module.CanonicalModule -> [CanonicalAdt]

8181canonicalizeAdts interfaces modul =

8282 localAdts ++ importedAdts

8383 where