--------------------------------------------------------------------------------
--- Some utilities for deailing with files and directories
--- for the Curry Package Manager.
--------------------------------------------------------------------------------

module CPM.FileUtil
  ( joinSearchPath
  , copyDirectory
  , createSymlink
  , removeSymlink
  , isSymlink, linkTarget, getRealPath
  , copyDirectoryFollowingSymlinks
  , quote
  , tempDir
  , cleanTempDir
  , inTempDir
  , inDirectory
  , recreateDirectory
  , removeDirectoryComplete
  , safeReadFile, checkAndGetVisibleDirectoryContents
  , whenFileExists, ifFileExists, writeFileIfNotExists
  ) where

import System.Directory   ( doesFileExist, doesDirectoryExist
                          , setCurrentDirectory, getDirectoryContents
                          , getTemporaryDirectory, doesDirectoryExist
                          , createDirectory, createDirectoryIfMissing
                          , getAbsolutePath, getCurrentDirectory )
import System.Process     ( system, exitWith, getPID )
import System.Environment ( getEnv )
import System.FilePath    ( FilePath, replaceFileName, (</>)
                          , searchPathSeparator )
import Data.List          ( intercalate, isPrefixOf, splitOn )
import Control.Monad      ( when )
import System.IOExts      ( evalCmd, readCompleteFile )

import CPM.Helpers        ( stripSpaces )

--- Joins a list of directories into a search path.
joinSearchPath :: [FilePath] -> String
joinSearchPath = intercalate [searchPathSeparator] . map emptyPath2Dot
 where
  emptyPath2Dot p = if null p then "." else p

--- Recursively copies a directory structure.
copyDirectory :: String -> String -> IO ()
copyDirectory src dst = do
  retCode <- system $ "cp -pR \"" ++ src ++ "\" \"" ++ dst ++ "\""
  if retCode /= 0
    then error $ "Copy failed with " ++ (show retCode)
    else return ()

--- Recursively copies a directory structure following symlinks, i.e. links
--- get replaced by copies in the destination.
copyDirectoryFollowingSymlinks :: String -> String -> IO ()
copyDirectoryFollowingSymlinks src dst = do
  retCode <- system $ "cp -pLR \"" ++ src ++ "\" \"" ++ dst ++ "\""
  if retCode /= 0
    then error $ "Copy failed with " ++ (show retCode)
    else return ()

--- Creates a new symlink.
createSymlink :: String -> String -> IO Int
createSymlink from to = system $ "ln -s " ++ (quote from) ++ " " ++ (quote to)

--- Deletes a symlink.
removeSymlink :: String -> IO Int
removeSymlink link = system $ "rm " ++ quote link

--- Tests whether a file is a symlink.
isSymlink :: String -> IO Bool
isSymlink link = do
  (code, _, _) <- evalCmd "readlink" ["-n", link] ""
  return $ code == 0

--- Gets the target of a symlink.
linkTarget :: String -> IO String
linkTarget link = do
  (rc, out, _) <- evalCmd "readlink" ["-n", link] ""
  return $ if rc == 0 then replaceFileName link out
                      else ""

--- Returns the absolute real path for a given file path
--- by following all symlinks in all path components.
getRealPath :: String -> IO String
getRealPath path = do
  (rc, out, _) <- evalCmd "realpath" [path] ""
  if rc == 0 then return (stripSpaces out)
             else getAbsolutePath path

--- Puts a file argument into quotes to avoid problems with files containing
--- blanks.
quote :: String -> String
quote s = "\"" ++ s ++ "\""

--- Gets a temporary directory for some CPM command.
tempDir :: IO String
tempDir = do
  t   <- getTemporaryDirectory
  pid <- getPID
  return (t </> "cpm" ++ show pid)

--- Removes the temporary directory for some CPM command.
cleanTempDir :: IO ()
cleanTempDir = tempDir >>= removeDirectoryComplete

--- Executes an IO action with the current directory set to  CPM's temporary
--- directory.
inTempDir :: IO b -> IO b
inTempDir b = do
  t <- tempDir
  exists <- doesDirectoryExist t
  if exists
    then return ()
    else createDirectory t
  inDirectory t b

--- Executes an IO action with the current directory set to a specific
--- directory.
inDirectory :: String -> IO b -> IO b
inDirectory dir b = do
  previous <- getCurrentDirectory
  setCurrentDirectory dir
  b' <- b
  setCurrentDirectory previous
  return b'

--- Recreates a directory. Deletes its contents if it already exists.
recreateDirectory :: String -> IO ()
recreateDirectory dir = do
  removeDirectoryComplete dir
  createDirectoryIfMissing True dir

--- Deletes a directory and its contents, if it exists, otherwise nothing
--- is done.
removeDirectoryComplete :: String -> IO ()
removeDirectoryComplete dir = do
  exists <- doesDirectoryExist dir
  when exists $ system ("rm -Rf " ++ quote dir) >> return ()

--- Reads the complete contents of a file and catches any error
--- (which is returned).
safeReadFile :: String -> IO (Either IOError String)
safeReadFile fname = do
  catch (readCompleteFile fname >>= return . Right)
        (return . Left)

--- Returns the list of all entries in a directory and terminates with
--- an error message if the directory does not exist.
checkAndGetDirectoryContents :: FilePath -> IO [FilePath]
checkAndGetDirectoryContents dir = do
  exdir <- doesDirectoryExist dir
  if exdir then getDirectoryContents dir
           else do putStrLn $ "ERROR: Directory '" ++ dir ++ "' does not exist!"
                   exitWith 1

--- Returns the list of all visible entries in a directory (i.e., not starting
--- with '.') and terminates with an error message if the directory
--- does not exist.
checkAndGetVisibleDirectoryContents :: FilePath -> IO [FilePath]
checkAndGetVisibleDirectoryContents dir =
  checkAndGetDirectoryContents dir >>= return . filter (not . isPrefixOf ".")

--- Performs one of two actions depending on the existence of a file.
ifFileExists :: FilePath -> IO a -> IO a -> IO a
ifFileExists fname thenact elseact = do
  exfile <- doesFileExist fname
  if exfile then thenact else elseact

--- Performs an action when a file exists.
whenFileExists :: FilePath -> IO () -> IO ()
whenFileExists fname act =
  ifFileExists fname act (return ())

--- Writes a file with a given contents if it does not exist.
writeFileIfNotExists :: FilePath -> String -> IO ()
writeFileIfNotExists fname cnt =
  ifFileExists fname (return ()) (writeFile fname cnt)