ef94ae2 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

psc-publish: only warn on dirty working tree on dry runs

ef94ae2Harry Garrood11 years ago

psc-publish/Main.hs+9−2

compare with golang

unifiedsplit

@@ -9,12 +9,20 @@ import Options.Applicative hiding (str)

10import qualified Paths_purescript as Paths

11import Language.PureScript.Publish

12+import Language.PureScript.Publish.ErrorsWarnings

13dryRun :: Parser Bool

14dryRun :: Parser Bool

14dryRun = switch $

15dryRun = switch $

15 long "dry-run"

16 long "dry-run"

16 <> help "Produce no output, and don't require a tagged version to be checked out."

17 <> help "Produce no output, and don't require a tagged version to be checked out."

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+

18main :: IO ()

26main :: IO ()

19main = execParser opts >>= publish

27main = execParser opts >>= publish

20 where

28 where

@@ -30,8 +38,7 @@ publish :: Bool -> IO ()

30publish isDryRun =

38publish isDryRun =

31 if isDryRun

39 if isDryRun

32 then do

40 then do

33− let dummyVersion = ("0.0.0", Version [0,0,0] [])

41+ _ <- preparePackage dryRunOptions

34− _ <- preparePackage $ defaultPublishOptions { publishGetVersion = return dummyVersion }

35 putStrLn "Dry run completed, no errors."

42 putStrLn "Dry run completed, no errors."

36 else do

43 else do

37 pkg <- preparePackage defaultPublishOptions

44 pkg <- preparePackage defaultPublishOptions

src/Language/PureScript/Publish.hs+12−5

@@ -8,10 +8,14 @@ module Language.PureScript.Publish

8 , preparePackage'

9 , PrepareM()

10 , runPrepareM

11+ , warn

12+ , userError

13+ , internalError

14+ , otherError

11 , PublishOptions(..)

15 , PublishOptions(..)

12 , defaultPublishOptions

16 , defaultPublishOptions

13 , getGitWorkingTreeStatus

17 , getGitWorkingTreeStatus

14− , requireCleanWorkingTree

18+ , checkCleanWorkingTree

15 , getVersionFromGitTag

19 , getVersionFromGitTag

16 , getBowerInfo

20 , getBowerInfo

17 , getModulesAndBookmarks

21 , getModulesAndBookmarks

@@ -63,11 +67,14 @@ data PublishOptions = PublishOptions

63 { -- | How to obtain the version tag and version that the data being

67 { -- | How to obtain the version tag and version that the data being

64 -- generated will refer to.

68 -- generated will refer to.

65 publishGetVersion :: PrepareM (String, Version)

69 publishGetVersion :: PrepareM (String, Version)

70+ , -- | What to do when the working tree is dirty

71+ publishWorkingTreeDirty :: PrepareM ()

66 }

72 }

68defaultPublishOptions :: PublishOptions

74defaultPublishOptions :: PublishOptions

69defaultPublishOptions = PublishOptions

75defaultPublishOptions = PublishOptions

70 { publishGetVersion = getVersionFromGitTag

76 { publishGetVersion = getVersionFromGitTag

77+ , publishWorkingTreeDirty = userError DirtyWorkingTree

71 }

78 }

73-- | Attempt to retrieve package metadata from the current directory.

80-- | Attempt to retrieve package metadata from the current directory.

@@ -119,7 +126,7 @@ preparePackage' opts = do

119 exists <- liftIO (doesFileExist "bower.json")

126 exists <- liftIO (doesFileExist "bower.json")

120 unless exists (userError BowerJSONNotFound)

127 unless exists (userError BowerJSONNotFound)

121

128

122− requireCleanWorkingTree

129+ checkCleanWorkingTree opts

123

130

124 pkgMeta <- liftIO (Bower.decodeFile "bower.json")

131 pkgMeta <- liftIO (Bower.decodeFile "bower.json")

125 >>= flip catchLeft (userError . CouldntDecodeBowerJSON)

132 >>= flip catchLeft (userError . CouldntDecodeBowerJSON)

@@ -155,11 +162,11 @@ getGitWorkingTreeStatus = do

155 then Clean

162 then Clean

156 else Dirty

163 else Dirty

157

164

158−requireCleanWorkingTree :: PrepareM ()

165+checkCleanWorkingTree :: PublishOptions -> PrepareM ()

159−requireCleanWorkingTree = do

166+checkCleanWorkingTree opts = do

160 status <- getGitWorkingTreeStatus

