1b0a3bf · elk · git.iko.soy

git.iko.soy/elk

Get Elm.Header working again

Also explicitly models whether the user puts a `module` declaration line or not.

commit1b0a3bfd490eafac7c4b66d06028c4caa22c98ff authorEvan Czaplicki <evancz@users.noreply.github.com> dateMon 11 Dec 2017, 15:07 (9 years ago) parent93f583a

5 files changed+124−78

compare with master

unifiedsplit

src/AST/Source.hs+11−23 src/AST/Valid.hs+23 src/Elm/Header.hs+64−35 src/Parse/Module.hs+18−17 src/Validate.hs+8−3

src/AST/Source.hs+11−23

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

11{-# OPTIONS_GHC -Wall #-}

2−{-# LANGUAGE OverloadedStrings #-}

32module AST.Source

43 ( Expr, Expr_(..)

54 , Decl, Decl_(..)

@@ -7,10 +6,10 @@ module AST.Source

76 , Pattern, Pattern_(..)

87 , Type, Type_(..)

98 , Module(..)

9+ , Header(..)

1010 , Import(..)

1111 , Effects(..)

1212 , Manager(..)

13− , defaultModule

1413 , Exposing(..)

1514 , Exposed(..)

1615 , Privacy(..)

@@ -130,14 +129,16 @@ data Decl_

130129

131130

132131data Module decls =

133− Module

134− { _name :: N.Name

135− , _effects :: Effects

136− , _docs :: A.Located (Maybe B.ByteString)

137− , _exports :: Exposing

138− , _imports :: [Import]

139− , _decls :: decls

140− }

132+ Module (Maybe Header) [Import] decls

133+

134+

135+data Header

136+ = Header

137+ { _name :: N.Name

138+ , _effects :: Effects

139+ , _exports :: Exposing

140+ , _docs :: A.Located (Maybe B.ByteString)

141+ }

141142

142143

143144data Import =

@@ -160,19 +161,6 @@ data Manager

160161 | Fx (A.Located N.Name) (A.Located N.Name)

161162

162163

163−defaultModule :: [Import] -> decls -> Module decls

164−defaultModule imports decls =

165− let zero = R.Position 1 1 in

166− Module

167− { _name = "Main"

168− , _effects = NoEffects

169− , _docs = A.at zero zero Nothing

170− , _exports = Open

171− , _imports = imports

172− , _decls = decls

173− }

174−

175−

176164

177165-- EXPOSING

178166

src/AST/Valid.hs+23

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

11{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

23module AST.Valid

34 ( Expr, Expr_(..)

45 , Def(..)

@@ -10,6 +11,7 @@ module AST.Valid

1011 , Effects(..)

1112 , Port(..)

1213 , Manager(..)

14+ , defaultModule

1315 )

1416 where

1517

@@ -104,3 +106,24 @@ data Manager

104106

105107

106108data Port = Port (A.Located N.Name) Src.Type

109+

110+

111+defaultModule :: Map.Map N.Name Text -> [Src.Import] -> [A.Located Decl] -> [Union] -> [Alias] -> [Binop] -> Module

112+defaultModule docs imports decls unions aliases binop =

113+ Module

114+ { _name = "Main"

115+ , _overview = A.At zero Nothing

116+ , _docs = docs

117+ , _exports = Src.Open

118+ , _imports = imports

119+ , _decls = decls

120+ , _unions = unions

121+ , _aliases = aliases

122+ , _binop = binop

123+ , _effects = NoEffects

124+ }

125+

126+

127+zero :: R.Region

128+zero =

129+ R.Region (R.Position 1 1) (R.Position 1 1)

src/Elm/Header.hs+64−35

@@ -6,15 +6,15 @@ module Elm.Header

66 where

9−import Data.Text (Text)

9+import qualified Data.ByteString as B

1010

11−import qualified AST.Module as Module

11+import qualified AST.Source as Src

1212import qualified Elm.Compiler.Imports as Imports

13−import qualified Elm.Compiler.Internals as I

1413import qualified Elm.Compiler.Module as M

15−import qualified Elm.Package as Package

16−import qualified Parse.Helpers as Parse (run)

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

14+import qualified Elm.Name as N

15+import qualified Elm.Package as Pkg

16+import qualified Parse.Primitives as Parser

17+import qualified Parse.Module as Module

1818import qualified Reporting.Annotation as A

1919import qualified Reporting.Error as Error

2020

@@ -30,34 +30,63 @@ data Tag = Normal | Effect | Port

3030-- PARSE

3131

3232

33−parse :: Package.Name -> Text -> Either I.Error (Maybe (Tag, M.Raw), [M.Raw])

34−parse pkgName sourceCode =

35− case Parse.run Parse.header sourceCode of

36− Right header ->

37− Right $ toSummary pkgName header

33+parse :: Pkg.Name -> B.ByteString -> Either Error.Error (Maybe (Tag, M.Raw), [M.Raw])

34+parse pkg sourceCode =

35+ case Parser.run chompHeader sourceCode of

36+ Right (Src.Module header imports _) ->

37+ Right

38+ ( fmap simplifyHeader header

39+ , toDeps pkg imports

40+ )

3841

3942 Left err ->

40− Left (I.Error (A.map Error.Syntax err))

41−

42−

43−toSummary :: Package.Name -> Module.Header [Module.UserImport] -> (Maybe (Tag, M.Raw), [M.Raw])

44−toSummary pkgName (Module.Header maybeHeaderDecl imports) =

45− let

46− dependencies =

47− if pkgName == Package.core

48− then map (A.drop . fst . A.drop) imports

49− else map (A.drop . fst . A.drop) imports ++ map fst Imports.defaults

50− in

51− case maybeHeaderDecl of

52− Nothing ->

53− ( Nothing, dependencies )

54−

55− Just (Module.HeaderDecl sourceTag name _ _ _) ->

56− let

57− tag =

58− case sourceTag of

59− Module.Normal -> Normal

60− Module.Port _ -> Port

61− Module.Effect _ -> Effect

62− in

63− ( Just (tag, name), dependencies )

43+ Left (Error.Syntax err)

44+

45+

46+chompHeader :: Parser.Parser (Src.Module ())

47+chompHeader =

48+ Module.module_ $ return ()

49+

50+

51+

52+-- TO DEPS

53+

54+

55+toDeps :: Pkg.Name -> [Src.Import] -> [N.Name]

56+toDeps pkg imports =

57+ if pkg == Pkg.core

58+ then map getName imports

59+ else map getName imports ++ defaultImports

60+

61+

62+getName :: Src.Import -> N.Name

63+getName (Src.Import (A.At _ name) _ _) =

64+ name

65+

66+

67+{-# NOINLINE defaultImports #-}

68+defaultImports :: [N.Name]

69+defaultImports =

70+ map Imports._name Imports.defaults

71+

72+

73+

74+-- TO HEADER

75+

76+

77+simplifyHeader :: Src.Header -> (Tag, N.Name)

78+simplifyHeader (Src.Header name effects _ _) =

79+ ( toTag effects, name )

80+

81+

82+toTag :: Src.Effects -> Tag

83+toTag effects =

84+ case effects of

85+ Src.NoEffects ->

86+ Normal

87+

88+ Src.Ports _ ->

89+ Port

90+

91+ Src.Manager _ _ ->

92+ Effect

src/Parse/Module.hs+18−17

@@ -25,28 +25,29 @@ import qualified Reporting.Region as R

2525

2626

2727

28−-- HEADER

28+-- MODULE

2929

3030

3131module_ :: Parser decls -> Parser (Src.Module decls)

3232module_ chompDecls =

3333 do freshLine

34− oneOf

35− [ do start <- P.getPosition

36− P.pushContext start E.Module

37− (name, effects) <- chompNameAndEffects

38− P.hint E.Exposing $ Keyword.exposing_

39− P.spaces

40− exports <- exposing

41− P.popContext ()

42− docs <- maybeDocComment

43− imports <- chompImports []

44− decls <- chompDecls

45− return (Src.Module name effects docs exports imports decls)

46− , Src.defaultModule

47− <$> chompImports []

48− <*> chompDecls

49− ]

34+ header <- oneOf [ Just <$> chompHeader, return Nothing ]

35+ imports <- chompImports []

36+ decls <- chompDecls

37+ return (Src.Module header imports decls)

38+

39+

40+chompHeader :: Parser Src.Header

41+chompHeader =

42+ do start <- P.getPosition

43+ P.pushContext start E.Module

44+ (name, effects) <- chompNameAndEffects

45+ P.hint E.Exposing $ Keyword.exposing_

46+ P.spaces

47+ exports <- exposing

48+ P.popContext ()

49+ docs <- maybeDocComment

50+ return (Src.Header name effects exports docs)

5051

5152

5253

src/Validate.hs+8−3

@@ -29,10 +29,15 @@ type Result i w a =

2929

3030

3131validate :: Src.Module [Src.Decl] -> Result i w Valid.Module

32−validate (Src.Module name srcEffects overview exports imports srcDecls) =

32+validate (Src.Module header imports srcDecls) =

3333 do (Stuff decls unions aliases binops ports docs) <- validateDecls srcDecls

34− effects <- validateEffects srcEffects ports

35− return $ Valid.Module name overview docs exports imports decls unions aliases binops effects

34+ case header of

35+ Nothing ->

36+ return $ Valid.defaultModule docs imports decls unions aliases binops

37+

38+ Just (Src.Header name srcEffects exports overview) ->

39+ do effects <- validateEffects srcEffects ports

40+ return $ Valid.Module name overview docs exports imports decls unions aliases binops effects

3641

3742

3843