Merge remote-tracking branch 'origin/master'

appveyor.yml

@@ -5,11 +5,8 @@ cache:
 build: off
 
 before_test:
-- ps: Invoke-WebRequest "https://github.com/commercialhaskell/stack/releases/download/v0.1.4.0/stack-0.1.4.0-x86_64-windows.zip" -OutFile stack.zip
-- ps: Invoke-WebRequest "https://github.com/fpco/minghc/blob/master/bin/7z.exe?raw=true" -OutFile 7z.exe
-- ps: Invoke-WebRequest "https://github.com/fpco/minghc/blob/master/bin/7z.dll?raw=true" -OutFile 7z.dll
-- 7z x stack.zip
-- move stack.exe.exe stack.exe
+- curl -ostack.zip -L --insecure http://www.stackage.org/stack/windows-i386
+- 7z x stack.zip stack.exe
 
 clone_folder: "c:\\stack"
 environment:

doc/MAINTAINER_GUIDE.md

@@ -62,12 +62,6 @@ for requirements to perform the release, and more details about the tool.
 
 * Upload package to Hackage: `stack upload . --pvp-bounds=both`
 
-    Note: due to a Cabal pretty-printer bug, this may fail with a syntax error.
-    This bug is fixed in Cabal HEAD. Can also work around it by running `stack
-    sdist --pvp-bounds=both`, updating `stack.cabal`'s bounds from the sdist's
-    version, then uploading with `stack upload .`. Don't forget to undo the change to
-    `stack.cabal` afterward (don't commit it).
-
 * On a machine with Vagrant installed:
     * Run `etc/scripts/vagrant-distros.sh`
 

src/Path/Extra.hs

@@ -0,0 +1,62 @@
+{-# LANGUAGE ViewPatterns #-}
+
+-- | Extra Path utilities.
+
+module Path.Extra
+  (toFilePathNoTrailingSep
+  ,dropRoot
+  ,parseCollapsedAbsDir
+  ,parseCollapsedAbsFile
+  ) where
+
+import           Control.Monad.Catch
+import           Path
+import           Path.Internal (Path(..))
+import qualified System.FilePath as FP
+
+-- | Convert to FilePath but don't add a trailing slash.
+toFilePathNoTrailingSep :: Path loc Dir -> FilePath
+toFilePathNoTrailingSep = FP.dropTrailingPathSeparator . toFilePath
+
+-- | Collapse intermediate "." and ".." directories from path, then parse
+-- it with 'parseAbsDir'.
+-- (probably should be moved to the Path module)
+parseCollapsedAbsDir :: MonadThrow m => FilePath -> m (Path Abs Dir)
+parseCollapsedAbsDir = parseAbsDir . collapseFilePath
+
+-- | Collapse intermediate "." and ".." directories from path, then parse
+-- it with 'parseAbsFile'.
+-- (probably should be moved to the Path module)
+parseCollapsedAbsFile :: MonadThrow m => FilePath -> m (Path Abs File)
+parseCollapsedAbsFile = parseAbsFile . collapseFilePath
+
+-- | Collapse intermediate "." and ".." directories from a path.
+--
+-- > collapseFilePath "./foo" == "foo"
+-- > collapseFilePath "/bar/../baz" == "/baz"
+-- > collapseFilePath "/../baz" == "/../baz"
+-- > collapseFilePath "parent/foo/baz/../bar" ==  "parent/foo/bar"
+-- > collapseFilePath "parent/foo/baz/../../bar" ==  "parent/bar"
+-- > collapseFilePath "parent/foo/.." ==  "parent"
+-- > collapseFilePath "/parent/foo/../../bar" ==  "/bar"
+--
+-- (borrowed from @Text.Pandoc.Shared@)
+collapseFilePath :: FilePath -> FilePath
+collapseFilePath = FP.joinPath . reverse . foldl go [] . FP.splitDirectories
+  where
+    go rs "." = rs
+    go r@(p:rs) ".." = case p of
+                            ".." -> ("..":r)
+                            (checkPathSeperator -> Just True) -> ("..":r)
+                            _ -> rs
+    go _ (checkPathSeperator -> Just True) = [[FP.pathSeparator]]
+    go rs x = x:rs
+    isSingleton [] = Nothing
+    isSingleton [x] = Just x
+    isSingleton _ = Nothing
+    checkPathSeperator = fmap FP.isPathSeparator . isSingleton
+
+-- | Drop the root (either @\/@ on POSIX or @C:\\@, @D:\\@, etc. on
+-- Windows).
+dropRoot :: Path Abs t -> Path Rel t
+dropRoot (Path l) = Path (FP.dropDrive l)

src/Path/IO.hs

@@ -31,9 +31,6 @@ module Path.IO
   ,copyFileIfExists
   ,copyDirectoryRecursive
   ,createTree
-  ,dropRoot
-  ,parseCollapsedAbsFile
-  ,parseCollapsedAbsDir
   ,withCanonicalizedSystemTempDirectory
   ,withCanonicalizedTempDirectory)
   where
@@ -46,7 +43,6 @@ import           Data.Either
 import           Data.Maybe
 import           Data.Typeable
 import           Path
-import           Path.Internal (Path(..))
 import qualified System.Directory as D
 import qualified System.FilePath as FP
 import           System.IO.Error
@@ -129,44 +125,6 @@ resolveFileMaybe :: (MonadIO m,MonadThrow m)
                  => Path Abs Dir -> FilePath -> m (Maybe (Path Abs File))
 resolveFileMaybe = resolveCheckParse D.doesFileExist parseAbsFile
 
--- | Collapse intermediate "." and ".." directories from path, then parse
--- it with 'parseAbsFile'.
--- (probably should be moved to the Path module)
-parseCollapsedAbsFile :: MonadThrow m => FilePath -> m (Path Abs File)
-parseCollapsedAbsFile = parseAbsFile . collapseFilePath
-
--- | Collapse intermediate "." and ".." directories from path, then parse
--- it with 'parseAbsDir'.
--- (probably should be moved to the Path module)
-parseCollapsedAbsDir :: MonadThrow m => FilePath -> m (Path Abs Dir)
-parseCollapsedAbsDir = parseAbsDir . collapseFilePath
-
--- | Collapse intermediate "." and ".." directories from a path.
---
--- > collapseFilePath "./foo" == "foo"
--- > collapseFilePath "/bar/../baz" == "/baz"
--- > collapseFilePath "/../baz" == "/../baz"
--- > collapseFilePath "parent/foo/baz/../bar" ==  "parent/foo/bar"
--- > collapseFilePath "parent/foo/baz/../../bar" ==  "parent/bar"
--- > collapseFilePath "parent/foo/.." ==  "parent"
--- > collapseFilePath "/parent/foo/../../bar" ==  "/bar"
---
--- (borrowed from @Text.Pandoc.Shared@)
-collapseFilePath :: FilePath -> FilePath
-collapseFilePath = FP.joinPath . reverse . foldl go [] . FP.splitDirectories
-  where
-    go rs "." = rs
-    go r@(p:rs) ".." = case p of
-                            ".." -> ("..":r)
-                            (checkPathSeperator -> Just True) -> ("..":r)
-                            _ -> rs
-    go _ (checkPathSeperator -> Just True) = [[FP.pathSeparator]]
-    go rs x = x:rs
-    isSingleton [] = Nothing
-    isSingleton [x] = Just x
-    isSingleton _ = Nothing
-    checkPathSeperator = fmap FP.isPathSeparator . isSingleton
-
 -- | List objects in a directory, excluding "@.@" and "@..@".  Entries are not sorted.
 listDirectory :: (MonadIO m,MonadThrow m) => Path Abs Dir -> m ([Path Abs Dir],[Path Abs File])
 listDirectory dir =
@@ -282,12 +240,6 @@ copyDirectoryRecursive srcDir destDir =
                   Nothing -> return ()
                   Just relSubDir -> copyDirectoryRecursive srcSubDir (destDir </> relSubDir))
 