167 status <- getGitWorkingTreeStatus

161 unless (status == Clean) $

168 unless (status == Clean) $

162− userError DirtyWorkingTree

169+ publishWorkingTreeDirty opts

163

170

164getVersionFromGitTag :: PrepareM (String, Version)

171getVersionFromGitTag :: PrepareM (String, Version)

165getVersionFromGitTag = do

172getVersionFromGitTag = do

src/Language/PureScript/Publish/ErrorsWarnings.hs+20−6

@@ -49,6 +49,7 @@ data PackageWarning

49 = NoResolvedVersion PackageName

50 | UndeclaredDependency PackageName

51 | UnacceptableVersion (PackageName, String)

52+ | DirtyWorkingTree_Warn

52 deriving (Show)

53 deriving (Show)

54-- | An error that should be fixed by the user.

55-- | An error that should be fixed by the user.

@@ -279,21 +280,24 @@ data CollectedWarnings = CollectedWarnings

279 { noResolvedVersions :: [PackageName]

280 { noResolvedVersions :: [PackageName]

280 , undeclaredDependencies :: [PackageName]

281 , undeclaredDependencies :: [PackageName]

281 , unacceptableVersions :: [(PackageName, String)]

282 , unacceptableVersions :: [(PackageName, String)]

283+ , dirtyWorkingTree :: Any

282 }

284 }

283 deriving (Show, Eq, Ord)

285 deriving (Show, Eq, Ord)

284

286

285instance Monoid CollectedWarnings where

287instance Monoid CollectedWarnings where

286− mempty = CollectedWarnings mempty mempty mempty

288+ mempty = CollectedWarnings mempty mempty mempty mempty

287− mappend (CollectedWarnings as bs cs) (CollectedWarnings as' bs' cs') =

289+ mappend (CollectedWarnings as bs cs d)

290+ (CollectedWarnings as' bs' cs' d') =

288− CollectedWarnings (as <> as') (bs <> bs') (cs <> cs')

291+ CollectedWarnings (as <> as') (bs <> bs') (cs <> cs') (d <> d')

289

292

290collectWarnings :: [PackageWarning] -> CollectedWarnings

293collectWarnings :: [PackageWarning] -> CollectedWarnings

291collectWarnings = foldMap singular

294collectWarnings = foldMap singular

292 where

295 where

293 singular w = case w of

296 singular w = case w of

294− NoResolvedVersion pn -> CollectedWarnings [pn] [] []

297+ NoResolvedVersion pn -> CollectedWarnings [pn] mempty mempty mempty

295− UndeclaredDependency pn -> CollectedWarnings [] [pn] []

298+ UndeclaredDependency pn -> CollectedWarnings mempty [pn] mempty mempty

296− UnacceptableVersion t -> CollectedWarnings [] [] [t]

299+ UnacceptableVersion t -> CollectedWarnings mempty mempty [t] mempty

300+ DirtyWorkingTree_Warn -> CollectedWarnings mempty mempty mempty (Any True)

297

301

298renderWarnings :: [PackageWarning] -> Box

302renderWarnings :: [PackageWarning] -> Box

299renderWarnings warns =

303renderWarnings warns =

@@ -302,6 +306,9 @@ renderWarnings warns =

302 mboxes = [ go warnNoResolvedVersions noResolvedVersions

306 mboxes = [ go warnNoResolvedVersions noResolvedVersions

303 , go warnUndeclaredDependencies undeclaredDependencies

307 , go warnUndeclaredDependencies undeclaredDependencies

304 , go warnUnacceptableVersions unacceptableVersions

308 , go warnUnacceptableVersions unacceptableVersions

309+ , if getAny dirtyWorkingTree

310+ then Just warnDirtyWorkingTree

311+ else Nothing

305 ]

312 ]

306 in case catMaybes mboxes of

313 in case catMaybes mboxes of

307 [] -> nullBox

314 [] -> nullBox

@@ -377,5 +384,12 @@ warnUnacceptableVersions pkgs =

377 where

384 where

378 showTuple (pkgName, tag) = runPackageName pkgName ++ "#" ++ tag

385 showTuple (pkgName, tag) = runPackageName pkgName ++ "#" ++ tag

379

386

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+

380printWarnings :: [PackageWarning] -> IO ()

394printWarnings :: [PackageWarning] -> IO ()

381printWarnings = printToStderr . renderWarnings

395printWarnings = printToStderr . renderWarnings