-- | @project.create@ input handler
module Unison.Codebase.Editor.HandleInput.ProjectCreate
  ( projectCreate,
  )
where

import Control.Lens
import Control.Monad.Reader (ask)
import Data.Text qualified as Text
import System.Random.Shuffle qualified as RandomShuffle
import U.Codebase.Sqlite.DbId
import U.Codebase.Sqlite.Project (Project (..))
import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..))
import U.Codebase.Sqlite.Queries (expectCausalHashIdByCausalHash)
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.Cli.DownloadUtils (downloadProjectBranchFromShare)
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.Share.Projects qualified as Share
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Causal qualified as Causal
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.SqliteCodebase.Operations qualified as Ops
import Unison.NameSegment qualified as NameSegment
import Unison.Prelude
import Unison.Project (ProjectAndBranch (..), ProjectName)
import Unison.Share.API.Hash qualified as Share.API
import Unison.Sync.Common qualified as Sync.Common
import Witch (unsafeFrom)

-- | Create a new project.
--
-- 1. If a project already exists with the given name, bail.
--
-- 2. Otherwise, create a scaffold out a new project with a "main" branch, and add it to the namespace (at a magic
--    location that the user isn't supposed to look at).
--
-- Big danger: we first commit the project identity and metadata (like its name) to the codebase, then manipulate our
-- in-memory namespace and flush its contents out in a separate transaction. This means that if lightning strikes at the
-- wrong time, we'll be in an inconsistent state.
--
-- This could be fixed in a few different ways:
--
--   1. Make a better `stepAt` helper that can mutate the namespace in a transaction.
--
--   2. Add more code to detect the inconsistency and work around it. For example, if we ever see that a project id
--      exists in the codebase but not at its corresponding place in the namespace, we could consider it garbage and
--      delete it. Then, any user who tried to create a project called "foo" shortly before getting hit by lightning
--      could simply try creating "foo" again later.
--
--   3. Don't store projects in the root namespace at all. We don't even want them there, it's just a little too
--      convenient because *not* storing them in the root namespace would require a lot of reworking and rewriting. We'd
--      rather hit some shorter-term project milestones and clean our mess up Later (TM).
--
-- For now, it doesn't seem worth it to do (1) or (2), since we want to do (3) eventually, and we'd rather not waste too
-- much time getting everything perfectly correct before we get there.
projectCreate :: Bool -> Maybe ProjectName -> Cli (ProjectAndBranch ProjectId ProjectBranchId)
projectCreate :: Bool
-> Maybe ProjectName
-> Cli (ProjectAndBranch ProjectId ProjectBranchId)
projectCreate Bool
tryDownloadingBase Maybe ProjectName
maybeProjectName = do
  let branchName :: ProjectBranchName
branchName = forall source target.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeFrom @Text Text
"main"
  (CausalHash
_, CausalHashId
emptyCausalHashId) <- Transaction (CausalHash, CausalHashId)
-> Cli (CausalHash, CausalHashId)
forall a. Transaction a -> Cli a
Cli.runTransaction Transaction (CausalHash, CausalHashId)
Codebase.emptyCausalHash

  (Project
project, ProjectBranch
branch) <-
    case Maybe ProjectName
maybeProjectName of
      Maybe ProjectName
Nothing -> do
        [ProjectName]
randomProjectNames <- IO [ProjectName] -> Cli [ProjectName]
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [ProjectName]
generateRandomProjectNames
        Transaction (Project, ProjectBranch)
-> Cli (Project, ProjectBranch)
forall a. Transaction a -> Cli a
Cli.runTransaction do
          let loop :: [ProjectName] -> Transaction (Project, ProjectBranch)
loop = \case
                [] -> [Char] -> Transaction (Project, ProjectBranch)
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char] -> [Char]
reportBug [Char]
"E066388" [Char]
"project name supply is supposed to be infinite")
                ProjectName
projectName : [ProjectName]
projectNames ->
                  ProjectName -> Transaction (Maybe Project)
