fa03159 · elk · git.iko.soy

git.iko.soy/elk

Account for client and server kernel code

commitfa031590a204a5a58f9f37ce05a0088faf6b5b19 authorEvan Czaplicki <evancz@users.noreply.github.com> dateFri 6 Oct 2017, 14:25 (9 years ago) parent6397e12

10 files changed+223−124

compare with master

unifiedsplit

elm-compiler.cabal+3 src/AST/Kernel.hs+31−7 src/Elm/Compiler.hs+16−88 src/Elm/Compiler/Internals.hs+20 src/Elm/Compiler/Objects.hs+3−2 src/Elm/Compiler/Objects/Internal.hs+1−1 src/Elm/Header.hs+63 src/Elm/Kernel.hs+31 src/Generate/JavaScript.hs+53−24 src/Parse/Kernel.hs+2−2

elm-compiler.cabal+3

@@ -53,6 +53,8 @@ Library

5353 Elm.Compiler.Objects,

5454 Elm.Compiler.Type,

5555 Elm.Docs,

56+ Elm.Kernel,

57+ Elm.Header,

5658 Elm.Package,

5759 Elm.Utils,

5860 Json.Decode,

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

8789 Docs.Centralize,

8890 Docs.Check,

8991 Elm.Compiler.Imports,

92+ Elm.Compiler.Internals,

9093 Elm.Compiler.Objects.Internal,

9194 Elm.Compiler.Type.Extract,

9295 Elm.Compiler.Version,

src/AST/Kernel.hs+31−7

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

