{-# 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 = (IOException -> IO (Maybe FilePath))
-> IO (Maybe FilePath) -> IO (Maybe FilePath)
forall a. (IOException -> IO a) -> IO a -> IO a
handleIO (Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> (IOException -> Maybe FilePath)
-> IOException
-> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> (IOException -> FilePath) -> IOException -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> FilePath
forall a. Show a => a -> FilePath
show) (IO (Maybe FilePath) -> IO (Maybe FilePath))
-> IO (Maybe FilePath) -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
createLink FilePath
from FilePath
to IO () -> IO (Maybe FilePath) -> IO (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
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 (FilePath -> IO ()) -> FilePath -> IO ()
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
        Maybe FilePath -> (FilePath -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe FilePath
b ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
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
        [FilePath] -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath
from, FilePath
to] ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
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}