Queries.loadProjectByName ProjectName
projectName Transaction (Maybe Project)
-> (Maybe Project -> Transaction (Project, ProjectBranch))
-> Transaction (Project, ProjectBranch)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Maybe Project
Nothing -> do
                      (Project
project, ProjectBranch
branch) <- ProjectName
-> ProjectBranchName
-> CausalHashId
-> Transaction (Project, ProjectBranch)
Ops.insertProjectAndBranch ProjectName
projectName ProjectBranchName
branchName CausalHashId
emptyCausalHashId
                      (Project, ProjectBranch) -> Transaction (Project, ProjectBranch)
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Project
project, ProjectBranch
branch)
                    Just Project
_project -> [ProjectName] -> Transaction (Project, ProjectBranch)
loop [ProjectName]
projectNames
          [ProjectName] -> Transaction (Project, ProjectBranch)
loop [ProjectName]
randomProjectNames
      Just ProjectName
projectName -> do
        ((forall void. Output -> Transaction void)
 -> Transaction (Project, ProjectBranch))
-> Cli (Project, ProjectBranch)
forall a.
((forall void. Output -> Transaction void) -> Transaction a)
-> Cli a
Cli.runTransactionWithRollback \forall void. Output -> Transaction void
rollback -> do
          ProjectName -> Transaction Bool
Queries.projectExistsByName ProjectName
projectName Transaction Bool
-> (Bool -> Transaction (Project, ProjectBranch))
-> Transaction (Project, ProjectBranch)
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Bool
False -> do
              ProjectName
-> ProjectBranchName
-> CausalHashId
-> Transaction (Project, ProjectBranch)
Ops.insertProjectAndBranch ProjectName
projectName ProjectBranchName
branchName CausalHashId
emptyCausalHashId
            Bool
True -> Output -> Transaction (Project, ProjectBranch)
forall void. Output -> Transaction void
rollback (ProjectName -> Output
Output.ProjectNameAlreadyExists ProjectName
projectName)

  Output -> Cli ()
Cli.respond (Bool -> ProjectName -> Output
Output.CreatedProject (Maybe ProjectName -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ProjectName
maybeProjectName) Project
project.name)
  ProjectAndBranch ProjectId ProjectBranchId -> Cli ()
Cli.switchProject (ProjectId
-> ProjectBranchId -> ProjectAndBranch ProjectId ProjectBranchId
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Project
project.projectId ProjectBranch
branch.branchId)

  Maybe (Branch IO)
maybeBaseLatestReleaseBranchObject <-
    if Bool
tryDownloadingBase
      then do
        Output -> Cli ()
Cli.respond Output
Output.FetchingLatestReleaseOfBase

        -- Make an effort to pull the latest release of base, which can go wrong in a number of ways, the most likely of
        -- which is that the user is offline.
        Maybe (Branch IO)
maybeBaseLatestReleaseBranchObject <-
          ((forall void. Maybe (Branch IO) -> Cli void)
 -> Cli (Maybe (Branch IO)))
-> Cli (Maybe (Branch IO))
forall a. ((forall void. a -> Cli void) -> Cli a) -> Cli a
Cli.label \forall void. Maybe (Branch IO) -> Cli void
done -> do
            RemoteProject
baseProject <-
              ProjectName -> Cli (Either ClientError (Maybe RemoteProject))
Share.getProjectByName' (forall source target.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeFrom @Text Text
"@unison/base") Cli (Either ClientError (Maybe RemoteProject))
-> (Either ClientError (Maybe RemoteProject) -> Cli RemoteProject)
-> Cli RemoteProject
forall a b. Cli a -> (a -> Cli b) -> Cli b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Right (Just RemoteProject
baseProject) -> RemoteProject -> Cli RemoteProject
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RemoteProject
baseProject
                Either ClientError (Maybe RemoteProject)
_ -> Maybe (Branch IO) -> Cli RemoteProject
forall void. Maybe (Branch IO) -> Cli void
done Maybe (Branch IO)
forall a. Maybe a
Nothing
            Semver
ver <- RemoteProject
baseProject RemoteProject
-> Getting (Maybe Semver) RemoteProject (Maybe Semver)
-> Maybe Semver
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Semver) RemoteProject (Maybe Semver)
#latestRelease Maybe Semver -> (Maybe Semver -> Cli Semver) -> Cli Semver
forall a b. a -> (a -> b) -> b
& Cli Semver -> Maybe Semver -> Cli Semver
forall (m :: * -> *) a. Applicative m => m a -> Maybe a -> m a
onNothing (Maybe (Branch IO) -> Cli Semver
forall void. Maybe (Branch IO) -> Cli void
done Maybe (Branch IO)
forall a. Maybe a
Nothing)
            let baseProjectId :: RemoteProjectId
