git.iko.soy/elk
on e00a3f3 help sign in
elk/src/Elm/Compiler.hs
226 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 source =
60 let
61 (Context packageName exposed importDict interfaces) =
62 context
64 (Result.Result oneLocalizer warnings answer) =
65 do modul <- Compile.compile packageName importDict interfaces source
66 docs <- Result.format id (docsGen exposed modul)
68 let iface = Module.toInterface modul
69 let objs = Obj.fromModule modul
71 return (Result docs iface objs)
72 in
73 ( Result.oneToValue dummyLocalizer Localizer oneLocalizer
74 , Bag.toList Warning warnings
75 , Result.answerToEither Error id answer
76 )
79data Context =
80 Context
81 { _package :: Package.Name
82 , _exposed :: Bool
83 , _imports :: Map.Map M.Raw M.Canonical
84 , _interfaces :: M.Interfaces
85 }
88data Result =
89 Result
90 { _docs :: Maybe Docs.Module
91 , _iface :: M.Interface
92 , _objs :: Obj.Graph
93 }
97-- DOCUMENTATION
100docsGen :: Bool -> Module.Optimized -> Result.Result () w Error.Error (Maybe Docs.Module)
101docsGen isExposed (Module.Module name info) =
102 if not isExposed then
103 Result.ok Nothing
105 else
106 let
107 toDocs checked =
108 Just (Docs.Module (ModuleName._module name) checked)
109 in
110 toDocs <$> Docs.check (Module.exports info) (Module.docs info)
114-- CODE GENERATION
117generate :: Obj.Graph -> Obj.Roots -> BS.Builder
118generate =
119 JS.generate
123-- DEALIASER
126newtype Localizer =
127 Localizer RenderType.Localizer
130dummyLocalizer :: Localizer
131dummyLocalizer =
132 Localizer Map.empty
136-- ERRORS
139newtype Error =
140 Error (A.Located Error.Error)
143errorToDoc :: Localizer -> String -> Text -> Error -> Doc
144errorToDoc (Localizer localizer) location source (Error (A.A region err)) =
145 Report.toDoc location region (Error.toReport localizer err) source
148errorToJson :: Localizer -> String -> Error -> Json.Value
149errorToJson (Localizer localizer) location (Error err) =
150 Error.toJson localizer location err
154-- WARNINGS
157newtype Warning =
158 Warning (A.Located Warning.Warning)
161warningToDoc :: Localizer -> String -> Text -> Warning -> Doc
162warningToDoc (Localizer localizer) location source (Warning (A.A region wrn)) =
163 Report.toDoc location region (Warning.toReport localizer wrn) source
166warningToJson :: Localizer -> String -> Warning -> Json.Value
167warningToJson (Localizer localizer) location (Warning wrn) =
168 Warning.toJson localizer location wrn
172-- PARSE HEADER
175data Tag = Normal | Effect | Port
178parseHeader :: Package.Name -> Text -> Either Error (Tag, Maybe M.Raw, [M.Raw])
179parseHeader pkgName sourceCode =
180 case Parse.run Parse.header sourceCode of
181 Right header ->
182 Right $ toHeaderSummary pkgName header
184 Left err ->
185 Left (Error (A.map Error.Syntax err))
188toHeaderSummary :: Package.Name -> Module.Header [Module.UserImport] -> (Tag, Maybe M.Raw, [M.Raw])
189toHeaderSummary pkgName (Module.Header maybeHeaderDecl imports) =
190 let
191 dependencies =
192 if pkgName == Package.core
193 then map (fst . A.drop) imports
194 else map (fst . A.drop) imports ++ map fst Imports.defaults
195 in
196 case maybeHeaderDecl of
197 Nothing ->
198 ( Normal, Nothing, dependencies )
200 Just (Module.HeaderDecl sourceTag name _ _ _) ->
201 let
202 tag =
203 case sourceTag of
204 Module.Normal -> Normal
205 Module.Port _ -> Port
206 Module.Effect _ -> Effect
207 in
208 ( tag, Just name, dependencies )
212-- PARSE KERNEL
215newtype KernelInfo =
216 KernelInfo Kernel.Info
219parseKernel :: Text -> Either Error KernelInfo
220parseKernel sourceCode =
221 case Parse.run Kernel.parser sourceCode of
222 Right info ->
223 Right (KernelInfo info)
225 Left err ->
226 Left (Error (A.map Error.Syntax err))