git.iko.soy/elk
on 4a978eb help sign in
elk/src/Elm/Compiler.hs
187 lines 4.6 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 qualified Data.Text.Lazy as LazyText
15import Data.Text (Text)
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, 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, M.Raw, [M.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 -> (Localizer, [Warning], Either [Error] Result)
92compile context source =
93 let
94 (Context packageName exposed importDict interfaces) =
95 context
97 (Result.Result oneLocalizer warnings answer) =
98 do modul <- Compile.compile packageName importDict interfaces source
99 docs <- Result.format id (docsGen exposed modul)
101 let interface = Module.toInterface 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 { _package :: Package.Name
115 , _exposed :: Bool
116 , _imports :: Map.Map M.Raw M.Canonical
117 , _interfaces :: M.Interfaces
118 }
121data Result = Result
122 { _docs :: Maybe Docs.Documentation
123 , _interface :: M.Interface
124 , _js :: LazyText.Text
125 }
128docsGen :: Bool -> Module.Optimized -> Result.Result () w Error.Error (Maybe Docs.Documentation)
129docsGen isExposed (Module.Module name _ info) =
130 if not isExposed then
131 Result.ok Nothing
133 else
134 let
135 toDocs checked =
136 Just (Docs.fromCheckedDocs (ModuleName._module name) checked)
137 in
138 toDocs <$> Docs.check (Module.exports info) (Module.docs info)
142-- DEALIASER
145newtype Localizer =
146 Localizer RenderType.Localizer
149dummyLocalizer :: Localizer
150dummyLocalizer =
151 Localizer Map.empty
155-- ERRORS
158newtype Error =
159 Error (A.Located Error.Error)
162errorToDoc :: Localizer -> String -> Text -> Error -> Doc
163errorToDoc (Localizer localizer) location source (Error (A.A region err)) =
164 Report.toDoc location region (Error.toReport localizer err) source
167errorToJson :: Localizer -> String -> Error -> Json.Value
168errorToJson (Localizer localizer) location (Error err) =
169 Error.toJson localizer location err
173-- WARNINGS
176newtype Warning =
177 Warning (A.Located Warning.Warning)
180warningToDoc :: Localizer -> String -> Text -> Warning -> Doc
181warningToDoc (Localizer localizer) location source (Warning (A.A region wrn)) =
182 Report.toDoc location region (Warning.toReport localizer wrn) source
185warningToJson :: Localizer -> String -> Warning -> Json.Value
186warningToJson (Localizer localizer) location (Warning wrn) =
187 Warning.toJson localizer location wrn