diff --git a/lib/unison-prelude/src/Unison/Prelude.hs b/lib/unison-prelude/src/Unison/Prelude.hs index 7c3673a9f5..fd9a27ec18 100644 --- a/lib/unison-prelude/src/Unison/Prelude.hs +++ b/lib/unison-prelude/src/Unison/Prelude.hs @@ -9,6 +9,12 @@ module Unison.Prelude tShow, wundefined, + -- * @Bool@ control flow + onFalse, + onFalseM, + onTrue, + onTrueM, + -- * @Maybe@ control flow onNothing, onNothingM, @@ -53,7 +59,8 @@ import Data.Foldable as X (fold, foldl', for_, toList, traverse_) import Data.Function as X ((&)) import Data.Functor as X import Data.Functor.Identity as X -import Data.Generics.Labels () -- #labelSyntax for generics-derived lenses +-- #labelSyntax for generics-derived lenses +import Data.Generics.Labels () import Data.Int as X import Data.List as X (foldl1', sortOn) import Data.Map as X (Map) @@ -93,6 +100,36 @@ altSum = foldl' (<|>) empty altMap :: (Alternative f, Foldable t) => (a -> f b) -> t a -> f b altMap f = altSum . fmap f . toList +-- | +-- > condition & onFalse do +-- > shortCircuit +onFalse :: (Applicative m) => m () -> Bool -> m () +onFalse action = \case + False -> action + True -> pure () + +-- | +-- > action & onFalseM do +-- > shortCircuit +onFalseM :: (Monad m) => m () -> m Bool -> m () +onFalseM x y = + y >>= onFalse x + +-- | +-- > condition & onTrue do +-- > shortCircuit +onTrue :: (Applicative m) => m () -> Bool -> m () +onTrue action = \case + True -> action + False -> pure () + +-- | +-- > action & onTrueM do +-- > shortCircuit +onTrueM :: (Monad m) => m () -> m Bool -> m () +onTrueM x y = + y >>= onTrue x + -- | E.g. -- -- @@ diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs index 3fc36ec2ed..7cf13757ab 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs @@ -333,7 +333,7 @@ assertLocalProjectBranchDoesntExist rollback = \case Just project -> go project branchName ProjectAndBranch (LocalProjectKey'Project project) branchName -> go project branchName where - go project branchName = - Queries.projectBranchExistsByName (project ^. #projectId) branchName >>= \case - False -> pure (Right project) - True -> rollback (Output.ProjectAndBranchNameAlreadyExists (ProjectAndBranch (project ^. #name) branchName)) + go project branchName = do + Queries.projectBranchExistsByName (project ^. #projectId) branchName & onTrueM do + rollback (Output.ProjectAndBranchNameAlreadyExists (ProjectAndBranch (project ^. #name) branchName)) + pure (Right project) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 1751a0803f..dff8048a3b 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1941,7 +1941,7 @@ notifyUser dir = \case prettyProjectAndBranchName projectAndBranch <> "already exists." <> "You can switch to it with " - <> IP.makeExampleEOS IP.projectSwitch [prettyBranchName projectAndBranch] + <> IP.makeExampleEOS IP.projectSwitch [prettyProjectAndBranchName projectAndBranch] NotOnProjectBranch -> pure (P.wrap "You are not currently on a branch.") NoAssociatedRemoteProject host projectAndBranch -> pure . P.wrap $ diff --git a/unison-src/transcripts/release-draft-command.output.md b/unison-src/transcripts/release-draft-command.output.md index 167e4b2da2..29676fc276 100644 --- a/unison-src/transcripts/release-draft-command.output.md +++ b/unison-src/transcripts/release-draft-command.output.md @@ -69,6 +69,6 @@ It's an error to try to create a `releases/drafts/x.y.z` branch that already exi foo/main> release.draft 1.2.3 foo/releases/drafts/1.2.3 already exists. You can switch to it - with `switch /releases/drafts/1.2.3`. + with `switch foo/releases/drafts/1.2.3`. ```