cb6a361 · elk · git.iko.soy

elm-compiler.cabal+4

compare with master

unifiedsplit

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

67 Canonicalize.Type,

68 Canonicalize.Variable,

69 Compile,

70+ Docs.AST,

71+ Docs.Centralize,

72+ Docs.Check,

70 Elm.Compiler.Imports,

73 Elm.Compiler.Imports,

71 Elm.Compiler.Type.Extract,

74 Elm.Compiler.Type.Extract,

72 Elm.Compiler.Version,

75 Elm.Compiler.Version,

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

89 Reporting.Annotation,

92 Reporting.Annotation,

90 Reporting.Error,

93 Reporting.Error,

91 Reporting.Error.Canonicalize,

94 Reporting.Error.Canonicalize,

95+ Reporting.Error.Docs,

92 Reporting.Error.Syntax,

96 Reporting.Error.Syntax,

93 Reporting.Error.Type,

97 Reporting.Error.Type,

94 Reporting.PrettyPrint,

98 Reporting.PrettyPrint,

src/AST/Declaration.hs+1−1

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

51

52

53type CanonicalDecl =

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

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

55

56

57-- PORTS

src/AST/Module.hs+10−2

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

19import qualified AST.Expression.Canonical as Canonical

20import qualified AST.Type as Type

21import qualified AST.Variable as Var

22+import qualified Docs.AST as Docs

22import qualified Elm.Compiler.Version as Compiler

23import qualified Elm.Compiler.Version as Compiler

23import qualified Reporting.Annotation as A

24import qualified Reporting.Annotation as A

24

25

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

39

40

40type SourceModule =

41type SourceModule =

41 Module

42 Module

43+ String

42 [UserImport]

44 [UserImport]

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

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

44 [Decl.SourceDecl]

46 [Decl.SourceDecl]

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

46

48

47type ValidModule =

49type ValidModule =

48 Module

50 Module

51+ String

49 ([DefaultImport], [UserImport])

52 ([DefaultImport], [UserImport])

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

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

51 [Decl.ValidDecl]

54 [Decl.ValidDecl]

52

55

53

56

54type CanonicalModule =

57type CanonicalModule =

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

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

56

59

57

60

58−data Module imports exports body = Module

61+data Module docs imports exports body = Module

59 { names :: Name

62 { names :: Name

60 , path :: FilePath

63 , path :: FilePath

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

61 , exports :: exports

65 , exports :: exports

62 , imports :: imports

66 , imports :: imports

63 , body :: body

67 , body :: body

64 }

68 }

65

69

70+

66data CanonicalBody = CanonicalBody

71data CanonicalBody = CanonicalBody

67 { program :: Canonical.Expr

72 { program :: Canonical.Expr

68 , types :: Types

73 , types :: Types

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

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

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

79data Header imports = Header

84data Header imports = Header

80 { _names :: Name

85 { _names :: Name

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

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

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

82 , _imports :: imports

88 , _imports :: imports

83 }

89 }

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

126 , iPorts :: [String]

132 , iPorts :: [String]

127 }

133 }

128

134

135+

129toInterface :: CanonicalModule -> Interface

136toInterface :: CanonicalModule -> Interface

130toInterface modul =

137toInterface modul =

131 let body' = body modul in

138 let body' = body modul in

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

140 , iPorts = ports body'

147 , iPorts = ports body'

141 }

148 }

142

149

150+

143instance Binary Interface where

151instance Binary Interface where

144 get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get

152 get = Interface <$> get <*> get <*> get <*> get <*> get <*> get <*> get <*> get

145 put modul = do

153 put modul = do

src/Canonicalize.hs+12−7

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

18import qualified AST.Pattern as P

19import qualified AST.Type as Type

20import qualified AST.Variable as Var

21+import qualified Docs.AST as Docs

22+import qualified Docs.Centralize as Docs

21import qualified Reporting.Annotation as A

23import qualified Reporting.Annotation as A

22import qualified Reporting.Error as Error

24import qualified Reporting.Error as Error

23import qualified Reporting.Error.Canonicalize as CError

25import qualified Reporting.Error.Canonicalize as CError

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

40 -> Module.ValidModule

42 -> Module.ValidModule

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

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

42module' interfaces modul =

44module' interfaces modul =

45+ let

43− let (Result.Result uses rawResults) =

46+ (Result.Result uses rawResults) =

44− moduleHelp interfaces modul

47+ moduleHelp interfaces modul

45 in

48 in

46 case rawResults of

49 case rawResults of

47 Result.Ok (env, almostCanonicalModule) ->

