git.iko.soy/elk
on master help sign in
Restrict the set of valid package names
858394dEvan Czaplicki
src/Elm/Package.hs+43−17
compare with master
unifiedsplit
@@ -3,12 +3,11 @@ module Elm.Package where
3import Control.Applicative ((<$>), (<*>))
3import Control.Applicative ((<$>), (<*>))
4import Data.Aeson
4import Data.Aeson
5import Data.Binary
5import Data.Binary
6+import qualified Data.Char as Char
7+import Data.Function (on)
6import qualified Data.List as List
8import qualified Data.List as List
7import qualified Data.Text as T
9import qualified Data.Text as T
8−import qualified Data.Maybe as Maybe
9import System.FilePath ((</>))
10import System.FilePath ((</>))
10−import Data.Char (isDigit)
11−import Data.Function (on)
12
11
13
12
14-- PACKGE NAMES
13-- PACKGE NAMES
@@ -48,12 +47,42 @@ toFilePath name =
48 user name </> project name
47 user name </> project name
49
48
50
49
51−fromString :: String -> Maybe Name
50+fromString :: String -> Either String Name
52fromString string =
51fromString string =
53 case break (=='/') string of
52 case break (=='/') string of
54− ( user@(_:_), '/' : project@(_:_) )
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
55− | all (/='/') project -> Just (Name user project)
61+ Name user <$> validate project
56− _ -> Nothing
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
57
86
58
87
59instance Binary Name where
88instance Binary Name where
@@ -68,7 +97,12 @@ instance FromJSON Name where
68 let
97 let
69 string = T.unpack text
98 string = T.unpack text
70 in
99 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
72
106
73 parseJSON _ =
107 parseJSON _ =
74 fail "Project name must be a string."
108 fail "Project name must be a string."
@@ -79,14 +113,6 @@ instance ToJSON Name where
79 toJSON (toString name)
113 toJSON (toString name)
80
114
81
115
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−
90-- PACKAGE VERSIONS
116-- PACKAGE VERSIONS
91
117
92data Version = Version
118data Version = Version
@@ -147,7 +173,7 @@ versionFromString string =
147 where
173 where
148 splitNumbers :: String -> Maybe [Int]
174 splitNumbers :: String -> Maybe [Int]
149 splitNumbers ns =
175 splitNumbers ns =
150− case span isDigit ns of
176+ case span Char.isDigit ns of
151 ("", _) ->
177 ("", _) ->
152 Nothing
178 Nothing
153
179