@@ -4,44 +4,34 @@ module Elm.Package
44 ( Name(..)
55 , Canonical(..)
66 , isKernel
7− , toString, toText, toUrl, toFilePath
8− , fromText
7+ , toString
8+ , toChars
9+ , toUrl
10+ , toFilePath
11+ , BadName(..)
12+ , fromString
913 , dummyName, kernel, core
1014 , browser, virtualDom, html
1115 , json, http, url
1216 , webgl, linearAlgebra
1317 , suggestions
14− , Version(..)
15− , initialVersion, dummyVersion
16− , bumpPatch, bumpMinor, bumpMajor
17− , filterLatest, majorAndMinor
18− , versionToString, versionToText, versionFromText
1918 , decoder
2019 , encode
21− , versionDecoder
22− , encodeVersion
2320 )
2421 where
2522
2623
27−import Control.Monad (liftM, liftM2, liftM3)
28−import Data.Binary (Binary, get, getWord8, put, putWord8)
24+import Control.Monad (liftM2)
25+import Data.Binary (Binary, get, put)
2926import qualified Data.Char as Char
30−import Data.Function (on)
31−import qualified Data.List as List
3227import qualified Data.Name as Name
3328import qualified Data.Map as Map
3429import Data.Monoid ((<>))
35−import qualified Data.Text as Text
36−import qualified Data.Text.Read as Text
37−import qualified Data.Text.Lazy as B (toStrict)
38−import qualified Data.Text.Lazy.Builder as B (singleton, toLazyText)
39−import qualified Data.Text.Lazy.Builder.Int as B (decimal)
40−import Data.Text (Text)
41−import Data.Word (Word16)
30+import qualified Data.Utf8 as Utf8
4231import System.FilePath ((</>))
4332
44−import qualified Json.Decode.Internals as Decode
33+import qualified Elm.Version as V
34+import qualified Json.Decode as Decode
4535import qualified Json.Encode as Encode
4636
4737
@@ -60,7 +50,7 @@ data Name =
6050data Canonical =
6151 Canonical
6252 { _name :: !Name
63− , _version :: !Version
53+ , _version :: !V.Version
6454 }
6555 deriving (Eq, Ord)
6656
@@ -74,96 +64,54 @@ isKernel (Name author _) =
7464 author == "elm" || author == "elm-explorations"
7565
7666
77−toString :: Name -> String
67+toString :: Name -> Utf8.String
7868toString (Name author project) =
79− Name.toString author <> "/" <> Name.toString project
69+ Utf8.join 0x2F [ Name.toUtf8 author, Name.toUtf8 project ]
8070
8171
82−toText :: Name -> Text
83−toText name =
84− Text.pack (toString name)
72+toChars :: Name -> String
73+toChars (Name author project) =
74+ Name.toChars author <> "/" <> Name.toChars project
8575
8676
8777toUrl :: Name -> String
8878toUrl (Name author project) =
89− Name.toString author ++ "/" ++ Name.toString project
79+ Name.toChars author ++ "/" ++ Name.toChars project
9080
9181
9282toFilePath :: Name -> FilePath
9383toFilePath (Name author project) =
94− Name.toString author </> Name.toString project
95−
96−
97−fromText :: Text -> Either (String, [String]) Name
98−fromText text =
99− case Text.splitOn "/" text of
100− [ author, project ] | not (Text.null author || Text.null project) ->
101− Name (Name.fromString (Text.unpack author)) <$> validateProjectName project
84+ Name.toChars author </> Name.toChars project
85+
86+
87+fromString :: Utf8.String -> Either BadName Name
88+fromString str =
89+ case Utf8.split 0x2F {- / -} str of
90+ [author, project]
91+ | Utf8.isEmpty author -> Left BadStructure
92+ | Utf8.isEmpty project -> Left BadStructure
93+ | Utf8.size project >= 256 -> Left TooLong
94+ | Utf8.containsDouble 0x2D {- - -} project -> Left HasDoubleDash
95+ | Utf8.contains 0x5F {- _ -} project -> Left HasUnderscore
96+ | Utf8.contains 0x2E {- . -} project -> Left HasDot
97+ | Utf8.any Char.isUpper project -> Left HasUppercase
98+ | Utf8.endsWithWord 0x2D {- - -} project -> Left HasDashEnd
99+ | Utf8.startsWithChar Char.isLower project -> Right (Name (Name.fromUtf8 author) (Name.fromUtf8 project))
100+ | True -> Left HasNonLowercaseStart
102101
103102 _ ->
104− Left
105− ( "A valid package name looks like \"author/project\" requiring the author and project name together."
106− , []
107− )
108−
109−
110−validateProjectName :: Text -> Either (String, [String]) Name.Name
111−validateProjectName text =
112− if Text.isInfixOf "--" text then
113− Left $ thisCannot "have two dashes in a row" text (Text.replace "--" "-" text)
114−
115− else if Text.isInfixOf "_" text then
116− Left $ thisCannot "have underscores" text (Text.replace "_" "-" text)
117−
118− else if Text.isInfixOf "." text then
119− Left $ thisCannot "have dots" text (Text.replace "." "-" text)
120−
121− else if Text.any Char.isUpper text then
122− Left $ thisCannot "have upper case letters" text (decap text)
123−
124− else if not (Char.isLetter (Text.head text)) then
125− Left
126− ( "The project name \"" ++ Text.unpack text ++ "\" must start with a letter. Is there another name that captures what your package is for?"
127− , []
128− )
103+ Left BadStructure
129104
130− else if Text.isSuffixOf "-" text then
131− Left $ thisCannot "end with a dash" text (Text.dropEnd 1 text)
132105
133− else
134− Right (Name.fromString (Text.unpack text))
135−
136−
137−thisCannot :: String -> Text -> Text -> (String, [String])
138−thisCannot beLikeThis problemName suggestedName =
139− let name = Text.unpack suggestedName in
140− (
141− "The project name \"" ++ Text.unpack problemName ++ "\" cannot "
142− ++ beLikeThis ++ ". Try something like \"" ++ name ++ "\" instead?"
143− ,
144− [name]
145− )
146−
147−
148−decap :: Text -> Text
149−decap text =
150− let
151− chunks =
152− uncurry (:) (Text.foldr gatherCaps ([],[]) text)
153− in
154− Text.pack $
155− if any (\c -> length c == 1) chunks then
156− concat chunks
157− else
158− List.intercalate "-" chunks
159−
160−
161−gatherCaps :: Char -> (String, [String]) -> (String, [String])
162−gatherCaps char (buffer, chunks) =
163− if Char.isUpper char then
164− ( [], (Char.toLower char : buffer) : chunks )
165− else
166− (char:buffer, chunks)
106+data BadName
107+ = BadStructure
108+ | TooLong
109+ | HasDoubleDash
110+ | HasUnderscore
111+ | HasDot
112+ | HasUppercase
113+ | HasDashEnd
114+ | HasNonLowercaseStart
167115
168116
169117
@@ -254,99 +202,6 @@ suggestions =
254202
255203
256204
257−-- PACKAGE VERSIONS
258−
259−
260−data Version =
261− Version
262− { _major :: {-# UNPACK #-} !Word16
263− , _minor :: {-# UNPACK #-} !Word16
264− , _patch :: {-# UNPACK #-} !Word16
265− }
266− deriving (Eq, Ord)
267−
268−
269−initialVersion :: Version
270−initialVersion =
271− Version 1 0 0
272−
273−dummyVersion :: Version
274−dummyVersion =
275− Version 0 0 0
276−
277−
278−bumpPatch :: Version -> Version
279−bumpPatch (Version major minor patch) =
280− Version major minor (patch + 1)
281−
282−
283−bumpMinor :: Version -> Version
284−bumpMinor (Version major minor _patch) =
285− Version major (minor + 1) 0
286−
287−
288−bumpMajor :: Version -> Version
289−bumpMajor (Version major _minor _patch) =
290− Version (major + 1) 0 0
291−
292−
293−
294−-- FILTERING
295−
296−
297−filterLatest :: (Ord a) => (Version -> a) -> [Version] -> [Version]
298−filterLatest characteristic versions =
299− map last (List.groupBy ((==) `on` characteristic) (List.sort versions))
300−
301−
302−majorAndMinor :: Version -> ( Int, Int )
303−majorAndMinor (Version major minor _patch) =
304− ( fromIntegral major, fromIntegral minor )
305−
306−
307−
308−-- CONVERSIONS
309−
310−
311−versionToString :: Version -> String
312−versionToString version =
313− Text.unpack (versionToText version)
314−
315−
316−versionToText :: Version -> Text
317−versionToText (Version major minor patch) =
318− B.toStrict $ B.toLazyText $
319− B.decimal major
320− <> B.singleton '.'
321− <> B.decimal minor
322− <> B.singleton '.'
323− <> B.decimal patch
324−
325−
326−versionFromText :: Text -> Maybe Version
327−versionFromText text =
328− case Text.splitOn "." text of
329− [major, minor, patch] ->
330− Version
331− <$> toNumber major
332− <*> toNumber minor
333− <*> toNumber patch
334−
335− _ ->
336− Nothing
337−
338−
339−toNumber :: Text -> Maybe Word16
340−toNumber txt =
341− case Text.decimal txt of
342− Right (n, "") ->
343− Just n
344−
345− _ ->
346− Nothing
347−
348−
349−
350205-- BINARY
351206
352207
@@ -368,61 +223,21 @@ instance Binary Canonical where
368223 put version
369224
370225
371−instance Binary Version where
372− get =
373− do word <- getWord8
374− if word == 0
375− then liftM3 Version get get get
376− else
377− do minor <- liftM fromIntegral getWord8
378− patch <- liftM fromIntegral getWord8
379− return (Version (fromIntegral word) minor patch)
380−
381− put (Version major minor patch) =
382− if major < 256 && minor < 256 && patch < 256 then
383− do putWord8 (fromIntegral major)
384− putWord8 (fromIntegral minor)
385− putWord8 (fromIntegral patch)
386− else
387− do putWord8 0
388− put major
389− put minor
390− put patch
391−
392−
393226
394227-- JSON
395228
396229
397−decoder :: Decode.Decoder String Name
230+decoder :: Decode.Decoder BadName Name
398231decoder =
399− do txt <- Decode.text
400− case fromText txt of
232+ do str <- Decode.string
233+ case fromString str of
401234 Right name ->
402− Decode.succeed name
403−
404− Left (msg, _) ->
405− Decode.fail msg
235+ return name
406236
237+ Left err ->
238+ Decode.failure err
407239
408240
409241encode :: Name -> Encode.Value
410242encode name =
411− Encode.text (toText name)
412−
413−
414−
415−versionDecoder :: Decode.Decoder Text Version
416−versionDecoder =
417− do txt <- Decode.text
418− case versionFromText txt of
419− Just version ->
420− Decode.succeed version
421−
422− Nothing ->
423− Decode.fail txt
424−
425−
426−encodeVersion :: Version -> Encode.Value
427−encodeVersion version =
428− Encode.text (versionToText version)
243+ Encode.string (toString name)