on cadeba6 help sign in
elk/src/Elm/Compiler.hs
181 lines 4.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Elm.Compiler
3 ( version
4 , parseDependencies
5 , compile, Context(..), Result(..)
6 , Dealiaser, dummyDealiaser
7 , Error, errorToString, errorToJson, printError
8 , Warning, warningToString, warningToJson, printWarning
9 ) where
11import qualified Data.Aeson as Json
12import qualified Data.Map as Map
14import qualified AST.Module as Module
15import qualified Compile
16import qualified Docs.Check as Docs
17import qualified Elm.Compiler.Version
18import qualified Elm.Compiler.Module as PublicModule
19import qualified Elm.Docs as Docs
20import qualified Elm.Package as Package
21import qualified Generate.JavaScript as JS
22import qualified Optimize
23import qualified Parse.Module as Parse
24import qualified Parse.Parse as Parse
25import qualified Reporting.Annotation as A
26import qualified Reporting.Error as Error
27import qualified Reporting.PrettyPrint as P
28import qualified Reporting.Result as Result
29import qualified Reporting.Warning as Warning
32-- VERSION
34version :: Package.Version
35version =
36 Elm.Compiler.Version.version
39-- DEPENDENCIES
41parseDependencies
42 :: String
43 -> Either [Error] (PublicModule.Name, [PublicModule.Name])
44parseDependencies sourceCode =
45 let
46 (Result.Result _warnings rawResult) =
47 Parse.parse sourceCode Parse.header
48 in
49 case rawResult of
50 Result.Err msgs ->
51 Left $ map (Error . A.map Error.Syntax) msgs
53 Result.Ok (Module.Header names _docs _exports imports) ->
54 Right
55 ( PublicModule.Name names
56 , map (PublicModule.Name . fst . A.drop) imports
57 )
60-- COMPILATION
62{-| Compiles Elm source code to JavaScript. -}
63compile
64 :: Context
65 -> String
66 -> Map.Map PublicModule.CanonicalName PublicModule.Interface
67 -> (Dealiaser, [Warning], Either [Error] Result)
69compile context source interfaces =
70 let
71 (Context packageName isRoot isExposed modulePackages) =
72 context
74 unwrappedInterfaces =
75 Map.mapKeysMonotonic PublicModule.fromCanonicalName interfaces
77 unwrappedPackages =
78 Map.mapKeysMonotonic (\(PublicModule.Name strs) -> strs ) modulePackages
80 (Result.Result (dealiaser, warnings) rawResult) =
81 do modul <- Compile.compile unwrappedPackages packageName isRoot unwrappedInterfaces source
82 docs <- docsGen isExposed modul
84 let interface = Module.toInterface packageName modul
85 let optModule = Optimize.optimize modul
86 let javascript = JS.generate optModule
88 return (Result docs interface javascript)
89 in
90 ( maybe dummyDealiaser Dealiaser dealiaser
91 , map Warning warnings
92 , Result.destruct (Left . map Error) Right rawResult
93 )
96data Context = Context
97 { _packageName :: Package.Name
98 , _isRoot :: Bool
99 , _isExposed :: Bool
100 , _modulePackages :: Map.Map PublicModule.Name Package.Name
101 }
104data Result = Result
105 { _docs :: Maybe Docs.Documentation
106 , _interface :: PublicModule.Interface
107 , _js :: String
108 }
111docsGen
112 :: Bool
113 -> Module.CanonicalModule
114 -> Result.Result w Error.Error (Maybe Docs.Documentation)
115docsGen isExposed modul =
116 if not isExposed then
117 Result.ok Nothing
118 else
119 let
120 getChecked =
121 Docs.check (Module.exports modul) (Module.docs modul)
123 toDocs checked =
124 Docs.fromCheckedDocs (PublicModule.Name (Module.names modul)) checked
125 in
126 (Just . toDocs) `fmap` Result.mapError Error.Docs getChecked
129-- DEALIASER
131newtype Dealiaser =
132 Dealiaser P.Dealiaser
135dummyDealiaser :: Dealiaser
136dummyDealiaser =
137 Dealiaser Map.empty
140-- ERRORS
142newtype Error =
143 Error (A.Located Error.Error)
146errorToString :: Dealiaser -> String -> String -> Error -> String
147errorToString (Dealiaser dealiaser) location source (Error err) =
148 Error.toString dealiaser location source err
151printError :: Dealiaser -> String -> String -> Error -> IO ()
152printError (Dealiaser dealiaser) location source (Error err) =
153 Error.print dealiaser location source err
156errorToJson :: Dealiaser -> String -> Error -> Json.Value
157errorToJson (Dealiaser dealiaser) location (Error err) =
158 Error.toJson dealiaser location err
161-- WARNINGS
163newtype Warning =
164 Warning (A.Located Warning.Warning)
167warningToString :: Dealiaser -> String -> String -> Warning -> String
168warningToString (Dealiaser dealiaser) location source (Warning err) =
169 Warning.toString dealiaser location source err
172printWarning :: Dealiaser -> String -> String -> Warning -> IO ()
173printWarning (Dealiaser dealiaser) location source (Warning err) =
174 Warning.print dealiaser location source err
177warningToJson :: Dealiaser -> String -> Warning -> Json.Value
178warningToJson (Dealiaser dealiaser) location (Warning err) =
179 Warning.toJson dealiaser location err