[pkg-haskell-tools] 01/01: dht make-all: link instead of copy, if possible

[Joachim Breitner]

This is an automated email from the git hooks/post-receive script.

nomeata pushed a commit to branch master
in repository pkg-haskell-tools.

commit 41cb90b4b3706075ea21e9a30bcb45a0d2521e29
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Wed Aug 19 19:42:29 2015 +0200

    dht make-all: link instead of copy, if possible
---
 dht.cabal       |  1 +
 src/Link.hs     | 15 +++++++++++++++
 src/make-all.hs |  3 ++-
 3 files changed, 18 insertions(+), 1 deletion(-)

diff --git a/dht.cabal b/dht.cabal
index 24ab27d..7f7dbbf 100644
--- a/dht.cabal
+++ b/dht.cabal
@@ -21,6 +21,7 @@ executable make-all
     directory,
     filepath,
     time,
+    unix,
     parsec,
     text,
     shake == 0.15.*,
diff --git a/src/Link.hs b/src/Link.hs
new file mode 100644
index 0000000..dd36477
--- /dev/null
+++ b/src/Link.hs
@@ -0,0 +1,15 @@
+module Link (linkOrCopyFile) where
+
+import Control.Exception
+import System.IO.Error
+import GHC.IO.Exception
+
+import System.Posix.Files
+import System.Directory
+
+linkOrCopyFile :: FilePath -> FilePath -> IO ()
+linkOrCopyFile old new = do
+    catchJust
+        (\e -> if ioeGetErrorType e == UnsupportedOperation then Just () else Nothing)
+        (createLink old new)
+        (\() -> copyFile old new)
diff --git a/src/make-all.hs b/src/make-all.hs
index 3c46205..ea83ed6 100644
--- a/src/make-all.hs
+++ b/src/make-all.hs
@@ -31,6 +31,7 @@ import Text.Parsec hiding (option, oneOf)
 import Text.Parsec.String
 
 import Utils
+import Link
 
 -- Option parsing
 data Conf = Conf
@@ -429,7 +430,7 @@ shakeMain conf@(Conf {..}) = do
             -- Create a dummy repository
             let repoDir = tmpdir </> "repo"
             liftIO $ createDirectory repoDir
-            forM_ localDebs $ \p -> liftIO $ copyFile ("lab" </> p) (repoDir </> p)
+            forM_ localDebs $ \p -> liftIO $ linkOrCopyFile ("lab" </> p) (repoDir </> p)
             unit $ cmd (Cwd repoDir)  (EchoStderr False) (FileStdout (repoDir </> "Packages"))
                 ["dpkg-scanpackages", "."]
 

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-haskell/pkg-haskell-tools.git