on 3b08065 help sign in
elk/src/Elm/Compiler.hs
193 lines 4.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Elm.Compiler
3 ( version
4 , parseDependencies, Tag(..)
5 , compile, Context(..), Result(..)
6 , Localizer, dummyLocalizer
7 , Error, errorToDoc, errorToJson
8 , Warning, warningToDoc, warningToJson
9 )
10 where
12import qualified Data.Aeson as Json
13import qualified Data.Map as Map
14import Data.Text (Text)
15import qualified Data.ByteString.Builder as BS
16import Text.PrettyPrint.ANSI.Leijen (Doc)
18import qualified AST.Module as Module
19import qualified AST.Module.Name as ModuleName
20import qualified Compile
21import qualified Docs.Check as Docs
22import qualified Elm.Compiler.Imports as Imports
23import qualified Elm.Compiler.Module as M
24import qualified Elm.Compiler.Version
25import qualified Elm.Docs as Docs
26import qualified Elm.Package as Package
27import qualified Generate.JavaScript as JS
28import qualified Parse.Helpers as Parse (run)
29import qualified Parse.Module as Parse (header)
30import qualified Reporting.Annotation as A
31import qualified Reporting.Bag as Bag
32import qualified Reporting.Error as Error
33import qualified Reporting.Render.Type as RenderType
34import qualified Reporting.Report as Report
35import qualified Reporting.Result as Result
36import qualified Reporting.Warning as Warning
40-- VERSION
43version :: Package.Version
44version =
45 Elm.Compiler.Version.version
49-- DEPENDENCIES
52data Tag
53 = Normal
54 | Effect
55 | 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 interface = Module.toInterface modul
107 let javascript = {-# SCC elm_compiler_generate #-} JS.generate modul
109 return (Result docs interface javascript)
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 , _js :: BS.Builder
131 }
134docsGen :: Bool -> Module.Optimized -> Result.Result () w Error.Error (Maybe Docs.Documentation)
135docsGen isExposed (Module.Module name info) =
136 if not isExposed then
137 Result.ok Nothing
139 else
140 let
141 toDocs checked =
142 Just (Docs.fromCheckedDocs (ModuleName._module name) checked)
143 in
144 toDocs <$> Docs.check (Module.exports info) (Module.docs info)
148-- DEALIASER
151newtype Localizer =
152 Localizer RenderType.Localizer
155dummyLocalizer :: Localizer
156dummyLocalizer =
157 Localizer Map.empty
161-- ERRORS
164newtype Error =
165 Error (A.Located Error.Error)
168errorToDoc :: Localizer -> String -> Text -> Error -> Doc
169errorToDoc (Localizer localizer) location source (Error (A.A region err)) =
170 Report.toDoc location region (Error.toReport localizer err) source
173errorToJson :: Localizer -> String -> Error -> Json.Value
174errorToJson (Localizer localizer) location (Error err) =
175 Error.toJson localizer location err
179-- WARNINGS
182newtype Warning =
183 Warning (A.Located Warning.Warning)
186warningToDoc :: Localizer -> String -> Text -> Warning -> Doc
187warningToDoc (Localizer localizer) location source (Warning (A.A region wrn)) =
188 Report.toDoc location region (Warning.toReport localizer wrn) source
191warningToJson :: Localizer -> String -> Warning -> Json.Value
192warningToJson (Localizer localizer) location (Warning wrn) =
193 Warning.toJson localizer location wrn