50 Result.Ok (env, almostCanonicalModule) ->

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

54

57

55type AlmostCanonicalModule =

58type AlmostCanonicalModule =

56 Module.Module

59 Module.Module

60+ Docs.Centralized

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

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

58 [Var.Value]

62 [Var.Value]

59 Module.CanonicalBody

63 Module.CanonicalBody

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

63 :: Module.Interfaces

67 :: Module.Interfaces

64 -> Module.ValidModule

68 -> Module.ValidModule

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

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

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

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

67 canonicalModule

71 canonicalModule

68 <$> canonicalDeclsResult

72 <$> canonicalDeclsResult

69 <*> resolveExports locals exports

73 <*> resolveExports locals exports

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

71 canonicalModule (env, canonicalDecls) canonicalExports =

75 canonicalModule (env, canonicalDecls) canonicalExports =

72 (,) env $

76 (,) env $

73 modul

77 modul

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

74− { Module.exports = canonicalExports

79+ , Module.exports = canonicalExports

75 , Module.body = body canonicalDecls

80 , Module.body = body canonicalDecls

76 }

81 }

77

82

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

116 :: Set.Set Module.Name

121 :: Set.Set Module.Name

117 -> AlmostCanonicalModule

122 -> AlmostCanonicalModule

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

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

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

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

120 do reducedImports <-

125 do reducedImports <-

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

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

122

127

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

262 :: Env.Environment

267 :: Env.Environment

263 -> D.ValidDecl

268 -> D.ValidDecl

264 -> Result.ResultErr D.CanonicalDecl

269 -> Result.ResultErr D.CanonicalDecl

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

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

266− A.A region <$>

271+ A.A ann <$>

267 case decl of

272 case decl of

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

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

