git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
psc-publish: only warn on dirty working tree on dry runs

As opposed to erroring.

commitef94ae2682a0b101ae2f7d1b140f6ad8e8146288 authorHarry Garrood <harry@garrood.me> dateTue 17 Nov 2015, 09:19 (11 years ago) parent367ff16
3 files changed+41−13
compare with golang
unifiedsplit
psc-publish/Main.hs+9−2 src/Language/PureScript/Publish.hs+12−5 src/Language/PureScript/Publish/ErrorsWarnings.hs+20−6
psc-publish/Main.hs+9−2
@@ -9,12 +9,20 @@ import Options.Applicative hiding (str)
99
1010import qualified Paths_purescript as Paths
1111import Language.PureScript.Publish
12+import Language.PureScript.Publish.ErrorsWarnings
1213
1314dryRun :: Parser Bool
1415dryRun = switch $
1516 long "dry-run"
1617 <> help "Produce no output, and don't require a tagged version to be checked out."
1718
19+dryRunOptions :: PublishOptions
20+dryRunOptions = defaultPublishOptions
21+ { publishGetVersion = return dummyVersion
22+ , publishWorkingTreeDirty = warn DirtyWorkingTree_Warn
23+ }
24+ where dummyVersion = ("0.0.0", Version [0,0,0] [])
25+
1826main :: IO ()
1927main = execParser opts >>= publish
2028 where
@@ -30,8 +38,7 @@ publish :: Bool -> IO ()
3038publish isDryRun =
3139 if isDryRun
3240 then do
33− let dummyVersion = ("0.0.0", Version [0,0,0] [])
34− _ <- preparePackage $ defaultPublishOptions { publishGetVersion = return dummyVersion }
41+ _ <- preparePackage dryRunOptions
3542 putStrLn "Dry run completed, no errors."
3643 else do
3744 pkg <- preparePackage defaultPublishOptions
src/Language/PureScript/Publish.hs+12−5
@@ -8,10 +8,14 @@ module Language.PureScript.Publish
88 , preparePackage'
99 , PrepareM()
1010 , runPrepareM
11+ , warn
12+ , userError
13+ , internalError
14+ , otherError
1115 , PublishOptions(..)
1216 , defaultPublishOptions
1317 , getGitWorkingTreeStatus
14− , requireCleanWorkingTree
18+ , checkCleanWorkingTree
1519 , getVersionFromGitTag
1620 , getBowerInfo
1721 , getModulesAndBookmarks
@@ -63,11 +67,14 @@ data PublishOptions = PublishOptions
6367 { -- | How to obtain the version tag and version that the data being
6468 -- generated will refer to.
6569 publishGetVersion :: PrepareM (String, Version)
70+ , -- | What to do when the working tree is dirty
71+ publishWorkingTreeDirty :: PrepareM ()
6672 }
6773
6874defaultPublishOptions :: PublishOptions
6975defaultPublishOptions = PublishOptions
7076 { publishGetVersion = getVersionFromGitTag
77+ , publishWorkingTreeDirty = userError DirtyWorkingTree
7178 }
7279
7380-- | Attempt to retrieve package metadata from the current directory.
@@ -119,7 +126,7 @@ preparePackage' opts = do
119126 exists <- liftIO (doesFileExist "bower.json")
120127 unless exists (userError BowerJSONNotFound)
121128
122− requireCleanWorkingTree
129+ checkCleanWorkingTree opts
123130
124131 pkgMeta <- liftIO (Bower.decodeFile "bower.json")
125132 >>= flip catchLeft (userError . CouldntDecodeBowerJSON)
@@ -155,11 +162,11 @@ getGitWorkingTreeStatus = do
155162 then Clean
156163 else Dirty
157164
158−requireCleanWorkingTree :: PrepareM ()
159−requireCleanWorkingTree = do
165+checkCleanWorkingTree :: PublishOptions -> PrepareM ()
166+checkCleanWorkingTree opts = do
160167 status <- getGitWorkingTreeStatus
161168 unless (status == Clean) $
162− userError DirtyWorkingTree
169+ publishWorkingTreeDirty opts
163170
164171getVersionFromGitTag :: PrepareM (String, Version)
165172getVersionFromGitTag = do
src/Language/PureScript/Publish/ErrorsWarnings.hs+20−6
@@ -49,6 +49,7 @@ data PackageWarning
4949 = NoResolvedVersion PackageName
5050 | UndeclaredDependency PackageName
5151 | UnacceptableVersion (PackageName, String)
52+ | DirtyWorkingTree_Warn
5253 deriving (Show)
5354
5455-- | An error that should be fixed by the user.
@@ -279,21 +280,24 @@ data CollectedWarnings = CollectedWarnings
279280 { noResolvedVersions :: [PackageName]
280281 , undeclaredDependencies :: [PackageName]
281282 , unacceptableVersions :: [(PackageName, String)]
283+ , dirtyWorkingTree :: Any
282284 }
283285 deriving (Show, Eq, Ord)
284286
285287instance Monoid CollectedWarnings where
286− mempty = CollectedWarnings mempty mempty mempty
287− mappend (CollectedWarnings as bs cs) (CollectedWarnings as' bs' cs') =
288− CollectedWarnings (as <> as') (bs <> bs') (cs <> cs')
288+ mempty = CollectedWarnings mempty mempty mempty mempty
289+ mappend (CollectedWarnings as bs cs d)
290+ (CollectedWarnings as' bs' cs' d') =
291+ CollectedWarnings (as <> as') (bs <> bs') (cs <> cs') (d <> d')
289292
290293collectWarnings :: [PackageWarning] -> CollectedWarnings
291294collectWarnings = foldMap singular
292295 where
293296 singular w = case w of
294− NoResolvedVersion pn -> CollectedWarnings [pn] [] []
295− UndeclaredDependency pn -> CollectedWarnings [] [pn] []
296− UnacceptableVersion t -> CollectedWarnings [] [] [t]
297+ NoResolvedVersion pn -> CollectedWarnings [pn] mempty mempty mempty
298+ UndeclaredDependency pn -> CollectedWarnings mempty [pn] mempty mempty
299+ UnacceptableVersion t -> CollectedWarnings mempty mempty [t] mempty
300+ DirtyWorkingTree_Warn -> CollectedWarnings mempty mempty mempty (Any True)
297301
298302renderWarnings :: [PackageWarning] -> Box
299303renderWarnings warns =
@@ -302,6 +306,9 @@ renderWarnings warns =
302306 mboxes = [ go warnNoResolvedVersions noResolvedVersions
303307 , go warnUndeclaredDependencies undeclaredDependencies
304308 , go warnUnacceptableVersions unacceptableVersions
309+ , if getAny dirtyWorkingTree
310+ then Just warnDirtyWorkingTree
311+ else Nothing
305312 ]
306313 in case catMaybes mboxes of
307314 [] -> nullBox
@@ -377,5 +384,12 @@ warnUnacceptableVersions pkgs =
377384 where
378385 showTuple (pkgName, tag) = runPackageName pkgName ++ "#" ++ tag
379386
387+warnDirtyWorkingTree :: Box
388+warnDirtyWorkingTree =
389+ para (concat
390+ [ "Your working tree is dirty. (Note: this would be an error if it "
391+ , "were not a dry run)"
392+ ])
393+
380394printWarnings :: [PackageWarning] -> IO ()
381395printWarnings = printToStderr . renderWarnings