@@ -3,12 +3,11 @@ module Elm.Package where
33import Control.Applicative ((<$>), (<*>))
44import Data.Aeson
55import Data.Binary
6+import qualified Data.Char as Char
7+import Data.Function (on)
68import qualified Data.List as List
79import qualified Data.Text as T
8−import qualified Data.Maybe as Maybe
910import System.FilePath ((</>))
10−import Data.Char (isDigit)
11−import Data.Function (on)
1211
1312
1413-- PACKGE NAMES
@@ -48,12 +47,42 @@ toFilePath name =
4847 user name </> project name
4948
5049
51−fromString :: String -> Maybe Name
50+fromString :: String -> Either String Name
5251fromString string =
5352 case break (=='/') string of
54− ( user@(_:_), '/' : project@(_:_) )
55− | all (/='/') project -> Just (Name user project)
56− _ -> Nothing
53+ ( user, '/' : project ) ->
54+ if null user then
55+ Left "You did not provide a user name (USER/PROJECT)"
56+
57+ else if null project then
58+ Left "You did not provide a project name (USER/PROJECT)"
59+
60+ else if all (/='/') project then
61+ Name user <$> validate project
62+
63+ else
64+ Left "Expecting only one slash, separating the user and project name (USER/PROJECT)"
65+
66+ _ ->
67+ Left "There should be a slash separating the user and project name (USER/PROJECT)"
68+
69+
70+validate :: String -> Either String String
71+validate str =
72+ if elem ('-','-') (zip str (tail str)) then
73+ Left "There is a double dash -- in your package name. It must be a single dash."
74+
75+ else if elem '_' str then
76+ Left "Underscores are not allowed in package names."
77+
78+ else if any Char.isUpper str then
79+ Left "Upper case characters are not allowed in package names."
80+
81+ else if not (Char.isLetter (head str)) then
82+ Left "Package names must start with a letter."
83+
84+ else
85+ Right str
5786
5887
5988instance Binary Name where
@@ -68,7 +97,12 @@ instance FromJSON Name where
6897 let
6998 string = T.unpack text
7099 in
71− Maybe.maybe (fail (errorMsg string)) return (fromString string)
100+ case fromString string of
101+ Left msg ->
102+ fail ("Ran into an invalid package name: " ++ string ++ "\n\n" ++ msg)
103+
104+ Right name ->
105+ return name
72106
73107 parseJSON _ =
74108 fail "Project name must be a string."
@@ -79,14 +113,6 @@ instance ToJSON Name where
79113 toJSON (toString name)
80114
81115
82−errorMsg :: String -> String
83−errorMsg string =
84− unlines
85− [ "Dependency file has an invalid name: " ++ string
86− , "Must have format USER/PROJECT and match a public github project."
87− ]
88−
89−
90116-- PACKAGE VERSIONS
91117
92118data Version = Version
@@ -147,7 +173,7 @@ versionFromString string =
147173 where
148174 splitNumbers :: String -> Maybe [Int]
149175 splitNumbers ns =
150− case span isDigit ns of
176+ case span Char.isDigit ns of
151177 ("", _) ->
152178 Nothing
153179