{-# LANGUAGE CPP #-}

module Development.Shake.Internal.History.Symlink(
    copyFileLink,
    createLinkMaybe
    ) where

import Control.Monad.Extra
import General.Extra
import System.Directory
import System.FilePath


#ifdef mingw32_HOST_OS
import Foreign.Ptr
import Foreign.C.String
#else
import System.Posix.Files(createLink)
#endif

createLinkMaybe :: FilePath -> FilePath -> IO (Maybe String)

#ifdef mingw32_HOST_OS

#ifdef x86_64_HOST_ARCH
#define CALLCONV ccall
#else
#define CALLCONV stdcall
#endif

foreign import CALLCONV unsafe "Windows.h CreateHardLinkW " c_CreateHardLinkW :: CWString -> CWString -> Ptr () -> IO Bool

createLinkMaybe from to = withCWString from $ \cfrom -> withCWString to $ \cto -> do
    res <- c_CreateHardLinkW cto cfrom nullPtr
    pure $ if res then Nothing else Just "CreateHardLink failed."

#else

createLinkMaybe :: FilePath -> FilePath -> IO (Maybe FilePath)
createLinkMaybe FilePath
from FilePath
to = forall a. (IOException -> IO a) -> IO a -> IO a
handleIO (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
createLink FilePath
from FilePath
to forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

#endif


copyFileLink :: Bool -> FilePath -> FilePath -> IO ()
copyFileLink :: Bool -> FilePath -> FilePath -> IO ()
copyFileLink Bool
useSymlink FilePath
from FilePath
to = do
    FilePath -> IO ()
createDirectoryRecursive forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
to
    FilePath -> IO ()
removeFile_ FilePath
to
    if Bool -> Bool
not Bool
useSymlink then FilePath -> FilePath -> IO ()
copyFile FilePath
from FilePath
to else do
        Maybe FilePath
b <- FilePath -> FilePath -> IO (Maybe FilePath)
createLinkMaybe FilePath
from FilePath
to
        forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe FilePath
b forall a b. (a -> b) -> a -> b
$ \FilePath
_ ->
            FilePath -> FilePath -> IO ()
copyFile FilePath
from FilePath
to
        -- making files read only stops them from inadvertently mutating the cache
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath
from, FilePath
to] forall a b. (a -> b) -> a -> b
$ \FilePath
x -> do
            Permissions
perm <- FilePath -> IO Permissions
getPermissions FilePath
x
            FilePath -> Permissions -> IO ()
setPermissions FilePath
x Permissions
perm{writable :: Bool
writable=Bool
False}