git.iko.soy/elk
on 1925e31 help sign in
elk/src/Elm/Compiler.hs
196 lines 5.2 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Elm.Compiler
3 ( version
4 , parseDependencies, Tag(..)
5 , compile, Context(..), Result(..)
6 , Localizer, dummyLocalizer
7 , Error, errorToString, errorToJson, printError
8 , Warning, warningToString, warningToJson, printWarning
9 )
10 where
12import qualified Data.Aeson as Json
13import qualified Data.Map as Map
14import qualified Data.Text.Lazy as LazyText
15import Data.Text (Text)
16import System.IO (Handle)
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 PublicModule
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, PublicModule.Raw, [PublicModule.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, PublicModule.Raw, [PublicModule.Raw])
69getDeps pkgName (Module.Header sourceTag name _ _ _ imports) =
70 let
71 tag =
72 case sourceTag of
73 Module.Normal -> Normal
74 Module.Port _ -> Port
75 Module.Effect _ -> Effect
77 deps =
78 if pkgName == Package.core then
79 map (fst . A.drop) imports
80 else
81 map (fst . A.drop) imports ++ map fst Imports.defaults
82 in
83 ( tag, name, deps )
87-- COMPILATION
90{-| Compiles Elm source code to JavaScript. -}
91compile :: Context -> Text -> PublicModule.Interfaces -> (Localizer, [Warning], Either [Error] Result)
92compile context source interfaces =
93 let
94 (Context packageName isExposed dependencies) =
95 context
97 (Result.Result oneLocalizer warnings answer) =
98 do modul <- Compile.compile packageName dependencies interfaces source
99 docs <- Result.format id (docsGen isExposed modul)
101 let interface = Module.toInterface packageName modul
102 let javascript = {-# SCC elm_compiler_generate #-} JS.generate modul
104 return (Result docs interface javascript)
105 in
106 ( Result.oneToValue dummyLocalizer Localizer oneLocalizer
107 , Bag.toList Warning warnings
108 , Result.answerToEither Error id answer
109 )
112data Context =
113 Context
114 { _packageName :: Package.Name
115 , _isExposed :: Bool
116 , _dependencies :: [PublicModule.Canonical]
117 }
120data Result = Result
121 { _docs :: Maybe Docs.Documentation
122 , _interface :: PublicModule.Interface
123 , _js :: LazyText.Text
124 }
127docsGen :: Bool -> Module.Optimized -> Result.Result () w Error.Error (Maybe Docs.Documentation)
128docsGen isExposed (Module.Module name _ info) =
129 if not isExposed then
130 Result.ok Nothing
132 else
133 let
134 toDocs checked =
135 Just (Docs.fromCheckedDocs (ModuleName._module name) checked)
136 in
137 toDocs <$> Docs.check (Module.exports info) (Module.docs info)
141-- DEALIASER
144newtype Localizer =
145 Localizer RenderType.Localizer
148dummyLocalizer :: Localizer
149dummyLocalizer =
150 Localizer Map.empty
154-- ERRORS
157newtype Error =
158 Error (A.Located Error.Error)
161errorToString :: Localizer -> String -> Text -> Error -> String
162errorToString (Localizer localizer) location source (Error (A.A region err)) =
163 Report.toString location region (Error.toReport localizer err) source
166printError :: Handle -> Localizer -> String -> Text -> Error -> IO ()
167printError handle (Localizer localizer) location source (Error (A.A region err)) =
168 Report.toHandle handle location region (Error.toReport localizer err) source
171errorToJson :: Localizer -> String -> Error -> Json.Value
172errorToJson (Localizer localizer) location (Error err) =
173 Error.toJson localizer location err
177-- WARNINGS
180newtype Warning =
181 Warning (A.Located Warning.Warning)
184warningToString :: Localizer -> String -> Text -> Warning -> String
185warningToString (Localizer localizer) location source (Warning (A.A region wrn)) =
186 Report.toString location region (Warning.toReport localizer wrn) source
189printWarning :: Handle -> Localizer -> String -> Text -> Warning -> IO ()
190printWarning handle (Localizer localizer) location source (Warning (A.A region wrn)) =
191 Report.toHandle handle location region (Warning.toReport localizer wrn) source
194warningToJson :: Localizer -> String -> Warning -> Json.Value
195warningToJson (Localizer localizer) location (Warning wrn) =
196 Warning.toJson localizer location wrn