{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
module Distribution.Client.InstallSymlink (
symlinkBinaries,
symlinkBinary,
trySymlink,
promptRun
) where
import Distribution.Client.Compat.Prelude hiding (ioError)
import Prelude ()
import Distribution.Client.Types
( ConfiguredPackage(..), BuildOutcomes )
import Distribution.Client.Setup
( InstallFlags(installSymlinkBinDir) )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.InstallPlan (InstallPlan)
import Distribution.Solver.Types.SourcePackage
import Distribution.Solver.Types.OptionalStanza
import Distribution.Package
( PackageIdentifier, Package(packageId), UnitId, installedUnitId )
import Distribution.Types.UnqualComponentName
import Distribution.Compiler
( CompilerId(..) )
import qualified Distribution.PackageDescription as PackageDescription
import Distribution.PackageDescription
( PackageDescription )
import Distribution.PackageDescription.Configuration
( finalizePD )
import Distribution.Simple.Setup
( ConfigFlags(..), fromFlag, fromFlagOrDefault, flagToMaybe )
import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.Compiler
( Compiler, compilerInfo, CompilerInfo(..) )
import Distribution.System
( Platform )
import Distribution.Simple.Utils ( info, withTempDirectory )
import System.Directory
( canonicalizePath, getTemporaryDirectory, removeFile )
import System.FilePath
( (</>), splitPath, joinPath, isAbsolute )
import System.IO.Error
( isDoesNotExistError, ioError )
import Control.Exception
( assert )
import Distribution.Client.Compat.Directory ( createFileLink, getSymbolicLinkTarget, pathIsSymbolicLink )
import Distribution.Client.Types.OverwritePolicy
import Distribution.Client.Init.Types ( DefaultPrompt(MandatoryPrompt) )
import Distribution.Client.Init.Prompt ( promptYesNo )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
symlinkBinaries :: Platform -> Compiler
-> OverwritePolicy
-> ConfigFlags
-> InstallFlags
-> InstallPlan
-> BuildOutcomes
-> IO [(PackageIdentifier, UnqualComponentName, FilePath)]
symlinkBinaries :: Platform
-> Compiler
-> OverwritePolicy
-> ConfigFlags
-> InstallFlags
-> InstallPlan
-> BuildOutcomes
-> IO [(PackageIdentifier, UnqualComponentName, FilePath)]
symlinkBinaries Platform
platform Compiler
comp OverwritePolicy
overwritePolicy
ConfigFlags
configFlags InstallFlags
installFlags
InstallPlan
plan BuildOutcomes
buildOutcomes =
case Flag FilePath -> Maybe FilePath
forall a. Flag a -> Maybe a
flagToMaybe (InstallFlags -> Flag FilePath
installSymlinkBinDir InstallFlags
installFlags) of
Maybe FilePath
Nothing -> [(PackageIdentifier, UnqualComponentName, FilePath)]
-> IO [(PackageIdentifier, UnqualComponentName, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just FilePath
symlinkBinDir
| [(ConfiguredPackage UnresolvedPkgLoc, PackageDescription,
Executable)]
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ConfiguredPackage UnresolvedPkgLoc, PackageDescription,
Executable)]
exes -> [(PackageIdentifier, UnqualComponentName, FilePath)]
-> IO [(PackageIdentifier, UnqualComponentName, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise -> do
FilePath
publicBinDir <- FilePath -> IO FilePath
canonicalizePath FilePath
symlinkBinDir
([Maybe (PackageIdentifier, UnqualComponentName, FilePath)]
-> [(PackageIdentifier, UnqualComponentName, FilePath)])
-> IO [Maybe (PackageIdentifier, UnqualComponentName, FilePath)]
-> IO [(PackageIdentifier, UnqualComponentName, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (PackageIdentifier, UnqualComponentName, FilePath)]
-> [(PackageIdentifier, UnqualComponentName, FilePath)]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe (PackageIdentifier, UnqualComponentName, FilePath)]
-> IO [(PackageIdentifier, UnqualComponentName, FilePath)])
-> IO [Maybe (PackageIdentifier, UnqualComponentName, FilePath)]
-> IO [(PackageIdentifier, UnqualComponentName, FilePath)]
forall a b. (a -> b) -> a -> b
$ [IO (Maybe (PackageIdentifier, UnqualComponentName, FilePath))]
-> IO [Maybe (PackageIdentifier, UnqualComponentName, FilePath)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
[ do FilePath
privateBinDir <- PackageDescription -> UnitId -> IO FilePath
pkgBinDir PackageDescription
pkg UnitId
ipid
Bool
ok <- OverwritePolicy
-> FilePath -> FilePath -> FilePath -> FilePath -> IO Bool
symlinkBinary
OverwritePolicy
overwritePolicy
FilePath
publicBinDir FilePath
privateBinDir
(UnqualComponentName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow UnqualComponentName
publicExeName) FilePath
privateExeName
if Bool
ok
then Maybe (PackageIdentifier, UnqualComponentName, FilePath)
-> IO (Maybe (PackageIdentifier, UnqualComponentName, FilePath))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (PackageIdentifier, UnqualComponentName, FilePath)
forall a. Maybe a
Nothing
else Maybe (PackageIdentifier, UnqualComponentName, FilePath)
-> IO (Maybe (PackageIdentifier, UnqualComponentName, FilePath))
forall (m :: * -> *) a. Monad m => a -> m a
return ((PackageIdentifier, UnqualComponentName, FilePath)
-> Maybe (PackageIdentifier, UnqualComponentName, FilePath)
forall a. a -> Maybe a
Just (PackageIdentifier
pkgid, UnqualComponentName
publicExeName,
FilePath
privateBinDir FilePath -> FilePath -> FilePath
</> FilePath
privateExeName))
| (ConfiguredPackage UnresolvedPkgLoc
rpkg, PackageDescription
pkg, Executable
exe) <- [(ConfiguredPackage UnresolvedPkgLoc, PackageDescription,
Executable)]
exes
, let pkgid :: PackageIdentifier
pkgid = PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg
ipid :: UnitId
ipid = ConfiguredPackage UnresolvedPkgLoc -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ConfiguredPackage UnresolvedPkgLoc
rpkg
publicExeName :: UnqualComponentName
publicExeName = Executable -> UnqualComponentName
PackageDescription.exeName Executable
exe
privateExeName :: FilePath
privateExeName = FilePath
prefix FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
publicExeName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
suffix
prefix :: FilePath
prefix = PackageIdentifier -> UnitId -> PathTemplate -> FilePath
substTemplate PackageIdentifier
pkgid UnitId
ipid PathTemplate
prefixTemplate
suffix :: FilePath
suffix = PackageIdentifier -> UnitId -> PathTemplate -> FilePath
substTemplate PackageIdentifier
pkgid UnitId
ipid PathTemplate
suffixTemplate ]
where
exes :: [(ConfiguredPackage UnresolvedPkgLoc, PackageDescription,
Executable)]
exes =
[ (ConfiguredPackage UnresolvedPkgLoc
cpkg, PackageDescription
pkg, Executable
exe)
| InstallPlan.Configured ConfiguredPackage UnresolvedPkgLoc
cpkg <- InstallPlan
-> [GenericPlanPackage
InstalledPackageInfo (ConfiguredPackage UnresolvedPkgLoc)]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList InstallPlan
plan
, case ConfiguredPackage UnresolvedPkgLoc
-> BuildOutcomes -> Maybe (Either BuildFailure BuildResult)
forall pkg failure result.
HasUnitId pkg =>
pkg
-> BuildOutcomes failure result -> Maybe (Either failure result)
InstallPlan.lookupBuildOutcome ConfiguredPackage UnresolvedPkgLoc
cpkg BuildOutcomes
buildOutcomes of
Just (Right BuildResult
_success) -> Bool
True
Maybe (Either BuildFailure BuildResult)
_ -> Bool
False
, let pkg :: PackageDescription
pkg :: PackageDescription
pkg = ConfiguredPackage UnresolvedPkgLoc -> PackageDescription
forall loc. ConfiguredPackage loc -> PackageDescription
pkgDescription ConfiguredPackage UnresolvedPkgLoc
cpkg
, Executable
exe <- PackageDescription -> [Executable]
PackageDescription.executables PackageDescription
pkg
, BuildInfo -> Bool
PackageDescription.buildable (Executable -> BuildInfo
PackageDescription.buildInfo Executable
exe) ]
pkgDescription :: ConfiguredPackage loc -> PackageDescription
pkgDescription (ConfiguredPackage InstalledPackageId
_ (SourcePackage PackageIdentifier
_ GenericPackageDescription
gpd loc
_ PackageDescriptionOverride
_)
FlagAssignment
flags OptionalStanzaSet
stanzas ComponentDeps [ConfiguredId]
_) =
case FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> Bool)
-> Platform
-> CompilerInfo
-> [PackageVersionConstraint]
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
finalizePD FlagAssignment
flags (OptionalStanzaSet -> ComponentRequestedSpec
enableStanzas OptionalStanzaSet
stanzas)
(Bool -> Dependency -> Bool
forall a b. a -> b -> a
const Bool
True)
Platform
platform CompilerInfo
cinfo [] GenericPackageDescription
gpd of
Left [Dependency]
_ -> FilePath -> PackageDescription
forall a. HasCallStack => FilePath -> a
error FilePath
"finalizePD ReadyPackage failed"
Right (PackageDescription
desc, FlagAssignment
_) -> PackageDescription
desc
pkgBinDir :: PackageDescription -> UnitId -> IO FilePath
pkgBinDir :: PackageDescription -> UnitId -> IO FilePath
pkgBinDir PackageDescription
pkg UnitId
ipid = do
InstallDirTemplates
defaultDirs <- CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates
InstallDirs.defaultInstallDirs
CompilerFlavor
compilerFlavor
(Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Bool
configUserInstall ConfigFlags
configFlags))
(PackageDescription -> Bool
PackageDescription.hasLibs PackageDescription
pkg)
let templateDirs :: InstallDirTemplates
templateDirs = (PathTemplate -> Flag PathTemplate -> PathTemplate)
-> InstallDirTemplates
-> InstallDirs (Flag PathTemplate)
-> InstallDirTemplates
forall a b c.
(a -> b -> c) -> InstallDirs a -> InstallDirs b -> InstallDirs c
InstallDirs.combineInstallDirs PathTemplate -> Flag PathTemplate -> PathTemplate
forall a. a -> Flag a -> a
fromFlagOrDefault
InstallDirTemplates
defaultDirs (ConfigFlags -> InstallDirs (Flag PathTemplate)
configInstallDirs ConfigFlags
configFlags)
absoluteDirs :: InstallDirs FilePath
absoluteDirs = PackageIdentifier
-> UnitId
-> CompilerInfo
-> CopyDest
-> Platform
-> InstallDirTemplates
-> InstallDirs FilePath
InstallDirs.absoluteInstallDirs
(PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg) UnitId
ipid
CompilerInfo
cinfo CopyDest
InstallDirs.NoCopyDest
Platform
platform InstallDirTemplates
templateDirs
FilePath -> IO FilePath
canonicalizePath (InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
InstallDirs.bindir InstallDirs FilePath
absoluteDirs)
substTemplate :: PackageIdentifier -> UnitId -> PathTemplate -> FilePath
substTemplate PackageIdentifier
pkgid UnitId
ipid = PathTemplate -> FilePath
InstallDirs.fromPathTemplate
(PathTemplate -> FilePath)
-> (PathTemplate -> PathTemplate) -> PathTemplate -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PathTemplateEnv -> PathTemplate -> PathTemplate
InstallDirs.substPathTemplate PathTemplateEnv
env
where env :: PathTemplateEnv
env = PackageIdentifier
-> UnitId -> CompilerInfo -> Platform -> PathTemplateEnv
InstallDirs.initialPathTemplateEnv PackageIdentifier
pkgid UnitId
ipid
CompilerInfo
cinfo Platform
platform
fromFlagTemplate :: Flag PathTemplate -> PathTemplate
fromFlagTemplate = PathTemplate -> Flag PathTemplate -> PathTemplate
forall a. a -> Flag a -> a
fromFlagOrDefault (FilePath -> PathTemplate
InstallDirs.toPathTemplate FilePath
"")
prefixTemplate :: PathTemplate
prefixTemplate = Flag PathTemplate -> PathTemplate
fromFlagTemplate (ConfigFlags -> Flag PathTemplate
configProgPrefix ConfigFlags
configFlags)
suffixTemplate :: PathTemplate
suffixTemplate = Flag PathTemplate -> PathTemplate
fromFlagTemplate (ConfigFlags -> Flag PathTemplate
configProgSuffix ConfigFlags
configFlags)
cinfo :: CompilerInfo
cinfo = Compiler -> CompilerInfo
compilerInfo Compiler
comp
(CompilerId CompilerFlavor
compilerFlavor Version
_) = CompilerInfo -> CompilerId
compilerInfoId CompilerInfo
cinfo
symlinkBinary ::
OverwritePolicy
-> FilePath
-> FilePath
-> FilePath
-> String
-> IO Bool
symlinkBinary :: OverwritePolicy
-> FilePath -> FilePath -> FilePath -> FilePath -> IO Bool
symlinkBinary OverwritePolicy
overwritePolicy FilePath
publicBindir FilePath
privateBindir FilePath
publicName FilePath
privateName = do
SymlinkStatus
ok <- FilePath -> FilePath -> IO SymlinkStatus
targetOkToOverwrite (FilePath
publicBindir FilePath -> FilePath -> FilePath
</> FilePath
publicName)
(FilePath
privateBindir FilePath -> FilePath -> FilePath
</> FilePath
privateName)
case SymlinkStatus
ok of
SymlinkStatus
NotExists -> IO Bool
mkLink
SymlinkStatus
OkToOverwrite -> IO Bool
overwrite
SymlinkStatus
NotOurFile ->
case OverwritePolicy
overwritePolicy of
OverwritePolicy
NeverOverwrite -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
OverwritePolicy
AlwaysOverwrite -> IO Bool
overwrite
OverwritePolicy
PromptOverwrite -> IO Bool
maybeOverwrite
where
relativeBindir :: FilePath
relativeBindir = FilePath -> FilePath -> FilePath
makeRelative FilePath
publicBindir FilePath
privateBindir
mkLink :: IO Bool
mkLink :: IO Bool
mkLink = Bool
True Bool -> IO () -> IO Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ FilePath -> FilePath -> IO ()
createFileLink (FilePath
relativeBindir FilePath -> FilePath -> FilePath
</> FilePath
privateName) (FilePath
publicBindir FilePath -> FilePath -> FilePath
</> FilePath
publicName)
rmLink :: IO Bool
rmLink :: IO Bool
rmLink = Bool
True Bool -> IO () -> IO Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ FilePath -> IO ()
removeFile (FilePath
publicBindir FilePath -> FilePath -> FilePath
</> FilePath
publicName)
overwrite :: IO Bool
overwrite :: IO Bool
overwrite = IO Bool
rmLink IO Bool -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO Bool
mkLink
maybeOverwrite :: IO Bool
maybeOverwrite :: IO Bool
maybeOverwrite
= FilePath -> IO Bool -> IO Bool
promptRun
FilePath
"Existing file found while installing symlink. Do you want to overwrite that file? (y/n)"
IO Bool
overwrite
promptRun :: String -> IO Bool -> IO Bool
promptRun :: FilePath -> IO Bool -> IO Bool
promptRun FilePath
s IO Bool
m = do
Bool
a <- FilePath -> DefaultPrompt Bool -> IO Bool
forall (m :: * -> *).
Interactive m =>
FilePath -> DefaultPrompt Bool -> m Bool
promptYesNo FilePath
s DefaultPrompt Bool
forall t. DefaultPrompt t
MandatoryPrompt
if Bool
a then IO Bool
m else Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
a
targetOkToOverwrite :: FilePath
-> FilePath
-> IO SymlinkStatus
targetOkToOverwrite :: FilePath -> FilePath -> IO SymlinkStatus
targetOkToOverwrite FilePath
symlink FilePath
target = IO SymlinkStatus -> IO SymlinkStatus
handleNotExist (IO SymlinkStatus -> IO SymlinkStatus)
-> IO SymlinkStatus -> IO SymlinkStatus
forall a b. (a -> b) -> a -> b
$ do
Bool
isLink <- FilePath -> IO Bool
pathIsSymbolicLink FilePath
symlink
if Bool -> Bool
not Bool
isLink
then SymlinkStatus -> IO SymlinkStatus
forall (m :: * -> *) a. Monad m => a -> m a
return SymlinkStatus
NotOurFile
else do FilePath
target' <- FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO FilePath
getSymbolicLinkTarget FilePath
symlink
if FilePath
target FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
target'
then SymlinkStatus -> IO SymlinkStatus
forall (m :: * -> *) a. Monad m => a -> m a
return SymlinkStatus
OkToOverwrite
else SymlinkStatus -> IO SymlinkStatus
forall (m :: * -> *) a. Monad m => a -> m a
return SymlinkStatus
NotOurFile
where
handleNotExist :: IO SymlinkStatus -> IO SymlinkStatus
handleNotExist IO SymlinkStatus
action = IO SymlinkStatus
-> (IOException -> IO SymlinkStatus) -> IO SymlinkStatus
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO IO SymlinkStatus
action ((IOException -> IO SymlinkStatus) -> IO SymlinkStatus)
-> (IOException -> IO SymlinkStatus) -> IO SymlinkStatus
forall a b. (a -> b) -> a -> b
$ \IOException
ioexception ->
if IOException -> Bool
isDoesNotExistError IOException
ioexception
then SymlinkStatus -> IO SymlinkStatus
forall (m :: * -> *) a. Monad m => a -> m a
return SymlinkStatus
NotExists
else IOException -> IO SymlinkStatus
forall a. IOException -> IO a
ioError IOException
ioexception
data SymlinkStatus
= NotExists
| OkToOverwrite
| NotOurFile
deriving Int -> SymlinkStatus -> FilePath -> FilePath
[SymlinkStatus] -> FilePath -> FilePath
SymlinkStatus -> FilePath
(Int -> SymlinkStatus -> FilePath -> FilePath)
-> (SymlinkStatus -> FilePath)
-> ([SymlinkStatus] -> FilePath -> FilePath)
-> Show SymlinkStatus
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [SymlinkStatus] -> FilePath -> FilePath
$cshowList :: [SymlinkStatus] -> FilePath -> FilePath
show :: SymlinkStatus -> FilePath
$cshow :: SymlinkStatus -> FilePath
showsPrec :: Int -> SymlinkStatus -> FilePath -> FilePath
$cshowsPrec :: Int -> SymlinkStatus -> FilePath -> FilePath
Show
makeRelative :: FilePath -> FilePath -> FilePath
makeRelative :: FilePath -> FilePath -> FilePath
makeRelative FilePath
a FilePath
b = Bool -> FilePath -> FilePath
forall a. HasCallStack => Bool -> a -> a
assert (FilePath -> Bool
isAbsolute FilePath
a Bool -> Bool -> Bool
&& FilePath -> Bool
isAbsolute FilePath
b) (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$
let as :: [FilePath]
as = FilePath -> [FilePath]
splitPath FilePath
a
bs :: [FilePath]
bs = FilePath -> [FilePath]
splitPath FilePath
b
commonLen :: Int
commonLen = [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Bool] -> Int) -> [Bool] -> Int
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Bool -> Bool
forall a. a -> a
id ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath -> Bool)
-> [FilePath] -> [FilePath] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
(==) [FilePath]
as [FilePath]
bs
in [FilePath] -> FilePath
joinPath ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [ FilePath
".." | FilePath
_ <- Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop Int
commonLen [FilePath]
as ]
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop Int
commonLen [FilePath]
bs
trySymlink :: Verbosity -> IO Bool
trySymlink :: Verbosity -> IO Bool
trySymlink Verbosity
verbosity = do
FilePath
tmp <- IO FilePath
getTemporaryDirectory
Verbosity
-> FilePath -> FilePath -> (FilePath -> IO Bool) -> IO Bool
forall a.
Verbosity -> FilePath -> FilePath -> (FilePath -> IO a) -> IO a
withTempDirectory Verbosity
verbosity FilePath
tmp FilePath
"cabal-symlink-test" ((FilePath -> IO Bool) -> IO Bool)
-> (FilePath -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \FilePath
tmpDirPath -> do
let from :: FilePath
from = FilePath
tmpDirPath FilePath -> FilePath -> FilePath
</> FilePath
"file.txt"
let to :: FilePath
to = FilePath
tmpDirPath FilePath -> FilePath -> FilePath
</> FilePath
"file2.txt"
FilePath -> ByteString -> IO ()
BS.writeFile FilePath
from (FilePath -> ByteString
BS8.pack FilePath
"TEST")
let create :: IO Bool
create :: IO Bool
create = do
FilePath -> FilePath -> IO ()
createFileLink FilePath
from FilePath
to
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Symlinking seems to work"
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
IO Bool
create IO Bool -> (IOException -> IO Bool) -> IO Bool
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` \IOException
exc -> do
Verbosity -> FilePath -> IO ()
info Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Symlinking doesn't seem to be working: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ IOException -> FilePath
forall a. Show a => a -> FilePath
show IOException
exc
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False