git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1329 from hdgarrood/psc-publish-windows

Fix psc-publish producing no modules on Windows

commit3bf1456eda5c0c380dffb3a6c151a95e5d36ca38 authorGary Burgess <gary.burgess@gmail.com> dateMon 3 Aug 2015, 23:09 (11 years ago) parent67e388e9170c52
2 files changed+20−3
compare with golang
unifiedsplit
src/Language/PureScript/Publish.hs+2−1 src/Language/PureScript/Publish/Utils.hs+18−2
src/Language/PureScript/Publish.hs+2−1
@@ -44,6 +44,7 @@ import Control.Monad.Writer
4444import System.Directory (doesFileExist, findExecutable)
4545import System.Process (readProcess)
4646import System.Exit (exitFailure)
47+import System.FilePath (pathSeparator)
4748import qualified System.FilePath.Glob as Glob
4849import qualified System.Info
4950
@@ -352,7 +353,7 @@ withPackageName fp = (,fp) <$> getPackageName fp
352353
353354getPackageName :: FilePath -> Maybe PackageName
354355getPackageName fp = do
355− let xs = splitOn "/" fp
356+ let xs = splitOn [pathSeparator] fp
356357 ys <- stripPrefix ["bower_components"] xs
357358 y <- headMay ys
358359 case Bower.mkPackageName y of
src/Language/PureScript/Publish/Utils.hs+18−2
@@ -2,8 +2,11 @@
22module Language.PureScript.Publish.Utils where
33
44import Data.List
5−import Data.Maybe
5+import Data.Either (partitionEithers)
66import System.Directory
7+import System.Exit (exitFailure)
8+import System.IO (hPutStrLn, stderr)
9+import System.FilePath (pathSeparator)
710import qualified System.FilePath.Glob as Glob
811
912-- | Glob relative to the current directory, and produce relative pathnames.
@@ -11,7 +14,20 @@ globRelative :: Glob.Pattern -> IO [FilePath]
1114globRelative pat = do
1215 currentDir <- getCurrentDirectory
1316 filesAbsolute <- Glob.globDir1 pat currentDir
14− return (mapMaybe (stripPrefix (currentDir ++ "/")) filesAbsolute)
17+ let prefix = currentDir ++ [pathSeparator]
18+ let (fails, paths) = partitionEithers . map (stripPrefix' prefix) $ filesAbsolute
19+ if null fails
20+ then return paths
21+ else do
22+ let p = hPutStrLn stderr
23+ p "Internal error in Language.PureScript.Publish.Utils.globRelative"
24+ p "Unmatched files:"
25+ mapM_ p fails
26+ exitFailure
27+
28+ where
29+ stripPrefix' prefix dir =
30+ maybe (Left dir) Right $ stripPrefix prefix dir
1531
1632-- | Glob pattern for PureScript source files.
1733purescriptSourceFiles :: Glob.Pattern