11{-# OPTIONS_GHC -Wall #-}

22module AST.Kernel

3− ( Info(..)

3+ ( Data(..)

4+ , Content(..)

45 , Chunk(..)

56 )

67 where

@@ -15,16 +16,31 @@ import qualified AST.Module.Name as ModuleName

1516

1617

1718

18−-- INFO

19+-- DATA

1920

2021

21−data Info =

22− Info

22+data Data =

23+ Data

24+ { _client :: Content

25+ , _server :: Maybe Content

26+ }

27+

28+

29+

30+-- CONTENT

31+

32+

33+data Content =

34+ Content

2335 { _imports :: [(ModuleName.Raw, Text.Text)]

2436 , _chunks :: [Chunk]

2537 }

2638

2739

40+

41+-- CHUNKS

42+

43+

2844data Chunk

2945 = JS BS.ByteString

3046 | Var ModuleName.Raw Text.Text

@@ -37,12 +53,20 @@ data Chunk

3753-- BINARY

3854

3955

40−instance Binary Info where

41− put (Info imports chunks) =

56+instance Binary Data where

57+ put (Data client server) =

58+ put client >> put server

59+

60+ get =

61+ liftM2 Data get get

62+

63+

64+instance Binary Content where

65+ put (Content imports chunks) =

4266 put imports >> put chunks

4367

4468 get =

45− liftM2 Info get get

69+ liftM2 Content get get

4670

4771

4872instance Binary Chunk where

src/Elm/Compiler.hs+16−88

@@ -2,12 +2,10 @@

22module Elm.Compiler

33 ( version

44 , compile, Context(..), Result(..)

5− , generate

5+ , generate, JS.Target(..)

66 , Localizer, dummyLocalizer

7− , Error, errorToDoc, errorToJson

8− , Warning, warningToDoc, warningToJson

9− , Tag(..), parseHeader

10− , KernelInfo(..), parseKernel

7+ , I.Error, errorToDoc, errorToJson

8+ , I.Warning, warningToDoc, warningToJson

119 )

1210 where

1311

@@ -17,21 +15,17 @@ import Data.Text (Text)

1715import qualified Data.ByteString.Builder as BS

1816import Text.PrettyPrint.ANSI.Leijen (Doc)

1917

20−import qualified AST.Kernel as Kernel (Info)

2118import qualified AST.Module as Module

2219import qualified AST.Module.Name as ModuleName

2320import qualified Compile

2421import qualified Docs.Check as Docs

25−import qualified Elm.Compiler.Imports as Imports

22+import qualified Elm.Compiler.Internals as I

2623import qualified Elm.Compiler.Module as M

2724import qualified Elm.Compiler.Objects.Internal as Obj

2825import qualified Elm.Compiler.Version

2926import qualified Elm.Docs as Docs

3027import qualified Elm.Package as Package

3128import qualified Generate.JavaScript as JS

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

33−import qualified Parse.Kernel as Kernel (parser)

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

3529import qualified Reporting.Annotation as A

3630import qualified Reporting.Bag as Bag

3731import qualified Reporting.Error as Error

@@ -55,7 +49,7 @@ version =

5549

5650

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

58−compile :: Context -> Text -> (Localizer, [Warning], Either [Error] Result)

52+compile :: Context -> Text -> (Localizer, [I.Warning], Either [I.Error] Result)

5953compile (Context packageName exposed importDict interfaces) source =

6054 let

6155 (Result.Result oneLocalizer warnings answer) =

@@ -68,8 +62,8 @@ compile (Context packageName exposed importDict interfaces) source =

6862 return (Result docs iface objs)

6963 in

7064 ( Result.oneToValue dummyLocalizer Localizer oneLocalizer

71− , Bag.toList Warning warnings

72− , Result.answerToEither Error id answer

65+ , Bag.toList I.Warning warnings

66+ , Result.answerToEither I.Error id answer

7367 )

7468

7569

@@ -111,7 +105,7 @@ docsGen isExposed (Module.Module name info) =

111105-- CODE GENERATION

112106

113107

114−generate :: Bool -> Obj.Graph -> Obj.Roots -> BS.Builder

108+generate :: Bool -> JS.Target -> Obj.Graph -> Obj.Roots -> BS.Builder

115109generate =

116110 JS.generate

117111

@@ -133,17 +127,13 @@ dummyLocalizer =

133127-- ERRORS

134128

135129

136−newtype Error =

137− Error (A.Located Error.Error)

138−

139−

140−errorToDoc :: Localizer -> String -> Text -> Error -> Doc

141−errorToDoc (Localizer localizer) location source (Error (A.A region err)) =

130+errorToDoc :: Localizer -> String -> Text -> I.Error -> Doc

131+errorToDoc (Localizer localizer) location source (I.Error (A.A region err)) =

142132 Report.toDoc location region (Error.toReport localizer err) source

143133

144134

145−errorToJson :: Localizer -> String -> Error -> Json.Value

146−errorToJson (Localizer localizer) location (Error err) =

135+errorToJson :: Localizer -> String -> I.Error -> Json.Value

136+errorToJson (Localizer localizer) location (I.Error err) =

147137 Error.toJson localizer location err

148138

149139

@@ -151,73 +141,11 @@ errorToJson (Localizer localizer) location (Error err) =

151141-- WARNINGS

152142

153143

154−newtype Warning =

155− Warning (A.Located Warning.Warning)

156−

157−

158−warningToDoc :: Localizer -> String -> Text -> Warning -> Doc

159−warningToDoc (Localizer localizer) location source (Warning (A.A region wrn)) =

144+warningToDoc :: Localizer -> String -> Text -> I.Warning -> Doc

145+warningToDoc (Localizer localizer) location source (I.Warning (A.A region wrn)) =

160146 Report.toDoc location region (Warning.toReport localizer wrn) source

161147

162148

163−warningToJson :: Localizer -> String -> Warning -> Json.Value

164−warningToJson (Localizer localizer) location (Warning wrn) =

149+warningToJson :: Localizer -> String -> I.Warning -> Json.Value

150+warningToJson (Localizer localizer) location (I.Warning wrn) =

165151 Warning.toJson localizer location wrn

166−

167−

168−

169−-- PARSE HEADER

170−

171−

172−data Tag = Normal | Effect | Port

173−

174−

175−parseHeader :: Package.Name -> Text -> Either Error (Maybe (Tag, M.Raw), [M.Raw])

176−parseHeader pkgName sourceCode =

177− case Parse.run Parse.header sourceCode of

178− Right header ->

179− Right $ toHeaderSummary pkgName header

180−

181− Left err ->

182− Left (Error (A.map Error.Syntax err))

183−

184−

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

186−toHeaderSummary pkgName (Module.Header maybeHeaderDecl imports) =

187− let

188− dependencies =

189− if pkgName == Package.core

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

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

192− in

193− case maybeHeaderDecl of

194− Nothing ->

195− ( Nothing, dependencies )

196−

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

198− let

199− tag =

200− case sourceTag of

201− Module.Normal -> Normal

202− Module.Port _ -> Port

203− Module.Effect _ -> Effect

204− in

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

206−

207−

208−

209−-- PARSE KERNEL

210−

211−

212−newtype KernelInfo =

213− KernelInfo Kernel.Info

214−

215−

216−parseKernel :: Text -> Either Error KernelInfo

217−parseKernel sourceCode =

218− case Parse.run Kernel.parser sourceCode of

219− Right info ->

220− Right (KernelInfo info)

221−

222− Left err ->

223− Left (Error (A.map Error.Syntax err))

src/Elm/Compiler/Internals.hsnew file+20

@@ -0,0 +1,20 @@

1+{-# OPTIONS_GHC -Wall #-}

2+module Elm.Compiler.Internals

3+ ( Error(..)

4+ , Warning(..)

5+ )

6+ where

9+import qualified Reporting.Annotation as A

10+import qualified Reporting.Error as Error

11+import qualified Reporting.Warning as Warning

12+

13+

14+

15+-- OPAQUE TYPES

16+

17+

18+newtype Error = Error (A.Located Error.Error)

19+newtype Warning = Warning (A.Located Warning.Warning)

20+

src/Elm/Compiler/Objects.hs+3−2

@@ -13,6 +13,7 @@ module Elm.Compiler.Objects

1313

1414import qualified Data.Map as Map

1515

16+import qualified AST.Kernel as Kernel

1617import qualified AST.Module.Name as ModuleName

1718import qualified Elm.Compiler as Compiler

1819import Elm.Compiler.Objects.Internal as Obj

@@ -22,10 +23,10 @@ import Elm.Compiler.Objects.Internal as Obj

2223-- HELPER

2324

2425

25−graphForPackage :: Map.Map ModuleName.Raw Compiler.KernelInfo -> [Compiler.Result] -> Obj.Graph

26+graphForPackage :: Map.Map ModuleName.Raw Kernel.Data -> [Compiler.Result] -> Obj.Graph

2627graphForPackage kernels results =

2728 let

2829 kernelGraph =

29− Obj.Graph Map.empty (Map.map (\(Compiler.KernelInfo info) -> info) kernels)

30+ Obj.Graph Map.empty kernels

3031 in

3132 Obj.unions (kernelGraph : map Compiler._objs results)

src/Elm/Compiler/Objects/Internal.hs+1−1

@@ -34,7 +34,7 @@ import qualified AST.Variable as Var

3434data Graph =

3535 Graph

3636 { _decls :: Map.Map Var.Global Opt.Decl

37− , _kernels :: Map.Map ModuleName.Raw Kernel.Info

37+ , _kernels :: Map.Map ModuleName.Raw Kernel.Data

3838 }

3939

4040

src/Elm/Header.hsnew file+63

@@ -0,0 +1,63 @@

1+{-# OPTIONS_GHC -Wall #-}

2+module Elm.Header

3+ ( Tag(..)

4+ , parse

5+ )

6+ where

9+import Data.Text (Text)

10+

11+import qualified AST.Module as Module

12+import qualified Elm.Compiler.Imports as Imports

13+import qualified Elm.Compiler.Internals as I

14+import 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)

18+import qualified Reporting.Annotation as A

19+import qualified Reporting.Error as Error

20+

21+

22+

23+-- HEADER TAGS

24+

25+

26+data Tag = Normal | Effect | Port

27+

28+

29+

30+-- PARSE

31+

32+

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

38+

39+ 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 )

src/Elm/Kernel.hsnew file+31

@@ -0,0 +1,31 @@

1+{-# OPTIONS_GHC -Wall #-}

2+module Elm.Kernel

3+ ( Kernel.Data(..)

4+ , Kernel.Content

5+ , parse

6+ )

7+ where

10+import Data.Text (Text)

11+

12+import qualified AST.Kernel as Kernel (Data(..), Content(..))

13+import qualified Elm.Compiler.Internals as I

14+import qualified Parse.Helpers as Parse (run)

15+import qualified Parse.Kernel as Kernel (parser)

16+import qualified Reporting.Annotation as A

17+import qualified Reporting.Error as Error

18+

19+

20+

21+-- PARSE KERNEL

22+

23+

24+parse :: Text -> Either I.Error Kernel.Content

25+parse sourceCode =

26+ case Parse.run Kernel.parser sourceCode of

27+ Right content ->

28+ Right content

29+

30+ Left err ->

31+ Left (I.Error (A.map Error.Syntax err))

src/Generate/JavaScript.hs+53−24

@@ -1,6 +1,10 @@

11{-# OPTIONS_GHC -Wall #-}

22{-# LANGUAGE OverloadedStrings #-}

3−module Generate.JavaScript (generate) where

3+module Generate.JavaScript

4+ ( generate

5+ , Target(..)

6+ )

7+ where

59import Control.Monad (foldM)

610import Data.Monoid ((<>))

@@ -28,11 +32,11 @@ import qualified Generate.JavaScript.Variable as JS

2832-- GENERATE JAVASCRIPT

2933

3034

31−generate :: Bool -> Obj.Graph -> Obj.Roots -> BS.Builder

32−generate debug graph roots =

35+generate :: Bool -> Target -> Obj.Graph -> Obj.Roots -> BS.Builder

36+generate debug target graph roots =

3337 let

34− (State builders _ _ effects _) =

35− List.foldl' (crawl graph) (initialState debug) (Obj.toGlobals roots)

38+ (State builders _ _ effects) =

39+ List.foldl' (crawl (Env debug target) graph) initialState (Obj.toGlobals roots)

3640

3741 managers =

3842 JS.run (JsEffects.generate effects)

@@ -41,6 +45,20 @@ generate debug graph roots =

4145

4246

4347

48+-- CRAWL ENV

49+

50+

51+data Env =

52+ Env

53+ { _debug :: Bool

54+ , _target :: Target

55+ }

56+

57+

58+data Target = Client | Server

59+

60+

61+

4462-- CRAWL STATE

4563

4664

@@ -50,21 +68,20 @@ data State =

5068 , _seenDecls :: Set.Set Var.Global

5169 , _seenKernels :: Set.Set ModuleName.Raw

5270 , _effects :: Map.Map ModuleName.Canonical Effects.ManagerType

53− , _debug :: Bool

5471 }

5572

5673

57−initialState :: Bool -> State

58−initialState debug =

59− State [] Set.empty Set.empty Map.empty debug

74+initialState :: State

75+initialState =

76+ State [] Set.empty Set.empty Map.empty

6077

6178

6279

6380-- CRAWL

6481

6582

66−crawl :: Obj.Graph -> State -> Var.Global -> State

67−crawl graph@(Obj.Graph decls kernels) state@(State _ seenDecls seenKernels _ _) name@(Var.Global home _) =

83+crawl :: Env -> Obj.Graph -> State -> Var.Global -> State

84+crawl env graph@(Obj.Graph decls kernels) state@(State _ seenDecls seenKernels _) name@(Var.Global home _) =

6885 if Set.member name seenDecls then

6986 state

7087

@@ -74,7 +91,7 @@ crawl graph@(Obj.Graph decls kernels) state@(State _ seenDecls seenKernels _ _)

7491 else

7592 case Map.lookup name decls of

7693 Just decl ->

77− crawlDecl graph name decl state

94+ crawlDecl env graph name decl state

7895

7996 Nothing ->

8097 let

@@ -86,7 +103,7 @@ crawl graph@(Obj.Graph decls kernels) state@(State _ seenDecls seenKernels _ _)

86103 else

87104 case Map.lookup kernelModule kernels of

88105 Just info ->

89− crawlKernel graph kernelModule info state

106+ crawlKernel env graph kernelModule info state

90107

91108 Nothing ->

92109 error (crawlError name)

@@ -96,14 +113,14 @@ crawl graph@(Obj.Graph decls kernels) state@(State _ seenDecls seenKernels _ _)

96113-- CRAWL DECL

97114

98115

99−crawlDecl :: Obj.Graph -> Var.Global -> Opt.Decl -> State -> State

100−crawlDecl graph var@(Var.Global home name) (Opt.Decl direct indirect fx body) state1 =

116+crawlDecl :: Env -> Obj.Graph -> Var.Global -> Opt.Decl -> State -> State

117+crawlDecl env graph var@(Var.Global home name) (Opt.Decl direct indirect fx body) state1 =

101118 let

102119 state2 =

103120 state1 { _seenDecls = Set.insert var (_seenDecls state1) }

104121

105− (State builders seenDecls seenKernels effects debug) =

106− Set.foldl' (crawl graph) state2 direct

122+ (State builders seenDecls seenKernels effects) =

123+ Set.foldl' (crawl env graph) state2 direct

107124

108125 stmt =

109126 JS.run (JsExpr.generateDecl home name body)

@@ -114,24 +131,37 @@ crawlDecl graph var@(Var.Global home name) (Opt.Decl direct indirect fx body) st

114131 , _seenDecls = seenDecls

115132 , _seenKernels = seenKernels

116133 , _effects = maybe id (Map.insert home) fx effects

117− , _debug = debug

118134 }

119135 in

120− Set.foldl' (crawl graph) state4 indirect

136+ Set.foldl' (crawl env graph) state4 indirect

121137

122138

123139

124140-- CRAWL KERNEL

125141

126142

127−crawlKernel :: Obj.Graph -> ModuleName.Raw -> Kernel.Info -> State -> State

128−crawlKernel graph name (Kernel.Info imports chunks) state1 =

143+crawlKernel :: Env -> Obj.Graph -> ModuleName.Raw -> Kernel.Data -> State -> State

144+crawlKernel env@(Env _ target) graph name (Kernel.Data client maybeServer) state =

145+ let

146+ content =

147+ case target of

148+ Server ->

149+ maybe client id maybeServer

150+

151+ Client ->

152+ client

153+ in

154+ crawlKernelContent env graph name content state

155+

156+

157+crawlKernelContent :: Env -> Obj.Graph -> ModuleName.Raw -> Kernel.Content -> State -> State

158+crawlKernelContent env@(Env debug _) graph name (Kernel.Content imports chunks) state1 =

129159 let

130160 state2 =

131161 state1 { _seenKernels = Set.insert name (_seenKernels state1) }

132162

133− (State builders seenDecls seenKernels effects debug) =

134− List.foldl' (crawl graph) state2 (map toCoreGlobal imports)

163+ (State builders seenDecls seenKernels effects) =

164+ List.foldl' (crawl env graph) state2 (map toCoreGlobal imports)

135165

136166 builder =

137167 JS.run (foldM (chunkToBuilder debug) mempty chunks)

@@ -141,7 +171,6 @@ crawlKernel graph name (Kernel.Info imports chunks) state1 =

141171 , _seenDecls = seenDecls

142172 , _seenKernels = seenKernels

143173 , _effects = effects

144− , _debug = debug

145174 }

146175

147176

src/Parse/Kernel.hs+2−2

@@ -30,12 +30,12 @@ import qualified Reporting.Annotation as A

3030-- PARSER

3131

3232

33−parser :: Parser Kernel.Info

33+parser :: Parser Kernel.Content

3434parser =

3535 do header <- Parse.kernelHeader

3636 let imports = Map.unions (map headerToImport header)

3737 chunks <- parserHelp imports Map.empty Map.empty []

38− return (Kernel.Info (Map.elems imports) chunks)

38+ return (Kernel.Content (Map.elems imports) chunks)

3939

4040

4141parserHelp :: Imports -> Enums -> Fields -> [Kernel.Chunk] -> Parser [Kernel.Chunk]