269 D.Definition <$> (

274 D.Definition <$> (

src/Canonicalize/Declaration.hs+1−1

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

18

19

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

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

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

22 let typeVar = Var.fromModule moduleName

23

24 loc expr =

src/Canonicalize/Setup.hs+1−1

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

27 :: Module.Interfaces

28 -> Module.ValidModule

29 -> Result.ResultErr Env.Environment

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

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

31 let moduleName =

32 Module.names modul

33

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 @@

1{-# OPTIONS_GHC -Wall #-}

2module Elm.Compiler

3 ( version, rawVersion

4− , parseDependencies, compile

4+ , parseDependencies

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

5 , Dealiaser, dummyDealiaser

6 , Dealiaser, dummyDealiaser

6 , Error, errorToString, errorToJson, printError

7 , Error, errorToString, errorToJson, printError

7 , Warning, warningToString, warningToJson, printWarning

8 , Warning, warningToString, warningToJson, printWarning

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

12

13

13import qualified AST.Module as Module

14import qualified AST.Module as Module

14import qualified Compile

15import qualified Compile

16+import qualified Docs.Check as Docs

15import qualified Elm.Compiler.Module as PublicModule

17import qualified Elm.Compiler.Module as PublicModule

16import qualified Elm.Compiler.Version as Version

18import qualified Elm.Compiler.Version as Version

19+import qualified Elm.Docs as Docs

17import qualified Generate.JavaScript as JS

20import qualified Generate.JavaScript as JS

18import qualified Parse.Module as Parse

21import qualified Parse.Module as Parse

19import qualified Parse.Parse as Parse

22import qualified Parse.Parse as Parse

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

50 Result.Err msgs ->

53 Result.Err msgs ->

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

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

52

55

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

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

54 Right

57 Right

55 ( PublicModule.Name names

58 ( PublicModule.Name names

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

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

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

61

64

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

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

63compile

66compile

64− :: String

67+ :: Context

65− -> String

66− -> Bool

67 -> String

68 -> String

68 -> Map.Map PublicModule.Name PublicModule.Interface

69 -> Map.Map PublicModule.Name PublicModule.Interface

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

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

70−compile user packageName isRoot source interfaces =

71− let unwrappedInterfaces =

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

73

71

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

72+compile context source interfaces =

73+ let

74+ (Context user packageName isRoot isExposed) =

75+ context

76+

75− Compile.compile user packageName isRoot unwrappedInterfaces source

77+ unwrappedInterfaces =

76− in

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

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

78− case rawResult of

79− Result.Ok modul ->

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

81

79

82− Result.Err 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

83− Left (map Error errors)

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

84

122

85

123

86-- DEALIASER

124-- DEALIASER

src/Elm/Docs.hs+27−1

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

7import qualified Data.Aeson as Json

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

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

10+import qualified Data.Map as Map

10

11

12+import qualified Docs.AST as Docs

11import qualified Elm.Compiler.Module as Module

13import qualified Elm.Compiler.Module as Module

12import qualified Elm.Compiler.Type as Type

14import qualified Elm.Compiler.Type as Type

15+import qualified Reporting.Annotation as A

13

16

14

17

15data Documentation = Documentation

18data Documentation = Documentation

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

41 { valueName :: String

44 { valueName :: String

42 , valueComment :: String

45 , valueComment :: String

43 , valueType :: Type.Type

46 , valueType :: Type.Type

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

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

45 }

48 }

46

49

47

50

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+

48-- PRETTY JSON

74-- PRETTY JSON

49

75

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

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

src/Generate/JavaScript.hs+1−1

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

344 _ -> (defs, lexpr)

345

346

347−generate :: CanonicalModule -> String

347+generate :: Module.CanonicalModule -> String

348generate modul =

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

350 [ 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 )

6

7import qualified AST.Declaration as D

8import qualified Parse.Expression as Expr

9−import Parse.Helpers

9+import Parse.Helpers as Help

10import qualified Parse.Type as Type

11

12

13declaration :: IParser D.SourceDecl

14declaration =

15 choice

16− [ D.Comment <$> docComment

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

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

18 ]

19

src/Parse/Helpers.hs+2−2

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

1module Parse.Helpers where

2

3import Prelude hiding (until)

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

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

5import Control.Monad (guard, join)

6import Control.Monad.State (State)

7import Data.Char (isUpper)

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

390

391multiComment :: IParser String

392multiComment =

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

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

394

395

396closeComment :: IParser String

src/Parse/Module.hs+6−1

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

26 do optional freshLine

27 (names, exports) <-

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

29+ docs <-

30+ choice

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

32+ , addLocation (return Nothing)

33+ ]

29 imports' <- imports

34 imports' <- imports

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

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

31

36

32

37

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

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

src/Parse/Parse.hs+4−4

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

26 -> String

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

28program needsDefaults isRoot table src =

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

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

30 parseWithTable table src programParser

31

32 validDecls <- Validate.declarations isRoot sourceDecls

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

34 let ammendedImports =

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

36

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

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

38

39

40-- HEADERS AND DECLARATIONS

41

42programParser :: IParser M.SourceModule

43programParser =

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

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

45 decls <- declarations

46 optional freshLine

47 optional spaces

48 eof

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

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

50

51

52declarations :: IParser [D.SourceDecl]

src/Reporting/Error.hs+8

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

8

9import qualified Reporting.Annotation as A

10import qualified Reporting.Error.Canonicalize as Canonicalize

11+import qualified Reporting.Error.Docs as Docs

11import qualified Reporting.Error.Syntax as Syntax

12import qualified Reporting.Error.Syntax as Syntax

12import qualified Reporting.Error.Type as Type

13import qualified Reporting.Error.Type as Type

13import qualified Reporting.PrettyPrint as P

14import qualified Reporting.PrettyPrint as P

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

20 = Syntax Syntax.Error

21 = Syntax Syntax.Error

21 | Canonicalize Canonicalize.Error

22 | Canonicalize Canonicalize.Error

22 | Type Type.Error

23 | Type Type.Error

24+ | Docs Docs.Error

23

25

24

26

25-- TO REPORT

27-- TO REPORT

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

36 Type typeError ->

38 Type typeError ->

37 Type.toReport dealiaser typeError

39 Type.toReport dealiaser typeError

38

40

41+ Docs docsError ->

42+ Docs.toReport docsError

43+

39

44

40-- TO STRING

45-- TO STRING

41

46

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

70

75

71 Type typeError ->

76 Type typeError ->

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

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

78+

79+ Docs docsError ->

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

73 in

81 in

74 Json.object $

82 Json.object $

75 [ "file" .= filePath

83 [ "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) =

75 Result (Just dealiaser, warnings) rawResult

76

77

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+

78-- EXTRA FANCY HELPERS

88-- EXTRA FANCY HELPERS

79

89

80instance M.Functor (Result w e) where

90instance M.Functor (Result w e) where

src/Type/Inference.hs+3−3

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

23

24infer

25 :: Interfaces

26− -> CanonicalModule

26+ -> Module.CanonicalModule

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

28infer interfaces modul =

29 either throwError return $ unsafePerformIO $ runExceptT $

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

40

41genConstraints

42 :: Interfaces

43− -> CanonicalModule

43+ -> Module.CanonicalModule

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

45genConstraints interfaces modul =

46 do env <-

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

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

78

79

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

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

81canonicalizeAdts interfaces modul =

82 localAdts ++ importedAdts

83 where