git.iko.soy/elk
on 3db3bdf help sign in
elk/src/Elm/Compiler.hs
206 lines 5.0 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Elm.Compiler
3 ( version
4 , compile, Context(..), Result(..)
5 , generate
6 , Localizer, dummyLocalizer
7 , Error, errorToDoc, errorToJson
8 , Warning, warningToDoc, warningToJson
9 , Tag(..), parseHeader
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.Module as Module
21import qualified AST.Module.Name as ModuleName
22import qualified Compile
23import qualified Docs.Check as Docs
24import qualified Elm.Compiler.Imports as Imports
25import qualified Elm.Compiler.Module as M
26import qualified Elm.Compiler.Objects.Internal as Obj
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-- COMPILATION
55{-| Compiles Elm source code to JavaScript. -}
56compile :: Context -> Text -> (Localizer, [Warning], Either [Error] Result)
57compile context source =
58 let
59 (Context packageName exposed importDict interfaces) =
60 context
62 (Result.Result oneLocalizer warnings answer) =
63 do modul <- Compile.compile packageName importDict interfaces source
64 docs <- Result.format id (docsGen exposed modul)
66 let iface = Module.toInterface modul
67 let objs = Obj.fromModule modul
69 return (Result docs iface objs)
70 in
71 ( Result.oneToValue dummyLocalizer Localizer oneLocalizer
72 , Bag.toList Warning warnings
73 , Result.answerToEither Error id answer
74 )
77data Context =
78 Context
79 { _package :: Package.Name
80 , _exposed :: Bool
81 , _imports :: Map.Map M.Raw M.Canonical
82 , _interfaces :: M.Interfaces
83 }
86data Result =
87 Result
88 { _docs :: Maybe Docs.Module
89 , _iface :: M.Interface
90 , _objs :: Obj.Graph
91 }
95-- DOCUMENTATION
98docsGen :: Bool -> Module.Optimized -> Result.Result () w Error.Error (Maybe Docs.Module)
99docsGen isExposed (Module.Module name info) =
100 if not isExposed then
101 Result.ok Nothing
103 else
104 let
105 toDocs checked =
106 Just (Docs.Module (ModuleName._module name) checked)
107 in
108 toDocs <$> Docs.check (Module.exports info) (Module.docs info)
112-- CODE GENERATION
115generate :: Obj.SymbolTable -> Obj.Graph -> Obj.Roots -> (Set.Set M.Canonical, BS.Builder)
116generate =
117 JS.generate
121-- DEALIASER
124newtype Localizer =
125 Localizer RenderType.Localizer
128dummyLocalizer :: Localizer
129dummyLocalizer =
130 Localizer Map.empty
134-- ERRORS
137newtype Error =
138 Error (A.Located Error.Error)
141errorToDoc :: Localizer -> String -> Text -> Error -> Doc
142errorToDoc (Localizer localizer) location source (Error (A.A region err)) =
143 Report.toDoc location region (Error.toReport localizer err) source
146errorToJson :: Localizer -> String -> Error -> Json.Value
147errorToJson (Localizer localizer) location (Error err) =
148 Error.toJson localizer location err
152-- WARNINGS
155newtype Warning =
156 Warning (A.Located Warning.Warning)
159warningToDoc :: Localizer -> String -> Text -> Warning -> Doc
160warningToDoc (Localizer localizer) location source (Warning (A.A region wrn)) =
161 Report.toDoc location region (Warning.toReport localizer wrn) source
164warningToJson :: Localizer -> String -> Warning -> Json.Value
165warningToJson (Localizer localizer) location (Warning wrn) =
166 Warning.toJson localizer location wrn
170-- PARSE HEADER
173data Tag = Normal | Effect | Port
176parseHeader :: Package.Name -> Text -> Either Error (Tag, Maybe M.Raw, [M.Raw])
177parseHeader pkgName sourceCode =
178 case Parse.run Parse.header sourceCode of
179 Right header ->
180 Right $ toHeaderSummary pkgName header
182 Left err ->
183 Left (Error (A.map Error.Syntax err))
186toHeaderSummary :: Package.Name -> Module.Header [Module.UserImport] -> (Tag, Maybe M.Raw, [M.Raw])
187toHeaderSummary pkgName (Module.Header maybeHeaderDecl imports) =
188 let
189 dependencies =
190 if pkgName == Package.core
191 then map (fst . A.drop) imports
192 else map (fst . A.drop) imports ++ map fst Imports.defaults
193 in
194 case maybeHeaderDecl of
195 Nothing ->
196 ( Normal, Nothing, dependencies )
198 Just (Module.HeaderDecl sourceTag name _ _ _) ->
199 let
200 tag =
201 case sourceTag of
202 Module.Normal -> Normal
203 Module.Port _ -> Port
204 Module.Effect _ -> Effect
205 in
206 ( tag, Just name, dependencies )