git.iko.soy/elk
on 357b7e4 help sign in
elk/src/Elm/Compiler.hs
188 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 =
122 Result
123 { _docs :: Maybe Docs.Documentation
124 , _iface :: M.Interface
125 , _js :: LazyText.Text
126 }
129docsGen :: Bool -> Module.Optimized -> Result.Result () w Error.Error (Maybe Docs.Documentation)
130docsGen isExposed (Module.Module name info) =
131 if not isExposed then
132 Result.ok Nothing
134 else
135 let
136 toDocs checked =
137 Just (Docs.fromCheckedDocs (ModuleName._module name) checked)
138 in
139 toDocs <$> Docs.check (Module.exports info) (Module.docs info)
143-- DEALIASER
146newtype Localizer =
147 Localizer RenderType.Localizer
150dummyLocalizer :: Localizer
151dummyLocalizer =
152 Localizer Map.empty
156-- ERRORS
159newtype Error =
160 Error (A.Located Error.Error)
163errorToDoc :: Localizer -> String -> Text -> Error -> Doc
164errorToDoc (Localizer localizer) location source (Error (A.A region err)) =
165 Report.toDoc location region (Error.toReport localizer err) source
168errorToJson :: Localizer -> String -> Error -> Json.Value
169errorToJson (Localizer localizer) location (Error err) =
170 Error.toJson localizer location err
174-- WARNINGS
177newtype Warning =
178 Warning (A.Located Warning.Warning)
181warningToDoc :: Localizer -> String -> Text -> Warning -> Doc
182warningToDoc (Localizer localizer) location source (Warning (A.A region wrn)) =
183 Report.toDoc location region (Warning.toReport localizer wrn) source
186warningToJson :: Localizer -> String -> Warning -> Json.Value
187warningToJson (Localizer localizer) location (Warning wrn) =
188 Warning.toJson localizer location wrn