on master help sign in
use D.customString and D.KeyDecoder in Deps.Registry

Cleans things up a decent bit when it comes to validating keys with complex structure.

commit429d4b62eedd5950926e9277fd6f80b24eda2a09 authorEvan Czaplicki <evancz@users.noreply.github.com> dateMon 3 Jun 2019, 12:48 (7 years ago) parent1f01d8c
1 file changed+29−61
builder/src/Deps/Registry.hs+29−61
builder/src/Deps/Registry.hs+29−61
@@ -16,11 +16,8 @@ module Deps.Registry
1616import Prelude hiding (read)
1717import Control.Monad (liftM2)
1818import Data.Binary (Binary, get, put)
19−import Data.Function (on)
2019import qualified Data.List as List
2120import qualified Data.Map.Strict as Map
22−import qualified Data.Name as Name
23−import qualified Data.Utf8 as Utf8
2421
2522import qualified Deps.Website as Website
2623import qualified Elm.Package as Pkg
@@ -28,8 +25,8 @@ import qualified Elm.Version as V
2825import qualified File
2926import qualified Http
3027import qualified Json.Decode as D
28+import qualified Parse.Primitives as P
3129import qualified Reporting.Exit as Exit
32−import qualified Reporting.Suggest as Suggest
3330import qualified Stuff
3431
3532
@@ -86,26 +83,19 @@ addEntry (KnownVersions _ vs) count =
8683
8784allPkgsDecoder :: D.Decoder () (Map.Map Pkg.Name KnownVersions)
8885allPkgsDecoder =
89− do pairs <- D.pairs (D.list (D.mapError (\_ -> ()) V.decoder))
90− checkKeys pairs Map.empty
91− where
92− checkKeys pairs pkgs =
93− case pairs of
94− [] ->
95− return pkgs
96−
97− (key, versions) : rest ->
98− case Pkg.fromString key of
99− Right pkg ->
100− case List.sortBy (flip compare) versions of
101− [] ->
102− D.failure ()
86+ let
87+ keyDecoder =
88+ Pkg.keyDecoder bail
10389
104− v:vs ->
105− checkKeys rest (Map.insert pkg (KnownVersions v vs) pkgs)
90+ versionsDecoder =
91+ D.list (D.mapError (\_ -> ()) V.decoder)
10692
107− Left _ ->
108− D.failure ()
93+ toKnownVersions versions =
94+ case List.sortBy (flip compare) versions of
95+ v:vs -> return (KnownVersions v vs)
96+ [] -> D.failure ()
97+ in
98+ D.dict keyDecoder (toKnownVersions =<< versionsDecoder)
10999
110100
111101
@@ -144,22 +134,26 @@ addNew (name, version) versions =
144134 Map.alter (Just . add) name versions
145135
146136
137+
138+-- NEW PACKAGE DECODER
139+
140+
147141newPkgDecoder :: D.Decoder () (Pkg.Name, V.Version)
148142newPkgDecoder =
149− do str <- D.string
150− case Utf8.split 0x40 {-@-} str of
151− [key, value] ->
152− case Pkg.fromString key of
153− Right pkg ->
154− case V.fromString value of
155− Just vsn -> return (pkg, vsn)
156− Nothing -> D.failure ()
143+ D.customString newPkgParser bail
144+
145+
146+newPkgParser :: P.Parser () (Pkg.Name, V.Version)
147+newPkgParser =
148+ do pkg <- P.specialize (\_ _ _ -> ()) Pkg.parser
149+ P.word1 0x40 {-@-} bail
150+ vsn <- P.specialize (\_ _ _ -> ()) V.parser
151+ return (pkg, vsn)
157152
158− Left _ ->
159− D.failure ()
160153
161− _ ->
162− D.failure ()
154+bail :: row -> col -> ()
155+bail _ _ =
156+ ()
163157
164158
165159
@@ -190,33 +184,7 @@ getVersions' :: Pkg.Name -> Registry -> Either [Pkg.Name] KnownVersions
190184getVersions' name (Registry _ versions) =
191185 case Map.lookup name versions of
192186 Just kvs -> Right kvs
193− Nothing -> Left $ nearbyNames name (Map.keys versions)
194−
195−
196−nearbyNames :: Pkg.Name -> [Pkg.Name] -> [Pkg.Name]
197−nearbyNames (Pkg.Name author1 project1) possibleNames =
198− let
199− authorDist = authorDistance (Name.toChars author1)
200− projectDist = projectDistance (Name.toChars project1)
201−
202− addDistance name@(Pkg.Name author2 project2) =
203− ( authorDist author2 + projectDist project2, name )
204− in
205− map snd $ take 4 $
206− List.sortBy (compare `on` fst) $
207− map addDistance possibleNames
208−
209−
210−authorDistance :: String -> Name.Name -> Int
211−authorDistance bad possibility =
212− abs (Suggest.distance bad (Name.toChars possibility))
213−
214−
215−projectDistance :: String -> Name.Name -> Int
216−projectDistance bad possibility =
217− if possibility == "elm" || possibility == "elm-explorations"
218− then 0
219− else abs (Suggest.distance bad (Name.toChars possibility))
187+ Nothing -> Left $ Pkg.nearbyNames name (Map.keys versions)
220188
221189
222190