5c327b7 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Connect to <package.elm-lang.org> less often

5c327b7Evan Czaplicki8 years ago

builder/src/Deps/Get.hs → builder/src/Deps/Cache.hsrenamed+98−48

compare with master

unifiedsplit

@@ -1,25 +1,28 @@

1{-# OPTIONS_GHC -Wall #-}

2{-# LANGUAGE OverloadedStrings #-}

3−module Deps.Get

3+module Deps.Cache

4− ( all

4+ ( update

5− , AllPackages

5+ , optionalUpdate

6− , Mode(..)

6+ , mandatoryUpdate

7− , versions

7+ , PackageRegistry

8− , info

8+ , getPackageRegistry

9− , docs

9+ , getVersions

10+ , getElmJson

11+ , getDocs

10 )

12 )

11 where

13 where

14import Prelude hiding (all)

16import Prelude hiding (all)

17+import Control.Monad (liftM2)

15import Control.Monad.Except (catchError, liftIO)

18import Control.Monad.Except (catchError, liftIO)

19+import Data.Binary (Binary, get, put)

16import qualified Data.ByteString as BS

20import qualified Data.ByteString as BS

17import Data.Function (on)

21import Data.Function (on)

18import qualified Data.List as List

22import qualified Data.List as List

19import qualified Data.Map as Map

23import qualified Data.Map as Map

20import Data.Map (Map)

24import Data.Map (Map)

21import qualified Data.Text as Text

25import qualified Data.Text as Text

22−import qualified System.Directory as Dir

23import System.FilePath ((</>))

26import System.FilePath ((</>))

25import qualified Elm.Docs as Docs

28import qualified Elm.Docs as Docs

@@ -38,53 +41,91 @@ import qualified Reporting.Task as Task

41−-- ALL VERSIONS

44+-- PACKAGE REGISTRY

44−data Mode = RequireLatest | AllowOffline

47+data PackageRegistry =

48+ PackageRegistry Int (Map Pkg.Name [Pkg.Version])

47−newtype AllPackages = AllPackages (Map Pkg.Name [Pkg.Version])

51+getPackageRegistry :: Task.Task PackageRegistry

52+getPackageRegistry =

53+ do path <- getRegistryPath

54+ exists <- IO.exists path

55+ if exists

56+ then IO.readBinary path

57+ else rebuild

50−all :: Mode -> Task.Task AllPackages

60+getRegistryPath :: Task.Task FilePath

51−all mode =

61+getRegistryPath =

52 do dir <- Task.getPackageCacheDir

62 do dir <- Task.getPackageCacheDir

53− let versionsFile = dir </> "versions.dat"

63+ return (dir </> "versions.dat")

54− exists <- liftIO $ Dir.doesFileExist versionsFile

64+

55− if exists

65+

56− then fetchNew versionsFile mode

66+

57− else fetchAll versionsFile

67+-- REBUILD

60−fetchAll :: FilePath -> Task.Task AllPackages

70+rebuild :: Task.Task PackageRegistry

61−fetchAll versionsFile =

71+rebuild =

72+ do path <- getRegistryPath

62− do packages <- Website.getAllPackages

73+ packages <- Website.getAllPackages

63 let size = Map.foldr ((+) . length) 0 packages

74 let size = Map.foldr ((+) . length) 0 packages

75+ let registry = PackageRegistry size packages

64− IO.writeBinary versionsFile (size, packages)

76+ IO.writeBinary path registry

65− return (AllPackages packages)

77+ return registry

68−fetchNew :: FilePath -> Mode -> Task.Task AllPackages

69−fetchNew versionsFile mode =

70− do (size, packages) <- IO.readBinary versionsFile

72− news <-

81+-- UPDATE

73− case mode of

74− RequireLatest ->

75− Website.getNewPackages size

77− AllowOffline ->

78− Website.getNewPackages size `catchError` \_ ->

79− do Task.report Progress.UnableToLoadLatestPackages

80− return []

82− if null news

84+optionalUpdate :: Task.Task PackageRegistry

83− then return (AllPackages packages)

85+optionalUpdate =

86+ update False

87+

88+

89+mandatoryUpdate :: Task.Task PackageRegistry

90+mandatoryUpdate =

91+ update True

92+

93+

94+update :: Bool -> Task.Task PackageRegistry

95+update isMandatory =

96+ do path <- getRegistryPath

97+ exists <- IO.exists path

98+ if not exists

99+ then rebuild

84 else

100 else

101+ do registry <- IO.readBinary path

102+ if isMandatory

103+ then attemptUpdate registry

104+ else attemptUpdate registry `catchError` recoverUpdate registry

105+

106+

107+recoverUpdate :: PackageRegistry -> a -> Task.Task PackageRegistry

108+recoverUpdate registry _ =

109+ do Task.report Progress.UnableToLoadLatestPackages

110+ return registry

111+

112+

113+attemptUpdate :: PackageRegistry -> Task.Task PackageRegistry

114+attemptUpdate oldRegistry@(PackageRegistry size packages) =

115+ do news <- Website.getNewPackages size

116+ case news of

117+ [] ->

118+ return oldRegistry

119+

120+ _:_ ->

121+ let

122+ newSize = size + length news

85− do let newAllPkgs = List.foldl' addNew packages news

123+ newPkgs = List.foldl' addNew packages news

86− IO.writeBinary versionsFile (size + length news, newAllPkgs)

124+ newRegistry = PackageRegistry newSize newPkgs

87− return (AllPackages newAllPkgs)

125+ in

126+ do path <- getRegistryPath

127+ IO.writeBinary path newRegistry

128+ return newRegistry

129

130

90addNew :: Map Pkg.Name [Pkg.Version] -> (Pkg.Name, Pkg.Version) -> Map Pkg.Name [Pkg.Version]

131addNew :: Map Pkg.Name [Pkg.Version] -> (Pkg.Name, Pkg.Version) -> Map Pkg.Name [Pkg.Version]

@@ -93,11 +134,11 @@ addNew packages (name, version) =

134

135

136

96−-- VERSIONS

137+-- GET VERSIONS

138

139

99−versions :: Pkg.Name -> AllPackages -> Either [Pkg.Name] [Pkg.Version]

140+getVersions :: Pkg.Name -> PackageRegistry -> Either [Pkg.Name] [Pkg.Version]

100−versions name (AllPackages pkgs) =

141+getVersions name (PackageRegistry _ pkgs) =

101 case Map.lookup name pkgs of

142 case Map.lookup name pkgs of

102 Just vsns ->

143 Just vsns ->

103 Right vsns

144 Right vsns

@@ -137,12 +178,12 @@ projectDistance bad possibility =

137-- PACKAGE INFO

178-- PACKAGE INFO

138

179

139

180

140−info :: Pkg.Name -> Pkg.Version -> Task.Task Project.PkgInfo

181+getElmJson :: Pkg.Name -> Pkg.Version -> Task.Task Project.PkgInfo

141−info name version =

182+getElmJson name version =

142 do dir <- Task.getPackageCacheDirFor name version

183 do dir <- Task.getPackageCacheDirFor name version

143 let elmJson = dir </> "elm.json"

184 let elmJson = dir </> "elm.json"

144

185

145− exists <- liftIO $ Dir.doesFileExist elmJson

186+ exists <- IO.exists elmJson

146

187

147 json <-

188 json <-

148 if exists

189 if exists

@@ -165,12 +206,12 @@ info name version =

165-- DOCS

206-- DOCS

166

207

167

208

168−docs :: Pkg.Name -> Pkg.Version -> Task.Task Docs.Documentation

209+getDocs :: Pkg.Name -> Pkg.Version -> Task.Task Docs.Documentation

169−docs name version =

210+getDocs name version =

170 do dir <- Task.getPackageCacheDirFor name version

211 do dir <- Task.getPackageCacheDirFor name version

171 let docsJson = dir </> "docs.json"

212 let docsJson = dir </> "docs.json"

172

213

173− exists <- liftIO $ Dir.doesFileExist docsJson

214+ exists <- IO.exists docsJson

174

215

175 json <-

216 json <-

176 if exists

217 if exists

@@ -209,3 +250,12 @@ errorToDocs err =

209 ,"<https://github.com/elm-lang/package.elm-lang.org/issues>"

250 ,"<https://github.com/elm-lang/package.elm-lang.org/issues>"

210 ,"if","you","think","it","is","on","the","Elm","side!"

251 ,"if","you","think","it","is","on","the","Elm","side!"

211 ]

252 ]

