@@ -9,6 +9,7 @@ module Unison.Project
99 projectNameUserSlug ,
1010 projectNameToUserProjectSlugs ,
1111 prependUserSlugToProjectName ,
12+ isValidNewProjectName ,
1213 ProjectBranchName ,
1314 projectBranchNameUserSlug ,
1415 projectBranchNameToValidProjectBranchNameText ,
3435
3536import Data.Char qualified as Char
3637import Data.Kind (Type )
38+ import Data.Monoid qualified as Monoid
3739import Data.Text qualified as Text
3840import Data.Text.Read qualified as Text (decimal )
3941import Data.These (These (.. ))
@@ -75,6 +77,56 @@ projectNameParser = do
7577 isStartChar c =
7678 Char. isAlpha c || c == ' _'
7779
80+ -- Parse a project name, and whether it ended in a forward slash (which is, of course, not part of the name)
81+ newProjectNameParser :: Megaparsec. ParsecVoid Text (ProjectName , Bool
82+ newProjectNameParser = do
83+ userSlug <-
84+ asum
85+ [ do
86+ user <- userSlugParser
87+ pure (Text.Builder. char ' @' <> user <> Text.Builder. char ' /'
88+ pure mempty
89+ ]
90+ projectSlug <- projectSlugParser
91+ hasTrailingSlash <- isJust <$> optional (Megaparsec. char ' /'
92+ pure (UnsafeProjectName (Text.Builder. run (userSlug <> projectSlug)), hasTrailingSlash)
93+ where
94+ -- Github project regular expression: ^[a-z\d](?:[a-z\d]|-(?=[a-z\d])){1,39}$
95+ --
96+ -- In English: a-z or 0-9, followed by 1-39 repetitions of a-z or 0-9 or hyphen, with the restriction that any
97+ -- hyphen must be followed by a-z or 0-9
98+ --
99+ -- We implement that here, but with parser combinators: a-z or 0-9, followed by 1 or more chunks of [optional
100+ -- hyphen followed by 1 or more a-z or 0-9], checking length at the end
101+ projectSlugParser :: Megaparsec. ParsecVoid Text Text. Builder
102+ projectSlugParser = do
103+ firstChar <- Megaparsec. satisfy isAsciiLowerOrDigit
104+ chunks <- some ((,) <$> optional (Megaparsec. char ' -' <*> Megaparsec. takeWhile1P Nothing isAsciiLowerOrDigit)
105+ when (chunksLength chunks > 39 ) (fail " Project name must be 2-40 characters long."
106+ pure $
107+ Text.Builder. char firstChar
108+ <> foldMap
109+ ( \ (maybeHyphen, chunk) ->
110+ maybe (mempty @ Text. BuilderText.Builder. char maybeHyphen <> Text.Builder. text chunk
111+ )
112+ chunks
113+ where
114+ isAsciiLowerOrDigit :: Char -> Bool
115+ isAsciiLowerOrDigit c =
116+ Char. isAsciiLower c || Char. isDigit c
117+
118+ chunksLength :: [(Maybe Char Text )] -> Int
119+ chunksLength =
120+ Monoid. getSum . foldMap (Monoid. Sum. chunkLength)
121+
122+ chunkLength :: (Maybe Char Text ) -> Int
123+ chunkLength (maybeHyphen, chunk) =
124+ (if isJust maybeHyphen then 1 else 0 ) + Text. length chunk
125+
126+ isValidNewProjectName :: ProjectName -> Bool
127+ isValidNewProjectName (UnsafeProjectName projectName) =
128+ isRight (Megaparsec. parse newProjectNameParser " "
129+
78130-- | Get the user slug at the beginning of a project name, if there is one.
79131--
80132-- >>> projectNameUserSlug "@arya/lens"
0 commit comments