git.iko.soy/elk
on master help sign in
Update Deps/* for Elm.Version and use more qualified imports
commit059dc436a8a82ffb0745abfe5e7f53340c001820 authorEvan Czaplicki <evancz@users.noreply.github.com> dateThu 27 Dec 2018, 12:29 (8 years ago) parent2760e84
6 files changed+174−209
compare with master
unifiedsplit
builder/src/Deps/Cache.hs+35−47 builder/src/Deps/Diff.hs+7−7 builder/src/Deps/Explorer.hs+9−10 builder/src/Deps/Solver.hs+13−14 builder/src/Deps/Verify.hs+61−81 builder/src/Deps/Website.hs+49−50
builder/src/Deps/Cache.hs+35−47
@@ -20,18 +20,16 @@ import qualified Data.ByteString as BS
2020import Data.Function (on)
2121import qualified Data.List as List
2222import qualified Data.Map as Map
23−import Data.Map (Map)
2423import qualified Data.Name as Name
2524import System.FilePath ((</>))
2625
26+import qualified Deps.Website as Website
2727import qualified Elm.Docs as Docs
2828import qualified Elm.Package as Pkg
29−
30−import qualified Deps.Website as Website
3129import qualified Elm.Project.Json as Project
30+import qualified Elm.Version as V
3231import qualified File.IO as IO
3332import qualified Json.Decode as Decode
34−import qualified Reporting.Doc as D
3533import qualified Reporting.Exit as Exit
3634import qualified Reporting.Exit.Assets as E
3735import qualified Reporting.Progress as Progress
@@ -44,15 +42,15 @@ import qualified Reporting.Task as Task
4442
4543
4644data PackageRegistry =
47− PackageRegistry Int (Map Pkg.Name [Pkg.Version])
45+ PackageRegistry Int (Map.Map Pkg.Name [V.Version])
4846
4947
5048getPackageRegistry :: Task.Task PackageRegistry
5149getPackageRegistry =
5250 do path <- getRegistryPath
53− exists <- IO.exists path
51+ exists <- liftIO $ IO.exists path
5452 if exists
55− then IO.readBinary path
53+ then unsafeGetRegistry path
5654 else rebuild
5755
5856
@@ -62,6 +60,18 @@ getRegistryPath =
6260 return (dir </> "versions.dat")
6361
6462
63+unsafeGetRegistry :: FilePath -> Task.Task PackageRegistry
64+unsafeGetRegistry path =
65+ do maybeRegistry <- liftIO $ IO.readBinary path
66+ case maybeRegistry of
67+ Just registry ->
68+ return registry
69+
70+ Nothing ->
71+ liftIO (putStrLn path) >>
72+ Task.throw (error "TODO corrupt binary 3")
73+
74+
6575
6676-- REBUILD
6777
@@ -72,7 +82,7 @@ rebuild =
7282 packages <- Website.getAllPackages
7383 let size = Map.foldr ((+) . length) 0 packages
7484 let registry = PackageRegistry size packages
75− IO.writeBinary path registry
85+ liftIO $ IO.writeBinary path registry
7686 return registry
7787
7888
@@ -93,11 +103,11 @@ mandatoryUpdate =
93103update :: Bool -> Task.Task PackageRegistry
94104update isMandatory =
95105 do path <- getRegistryPath
96− exists <- IO.exists path
106+ exists <- liftIO $ IO.exists path
97107 if not exists
98108 then rebuild
99109 else
100− do registry <- IO.readBinary path
110+ do registry <- unsafeGetRegistry path
101111 if isMandatory
102112 then attemptUpdate registry
103113 else attemptUpdate registry `catchError` recoverUpdate registry
@@ -123,11 +133,11 @@ attemptUpdate oldRegistry@(PackageRegistry size packages) =
123133 newRegistry = PackageRegistry newSize newPkgs
124134 in
125135 do path <- getRegistryPath
126− IO.writeBinary path newRegistry
136+ liftIO $ IO.writeBinary path newRegistry
127137 return newRegistry
128138
129139
130−addNew :: Map Pkg.Name [Pkg.Version] -> (Pkg.Name, Pkg.Version) -> Map Pkg.Name [Pkg.Version]
140+addNew :: Map.Map Pkg.Name [V.Version] -> (Pkg.Name, V.Version) -> Map.Map Pkg.Name [V.Version]
131141addNew packages (name, version) =
132142 Map.insertWith (++) name [version] packages
133143
@@ -136,7 +146,7 @@ addNew packages (name, version) =
136146-- GET VERSIONS
137147
138148
139−getVersions :: Pkg.Name -> PackageRegistry -> Either [Pkg.Name] [Pkg.Version]
149+getVersions :: Pkg.Name -> PackageRegistry -> Either [Pkg.Name] [V.Version]
140150getVersions name (PackageRegistry _ pkgs) =
141151 case Map.lookup name pkgs of
142152 Just vsns ->
@@ -149,8 +159,8 @@ getVersions name (PackageRegistry _ pkgs) =
149159nearbyNames :: Pkg.Name -> [Pkg.Name] -> [Pkg.Name]
150160nearbyNames (Pkg.Name author1 project1) possibleNames =
151161 let
152− authorDist = authorDistance (Name.toString author1)
153− projectDist = projectDistance (Name.toString project1)
162+ authorDist = authorDistance (Name.toChars author1)
163+ projectDist = projectDistance (Name.toChars project1)
154164
155165 addDistance name@(Pkg.Name author2 project2) =
156166 ( authorDist author2 + projectDist project2, name )
@@ -162,7 +172,7 @@ nearbyNames (Pkg.Name author1 project1) possibleNames =
162172
163173authorDistance :: String -> Name.Name -> Int
164174authorDistance bad possibility =
165− abs (Suggest.distance bad (Name.toString possibility))
175+ abs (Suggest.distance bad (Name.toChars possibility))
166176
167177
168178projectDistance :: String -> Name.Name -> Int
@@ -170,19 +180,19 @@ projectDistance bad possibility =
170180 if possibility == "elm" || possibility == "elm-explorations" then
171181 0
172182 else
173− abs (Suggest.distance bad (Name.toString possibility))
183+ abs (Suggest.distance bad (Name.toChars possibility))
174184
175185
176186
177187-- PACKAGE INFO
178188
179189
180−getElmJson :: Pkg.Name -> Pkg.Version -> Task.Task Project.PkgInfo
190+getElmJson :: Pkg.Name -> V.Version -> Task.Task Project.PkgInfo
181191getElmJson name version =
182192 do dir <- Task.getPackageCacheDirFor name version
183193 let elmJson = dir </> "elm.json"
184194
185− exists <- IO.exists elmJson
195+ exists <- liftIO $ IO.exists elmJson
186196
187197 json <-
188198 if exists
@@ -192,12 +202,12 @@ getElmJson name version =
192202 liftIO (BS.writeFile elmJson bits)
193203 return bits
194204
195− case Decode.parse "project" E.badContentToDocs Project.pkgDecoder json of
205+ case Decode.fromByteString Project.pkgDecoder json of
196206 Right pkgInfo ->
197207 return pkgInfo
198208
199209 Left _ ->
200− do IO.remove elmJson
210+ do liftIO $ IO.remove elmJson
201211 Task.throw $ Exit.Assets $ E.CorruptElmJson name version
202212
203213
@@ -205,12 +215,12 @@ getElmJson name version =
205215-- DOCS
206216
207217
208−getDocs :: Pkg.Name -> Pkg.Version -> Task.Task Docs.Documentation
218+getDocs :: Pkg.Name -> V.Version -> Task.Task Docs.Documentation
209219getDocs name version =
210220 do dir <- Task.getPackageCacheDirFor name version
211221 let docsJson = dir </> "docs.json"
212222
213− exists <- IO.exists docsJson
223+ exists <- liftIO $ IO.exists docsJson
214224
215225 json <-
216226 if exists
@@ -220,37 +230,15 @@ getDocs name version =
220230 liftIO (BS.writeFile docsJson bits)
221231 return bits
222232
223− case Decode.parse "docs" errorToDocs (Docs.toDict <$> Decode.list Docs.decoder) json of
233+ case Decode.fromByteString (Docs.toDict <$> Decode.list Docs.decoder) json of
224234 Right pkgInfo ->
225235 return pkgInfo
226236
227237 Left _ ->
228− do IO.remove docsJson
238+ do liftIO $ IO.remove docsJson
229239 Task.throw $ Exit.Assets $ E.CorruptDocumentation name version
230240
231241
232−errorToDocs :: Docs.Error -> [D.Doc]
233−errorToDocs err =
234− let
235− details =
236− case err of
237− Docs.BadAssociativity txt ->
238− ["Binary","operators","cannot","have",D.red (D.fromString (show txt)),"as","their","associativity."]
239−
240− Docs.BadName ->
241− ["It","is","not","a","valid","module","name."]
242−
243− Docs.BadType ->
244− ["It","is","not","a","valid","Elm","type."]
245− in
246− details
247− ++
248− ["This","should","not","happen","in","general,","so","please","report","this","at"
249− ,"<https://github.com/elm/package.elm-lang.org/issues>"
250− ,"if","you","think","it","is","on","the","Elm","side!"
251− ]
252−
253−
254242
255243-- BINARY
256244
builder/src/Deps/Diff.hs+7−7
@@ -19,12 +19,12 @@ import qualified Data.List as List
1919import qualified Data.Map as Map
2020import qualified Data.Name as Name
2121import qualified Data.Set as Set
22−import qualified Data.Text as Text
22+import qualified Data.Utf8 as Utf8
2323
2424import qualified Elm.Compiler.Type as Type
2525import qualified Elm.Docs as Docs
2626import qualified Elm.ModuleName as ModuleName
27−import qualified Elm.Package as Pkg
27+import qualified Elm.Version as V
2828
2929
3030
@@ -196,7 +196,7 @@ isSameName :: Name.Name -> Name.Name -> Bool
196196isSameName oldFullName newFullName =
197197 let
198198 dedot name =
199− reverse (Text.splitOn "." (Name.toText name))
199+ reverse (Utf8.split 0x2E {-.-} (Name.toUtf8 name))
200200 in
201201 case ( dedot oldFullName, dedot newFullName ) of
202202 (oldName:[], newName:_) ->
@@ -318,17 +318,17 @@ magnitudeToString magnitude =
318318 "MAJOR"
319319
320320
321−bump :: PackageChanges -> Pkg.Version -> Pkg.Version
321+bump :: PackageChanges -> V.Version -> V.Version
322322bump changes version =
323323 case toMagnitude changes of
324324 PATCH ->
325− Pkg.bumpPatch version
325+ V.bumpPatch version
326326
327327 MINOR ->
328− Pkg.bumpMinor version
328+ V.bumpMinor version
329329
330330 MAJOR ->
331− Pkg.bumpMajor version
331+ V.bumpMajor version
332332
333333
334334toMagnitude :: PackageChanges -> Magnitude
builder/src/Deps/Explorer.hs+9−10
@@ -21,15 +21,14 @@ The goal of this module is to only pay for (1) and pay for (2) as needed.
2121
2222import Control.Monad.Except (liftIO, lift, throwError)
2323import Control.Monad.State (StateT, evalStateT, gets, modify)
24−import Data.Map (Map)
2524import qualified Data.Map as Map
2625
27−import Elm.Package (Name, Version)
28−
2926import qualified Deps.Cache as Cache
27+import qualified Elm.Constraint as C
28+import qualified Elm.Package as Pkg
3029import qualified Elm.PerUserCache as PerUserCache
3130import qualified Elm.Project.Json as Project
32−import Elm.Project.Constraint (Constraint)
31+import qualified Elm.Version as V
3332import qualified Reporting.Exit as Exit
3433import qualified Reporting.Exit.Deps as E
3534import qualified Reporting.Task as Task
@@ -46,14 +45,14 @@ type Explorer =
4645data Metadata =
4746 Metadata
4847 { _registry :: Cache.PackageRegistry
49− , _info :: Map (Name, Version) Info
48+ , _info :: Map.Map (Pkg.Name, V.Version) Info
5049 }
5150
5251
5352data Info =
5453 Info
55− { _elm :: Constraint
56− , _pkgs :: Map Name Constraint
54+ { _elm :: C.Constraint
55+ , _pkgs :: Map.Map Pkg.Name C.Constraint
5756 }
5857
5958
@@ -66,7 +65,7 @@ run registry explorer =
6665-- EXISTS
6766
6867
69−exists :: Name -> Explorer ()
68+exists :: Pkg.Name -> Explorer ()
7069exists name =
7170 do registry <- gets _registry
7271 case Cache.getVersions name registry of
@@ -81,7 +80,7 @@ exists name =
8180-- VERSIONS
8281
8382
84−getVersions :: Name -> Explorer [Version]
83+getVersions :: Pkg.Name -> Explorer [V.Version]
8584getVersions name =
8685 do registry <- gets _registry
8786 case Cache.getVersions name registry of
@@ -97,7 +96,7 @@ getVersions name =
9796-- CONSTRAINTS
9897
9998
100−getConstraints :: Name -> Version -> Explorer Info
99+getConstraints :: Pkg.Name -> V.Version -> Explorer Info
101100getConstraints name version =
102101 do allInfo <- gets _info
103102 case Map.lookup (name, version) allInfo of
builder/src/Deps/Solver.hs+13−14
@@ -12,19 +12,18 @@ import qualified Data.List as List
1212import qualified Data.Map as Map
1313import Data.Map (Map)
1414
15−import Elm.Package (Name, Version)
16−
1715import Deps.Explorer (Explorer)
1816import qualified Deps.Explorer as Explorer
19−import Elm.Project.Constraint (Constraint)
20−import qualified Elm.Project.Constraint as Con
17+import qualified Elm.Constraint as C
18+import qualified Elm.Package as Pkg
19+import qualified Elm.Version as V
2120
2221
2322
2423-- SOLVE
2524
2625
27−solve :: Map Name Constraint -> Solver (Map Name Version)
26+solve :: Map Pkg.Name C.Constraint -> Solver (Map Pkg.Name V.Version)
2827solve cons =
2928 mkSolver (State Map.empty cons)
3029
@@ -44,12 +43,12 @@ run solver =
4443
4544data State =
4645 State
47− { _solution :: Map Name Version
48− , _unsolved :: Map Name Constraint
46+ { _solution :: Map Pkg.Name V.Version
47+ , _unsolved :: Map Pkg.Name C.Constraint
4948 }
5049
5150
52−mkSolver :: State -> Solver (Map Name Version)
51+mkSolver :: State -> Solver (Map Pkg.Name V.Version)
5352mkSolver (State solution unsolved) =
5453 case Map.minViewWithKey unsolved of
5554 Nothing ->
@@ -59,28 +58,28 @@ mkSolver (State solution unsolved) =
5958 do allVersions <- lift $ Explorer.getVersions name
6059 let versions =
6160 reverse $ List.sort $
62− filter (Con.satisfies constraint) allVersions
61+ filter (C.satisfies constraint) allVersions
6362
6463 let state1 = State solution otherUnsolved
6564 state2 <- msum (map (addVersion state1 name) versions)
6665 mkSolver state2
6766
6867
69−addVersion :: State -> Name -> Version -> Solver State
68+addVersion :: State -> Pkg.Name -> V.Version -> Solver State
7069addVersion (State solution unsolved) name version =
7170 do (Explorer.Info elm cons) <-
7271 lift $ Explorer.getConstraints name version
7372
74− guard (Con.goodElm elm)
73+ guard (C.goodElm elm)
7574 newUnsolved <- foldM (addConstraint solution) unsolved (Map.toList cons)
7675 return (State (Map.insert name version solution) newUnsolved)
7776
7877
79−addConstraint :: Map Name Version -> Map Name Constraint -> (Name, Constraint) -> Solver (Map Name Constraint)
78+addConstraint :: Map Pkg.Name V.Version -> Map Pkg.Name C.Constraint -> (Pkg.Name, C.Constraint) -> Solver (Map Pkg.Name C.Constraint)
8079addConstraint solution unsolved (name, newConstraint) =
8180 case Map.lookup name solution of
8281 Just version ->
83− if Con.satisfies newConstraint version then
82+ if C.satisfies newConstraint version then
8483 return unsolved
8584 else
8685 mzero
@@ -91,7 +90,7 @@ addConstraint solution unsolved (name, newConstraint) =
9190 return $ Map.insert name newConstraint unsolved
9291
9392 Just oldConstraint ->
94− case Con.intersect oldConstraint newConstraint of
93+ case C.intersect oldConstraint newConstraint of
9594 Nothing ->
9695 mzero
9796
builder/src/Deps/Verify.hs+61−81
@@ -9,30 +9,26 @@ import Control.Concurrent.MVar (MVar, newMVar, newEmptyMVar, putMVar, readMVar,
99import Control.Monad (filterM, void)
1010import Control.Monad.Trans (liftIO)
1111import qualified Data.Map as Map
12−import qualified Data.Set as Set
1312import qualified Data.Map.Merge.Strict as Map
14−import Data.Map (Map)
15−import Data.Set (Set)
13+import qualified Data.Set as Set
1614import System.Directory (doesDirectoryExist)
1715import System.FilePath ((</>))
1816
19−import qualified Elm.Compiler.Objects as Obj
20−import qualified Elm.Docs as Docs
21−import qualified Elm.Interface as I
22−import qualified Elm.ModuleName as ModuleName
23−import Elm.Package (Name, Version)
24−import qualified Elm.PerUserCache as PerUserCache
25−import Elm.Project.Json (Project(..), AppInfo(..), PkgInfo(..))
26−import qualified Json.Encode as Encode
27−
2817import qualified Deps.Cache as Cache
2918import qualified Deps.Explorer as Explorer
3019import qualified Deps.Solver as Solver
3120import qualified Deps.Website as Website
3221import qualified Elm.Compiler as Compiler
22+import qualified Elm.Compiler.Objects as Obj
23+import qualified Elm.Constraint as Con
24+import qualified Elm.Interface as I
25+import qualified Elm.ModuleName as ModuleName
26+import qualified Elm.Package as Pkg
27+import qualified Elm.PerUserCache as PerUserCache
28+import Elm.Project.Json (Project(..), AppInfo(..), PkgInfo(..))
3329import qualified Elm.Project.Json as Project
34−import qualified Elm.Project.Constraint as Con
3530import qualified Elm.Project.Summary as Summary
31+import qualified Elm.Version as V
3632import qualified File.Args as Args
3733import qualified File.Compile as Compile
3834import qualified File.Crawl as Crawl
@@ -70,9 +66,9 @@ throw exit =
7066-- VERIFY APP
7167
7268
73−verifyApp :: AppInfo -> Task.Task (Map Name Version)
69+verifyApp :: AppInfo -> Task.Task (Map.Map Pkg.Name V.Version)
7470verifyApp info =
75− if _app_elm_version info /= Compiler.version then
71+ if _app_elm_version info /= V.compiler then
7672 throw (E.AppBadElm (_app_elm_version info))
7773
7874 else
@@ -95,7 +91,7 @@ verifyApp info =
9591-- VERIFY PKG
9692
9793
98−verifyPkg :: PkgInfo -> Task.Task (Map Name Version)
94+verifyPkg :: PkgInfo -> Task.Task (Map.Map Pkg.Name V.Version)
9995verifyPkg info =
10096 if not (Con.goodElm (_pkg_elm_version info)) then
10197 throw (E.PkgBadElm (_pkg_elm_version info))
@@ -117,19 +113,19 @@ verifyPkg info =
117113-- APP TO SOLUTION
118114
119115
120−appToSolution :: Project.AppInfo -> Task.Task (Map Name Version)
116+appToSolution :: Project.AppInfo -> Task.Task (Map.Map Pkg.Name V.Version)
121117appToSolution (Project.AppInfo _ _ depsDirect depsTrans testDirect testTrans) =
122118 do a <- union allowEqualDups depsTrans testDirect
123119 b <- union noDups depsDirect testTrans
124120 union noDups a b
125121
126122
127−noDups :: Name -> a -> a -> Task.Task a
123+noDups :: Pkg.Name -> a -> a -> Task.Task a
128124noDups _ _ _ =
129125 throw E.BadDeps
130126
131127
132−allowEqualDups :: Name -> Version -> Version -> Task.Task Version
128+allowEqualDups :: Pkg.Name -> V.Version -> V.Version -> Task.Task V.Version
133129allowEqualDups _ v1 v2 =
134130 if v1 == v2 then
135131 return v1
@@ -137,7 +133,7 @@ allowEqualDups _ v1 v2 =
137133 throw E.BadDeps
138134
139135
140−union :: (Name -> a -> a -> Task.Task a) -> Map Name a -> Map Name a -> Task.Task (Map Name a)
136+union :: (Pkg.Name -> a -> a -> Task.Task a) -> Map.Map Pkg.Name a -> Map.Map Pkg.Name a -> Task.Task (Map.Map Pkg.Name a)
141137union tieBreaker deps1 deps2 =
142138 Map.mergeA Map.preserveMissing Map.preserveMissing (Map.zipWithAMatched tieBreaker) deps1 deps2
143139
@@ -146,13 +142,13 @@ union tieBreaker deps1 deps2 =
146142-- VERIFY ARTIFACTS
147143
148144
149−verifyArtifacts :: Map Name Version -> Task.Task RawInfo
145+verifyArtifacts :: Map.Map Pkg.Name V.Version -> Task.Task RawInfo
150146verifyArtifacts solution =
151147 do Website.download =<< filterM noSrc (Map.toList solution)
152148 verifyBuildArtifacts solution
153149
154150
155−noSrc :: (Name, Version) -> Task.Task Bool
151+noSrc :: (Pkg.Name, V.Version) -> Task.Task Bool
156152noSrc (name, version) =
157153 do root <- Task.getPackageCacheDirFor name version
158154 liftIO $ not <$> doesDirectoryExist (root </> "src")
@@ -162,7 +158,7 @@ noSrc (name, version) =
162158-- VERIFY BUILD ARTIFACTS
163159
164160
165−verifyBuildArtifacts :: Map Name Version -> Task.Task RawInfo
161+verifyBuildArtifacts :: Map.Map Pkg.Name V.Version -> Task.Task RawInfo
166162verifyBuildArtifacts solution =
167163 do Task.report (Progress.BuildDepsStart (Map.size solution))
168164 startMVar <- liftIO newEmptyMVar
@@ -177,14 +173,14 @@ verifyBuildArtifacts solution =
177173
178174
179175data RawInfo =
180− RawInfo (Map Name PkgInfo) I.Interfaces
176+ RawInfo (Map.Map Pkg.Name PkgInfo) I.Interfaces
181177
182178
183179verifyBuild
184− :: MVar (Map Name (MVar Answer))
180+ :: MVar (Map.Map Pkg.Name (MVar Answer))
185181 -> MVar I.Interfaces
186− -> Name
187− -> Version
182+ -> Pkg.Name
183+ -> V.Version
188184 -> Task.Task (MVar Answer)
189185verifyBuild pkgInfoMVar ifacesMVar name version =
190186 do mvar <- liftIO newEmptyMVar
@@ -223,10 +219,10 @@ verifyBuild pkgInfoMVar ifacesMVar name version =
223219data Answer
224220 = Ok PkgInfo
225221 | Blocked
226− | Err Name Version
222+ | Err Pkg.Name V.Version
227223
228224
229−toInfo :: Name -> Answer -> Task.Task (Maybe PkgInfo)
225+toInfo :: Pkg.Name -> Answer -> Task.Task (Maybe PkgInfo)
230226toInfo _ answer =
231227 case answer of
232228 Ok info ->
@@ -240,7 +236,7 @@ toInfo _ answer =
240236 throw (E.BuildFailure elmHome name version)
241237
242238
243−ifNotBlocked :: Map Name Answer -> (Map Name PkgInfo -> IO Answer) -> IO Answer
239+ifNotBlocked :: Map.Map Pkg.Name Answer -> (Map.Map Pkg.Name PkgInfo -> IO Answer) -> IO Answer
244240ifNotBlocked answers callback =
245241 case traverse isOk answers of
246242 Nothing ->
@@ -263,32 +259,30 @@ isOk answer =
263259
264260
265261getIface
266− :: Name
267− -> Version
262+ :: Pkg.Name
263+ -> V.Version
268264 -> PkgInfo
269− -> Map Name PkgInfo
265+ -> Map.Map Pkg.Name PkgInfo
270266 -> I.Interfaces
271267 -> Task.Task I.Interfaces
272268getIface name version info infos depIfaces =
273269 do root <- Task.getPackageCacheDirFor name version
274270 let solution = Map.map _pkg_version infos
275271
276− cached <- isCached root solution
272+ cached <- liftIO $ isCached root solution
277273
278274 if cached
279− then IO.readBinary (root </> "ifaces.dat")
275+ then
276+ do maybeIfaces <- liftIO $ IO.readBinary (root </> "ifaces.dat")
277+ maybe (Task.throw (error "TODO corrupt binary 1")) return maybeIfaces
280278 else
281279 do Paths.removeStuff root
282− let docsPath = root </> "docs.json"
283−
284280 let summary = Summary.cheapInit root info infos depIfaces
285281 args <- Args.fromSummary summary
286282 graph <- Crawl.crawl summary args
287− (dirty, cachedIfaces) <- Plan.plan (Just docsPath) summary graph
288− answers <- Compile.compile (Pkg info) (Just docsPath) cachedIfaces dirty
283+ (dirty, cachedIfaces) <- Plan.plan summary graph
284+ answers <- Compile.compile (Pkg info) cachedIfaces dirty
289285 results <- Artifacts.ignore answers
290− _ <- Artifacts.writeDocs results docsPath
291−
292286 Paths.removeStuff root
293287
294288 updateCache root name info solution graph results
@@ -298,25 +292,29 @@ getIface name version info infos depIfaces =
298292-- IS CACHED?
299293
300294
301−isCached :: FilePath -> Map Name Version -> Task.Task Bool
295+isCached :: FilePath -> Map.Map Pkg.Name V.Version -> IO Bool
302296isCached root solution =
303297 IO.andM
304298 [ IO.exists (root </> "cached.dat")
305299 , IO.exists (root </> "ifaces.dat")
306300 , IO.exists (root </> "objs.dat")
307− , IO.exists (root </> "documentation.json")
308301 , isCachedHelp solution <$> IO.readBinary (root </> "cached.dat")
309302 ]
310303
311304
312−isCachedHelp :: Map Name Version -> Map Name (Set Version) -> Bool
313−isCachedHelp solution cachedDeps =
314− let
315− matches =
316− Map.intersectionWith Set.member solution cachedDeps
317− in
318− Map.size solution == Map.size matches
319− && Map.foldr (&&) True matches
305+isCachedHelp :: Map.Map Pkg.Name V.Version -> Maybe (Map.Map Pkg.Name (Set.Set V.Version)) -> Bool
306+isCachedHelp solution maybeCachedDeps =
307+ case maybeCachedDeps of
308+ Nothing ->
309+ False
310+
311+ Just cachedDeps ->
312+ let
313+ matches =
314+ Map.intersectionWith Set.member solution cachedDeps
315+ in
316+ Map.size solution == Map.size matches
317+ && Map.foldr (&&) True matches
320318
321319
322320
@@ -325,35 +323,31 @@ isCachedHelp solution cachedDeps =
325323
326324updateCache
327325 :: FilePath
328− -> Name
326+ -> Pkg.Name
329327 -> PkgInfo
330− -> Map Name Version
328+ -> Map.Map Pkg.Name V.Version
331329 -> Crawl.Result
332− -> Map ModuleName.Raw Compiler.Artifacts
330+ -> Map.Map ModuleName.Raw Compiler.Artifacts
333331 -> Task.Task I.Interfaces
334332updateCache root name info solution graph results =
335333 do let path = root </> "cached.dat"
336334 let deps = Map.map Set.singleton solution
337335 let elmi = crush name info results
338336
339− exists <- IO.exists path
337+ exists <- liftIO $ IO.exists path
340338
341339 if exists
342340 then
343− do oldDeps <- IO.readBinary path
344− IO.writeBinary path (Map.unionWith Set.union deps oldDeps)
341+ do maybeOldDeps <- liftIO $ IO.readBinary path
342+ oldDeps <- maybe (error "TODO corrupt binary 2") return maybeOldDeps
343+ liftIO $ IO.writeBinary path (Map.unionWith Set.union deps oldDeps)
345344 else
345+ liftIO $
346346 do IO.writeBinary (root </> "ifaces.dat") elmi
347−
348347 IO.writeBinary path deps
349−
350348 IO.writeBinary (root </> "objs.dat") $
351349 Map.foldr addGraph (objGraphFromKernels graph) results
352350
353− liftIO $ Encode.writeUgly (root </> "documentation.json") $
354− Encode.list Docs.encode $
355− Map.foldr addDocs [] results
356−
357351 return elmi
358352
359353
@@ -361,7 +355,7 @@ updateCache root name info solution graph results =
361355-- CRUSH INTERFACES
362356
363357
364−crush :: Name -> PkgInfo -> Map ModuleName.Raw Compiler.Artifacts -> I.Interfaces
358+crush :: Pkg.Name -> PkgInfo -> Map.Map ModuleName.Raw Compiler.Artifacts -> I.Interfaces
365359crush pkg info results =
366360 let
367361 exposed =
@@ -371,8 +365,8 @@ crush pkg info results =
371365 Map.mapMaybeWithKey (crushHelp exposed) results
372366
373367
374−crushHelp :: Set ModuleName.Raw -> ModuleName.Raw -> Compiler.Artifacts -> Maybe I.Interface
375−crushHelp exposed name (Compiler.Artifacts elmi _ _) =
368+crushHelp :: Set.Set ModuleName.Raw -> ModuleName.Raw -> Compiler.Artifacts -> Maybe I.Interface
369+crushHelp exposed name (Compiler.Artifacts elmi _) =
376370 if Set.member name exposed then
377371 Just elmi
378372
@@ -381,25 +375,11 @@ crushHelp exposed name (Compiler.Artifacts elmi _ _) =
381375
382376
383377
384−-- DOCUMENTATION
385−
386−
387−addDocs :: Compiler.Artifacts -> [Docs.Module] -> [Docs.Module]
388−addDocs (Compiler.Artifacts _ _ maybeDocs) docsList =
389− case maybeDocs of
390− Nothing ->
391− docsList
392−
393− Just docs ->
394− docs : docsList
395−
396−
397−
398378-- OBJECT GRAPH
399379
400380
401381addGraph :: Compiler.Artifacts -> Obj.Graph -> Obj.Graph
402−addGraph (Compiler.Artifacts _ elmo _) graph =
382+addGraph (Compiler.Artifacts _ elmo) graph =
403383 Obj.union elmo graph
404384
405385
builder/src/Deps/Website.hs+49−50
@@ -23,18 +23,17 @@ import qualified Data.ByteString.Char8 as BS
2323import qualified Data.ByteString.Lazy as LBS
2424import qualified Data.Digest.Pure.SHA as SHA
2525import qualified Data.Map as Map
26−import qualified Data.Text as Text
26+import qualified Data.Utf8 as Utf8
2727import qualified Network.HTTP.Client as Client
2828import qualified Network.HTTP.Client.MultipartFormData as Multi
2929import qualified Network.HTTP.Types as Http
3030import qualified System.Directory as Dir
3131import System.FilePath ((</>), splitFileName)
3232
33−import Elm.Package (Name, Version)
3433import qualified Elm.Package as Pkg
34+import qualified Elm.Version as V
3535import qualified Json.Decode as D
3636
37−import qualified Reporting.Doc as D
3837import qualified Reporting.Exit.Http as E
3938import qualified Reporting.Progress as Progress
4039import qualified Reporting.Task as Task
@@ -46,74 +45,74 @@ import qualified Stuff.Paths as Path
4645-- GET PACKAGE INFO
4746
4847
49−getElmJson :: Name -> Version -> Task.Task BS.ByteString
48+getElmJson :: Pkg.Name -> V.Version -> Task.Task BS.ByteString
5049getElmJson name version =
5150 Http.run $ fetchByteString $
52− "packages/" ++ Pkg.toUrl name ++ "/" ++ Pkg.versionToString version ++ "/elm.json"
51+ "packages/" ++ Pkg.toUrl name ++ "/" ++ V.toChars version ++ "/elm.json"
5352
5453
55−getDocs :: Name -> Version -> Task.Task BS.ByteString
54+getDocs :: Pkg.Name -> V.Version -> Task.Task BS.ByteString
5655getDocs name version =
5756 Http.run $ fetchByteString $
58− "packages/" ++ Pkg.toUrl name ++ "/" ++ Pkg.versionToString version ++ "/docs.json"
57+ "packages/" ++ Pkg.toUrl name ++ "/" ++ V.toChars version ++ "/docs.json"
5958
6059
6160
6261-- NEW PACKAGES
6362
6463
65−getNewPackages :: Int -> Task.Task [(Name, Version)]
64+getNewPackages :: Int -> Task.Task [(Pkg.Name, V.Version)]
6665getNewPackages index =
67− Http.run $ fetchJson "packages" E.badJsonToDocs (D.list newPkgDecoder) ("all-packages/since/" ++ show index)
66+ Http.run $ fetchJson (D.list newPkgDecoder) ("all-packages/since/" ++ show index)
6867
6968
70−newPkgDecoder :: D.Decoder E.BadJson ( Name, Version )
69+newPkgDecoder :: D.Decoder E.BadJson ( Pkg.Name, V.Version )
7170newPkgDecoder =
72− do txt <- D.text
73− case Text.splitOn "@" txt of
71+ do str <- D.string
72+ case Utf8.split 0x40 {-@-} str of
7473 [key, value] ->
75− case Pkg.fromText key of
74+ case Pkg.fromString key of
7675 Right pkg ->
77− case Pkg.versionFromText value of
76+ case V.fromString value of
7877 Just vsn ->
79− D.succeed (pkg, vsn)
78+ return (pkg, vsn)
8079
8180 Nothing ->
82− D.fail (E.BadNewPkg txt)
81+ D.failure (E.BadNewPkg str)
8382
8483 Left _ ->
85− D.fail (E.BadNewPkg txt)
84+ D.failure (E.BadNewPkg str)
8685
8786 _ ->
88− D.fail (E.BadNewPkg txt)
87+ D.failure (E.BadNewPkg str)
8988
9089
9190
9291-- ALL PACKAGES
9392
9493
95−getAllPackages :: Task.Task (Map.Map Name [Version])
94+getAllPackages :: Task.Task (Map.Map Pkg.Name [V.Version])
9695getAllPackages =
97− Http.run $ fetchJson "packages" E.badJsonToDocs allPkgsDecoder "all-packages"
96+ Http.run $ fetchJson allPkgsDecoder "all-packages"
9897
9998
100−allPkgsDecoder :: D.Decoder E.BadJson (Map.Map Name [Version])
99+allPkgsDecoder :: D.Decoder E.BadJson (Map.Map Pkg.Name [V.Version])
101100allPkgsDecoder =
102101 let
103102 checkKeys pairs pkgs =
104103 case pairs of
105104 [] ->
106− D.succeed pkgs
105+ return pkgs
107106
108107 (key, versions) : rest ->
109− case Pkg.fromText key of
110− Left (msg, _) ->
111− D.fail (E.BadAllPkg key msg)
112−
108+ case Pkg.fromString key of
113109 Right pkg ->
114110 checkKeys rest (Map.insert pkg versions pkgs)
111+
112+ Left badName ->
113+ D.failure (E.BadAllPkg key badName)
115114 in
116− do pairs <- D.pairs (D.list (D.mapError E.BadAllVsn Pkg.versionDecoder))
115+ do pairs <- D.pairs (D.list (D.mapError E.BadAllVsn V.decoder))
117116 checkKeys pairs Map.empty
118117
119118
@@ -128,24 +127,24 @@ fetchByteString path =
128127 return $ Right $ LBS.toStrict $ Client.responseBody response
129128
130129
131−fetchJson :: String -> (e -> [D.Doc]) -> D.Decoder e a -> String -> Http.Fetch a
132−fetchJson rootName errorToDocs decoder path =
130+fetchJson :: D.Decoder e a -> String -> Http.Fetch a
131+fetchJson decoder path =
133132 Http.package path [] $ \request manager ->
134133 do response <- Client.httpLbs request manager
135134 let bytes = LBS.toStrict (Client.responseBody response)
136− case D.parse rootName errorToDocs decoder bytes of
135+ case D.fromByteString decoder bytes of
137136 Right value ->
138137 return $ Right value
139138
140139 Left jsonProblem ->
141− return $ Left $ E.BadJson path jsonProblem
140+ return $ Left $ E.BadJson path (error "TODO give real HTTP problem" jsonProblem)
142141
143142
144143
145144-- DOWNLOAD
146145
147146
148−download :: [(Name, Version)] -> Task.Task ()
147+download :: [(Pkg.Name, V.Version)] -> Task.Task ()
149148download packages =
150149 case packages of
151150 [] ->
@@ -161,13 +160,13 @@ download packages =
161160 Http.parallel $ map (downloadHelp cache) packages
162161
163162
164−downloadHelp :: FilePath -> (Name, Version) -> Http.Fetch ()
163+downloadHelp :: FilePath -> (Pkg.Name, V.Version) -> Http.Fetch ()
165164downloadHelp cache (name, version) =
166165 let
167166 endpointUrl =
168− "packages/" ++ Pkg.toUrl name ++ "/" ++ Pkg.versionToString version ++ "/endpoint.json"
167+ "packages/" ++ Pkg.toUrl name ++ "/" ++ V.toChars version ++ "/endpoint.json"
169168 in
170− Http.andThen (fetchJson "version" id endpointDecoder endpointUrl) $ \(endpoint, hash) ->
169+ Http.andThen (fetchJson endpointDecoder endpointUrl) $ \(endpoint, hash) ->
171170 let
172171 start = Progress.DownloadPkgStart name version
173172 toEnd = Progress.DownloadPkgEnd name version
@@ -179,16 +178,16 @@ downloadHelp cache (name, version) =
179178
180179endpointDecoder :: D.Decoder e (String, String)
181180endpointDecoder =
182− D.map2 (,)
183− (D.field "url" D.string)
184− (D.field "hash" D.string)
181+ (,)
182+ <$> (Utf8.toChars <$> D.field "url" D.string)
183+ <*> (Utf8.toChars <$> D.field "hash" D.string)
185184
186185
187186
188187-- DOWNLOAD ZIP ARCHIVE
189188
190189
191−downloadArchive :: FilePath -> Name -> Version -> String -> Client.Response Client.BodyReader -> IO (Either E.Exit ())
190+downloadArchive :: FilePath -> Pkg.Name -> V.Version -> String -> Client.Response Client.BodyReader -> IO (Either E.Exit ())
192191downloadArchive cache name version expectedHash response =
193192 do result <- readArchive (Client.responseBody response) initialArchiveState
194193 case result of
@@ -197,7 +196,7 @@ downloadArchive cache name version expectedHash response =
197196
198197 Right (sha, archive) ->
199198 if expectedHash == SHA.showDigest sha then
200− Right <$> writeArchive archive (cache </> Pkg.toFilePath name) (Pkg.versionToString version)
199+ Right <$> writeArchive archive (cache </> Pkg.toFilePath name) (V.toChars version)
201200 else
202201 return $ Left $ E.BadZipSha expectedHash (SHA.showDigest sha)
203202
@@ -264,11 +263,11 @@ replaceRoot root entry =
264263-- FIND TAGGED COMMIT ON GITHUB
265264
266265
267−githubCommit :: Name -> Version -> Task.Task String
266+githubCommit :: Pkg.Name -> V.Version -> Task.Task String
268267githubCommit name version =
269268 let
270269 endpoint =
271− "https://api.github.com/repos/" ++ Pkg.toUrl name ++ "/git/refs/tags/" ++ Pkg.versionToString version
270+ "https://api.github.com/repos/" ++ Pkg.toUrl name ++ "/git/refs/tags/" ++ V.toChars version
272271
273272 headers =
274273 [ ( Http.hUserAgent, "elm-cli" )
@@ -276,14 +275,14 @@ githubCommit name version =
276275 ]
277276
278277 decoder =
279− D.at ["object","sha"] D.string
278+ D.field "object" (D.field "sha" D.string)
280279 in
281280 Http.run $ Http.anything endpoint $ \request manager ->
282281 do response <- Client.httpLbs (request { Client.requestHeaders = headers }) manager
283282 let bytes = LBS.toStrict (Client.responseBody response)
284− case D.parse "github" id decoder bytes of
283+ case D.fromByteString decoder bytes of
285284 Right value ->
286− return $ Right value
285+ return $ Right (Utf8.toChars value)
287286
288287 Left jsonProblem ->
289288 return $ Left $ E.BadJson "github.json" jsonProblem
@@ -293,11 +292,11 @@ githubCommit name version =
293292-- DOWNLOAD FROM GITHUB
294293
295294
296−githubDownload :: Name -> Version -> FilePath -> Task.Task Sha
295+githubDownload :: Pkg.Name -> V.Version -> FilePath -> Task.Task Sha
297296githubDownload name version dir =
298297 let
299298 endpoint =
300− "https://github.com/" ++ Pkg.toUrl name ++ "/zipball/" ++ Pkg.versionToString version ++ "/"
299+ "https://github.com/" ++ Pkg.toUrl name ++ "/zipball/" ++ V.toChars version ++ "/"
301300 in
302301 Http.run $ Http.anything endpoint $ \request manager ->
303302 Client.withResponse request manager (githubDownloadHelp dir)
@@ -320,12 +319,12 @@ githubDownloadHelp targetDir response =
320319-- REGISTER PACKAGES
321320
322321
323−register :: Name -> Version -> String -> Sha -> Task.Task ()
322+register :: Pkg.Name -> V.Version -> String -> Sha -> Task.Task ()
324323register name version commitHash digest =
325324 let
326325 params =
327− [ ("name", Pkg.toString name)
328− , ("version", Pkg.versionToString version)
326+ [ ("name", Pkg.toChars name)
327+ , ("version", V.toChars version)
329328 , ("commit-hash", commitHash)
330329 ]
331330