253+

254+

255+

256+-- BINARY

257+

258+

259+instance Binary PackageRegistry where

260+ get = liftM2 PackageRegistry get get

261+ put (PackageRegistry a b) = put a >> put b

builder/src/Deps/Explorer.hs+10−11

@@ -26,7 +26,7 @@ import qualified Data.Map as Map

27import Elm.Package (Name, Version)

29−import qualified Deps.Get as Get

29+import qualified Deps.Cache as Cache

30import qualified Elm.PerUserCache as PerUserCache

31import qualified Elm.Project.Json as Project

32import Elm.Project.Constraint (Constraint)

@@ -45,7 +45,7 @@ type Explorer =

46data Metadata =

47 Metadata

48− { _vsns :: Get.AllPackages

48+ { _registry :: Cache.PackageRegistry

49 , _info :: Map (Name, Version) Info

50 }

@@ -57,10 +57,9 @@ data Info =

57 }

60−run :: Explorer a -> Task.Task a

60+run :: Cache.PackageRegistry -> Explorer a -> Task.Task a

61−run explorer =

61+run registry explorer =

62− do versions <- Get.all Get.AllowOffline

63− evalStateT explorer (Metadata versions Map.empty)

62+ evalStateT explorer (Metadata registry Map.empty)

@@ -69,8 +68,8 @@ run explorer =

