mirror of
https://github.com/gren-lang/compiler.git
synced 2024-10-26 18:00:47 +03:00
Merge pull request #217 from Gauteab/add-yes-options-in-cli
Add --yes option to more cli commands
This commit is contained in:
commit
a43cd2ed79
2
.github/workflows/build.yml
vendored
2
.github/workflows/build.yml
vendored
@ -15,7 +15,7 @@ jobs:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: mrkkrp/ormolu-action@v9
|
||||
- uses: haskell-actions/run-ormolu@v14
|
||||
|
||||
linux:
|
||||
runs-on: ubuntu-latest
|
||||
|
@ -340,9 +340,9 @@ decoder =
|
||||
in do
|
||||
tipe <- D.field "type" D.string
|
||||
if
|
||||
| tipe == application -> App <$> appDecoder
|
||||
| tipe == package -> Pkg <$> pkgDecoder
|
||||
| otherwise -> D.failure Exit.OP_BadType
|
||||
| tipe == application -> App <$> appDecoder
|
||||
| tipe == package -> Pkg <$> pkgDecoder
|
||||
| otherwise -> D.failure Exit.OP_BadType
|
||||
|
||||
appDecoder :: Decoder AppOutline
|
||||
appDecoder =
|
||||
|
@ -128,11 +128,13 @@ ignorer =
|
||||
|
||||
-- ASK
|
||||
|
||||
ask :: D.Doc -> IO Bool
|
||||
ask doc =
|
||||
do
|
||||
Help.toStdout doc
|
||||
askHelp
|
||||
ask :: Bool -> D.Doc -> IO Bool
|
||||
ask skipPrompts doc =
|
||||
if skipPrompts
|
||||
then pure True
|
||||
else do
|
||||
Help.toStdout doc
|
||||
askHelp
|
||||
|
||||
askHelp :: IO Bool
|
||||
askHelp =
|
||||
@ -238,7 +240,7 @@ putDownload mark pkg vsn =
|
||||
mark
|
||||
<+> D.fromPackage pkg
|
||||
<+> D.fromVersion vsn
|
||||
<> "\n"
|
||||
<> "\n"
|
||||
|
||||
putTransition :: DState -> IO DState
|
||||
putTransition state@(DState total cached _ rcvd failed built broken) =
|
||||
|
@ -165,7 +165,7 @@ emptyOrderedListBuilder =
|
||||
_ab_values = Map.empty
|
||||
}
|
||||
|
||||
insertIntoOrderedListBuilder :: Ord a => a -> OrderedListBuilder a -> OrderedListBuilder a
|
||||
insertIntoOrderedListBuilder :: (Ord a) => a -> OrderedListBuilder a -> OrderedListBuilder a
|
||||
insertIntoOrderedListBuilder value builder@(OrderedListBuilder nextIndex values) =
|
||||
case Map.lookup value values of
|
||||
Just _ ->
|
||||
@ -176,7 +176,7 @@ insertIntoOrderedListBuilder value builder@(OrderedListBuilder nextIndex values)
|
||||
_ab_values = Map.insert value nextIndex values
|
||||
}
|
||||
|
||||
lookupIndexOrderedListBuilder :: Ord a => a -> OrderedListBuilder a -> Maybe Int
|
||||
lookupIndexOrderedListBuilder :: (Ord a) => a -> OrderedListBuilder a -> Maybe Int
|
||||
lookupIndexOrderedListBuilder value (OrderedListBuilder _ values) =
|
||||
Map.lookup value values
|
||||
|
||||
|
@ -239,10 +239,10 @@ assocDecoder =
|
||||
in do
|
||||
str <- D.string
|
||||
if
|
||||
| str == left -> return Binop.Left
|
||||
| str == non -> return Binop.Non
|
||||
| str == right -> return Binop.Right
|
||||
| otherwise -> D.failure BadAssociativity
|
||||
| str == left -> return Binop.Left
|
||||
| str == non -> return Binop.Non
|
||||
| str == right -> return Binop.Right
|
||||
| otherwise -> D.failure BadAssociativity
|
||||
|
||||
-- PRECEDENCE JSON
|
||||
|
||||
|
@ -88,10 +88,10 @@ instance Binary Position where
|
||||
put (Position a b) = put a >> put b
|
||||
get = liftM2 Position get get
|
||||
|
||||
instance Ord a => Ord (Located a) where
|
||||
instance (Ord a) => Ord (Located a) where
|
||||
compare (At _ lhs) (At _ rhs) = compare lhs rhs
|
||||
|
||||
instance Eq a => Eq (Located a) where
|
||||
instance (Eq a) => Eq (Located a) where
|
||||
(==) (At _ lhs) (At _ rhs) = lhs == rhs
|
||||
|
||||
instance (Binary a) => Binary (Located a) where
|
||||
|
@ -189,10 +189,7 @@ validateExistingFile projectType path = do
|
||||
|
||||
formatFilesOnDisk :: Flags -> Parse.ProjectType -> [FilePath] -> Task.Task Exit.Format ()
|
||||
formatFilesOnDisk flags projectType paths = do
|
||||
approved <-
|
||||
if not (_skipPrompts flags)
|
||||
then Task.io $ Reporting.ask (confirmFormat paths)
|
||||
else return True
|
||||
approved <- Task.io $ Reporting.ask (_skipPrompts flags) (confirmFormat paths)
|
||||
if not approved
|
||||
then Task.io $ putStrLn "Okay, I did not change anything!"
|
||||
else do
|
||||
|
@ -26,7 +26,8 @@ import System.Directory qualified as Dir
|
||||
import Prelude hiding (init)
|
||||
|
||||
data Flags = Flags
|
||||
{ _isPackage :: Bool,
|
||||
{ _skipPrompts :: Bool,
|
||||
_isPackage :: Bool,
|
||||
_platform :: Maybe Platform.Platform
|
||||
}
|
||||
|
||||
@ -40,7 +41,7 @@ run () flags =
|
||||
if exists
|
||||
then return (Left Exit.InitAlreadyExists)
|
||||
else do
|
||||
approved <- Reporting.ask question
|
||||
approved <- Reporting.ask (_skipPrompts flags) question
|
||||
if approved
|
||||
then init flags
|
||||
else do
|
||||
|
@ -81,6 +81,7 @@ init =
|
||||
|
||||
initFlags =
|
||||
flags Init.Flags
|
||||
|-- onOff "yes" "Assume yes for all interactive prompts."
|
||||
|-- onOff "package" "Create a package (as opposed to an application)."
|
||||
|-- flag "platform" initPlatformParser "Which platform to target"
|
||||
in Terminal.Command "init" (Common summary) details example noArgs initFlags Init.run
|
||||
@ -192,14 +193,14 @@ package =
|
||||
\ you would say:",
|
||||
P.indent 4 $
|
||||
P.green $
|
||||
P.vcat $
|
||||
P.vcat
|
||||
[ "gren package install gren-lang/browser"
|
||||
],
|
||||
reflow
|
||||
"To see a description of all available sub-commands, execute:",
|
||||
P.indent 4 $
|
||||
P.green $
|
||||
P.vcat $
|
||||
P.vcat
|
||||
["gren package --help"]
|
||||
]
|
||||
in Terminal.Prefix "package" details example Package.run
|
||||
|
@ -55,7 +55,7 @@ install =
|
||||
"For example, if you want to get access to Web APIs in your project, you would say:",
|
||||
P.indent 4 $
|
||||
P.green $
|
||||
P.vcat $
|
||||
P.vcat
|
||||
[ "gren package install gren-lang/browser"
|
||||
],
|
||||
reflow
|
||||
@ -91,7 +91,7 @@ uninstall =
|
||||
\ you would say:",
|
||||
P.indent 4 $
|
||||
P.green $
|
||||
P.vcat $
|
||||
P.vcat
|
||||
[ "gren package uninstall gren-lang/browser"
|
||||
],
|
||||
reflow
|
||||
@ -124,7 +124,7 @@ outdated =
|
||||
\ you would say:",
|
||||
P.indent 4 $
|
||||
P.green $
|
||||
P.vcat $
|
||||
P.vcat
|
||||
[ "gren package outdated"
|
||||
]
|
||||
]
|
||||
@ -179,7 +179,11 @@ bump =
|
||||
\ I will compare the published API to what you have locally, figure out that\
|
||||
\ it is a MAJOR change, and bump your version number to 2.0.0. I do this with\
|
||||
\ all packages, so there cannot be MAJOR changes hiding in PATCH releases in Gren!"
|
||||
in Terminal.Command "bump" Uncommon details example noArgs noFlags Bump.run
|
||||
|
||||
bumpFlags =
|
||||
flags Bump.Flags
|
||||
|-- onOff "yes" "Assume yes for all interactive prompts."
|
||||
in Terminal.Command "bump" Uncommon details example noArgs bumpFlags Bump.run
|
||||
|
||||
-- DIFF
|
||||
|
||||
@ -193,7 +197,7 @@ diff =
|
||||
[ reflow
|
||||
"For example, to see what changed in the Browser package between\
|
||||
\ versions 1.0.0 and 2.0.0, you can say:",
|
||||
P.indent 4 $ P.green $ "gren package diff gren-lang/browser 1.0.0 2.0.0",
|
||||
P.indent 4 $ P.green "gren package diff gren-lang/browser 1.0.0 2.0.0",
|
||||
reflow
|
||||
"Sometimes a MAJOR change is not actually very big, so\
|
||||
\ this can help you plan your upgrade timelines."
|
||||
|
@ -2,6 +2,7 @@
|
||||
|
||||
module Package.Bump
|
||||
( run,
|
||||
Flags (Flags),
|
||||
)
|
||||
where
|
||||
|
||||
@ -26,10 +27,13 @@ import Reporting.Task qualified as Task
|
||||
|
||||
-- RUN
|
||||
|
||||
run :: () -> () -> IO ()
|
||||
run () () =
|
||||
newtype Flags = Flags
|
||||
{_skipPrompts :: Bool}
|
||||
|
||||
run :: () -> Flags -> IO ()
|
||||
run () flags =
|
||||
Reporting.attempt Exit.bumpToReport $
|
||||
Task.run (bump =<< getEnv)
|
||||
Task.run (bump flags =<< getEnv)
|
||||
|
||||
-- ENV
|
||||
|
||||
@ -58,8 +62,8 @@ getEnv =
|
||||
|
||||
-- BUMP
|
||||
|
||||
bump :: Env -> Task.Task Exit.Bump ()
|
||||
bump env@(Env root _ outline@(Outline.PkgOutline pkg _ _ vsn _ _ _ _)) =
|
||||
bump :: Flags -> Env -> Task.Task Exit.Bump ()
|
||||
bump flags env@(Env root _ outline@(Outline.PkgOutline pkg _ _ vsn _ _ _ _)) =
|
||||
Task.eio id $
|
||||
do
|
||||
versionResult <- Package.getVersions pkg
|
||||
@ -68,7 +72,7 @@ bump env@(Env root _ outline@(Outline.PkgOutline pkg _ _ vsn _ _ _ _)) =
|
||||
let bumpableVersions =
|
||||
map (\(old, _, _) -> old) (Package.bumpPossibilities knownVersions)
|
||||
in if elem vsn bumpableVersions
|
||||
then Task.run $ suggestVersion env
|
||||
then Task.run $ suggestVersion flags env
|
||||
else do
|
||||
return $
|
||||
Left $
|
||||
@ -76,19 +80,19 @@ bump env@(Env root _ outline@(Outline.PkgOutline pkg _ _ vsn _ _ _ _)) =
|
||||
map head (List.group (List.sort bumpableVersions))
|
||||
Left _ ->
|
||||
do
|
||||
checkNewPackage root outline
|
||||
checkNewPackage flags root outline
|
||||
return $ Right ()
|
||||
|
||||
-- CHECK NEW PACKAGE
|
||||
|
||||
checkNewPackage :: FilePath -> Outline.PkgOutline -> IO ()
|
||||
checkNewPackage root outline@(Outline.PkgOutline _ _ _ version _ _ _ _) =
|
||||
checkNewPackage :: Flags -> FilePath -> Outline.PkgOutline -> IO ()
|
||||
checkNewPackage flags root outline@(Outline.PkgOutline _ _ _ version _ _ _ _) =
|
||||
do
|
||||
putStrLn Exit.newPackageOverview
|
||||
if version == V.one
|
||||
then putStrLn "The version number in gren.json is correct so you are all set!"
|
||||
else
|
||||
changeVersion root outline V.one $
|
||||
changeVersion flags root outline V.one $
|
||||
"It looks like the version in gren.json has been changed though!\n\
|
||||
\Would you like me to change it back to "
|
||||
<> D.fromVersion V.one
|
||||
@ -96,8 +100,8 @@ checkNewPackage root outline@(Outline.PkgOutline _ _ _ version _ _ _ _) =
|
||||
|
||||
-- SUGGEST VERSION
|
||||
|
||||
suggestVersion :: Env -> Task.Task Exit.Bump ()
|
||||
suggestVersion (Env root cache outline@(Outline.PkgOutline pkg _ _ vsn _ _ _ _)) =
|
||||
suggestVersion :: Flags -> Env -> Task.Task Exit.Bump ()
|
||||
suggestVersion flags (Env root cache outline@(Outline.PkgOutline pkg _ _ vsn _ _ _ _)) =
|
||||
do
|
||||
oldDocs <-
|
||||
Task.mapError
|
||||
@ -108,24 +112,24 @@ suggestVersion (Env root cache outline@(Outline.PkgOutline pkg _ _ vsn _ _ _ _))
|
||||
let changes = Diff.diff oldDocs newDocs
|
||||
let newVersion = Diff.bump changes vsn
|
||||
Task.io $
|
||||
changeVersion root outline newVersion $
|
||||
changeVersion flags root outline newVersion $
|
||||
let old = D.fromVersion vsn
|
||||
new = D.fromVersion newVersion
|
||||
mag = D.fromChars $ M.toChars (Diff.toMagnitude changes)
|
||||
in "Based on your new API, this should be a"
|
||||
<+> D.green mag
|
||||
<+> "change ("
|
||||
<> old
|
||||
<> " => "
|
||||
<> new
|
||||
<> ")\n"
|
||||
<> "Bail out of this command and run 'gren diff' for a full explanation.\n"
|
||||
<> "\n"
|
||||
<> "Should I perform the update ("
|
||||
<> old
|
||||
<> " => "
|
||||
<> new
|
||||
<> ") in gren.json? [Y/n] "
|
||||
<> old
|
||||
<> " => "
|
||||
<> new
|
||||
<> ")\n"
|
||||
<> "Bail out of this command and run 'gren diff' for a full explanation.\n"
|
||||
<> "\n"
|
||||
<> "Should I perform the update ("
|
||||
<> old
|
||||
<> " => "
|
||||
<> new
|
||||
<> ") in gren.json? [Y/n] "
|
||||
|
||||
generateDocs :: FilePath -> Outline.PkgOutline -> Task.Task Exit.Bump Docs.Documentation
|
||||
generateDocs root (Outline.PkgOutline _ _ _ _ exposed _ _ _) =
|
||||
@ -144,10 +148,10 @@ generateDocs root (Outline.PkgOutline _ _ _ _ exposed _ _ _) =
|
||||
|
||||
-- CHANGE VERSION
|
||||
|
||||
changeVersion :: FilePath -> Outline.PkgOutline -> V.Version -> D.Doc -> IO ()
|
||||
changeVersion root outline targetVersion question =
|
||||
changeVersion :: Flags -> FilePath -> Outline.PkgOutline -> V.Version -> D.Doc -> IO ()
|
||||
changeVersion flags root outline targetVersion question =
|
||||
do
|
||||
approved <- Reporting.ask question
|
||||
approved <- Reporting.ask (_skipPrompts flags) question
|
||||
if not approved
|
||||
then putStrLn "Okay, I did not change anything!"
|
||||
else do
|
||||
|
@ -125,10 +125,7 @@ attemptChangesHelp root env skipPrompt oldOutline newOutline question =
|
||||
Task.eio Exit.InstallBadDetails $
|
||||
BW.withScope $ \scope ->
|
||||
do
|
||||
approved <-
|
||||
if skipPrompt
|
||||
then return True
|
||||
else Reporting.ask question
|
||||
approved <- Reporting.ask skipPrompt question
|
||||
if approved
|
||||
then do
|
||||
Outline.write root newOutline
|
||||
|
@ -126,10 +126,7 @@ attemptChangesHelp root env skipPrompt oldOutline newOutline question =
|
||||
Task.eio Exit.UninstallBadDetails $
|
||||
BW.withScope $ \scope ->
|
||||
do
|
||||
approved <-
|
||||
if skipPrompt
|
||||
then return True
|
||||
else Reporting.ask question
|
||||
approved <- Reporting.ask skipPrompt question
|
||||
if approved
|
||||
then do
|
||||
Outline.write root newOutline
|
||||
|
Loading…
Reference in New Issue
Block a user