baseProjectId = RemoteProject
baseProject RemoteProject
-> Getting RemoteProjectId RemoteProject RemoteProjectId
-> RemoteProjectId
forall s a. s -> Getting a s a -> a
^. Getting RemoteProjectId RemoteProject RemoteProjectId
#projectId
            let baseLatestReleaseBranchName :: ProjectBranchName
baseLatestReleaseBranchName = forall source target.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeFrom @Text (Text
"releases/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text Semver
ver)
            GetProjectBranchResponse
response <-
              IncludeSquashedHead
-> ProjectAndBranch RemoteProjectId ProjectBranchName
-> Cli (Either ClientError GetProjectBranchResponse)
Share.getProjectBranchByName' IncludeSquashedHead
Share.NoSquashedHead (RemoteProjectId
-> ProjectBranchName
-> ProjectAndBranch RemoteProjectId ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch RemoteProjectId
baseProjectId ProjectBranchName
baseLatestReleaseBranchName)
                Cli (Either ClientError GetProjectBranchResponse)
-> (Cli (Either ClientError GetProjectBranchResponse)
    -> Cli GetProjectBranchResponse)
-> Cli GetProjectBranchResponse
forall a b. a -> (a -> b) -> b
& (ClientError -> Cli GetProjectBranchResponse)
-> Cli (Either ClientError GetProjectBranchResponse)
-> Cli GetProjectBranchResponse
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m (Either a b) -> m b
onLeftM \ClientError
_err -> Maybe (Branch IO) -> Cli GetProjectBranchResponse
forall void. Maybe (Branch IO) -> Cli void
done Maybe (Branch IO)
forall a. Maybe a
Nothing
            RemoteProjectBranch
baseLatestReleaseBranch <-
              case GetProjectBranchResponse
response of
                GetProjectBranchResponse
Share.GetProjectBranchResponseBranchNotFound -> Maybe (Branch IO) -> Cli RemoteProjectBranch
forall void. Maybe (Branch IO) -> Cli void
done Maybe (Branch IO)
forall a. Maybe a
Nothing
                GetProjectBranchResponse
Share.GetProjectBranchResponseProjectNotFound -> Maybe (Branch IO) -> Cli RemoteProjectBranch
forall void. Maybe (Branch IO) -> Cli void
done Maybe (Branch IO)
forall a. Maybe a
Nothing
                Share.GetProjectBranchResponseSuccess RemoteProjectBranch
branch -> RemoteProjectBranch -> Cli RemoteProjectBranch
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RemoteProjectBranch
branch
            HasCallStack =>
IncludeSquashedHead
-> RemoteProjectBranch -> Cli (Either ShareError CausalHash)
IncludeSquashedHead
-> RemoteProjectBranch -> Cli (Either ShareError CausalHash)
downloadProjectBranchFromShare IncludeSquashedHead
Share.NoSquashedHead RemoteProjectBranch
baseLatestReleaseBranch
              Cli (Either ShareError CausalHash)
-> (Cli (Either ShareError CausalHash) -> Cli CausalHash)
-> Cli CausalHash
forall a b. a -> (a -> b) -> b
& (ShareError -> Cli CausalHash)
-> Cli (Either ShareError CausalHash) -> Cli CausalHash
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m (Either a b) -> m b
onLeftM (Output -> Cli CausalHash
forall a. Output -> Cli a
Cli.returnEarly (Output -> Cli CausalHash)
-> (ShareError -> Output) -> ShareError -> Cli CausalHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShareError -> Output
Output.ShareError)
            Cli.Env {Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
            Branch IO
baseLatestReleaseBranchObject <-
              IO (Branch IO) -> Cli (Branch IO)
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Branch IO) -> Cli (Branch IO))
-> IO (Branch IO) -> Cli (Branch IO)
forall a b. (a -> b) -> a -> b
$
                Codebase IO Symbol Ann -> CausalHash -> IO (Branch IO)
forall (m :: * -> *) v a.
Monad m =>
Codebase m v a -> CausalHash -> m (Branch m)
Codebase.expectBranchForHash
                  Codebase IO Symbol Ann