-
--- | Drop the root (either @\/@ on POSIX or @C:\\@, @D:\\@, etc. on
--- Windows).
-dropRoot :: Path Abs t -> Path Rel t
-dropRoot (Path l) = Path (FP.dropDrive l)
-
 -- Utility function for a common pattern of ignoring does-not-exist errors.
 ignoreDoesNotExist :: MonadIO m => IO () -> m ()
 ignoreDoesNotExist f =

src/Stack/Build/ConstructPlan.hs

@@ -47,19 +47,19 @@ import           Stack.PackageIndex
 import           Stack.Types
 
 data PackageInfo
-    = PIOnlyInstalled Version InstallLocation Installed
+    = PIOnlyInstalled InstallLocation Installed
     | PIOnlySource PackageSource
     | PIBoth PackageSource Installed
 
 combineSourceInstalled :: PackageSource
-                       -> (Version, InstallLocation, Installed)
+                       -> (InstallLocation, Installed)
                        -> PackageInfo
-combineSourceInstalled ps (version, location, installed) =
-    assert (piiVersion ps == version) $
+combineSourceInstalled ps (location, installed) =
+    assert (piiVersion ps == installedVersion installed) $
     assert (piiLocation ps == location) $
     case location of
         -- Always trust something in the snapshot
-        Snap -> PIOnlyInstalled version location installed
+        Snap -> PIOnlyInstalled location installed
         Local -> PIBoth ps installed
 
 type CombinedMap = Map PackageName PackageInfo
@@ -68,7 +68,7 @@ combineMap :: SourceMap -> InstalledMap -> CombinedMap
 combineMap = Map.mergeWithKey
     (\_ s i -> Just $ combineSourceInstalled s i)
     (fmap PIOnlySource)
-    (fmap (\(v, l, i) -> PIOnlyInstalled v l i))
+    (fmap (\(l, i) -> PIOnlyInstalled l i))
 
 data AddDepRes
     = ADRToInstall Task
@@ -282,7 +282,8 @@ addDep'' treatAsDep name = do
         -- TODO look up in the package index and see if there's a
         -- recommendation available
         Nothing -> return $ Left $ UnknownPackage name
-        Just (PIOnlyInstalled version loc installed) -> do
+        Just (PIOnlyInstalled loc installed) -> do
+            let version = installedVersion installed
             tellExecutablesUpstream name version loc Map.empty -- slightly hacky, no flags since they likely won't affect executable names
             return $ Right $ ADRFound loc version installed
         Just (PIOnlySource ps) -> do
@@ -316,7 +317,7 @@ tellExecutablesPackage loc p = do
     let myComps =
             case Map.lookup (packageName p) cm of
                 Nothing -> assert False Set.empty
-                Just (PIOnlyInstalled _ _ _) -> Set.empty
+                Just (PIOnlyInstalled _ _) -> Set.empty
                 Just (PIOnlySource ps) -> goSource ps
                 Just (PIBoth ps _) -> goSource ps