@@ -51,7 +51,7 @@ import qualified Json.Encode as Encode
5151
5252data Name =
5353 Name
54− { _user :: !Text
54+ { _author :: !Text
5555 , _project :: !Text
5656 }
5757 deriving (Eq, Ord)
@@ -70,8 +70,8 @@ data Package =
7070
7171
7272isKernel :: Name -> Bool
73−isKernel (Name user _) =
74− user == "elm-lang" || user == "elm-explorations"
73+isKernel (Name author _) =
74+ author == "elm-lang" || author == "elm-explorations"
7575
7676
7777toString :: Name -> String
@@ -80,54 +80,92 @@ toString name =
8080
8181
8282toText :: Name -> Text
83−toText (Name user project) =
84− user <> "/" <> project
83+toText (Name author project) =
84+ author <> "/" <> project
8585
8686
8787toUrl :: Name -> String
88−toUrl (Name user project) =
89− Text.unpack user ++ "/" ++ Text.unpack project
88+toUrl (Name author project) =
89+ Text.unpack author ++ "/" ++ Text.unpack project
9090
9191
9292toFilePath :: Name -> FilePath
93−toFilePath (Name user project) =
94− Text.unpack user </> Text.unpack project
93+toFilePath (Name author project) =
94+ Text.unpack author </> Text.unpack project
9595
9696
97−fromText :: Text -> Either String Name
97+fromText :: Text -> Either (String, [String]) Name
9898fromText text =
9999 case Text.splitOn "/" text of
100− [ user, project ] | not (Text.null user || Text.null project) ->
101− Name user <$> validateProjectName project
100+ [ author, project ] | not (Text.null author || Text.null project) ->
101+ Name author <$> validateProjectName project
102102
103103 _ ->
104− Left "A valid project name looks like `user/project`"
104+ Left
105+ ( "A valid package name looks like \"author/project\" requiring the author and project name together."
106+ , []
107+ )
105108
106109
107−validateProjectName :: Text -> Either String Text
110+validateProjectName :: Text -> Either (String, [String]) Text
108111validateProjectName text =
109112 if Text.isInfixOf "--" text then
110− Left "There is a double dash -- in your package name. It must be a single dash."
113+ Left $ thisCannot "have two dashes in a row" text (Text.replace "--" "-" text)
111114
112115 else if Text.isInfixOf "_" text then
113− Left "Underscores are not allowed in package names."
116+ Left $ thisCannot "have underscores" text (Text.replace "_" "-" text)
114117
115118 else if Text.isInfixOf "." text then
116− Left "Dots are not allowed in package names."
119+ Left $ thisCannot "have dots" text (Text.replace "." "-" text)
117120
118121 else if Text.any Char.isUpper text then
119− Left "Upper case characters are not allowed in package names."
122+ Left $ thisCannot "have upper case letters" text (decap text)
120123
121124 else if not (Char.isLetter (Text.head text)) then
122− Left "Package names must start with a letter."
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+ )
123129
124130 else if Text.isSuffixOf "-" text then
125− Left "Package names cannot end with a dash."
131+ Left $ thisCannot "end with a dash" text (Text.dropEnd 1 text)
126132
127133 else
128134 Right text
129135
130136
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)
167+
168+
131169
132170-- COMMON PACKAGE NAMES
133171
@@ -135,7 +173,7 @@ validateProjectName text =
135173{-# NOINLINE dummyName #-}
136174dummyName :: Name
137175dummyName =
138− Name "user" "project"
176+ Name "author" "project"
139177
140178
141179{-# NOINLINE kernel #-}
@@ -316,8 +354,8 @@ instance Binary Name where
316354 get =
317355 liftM2 Name get get
318356
319− put (Name user project) =
320− do put user
357+ put (Name author project) =
358+ do put author
321359 put project
322360
323361
@@ -363,7 +401,7 @@ decoder =
363401 Right name ->
364402 Decode.succeed name
365403
366− Left msg ->
404+ Left (msg, _) ->
367405 Decode.fail msg
368406
369407