@@ -10,6 +10,8 @@ module Language.PureScript.Publish
1010 , runPrepareM
1111 , PublishOptions(..)
1212 , defaultPublishOptions
13+ , getGitWorkingTreeStatus
14+ , requireCleanWorkingTree
1315 , getVersionFromGitTag
1416 , getBowerInfo
1517 , getModulesAndBookmarks
@@ -112,6 +114,8 @@ preparePackage' opts = do
112114 exists <- liftIO (doesFileExist "bower.json")
113115 unless exists (userError BowerJSONNotFound)
114116
117+ requireCleanWorkingTree
118+
115119 pkgMeta <- liftIO (Bower.decodeFile "bower.json")
116120 >>= flip catchLeft (userError . CouldntParseBowerJSON)
117121 (pkgVersionTag, pkgVersion) <- publishGetVersion opts
@@ -136,6 +140,22 @@ getModulesAndBookmarks = do
136140 renderModules bookmarks modules =
137141 return (bookmarks, map D.convertModule modules)
138142
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+
139159getVersionFromGitTag :: PrepareM (String, Version)
140160getVersionFromGitTag = do
141161 out <- readProcess' "git" ["tag", "--list", "--points-at", "HEAD"] ""