git.iko.soy/elk
on master help sign in
start using D.customString in Elm.Package
18820a0Evan Czaplicki
compiler/src/Elm/Package.hs+207−87
compare with master
unifiedsplit
@@ -1,38 +1,53 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE BangPatterns, EmptyDataDecls, FlexibleInstances, UnboxedTuples #-}
3module Elm.Package
3module Elm.Package
4 ( Name(..)
4 ( Name(..)
5+ , Author
6+ , Project
5 , Canonical(..)
7 , Canonical(..)
6 , isKernel
8 , isKernel
7− , toString
8 , toChars
9 , toChars
9 , toUrl
10 , toUrl
10 , toFilePath
11 , toFilePath
11− , BadName(..)
12+ , toJsonString
12− , fromString
13+ --
13 , dummyName, kernel, core
14 , dummyName, kernel, core
14 , browser, virtualDom, html
15 , browser, virtualDom, html
15 , json, http, url
16 , json, http, url
16 , webgl, linearAlgebra
17 , webgl, linearAlgebra
18+ --
17 , suggestions
19 , suggestions
20+ , nearbyNames
21+ --
18 , decoder
22 , decoder
19 , encode
23 , encode
24+ , keyDecoder
25+ --
26+ , parser
20 )
27 )
21 where
28 where
22
29
23
30
24import Control.Monad (liftM2)
31import Control.Monad (liftM2)
25import Data.Binary (Binary, get, put)
32import Data.Binary (Binary, get, put)
26−import qualified Data.Char as Char
33+import qualified Data.Coerce as Coerce
34+import Data.Function (on)
27−import qualified Data.Name as Name
35+import qualified Data.List as List
28import qualified Data.Map as Map
36import qualified Data.Map as Map
37+import qualified Data.Name as Name
29import Data.Monoid ((<>))
38import Data.Monoid ((<>))
30import qualified Data.Utf8 as Utf8
39import qualified Data.Utf8 as Utf8
40+import Data.Word (Word8)
41+import Foreign.Ptr (Ptr, plusPtr, minusPtr)
31import System.FilePath ((</>))
42import System.FilePath ((</>))
32
43
33import qualified Elm.Version as V
44import qualified Elm.Version as V
34−import qualified Json.Decode as Decode
45+import qualified Json.Decode as D
35−import qualified Json.Encode as Encode
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
36
51
37
52
38
53
@@ -41,11 +56,18 @@ import qualified Json.Encode as Encode
41
56
42data Name =
57data Name =
43 Name
58 Name
44− { _author :: !Name.Name
59+ { _author :: !Author
45− , _project :: !Name.Name
60+ , _project :: !Project
46 }
61 }
47
62
48
63
64+type Author = Utf8.Utf8 AUTHOR
65+type Project = Utf8.Utf8 PROJECT
66+
67+data AUTHOR
68+data PROJECT
69+
70+
49data Canonical =
71data Canonical =
50 Canonical
72 Canonical
51 { _name :: !Name
73 { _name :: !Name
@@ -60,127 +82,114 @@ data Canonical =
60
82
61isKernel :: Name -> Bool
83isKernel :: Name -> Bool
62isKernel (Name author _) =
84isKernel (Name author _) =
63− author == "elm" || author == "elm-explorations"
85+ 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 ]
69
86
70
87
71toChars :: Name -> String
88toChars :: Name -> String
72toChars (Name author project) =
89toChars (Name author project) =
73− Name.toChars author <> "/" <> Name.toChars project
90+ Utf8.toChars author <> "/" <> Utf8.toChars project
74
91
75
92
76toUrl :: Name -> String
93toUrl :: Name -> String
77toUrl (Name author project) =
94toUrl (Name author project) =
78− Name.toChars author ++ "/" ++ Name.toChars project
95+ Utf8.toChars author ++ "/" ++ Utf8.toChars project
79
96
80
97
81toFilePath :: Name -> FilePath
98toFilePath :: Name -> FilePath
82toFilePath (Name author project) =
99toFilePath (Name author project) =
83− Name.toChars author </> Name.toChars project
100+ Utf8.toChars author </> Utf8.toChars project
84
101
85
102
86−fromString :: Utf8.String -> Either BadName Name
103+toJsonString :: Name -> Json.String
87−fromString str =
104+toJsonString (Name author project) =
88− case Utf8.split 0x2F {- / -} str of
89− [author, project]
105+ Utf8.join 0x2F {-/-} [ Coerce.coerce author, Coerce.coerce 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
100
106
101− _ ->
102− Left BadStructure
103
107
104
108
105−data BadName
109+-- COMMON PACKAGE NAMES
106− = BadStructure
107− | TooLong
108− | HasDoubleDash
109− | HasUnderscore
110− | HasDot
111− | HasUppercase
112− | HasDashEnd
113− | HasNonLowercaseStart
114−
115
110
116
111
117−-- COMMON PACKAGE NAMES
112+toName :: Author -> [Char] -> Name
113+toName author project =
114+ Name author (Utf8.fromChars project)
118
115
119
116
120{-# NOINLINE dummyName #-}
117{-# NOINLINE dummyName #-}
121dummyName :: Name
118dummyName :: Name
122dummyName =
119dummyName =
123− Name "author" "project"
120+ toName (Utf8.fromChars "author") "project"
124
121
125
122
126{-# NOINLINE kernel #-}
123{-# NOINLINE kernel #-}
127kernel :: Name
124kernel :: Name
128kernel =
125kernel =
129− Name "elm" "kernel"
126+ toName elm "kernel"
130
127
131
128
132{-# NOINLINE core #-}
129{-# NOINLINE core #-}
133core :: Name
130core :: Name
134core =
131core =
135− Name "elm" "core"
132+ toName elm "core"
136
133
137
134
138{-# NOINLINE browser #-}
135{-# NOINLINE browser #-}
139browser :: Name
136browser :: Name
140browser =
137browser =
141− Name "elm" "browser"
138+ toName elm "browser"
142
139
143
140
144{-# NOINLINE virtualDom #-}
141{-# NOINLINE virtualDom #-}
145virtualDom :: Name
142virtualDom :: Name
146virtualDom =
143virtualDom =
147− Name "elm" "virtual-dom"
144+ toName elm "virtual-dom"
148
145
149
146
150{-# NOINLINE html #-}
147{-# NOINLINE html #-}
151html :: Name
148html :: Name
152html =
149html =
153− Name "elm" "html"
150+ toName elm "html"
154
151
155
152
156{-# NOINLINE json #-}
153{-# NOINLINE json #-}
157json :: Name
154json :: Name
158json =
155json =
159− Name "elm" "json"
156+ toName elm "json"
160
157
161
158
162{-# NOINLINE http #-}
159{-# NOINLINE http #-}
163http :: Name
160http :: Name
164http =
161http =
165− Name "elm" "http"
162+ toName elm "http"
166
163
167
164
168{-# NOINLINE url #-}
165{-# NOINLINE url #-}
169url :: Name
166url :: Name
170url =
167url =
171− Name "elm" "url"
168+ toName elm "url"
172
169
173
170
174{-# NOINLINE webgl #-}
171{-# NOINLINE webgl #-}
175webgl :: Name
172webgl :: Name
176webgl =
173webgl =
177− Name "elm-explorations" "webgl"
174+ toName elm_explorations "webgl"
178
175
179
176
180{-# NOINLINE linearAlgebra #-}
177{-# NOINLINE linearAlgebra #-}
181linearAlgebra :: Name
178linearAlgebra :: Name
182linearAlgebra =
179linearAlgebra =
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"
184
193
185
194
186
195
@@ -190,28 +199,63 @@ linearAlgebra =
190suggestions :: Map.Map Name.Name Name
199suggestions :: Map.Map Name.Name Name
191suggestions =
200suggestions =
192 let
201 let
193− random = Name "elm" "random"
202+ random = toName elm "random"
194− time = Name "elm" "time"
203+ time = toName elm "time"
195− file = Name "elm" "file"
204+ file = toName elm "file"
196 in
205 in
197 Map.fromList
206 Map.fromList
198− [ ("Browser", browser)
207+ [ "Browser" ==> browser
199− , ("File", file)
208+ , "File" ==> file
200− , ("File.Download", file)
209+ , "File.Download" ==> file
201− , ("File.Select", file)
210+ , "File.Select" ==> file
202− , ("Html", html)
211+ , "Html" ==> html
203− , ("Html.Attributes", html)
212+ , "Html.Attributes" ==> html
204− , ("Html.Events", html)
213+ , "Html.Events" ==> html
205− , ("Http", http)
214+ , "Http" ==> http
206− , ("Json.Decode", json)
215+ , "Json.Decode" ==> json
207− , ("Json.Encode", json)
216+ , "Json.Encode" ==> json
208− , ("Random", random)
217+ , "Random" ==> random
209− , ("Time", time)
218+ , "Time" ==> time
210− , ("Url.Parser", url)
219+ , "Url.Parser" ==> url
211− , ("Url", url)
220+ , "Url" ==> url
212 ]
221 ]
213
222
214
223
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+
215
259
216-- INSTANCES
260-- INSTANCES
217
261
@@ -234,9 +278,13 @@ instance Ord Name where
234 GT -> GT
278 GT -> GT
235
279
236
280
281+
282+-- BINARY
283+
284+
237−instance Binary Name where
285+instance Binary Name where -- TODO try storing as a Word16
238− get = liftM2 Name get get
286+ get = liftM2 Name Utf8.getUnder256 Utf8.getUnder256
239− put (Name a b) = put a >> put b
287+ put (Name a b) = Utf8.putUnder256 a >> Utf8.putUnder256 b
240
288
241
289
242instance Binary Canonical where
290instance Binary Canonical where
@@ -248,17 +296,89 @@ instance Binary Canonical where
248-- JSON
296-- JSON
249
297
250
298
251−decoder :: Decode.Decoder BadName Name
299+decoder :: D.Decoder (Row, Col) Name
252decoder =
300decoder =
253− do str <- Decode.string
301+ D.customString parser (,)
254− case fromString str of
255− Right name ->
256− return name
257−
258− Left err ->
259− Decode.failure err
260
302
261
303
262−encode :: Name -> Encode.Value
304+encode :: Name -> E.Value
263encode name =
305encode 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 #)