on 833ed96 help sign in
elk/src/Compile.hs
127 lines 2.9 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2module Compile
3 ( DocsFlag(..)
4 , compile
5 , Artifacts(..)
6 )
7 where
10import qualified Data.ByteString as BS
11import qualified Data.Map as Map
13import qualified AST.Canonical as Can
14import qualified AST.Optimized as Opt
15import qualified AST.Module.Name as ModuleName
16import qualified Canonicalize.Module as Canonicalize
17import qualified Elm.Docs as Docs
18import qualified Elm.Interface as I
19import qualified Elm.Name as N
20import qualified Elm.Package as Pkg
21import qualified Nitpick.PatternMatches as PatternMatches
22import qualified Nitpick.TopLevelTypes as TopLevelTypes
23import qualified Optimize.Module as Optimize
24import qualified Parse.Parse as Parse
25import qualified Reporting.Error as Error
26import qualified Reporting.Result as Result
27import qualified Reporting.Warning as Warning
28import qualified Type.Constrain.Module as Type
29import qualified Type.Solve as Type
31import System.IO.Unsafe (unsafePerformIO)
35-- COMPILE
38type Result i a =
39 Result.Result i [Warning.Warning] Error.Error a
42type ImportDict =
43 Map.Map N.Name ModuleName.Canonical
46data Artifacts =
47 Artifacts
48 { _elmi :: I.Interface
49 , _elmo :: Opt.Graph
50 , _docs :: Maybe Docs.Module
51 }
54compile :: DocsFlag -> Pkg.Name -> ImportDict -> I.Interfaces -> BS.ByteString -> Result i Artifacts
55compile flag pkg importDict interfaces source =
56 do
57 valid <- Result.mapError Error.Syntax $
58 Parse.program pkg source
60 canonical <- Result.mapError Error.Canonicalize $
61 Canonicalize.canonicalize pkg importDict interfaces valid
63 annotations <-
64 runTypeInference canonical
66 mains <- Result.mapError Error.Main $
67 TopLevelTypes.check annotations canonical
69 () <-
70 exhaustivenessCheck canonical
72 let (Optimize.Graph fields graph) = Optimize.optimize canonical
74 documentation <-
75 genaretaDocs flag canonical
77 Result.ok $
78 Artifacts
79 { _elmi = I.fromModule annotations canonical
80 , _elmo = Opt.Graph mains graph fields
81 , _docs = documentation
82 }
86-- TYPE INFERENCE
89runTypeInference :: Can.Module -> Result i (Map.Map N.Name Can.Annotation)
90runTypeInference canonical =
91 case unsafePerformIO (Type.run =<< Type.constrain canonical) of
92 Left errors ->
93 Result.throw (Error.Type errors)
95 Right annotations ->
96 Result.ok annotations
100-- EXHAUSTIVENESS CHECK
103exhaustivenessCheck :: Can.Module -> Result i ()
104exhaustivenessCheck canonical =
105 case PatternMatches.check canonical of
106 Left errors ->
107 Result.throw (Error.Pattern errors)
109 Right () ->
110 Result.ok ()
114-- DOCUMENTATION
117data DocsFlag = YesDocs | NoDocs
120genaretaDocs :: DocsFlag -> Can.Module -> Result.Result i w Error.Error (Maybe Docs.Module)
121genaretaDocs flag modul =
122 case flag of
123 NoDocs ->
124 Result.ok Nothing
126 YesDocs ->
127 Just <$> Docs.fromModule modul