70exists :: Name -> Explorer ()

69exists :: Name -> Explorer ()

71exists name =

70exists name =

72− do pkgs <- gets _vsns

71+ do registry <- gets _registry

73− case Get.versions name pkgs of

72+ case Cache.getVersions name registry of

74 Right _ ->

73 Right _ ->

75 return ()

74 return ()

@@ -84,8 +83,8 @@ exists name =

85getVersions :: Name -> Explorer [Version]

84getVersions :: Name -> Explorer [Version]

86getVersions name =

85getVersions name =

87− do pkgs <- gets _vsns

86+ do registry <- gets _registry

88− case Get.versions name pkgs of

87+ case Cache.getVersions name registry of

89 Right versions ->

88 Right versions ->

90 return versions

89 return versions

@@ -106,7 +105,7 @@ getConstraints name version =

106 return info

105 return info

107

106

108 Nothing ->

107 Nothing ->

109− do pkgInfo <- lift $ Get.info name version

108+ do pkgInfo <- lift $ Cache.getElmJson name version

110

109

111 let elm = Project._pkg_elm_version pkgInfo

110 let elm = Project._pkg_elm_version pkgInfo

112 let pkgs = Project._pkg_deps pkgInfo

111 let pkgs = Project._pkg_deps pkgInfo

builder/src/Deps/Verify.hs+6−4

@@ -23,8 +23,8 @@ import qualified Elm.PerUserCache as PerUserCache

23import Elm.Project.Json (Project(..), AppInfo(..), PkgInfo(..))

24import qualified Json.Encode as Encode

26+import qualified Deps.Cache as Cache

26import qualified Deps.Explorer as Explorer

27import qualified Deps.Explorer as Explorer

27−import qualified Deps.Get as Get

28import qualified Deps.Solver as Solver

29import qualified Deps.Website as Website

30import qualified Elm.Compiler as Compiler

@@ -73,7 +73,8 @@ verifyApp info =

73 else

74 do let oldSolution = Project.appSolution info

75 let solver = Solver.solve (Map.map Con.exactly oldSolution)

76+ registry <- Cache.optionalUpdate

76− maybeSolution <- Explorer.run (Solver.run solver)

77+ maybeSolution <- Explorer.run registry (Solver.run solver)

77 case maybeSolution of

78 case maybeSolution of

78 Nothing ->

79 Nothing ->

79 throw E.BadDeps

80 throw E.BadDeps

@@ -90,7 +91,8 @@ verifyPkg info =

90 else

91 else

91 do let deps = Map.union (_pkg_deps info) (_pkg_test_deps info)

92 do let deps = Map.union (_pkg_deps info) (_pkg_test_deps info)

92 let solver = Solver.solve deps

93 let solver = Solver.solve deps

94+ registry <- Cache.optionalUpdate

93− maybeSolution <- Explorer.run (Solver.run solver)

95+ maybeSolution <- Explorer.run registry (Solver.run solver)

94 case maybeSolution of

96 case maybeSolution of

95 Nothing ->

97 Nothing ->

96 throw E.BadDeps

98 throw E.BadDeps

@@ -145,7 +147,7 @@ verifyBuild

145 -> Task.Task (MVar Answer)

147 -> Task.Task (MVar Answer)

146verifyBuild pkgInfoMVar ifacesMVar name version =

148verifyBuild pkgInfoMVar ifacesMVar name version =

147 do mvar <- liftIO newEmptyMVar

149 do mvar <- liftIO newEmptyMVar

148− info <- Get.info name version

150+ info <- Cache.getElmJson name version

149 report <- Task.getReporter

151 report <- Task.getReporter

150 runner <- Task.getSilentRunner

152 runner <- Task.getSilentRunner

151

153

builder/src/Elm/Bump.hs+4−4

@@ -9,8 +9,8 @@ module Elm.Bump

9import Control.Monad.Trans (liftIO)

10import qualified Data.List as List

