@@ -13,7 +13,7 @@ module Elm.Details
1313
1414
1515import Control.Concurrent (forkIO)
16−import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, readMVar, takeMVar)
16+import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, readMVar, takeMVar)
1717import Control.Monad (liftM, liftM2, liftM4)
1818import Data.Binary (Binary, get, put, getWord8, putWord8)
1919import qualified Data.Map as Map
@@ -59,6 +59,7 @@ data Details =
5959 , _outline :: ValidOutline
6060 , _locals :: Map.Map ModuleName.Raw Local
6161 , _foreigns :: Map.Map ModuleName.Raw Foreign
62+ , _extras :: Extras
6263 }
6364
6465
@@ -80,22 +81,31 @@ data Foreign =
8081 Foreign Pkg.Name [Pkg.Name]
8182
8283
84+data Extras
85+ = ArtifactsCached
86+ | ArtifactsFresh Interfaces Opt.GlobalGraph
87+
88+
89+type Interfaces =
90+ Map.Map ModuleName.Canonical I.DependencyInterface
91+
92+
8393
8494-- LOAD
8595
8696
8797loadObjects :: FilePath -> Details -> IO (MVar (Maybe Opt.GlobalGraph))
88−loadObjects root _ =
89− fork (File.readBinary (Stuff.objects root))
98+loadObjects root (Details _ _ _ _ extras) =
99+ case extras of
100+ ArtifactsFresh _ o -> newMVar (Just o)
101+ ArtifactsCached -> fork (File.readBinary (Stuff.objects root))
90102
91103
92104loadInterfaces :: FilePath -> Details -> IO (MVar (Maybe Interfaces))
93−loadInterfaces root _ =
94− fork (File.readBinary (Stuff.interfaces root))
95−
96−
97−type Interfaces =
98− Map.Map ModuleName.Canonical I.DependencyInterface
105+loadInterfaces root (Details _ _ _ _ extras) =
106+ case extras of
107+ ArtifactsFresh i _ -> newMVar (Just i)
108+ ArtifactsCached -> fork (File.readBinary (Stuff.interfaces root))
99109
100110
101111
@@ -110,7 +120,7 @@ verify style root =
110120 Nothing ->
111121 verifyFromScratch style root newTime
112122
113− Just details@(Details oldTime _ _ _) ->
123+ Just details@(Details oldTime _ _ _ _) ->
114124 if oldTime == newTime
115125 then return (Right details)
116126 else verifyFromScratch style root newTime
@@ -140,16 +150,11 @@ data Env =
140150 , _root :: FilePath
141151 , _cache :: Stuff.PackageCache
142152 , _manager :: Http.Manager
143− , _connection :: Connection
153+ , _connection :: Solver.Connection
144154 , _registry :: Registry.Registry
145155 }
146156
147157
148−data Connection
149− = Online
150− | Offline
151−
152−
153158initEnv :: Reporting.DKey -> FilePath -> IO (Either Exit.Details (Env, Outline.Outline))
154159initEnv key root =
155160 do cacheMVar <- fork Stuff.getPackageCache
@@ -169,7 +174,11 @@ initEnv key root =
169174 do eitherRegistry <- Registry.fetch manager cache
170175 case eitherRegistry of
171176 Right latestRegistry ->
172− return $ Right (Env key root cache manager Online latestRegistry, outline)
177+ let
178+ conn = Solver.Online manager
179+ env = Env key root cache manager conn latestRegistry
180+ in
181+ return $ Right (env, outline)
173182
174183 Left problem ->
175184 return $ Left $ Exit.DetailsCannotGetRegistry problem
@@ -178,10 +187,17 @@ initEnv key root =
178187 do eitherRegistry <- Registry.update manager cache cachedRegistry
179188 case eitherRegistry of
180189 Right latestRegistry ->
181− return $ Right (Env key root cache manager Online latestRegistry, outline)
190+ let
191+ conn = Solver.Online manager
192+ env = Env key root cache manager conn latestRegistry
193+ in
194+ return $ Right (env, outline)
182195
183196 Left _ ->
184− return $ Right (Env key root cache manager Offline cachedRegistry, outline)
197+ let
198+ env = Env key root cache manager Solver.Offline cachedRegistry
199+ in
200+ return $ Right (env, outline)
185201
186202
187203
@@ -195,7 +211,7 @@ verifyPkg :: Env -> File.Time -> Outline.PkgOutline -> Task Details
195211verifyPkg env time outline@(Outline.PkgOutline _ _ _ _ _ direct testDirect elm) =
196212 if Con.goodElm elm
197213 then
198− do solution <- solve env =<< union noDups direct testDirect
214+ do solution <- verifyConstraints env =<< union noDups direct testDirect
199215 let vsns = Map.map (\(Solver.Details v _) -> v) solution
200216 verifyDependencies env time (ValidPkg outline vsns) solution direct
201217 else
@@ -207,7 +223,7 @@ verifyApp env time outline@(Outline.AppOutline elmVersion _ direct _ _ _) =
207223 if elmVersion == V.compiler
208224 then
209225 do stated <- checkAppDeps outline
210− actual <- solve env (Map.map Con.exactly stated)
226+ actual <- verifyConstraints env (Map.map Con.exactly stated)
211227 if Map.size stated == Map.size actual
212228 then verifyDependencies env time (ValidApp outline) actual direct
213229 else Task.throw $ Exit.DetailsHandEditedDependencies
@@ -223,15 +239,17 @@ checkAppDeps (Outline.AppOutline _ _ direct indirect testDirect testIndirect) =
223239
224240
225241
226−-- SOLVE
242+-- VERIFY CONSTRAINTS
227243
228244
229−solve :: Env -> Map.Map Pkg.Name Con.Constraint -> Task (Map.Map Pkg.Name Solver.Details)
230−solve (Env _ _ cache manager connection registry) constraints =
231− Task.eio (error "TODO solve problem") $
232− case connection of
233− Online -> Solver.online cache manager registry constraints
234− Offline -> Solver.offline cache registry constraints
245+verifyConstraints :: Env -> Map.Map Pkg.Name Con.Constraint -> Task (Map.Map Pkg.Name Solver.Details)
246+verifyConstraints (Env _ _ cache _ connection registry) constraints =
247+ do result <- Task.io $ Solver.verify cache connection registry constraints
248+ case result of
249+ Solver.Ok details -> return details
250+ Solver.NoSolution -> Task.throw $ Exit.DetailsNoSolution
251+ Solver.NoOfflineSolution -> Task.throw $ Exit.DetailsNoOfflineSolution
252+ Solver.Err exit -> Task.throw $ Exit.DetailsSolverProblem exit
235253
236254
237255
@@ -280,14 +298,14 @@ verifyDependencies env@(Env key root _ _ _ _) time outline solution directDeps =
280298 deps <- traverse readMVar mvars
281299 case sequence deps of
282300 Left problem ->
283− error "TODO problem in verifyDependencies"
301+ error "TODO verifyDependencies" problem
284302
285303 Right artifacts ->
286304 let
287305 objs = Map.foldr addObjects Opt.empty artifacts
288306 ifaces = Map.foldrWithKey (addInterfaces directDeps) Map.empty artifacts
289307 foreigns = Map.map (OneOrMore.destruct Foreign) $ Map.foldrWithKey gatherForeigns Map.empty artifacts
290− details = Details time outline Map.empty foreigns
308+ details = Details time outline Map.empty foreigns (ArtifactsFresh ifaces objs)
291309 in
292310 do File.writeBinary (Stuff.objects root) objs
293311 File.writeBinary (Stuff.interfaces root) ifaces
@@ -687,8 +705,8 @@ endpointDecoder =
687705
688706
689707instance Binary Details where
690− get = liftM4 Details get get get get
691− put (Details a b c d) = put a >> put b >> put c >> put d
708+ get = do { a <- get; b <- get; c <- get; d <- get; return (Details a b c d ArtifactsCached) }
709+ put (Details a b c d _) = put a >> put b >> put c >> put d
692710
693711
694712instance Binary ValidOutline where