d163289 · elk · git.iko.soy

src/AST/Module.hs+32−14

compare with master

unifiedsplit

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

1module AST.Module

2− ( Header(..), Module(..), Tag(..)

2+ ( Header(..), Module(..)

3

4− , Source, SourceInfo(..)

4+ , Source, SourceInfo(..), SourceTag(..), SourceSettings, emptySettings

5− , Valid, ValidInfo(..)

5+ , Valid, ValidInfo(..), ValidEffects(..)

6 , Canonical, Optimized, Info(..)

7

8 , UserImport, DefaultImport, ImportMethod(..)

@@ -38,10 +38,11 @@ import qualified Reporting.Region as R

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

39data Header imports =

40 Header

41− { _tag :: Tag

41+ { _tag :: SourceTag

42 , _name :: Name.Raw

43− , _docs :: A.Located (Maybe String)

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

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

44+ , _settings :: SourceSettings

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

45 , _imports :: imports

46 , _imports :: imports

46 }

47 }

47

48

@@ -52,32 +53,42 @@ data Header imports =

52

53

53data Module phase =

54data Module phase =

54 Module

55 Module

55− { tag :: Tag

56− , name :: Name.Canonical

56+ { name :: Name.Canonical

57 , path :: FilePath

58 , info :: phase

59 }

60

61

62−data Tag

63− = Normal

64− | Effect (Maybe (A.Located String)) (Maybe (A.Located String))

65− | Foreign R.Region

66−

67−

68type Source =

62type Source =

69 Module SourceInfo

63 Module SourceInfo

70

64

71

65

72data SourceInfo =

66data SourceInfo =

73 Source

67 Source

68+ { srcTag :: SourceTag

69+ , srcSettings :: SourceSettings

74− { srcDocs :: A.Located (Maybe String)

70+ , srcDocs :: A.Located (Maybe String)

75 , srcExports :: Var.Listing (A.Located Var.Value)

71 , srcExports :: Var.Listing (A.Located Var.Value)

76 , srcImports :: [UserImport]

72 , srcImports :: [UserImport]

77 , srcDecls :: [Decl.Source]

73 , srcDecls :: [Decl.Source]

78 }

74 }

79

75

80

76

77+data SourceTag

78+ = SrcNormal

79+ | SrcEffect

80+ | SrcForeign

81+

82+

83+type SourceSettings =

84+ A.Located [(A.Located String, A.Located String)]

85+

86+

87+emptySettings :: SourceSettings

88+emptySettings =

89+ A.A (error "region of empty settings should not be needed") []

90+

91+

81type Valid =

92type Valid =

82 Module ValidInfo

93 Module ValidInfo

83

94

@@ -88,9 +99,16 @@ data ValidInfo =

88 , validExports :: Var.Listing (A.Located Var.Value)

99 , validExports :: Var.Listing (A.Located Var.Value)

89 , validImports :: ([DefaultImport], [UserImport])

100 , validImports :: ([DefaultImport], [UserImport])

90 , validDecls :: [Decl.Valid]

101 , validDecls :: [Decl.Valid]

102+ , validEffects :: ValidEffects

91 }

103 }

92

104

93

105

106+data ValidEffects

107+ = ValidNormal

108+ | ValidEffect (Maybe (A.Located String)) (Maybe (A.Located String))

109+ | ValidForeign

110+

111+

94type Canonical =

112type Canonical =

95 Module (Info Canonical.Expr)

113 Module (Info Canonical.Expr)

96

114

src/Canonicalize.hs+1−1

@@ -46,7 +46,7 @@ module'

46 -> R.Result Warning.Warning Error.Error Module.Canonical

47module' canonicalImports interfaces modul =

48 let

49− (Module.Valid docs exports imports decls) =

49+ (Module.Valid docs exports imports decls effects) =

50 Module.info modul

51

52 importDict =

src/Canonicalize/Setup.hs+2−2

@@ -30,9 +30,9 @@ environment

30 -> Module.Interfaces

31 -> Module.Valid

32 -> Result.ResultErr Env.Environment

33−environment importDict interfaces (Module.Module _ name _ info) =

33+environment importDict interfaces (Module.Module name _ info) =

34 let

35− (Module.Valid _ _ (defaults, imports) decls) =

35+ (Module.Valid _ _ (defaults, imports) decls effects) =

36 info

37

38 allImports =

src/Elm/Compiler.hs+2−2

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

53 Result.Err msgs ->

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

55

56− Result.Ok (Module.Header _kind name _docs _exports imports) ->

56+ Result.Ok (Module.Header _ name _ _ _ imports) ->

57 Right

58 ( PublicModule.Name name

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

@@ -107,7 +107,7 @@ docsGen

107 :: Bool

108 -> Module.Optimized

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

110−docsGen isExposed (Module.Module _ name _ info) =

110+docsGen isExposed (Module.Module name _ info) =

111 if not isExposed then

112 Result.ok Nothing

113

src/Generate/JavaScript.hs+1−1

@@ -17,7 +17,7 @@ import qualified Generate.JavaScript.Variable as Var

17

18

19generate :: Module.Optimized -> String

20−generate (Module.Module _ (ModuleName.Canonical _ name) _ info) =

20+generate (Module.Module (ModuleName.Canonical _ name) _ info) =

21 let

22 body =

23 concat

src/Nitpick/PatternMatches.hs+1−1

@@ -27,7 +27,7 @@ patternMatches

27 :: Module.Interfaces

28 -> Module.Canonical

29 -> Result.Result w Error.Error DT.VariantDict

30−patternMatches interfaces (Module.Module _ name _ info) =

30+patternMatches interfaces (Module.Module name _ info) =

31 let

32 tagDict =

33 toTagDict interfaces name (Module.unions info)

src/Optimize.hs+2−2

@@ -24,7 +24,7 @@ import qualified Reporting.Region as R

24

25

26optimize :: DT.VariantDict -> Module.Canonical -> Module.Optimized

27−optimize variantDict module_@(Module.Module _ home _ info) =

27+optimize variantDict modul@(Module.Module home _ info) =

28 let

29 (defs, _) =

30 flattenLets [] (Module.program info)

@@ -35,7 +35,7 @@ optimize variantDict module_@(Module.Module _ home _ info) =

35 optInfo =

36 info { Module.program = optDefs }

37 in

38− module_ { Module.info = optInfo }

38+ modul { Module.info = optInfo }

39

40

41flattenLets :: [Can.Def] -> Can.Expr -> ([Can.Def], Can.Expr)

src/Parse/Module.hs+47−55

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

8import qualified AST.Module.Name as ModuleName

9import qualified AST.Variable as Var

10import qualified Reporting.Annotation as A

11−import qualified Reporting.Region as R

12

11

13

12

14getModuleName :: String -> Maybe String

13getModuleName :: String -> Maybe String

@@ -16,7 +15,7 @@ getModuleName source =

16 let

15 let

17 minimalParser =

16 minimalParser =

18 do optional freshLine

17 do optional freshLine

19− (_, names, _) <- moduleDecl

18+ (ModuleDecl _ names _ _) <- moduleDecl

20 return (ModuleName.toString names)

19 return (ModuleName.toString names)

21 in

20 in

22 case iParse minimalParser source of

21 case iParse minimalParser source of

@@ -30,9 +29,9 @@ getModuleName source =

30header :: IParser (Module.Header [Module.UserImport])

29header :: IParser (Module.Header [Module.UserImport])

31header =

30header =

32 do optional freshLine

31 do optional freshLine

33− (tag, names, exports) <-

32+ (ModuleDecl tag names exports settings) <-

34 option

33 option

35− (Module.Normal, ["Main"], Var.openListing)

34+ (ModuleDecl Module.SrcNormal ["Main"] Var.openListing Module.emptySettings)

36 (moduleDecl `followedBy` freshLine)

35 (moduleDecl `followedBy` freshLine)

37

36

38 docs <-

37 docs <-

@@ -43,70 +42,63 @@ header =

43

42

44 imports' <- imports

43 imports' <- imports

45

44

46− return (Module.Header tag names docs exports imports')

45+ return (Module.Header tag names exports settings docs imports')

47

46

48

47

48+data ModuleDecl =

49+ ModuleDecl

50+ { _tag :: Module.SourceTag

51+ , _name :: [String]

49−moduleDecl :: IParser (Module.Tag, [String], Var.Listing (A.Located Var.Value))

52+ , _exports :: Var.Listing (A.Located Var.Value)

53+ , _settings :: Module.SourceSettings

54+ }

55+

56+

57+moduleDecl :: IParser ModuleDecl

50moduleDecl =

58moduleDecl =

51 expecting "a module declaration" $

59 expecting "a module declaration" $

52 do

60 do

53− endParser <-

61+ tag <- parseTag

54− choice

55− [

56− do try (reserved "module")

57− return (return Module.Normal)

58− ,

59− do try (reserved "effect")

60− whitespace

61− reserved "module"

62− return parseEffects

63− ,

64− do start <- getMyPosition

65− reserved "foreign"

66− whitespace

67− reserved "effect"

68− whitespace

69− reserved "module"

70− end <- getMyPosition

71− return (return (Module.Foreign (R.Region start end)))

72− ]

73

62

74− whitespace

75− names <- dotSep1 capVar <?> "the name of this module"

63+ names <- padded (dotSep1 capVar) <?> "the name of this module"

76

64

77− padded (reserved "exposing")

65+ settings <- option Module.emptySettings parseSetting

78

66

79− exports <- listing (addLocation value)

67+ exports <- padded (listing (addLocation value))

80

68

81− tag <- endParser

69+ reserved "where"

82

70

83− return (tag, names, exports)

71+ return (ModuleDecl tag names exports settings)

84

72

85

73

86−parseEffects :: IParser Module.Tag

74+parseTag :: IParser Module.SourceTag

87−parseEffects =

75+parseTag =

88− do padded (reserved "where")

89− brackets $ choice $

76+ choice

90− [ do cmd <- entry "command"

77+ [

91− whitespace

78+ do try (reserved "module")

92− sub <- option Nothing (secondEntry "subscription")

93− return (Module.Effect cmd sub)

79+ return Module.SrcNormal

94− , do sub <- entry "subscription"

80+ ,

81+ do try (reserved "effect")

95− whitespace

82+ whitespace

96− cmd <- option Nothing (secondEntry "command")

83+ reserved "module"

97− return (Module.Effect cmd sub)

84+ return Module.SrcEffect

98− ]

85+ ,

99− where

86+ do reserved "foreign"

100− entry name =

87+ whitespace

101− do try (string name)

88+ reserved "effect"

102− padded equals

103− typeName <- addLocation capVar

104− return (Just typeName)

105−

106− secondEntry name =

107− do try comma

108 whitespace

89 whitespace

109− entry name

90+ reserved "module"

91+ return Module.SrcForeign

92+ ]

93+

94+

95+parseSetting :: IParser Module.SourceSettings

96+parseSetting =

97+ addLocation $ brackets $ commaSep $

98+ do name <- addLocation lowVar

99+ padded equals

100+ typeName <- addLocation capVar

101+ return (name, typeName)

110

102

111

103

112imports :: IParser [Module.UserImport]

104imports :: IParser [Module.UserImport]

src/Parse/Parse.hs+3−34

@@ -9,7 +9,6 @@ import qualified Text.Parsec.Error as Parsec

9import qualified AST.Declaration as Decl

10import qualified AST.Module as Module

11import qualified AST.Module.Name as ModuleName

12−import qualified Elm.Compiler.Imports as Imports

13import qualified Elm.Package as Package

12import qualified Elm.Package as Package

14import Parse.Helpers

13import Parse.Helpers

15import qualified Parse.Module as Parse (header)

14import qualified Parse.Module as Parse (header)

@@ -30,36 +29,7 @@ program pkgName table src =

30 do modul <-

29 do modul <-

31 parseWithTable table src (programParser pkgName)

30 parseWithTable table src (programParser pkgName)

32

31

33− let

34− (Module.Source docs exports imports sourceDecls) =

35− Module.info modul

36−

37− validDecls <-

38− Validate.declarations sourceDecls

39−

40− return $

41− modul

32+ Validate.module' modul

42− { Module.info =

43− Module.Valid

44− docs

45− exports

46− (addDefaults pkgName imports)

47− validDecls

48− }

49−

50−

51−-- determine if default imports should be added, only elm-lang/core is exempt

52−addDefaults

53− :: Package.Name

54− -> [Module.UserImport]

55− -> ([Module.DefaultImport], [Module.UserImport])

56−addDefaults pkgName imports =

57− flip (,) imports $

58− if pkgName == Package.coreName then

59− []

60−

61− else

62− Imports.defaults

63

33

64

34

65

35

@@ -68,7 +38,7 @@ addDefaults pkgName imports =

68

38

69programParser :: Package.Name -> IParser Module.Source

39programParser :: Package.Name -> IParser Module.Source

70programParser pkgName =

40programParser pkgName =

71− do (Module.Header tag name docs exports imports) <-

41+ do (Module.Header tag name exports settings docs imports) <-

72 Parse.header

42 Parse.header

73

43

74 decls <-

44 decls <-

@@ -80,10 +50,9 @@ programParser pkgName =

80

50

81 return $

51 return $

82 Module.Module

52 Module.Module

83− tag

84 (ModuleName.Canonical pkgName name)

53 (ModuleName.Canonical pkgName name)

85 ""

54 ""

86− (Module.Source docs exports imports decls)

55+ (Module.Source tag settings docs exports imports decls)

87

56

88

57

89declarations :: IParser [Decl.Source]

58declarations :: IParser [Decl.Source]

src/Reporting/Error/Syntax.hs+5

@@ -20,6 +20,11 @@ data Error

20 | CommentOnComment

21 | CommentOnNothing

22

23+ | SettingsOnNormalModule

24+ | SettingsOnForeignModule

25+ | DuplicateSettingOnEffectModule String

26+ | BadSettingOnEffectModule String

27+

23 | InfixDuplicate String

28 | InfixDuplicate String

24 | TypeWithoutDefinition String

29 | TypeWithoutDefinition String

25 | DuplicateFieldName String

30 | DuplicateFieldName String

src/Type/Inference.hs+1−1

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

81

82

83canonicalizeUnions :: Module.Interfaces -> Module.Canonical -> [Module.CanonicalUnion]

84−canonicalizeUnions interfaces (Module.Module _ name _ info) =

84+canonicalizeUnions interfaces (Module.Module name _ info) =

85 localUnions ++ importedUnions

86 where

87 localUnions :: [Module.CanonicalUnion]

src/Validate.hs+113−1

@@ -1,5 +1,5 @@

1{-# OPTIONS_GHC -Wall #-}

2−module Validate (declarations) where

2+module Validate (module') where

3

4import Control.Monad (foldM)

5import qualified Data.Map as Map

@@ -11,8 +11,12 @@ import AST.Expression.General as Expr

11import qualified AST.Expression.Source as Source

12import qualified AST.Expression.Valid as Valid

13import qualified AST.Declaration as D

14+import qualified AST.Module as Module

15+import qualified AST.Module.Name as ModuleName

14import qualified AST.Pattern as Pattern

16import qualified AST.Pattern as Pattern

15import qualified AST.Type as Type

17import qualified AST.Type as Type

18+import qualified Elm.Compiler.Imports as Imports

19+import qualified Elm.Package as Package

16import Elm.Utils ((|>))

20import Elm.Utils ((|>))

17import qualified Reporting.Annotation as A

21import qualified Reporting.Annotation as A

18import qualified Reporting.Error.Syntax as Error

22import qualified Reporting.Error.Syntax as Error

@@ -21,6 +25,114 @@ import qualified Reporting.Result as Result

21

25

22

26

23

27

28+-- MODULES

29+

30+

31+module' :: Module.Source -> Result.Result wrn Error.Error Module.Valid

32+module' (Module.Module name path info) =

33+ let

34+ (ModuleName.Canonical pkgName _) =

35+ name

36+

37+ (Module.Source tag settings docs exports imports decls) =

38+ info

39+ in

40+ do validEffects <- validateModuleDecl tag settings

41+ validDecls <- declarations decls

42+

43+ return $ Module.Module name path $

44+ Module.Valid docs exports (addDefaults pkgName imports) validDecls validEffects

45+

46+

47+-- determine if default imports should be added, only elm-lang/core is exempt

48+addDefaults

49+ :: Package.Name

50+ -> [Module.UserImport]

51+ -> ([Module.DefaultImport], [Module.UserImport])

52+addDefaults pkgName imports =

53+ flip (,) imports $

54+ if pkgName == Package.coreName then

55+ []

56+

57+ else

58+ Imports.defaults

59+

60+

61+validateModuleDecl

62+ :: Module.SourceTag

63+ -> Module.SourceSettings

64+ -> Result.Result wrn Error.Error Module.ValidEffects

65+validateModuleDecl tag settings =

66+ case tag of

67+ Module.SrcNormal ->

68+ do noSettings Error.SettingsOnNormalModule settings

69+ return Module.ValidNormal

70+

71+ Module.SrcForeign ->

72+ do noSettings Error.SettingsOnForeignModule settings

73+ return Module.ValidForeign

74+

75+ Module.SrcEffect ->

76+ gatherEffectSettings settings

77+

78+

79+noSettings

80+ :: Error.Error

81+ -> Module.SourceSettings

82+ -> Result.Result wrn Error.Error ()

83+noSettings errorMsg (A.A region settings) =

84+ case settings of

85+ [] ->

86+ Result.ok ()

87+

88+ _ : _ ->

89+ Result.throw region errorMsg

90+

91+

92+gatherEffectSettings

93+ :: Module.SourceSettings

94+ -> Result.Result wrn Error.Error Module.ValidEffects

95+gatherEffectSettings (A.A _ pairs) =

96+ uncurry Module.ValidEffect <$>

97+ gatherEffectSettingsHelp (Nothing, Nothing) pairs

98+

99+

100+type Effects =

101+ (Maybe (A.Located String), Maybe (A.Located String))

102+

103+

104+gatherEffectSettingsHelp

105+ :: Effects

106+ -> [(A.Located String, A.Located String)]

107+ -> Result.Result wrn Error.Error Effects

108+gatherEffectSettingsHelp effects@(maybeCmd, maybeSub) pairs =

109+ case pairs of

110+ [] ->

111+ Result.ok effects

112+

113+ (A.A region name, effect) : rest ->

114+ case name of

115+ "command" ->

116+ case maybeCmd of

117+ Nothing ->

118+ gatherEffectSettingsHelp (Just effect, maybeSub) rest

119+

120+ Just _ ->

121+ Result.throw region (Error.DuplicateSettingOnEffectModule name)

122+

123+ "subscription" ->

124+ case maybeSub of

125+ Nothing ->

126+ gatherEffectSettingsHelp (maybeCmd, Just effect) rest

127+

128+ Just _ ->

129+ Result.throw region (Error.DuplicateSettingOnEffectModule name)

130+

131+ _ ->

132+ Result.throw region (Error.BadSettingOnEffectModule name)

133+

134+

135+

24-- COLLAPSE COMMENTS

136-- COLLAPSE COMMENTS

25

137

26

138