git.iko.soy/elk
on bca019d help sign in
elk/src/Elm/Compiler.hs
223 lines 5.3 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 , KernelInfo(..), parseKernel
11 )
12 where
14import qualified Data.Aeson as Json
15import qualified Data.Map as Map
16import Data.Text (Text)
17import qualified Data.ByteString.Builder as BS
18import Text.PrettyPrint.ANSI.Leijen (Doc)
20import qualified AST.Kernel as Kernel (Info)
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.Objects.Internal as Obj
28import qualified Elm.Compiler.Version
29import qualified Elm.Docs as Docs
30import qualified Elm.Package as Package
31import qualified Generate.JavaScript as JS
32import qualified Parse.Helpers as Parse (run)
33import qualified Parse.Kernel as Kernel (parser)
34import qualified Parse.Module as Parse (header)
35import qualified Reporting.Annotation as A
36import qualified Reporting.Bag as Bag
37import qualified Reporting.Error as Error
38import qualified Reporting.Render.Type as RenderType
39import qualified Reporting.Report as Report
40import qualified Reporting.Result as Result
41import qualified Reporting.Warning as Warning
45-- VERSION
48version :: Package.Version
49version =
50 Elm.Compiler.Version.version
54-- COMPILATION
57{-| Compiles Elm source code to JavaScript. -}
58compile :: Context -> Text -> (Localizer, [Warning], Either [Error] Result)
59compile (Context packageName exposed importDict interfaces) source =
60 let
61 (Result.Result oneLocalizer warnings answer) =
62 do modul <- Compile.compile packageName importDict interfaces source
63 docs <- Result.format id (docsGen exposed modul)
65 let iface = Module.toInterface modul
66 let objs = Obj.fromModule modul
68 return (Result docs iface objs)
69 in
70 ( Result.oneToValue dummyLocalizer Localizer oneLocalizer
71 , Bag.toList Warning warnings
72 , Result.answerToEither Error id answer
73 )
76data Context =
77 Context
78 { _package :: Package.Name
79 , _exposed :: Bool
80 , _imports :: Map.Map M.Raw M.Canonical
81 , _interfaces :: M.Interfaces
82 }
85data Result =
86 Result
87 { _docs :: Maybe Docs.Module
88 , _iface :: M.Interface
89 , _objs :: Obj.Graph
90 }
94-- DOCUMENTATION
97docsGen :: Bool -> Module.Optimized -> Result.Result () w Error.Error (Maybe Docs.Module)
98docsGen isExposed (Module.Module name info) =
99 if not isExposed then
100 Result.ok Nothing
102 else
103 let
104 toDocs checked =
105 Just (Docs.Module (ModuleName._module name) checked)
106 in
107 toDocs <$> Docs.check (Module.exports info) (Module.docs info)
111-- CODE GENERATION
114generate :: Obj.Graph -> Obj.Roots -> BS.Builder
115generate =
116 JS.generate
120-- DEALIASER
123newtype Localizer =
124 Localizer RenderType.Localizer
127dummyLocalizer :: Localizer
128dummyLocalizer =
129 Localizer Map.empty
133-- ERRORS
136newtype Error =
137 Error (A.Located Error.Error)
140errorToDoc :: Localizer -> String -> Text -> Error -> Doc
141errorToDoc (Localizer localizer) location source (Error (A.A region err)) =
142 Report.toDoc location region (Error.toReport localizer err) source
145errorToJson :: Localizer -> String -> Error -> Json.Value
146errorToJson (Localizer localizer) location (Error err) =
147 Error.toJson localizer location err
151-- WARNINGS
154newtype Warning =
155 Warning (A.Located Warning.Warning)
158warningToDoc :: Localizer -> String -> Text -> Warning -> Doc
159warningToDoc (Localizer localizer) location source (Warning (A.A region wrn)) =
160 Report.toDoc location region (Warning.toReport localizer wrn) source
163warningToJson :: Localizer -> String -> Warning -> Json.Value
164warningToJson (Localizer localizer) location (Warning wrn) =
165 Warning.toJson localizer location wrn
169-- PARSE HEADER
172data Tag = Normal | Effect | Port
175parseHeader :: Package.Name -> Text -> Either Error (Tag, Maybe M.Raw, [M.Raw])
176parseHeader pkgName sourceCode =
177 case Parse.run Parse.header sourceCode of
178 Right header ->
179 Right $ toHeaderSummary pkgName header
181 Left err ->
182 Left (Error (A.map Error.Syntax err))
185toHeaderSummary :: Package.Name -> Module.Header [Module.UserImport] -> (Tag, Maybe M.Raw, [M.Raw])
186toHeaderSummary 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 ( Normal, Nothing, dependencies )
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 ( tag, Just name, dependencies )
209-- PARSE KERNEL
212newtype KernelInfo =
213 KernelInfo Kernel.Info
216parseKernel :: Text -> Either Error KernelInfo
217parseKernel sourceCode =
218 case Parse.run Kernel.parser sourceCode of
219 Right info ->
220 Right (KernelInfo info)
222 Left err ->
223 Left (Error (A.map Error.Syntax err))