codebase
                  (Hash32 -> CausalHash
Sync.Common.hash32ToCausalHash (HashJWT -> Hash32
Share.API.hashJWTHash (RemoteProjectBranch
baseLatestReleaseBranch RemoteProjectBranch
-> Getting HashJWT RemoteProjectBranch HashJWT -> HashJWT
forall s a. s -> Getting a s a -> a
^. Getting HashJWT RemoteProjectBranch HashJWT
#branchHead)))
            pure (Branch IO -> Maybe (Branch IO)
forall a. a -> Maybe a
Just Branch IO
baseLatestReleaseBranchObject)
        Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Branch IO) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Branch IO)
maybeBaseLatestReleaseBranchObject) do
          Output -> Cli ()
Cli.respond Output
Output.FailedToFetchLatestReleaseOfBase
        pure Maybe (Branch IO)
maybeBaseLatestReleaseBranchObject
      else Maybe (Branch IO) -> Cli (Maybe (Branch IO))
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Branch IO)
forall a. Maybe a
Nothing

  Maybe (Branch IO) -> (Branch IO -> Cli ()) -> Cli ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (Branch IO)
maybeBaseLatestReleaseBranchObject \Branch IO
baseLatestReleaseBranchObject -> do
    -- lib.base
    let projectBranchLibBaseObject :: Branch0 IO
projectBranchLibBaseObject =
          Branch0 IO
forall (m :: * -> *). Branch0 m
Branch.empty0
            Branch0 IO -> (Branch0 IO -> Branch0 IO) -> Branch0 IO
forall a b. a -> (a -> b) -> b
& (Map NameSegment (Branch IO)
 -> Identity (Map NameSegment (Branch IO)))
-> Branch0 IO -> Identity (Branch0 IO)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
Branch.children
              ((Map NameSegment (Branch IO)
  -> Identity (Map NameSegment (Branch IO)))
 -> Branch0 IO -> Identity (Branch0 IO))
-> ((Maybe (Branch IO) -> Identity (Maybe (Branch IO)))
    -> Map NameSegment (Branch IO)
    -> Identity (Map NameSegment (Branch IO)))
