7bb1738 · elk · git.iko.soy

src/AST/Module.hs+16−10

compare with master

unifiedsplit

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

1{-# OPTIONS_GHC -Wall #-}

2{-# LANGUAGE OverloadedStrings #-}

3module AST.Module

4− ( Header(..), defaultHeader, Module(..)

4+ ( Header(..), HeaderDecl(..), defaultHeaderDecl

5+ , Module(..)

5

6

6 , Source, SourceInfo(..), SourceTag(..), SourceSettings, emptySettings

7 , Source, SourceInfo(..), SourceTag(..), SourceSettings, emptySettings

7 , Valid, ValidInfo(..)

8 , Valid, ValidInfo(..)

@@ -40,23 +41,28 @@ import qualified Reporting.Region as R

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

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

41data Header imports =

42data Header imports =

42 Header

43 Header

44+ { _decl :: Maybe HeaderDecl

45+ , _imports :: imports

46+ }

47+

48+

49+data HeaderDecl =

50+ HeaderDecl

43 { _tag :: SourceTag

51 { _tag :: SourceTag

44 , _name :: Name.Raw

52 , _name :: Name.Raw

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

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

46 , _settings :: SourceSettings

54 , _settings :: SourceSettings

47 , _docs :: A.Located (Maybe Text)

55 , _docs :: A.Located (Maybe Text)

48− , _imports :: imports

49 }

56 }

50

57

51

58

52−instance Show (Header a) where

59+defaultHeaderDecl :: HeaderDecl

53− show header =

60+defaultHeaderDecl =

54− show (_name header)

61+ let

55−

62+ zero = R.Position 1 1

56−

63+ noDocs = A.at zero zero Nothing

57−defaultHeader :: R.Position -> R.Position -> imports -> Header imports

64+ in

58−defaultHeader start end imports_ =

59− Header Normal "Main" Var.openListing emptySettings (A.at start end Nothing) imports_

65+ HeaderDecl Normal "Main" Var.openListing emptySettings noDocs

60

66

61

67

62

68

src/Elm/Compiler.hs+20−15

@@ -55,7 +55,7 @@ data Tag

55 | Port

56

57

58−parseDependencies :: Package.Name -> Text -> Either Error (Tag, M.Raw, [M.Raw])

58+parseDependencies :: Package.Name -> Text -> Either Error (Tag, Maybe M.Raw, [M.Raw])

59parseDependencies pkgName sourceCode =

60 case Parse.run Parse.header sourceCode of

61 Right header ->

@@ -65,22 +65,27 @@ parseDependencies pkgName sourceCode =

65 Left (Error (A.map Error.Syntax err))

66

67

68−getDeps :: Package.Name -> Module.Header [Module.UserImport] -> (Tag, M.Raw, [M.Raw])

68+getDeps :: Package.Name -> Module.Header [Module.UserImport] -> (Tag, Maybe M.Raw, [M.Raw])

69−getDeps pkgName (Module.Header sourceTag name _ _ _ imports) =

69+getDeps pkgName (Module.Header maybeHeaderDecl imports) =

70 let

71− tag =

71+ dependencies =

72− case sourceTag of

73− Module.Normal -> Normal

74− Module.Port _ -> Port

75− Module.Effect _ -> Effect

76−

77− deps =

78− if pkgName == Package.core then

72+ if pkgName == Package.core

79− map (fst . A.drop) imports

73+ then map (fst . A.drop) imports

80− else

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

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

82 in

75 in

76+ case maybeHeaderDecl of

77+ Nothing ->

78+ ( Normal, Nothing, dependencies )

79+

80+ Just (Module.HeaderDecl sourceTag name _ _ _) ->

81+ let

82+ tag =

83+ case sourceTag of

84+ Module.Normal -> Normal

85+ Module.Port _ -> Port

86+ Module.Effect _ -> Effect

87+ in

83− ( tag, name, deps )

88+ ( tag, Just name, dependencies )

84

89

85

90

86

91

src/Parse/Module.hs+16−13

@@ -18,22 +18,26 @@ import qualified Reporting.Region as R

18

19header :: Parser (Module.Header [Module.UserImport])

20header =

21− do start <- getPosition

22− freshLine

21+ do freshLine

23− end <- getPosition

24− oneOf

25− [ fullHeader end

26− , Module.defaultHeader start end <$> chompImports []

22+ Module.Header <$> maybeHeaderDecl <*> chompImports []

27− ]

28

23

29

24

30

25

31−-- FULL HEADER

26+-- HEADER DECL

32

27

33

28

34−fullHeader :: R.Position -> Parser (Module.Header [Module.UserImport])

29+maybeHeaderDecl :: Parser (Maybe Module.HeaderDecl)

35−fullHeader start =

30+maybeHeaderDecl =

31+ oneOf

32+ [ Just <$> headerDecl

33+ , return Nothing

34+ ]

35+

36+

37+headerDecl :: Parser Module.HeaderDecl

38+headerDecl =

39+ do start <- getPosition

36− do pushContext start E.Module

40+ pushContext start E.Module

37 tag <- sourceTag

41 tag <- sourceTag

38 spaces

42 spaces

39 name <- qualifiedCapVar

43 name <- qualifiedCapVar

@@ -44,8 +48,7 @@ fullHeader start =

44 exports <- listing (addLocation listingValue)

48 exports <- listing (addLocation listingValue)

45 popContext ()

49 popContext ()

46 docs <- maybeDocComment

50 docs <- maybeDocComment

47− imports <- chompImports []

48− return (Module.Header tag name exports settings docs imports)

51+ return (Module.HeaderDecl tag name exports settings docs)

49

52

50

53

51

54

src/Parse/Parse.hs+5−1

@@ -32,9 +32,13 @@ program pkgName src =

32

33chompProgram :: Package.Name -> Parser Module.Source

34chompProgram pkgName =

35− do (Module.Header tag name exports settings docs imports) <- Parse.header

35+ do (Module.Header maybeHeaderDecl imports) <- Parse.header

36 decls <- chompDeclarations []

37 endOfFile

38+

39+ let (Module.HeaderDecl tag name exports settings docs) =

40+ maybe Module.defaultHeaderDecl id maybeHeaderDecl

41+

38 let moduleName = ModuleName.Canonical pkgName name

42 let moduleName = ModuleName.Canonical pkgName name

39 let source = Module.Source tag settings docs exports imports decls

43 let source = Module.Source tag settings docs exports imports decls

40 return (Module.Module moduleName source)

44 return (Module.Module moduleName source)