on master help sign in
use D.customString and D.KeyDecoder in Deps.Registry
429d4b6Evan Czaplicki
builder/src/Deps/Registry.hs+29−61
@@ -16,11 +16,8 @@ module Deps.Registry
16import Prelude hiding (read)
16import Prelude hiding (read)
17import Control.Monad (liftM2)
17import Control.Monad (liftM2)
18import Data.Binary (Binary, get, put)
18import Data.Binary (Binary, get, put)
19−import Data.Function (on)
20import qualified Data.List as List
19import qualified Data.List as List
21import qualified Data.Map.Strict as Map
20import qualified Data.Map.Strict as Map
22−import qualified Data.Name as Name
23−import qualified Data.Utf8 as Utf8
24
21
25import qualified Deps.Website as Website
22import qualified Deps.Website as Website
26import qualified Elm.Package as Pkg
23import qualified Elm.Package as Pkg
@@ -28,8 +25,8 @@ import qualified Elm.Version as V
28import qualified File
25import qualified File
29import qualified Http
26import qualified Http
30import qualified Json.Decode as D
27import qualified Json.Decode as D
28+import qualified Parse.Primitives as P
31import qualified Reporting.Exit as Exit
29import qualified Reporting.Exit as Exit
32−import qualified Reporting.Suggest as Suggest
33import qualified Stuff
30import qualified Stuff
34
31
35
32
@@ -86,26 +83,19 @@ addEntry (KnownVersions _ vs) count =
86
83
87allPkgsDecoder :: D.Decoder () (Map.Map Pkg.Name KnownVersions)
84allPkgsDecoder :: D.Decoder () (Map.Map Pkg.Name KnownVersions)
88allPkgsDecoder =
85allPkgsDecoder =
89− do pairs <- D.pairs (D.list (D.mapError (\_ -> ()) V.decoder))
86+ let
90− checkKeys pairs Map.empty
87+ keyDecoder =
91− where
88+ Pkg.keyDecoder bail
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 ()
103
89
104− v:vs ->
90+ versionsDecoder =
105− checkKeys rest (Map.insert pkg (KnownVersions v vs) pkgs)
91+ D.list (D.mapError (\_ -> ()) V.decoder)
106
92
107− Left _ ->
93+ toKnownVersions versions =
94+ case List.sortBy (flip compare) versions of
95+ v:vs -> return (KnownVersions v vs)
108− D.failure ()
96+ [] -> D.failure ()
97+ in
98+ D.dict keyDecoder (toKnownVersions =<< versionsDecoder)
109
99
110
100
111
101
@@ -144,22 +134,26 @@ addNew (name, version) versions =
144 Map.alter (Just . add) name versions
134 Map.alter (Just . add) name versions
145
135
146
136
137+
138+-- NEW PACKAGE DECODER
139+
140+
147newPkgDecoder :: D.Decoder () (Pkg.Name, V.Version)
141newPkgDecoder :: D.Decoder () (Pkg.Name, V.Version)
148newPkgDecoder =
142newPkgDecoder =
149− do str <- D.string
143+ D.customString newPkgParser bail
150− case Utf8.split 0x40 {-@-} str of
144+
151− [key, value] ->
145+
152− case Pkg.fromString key of
146+newPkgParser :: P.Parser () (Pkg.Name, V.Version)
153− Right pkg ->
147+newPkgParser =
154− case V.fromString value of
148+ do pkg <- P.specialize (\_ _ _ -> ()) Pkg.parser
149+ P.word1 0x40 {-@-} bail
150+ vsn <- P.specialize (\_ _ _ -> ()) V.parser
155− Just vsn -> return (pkg, vsn)
151+ return (pkg, vsn)
156− Nothing -> D.failure ()
157
152
158− Left _ ->
159− D.failure ()
160
153
161− _ ->
154+bail :: row -> col -> ()
162− D.failure ()
155+bail _ _ =
156+ ()
163
157
164
158
165
159
@@ -190,33 +184,7 @@ getVersions' :: Pkg.Name -> Registry -> Either [Pkg.Name] KnownVersions
190getVersions' name (Registry _ versions) =
184getVersions' name (Registry _ versions) =
191 case Map.lookup name versions of
185 case Map.lookup name versions of
192 Just kvs -> Right kvs
186 Just kvs -> Right kvs
193− Nothing -> Left $ nearbyNames name (Map.keys versions)
187+ Nothing -> Left $ Pkg.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))
220
188
221
189
222
190