-> (Maybe (Branch IO) -> Identity (Maybe (Branch IO)))
-> Branch0 IO
-> Identity (Branch0 IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NameSegment (Branch IO))
-> Lens'
     (Map NameSegment (Branch IO))
     (Maybe (IxValue (Map NameSegment (Branch IO))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NameSegment (Branch IO))
NameSegment
NameSegment.baseSegment
              ((Maybe (Branch IO) -> Identity (Maybe (Branch IO)))
 -> Branch0 IO -> Identity (Branch0 IO))
-> Maybe (Branch IO) -> Branch0 IO -> Branch0 IO
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Branch IO -> Maybe (Branch IO)
forall a. a -> Maybe a
Just Branch IO
baseLatestReleaseBranchObject
        projectBranchLibObject :: Branch IO
projectBranchLibObject = Branch0 IO -> Branch IO -> Branch IO
forall (m :: * -> *).
Applicative m =>
Branch0 m -> Branch m -> Branch m
Branch.cons Branch0 IO
projectBranchLibBaseObject Branch IO
forall (m :: * -> *). Branch m
Branch.empty
    let branchWithBase :: Branch IO
branchWithBase =
          Branch IO
forall (m :: * -> *). Branch m
Branch.empty
            Branch IO -> (Branch IO -> Branch IO) -> Branch IO
forall a b. a -> (a -> b) -> b
& (UnwrappedBranch IO -> Identity (UnwrappedBranch IO))
-> Branch IO -> Identity (Branch IO)
forall (m :: * -> *) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (UnwrappedBranch m) (f (UnwrappedBranch m))
-> p (Branch m) (f (Branch m))
Branch.history
              ((UnwrappedBranch IO -> Identity (UnwrappedBranch IO))
 -> Branch IO -> Identity (Branch IO))
-> ((Maybe (Branch IO) -> Identity (Maybe (Branch IO)))
    -> UnwrappedBranch IO -> Identity (UnwrappedBranch IO))
-> (Maybe (Branch IO) -> Identity (Maybe (Branch IO)))
-> Branch IO
-> Identity (Branch IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Branch0 IO -> Identity (Branch0 IO))
-> UnwrappedBranch IO -> Identity (UnwrappedBranch IO)
forall e (m :: * -> *).
ContentAddressable e =>
Lens' (Causal m e) e
Lens' (UnwrappedBranch IO) (Branch0 IO)
Causal.head_
              ((Branch0 IO -> Identity (Branch0 IO))
 -> UnwrappedBranch IO -> Identity (UnwrappedBranch IO))
-> ((Maybe (Branch IO) -> Identity (Maybe (Branch IO)))
    -> Branch0 IO -> Identity (Branch0 IO))
-> (Maybe (Branch IO) -> Identity (Maybe (Branch IO)))
-> UnwrappedBranch IO
-> Identity (UnwrappedBranch IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map NameSegment (Branch IO)
 -> Identity (Map NameSegment (Branch IO)))
-> Branch0 IO -> Identity (Branch0 IO)
forall (m :: * -> *) (f :: * -> *).
Functor f =>
(Map NameSegment (Branch m) -> f (Map NameSegment (Branch m)))
-> Branch0 m -> f (Branch0 m)
Branch.children
              ((Map NameSegment (Branch IO)
  -> Identity (Map NameSegment (Branch IO)))
 -> Branch0 IO -> Identity (Branch0 IO))
-> ((Maybe (Branch IO) -> Identity (Maybe (Branch IO)))
    -> Map NameSegment (Branch IO)
    -> Identity (Map NameSegment (Branch IO)))
-> (Maybe (Branch IO) -> Identity (Maybe (Branch IO)))
-> Branch0 IO
-> Identity (Branch0 IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NameSegment (Branch IO))
-> Lens'
     (Map NameSegment (Branch IO))
     (Maybe (IxValue (Map NameSegment (Branch IO))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NameSegment (Branch IO))
NameSegment
NameSegment.libSegment
              ((Maybe (Branch IO) -> Identity (Maybe (Branch IO)))
 -> Branch IO -> Identity (Branch IO))
-> Maybe (Branch IO) -> Branch IO -> Branch IO
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Branch IO -> Maybe (Branch IO)
forall a. a -> Maybe a
Just Branch IO
projectBranchLibObject
    Cli.Env {Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO () -> Cli ()
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Cli ()) -> IO () -> Cli ()
forall a b. (a -> b) -> a -> b
$ Codebase IO Symbol Ann -> Branch IO -> IO ()
forall (m :: * -> *) v a. Codebase m v a -> Branch m -> m ()
Codebase.putBranch Codebase IO Symbol Ann
codebase Branch IO
branchWithBase
    Transaction () -> Cli ()
forall a. Transaction a -> Cli a
Cli.runTransaction (Transaction () -> Cli ()) -> Transaction () -> Cli ()
forall a b. (a -> b) -> a -> b
$ do
      CausalHashId
baseBranchCausalHashId <- CausalHash -> Transaction CausalHashId
expectCausalHashIdByCausalHash (Branch IO -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch IO
branchWithBase)
      Text
-> ProjectId -> ProjectBranchId -> CausalHashId -> Transaction ()
Queries.setProjectBranchHead Text
"Include latest base library" Project
project.projectId ProjectBranch
branch.branchId CausalHashId
baseBranchCausalHashId

  Output -> Cli ()
Cli.respond Output
Output.HappyCoding
  pure ProjectAndBranch {project :: ProjectId
project = Project
project.projectId, branch :: ProjectBranchId
branch = ProjectBranch
branch.branchId}

-- An infinite list of random project names that looks like
--
--   [
--     -- We have some reasonable amount of base names...
--     "happy-giraffe",   "happy-gorilla",   "silly-giraffe",   "silly-gorilla",
--
--     -- But if we need more, we just add append a number, and so on...
--     "happy-giraffe-2", "happy-gorilla-2", "silly-giraffe-2", "silly-gorilla-2",
--
--     ...
--   ]
--
-- It's in IO because the base supply (without numbers) gets shuffled.
generateRandomProjectNames :: IO [ProjectName]
generateRandomProjectNames :: IO [ProjectName]
generateRandomProjectNames = do
  [Text]
baseNames <-
    [Text] -> IO [Text]
forall (m :: * -> *) a. MonadRandom m => [a] -> m [a]
RandomShuffle.shuffleM do
      Text
adjective <-
        [ Text
"adept",
          Text
"adorable",
          Text
"ambitious",
          Text
"beautiful",
          Text
"brave",
          Text
"brilliant",
          Text
"courageous",
          Text
"charming",
          Text
"dazzling",
          Text
"delightful",
          Text
"determined",
          Text
"devoted",
          Text
"elegant",
          Text
"enchanting",
          Text
"energetic",
          Text
"engaging",
          Text
"excited",
          Text
"fantastic",
          Text
"fortuitous",
          Text
"friendly",
          Text
"gentle",
          Text
"helpful",
          Text
"heartwarming",
          Text
"hilarious",
          Text
"humorous",
          Text
"incredible",
          Text
"imaginative",
          Text
"innocent",
          Text
"insightful",
          Text
"jolly",
          Text
"joyous",
          Text
"kind",
          Text
"lucky",
          Text
"magnificent",
          Text
"marvelous",
          Text
"nice",
          Text
"outstanding",
          Text
"patient",
          Text
"philosophical",
          Text
"pleasant",
          Text
"proficient",
          Text
"quiet",
          Text
"relaxed",
          Text
"resourceful",
          Text
"responsible",
          Text
"silly",
          Text
"sincere",
          Text
"sensible",
          Text
"sparkling",
          Text
"spectacular",
          Text
"spellbinding",
          Text
"stellar",
          Text
"thoughtful",
          Text
"useful",
          Text
"vibrant",
          Text
"warm-hearted",
          Text
"witty",
          Text
"wondrous",
          Text
"zestful"
          ]
      Text
noun <-
        [ Text
"alpaca",
          Text
"armadillo",
          Text
"axolotl",
          Text
"badger",
          Text
"blobfish",
          Text
"bobcat",
          Text
"camel",
          Text
"capybara",
          Text
"caracal",
          Text
"cheetah",
          Text
"chameleon",
          Text
"chinchilla",
          Text
"chipmunk",
          Text
"donkey",
          Text
"dormouse",
          Text
"earwig",
          Text
"egret",
          Text
"elk",
          Text
"ferret",
          Text
"fennec",
          Text
"fox",
          Text
"frog",
          Text
"gecko",
          Text
"gerbil",
          Text
"gibbon",
          Text
"giraffe",
          Text
"hamster",
          Text
"hedgehog",
          Text
"herron",
          Text
"hippo",
          Text
"ibis",
          Text
"jaguar",
          Text
"kangaroo",
          Text
"kiwi",
          Text
"koala",
          Text
"ladybug",
          Text
"lemur",
          Text
"leopard",
          Text
"lizard",
          Text
"llama",
          Text
"mallard",
          Text
"marmot",
          Text
"mole",
          Text
"moonrat",
          Text
"moose",
          Text
"mouse",
          Text
"narwhal",
          Text
"ocelot",
          Text
"ostrich",
          Text
"otter",
          Text
"owl",
          Text
"panda",
          Text
"pangolin",
          Text
"penguin",
          Text
"platypus",
          Text
"polecat",
          Text
"porcupine",
          Text
"possum",
          Text
"puffin",
          Text
"quahog",
          Text
"racoon",
          Text
"reindeer",
          Text
"rhino",
          Text
"seahorse",
          Text
"seal",
          Text
"serval",
          Text
"shrew",
          Text
"sloth",
          Text
"starling",
          Text
"tapir",
          Text
"tiger",
          Text
"toad",
          Text
"toucan",
          Text
"turkey",
          Text
"turtle",
          Text
"urchin",
          Text
"vole",
          Text
"walrus",
          Text
"wallaby",
          Text
"wallaroo",
          Text
"weasel",
          Text
"woodchuck",
          Text
"wolverine",
          Text
"wombat",
          Text
"yak",
          Text
"zebra"
          ]

      pure (Text
adjective Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
noun)

  let namesWithNumbers :: [Text]
namesWithNumbers = do
        Int
n <- [(Int
2 :: Int) ..]
        Text
name <- [Text]
baseNames
        pure (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n))

  [ProjectName] -> IO [ProjectName]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text -> ProjectName) -> [Text] -> [ProjectName]
forall a b. (a -> b) -> [a] -> [b]
map (forall source target.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeFrom @Text) ([Text]
baseNames [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
namesWithNumbers))