git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1319 from hdgarrood/publish-ensure-clean-tree
beb86e9Phil Freeman
src/Language/PureScript/Publish.hs+20
compare with golang
unifiedsplit
@@ -10,6 +10,8 @@ module Language.PureScript.Publish
10 , runPrepareM
10 , runPrepareM
11 , PublishOptions(..)
11 , PublishOptions(..)
12 , defaultPublishOptions
12 , defaultPublishOptions
13+ , getGitWorkingTreeStatus
14+ , requireCleanWorkingTree
13 , getVersionFromGitTag
15 , getVersionFromGitTag
14 , getBowerInfo
16 , getBowerInfo
15 , getModulesAndBookmarks
17 , getModulesAndBookmarks
@@ -112,6 +114,8 @@ preparePackage' opts = do
112 exists <- liftIO (doesFileExist "bower.json")
114 exists <- liftIO (doesFileExist "bower.json")
113 unless exists (userError BowerJSONNotFound)
115 unless exists (userError BowerJSONNotFound)
114
116
117+ requireCleanWorkingTree
118+
115 pkgMeta <- liftIO (Bower.decodeFile "bower.json")
119 pkgMeta <- liftIO (Bower.decodeFile "bower.json")
116 >>= flip catchLeft (userError . CouldntParseBowerJSON)
120 >>= flip catchLeft (userError . CouldntParseBowerJSON)
117 (pkgVersionTag, pkgVersion) <- publishGetVersion opts
121 (pkgVersionTag, pkgVersion) <- publishGetVersion opts
@@ -136,6 +140,22 @@ getModulesAndBookmarks = do
136 renderModules bookmarks modules =
140 renderModules bookmarks modules =
137 return (bookmarks, map D.convertModule modules)
141 return (bookmarks, map D.convertModule modules)
138
142
143+data TreeStatus = Clean | Dirty deriving (Show, Eq, Ord, Enum)
144+
145+getGitWorkingTreeStatus :: PrepareM TreeStatus
146+getGitWorkingTreeStatus = do
147+ out <- readProcess' "git" ["status", "--porcelain"] ""
148+ return $
149+ if null . filter (not . null) . lines $ out
150+ then Clean
151+ else Dirty
152+
153+requireCleanWorkingTree :: PrepareM ()
154+requireCleanWorkingTree = do
155+ status <- getGitWorkingTreeStatus
156+ unless (status == Clean) $
157+ userError DirtyWorkingTree
158+
139getVersionFromGitTag :: PrepareM (String, Version)
159getVersionFromGitTag :: PrepareM (String, Version)
140getVersionFromGitTag = do
160getVersionFromGitTag = do
141 out <- readProcess' "git" ["tag", "--list", "--points-at", "HEAD"] ""
161 out <- readProcess' "git" ["tag", "--list", "--points-at", "HEAD"] ""
src/Language/PureScript/Publish/ErrorsWarnings.hs+6
@@ -60,6 +60,7 @@ data UserError
60 | BadRepositoryField RepositoryFieldError
60 | BadRepositoryField RepositoryFieldError
61 | MissingDependencies (NonEmpty PackageName)
61 | MissingDependencies (NonEmpty PackageName)
62 | ParseAndDesugarError D.ParseDesugarError
62 | ParseAndDesugarError D.ParseDesugarError
63+ | DirtyWorkingTree
63 deriving (Show)
64 deriving (Show)
64
65
65data RepositoryFieldError
66data RepositoryFieldError
@@ -196,6 +197,11 @@ displayUserError e = case e of
196 [ para "Error while desugaring:"
197 [ para "Error while desugaring:"
197 , indented (para (P.prettyPrintMultipleErrors False err))
198 , indented (para (P.prettyPrintMultipleErrors False err))
198 ]
199 ]
200+ DirtyWorkingTree ->
201+ para (concat
202+ [ "Your git working tree is dirty. Please commit, discard, or stash "
203+ , "your changes first."
204+ ])
199
205
200displayRepositoryError :: RepositoryFieldError -> Box
206displayRepositoryError :: RepositoryFieldError -> Box
201displayRepositoryError err = case err of
207displayRepositoryError err = case err of