12+import qualified Deps.Cache as Cache

12import qualified Deps.Diff as Diff

13import qualified Deps.Diff as Diff

13−import qualified Deps.Get as Get

14import qualified Elm.Package as Pkg

15import qualified Elm.Project as Project

16import qualified Elm.Project.Json as Project

@@ -35,8 +35,8 @@ bump summary@(Summary.Summary root project _ _ _) =

35 Task.throw (Exit.Bump E.Application)

37 Project.Pkg info@(Project.PkgInfo name _ _ version _ _ _ _) ->

38− do pkgs <- Get.all Get.RequireLatest

38+ do registry <- Cache.mandatoryUpdate

39− case Get.versions name pkgs of

39+ case Cache.getVersions name registry of

40 Left _suggestions ->

41 checkNewPackage root info

@@ -101,7 +101,7 @@ checkNewPackage root info@(Project.PkgInfo _ _ _ version _ _ _ _) =

101

102suggestVersion :: Summary.Summary -> Project.PkgInfo -> Task.Task ()

103suggestVersion summary@(Summary.Summary root _ _ _ _) info@(Project.PkgInfo name _ _ version _ _ _ _) =

104− do oldDocs <- Get.docs name version

104+ do oldDocs <- Cache.getDocs name version

105 newDocs <- Task.silently (Project.generateDocs summary)

106 let changes = Diff.diff oldDocs newDocs

107 let newVersion = Diff.bump changes version

builder/src/Elm/Diff.hs+6−6

@@ -12,9 +12,9 @@ import qualified Data.List as List

12import qualified Data.Map as Map

13import qualified Data.Maybe as Maybe

15+import qualified Deps.Cache as Cache

15import Deps.Diff (PackageChanges(..), ModuleChanges(..), Changes(..), Magnitude(..))

16import Deps.Diff (PackageChanges(..), ModuleChanges(..), Changes(..), Magnitude(..))

16import qualified Deps.Diff as Diff

17import qualified Deps.Diff as Diff

17−import qualified Deps.Get as Get

18import qualified Elm.Compiler.Module as Module

19import qualified Elm.Compiler.Type as Type

20import qualified Elm.Docs as Docs

@@ -47,8 +47,8 @@ diff :: Args -> Task.Task ()

47diff args =

48 case args of

49 GlobalInquiry name v1 v2 ->

50− do pkgs <- Get.all Get.RequireLatest

50+ do registry <- Cache.mandatoryUpdate

51− case Get.versions name pkgs of

51+ case Cache.getVersions name registry of

52 Left suggestions ->

53 throw $ E.UnknownPackage name suggestions

@@ -88,7 +88,7 @@ throw exit =

88getDocs :: Pkg.Name -> [Pkg.Version] -> Pkg.Version -> Task.Task Docs.Documentation

89getDocs name allVersions version =

90 if elem version allVersions then

91− Get.docs name version

91+ Cache.getDocs name version

92 else

93 throw $ E.UnknownVersion name version allVersions

@@ -101,8 +101,8 @@ getPackageInfo =

101 throw $ E.Application

102

103 Project.Pkg (Project.PkgInfo name _ _ _ _ _ _ _) ->

104− do pkgs <- Get.all Get.RequireLatest

104+ do registry <- Cache.mandatoryUpdate

105− let vsns = either (const []) id (Get.versions name pkgs)

105+ let vsns = either (const []) id (Cache.getVersions name registry)

106 return ( summary, name, vsns )

107

108

builder/src/Elm/Install.hs+11−8

@@ -15,6 +15,7 @@ import System.IO (stdout)

15import qualified Elm.Package as Pkg

16import Elm.Package (Name, Version)

18+import qualified Deps.Cache as Cache

18import Deps.Explorer (Explorer)

19import Deps.Explorer (Explorer)

19import qualified Deps.Explorer as Explorer

20import qualified Deps.Explorer as Explorer

20import qualified Deps.Verify as Verify

21import qualified Deps.Verify as Verify

@@ -58,7 +59,8 @@ makePlan :: Name -> Project.Project -> (Project.Project -> Task.Task ()) -> Task

58makePlan pkg project attemptInstall =

59makePlan pkg project attemptInstall =

59 case project of

60 case project of

60 Project.App info@(Project.AppInfo elm srcDirs deps test trans) ->

61 Project.App info@(Project.AppInfo elm srcDirs deps test trans) ->

62+ do registry <- Cache.optionalUpdate

61− do changes <- addToApp pkg info

63+ changes <- addToApp registry pkg info

63 let news = Map.mapMaybe keepNew changes

65 let news = Map.mapMaybe keepNew changes

