add project.create input pattern

unison-cli/package.yaml

@@ -88,6 +88,7 @@ dependencies:
   - witherable
   - wai
   - warp
+  - witch
   - witherable
 
 library:

unison-cli/src/Unison/Codebase/Editor/Input.hs

@@ -38,6 +38,7 @@ import Unison.Codebase.Verbosity
 import qualified Unison.HashQualified as HQ
 import Unison.Name (Name)
 import Unison.NameSegment (NameSegment)
+import Unison.Project (ProjectName)
 import Unison.Prelude
 import Unison.ShortHash (ShortHash)
 import qualified Unison.Util.Pretty as P
@@ -208,6 +209,7 @@ data Input
   | AuthLoginI
   | VersionI
   | DiffNamespaceToPatchI DiffNamespaceToPatchInput
+  | CreateProjectI ProjectName
   deriving (Eq, Show)
 
 data DiffNamespaceToPatchInput = DiffNamespaceToPatchInput

unison-cli/src/Unison/CommandLine/InputPatterns.hs

@@ -43,11 +43,13 @@ import qualified Unison.HashQualified as HQ
 import Unison.Name (Name)
 import qualified Unison.NameSegment as NameSegment
 import Unison.Prelude
+import Unison.Project (ProjectName)
 import qualified Unison.Syntax.HashQualified as HQ (fromString)
 import qualified Unison.Syntax.Name as Name (unsafeFromString)
 import qualified Unison.Util.ColorText as CT
 import Unison.Util.Monoid (intercalateMap)
 import qualified Unison.Util.Pretty as P
+import Witch
 
 showPatternHelp :: InputPattern -> P.Pretty CT.ColorText
 showPatternHelp i =
@@ -2154,7 +2156,7 @@ runScheme =
         ]
     )
     ( \case
-        (main:args) ->
+        (main : args) ->
           flip Input.ExecuteSchemeI args <$> parseHashQualifiedName main
         _ -> Left $ showPatternHelp runScheme
     )
@@ -2336,6 +2338,22 @@ diffNamespaceToPatch =
         _ -> Left (showPatternHelp diffNamespaceToPatch)
     }
 
+projectCreate :: InputPattern
+projectCreate =
+  InputPattern
+    { patternName = "project.create",
+      aliases = undefined,
+      visibility = I.Visible,
+      argTypes = [(Required, projectNameArg)],
+      help = P.wrap "Create a project.",
+      parse = \case
+        [name] ->
+          case tryInto @ProjectName (Text.pack name) of
+            Left _ -> Left "Invalid project name."
+            Right name1 -> Right (Input.CreateProjectI name1)
+        _ -> Left (showPatternHelp projectCreate)
+    }
+
 validInputs :: [InputPattern]
 validInputs =
   sortOn
@@ -2576,6 +2594,15 @@ remoteNamespaceArg =
       globTargets = mempty
     }
 
+-- | A project name.
+projectNameArg :: ArgumentType
+projectNameArg =
+  ArgumentType
+    { typeName = "project name",
+      suggestions = \_ _ _ _ -> pure [],
+      globTargets = Set.empty
+    }
+
 collectNothings :: (a -> Maybe b) -> [a] -> [a]
 collectNothings f as = [a | (Nothing, a) <- map f as `zip` as]
 

unison-cli/unison-cli.cabal

@@ -202,6 +202,7 @@ library
     , vector
     , wai
     , warp
+    , witch
     , witherable
   if flag(optimized)
     ghc-options: -O2 -funbox-strict-fields
@@ -330,6 +331,7 @@ executable cli-integration-tests
     , vector
     , wai
     , warp
+    , witch
     , witherable
   if flag(optimized)
     ghc-options: -O2 -funbox-strict-fields
@@ -452,6 +454,7 @@ executable transcripts
     , vector
     , wai
     , warp
+    , witch
     , witherable
   if flag(optimized)
     ghc-options: -O2 -funbox-strict-fields
@@ -581,6 +584,7 @@ executable unison
     , vector
     , wai
     , warp
+    , witch
     , witherable
   if flag(optimized)
     ghc-options: -O2 -funbox-strict-fields
@@ -713,6 +717,7 @@ test-suite cli-tests
     , vector
     , wai
     , warp
+    , witch
     , witherable
   if flag(optimized)
     ghc-options: -O2 -funbox-strict-fields

unison-core/package.yaml

@@ -31,6 +31,7 @@ library:
     - unison-util-base32hex
     - unison-util-relation
     - vector
+    - witch
 
 default-extensions:
   - ApplicativeDo

unison-core/src/Unison/Project.hs

@@ -0,0 +1,36 @@
+module Unison.Project
+  ( ProjectName,
+  )
+where
+
+import qualified Data.Char as Char
+import qualified Data.Text as Text
+import Unison.Prelude
+import Witch
+
+-- | The name of a project.
+--
+-- Convert to and from text with the 'From' and 'TryFrom' instances.
+newtype ProjectName
+  = ProjectName Text
+  deriving stock (Eq, Ord, Show)
+
+instance From ProjectName Text
+
+instance TryFrom Text ProjectName where
+  -- project-name            = project-name-start-char project-name-char*
+  -- project-name-start-char = alpha | - | _ | / | @
+  -- project-name-char       = project-name-start-char | num
+  tryFrom = do
+    maybeTryFrom \name -> do
+      (c, cs) <- Text.uncons name
+      guard (isValidStartChar c && Text.all isValidChar cs)
+      Just (ProjectName name)
+    where
+      isValidStartChar :: Char -> Bool
+      isValidStartChar c =
+        Char.isAlpha c || c == '-' || c == '_' || c == '/' || c == '@'
+
+      isValidChar :: Char -> Bool
+      isValidChar c =
+        isValidStartChar c || Char.isNumber c

unison-core/unison-core1.cabal

@@ -44,6 +44,7 @@ library
       Unison.NamesWithHistory
       Unison.Pattern
       Unison.Position
+      Unison.Project
       Unison.Reference
       Unison.Referent
       Unison.Referent'
@@ -106,6 +107,7 @@ library
     , unison-util-base32hex
     , unison-util-relation
     , vector
+    , witch
   if flag(optimized)
     ghc-options: -O2 -funbox-strict-fields
   default-language: Haskell2010