git.iko.soy/elk
on d4cc828 help sign in
elk/src/Elm/Compiler.hs
197 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 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 :: Maybe Package.Name -> Text -> Either Error (Tag, M.Raw, [M.Raw])
59parseDependencies maybePkgName sourceCode =
60 case Parse.run Parse.header sourceCode of
61 Right header ->
62 Right $ getDeps maybePkgName header
64 Left err ->
65 Left (Error (A.map Error.Syntax err))
68getDeps :: Maybe Package.Name -> Module.Header [Module.UserImport] -> (Tag, M.Raw, [M.Raw])
69getDeps maybePkgName (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 maybePkgName == Just 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 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 { _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)
162errorToString :: Localizer -> String -> Text -> Error -> String
163errorToString (Localizer localizer) location source (Error (A.A region err)) =
164 Report.toString location region (Error.toReport localizer err) source
167printError :: Handle -> Localizer -> String -> Text -> Error -> IO ()
168printError handle (Localizer localizer) location source (Error (A.A region err)) =
169 Report.toHandle handle location region (Error.toReport localizer err) source
172errorToJson :: Localizer -> String -> Error -> Json.Value
173errorToJson (Localizer localizer) location (Error err) =
174 Error.toJson localizer location err
178-- WARNINGS
181newtype Warning =
182 Warning (A.Located Warning.Warning)
185warningToString :: Localizer -> String -> Text -> Warning -> String
186warningToString (Localizer localizer) location source (Warning (A.A region wrn)) =
187 Report.toString location region (Warning.toReport localizer wrn) source
190printWarning :: Handle -> Localizer -> String -> Text -> Warning -> IO ()
191printWarning handle (Localizer localizer) location source (Warning (A.A region wrn)) =
192 Report.toHandle handle location region (Warning.toReport localizer wrn) source
195warningToJson :: Localizer -> String -> Warning -> Json.Value
196warningToJson (Localizer localizer) location (Warning wrn) =
197 Warning.toJson localizer location wrn