64 let newDeps = addNews (Just pkg) news deps

66 let newDeps = addNews (Just pkg) news deps

@@ -70,7 +72,8 @@ makePlan pkg project attemptInstall =

70 withApproval Pkg.versionToString changes (attemptInstall newProject)

72 withApproval Pkg.versionToString changes (attemptInstall newProject)

72 Project.Pkg info@(Project.PkgInfo _ _ _ _ _ deps test _) ->

74 Project.Pkg info@(Project.PkgInfo _ _ _ _ _ deps test _) ->

75+ do registry <- Cache.optionalUpdate

73− do changes <- addToPkg pkg info

76+ changes <- addToPkg registry pkg info

75 let news = Map.mapMaybe keepNew changes

78 let news = Map.mapMaybe keepNew changes

76 let newProject = Project.Pkg $

79 let newProject = Project.Pkg $

@@ -137,9 +140,9 @@ keepNew change =

137-- ADD TO APP

140-- ADD TO APP

138

141

139

142

140−addToApp :: Name -> Project.AppInfo -> Task.Task (Map Name (Change Version))

143+addToApp :: Cache.PackageRegistry -> Name -> Project.AppInfo -> Task.Task (Map Name (Change Version))

141−addToApp pkg info@(Project.AppInfo _ _ deps tests trans) =

144+addToApp registry pkg info@(Project.AppInfo _ _ deps tests trans) =

142− Explorer.run $

145+ Explorer.run registry $

143 do Explorer.exists pkg

146 do Explorer.exists pkg

144 let old = Map.unions [ deps, tests, trans ]

147 let old = Map.unions [ deps, tests, trans ]

145 result <- Solver.run (addToAppHelp pkg info)

148 result <- Solver.run (addToAppHelp pkg info)

@@ -177,9 +180,9 @@ addToAppHelp pkg (Project.AppInfo _ _ deps tests trans) =

177-- ADD TO PKG

180-- ADD TO PKG

178

181

179

182

180−addToPkg :: Name -> Project.PkgInfo -> Task.Task (Map Name (Change Constraint))

183+addToPkg :: Cache.PackageRegistry -> Name -> Project.PkgInfo -> Task.Task (Map Name (Change Constraint))

181−addToPkg pkg info@(Project.PkgInfo _ _ _ _ _ deps tests _) =

184+addToPkg registry pkg info@(Project.PkgInfo _ _ _ _ _ deps tests _) =

182− Explorer.run $

185+ Explorer.run registry $

183 do Explorer.exists pkg

186 do Explorer.exists pkg

184 let old = Map.union deps tests

187 let old = Map.union deps tests

185 result <- Solver.run (addToPkgHelp pkg info)

188 result <- Solver.run (addToPkgHelp pkg info)

builder/src/Elm/Publish.hs+4−4

@@ -13,8 +13,8 @@ import System.FilePath ((</>))

13import qualified System.IO as IO

14import qualified System.Process as Process

16+import qualified Deps.Cache as Cache

16import qualified Deps.Diff as Diff

17import qualified Deps.Diff as Diff

17−import qualified Deps.Get as Get

18import qualified Deps.Website as Website

19import qualified Elm.Bump as Bump

20import qualified Elm.Docs as Docs

@@ -41,8 +41,8 @@ publish summary@(Summary.Summary root project _ _ _) =

42 Project.Pkg (Project.PkgInfo name smry _ version exposed _ _ _) ->

43 do

44− pkgs <- Get.all Get.RequireLatest

44+ registry <- Cache.mandatoryUpdate

45− let maybePublishedVersions = either (const Nothing) Just (Get.versions name pkgs)

45+ let maybePublishedVersions = either (const Nothing) Just (Cache.getVersions name registry)

47 Task.report (Progress.PublishStart name version maybePublishedVersions)

@@ -244,7 +244,7 @@ verifyBump name statedVersion newDocs publishedVersions =

244 throw $ E.InvalidBump statedVersion (last publishedVersions)

245

246 Just (old, new, magnitude) ->

247− do oldDocs <- Get.docs name old

247+ do oldDocs <- Cache.getDocs name old

248 let changes = Diff.diff oldDocs newDocs

249 let realNew = Diff.bump changes old

250 if new == realNew

elm.cabal+1−1

@@ -88,9 +88,9 @@ Executable elm

88 Reporting.Task,

90 -- private from builder/

91+ Deps.Cache,

91 Deps.Diff,

92 Deps.Diff,

92 Deps.Explorer,

93 Deps.Explorer,

93− Deps.Get,

94 Deps.Solver,

95 Deps.Verify,

96 Deps.Website,