git.iko.soy/elk
on d88abc7 help sign in
elk/compiler/src/Compile.hs
130 lines 3.1 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
12import qualified Data.Time.Clock as Time
14import qualified AST.Canonical as Can
15import qualified AST.Optimized as Opt
16import qualified AST.Module.Name as ModuleName
17import qualified Canonicalize.Module as Canonicalize
18import qualified Elm.Docs as Docs
19import qualified Elm.Interface as I
20import qualified Elm.Name as N
21import qualified Elm.Package as Pkg
22import qualified Nitpick.PatternMatches as PatternMatches
23import qualified Optimize.Module as Optimize
24import qualified Parse.Parse as Parse
25import qualified Reporting.Error as Error
26import qualified Reporting.Render.Type.Localizer as L
27import qualified Reporting.Result as Result
28import qualified Reporting.Warning as Warning
29import qualified Type.Constrain.Module as Type
30import qualified Type.Solve as Type
32import System.IO.Unsafe (unsafePerformIO)
36-- COMPILE
39type Result i a =
40 Result.Result i [Warning.Warning] Error.Error a
43type ImportDict =
44 Map.Map N.Name ModuleName.Canonical
47data Artifacts =
48 Artifacts
49 { _time :: Time.UTCTime
50 , _elmi :: I.Interface
51 , _elmo :: Opt.Graph
52 , _docs :: Maybe Docs.Module
53 }
56compile :: DocsFlag -> Pkg.Name -> ImportDict -> I.Interfaces -> Time.UTCTime -> BS.ByteString -> Result i Artifacts
57compile flag pkg importDict interfaces time source =
58 do
59 valid <- Result.mapError Error.Syntax $
60 Parse.program pkg source
62 canonical <- Result.mapError Error.Canonicalize $
63 Canonicalize.canonicalize pkg importDict interfaces valid
65 let localizer = L.fromModule valid -- TODO should this be strict for GC?
67 annotations <-
68 runTypeInference localizer canonical
70 () <-
71 exhaustivenessCheck canonical
73 graph <- Result.mapError (Error.Main localizer) $
74 Optimize.optimize annotations canonical
76 documentation <-
77 genarateDocs flag canonical
79 Result.ok $
80 Artifacts
81 { _time = time
82 , _elmi = I.fromModule annotations canonical
83 , _elmo = graph
84 , _docs = documentation
85 }
89-- TYPE INFERENCE
92runTypeInference :: L.Localizer -> Can.Module -> Result i (Map.Map N.Name Can.Annotation)
93runTypeInference localizer canonical =
94 case unsafePerformIO (Type.run =<< Type.constrain canonical) of
95 Right annotations ->
96 Result.ok annotations
98 Left errors ->
99 Result.throw (Error.Type localizer errors)
103-- EXHAUSTIVENESS CHECK
106exhaustivenessCheck :: Can.Module -> Result i ()
107exhaustivenessCheck canonical =
108 case PatternMatches.check canonical of
109 Left errors ->
110 Result.throw (Error.Pattern errors)
112 Right () ->
113 Result.ok ()
117-- DOCUMENTATION
120data DocsFlag = YesDocs | NoDocs
123genarateDocs :: DocsFlag -> Can.Module -> Result.Result i w Error.Error (Maybe Docs.Module)
124genarateDocs flag modul =
125 case flag of
126 NoDocs ->
127 Result.ok Nothing
129 YesDocs ->
130 Just <$> Docs.fromModule modul