@@ -1,38 +1,53 @@
11{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE BangPatterns, EmptyDataDecls, FlexibleInstances, UnboxedTuples #-}
33module Elm.Package
44 ( Name(..)
5+ , Author
6+ , Project
57 , Canonical(..)
68 , isKernel
7− , toString
89 , toChars
910 , toUrl
1011 , toFilePath
11− , BadName(..)
12− , fromString
12+ , toJsonString
13+ --
1314 , dummyName, kernel, core
1415 , browser, virtualDom, html
1516 , json, http, url
1617 , webgl, linearAlgebra
18+ --
1719 , suggestions
20+ , nearbyNames
21+ --
1822 , decoder
1923 , encode
24+ , keyDecoder
25+ --
26+ , parser
2027 )
2128 where
2229
2330
2431import Control.Monad (liftM2)
2532import Data.Binary (Binary, get, put)
26−import qualified Data.Char as Char
27−import qualified Data.Name as Name
33+import qualified Data.Coerce as Coerce
34+import Data.Function (on)
35+import qualified Data.List as List
2836import qualified Data.Map as Map
37+import qualified Data.Name as Name
2938import Data.Monoid ((<>))
3039import qualified Data.Utf8 as Utf8
40+import Data.Word (Word8)
41+import Foreign.Ptr (Ptr, plusPtr, minusPtr)
3142import System.FilePath ((</>))
3243
3344import qualified Elm.Version as V
34−import qualified Json.Decode as Decode
35−import qualified Json.Encode as Encode
45+import qualified Json.Decode as D
46+import qualified Json.Encode as E
47+import qualified Json.String as Json
48+import qualified Parse.Primitives as P
49+import Parse.Primitives (Row, Col)
50+import qualified Reporting.Suggest as Suggest
3651
3752
3853
@@ -41,11 +56,18 @@ import qualified Json.Encode as Encode
4156
4257data Name =
4358 Name
44− { _author :: !Name.Name
45− , _project :: !Name.Name
59+ { _author :: !Author
60+ , _project :: !Project
4661 }
4762
4863
64+type Author = Utf8.Utf8 AUTHOR
65+type Project = Utf8.Utf8 PROJECT
66+
67+data AUTHOR
68+data PROJECT
69+
70+
4971data Canonical =
5072 Canonical
5173 { _name :: !Name
@@ -60,127 +82,114 @@ data Canonical =
6082
6183isKernel :: Name -> Bool
6284isKernel (Name author _) =
63− author == "elm" || author == "elm-explorations"
64−
65−
66−toString :: Name -> Utf8.String
67−toString (Name author project) =
68− Utf8.join 0x2F [ Name.toUtf8 author, Name.toUtf8 project ]
85+ author == elm || author == elm_explorations
6986
7087
7188toChars :: Name -> String
7289toChars (Name author project) =
73− Name.toChars author <> "/" <> Name.toChars project
90+ Utf8.toChars author <> "/" <> Utf8.toChars project
7491
7592
7693toUrl :: Name -> String
7794toUrl (Name author project) =
78− Name.toChars author ++ "/" ++ Name.toChars project
95+ Utf8.toChars author ++ "/" ++ Utf8.toChars project
7996
8097
8198toFilePath :: Name -> FilePath
8299toFilePath (Name author project) =
83− Name.toChars author </> Name.toChars project
100+ Utf8.toChars author </> Utf8.toChars project
84101
85102
86−fromString :: Utf8.String -> Either BadName Name
87−fromString str =
88− case Utf8.split 0x2F {- / -} str of
89− [author, project]
90− | Utf8.isEmpty author -> Left BadStructure
91− | Utf8.isEmpty project -> Left BadStructure
92− | Utf8.size project >= 256 -> Left TooLong
93− | Utf8.containsDouble 0x2D {- - -} project -> Left HasDoubleDash
94− | Utf8.contains 0x5F {- _ -} project -> Left HasUnderscore
95− | Utf8.contains 0x2E {- . -} project -> Left HasDot
96− | Utf8.any Char.isUpper project -> Left HasUppercase
97− | Utf8.endsWithWord 0x2D {- - -} project -> Left HasDashEnd
98− | Utf8.startsWithChar Char.isLower project -> Right (Name (Name.fromUtf8 author) (Name.fromUtf8 project))
99− | True -> Left HasNonLowercaseStart
103+toJsonString :: Name -> Json.String
104+toJsonString (Name author project) =
105+ Utf8.join 0x2F {-/-} [ Coerce.coerce author, Coerce.coerce project ]
100106
101− _ ->
102− Left BadStructure
103107
104108
105−data BadName
106− = BadStructure
107− | TooLong
108− | HasDoubleDash
109− | HasUnderscore
110− | HasDot
111− | HasUppercase
112− | HasDashEnd
113− | HasNonLowercaseStart
114−
109+-- COMMON PACKAGE NAMES
115110
116111
117−-- COMMON PACKAGE NAMES
112+toName :: Author -> [Char] -> Name
113+toName author project =
114+ Name author (Utf8.fromChars project)
118115
119116
120117{-# NOINLINE dummyName #-}
121118dummyName :: Name
122119dummyName =
123− Name "author" "project"
120+ toName (Utf8.fromChars "author") "project"
124121
125122
126123{-# NOINLINE kernel #-}
127124kernel :: Name
128125kernel =
129− Name "elm" "kernel"
126+ toName elm "kernel"
130127
131128
132129{-# NOINLINE core #-}
133130core :: Name
134131core =
135− Name "elm" "core"
132+ toName elm "core"
136133
137134
138135{-# NOINLINE browser #-}
139136browser :: Name
140137browser =
141− Name "elm" "browser"
138+ toName elm "browser"
142139
143140
144141{-# NOINLINE virtualDom #-}
145142virtualDom :: Name
146143virtualDom =
147− Name "elm" "virtual-dom"
144+ toName elm "virtual-dom"
148145
149146
150147{-# NOINLINE html #-}
151148html :: Name
152149html =
153− Name "elm" "html"
150+ toName elm "html"
154151
155152
156153{-# NOINLINE json #-}
157154json :: Name
158155json =
159− Name "elm" "json"
156+ toName elm "json"
160157
161158
162159{-# NOINLINE http #-}
163160http :: Name
164161http =
165− Name "elm" "http"
162+ toName elm "http"
166163
167164
168165{-# NOINLINE url #-}
169166url :: Name
170167url =
171− Name "elm" "url"
168+ toName elm "url"
172169
173170
174171{-# NOINLINE webgl #-}
175172webgl :: Name
176173webgl =
177− Name "elm-explorations" "webgl"
174+ toName elm_explorations "webgl"
178175
179176
180177{-# NOINLINE linearAlgebra #-}
181178linearAlgebra :: Name
182179linearAlgebra =
183− Name "elm-explorations" "linear-algebra"
180+ toName elm_explorations "linear-algebra"
181+
182+
183+{-# NOINLINE elm #-}
184+elm :: Author
185+elm =
186+ Utf8.fromChars "elm"
187+
188+
189+{-# NOINLINE elm_explorations #-}
190+elm_explorations :: Author
191+elm_explorations =
192+ Utf8.fromChars "elm-explorations"
184193
185194
186195
@@ -190,28 +199,63 @@ linearAlgebra =
190199suggestions :: Map.Map Name.Name Name
191200suggestions =
192201 let
193− random = Name "elm" "random"
194− time = Name "elm" "time"
195− file = Name "elm" "file"
202+ random = toName elm "random"
203+ time = toName elm "time"
204+ file = toName elm "file"
196205 in
197206 Map.fromList
198− [ ("Browser", browser)
199− , ("File", file)
200− , ("File.Download", file)
201− , ("File.Select", file)
202− , ("Html", html)
203− , ("Html.Attributes", html)
204− , ("Html.Events", html)
205− , ("Http", http)
206− , ("Json.Decode", json)
207− , ("Json.Encode", json)
208− , ("Random", random)
209− , ("Time", time)
210− , ("Url.Parser", url)
211− , ("Url", url)
207+ [ "Browser" ==> browser
208+ , "File" ==> file
209+ , "File.Download" ==> file
210+ , "File.Select" ==> file
211+ , "Html" ==> html
212+ , "Html.Attributes" ==> html
213+ , "Html.Events" ==> html
214+ , "Http" ==> http
215+ , "Json.Decode" ==> json
216+ , "Json.Encode" ==> json
217+ , "Random" ==> random
218+ , "Time" ==> time
219+ , "Url.Parser" ==> url
220+ , "Url" ==> url
212221 ]
213222
214223
224+(==>) :: [Char] -> Name -> (Name.Name, Name)
225+(==>) moduleName package =
226+ ( Utf8.fromChars moduleName, package )
227+
228+
229+
230+-- NEARBY NAMES
231+
232+
233+nearbyNames :: Name -> [Name] -> [Name]
234+nearbyNames (Name author1 project1) possibleNames =
235+ let
236+ authorDist = authorDistance (Utf8.toChars author1)
237+ projectDist = projectDistance (Utf8.toChars project1)
238+
239+ addDistance name@(Name author2 project2) =
240+ ( authorDist author2 + projectDist project2, name )
241+ in
242+ map snd $ take 4 $
243+ List.sortBy (compare `on` fst) $
244+ map addDistance possibleNames
245+
246+
247+authorDistance :: [Char] -> Author -> Int
248+authorDistance given possibility =
249+ if possibility == elm || possibility == elm_explorations
250+ then 0
251+ else abs (Suggest.distance given (Utf8.toChars possibility))
252+
253+
254+projectDistance :: [Char] -> Project -> Int
255+projectDistance given possibility =
256+ abs (Suggest.distance given (Utf8.toChars possibility))
257+
258+
215259
216260-- INSTANCES
217261
@@ -234,9 +278,13 @@ instance Ord Name where
234278 GT -> GT
235279
236280
237−instance Binary Name where
238− get = liftM2 Name get get
239− put (Name a b) = put a >> put b
281+
282+-- BINARY
283+
284+
285+instance Binary Name where -- TODO try storing as a Word16
286+ get = liftM2 Name Utf8.getUnder256 Utf8.getUnder256
287+ put (Name a b) = Utf8.putUnder256 a >> Utf8.putUnder256 b
240288
241289
242290instance Binary Canonical where
@@ -248,17 +296,89 @@ instance Binary Canonical where
248296-- JSON
249297
250298
251−decoder :: Decode.Decoder BadName Name
299+decoder :: D.Decoder (Row, Col) Name
252300decoder =
253− do str <- Decode.string
254− case fromString str of
255− Right name ->
256− return name
257−
258− Left err ->
259− Decode.failure err
301+ D.customString parser (,)
260302
261303
262−encode :: Name -> Encode.Value
304+encode :: Name -> E.Value
263305encode name =
264− Encode.string (toString name)
306+ E.chars (toChars name)
307+
308+
309+keyDecoder :: (Row -> Col -> x) -> D.KeyDecoder x Name
310+keyDecoder toError =
311+ let
312+ keyParser =
313+ P.specialize (\(r,c) _ _ -> toError r c) parser
314+ in
315+ D.KeyDecoder keyParser toError
316+
317+
318+
319+-- PARSER
320+
321+
322+parser :: P.Parser (Row, Col) Name
323+parser =
324+ do author <- parseName isAlphaOrDigit isAlphaOrDigit
325+ P.word1 0x2F {-/-} (,)
326+ project <- parseName isLower isLowerOrDigit
327+ return (Name author project)
328+
329+
330+parseName :: (Word8 -> Bool) -> (Word8 -> Bool) -> P.Parser (Row, Col) (Utf8.Utf8 t)
331+parseName isGoodStart isGoodInner =
332+ P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->
333+ if pos >= end then
334+ eerr row col (,)
335+ else
336+ let !word = P.unsafeIndex pos in
337+ if not (isGoodStart word) then
338+ eerr row col (,)
339+ else
340+ let
341+ (# isGood, newPos #) = chompName isGoodInner (plusPtr pos 1) end False
342+ !len = fromIntegral (minusPtr newPos pos)
343+ !newCol = col + len
344+ in
345+ if isGood && len < 256 then
346+ let !newState = P.State src newPos end indent row newCol in
347+ cok (Utf8.fromPtr pos newPos) newState
348+ else
349+ cerr row newCol (,)
350+
351+
352+isLower :: Word8 -> Bool
353+isLower word =
354+ 0x61 {-a-} <= word && word <= 0x7A {-z-}
355+
356+
357+isLowerOrDigit :: Word8 -> Bool
358+isLowerOrDigit word =
359+ 0x61 {-a-} <= word && word <= 0x7A {-z-}
360+ || 0x30 {-0-} <= word && word <= 0x39 {-9-}
361+
362+
363+isAlphaOrDigit :: Word8 -> Bool
364+isAlphaOrDigit word =
365+ 0x61 {-a-} <= word && word <= 0x7A {-z-}
366+ || 0x41 {-A-} <= word && word <= 0x5A {-Z-}
367+ || 0x30 {-0-} <= word && word <= 0x39 {-9-}
368+
369+
370+chompName :: (Word8 -> Bool) -> Ptr Word8 -> Ptr Word8 -> Bool -> (# Bool, Ptr Word8 #)
371+chompName isGoodChar pos end prevWasDash =
372+ if pos >= end then
373+ (# not prevWasDash, pos #)
374+ else
375+ let !word = P.unsafeIndex pos in
376+ if isGoodChar word then
377+ chompName isGoodChar (plusPtr pos 1) end False
378+ else if word == 0x2D {---} then
379+ if prevWasDash then
380+ (# False, pos #)
381+ else
382+ chompName isGoodChar (plusPtr pos 1) end True
383+ else
384+ (# True, pos #)