git.iko.soy/elk
on 78cd7e7 help sign in
elk/compiler/src/Compile.hs
124 lines 2.8 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 Optimize.Module as Optimize
23import qualified Parse.Parse as Parse
24import qualified Reporting.Error as Error
25import qualified Reporting.Result as Result
26import qualified Reporting.Warning as Warning
27import qualified Type.Constrain.Module as Type
28import qualified Type.Solve as Type
30import System.IO.Unsafe (unsafePerformIO)
34-- COMPILE
37type Result i a =
38 Result.Result i [Warning.Warning] Error.Error a
41type ImportDict =
42 Map.Map N.Name ModuleName.Canonical
45data Artifacts =
46 Artifacts
47 { _elmi :: I.Interface
48 , _elmo :: Opt.Graph
49 , _docs :: Maybe Docs.Module
50 }
53compile :: DocsFlag -> Pkg.Name -> ImportDict -> I.Interfaces -> BS.ByteString -> Result i Artifacts
54compile flag pkg importDict interfaces source =
55 do
56 valid <- Result.mapError Error.Syntax $
57 Parse.program pkg source
59 canonical <- Result.mapError Error.Canonicalize $
60 Canonicalize.canonicalize pkg importDict interfaces valid
62 annotations <-
63 runTypeInference canonical
65 () <-
66 exhaustivenessCheck canonical
68 graph <- Result.mapError Error.Main $
69 Optimize.optimize annotations canonical
71 documentation <-
72 genarateDocs flag canonical
74 Result.ok $
75 Artifacts
76 { _elmi = I.fromModule annotations canonical
77 , _elmo = graph
78 , _docs = documentation
79 }
83-- TYPE INFERENCE
86runTypeInference :: Can.Module -> Result i (Map.Map N.Name Can.Annotation)
87runTypeInference canonical =
88 case unsafePerformIO (Type.run =<< Type.constrain canonical) of
89 Left errors ->
90 Result.throw (Error.Type errors)
92 Right annotations ->
93 Result.ok annotations
97-- EXHAUSTIVENESS CHECK
100exhaustivenessCheck :: Can.Module -> Result i ()
101exhaustivenessCheck canonical =
102 case PatternMatches.check canonical of
103 Left errors ->
104 Result.throw (Error.Pattern errors)
106 Right () ->
107 Result.ok ()
111-- DOCUMENTATION
114data DocsFlag = YesDocs | NoDocs
117genarateDocs :: DocsFlag -> Can.Module -> Result.Result i w Error.Error (Maybe Docs.Module)
118genarateDocs flag modul =
119 case flag of
120 NoDocs ->
121 Result.ok Nothing
123 YesDocs ->
124 Just <$> Docs.fromModule modul