@@ -1,6 +1,18 @@
11{-# OPTIONS_GHC -Wall #-}
22{-# LANGUAGE OverloadedStrings #-}
3−module Elm.Package where
3+module Elm.Package
4+ ( Name(..)
5+ , Package
6+ , dummyName, core, virtualDom, html
7+ , toString, toText, toUrl, toFilePath
8+ , fromText
9+ , Version(..)
10+ , initialVersion, dummyVersion
11+ , bumpPatch, bumpMinor, bumpMajor
12+ , filterLatest, majorAndMinor
13+ , versionToString, versionFromText
14+ )
15+ where
416
517import Data.Aeson
618import Data.Binary
@@ -9,6 +21,7 @@ import Data.Function (on)
921import qualified Data.List as List
1022import Data.Monoid ((<>))
1123import qualified Data.Text as Text
24+import qualified Data.Text.Read as Text
1225import Data.Text (Text)
1326import System.FilePath ((</>))
1427
@@ -17,7 +30,8 @@ import System.FilePath ((</>))
1730-- PACKGE NAMES
1831
1932
20−data Name = Name
33+data Name =
34+ Name
2135 { _user :: Text
2236 , _project :: Text
2337 }
@@ -67,68 +81,32 @@ toFilePath (Name user project) =
6781 Text.unpack user </> Text.unpack project
6882
6983
70−fromString :: String -> Either String Name
71−fromString string =
72− case break (=='/') string of
73− ( user, '/' : project ) ->
74− if null user then
75− Left "You did not provide a user name (user/project)"
84+fromText :: Text -> Either String Name
85+fromText text =
86+ case Text.splitOn "/" text of
87+ [ user, project ] | not (Text.null user || Text.null project) ->
88+ Name user <$> validateProjectName project
7689
77− else if null project then
78− Left "You did not provide a project name (user/project)"
90+ _ ->
91+ Left "A valid project name looks like `user/project`"
7992
80− else if all (/='/') project then
81− Name (Text.pack user) <$> validateProjectName project
8293
83− else
84− Left "Expecting only one slash, separating the user and project name (user/project)"
94+validateProjectName :: Text -> Either String Text
95+validateProjectName text =
96+ if Text.isInfixOf "--" text then
97+ Left "There is a double dash -- in your package name. It must be a single dash."
8598
86− _ ->
87− Left "There should be a slash separating the user and project name (user/project)"
88−
89−
90−whitelistedUppercaseName :: String -> Bool
91−whitelistedUppercaseName name =
92− -- These packages were uploaded to package.elm-lang.org before version 0.16,
93− -- when uppercase letters were disallowed in package names.
94− -- They should be considered deprecated and removed from this list once users
95− -- migrate to using the lowercase versions of the names.
96− List.elem name
97− [ "Easing"
98− , "LoadAssets"
99− , "elm-MultiDimArray"
100− , "elm-SafeLists"
101− , "GraphicsEngine"
102− , "Elm-Css"
103− , "Elm-Test"
104− , "DateOp"
105− , "IO"
106− , "Elm-Align-Distribute"
107− , "Elm-Format-String"
108− , "Elm-Multiset"
109− , "Elm-Random-Sampling"
110− , "ElmCache"
111− , "ExternalStorage"
112− , "IntRange"
113− ]
114−
115−
116−validateProjectName :: String -> Either String Text
117−validateProjectName str =
118− if elem ('-','-') (zip str (tail str)) then
119− Left "There is a double dash -- in your package name. It must be a single dash."
120−
121− else if elem '_' str then
122− Left "Underscores are not allowed in package names."
123−
124− else if any Char.isUpper str && not (whitelistedUppercaseName str) then
125− Left "Upper case characters are not allowed in package names."
126−
127− else if not (Char.isLetter (head str)) then
128− Left "Package names must start with a letter."
99+ else if Text.isInfixOf "_" text then
100+ Left "Underscores are not allowed in package names."
101+
102+ else if Text.any Char.isUpper text then
103+ Left "Upper case characters are not allowed in package names."
104+
105+ else if not (Char.isLetter (Text.head text)) then
106+ Left "Package names must start with a letter."
129107
130108 else
131− Right (Text.pack str)
109+ Right text
132110
133111
134112instance Binary Name where
@@ -140,15 +118,14 @@ instance Binary Name where
140118
141119instance FromJSON Name where
142120 parseJSON (String text) =
143− let
144− string = Text.unpack text
145− in
146− case fromString string of
147− Left msg ->
148− fail ("Ran into an invalid package name: " ++ string ++ "\n\n" ++ msg)
121+ case fromText text of
122+ Left msg ->
123+ fail $
124+ "Ran into an invalid package name: "
125+ ++ Text.unpack text ++ "\n\n" ++ msg
149126
150− Right name ->
151− return name
127+ Right name ->
128+ return name
152129
153130 parseJSON _ =
154131 fail "Project name must be a string."
@@ -161,7 +138,8 @@ instance ToJSON Name where
161138
162139-- PACKAGE VERSIONS
163140
164−data Version = Version
141+data Version =
142+ Version
165143 { _major :: Int
166144 , _minor :: Int
167145 , _patch :: Int
@@ -210,53 +188,52 @@ versionToString (Version major minor patch) =
210188 show major ++ "." ++ show minor ++ "." ++ show patch
211189
212190
213−versionFromString :: String -> Either String Version
214−versionFromString string =
215− case splitNumbers string of
216− Just [major, minor, patch] ->
217− Right (Version major minor patch)
218− _ ->
219− Left "Must have format MAJOR.MINOR.PATCH (e.g. 1.0.2)"
220− where
221− splitNumbers :: String -> Maybe [Int]
222− splitNumbers ns =
223− case span Char.isDigit ns of
224− ("", _) ->
225− Nothing
191+versionFromText :: Text -> Either String Version
192+versionFromText text =
193+ let
194+ chunks =
195+ Text.splitOn "." text
226196
227− (numbers, []) ->
228− Just [ read numbers ]
197+ toNumber txt =
198+ case Text.decimal txt of
199+ Right (n, "") ->
200+ Just n
229201
230− (numbers, '.':rest) ->
231− (read numbers :) <$> splitNumbers rest
202+ _ ->
203+ Nothing
204+ in
205+ case traverse toNumber chunks of
206+ Just [major, minor, patch] ->
207+ Right (Version major minor patch)
232208
233− _ ->
234− Nothing
209+ _ ->
210+ Left "Must have format MAJOR.MINOR.PATCH (e.g. 1.0.2)"
235211
236212
237213instance Binary Version where
238− get = Version <$> get <*> get <*> get
239− put (Version major minor patch) =
240− do put major
241− put minor
242− put patch
214+ get =
215+ Version <$> get <*> get <*> get
243216
217+ put (Version major minor patch) =
218+ do put major
219+ put minor
220+ put patch
244221
245−instance FromJSON Version where
246− parseJSON (String text) =
247− let string = Text.unpack text in
248− case versionFromString string of
249− Right v ->
250− return v
251222
252− Left problem ->
253− fail $ unlines
254− [ "Ran into an invalid version number: " ++ string
255− , problem
256− ]
257−
258− parseJSON _ =
259− fail "Version number must be stored as a string."
223+instance FromJSON Version where
224+ parseJSON (String text) =
225+ case versionFromText text of
226+ Right version ->
227+ return version
228+
229+ Left problem ->
230+ fail $ unlines $
231+ [ "Ran into an invalid version number: " ++ Text.unpack text
232+ , problem
233+ ]
234+
235+ parseJSON _ =
236+ fail "Version number must be stored as a string."
260237
261238
262239instance ToJSON Version where