Use permissions code from directory

commercialhaskell · Aug 15, 2018 · 1a98bff · 1a98bff
1 parent ba8895d
commit 1a98bff
Show file tree

Hide file tree

Showing 2 changed files with 4 additions and 17 deletions.
diff --git a/subs/pantry/package.yaml b/subs/pantry/package.yaml
@@ -45,14 +45,6 @@ dependencies:
 - yaml
 - zip-archive
 
-when:
-- condition: os(windows)
-  then:
-    cpp-options: -DWINDOWS
-  else:
-    dependencies:
-    - unix
-
 library:
   source-dirs: src/
   exposed-modules:

diff --git a/subs/pantry/src/Pantry/Tree.hs b/subs/pantry/src/Pantry/Tree.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ViewPatterns #-}
@@ -18,17 +17,13 @@ import qualified RIO.ByteString as B
 import Pantry.Storage
 import Pantry.Types
 import RIO.FilePath ((</>), takeDirectory)
-import RIO.Directory (createDirectoryIfMissing)
+import RIO.Directory (createDirectoryIfMissing, setPermissions, getPermissions, setOwnerExecutable)
 import Path (Path, Abs, Dir, toFilePath)
 import Distribution.Parsec.Common (PWarning (..))
 import Distribution.PackageDescription (packageDescription, package, GenericPackageDescription)
 import Distribution.PackageDescription.Parsec
 import Path (File)
 
-#if !WINDOWS
-import System.Posix.Files (setFileMode)
-#endif
-
 unpackTree
   :: (HasPantryConfig env, HasLogFunc env)
   => Path Abs Dir -- ^ dest dir, will be created if necessary
@@ -43,11 +38,11 @@ unpackTree (toFilePath -> dir) (TreeMap m) = do
       Nothing -> error $ "Missing blob: " ++ show blobKey
       Just bs -> do
         B.writeFile dest bs
-#if !WINDOWS
         case ft of
           FTNormal -> pure ()
-          FTExecutable -> liftIO $ setFileMode dest 0o755
-#endif
+          FTExecutable -> liftIO $ do
+            perms <- getPermissions dest
+            setPermissions dest $ setOwnerExecutable True perms
 
 findCabalFile
   :: MonadThrow m