on fe7bbbd help sign in
elk/src/Elm/Compiler.hs
206 lines 5.1 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Elm.Compiler
3 ( version
4 , parseDependencies, Tag(..)
5 , compile, Context(..), Result(..)
6 , generate
7 , Localizer, dummyLocalizer
8 , Error, errorToDoc, errorToJson
9 , Warning, warningToDoc, warningToJson
10 )
11 where
13import qualified Data.Aeson as Json
14import qualified Data.Map as Map
15import qualified Data.Set as Set
16import Data.Text (Text)
17import qualified Data.ByteString.Builder as BS
18import Text.PrettyPrint.ANSI.Leijen (Doc)
20import qualified AST.Expression.Optimized as Opt
21import qualified AST.Module as Module
22import qualified AST.Module.Name as ModuleName
23import qualified Compile
24import qualified Docs.Check as Docs
25import qualified Elm.Compiler.Imports as Imports
26import qualified Elm.Compiler.Module as M
27import qualified Elm.Compiler.Version
28import qualified Elm.Docs as Docs
29import qualified Elm.Package as Package
30import qualified Generate.JavaScript as JS
31import qualified Parse.Helpers as Parse (run)
32import qualified Parse.Module as Parse (header)
33import qualified Reporting.Annotation as A
34import qualified Reporting.Bag as Bag
35import qualified Reporting.Error as Error
36import qualified Reporting.Render.Type as RenderType
37import qualified Reporting.Report as Report
38import qualified Reporting.Result as Result
39import qualified Reporting.Warning as Warning
43-- VERSION
46version :: Package.Version
47version =
48 Elm.Compiler.Version.version
52-- DEPENDENCIES
55data Tag = Normal | Effect | Port
58parseDependencies :: 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 ->
62 Right $ getDeps pkgName header
64 Left err ->
65 Left (Error (A.map Error.Syntax err))
68getDeps :: Package.Name -> Module.Header [Module.UserImport] -> (Tag, Maybe M.Raw, [M.Raw])
69getDeps pkgName (Module.Header maybeHeaderDecl imports) =
70 let
71 dependencies =
72 if pkgName == Package.core
73 then map (fst . A.drop) imports
74 else map (fst . A.drop) imports ++ map fst Imports.defaults
75 in
76 case maybeHeaderDecl of
77 Nothing ->
78 ( Normal, Nothing, dependencies )
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
88 ( tag, Just name, dependencies )
92-- COMPILATION
95{-| Compiles Elm source code to JavaScript. -}
96compile :: Context -> Text -> (Localizer, [Warning], Either [Error] Result)
97compile context source =
98 let
99 (Context packageName exposed importDict interfaces) =
100 context
102 (Result.Result oneLocalizer warnings answer) =
103 do modul <- Compile.compile packageName importDict interfaces source
104 docs <- Result.format id (docsGen exposed modul)
106 let iface = Module.toInterface modul
107 let objs = Module.program (Module.info modul)
109 return (Result docs iface objs)
110 in
111 ( Result.oneToValue dummyLocalizer Localizer oneLocalizer
112 , Bag.toList Warning warnings
113 , Result.answerToEither Error id answer
114 )
117data Context =
118 Context
119 { _package :: Package.Name
120 , _exposed :: Bool
121 , _imports :: Map.Map M.Raw M.Canonical
122 , _interfaces :: M.Interfaces
123 }
126data Result =
127 Result
128 { _docs :: Maybe Docs.Documentation
129 , _iface :: M.Interface
130 , _objs :: [(Text, Opt.Decl)]
131 }
135-- DOCUMENTATION
138docsGen :: Bool -> Module.Optimized -> Result.Result () w Error.Error (Maybe Docs.Documentation)
139docsGen isExposed (Module.Module name info) =
140 if not isExposed then
141 Result.ok Nothing
143 else
144 let
145 toDocs checked =
146 Just (Docs.fromCheckedDocs (ModuleName._module name) checked)
147 in
148 toDocs <$> Docs.check (Module.exports info) (Module.docs info)
152-- CODE GENERATION
155generate :: Map.Map M.Global Opt.Decl -> [M.Global] -> (Set.Set M.Canonical, BS.Builder)
156generate =
157 JS.generate
161-- DEALIASER
164newtype Localizer =
165 Localizer RenderType.Localizer
168dummyLocalizer :: Localizer
169dummyLocalizer =
170 Localizer Map.empty
174-- ERRORS
177newtype Error =
178 Error (A.Located Error.Error)
181errorToDoc :: Localizer -> String -> Text -> Error -> Doc
182errorToDoc (Localizer localizer) location source (Error (A.A region err)) =
183 Report.toDoc location region (Error.toReport localizer err) source
186errorToJson :: Localizer -> String -> Error -> Json.Value
187errorToJson (Localizer localizer) location (Error err) =
188 Error.toJson localizer location err
192-- WARNINGS
195newtype Warning =
196 Warning (A.Located Warning.Warning)
199warningToDoc :: Localizer -> String -> Text -> Warning -> Doc
200warningToDoc (Localizer localizer) location source (Warning (A.A region wrn)) =
201 Report.toDoc location region (Warning.toReport localizer wrn) source
204warningToJson :: Localizer -> String -> Warning -> Json.Value
205warningToJson (Localizer localizer) location (Warning wrn) =
206 Warning.toJson localizer location wrn