git.iko.soy/elk
on master help sign in
Update Deps/* for Elm.Version and use more qualified imports
059dc43Evan Czaplicki
builder/src/Deps/Cache.hs+35−47
compare with master
unifiedsplit
@@ -20,18 +20,16 @@ import qualified Data.ByteString as BS
20import Data.Function (on)
20import Data.Function (on)
21import qualified Data.List as List
21import qualified Data.List as List
22import qualified Data.Map as Map
22import qualified Data.Map as Map
23−import Data.Map (Map)
24import qualified Data.Name as Name
23import qualified Data.Name as Name
25import System.FilePath ((</>))
24import System.FilePath ((</>))
26
25
26+import qualified Deps.Website as Website
27import qualified Elm.Docs as Docs
27import qualified Elm.Docs as Docs
28import qualified Elm.Package as Pkg
28import qualified Elm.Package as Pkg
29−
30−import qualified Deps.Website as Website
31import qualified Elm.Project.Json as Project
29import qualified Elm.Project.Json as Project
30+import qualified Elm.Version as V
32import qualified File.IO as IO
31import qualified File.IO as IO
33import qualified Json.Decode as Decode
32import qualified Json.Decode as Decode
34−import qualified Reporting.Doc as D
35import qualified Reporting.Exit as Exit
33import qualified Reporting.Exit as Exit
36import qualified Reporting.Exit.Assets as E
34import qualified Reporting.Exit.Assets as E
37import qualified Reporting.Progress as Progress
35import qualified Reporting.Progress as Progress
@@ -44,15 +42,15 @@ import qualified Reporting.Task as Task
44
42
45
43
46data PackageRegistry =
44data PackageRegistry =
47− PackageRegistry Int (Map Pkg.Name [Pkg.Version])
45+ PackageRegistry Int (Map.Map Pkg.Name [V.Version])
48
46
49
47
50getPackageRegistry :: Task.Task PackageRegistry
48getPackageRegistry :: Task.Task PackageRegistry
51getPackageRegistry =
49getPackageRegistry =
52 do path <- getRegistryPath
50 do path <- getRegistryPath
53− exists <- IO.exists path
51+ exists <- liftIO $ IO.exists path
54 if exists
52 if exists
55− then IO.readBinary path
53+ then unsafeGetRegistry path
56 else rebuild
54 else rebuild
57
55
58
56
@@ -62,6 +60,18 @@ getRegistryPath =
62 return (dir </> "versions.dat")
60 return (dir </> "versions.dat")
63
61
64
62
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+
65
75
66-- REBUILD
76-- REBUILD
67
77
@@ -72,7 +82,7 @@ rebuild =
72 packages <- Website.getAllPackages
82 packages <- Website.getAllPackages
73 let size = Map.foldr ((+) . length) 0 packages
83 let size = Map.foldr ((+) . length) 0 packages
74 let registry = PackageRegistry size packages
84 let registry = PackageRegistry size packages
75− IO.writeBinary path registry
85+ liftIO $ IO.writeBinary path registry
76 return registry
86 return registry
77
87
78
88
@@ -93,11 +103,11 @@ mandatoryUpdate =
93update :: Bool -> Task.Task PackageRegistry
103update :: Bool -> Task.Task PackageRegistry
94update isMandatory =
104update isMandatory =
95 do path <- getRegistryPath
105 do path <- getRegistryPath
96− exists <- IO.exists path
106+ exists <- liftIO $ IO.exists path
97 if not exists
107 if not exists
98 then rebuild
108 then rebuild
99 else
109 else
100− do registry <- IO.readBinary path
110+ do registry <- unsafeGetRegistry path
101 if isMandatory
111 if isMandatory
102 then attemptUpdate registry
112 then attemptUpdate registry
103 else attemptUpdate registry `catchError` recoverUpdate registry
113 else attemptUpdate registry `catchError` recoverUpdate registry
@@ -123,11 +133,11 @@ attemptUpdate oldRegistry@(PackageRegistry size packages) =
123 newRegistry = PackageRegistry newSize newPkgs
133 newRegistry = PackageRegistry newSize newPkgs
124 in
134 in
125 do path <- getRegistryPath
135 do path <- getRegistryPath
126− IO.writeBinary path newRegistry
136+ liftIO $ IO.writeBinary path newRegistry
127 return newRegistry
137 return newRegistry
128
138
129
139
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]
131addNew packages (name, version) =
141addNew packages (name, version) =
132 Map.insertWith (++) name [version] packages
142 Map.insertWith (++) name [version] packages
133
143
@@ -136,7 +146,7 @@ addNew packages (name, version) =
136-- GET VERSIONS
146-- GET VERSIONS
137
147
138
148
139−getVersions :: Pkg.Name -> PackageRegistry -> Either [Pkg.Name] [Pkg.Version]
149+getVersions :: Pkg.Name -> PackageRegistry -> Either [Pkg.Name] [V.Version]
140getVersions name (PackageRegistry _ pkgs) =
150getVersions name (PackageRegistry _ pkgs) =
141 case Map.lookup name pkgs of
151 case Map.lookup name pkgs of
142 Just vsns ->
152 Just vsns ->
@@ -149,8 +159,8 @@ getVersions name (PackageRegistry _ pkgs) =
149nearbyNames :: Pkg.Name -> [Pkg.Name] -> [Pkg.Name]
159nearbyNames :: Pkg.Name -> [Pkg.Name] -> [Pkg.Name]
150nearbyNames (Pkg.Name author1 project1) possibleNames =
160nearbyNames (Pkg.Name author1 project1) possibleNames =
151 let
161 let
152− authorDist = authorDistance (Name.toString author1)
162+ authorDist = authorDistance (Name.toChars author1)
153− projectDist = projectDistance (Name.toString project1)
163+ projectDist = projectDistance (Name.toChars project1)
154
164
155 addDistance name@(Pkg.Name author2 project2) =
165 addDistance name@(Pkg.Name author2 project2) =
156 ( authorDist author2 + projectDist project2, name )
166 ( authorDist author2 + projectDist project2, name )
@@ -162,7 +172,7 @@ nearbyNames (Pkg.Name author1 project1) possibleNames =
162
172
163authorDistance :: String -> Name.Name -> Int
173authorDistance :: String -> Name.Name -> Int
164authorDistance bad possibility =
174authorDistance bad possibility =
165− abs (Suggest.distance bad (Name.toString possibility))
175+ abs (Suggest.distance bad (Name.toChars possibility))
166
176
167
177
168projectDistance :: String -> Name.Name -> Int
178projectDistance :: String -> Name.Name -> Int
@@ -170,19 +180,19 @@ projectDistance bad possibility =
170 if possibility == "elm" || possibility == "elm-explorations" then
180 if possibility == "elm" || possibility == "elm-explorations" then
171 0
181 0
172 else
182 else
173− abs (Suggest.distance bad (Name.toString possibility))
183+ abs (Suggest.distance bad (Name.toChars possibility))
174
184
175
185
176
186
177-- PACKAGE INFO
187-- PACKAGE INFO
178
188
179
189
180−getElmJson :: Pkg.Name -> Pkg.Version -> Task.Task Project.PkgInfo
190+getElmJson :: Pkg.Name -> V.Version -> Task.Task Project.PkgInfo
181getElmJson name version =
191getElmJson name version =
182 do dir <- Task.getPackageCacheDirFor name version
192 do dir <- Task.getPackageCacheDirFor name version
183 let elmJson = dir </> "elm.json"
193 let elmJson = dir </> "elm.json"
184
194
185− exists <- IO.exists elmJson
195+ exists <- liftIO $ IO.exists elmJson
186
196
187 json <-
197 json <-
188 if exists
198 if exists
@@ -192,12 +202,12 @@ getElmJson name version =
192 liftIO (BS.writeFile elmJson bits)
202 liftIO (BS.writeFile elmJson bits)
193 return bits
203 return bits
194
204
195− case Decode.parse "project" E.badContentToDocs Project.pkgDecoder json of
205+ case Decode.fromByteString Project.pkgDecoder json of
196 Right pkgInfo ->
206 Right pkgInfo ->
197 return pkgInfo
207 return pkgInfo
198
208
199 Left _ ->
209 Left _ ->
200− do IO.remove elmJson
210+ do liftIO $ IO.remove elmJson
201 Task.throw $ Exit.Assets $ E.CorruptElmJson name version
211 Task.throw $ Exit.Assets $ E.CorruptElmJson name version
202
212
203
213
@@ -205,12 +215,12 @@ getElmJson name version =
205-- DOCS
215-- DOCS
206
216
207
217
208−getDocs :: Pkg.Name -> Pkg.Version -> Task.Task Docs.Documentation
218+getDocs :: Pkg.Name -> V.Version -> Task.Task Docs.Documentation
209getDocs name version =
219getDocs name version =
210 do dir <- Task.getPackageCacheDirFor name version
220 do dir <- Task.getPackageCacheDirFor name version
211 let docsJson = dir </> "docs.json"
221 let docsJson = dir </> "docs.json"
212
222
213− exists <- IO.exists docsJson
223+ exists <- liftIO $ IO.exists docsJson
214
224
215 json <-
225 json <-
216 if exists
226 if exists
@@ -220,37 +230,15 @@ getDocs name version =
220 liftIO (BS.writeFile docsJson bits)
230 liftIO (BS.writeFile docsJson bits)
221 return bits
231 return bits
222
232
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
224 Right pkgInfo ->
234 Right pkgInfo ->
225 return pkgInfo
235 return pkgInfo
226
236
227 Left _ ->
237 Left _ ->
228− do IO.remove docsJson
238+ do liftIO $ IO.remove docsJson
229 Task.throw $ Exit.Assets $ E.CorruptDocumentation name version
239 Task.throw $ Exit.Assets $ E.CorruptDocumentation name version
230
240
231
241
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−
254
242
255-- BINARY
243-- BINARY
256
244
builder/src/Deps/Diff.hs+7−7
@@ -19,12 +19,12 @@ import qualified Data.List as List
19import qualified Data.Map as Map
19import qualified Data.Map as Map
20import qualified Data.Name as Name
20import qualified Data.Name as Name
21import qualified Data.Set as Set
21import qualified Data.Set as Set
22−import qualified Data.Text as Text
22+import qualified Data.Utf8 as Utf8
23
23
24import qualified Elm.Compiler.Type as Type
24import qualified Elm.Compiler.Type as Type
25import qualified Elm.Docs as Docs
25import qualified Elm.Docs as Docs
26import qualified Elm.ModuleName as ModuleName
26import qualified Elm.ModuleName as ModuleName
27−import qualified Elm.Package as Pkg
27+import qualified Elm.Version as V
28
28
29
29
30
30
@@ -196,7 +196,7 @@ isSameName :: Name.Name -> Name.Name -> Bool
196isSameName oldFullName newFullName =
196isSameName oldFullName newFullName =
197 let
197 let
198 dedot name =
198 dedot name =
199− reverse (Text.splitOn "." (Name.toText name))
199+ reverse (Utf8.split 0x2E {-.-} (Name.toUtf8 name))
200 in
200 in
201 case ( dedot oldFullName, dedot newFullName ) of
201 case ( dedot oldFullName, dedot newFullName ) of
202 (oldName:[], newName:_) ->
202 (oldName:[], newName:_) ->
@@ -318,17 +318,17 @@ magnitudeToString magnitude =
318 "MAJOR"
318 "MAJOR"
319
319
320
320
321−bump :: PackageChanges -> Pkg.Version -> Pkg.Version
321+bump :: PackageChanges -> V.Version -> V.Version
322bump changes version =
322bump changes version =
323 case toMagnitude changes of
323 case toMagnitude changes of
324 PATCH ->
324 PATCH ->
325− Pkg.bumpPatch version
325+ V.bumpPatch version
326
326
327 MINOR ->
327 MINOR ->
328− Pkg.bumpMinor version
328+ V.bumpMinor version
329
329
330 MAJOR ->
330 MAJOR ->
331− Pkg.bumpMajor version
331+ V.bumpMajor version
332
332
333
333
334toMagnitude :: PackageChanges -> Magnitude
334toMagnitude :: 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.
21
21
22import Control.Monad.Except (liftIO, lift, throwError)
22import Control.Monad.Except (liftIO, lift, throwError)
23import Control.Monad.State (StateT, evalStateT, gets, modify)
23import Control.Monad.State (StateT, evalStateT, gets, modify)
24−import Data.Map (Map)
25import qualified Data.Map as Map
24import qualified Data.Map as Map
26
25
27−import Elm.Package (Name, Version)
28−
29import qualified Deps.Cache as Cache
26import qualified Deps.Cache as Cache
27+import qualified Elm.Constraint as C
28+import qualified Elm.Package as Pkg
30import qualified Elm.PerUserCache as PerUserCache
29import qualified Elm.PerUserCache as PerUserCache
31import qualified Elm.Project.Json as Project
30import qualified Elm.Project.Json as Project
32−import Elm.Project.Constraint (Constraint)
31+import qualified Elm.Version as V
33import qualified Reporting.Exit as Exit
32import qualified Reporting.Exit as Exit
34import qualified Reporting.Exit.Deps as E
33import qualified Reporting.Exit.Deps as E
35import qualified Reporting.Task as Task
34import qualified Reporting.Task as Task
@@ -46,14 +45,14 @@ type Explorer =
46data Metadata =
45data Metadata =
47 Metadata
46 Metadata
48 { _registry :: Cache.PackageRegistry
47 { _registry :: Cache.PackageRegistry
49− , _info :: Map (Name, Version) Info
48+ , _info :: Map.Map (Pkg.Name, V.Version) Info
50 }
49 }
51
50
52
51
53data Info =
52data Info =
54 Info
53 Info
55− { _elm :: Constraint
54+ { _elm :: C.Constraint
56− , _pkgs :: Map Name Constraint
55+ , _pkgs :: Map.Map Pkg.Name C.Constraint
57 }
56 }
58
57
59
58
@@ -66,7 +65,7 @@ run registry explorer =
66-- EXISTS
65-- EXISTS
67
66
68
67
69−exists :: Name -> Explorer ()
68+exists :: Pkg.Name -> Explorer ()
70exists name =
69exists name =
71 do registry <- gets _registry
70 do registry <- gets _registry
72 case Cache.getVersions name registry of
71 case Cache.getVersions name registry of
@@ -81,7 +80,7 @@ exists name =
81-- VERSIONS
80-- VERSIONS
82
81
83
82
84−getVersions :: Name -> Explorer [Version]
83+getVersions :: Pkg.Name -> Explorer [V.Version]
85getVersions name =
84getVersions name =
86 do registry <- gets _registry
85 do registry <- gets _registry
87 case Cache.getVersions name registry of
86 case Cache.getVersions name registry of
@@ -97,7 +96,7 @@ getVersions name =
97-- CONSTRAINTS
96-- CONSTRAINTS
98
97
99
98
100−getConstraints :: Name -> Version -> Explorer Info
99+getConstraints :: Pkg.Name -> V.Version -> Explorer Info
101getConstraints name version =
100getConstraints name version =
102 do allInfo <- gets _info
101 do allInfo <- gets _info
103 case Map.lookup (name, version) allInfo of
102 case Map.lookup (name, version) allInfo of
builder/src/Deps/Solver.hs+13−14
@@ -12,19 +12,18 @@ import qualified Data.List as List
12import qualified Data.Map as Map
12import qualified Data.Map as Map
13import Data.Map (Map)
13import Data.Map (Map)
14
14
15−import Elm.Package (Name, Version)
16−
17import Deps.Explorer (Explorer)
15import Deps.Explorer (Explorer)
18import qualified Deps.Explorer as Explorer
16import qualified Deps.Explorer as Explorer
19−import Elm.Project.Constraint (Constraint)
17+import qualified Elm.Constraint as C
20−import qualified Elm.Project.Constraint as Con
18+import qualified Elm.Package as Pkg
19+import qualified Elm.Version as V
21
20
22
21
23
22
24-- SOLVE
23-- SOLVE
25
24
26
25
27−solve :: Map Name Constraint -> Solver (Map Name Version)
26+solve :: Map Pkg.Name C.Constraint -> Solver (Map Pkg.Name V.Version)
28solve cons =
27solve cons =
29 mkSolver (State Map.empty cons)
28 mkSolver (State Map.empty cons)
30
29
@@ -44,12 +43,12 @@ run solver =
44
43
45data State =
44data State =
46 State
45 State
47− { _solution :: Map Name Version
46+ { _solution :: Map Pkg.Name V.Version
48− , _unsolved :: Map Name Constraint
47+ , _unsolved :: Map Pkg.Name C.Constraint
49 }
48 }
50
49
51
50
52−mkSolver :: State -> Solver (Map Name Version)
51+mkSolver :: State -> Solver (Map Pkg.Name V.Version)
53mkSolver (State solution unsolved) =
52mkSolver (State solution unsolved) =
54 case Map.minViewWithKey unsolved of
53 case Map.minViewWithKey unsolved of
55 Nothing ->
54 Nothing ->
@@ -59,28 +58,28 @@ mkSolver (State solution unsolved) =
59 do allVersions <- lift $ Explorer.getVersions name
58 do allVersions <- lift $ Explorer.getVersions name
60 let versions =
59 let versions =
61 reverse $ List.sort $
60 reverse $ List.sort $
62− filter (Con.satisfies constraint) allVersions
61+ filter (C.satisfies constraint) allVersions
63
62
64 let state1 = State solution otherUnsolved
63 let state1 = State solution otherUnsolved
65 state2 <- msum (map (addVersion state1 name) versions)
64 state2 <- msum (map (addVersion state1 name) versions)
66 mkSolver state2
65 mkSolver state2
67
66
68
67
69−addVersion :: State -> Name -> Version -> Solver State
68+addVersion :: State -> Pkg.Name -> V.Version -> Solver State
70addVersion (State solution unsolved) name version =
69addVersion (State solution unsolved) name version =
71 do (Explorer.Info elm cons) <-
70 do (Explorer.Info elm cons) <-
72 lift $ Explorer.getConstraints name version
71 lift $ Explorer.getConstraints name version
73
72
74− guard (Con.goodElm elm)
73+ guard (C.goodElm elm)
75 newUnsolved <- foldM (addConstraint solution) unsolved (Map.toList cons)
74 newUnsolved <- foldM (addConstraint solution) unsolved (Map.toList cons)
76 return (State (Map.insert name version solution) newUnsolved)
75 return (State (Map.insert name version solution) newUnsolved)
77
76
78
77
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)
80addConstraint solution unsolved (name, newConstraint) =
79addConstraint solution unsolved (name, newConstraint) =
81 case Map.lookup name solution of
80 case Map.lookup name solution of
82 Just version ->
81 Just version ->
83− if Con.satisfies newConstraint version then
82+ if C.satisfies newConstraint version then
84 return unsolved
83 return unsolved
85 else
84 else
86 mzero
85 mzero
@@ -91,7 +90,7 @@ addConstraint solution unsolved (name, newConstraint) =
91 return $ Map.insert name newConstraint unsolved
90 return $ Map.insert name newConstraint unsolved
92
91
93 Just oldConstraint ->
92 Just oldConstraint ->
94− case Con.intersect oldConstraint newConstraint of
93+ case C.intersect oldConstraint newConstraint of
95 Nothing ->
94 Nothing ->
96 mzero
95 mzero
97
96
builder/src/Deps/Verify.hs+61−81
@@ -9,30 +9,26 @@ import Control.Concurrent.MVar (MVar, newMVar, newEmptyMVar, putMVar, readMVar,
9import Control.Monad (filterM, void)
9import Control.Monad (filterM, void)
10import Control.Monad.Trans (liftIO)
10import Control.Monad.Trans (liftIO)
11import qualified Data.Map as Map
11import qualified Data.Map as Map
12−import qualified Data.Set as Set
13import qualified Data.Map.Merge.Strict as Map
12import qualified Data.Map.Merge.Strict as Map
14−import Data.Map (Map)
15−import Data.Set (Set)
13+import qualified Data.Set as Set
16import System.Directory (doesDirectoryExist)
14import System.Directory (doesDirectoryExist)
17import System.FilePath ((</>))
15import System.FilePath ((</>))
18
16
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−
28import qualified Deps.Cache as Cache
17import qualified Deps.Cache as Cache
29import qualified Deps.Explorer as Explorer
18import qualified Deps.Explorer as Explorer
30import qualified Deps.Solver as Solver
19import qualified Deps.Solver as Solver
31import qualified Deps.Website as Website
20import qualified Deps.Website as Website
32import qualified Elm.Compiler as Compiler
21import 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(..))
33import qualified Elm.Project.Json as Project
29import qualified Elm.Project.Json as Project
34−import qualified Elm.Project.Constraint as Con
35import qualified Elm.Project.Summary as Summary
30import qualified Elm.Project.Summary as Summary
31+import qualified Elm.Version as V
36import qualified File.Args as Args
32import qualified File.Args as Args
37import qualified File.Compile as Compile
33import qualified File.Compile as Compile
38import qualified File.Crawl as Crawl
34import qualified File.Crawl as Crawl
@@ -70,9 +66,9 @@ throw exit =
70-- VERIFY APP
66-- VERIFY APP
71
67
72
68
73−verifyApp :: AppInfo -> Task.Task (Map Name Version)
69+verifyApp :: AppInfo -> Task.Task (Map.Map Pkg.Name V.Version)
74verifyApp info =
70verifyApp info =
75− if _app_elm_version info /= Compiler.version then
71+ if _app_elm_version info /= V.compiler then
76 throw (E.AppBadElm (_app_elm_version info))
72 throw (E.AppBadElm (_app_elm_version info))
77
73
78 else
74 else
@@ -95,7 +91,7 @@ verifyApp info =
95-- VERIFY PKG
91-- VERIFY PKG
96
92
97
93
98−verifyPkg :: PkgInfo -> Task.Task (Map Name Version)
94+verifyPkg :: PkgInfo -> Task.Task (Map.Map Pkg.Name V.Version)
99verifyPkg info =
95verifyPkg info =
100 if not (Con.goodElm (_pkg_elm_version info)) then
96 if not (Con.goodElm (_pkg_elm_version info)) then
101 throw (E.PkgBadElm (_pkg_elm_version info))
97 throw (E.PkgBadElm (_pkg_elm_version info))
@@ -117,19 +113,19 @@ verifyPkg info =
117-- APP TO SOLUTION
113-- APP TO SOLUTION
118
114
119
115
120−appToSolution :: Project.AppInfo -> Task.Task (Map Name Version)
116+appToSolution :: Project.AppInfo -> Task.Task (Map.Map Pkg.Name V.Version)
121appToSolution (Project.AppInfo _ _ depsDirect depsTrans testDirect testTrans) =
117appToSolution (Project.AppInfo _ _ depsDirect depsTrans testDirect testTrans) =
122 do a <- union allowEqualDups depsTrans testDirect
118 do a <- union allowEqualDups depsTrans testDirect
123 b <- union noDups depsDirect testTrans
119 b <- union noDups depsDirect testTrans
124 union noDups a b
120 union noDups a b
125
121
126
122
127−noDups :: Name -> a -> a -> Task.Task a
123+noDups :: Pkg.Name -> a -> a -> Task.Task a
128noDups _ _ _ =
124noDups _ _ _ =
129 throw E.BadDeps
125 throw E.BadDeps
130
126
131
127
132−allowEqualDups :: Name -> Version -> Version -> Task.Task Version
128+allowEqualDups :: Pkg.Name -> V.Version -> V.Version -> Task.Task V.Version
133allowEqualDups _ v1 v2 =
129allowEqualDups _ v1 v2 =
134 if v1 == v2 then
130 if v1 == v2 then
135 return v1
131 return v1
@@ -137,7 +133,7 @@ allowEqualDups _ v1 v2 =
137 throw E.BadDeps
133 throw E.BadDeps
138
134
139
135
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)
141union tieBreaker deps1 deps2 =
137union tieBreaker deps1 deps2 =
142 Map.mergeA Map.preserveMissing Map.preserveMissing (Map.zipWithAMatched tieBreaker) deps1 deps2
138 Map.mergeA Map.preserveMissing Map.preserveMissing (Map.zipWithAMatched tieBreaker) deps1 deps2
143
139
@@ -146,13 +142,13 @@ union tieBreaker deps1 deps2 =
146-- VERIFY ARTIFACTS
142-- VERIFY ARTIFACTS
147
143
148
144
149−verifyArtifacts :: Map Name Version -> Task.Task RawInfo
145+verifyArtifacts :: Map.Map Pkg.Name V.Version -> Task.Task RawInfo
150verifyArtifacts solution =
146verifyArtifacts solution =
151 do Website.download =<< filterM noSrc (Map.toList solution)
147 do Website.download =<< filterM noSrc (Map.toList solution)
152 verifyBuildArtifacts solution
148 verifyBuildArtifacts solution
153
149
154
150
155−noSrc :: (Name, Version) -> Task.Task Bool
151+noSrc :: (Pkg.Name, V.Version) -> Task.Task Bool
156noSrc (name, version) =
152noSrc (name, version) =
157 do root <- Task.getPackageCacheDirFor name version
153 do root <- Task.getPackageCacheDirFor name version
158 liftIO $ not <$> doesDirectoryExist (root </> "src")
154 liftIO $ not <$> doesDirectoryExist (root </> "src")
@@ -162,7 +158,7 @@ noSrc (name, version) =
162-- VERIFY BUILD ARTIFACTS
158-- VERIFY BUILD ARTIFACTS
163
159
164
160
165−verifyBuildArtifacts :: Map Name Version -> Task.Task RawInfo
161+verifyBuildArtifacts :: Map.Map Pkg.Name V.Version -> Task.Task RawInfo
166verifyBuildArtifacts solution =
162verifyBuildArtifacts solution =
167 do Task.report (Progress.BuildDepsStart (Map.size solution))
163 do Task.report (Progress.BuildDepsStart (Map.size solution))
168 startMVar <- liftIO newEmptyMVar
164 startMVar <- liftIO newEmptyMVar
@@ -177,14 +173,14 @@ verifyBuildArtifacts solution =
177
173
178
174
179data RawInfo =
175data RawInfo =
180− RawInfo (Map Name PkgInfo) I.Interfaces
176+ RawInfo (Map.Map Pkg.Name PkgInfo) I.Interfaces
181
177
182
178
183verifyBuild
179verifyBuild
184− :: MVar (Map Name (MVar Answer))
180+ :: MVar (Map.Map Pkg.Name (MVar Answer))
185 -> MVar I.Interfaces
181 -> MVar I.Interfaces
186− -> Name
182+ -> Pkg.Name
187− -> Version
183+ -> V.Version
188 -> Task.Task (MVar Answer)
184 -> Task.Task (MVar Answer)
189verifyBuild pkgInfoMVar ifacesMVar name version =
185verifyBuild pkgInfoMVar ifacesMVar name version =
190 do mvar <- liftIO newEmptyMVar
186 do mvar <- liftIO newEmptyMVar
@@ -223,10 +219,10 @@ verifyBuild pkgInfoMVar ifacesMVar name version =
223data Answer
219data Answer
224 = Ok PkgInfo
220 = Ok PkgInfo
225 | Blocked
221 | Blocked
226− | Err Name Version
222+ | Err Pkg.Name V.Version
227
223
228
224
229−toInfo :: Name -> Answer -> Task.Task (Maybe PkgInfo)
225+toInfo :: Pkg.Name -> Answer -> Task.Task (Maybe PkgInfo)
230toInfo _ answer =
226toInfo _ answer =
231 case answer of
227 case answer of
232 Ok info ->
228 Ok info ->
@@ -240,7 +236,7 @@ toInfo _ answer =
240 throw (E.BuildFailure elmHome name version)
236 throw (E.BuildFailure elmHome name version)
241
237
242
238
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
244ifNotBlocked answers callback =
240ifNotBlocked answers callback =
245 case traverse isOk answers of
241 case traverse isOk answers of
246 Nothing ->
242 Nothing ->
@@ -263,32 +259,30 @@ isOk answer =
263
259
264
260
265getIface
261getIface
266− :: Name
262+ :: Pkg.Name
267− -> Version
263+ -> V.Version
268 -> PkgInfo
264 -> PkgInfo
269− -> Map Name PkgInfo
265+ -> Map.Map Pkg.Name PkgInfo
270 -> I.Interfaces
266 -> I.Interfaces
271 -> Task.Task I.Interfaces
267 -> Task.Task I.Interfaces
272getIface name version info infos depIfaces =
268getIface name version info infos depIfaces =
273 do root <- Task.getPackageCacheDirFor name version
269 do root <- Task.getPackageCacheDirFor name version
274 let solution = Map.map _pkg_version infos
270 let solution = Map.map _pkg_version infos
275
271
276− cached <- isCached root solution
272+ cached <- liftIO $ isCached root solution
277
273
278 if cached
274 if cached
275+ then
279− then IO.readBinary (root </> "ifaces.dat")
276+ do maybeIfaces <- liftIO $ IO.readBinary (root </> "ifaces.dat")
277+ maybe (Task.throw (error "TODO corrupt binary 1")) return maybeIfaces
280 else
278 else
281 do Paths.removeStuff root
279 do Paths.removeStuff root
282− let docsPath = root </> "docs.json"
283−
284 let summary = Summary.cheapInit root info infos depIfaces
280 let summary = Summary.cheapInit root info infos depIfaces
285 args <- Args.fromSummary summary
281 args <- Args.fromSummary summary
286 graph <- Crawl.crawl summary args
282 graph <- Crawl.crawl summary args
287− (dirty, cachedIfaces) <- Plan.plan (Just docsPath) summary graph
283+ (dirty, cachedIfaces) <- Plan.plan summary graph
288− answers <- Compile.compile (Pkg info) (Just docsPath) cachedIfaces dirty
284+ answers <- Compile.compile (Pkg info) cachedIfaces dirty
289 results <- Artifacts.ignore answers
285 results <- Artifacts.ignore answers
290− _ <- Artifacts.writeDocs results docsPath
291−
292 Paths.removeStuff root
286 Paths.removeStuff root
293
287
294 updateCache root name info solution graph results
288 updateCache root name info solution graph results
@@ -298,25 +292,29 @@ getIface name version info infos depIfaces =
298-- IS CACHED?
292-- IS CACHED?
299
293
300
294
301−isCached :: FilePath -> Map Name Version -> Task.Task Bool
295+isCached :: FilePath -> Map.Map Pkg.Name V.Version -> IO Bool
302isCached root solution =
296isCached root solution =
303 IO.andM
297 IO.andM
304 [ IO.exists (root </> "cached.dat")
298 [ IO.exists (root </> "cached.dat")
305 , IO.exists (root </> "ifaces.dat")
299 , IO.exists (root </> "ifaces.dat")
306 , IO.exists (root </> "objs.dat")
300 , IO.exists (root </> "objs.dat")
307− , IO.exists (root </> "documentation.json")
308 , isCachedHelp solution <$> IO.readBinary (root </> "cached.dat")
301 , isCachedHelp solution <$> IO.readBinary (root </> "cached.dat")
309 ]
302 ]
310
303
311
304
312−isCachedHelp :: Map Name Version -> Map Name (Set Version) -> Bool
305+isCachedHelp :: Map.Map Pkg.Name V.Version -> Maybe (Map.Map Pkg.Name (Set.Set V.Version)) -> Bool
313−isCachedHelp solution cachedDeps =
306+isCachedHelp solution maybeCachedDeps =
307+ case maybeCachedDeps of
308+ Nothing ->
309+ False
310+
311+ Just cachedDeps ->
314− let
312+ let
315− matches =
313+ matches =
316− Map.intersectionWith Set.member solution cachedDeps
314+ Map.intersectionWith Set.member solution cachedDeps
317− in
315+ in
318− Map.size solution == Map.size matches
316+ Map.size solution == Map.size matches
319− && Map.foldr (&&) True matches
317+ && Map.foldr (&&) True matches
320
318
321
319
322
320
@@ -325,35 +323,31 @@ isCachedHelp solution cachedDeps =
325
323
326updateCache
324updateCache
327 :: FilePath
325 :: FilePath
328− -> Name
326+ -> Pkg.Name
329 -> PkgInfo
327 -> PkgInfo
330− -> Map Name Version
328+ -> Map.Map Pkg.Name V.Version
331 -> Crawl.Result
329 -> Crawl.Result
332− -> Map ModuleName.Raw Compiler.Artifacts
330+ -> Map.Map ModuleName.Raw Compiler.Artifacts
333 -> Task.Task I.Interfaces
331 -> Task.Task I.Interfaces
334updateCache root name info solution graph results =
332updateCache root name info solution graph results =
335 do let path = root </> "cached.dat"
333 do let path = root </> "cached.dat"
336 let deps = Map.map Set.singleton solution
334 let deps = Map.map Set.singleton solution
337 let elmi = crush name info results
335 let elmi = crush name info results
338
336
339− exists <- IO.exists path
337+ exists <- liftIO $ IO.exists path
340
338
341 if exists
339 if exists
342 then
340 then
343− do oldDeps <- IO.readBinary path
341+ do maybeOldDeps <- liftIO $ IO.readBinary path
342+ oldDeps <- maybe (error "TODO corrupt binary 2") return maybeOldDeps
344− IO.writeBinary path (Map.unionWith Set.union deps oldDeps)
343+ liftIO $ IO.writeBinary path (Map.unionWith Set.union deps oldDeps)
345 else
344 else
345+ liftIO $
346 do IO.writeBinary (root </> "ifaces.dat") elmi
346 do IO.writeBinary (root </> "ifaces.dat") elmi
347−
348 IO.writeBinary path deps
347 IO.writeBinary path deps
349−
350 IO.writeBinary (root </> "objs.dat") $
348 IO.writeBinary (root </> "objs.dat") $
351 Map.foldr addGraph (objGraphFromKernels graph) results
349 Map.foldr addGraph (objGraphFromKernels graph) results
352
350
353− liftIO $ Encode.writeUgly (root </> "documentation.json") $
354− Encode.list Docs.encode $
355− Map.foldr addDocs [] results
356−
357 return elmi
351 return elmi
358
352
359
353
@@ -361,7 +355,7 @@ updateCache root name info solution graph results =
361-- CRUSH INTERFACES
355-- CRUSH INTERFACES
362
356
363
357
364−crush :: Name -> PkgInfo -> Map ModuleName.Raw Compiler.Artifacts -> I.Interfaces
358+crush :: Pkg.Name -> PkgInfo -> Map.Map ModuleName.Raw Compiler.Artifacts -> I.Interfaces
365crush pkg info results =
359crush pkg info results =
366 let
360 let
367 exposed =
361 exposed =
@@ -371,8 +365,8 @@ crush pkg info results =
371 Map.mapMaybeWithKey (crushHelp exposed) results
365 Map.mapMaybeWithKey (crushHelp exposed) results
372
366
373
367
374−crushHelp :: Set ModuleName.Raw -> ModuleName.Raw -> Compiler.Artifacts -> Maybe I.Interface
368+crushHelp :: Set.Set ModuleName.Raw -> ModuleName.Raw -> Compiler.Artifacts -> Maybe I.Interface
375−crushHelp exposed name (Compiler.Artifacts elmi _ _) =
369+crushHelp exposed name (Compiler.Artifacts elmi _) =
376 if Set.member name exposed then
370 if Set.member name exposed then
377 Just elmi
371 Just elmi
378
372
@@ -381,25 +375,11 @@ crushHelp exposed name (Compiler.Artifacts elmi _ _) =
381
375
382
376
383
377
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−
398-- OBJECT GRAPH
378-- OBJECT GRAPH
399
379
400
380
401addGraph :: Compiler.Artifacts -> Obj.Graph -> Obj.Graph
381addGraph :: Compiler.Artifacts -> Obj.Graph -> Obj.Graph
402−addGraph (Compiler.Artifacts _ elmo _) graph =
382+addGraph (Compiler.Artifacts _ elmo) graph =
403 Obj.union elmo graph
383 Obj.union elmo graph
404
384
405
385
builder/src/Deps/Website.hs+49−50
@@ -23,18 +23,17 @@ import qualified Data.ByteString.Char8 as BS
23import qualified Data.ByteString.Lazy as LBS
23import qualified Data.ByteString.Lazy as LBS
24import qualified Data.Digest.Pure.SHA as SHA
24import qualified Data.Digest.Pure.SHA as SHA
25import qualified Data.Map as Map
25import qualified Data.Map as Map
26−import qualified Data.Text as Text
26+import qualified Data.Utf8 as Utf8
27import qualified Network.HTTP.Client as Client
27import qualified Network.HTTP.Client as Client
28import qualified Network.HTTP.Client.MultipartFormData as Multi
28import qualified Network.HTTP.Client.MultipartFormData as Multi
29import qualified Network.HTTP.Types as Http
29import qualified Network.HTTP.Types as Http
30import qualified System.Directory as Dir
30import qualified System.Directory as Dir
31import System.FilePath ((</>), splitFileName)
31import System.FilePath ((</>), splitFileName)
32
32
33−import Elm.Package (Name, Version)
34import qualified Elm.Package as Pkg
33import qualified Elm.Package as Pkg
34+import qualified Elm.Version as V
35import qualified Json.Decode as D
35import qualified Json.Decode as D
36
36
37−import qualified Reporting.Doc as D
38import qualified Reporting.Exit.Http as E
37import qualified Reporting.Exit.Http as E
39import qualified Reporting.Progress as Progress
38import qualified Reporting.Progress as Progress
40import qualified Reporting.Task as Task
39import qualified Reporting.Task as Task
@@ -46,74 +45,74 @@ import qualified Stuff.Paths as Path
46-- GET PACKAGE INFO
45-- GET PACKAGE INFO
47
46
48
47
49−getElmJson :: Name -> Version -> Task.Task BS.ByteString
48+getElmJson :: Pkg.Name -> V.Version -> Task.Task BS.ByteString
50getElmJson name version =
49getElmJson name version =
51 Http.run $ fetchByteString $
50 Http.run $ fetchByteString $
52− "packages/" ++ Pkg.toUrl name ++ "/" ++ Pkg.versionToString version ++ "/elm.json"
51+ "packages/" ++ Pkg.toUrl name ++ "/" ++ V.toChars version ++ "/elm.json"
53
52
54
53
55−getDocs :: Name -> Version -> Task.Task BS.ByteString
54+getDocs :: Pkg.Name -> V.Version -> Task.Task BS.ByteString
56getDocs name version =
55getDocs name version =
57 Http.run $ fetchByteString $
56 Http.run $ fetchByteString $
58− "packages/" ++ Pkg.toUrl name ++ "/" ++ Pkg.versionToString version ++ "/docs.json"
57+ "packages/" ++ Pkg.toUrl name ++ "/" ++ V.toChars version ++ "/docs.json"
59
58
60
59
61
60
62-- NEW PACKAGES
61-- NEW PACKAGES
63
62
64
63
65−getNewPackages :: Int -> Task.Task [(Name, Version)]
64+getNewPackages :: Int -> Task.Task [(Pkg.Name, V.Version)]
66getNewPackages index =
65getNewPackages 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)
68
67
69
68
70−newPkgDecoder :: D.Decoder E.BadJson ( Name, Version )
69+newPkgDecoder :: D.Decoder E.BadJson ( Pkg.Name, V.Version )
71newPkgDecoder =
70newPkgDecoder =
72− do txt <- D.text
71+ do str <- D.string
73− case Text.splitOn "@" txt of
72+ case Utf8.split 0x40 {-@-} str of
74 [key, value] ->
73 [key, value] ->
75− case Pkg.fromText key of
74+ case Pkg.fromString key of
76 Right pkg ->
75 Right pkg ->
77− case Pkg.versionFromText value of
76+ case V.fromString value of
78 Just vsn ->
77 Just vsn ->
79− D.succeed (pkg, vsn)
78+ return (pkg, vsn)
80
79
81 Nothing ->
80 Nothing ->
82− D.fail (E.BadNewPkg txt)
81+ D.failure (E.BadNewPkg str)
83
82
84 Left _ ->
83 Left _ ->
85− D.fail (E.BadNewPkg txt)
84+ D.failure (E.BadNewPkg str)
86
85
87 _ ->
86 _ ->
88− D.fail (E.BadNewPkg txt)
87+ D.failure (E.BadNewPkg str)
89
88
90
89
91
90
92-- ALL PACKAGES
91-- ALL PACKAGES
93
92
94
93
95−getAllPackages :: Task.Task (Map.Map Name [Version])
94+getAllPackages :: Task.Task (Map.Map Pkg.Name [V.Version])
96getAllPackages =
95getAllPackages =
97− Http.run $ fetchJson "packages" E.badJsonToDocs allPkgsDecoder "all-packages"
96+ Http.run $ fetchJson allPkgsDecoder "all-packages"
98
97
99
98
100−allPkgsDecoder :: D.Decoder E.BadJson (Map.Map Name [Version])
99+allPkgsDecoder :: D.Decoder E.BadJson (Map.Map Pkg.Name [V.Version])
101allPkgsDecoder =
100allPkgsDecoder =
102 let
101 let
103 checkKeys pairs pkgs =
102 checkKeys pairs pkgs =
104 case pairs of
103 case pairs of
105 [] ->
104 [] ->
106− D.succeed pkgs
105+ return pkgs
107
106
108 (key, versions) : rest ->
107 (key, versions) : rest ->
109− case Pkg.fromText key of
108+ case Pkg.fromString key of
110− Left (msg, _) ->
111− D.fail (E.BadAllPkg key msg)
112−
113 Right pkg ->
109 Right pkg ->
114 checkKeys rest (Map.insert pkg versions pkgs)
110 checkKeys rest (Map.insert pkg versions pkgs)
111+
112+ Left badName ->
113+ D.failure (E.BadAllPkg key badName)
115 in
114 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))
117 checkKeys pairs Map.empty
116 checkKeys pairs Map.empty
118
117
119
118
@@ -128,24 +127,24 @@ fetchByteString path =
128 return $ Right $ LBS.toStrict $ Client.responseBody response
127 return $ Right $ LBS.toStrict $ Client.responseBody response
129
128
130
129
131−fetchJson :: String -> (e -> [D.Doc]) -> D.Decoder e a -> String -> Http.Fetch a
130+fetchJson :: D.Decoder e a -> String -> Http.Fetch a
132−fetchJson rootName errorToDocs decoder path =
131+fetchJson decoder path =
133 Http.package path [] $ \request manager ->
132 Http.package path [] $ \request manager ->
134 do response <- Client.httpLbs request manager
133 do response <- Client.httpLbs request manager
135 let bytes = LBS.toStrict (Client.responseBody response)
134 let bytes = LBS.toStrict (Client.responseBody response)
136− case D.parse rootName errorToDocs decoder bytes of
135+ case D.fromByteString decoder bytes of
137 Right value ->
136 Right value ->
138 return $ Right value
137 return $ Right value
139
138
140 Left jsonProblem ->
139 Left jsonProblem ->
141− return $ Left $ E.BadJson path jsonProblem
140+ return $ Left $ E.BadJson path (error "TODO give real HTTP problem" jsonProblem)
142
141
143
142
144
143
145-- DOWNLOAD
144-- DOWNLOAD
146
145
147
146
148−download :: [(Name, Version)] -> Task.Task ()
147+download :: [(Pkg.Name, V.Version)] -> Task.Task ()
149download packages =
148download packages =
150 case packages of
149 case packages of
151 [] ->
150 [] ->
@@ -161,13 +160,13 @@ download packages =
161 Http.parallel $ map (downloadHelp cache) packages
160 Http.parallel $ map (downloadHelp cache) packages
162
161
163
162
164−downloadHelp :: FilePath -> (Name, Version) -> Http.Fetch ()
163+downloadHelp :: FilePath -> (Pkg.Name, V.Version) -> Http.Fetch ()
165downloadHelp cache (name, version) =
164downloadHelp cache (name, version) =
166 let
165 let
167 endpointUrl =
166 endpointUrl =
168− "packages/" ++ Pkg.toUrl name ++ "/" ++ Pkg.versionToString version ++ "/endpoint.json"
167+ "packages/" ++ Pkg.toUrl name ++ "/" ++ V.toChars version ++ "/endpoint.json"
169 in
168 in
170− Http.andThen (fetchJson "version" id endpointDecoder endpointUrl) $ \(endpoint, hash) ->
169+ Http.andThen (fetchJson endpointDecoder endpointUrl) $ \(endpoint, hash) ->
171 let
170 let
172 start = Progress.DownloadPkgStart name version
171 start = Progress.DownloadPkgStart name version
173 toEnd = Progress.DownloadPkgEnd name version
172 toEnd = Progress.DownloadPkgEnd name version
@@ -179,16 +178,16 @@ downloadHelp cache (name, version) =
179
178
180endpointDecoder :: D.Decoder e (String, String)
179endpointDecoder :: D.Decoder e (String, String)
181endpointDecoder =
180endpointDecoder =
182− D.map2 (,)
181+ (,)
183− (D.field "url" D.string)
182+ <$> (Utf8.toChars <$> D.field "url" D.string)
184− (D.field "hash" D.string)
183+ <*> (Utf8.toChars <$> D.field "hash" D.string)
185
184
186
185
187
186
188-- DOWNLOAD ZIP ARCHIVE
187-- DOWNLOAD ZIP ARCHIVE
189
188
190
189
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 ())
192downloadArchive cache name version expectedHash response =
191downloadArchive cache name version expectedHash response =
193 do result <- readArchive (Client.responseBody response) initialArchiveState
192 do result <- readArchive (Client.responseBody response) initialArchiveState
194 case result of
193 case result of
@@ -197,7 +196,7 @@ downloadArchive cache name version expectedHash response =
197
196
198 Right (sha, archive) ->
197 Right (sha, archive) ->
199 if expectedHash == SHA.showDigest sha then
198 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)
201 else
200 else
202 return $ Left $ E.BadZipSha expectedHash (SHA.showDigest sha)
201 return $ Left $ E.BadZipSha expectedHash (SHA.showDigest sha)
203
202
@@ -264,11 +263,11 @@ replaceRoot root entry =
264-- FIND TAGGED COMMIT ON GITHUB
263-- FIND TAGGED COMMIT ON GITHUB
265
264
266
265
267−githubCommit :: Name -> Version -> Task.Task String
266+githubCommit :: Pkg.Name -> V.Version -> Task.Task String
268githubCommit name version =
267githubCommit name version =
269 let
268 let
270 endpoint =
269 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
272
271
273 headers =
272 headers =
274 [ ( Http.hUserAgent, "elm-cli" )
273 [ ( Http.hUserAgent, "elm-cli" )
@@ -276,14 +275,14 @@ githubCommit name version =
276 ]
275 ]
277
276
278 decoder =
277 decoder =
279− D.at ["object","sha"] D.string
278+ D.field "object" (D.field "sha" D.string)
280 in
279 in
281 Http.run $ Http.anything endpoint $ \request manager ->
280 Http.run $ Http.anything endpoint $ \request manager ->
282 do response <- Client.httpLbs (request { Client.requestHeaders = headers }) manager
281 do response <- Client.httpLbs (request { Client.requestHeaders = headers }) manager
283 let bytes = LBS.toStrict (Client.responseBody response)
282 let bytes = LBS.toStrict (Client.responseBody response)
284− case D.parse "github" id decoder bytes of
283+ case D.fromByteString decoder bytes of
285 Right value ->
284 Right value ->
286− return $ Right value
285+ return $ Right (Utf8.toChars value)
287
286
288 Left jsonProblem ->
287 Left jsonProblem ->
289 return $ Left $ E.BadJson "github.json" jsonProblem
288 return $ Left $ E.BadJson "github.json" jsonProblem
@@ -293,11 +292,11 @@ githubCommit name version =
293-- DOWNLOAD FROM GITHUB
292-- DOWNLOAD FROM GITHUB
294
293
295
294
296−githubDownload :: Name -> Version -> FilePath -> Task.Task Sha
295+githubDownload :: Pkg.Name -> V.Version -> FilePath -> Task.Task Sha
297githubDownload name version dir =
296githubDownload name version dir =
298 let
297 let
299 endpoint =
298 endpoint =
300− "https://github.com/" ++ Pkg.toUrl name ++ "/zipball/" ++ Pkg.versionToString version ++ "/"
299+ "https://github.com/" ++ Pkg.toUrl name ++ "/zipball/" ++ V.toChars version ++ "/"
301 in
300 in
302 Http.run $ Http.anything endpoint $ \request manager ->
301 Http.run $ Http.anything endpoint $ \request manager ->
303 Client.withResponse request manager (githubDownloadHelp dir)
302 Client.withResponse request manager (githubDownloadHelp dir)
@@ -320,12 +319,12 @@ githubDownloadHelp targetDir response =
320-- REGISTER PACKAGES
319-- REGISTER PACKAGES
321
320
322
321
323−register :: Name -> Version -> String -> Sha -> Task.Task ()
322+register :: Pkg.Name -> V.Version -> String -> Sha -> Task.Task ()
324register name version commitHash digest =
323register name version commitHash digest =
325 let
324 let
326 params =
325 params =
327− [ ("name", Pkg.toString name)
326+ [ ("name", Pkg.toChars name)
328− , ("version", Pkg.versionToString version)
327+ , ("version", V.toChars version)
329 , ("commit-hash", commitHash)
328 , ("commit-hash", commitHash)
330 ]
329 ]
331
330