git.iko.soy/elk
on master help sign in
Begin to consolidate Elm.Project.* into Elm.Outline and Elm.Details
f31fd4aEvan Czaplicki
builder/src/Elm/Details.hsnew file+104
compare with master
unifiedsplit
@@ -0,0 +1,104 @@
1+{-# OPTIONS_GHC -Wall #-}
2+module Elm.Details
3+ ( Details(..)
4+ , ValidOutline(..)
5+ , Local(..)
6+ , Foreign(..)
7+ )
8+ where
9+
10+
11+import Control.Concurrent (forkIO)
12+import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, readMVar)
13+import Control.Monad (liftM, liftM2, liftM3, liftM4)
14+import Data.Binary (Binary, get, put, getWord8, putWord8)
15+import qualified Data.Map as Map
16+import qualified Data.Map.Merge.Strict as Map
17+import qualified Data.Set as Set
18+import qualified Data.Utf8 as Utf8
19+import System.Directory (doesDirectoryExist)
20+import System.FilePath ((</>))
21+
22+import qualified Deps.Registry as Registry
23+import qualified Deps.Solver as Solver
24+import qualified Elm.Constraint as Con
25+import qualified Elm.Interface as I
26+import qualified Elm.ModuleName as ModuleName
27+import qualified Elm.Outline as Outline
28+import qualified Elm.Package as Pkg
29+import qualified Elm.Version as V
30+import qualified File
31+import qualified Http
32+import qualified Json.Decode as D
33+import qualified Reporting.Exit as Exit
34+import qualified Reporting.Progress as Progress
35+import qualified Reporting.Task as Task
36+import qualified Stuff
37+
38+
39+
40+-- DETAILS
41+
42+
43+data Details =
44+ Details
45+ { _outlineTime :: File.Time
46+ , _outline :: ValidOutline
47+ , _locals :: Map.Map ModuleName.Raw Local
48+ , _foreigns :: Map.Map ModuleName.Raw Foreign
49+ }
50+
51+
52+data ValidOutline
53+ = ValidApp Outline.AppOutline
54+ | ValidPkg Outline.PkgOutline (Map.Map Pkg.Name V.Version)
55+
56+
57+data Local =
58+ Local
59+ { _path :: FilePath
60+ , _time :: File.Time
61+ , _deps :: [ModuleName.Raw]
62+ }
63+
64+
65+data Foreign =
66+ Foreign Pkg.Name [Pkg.Name]
67+
68+
69+
70+-- BINARY
71+
72+
73+instance Binary Details where
74+ get = liftM4 Details get get get get
75+ put (Details a b c d) = put a >> put b >> put c >> put d
76+
77+
78+instance Binary ValidOutline where
79+ put outline =
80+ case outline of
81+ ValidApp a -> putWord8 0 >> put a
82+ ValidPkg a b -> putWord8 1 >> put a >> put b
83+
84+ get =
85+ do n <- getWord8
86+ case n of
87+ 0 -> liftM ValidApp get
88+ 1 -> liftM2 ValidPkg get get
89+ _ -> error "binary encoding of ValidOutline was corrupted"
90+
91+
92+instance Binary Local where
93+ get = liftM3 Local get get get
94+ put (Local a b c) = put a >> put b >> put c
95+
96+
97+instance Binary Foreign where
98+ get = liftM2 Foreign get get
99+ put (Foreign a b) = put a >> put b
100+
101+
102+instance Binary Artifacts where
103+ get = liftM3 Artifacts get get get
104+ put (Artifacts a b c) = put a >> put b >> put c
builder/src/Elm/Project/Json.hs → builder/src/Elm/Outline.hsrenamed+133−121
@@ -1,27 +1,25 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3−module Elm.Project.Json
3+module Elm.Outline
4− ( Project(..)
4+ ( Outline(..)
5− , AppInfo(..)
5+ , AppOutline(..)
6− , PkgInfo(..)
6+ , PkgOutline(..)
7 , Exposed(..)
7 , Exposed(..)
8− , defaultSummary
8+ , read
9− -- json
10 , write
9 , write
11 , encode
10 , encode
12− , read
11+ , decoder
13− , pkgDecoder
12+ , defaultSummary
14− -- queries
15 , isPlatformPackage
13 , isPlatformPackage
16 , getName
14 , getName
17 , getExposed
15 , getExposed
18− , check
19 )
16 )
20 where
17 where
21
18
22
19
23import Prelude hiding (read)
20import Prelude hiding (read)
24−import Control.Monad.Trans (liftIO)
21+import Control.Monad (filterM, liftM)
22+import Data.Binary (Binary, get, put, getWord8, putWord8)
25import Data.Foldable (traverse_)
23import Data.Foldable (traverse_)
26import qualified Data.Map as Map
24import qualified Data.Map as Map
27import qualified Data.Utf8 as Utf8
25import qualified Data.Utf8 as Utf8
@@ -37,39 +35,30 @@ import qualified Json.Decode as D
37import qualified Json.Encode as E
35import qualified Json.Encode as E
38import qualified Reporting.Exit as Exit
36import qualified Reporting.Exit as Exit
39import qualified Reporting.Exit.Assets as E
37import qualified Reporting.Exit.Assets as E
40−import qualified Reporting.Task as Task
41−
42−
43−
44−-- PROJECT
45
38
46
39
47−data Project
48− = App AppInfo
49− | Pkg PkgInfo
50
40
41+-- OUTLINE
51
42
52
43
53−-- APPLICATION
44+data Outline
45+ = App AppOutline
46+ | Pkg PkgOutline
54
47
55
48
56−data AppInfo =
49+data AppOutline =
57− AppInfo
50+ AppOutline
58 { _app_elm_version :: V.Version
51 { _app_elm_version :: V.Version
59 , _app_source_dirs :: [FilePath]
52 , _app_source_dirs :: [FilePath]
60 , _app_deps_direct :: Map.Map Pkg.Name V.Version
53 , _app_deps_direct :: Map.Map Pkg.Name V.Version
61− , _app_deps_trans :: Map.Map Pkg.Name V.Version
54+ , _app_deps_indirect :: Map.Map Pkg.Name V.Version
62 , _app_test_direct :: Map.Map Pkg.Name V.Version
55 , _app_test_direct :: Map.Map Pkg.Name V.Version
63− , _app_test_trans :: Map.Map Pkg.Name V.Version
56+ , _app_test_indirect :: Map.Map Pkg.Name V.Version
64 }
57 }
65
58
66
59
67−
60+data PkgOutline =
68−-- PACKAGE
61+ PkgOutline
69−
70−
71−data PkgInfo =
72− PkgInfo
73 { _pkg_name :: Pkg.Name
62 { _pkg_name :: Pkg.Name
74 , _pkg_summary :: Utf8.String
63 , _pkg_summary :: Utf8.String
75 , _pkg_license :: Licenses.License
64 , _pkg_license :: Licenses.License
@@ -99,76 +88,54 @@ defaultSummary =
99-- QUERIES
88-- QUERIES
100
89
101
90
102−isPlatformPackage :: Project -> Bool
91+isPlatformPackage :: Outline -> Bool
103−isPlatformPackage project =
92+isPlatformPackage outline =
104− case project of
93+ case outline of
105 App _ ->
94 App _ ->
106 False
95 False
107
96
108− Pkg info ->
97+ Pkg pkgOutline ->
109− let
98+ let author = Pkg._author (_pkg_name pkgOutline) in
110− (Pkg.Name author _) =
111− _pkg_name info
112− in
113 author == "elm" || author == "elm-explorations"
99 author == "elm" || author == "elm-explorations"
114
100
115
101
116−getName :: Project -> Pkg.Name
102+getName :: Outline -> Pkg.Name
117−getName project =
103+getName outline =
118− case project of
104+ case outline of
119 App _ ->
105 App _ ->
120 Pkg.dummyName
106 Pkg.dummyName
121
107
122− Pkg info ->
123− _pkg_name info
124−
125−
126−getExposed :: PkgInfo -> [ModuleName.Raw]
127−getExposed info =
128− case _pkg_exposed info of
129− ExposedList modules ->
130− modules
131−
132− ExposedDict chunks ->
133− concatMap snd chunks
134−
135−
136−check :: Project -> Task.Task ()
137−check project =
138− case project of
139− Pkg (PkgInfo name _ _ _ _ deps _ _) ->
108+ Pkg (PkgOutline name _ _ _ _ _ _ _) ->
140− if name == Pkg.core || Map.member Pkg.core deps
109+ name
141− then return ()
142− else throwBadJson E.NoPkgCore
143
110
144− App (AppInfo _ _ direct indirect _ _) ->
145− if Map.member Pkg.core direct then
146
111
147− if Map.member Pkg.json direct || Map.member Pkg.json indirect
112+getExposed :: PkgOutline -> [ModuleName.Raw]
148− then return ()
113+getExposed (PkgOutline _ _ _ _ exposed _ _ _) =
149− else throwBadJson E.NoAppJson
114+ case exposed of
115+ ExposedList names ->
116+ names
150
117
151− else
118+ ExposedDict sections ->
152− throwBadJson E.NoAppCore
119+ concatMap snd sections
153
120
154
121
155
122
156-- WRITE
123-- WRITE
157
124
158
125
159−write :: FilePath -> Project -> IO ()
126+write :: FilePath -> Outline -> IO ()
160−write root project =
127+write root outline =
161− E.write (root </> "elm.json") (encode project)
128+ E.write (root </> "elm.json") (encode outline)
162
129
163
130
164
131
165-- JSON ENCODE
132-- JSON ENCODE
166
133
167
134
168−encode :: Project -> E.Value
135+encode :: Outline -> E.Value
169−encode project =
136+encode outline =
170− case project of
137+ case outline of
171− App (AppInfo elm srcDirs depsDirect depsTrans testDirect testTrans) ->
138+ App (AppOutline elm srcDirs depsDirect depsTrans testDirect testTrans) ->
172 E.object
139 E.object
173 [ "type" ==> E.string "application"
140 [ "type" ==> E.string "application"
174 , "source-directories" ==> E.list (E.string . Utf8.fromChars) srcDirs
141 , "source-directories" ==> E.list (E.string . Utf8.fromChars) srcDirs
@@ -185,10 +152,10 @@ encode project =
185 ]
152 ]
186 ]
153 ]
187
154
188− Pkg (PkgInfo name summary license version exposed deps tests elm) ->
155+ Pkg (PkgOutline name summary license version exposed deps tests elm) ->
189 E.object
156 E.object
190 [ "type" ==> E.string "package"
157 [ "type" ==> E.string "package"
191− , "name" ==> E.string (Pkg.toString name)
158+ , "name" ==> Pkg.encode name
192 , "summary" ==> E.string summary
159 , "summary" ==> E.string summary
193 , "license" ==> Licenses.encode license
160 , "license" ==> Licenses.encode license
194 , "version" ==> V.encode version
161 , "version" ==> V.encode version
@@ -228,34 +195,28 @@ encodeDeps encodeValue deps =
228-- PARSE AND VERIFY
195-- PARSE AND VERIFY
229
196
230
197
231−read :: FilePath -> Task.Task Project
198+read :: FilePath -> IO (Either Exit.OutlineProblem Outline)
232−read path =
199+read root =
233− do result <- liftIO $ D.fromFile decoder path
200+ do result <- D.fromFile decoder (root </> "elm.json")
234 case result of
201 case result of
235− Right project ->
236− case project of
237− Pkg _ ->
238− do return project
239−
240− App (AppInfo _ srcDirs _ _ _ _) ->
241− do mapM_ doesDirectoryExist srcDirs
242− return project
243−
244 Left err ->
202 Left err ->
245− throwBadJson (error "TODO bad json" err)
203+ return $ Left (Exit.BadOutlineStructure err)
246
204
205+ Right outline ->
206+ case outline of
207+ Pkg _ ->
208+ return $ Right outline
247
209
248−throwBadJson :: E.ElmJsonProblem -> Task.Task a
210+ App (AppOutline _ srcDirs _ _ _ _) ->
249−throwBadJson problem =
211+ do badDirs <- filterM (isBadSrcDir root) srcDirs
250− Task.throw (Exit.Assets (E.BadElmJson problem))
212+ case badDirs of
213+ [] -> return $ Right outline
214+ d:ds -> return $ Left (Exit.BadOutlineSrcDirs d ds)
251
215
252
216
253−doesDirectoryExist :: FilePath -> Task.Task ()
217+isBadSrcDir :: FilePath -> FilePath -> IO Bool
254−doesDirectoryExist dir =
218+isBadSrcDir root dir =
255− do exists <- liftIO $ Dir.doesDirectoryExist dir
219+ not <$> Dir.doesDirectoryExist (root </> dir)
256− if exists
257− then return ()
258− else throwBadJson (E.BadSrcDir dir)
259
220
260
221
261
222
@@ -266,7 +227,7 @@ type Decoder a =
266 D.Decoder E.BadElmJsonContent a
227 D.Decoder E.BadElmJsonContent a
267
228
268
229
269−decoder :: Decoder Project
230+decoder :: Decoder Outline
270decoder =
231decoder =
271 do tipe <- D.field "type" D.string
232 do tipe <- D.field "type" D.string
272 case tipe of
233 case tipe of
@@ -280,9 +241,9 @@ decoder =
280 D.failure (E.BadType other)
241 D.failure (E.BadType other)
281
242
282
243
283−appDecoder :: Decoder AppInfo
244+appDecoder :: Decoder AppOutline
284appDecoder =
245appDecoder =
285− AppInfo
246+ AppOutline
286 <$> D.field "elm-version" versionDecoder
247 <$> D.field "elm-version" versionDecoder
287 <*> D.field "source-directories" (D.list dirDecoder)
248 <*> D.field "source-directories" (D.list dirDecoder)
288 <*> D.field "dependencies" (D.field "direct" (depsDecoder versionDecoder))
249 <*> D.field "dependencies" (D.field "direct" (depsDecoder versionDecoder))
@@ -291,12 +252,12 @@ appDecoder =
291 <*> D.field "test-dependencies" (D.field "indirect" (depsDecoder versionDecoder))
252 <*> D.field "test-dependencies" (D.field "indirect" (depsDecoder versionDecoder))
292
253
293
254
294−pkgDecoder :: Decoder PkgInfo
255+pkgDecoder :: Decoder PkgOutline
295pkgDecoder =
256pkgDecoder =
296− PkgInfo
257+ PkgOutline
297− <$> D.field "name" pkgNameDecoder
258+ <$> D.field "name" (D.mapError E.BadPkgName Pkg.decoder)
298 <*> D.field "summary" summaryDecoder
259 <*> D.field "summary" summaryDecoder
299− <*> D.field "license" licenseDecoder
260+ <*> D.field "license" (Licenses.decoder E.BadLicense)
300 <*> D.field "version" versionDecoder
261 <*> D.field "version" versionDecoder
301 <*> D.field "exposed-modules" exposedDecoder
262 <*> D.field "exposed-modules" exposedDecoder
302 <*> D.field "dependencies" (depsDecoder constraintDecoder)
263 <*> D.field "dependencies" (depsDecoder constraintDecoder)
@@ -308,11 +269,6 @@ pkgDecoder =
308-- JSON DECODE HELPERS
269-- JSON DECODE HELPERS
309
270
310
271
311−pkgNameDecoder :: Decoder Pkg.Name
312−pkgNameDecoder =
313− D.mapError E.BadPkgName Pkg.decoder
314−
315−
316summaryDecoder :: Decoder Utf8.String
272summaryDecoder :: Decoder Utf8.String
317summaryDecoder =
273summaryDecoder =
318 do summary <- D.string
274 do summary <- D.string
@@ -321,11 +277,6 @@ summaryDecoder =
321 else D.failure E.BadSummaryTooLong
277 else D.failure E.BadSummaryTooLong
322
278
323
279
324−licenseDecoder :: Decoder Licenses.License
325−licenseDecoder =
326− Licenses.decoder E.BadLicense
327−
328−
329versionDecoder :: Decoder V.Version
280versionDecoder :: Decoder V.Version
330versionDecoder =
281versionDecoder =
331 D.mapError E.BadVersion V.decoder
282 D.mapError E.BadVersion V.decoder
@@ -379,7 +330,68 @@ moduleDecoder =
379
330
380checkHeader :: Utf8.String -> Decoder ()
331checkHeader :: Utf8.String -> Decoder ()
381checkHeader header =
332checkHeader header =
382− if Utf8.size header < 20 then
333+ if Utf8.size header < 20
383− return ()
334+ then return ()
384− else
385− D.failure (E.BadModuleHeaderTooLong header)
335+ else D.failure (E.BadModuleHeaderTooLong header)
336+
337+
338+
339+-- BINARY
340+
341+
342+instance Binary Outline where
343+ put outline =
344+ case outline of
345+ App a -> putWord8 0 >> put a
346+ Pkg a -> putWord8 1 >> put a
347+
348+ get =
349+ do n <- getWord8
350+ case n of
351+ 0 -> liftM App get
352+ 1 -> liftM Pkg get
353+ _ -> error "binary encoding of Outline was corrupted"
354+
355+
356+instance Binary AppOutline where
357+ put (AppOutline a b c d e f) =
358+ put a >> put b >> put c >> put d >> put e >> put f
359+
360+ get =
361+ do a <- get
362+ b <- get
363+ c <- get
364+ d <- get
365+ e <- get
366+ f <- get
367+ return (AppOutline a b c d e f)
368+
369+
370+instance Binary PkgOutline where
371+ put (PkgOutline a b c d e f g h) =
372+ put a >> put b >> put c >> put d >> put e >> put f >> put g >> put h
373+
374+ get =
375+ do a <- get
376+ b <- get
377+ c <- get
378+ d <- get
379+ e <- get
380+ f <- get
381+ g <- get
382+ h <- get
383+ return (PkgOutline a b c d e f g h)
384+
385+
386+instance Binary Exposed where
387+ put exposed =
388+ case exposed of
389+ ExposedList a -> putWord8 0 >> put a
390+ ExposedDict a -> putWord8 1 >> put a
391+
392+ get =
393+ do n <- getWord8
394+ case n of
395+ 0 -> liftM ExposedList get
396+ 1 -> liftM ExposedDict get
397+ _ -> error "binary encoding of ProjectDeps was corrupted"
builder/src/Elm/Project.hsdeleted−80
@@ -1,80 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−module Elm.Project
4− ( getRoot
5− , getRootWithReplFallback
6− , compile
7− , compileForRepl
8− )
9− where
10−
11−
12−import qualified Data.ByteString as BS
13−import Data.Map ((!))
14−import qualified Data.Name as Name
15−
16−import qualified Elm.Compiler as Compiler
17−import qualified Elm.Project.Json as Project
18−import qualified Elm.Project.Root as Root
19−import qualified Elm.Project.Summary as Summary
20−import Elm.Project.Summary (Summary)
21−import qualified File.Args as Args
22−import qualified File.Compile as Compile
23−import qualified File.Crawl as Crawl
24−import qualified File.Plan as Plan
25−import qualified Generate.Artifacts as Artifacts
26−import qualified Generate.Output as Output
27−import qualified Reporting.Render.Type.Localizer as L
28−import qualified Reporting.Task as Task
29−
30−
31−
32−-- GET ROOT
33−
34−
35−getRoot :: Task.Task Summary
36−getRoot =
37− Root.get
38−
39−
40−getRootWithReplFallback :: IO FilePath
41−getRootWithReplFallback =
42− Root.getWithReplFallback
43−
44−
45−
46−-- COMPILE
47−
48−
49−compile
50− :: Output.Mode
51− -> Output.Target
52− -> Maybe Output.Output
53− -> Summary
54− -> [FilePath]
55− -> Task.Task ()
56−compile mode target maybeOutput summary@(Summary.Summary root project _ _ _) paths =
57− do Project.check project
58− args <- Args.fromPaths summary paths
59− graph <- Crawl.crawl summary args
60− (dirty, ifaces) <- Plan.plan summary graph
61− answers <- Compile.compile project ifaces dirty
62− results <- Artifacts.write root answers
63− -- _ <- traverse (Artifacts.writeDocs results) docs
64− Output.generate mode target maybeOutput summary graph results
65−
66−
67−
68−-- COMPILE FOR REPL
69−
70−
71−compileForRepl :: Bool -> L.Localizer -> BS.ByteString -> Maybe Name.Name -> Task.Task (Maybe FilePath)
72−compileForRepl noColors localizer source maybeName =
73− do summary@(Summary.Summary root project _ _ _) <- getRoot
74− Project.check project
75− graph <- Crawl.crawlFromSource summary source
76− (dirty, ifaces) <- Plan.plan summary graph
77− answers <- Compile.compile project ifaces dirty
78− results <- Artifacts.write root answers
79− let (Compiler.Artifacts elmi _) = results ! Name.replModule
80− traverse (Output.generateReplFile noColors localizer summary graph elmi) maybeName
builder/src/Elm/Project/Root.hsdeleted−95
@@ -1,95 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−module Elm.Project.Root
3− ( get
4− , unsafeGet
5− , getWithReplFallback
6− )
7− where
8−
9−
10−import Control.Monad.Trans (liftIO)
11−import qualified Data.Map as Map
12−import qualified System.Directory as Dir
13−import System.FilePath ((</>))
14−
15−import qualified Elm.Constraint as Con
16−import qualified Elm.Licenses as Licenses
17−import qualified Elm.Package as Pkg
18−import qualified Elm.Project.Json as Project
19−import qualified Elm.Project.Summary as Summary
20−import qualified Elm.PerUserCache as PerUserCache
21−import qualified Elm.Version as V
22−import qualified File.IO as IO
23−import qualified Reporting.Exit as Exit
24−import qualified Reporting.Task as Task
25−import qualified Stuff.Verify as Verify
26−import qualified Json.Encode as Encode
27−
28−
29−
30−-- GET
31−
32−
33−get :: Task.Task Summary.Summary
34−get =
35− do root <- moveToRoot
36− project <- Project.read "elm.json"
37− Verify.verify root project
38−
39−
40−unsafeGet :: Task.Task (FilePath, Project.Project)
41−unsafeGet =
42− (,) <$> moveToRoot <*> Project.read "elm.json"
43−
44−
45−
46−-- MOVE TO ROOT
47−
48−
49−moveToRoot :: Task.Task FilePath
50−moveToRoot =
51− do maybeRoot <- liftIO $ IO.find "elm.json"
52− case maybeRoot of
53− Just root ->
54− do liftIO $ Dir.setCurrentDirectory root
55− return root
56−
57− Nothing ->
58− Task.throw Exit.NoElmJson
59−
60−
61−
62−-- GET WITH FALLBACK
63−
64−
65−getWithReplFallback :: IO FilePath
66−getWithReplFallback =
67− do maybeRoot <- IO.find "elm.json"
68−
69− case maybeRoot of
70− Just root ->
71− do Dir.setCurrentDirectory root
72− return root
73−
74− Nothing ->
75− do cache <- PerUserCache.getReplRoot
76− let root = cache </> "tmp"
77− Dir.createDirectoryIfMissing True root
78− Dir.setCurrentDirectory root
79− IO.removeDir "elm-stuff"
80− Encode.write "elm.json" (Project.encode (Project.Pkg replInfo))
81− return root
82−
83−
84−replInfo :: Project.PkgInfo
85−replInfo =
86− Project.PkgInfo
87− { Project._pkg_name = Pkg.dummyName
88− , Project._pkg_summary = "dummy code for the REPL"
89− , Project._pkg_license = Licenses.bsd3
90− , Project._pkg_version = V.one
91− , Project._pkg_exposed = Project.ExposedList []
92− , Project._pkg_deps = Map.singleton Pkg.core Con.anything
93− , Project._pkg_test_deps = Map.empty
94− , Project._pkg_elm_version = Con.defaultElm
95− }
builder/src/Elm/Project/Summary.hsdeleted−108
@@ -1,108 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−module Elm.Project.Summary
3− ( Summary(..)
4− , ExposedModules
5− , DepsGraph
6− , init
7− , cheapInit
8− )
9− where
10−
11−
12−import Prelude hiding (init)
13−import qualified Data.List as List
14−import qualified Data.Map as Map
15−
16−import qualified Elm.Interface as I
17−import qualified Elm.ModuleName as ModuleName
18−import qualified Elm.Package as Pkg
19−import qualified Elm.Version as V
20−import Elm.Project.Json (Project(..), AppInfo(..), PkgInfo(..))
21−import qualified Elm.Project.Json as Project
22−
23−
24−
25−-- SUMMARY
26−
27−
28−data Summary =
29− Summary
30− { _root :: FilePath
31− , _project :: Project
32− , _exposed :: ExposedModules
33− , _ifaces :: I.Interfaces
34− , _depsGraph :: DepsGraph
35− }
36−
37−
38−type ExposedModules =
39− Map.Map ModuleName.Raw [Pkg.Canonical]
40−
41−
42−type DepsGraph =
43− Map.Map Pkg.Name ( V.Version, [Pkg.Name] )
44−
45−
46−
47−-- MAKE SUMMARY
48−
49−
50−init :: FilePath -> Project -> Map.Map Pkg.Name PkgInfo -> I.Interfaces -> Summary
51−init root project deps ifaces =
52− let
53− exposed =
54− case project of
55− Project.App info ->
56− getExposed deps (_app_deps_direct info)
57−
58− Project.Pkg info ->
59− getExposed deps (_pkg_deps info)
60−
61− privatizedInterfaces =
62− Map.mapMaybeWithKey (privatize exposed) ifaces
63−
64− depsGraph =
65− Map.foldr toNode Map.empty deps
66− in
67− Summary root project exposed privatizedInterfaces depsGraph
68−
69−
70−privatize :: ExposedModules -> ModuleName.Canonical -> I.Interface -> Maybe I.Interface
71−privatize exposed (ModuleName.Canonical _ name) iface =
72− case Map.lookup name exposed of
73− Just [_] ->
74− Just iface
75−
76− _ ->
77− Nothing
78−
79−
80−toNode :: PkgInfo -> DepsGraph -> DepsGraph
81−toNode (PkgInfo name _ _ version _ deps _ _) graph =
82− Map.insert name (version, Map.keys deps) graph
83−
84−
85−
86−-- MAKE CHEAP SUMMARY
87−
88−
89−cheapInit :: FilePath -> PkgInfo -> Map.Map Pkg.Name PkgInfo -> I.Interfaces -> Summary
90−cheapInit root info deps ifaces =
91− Summary root (Pkg info) (getExposed deps (_pkg_deps info)) ifaces Map.empty
92−
93−
94−getExposed :: Map.Map Pkg.Name PkgInfo -> Map.Map Pkg.Name a -> ExposedModules
95−getExposed deps directs =
96− Map.foldl insertExposed Map.empty (Map.intersection deps directs)
97−
98−
99−insertExposed :: ExposedModules -> PkgInfo -> ExposedModules
100−insertExposed exposed info =
101− let
102− home =
103− Pkg.Canonical (_pkg_name info) (_pkg_version info)
104−
105− insertModule dict modul =
106− Map.insertWith (++) modul [home] dict
107− in
108− List.foldl' insertModule exposed (Project.getExposed info)