Utils.hs

module Distribution.Client.Utils where

import Data.List
         ( sortBy, groupBy )
import qualified Data.ByteString.Lazy as BS
import System.FilePath
         ( (<.>), splitFileName )
import Control.Monad
        ( unless )
import System.IO
         ( openBinaryTempFile, hClose )
import System.IO.Error
         ( isDoesNotExistError )
import System.Directory
         ( removeFile, renameFile, doesFileExist, getModificationTime
         , getCurrentDirectory, setCurrentDirectory )
import qualified Control.Exception as Exception
         ( handle, throwIO, evaluate, finally )

-- | Generic merging utility. For sorted input lists this is a full outer join.
--
-- * The result list never contains @(Nothing, Nothing)@.
--
mergeBy :: (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
mergeBy cmp = merge
  where
    merge []     ys     = [ OnlyInRight y | y <- ys]
    merge xs     []     = [ OnlyInLeft  x | x <- xs]
    merge (x:xs) (y:ys) =
      case x `cmp` y of
        GT -> OnlyInRight   y : merge (x:xs) ys
        EQ -> InBoth      x y : merge xs     ys
        LT -> OnlyInLeft  x   : merge xs  (y:ys)

data MergeResult a b = OnlyInLeft a | InBoth a b | OnlyInRight b

duplicates :: Ord a => [a] -> [[a]]
duplicates = duplicatesBy compare

duplicatesBy :: (a -> a -> Ordering) -> [a] -> [[a]]
duplicatesBy cmp = filter moreThanOne . groupBy eq . sortBy cmp
  where
    eq a b = case cmp a b of
               EQ -> True
               _  -> False
    moreThanOne (_:_:_) = True
    moreThanOne _       = False

writeFileAtomic :: FilePath -> BS.ByteString -> IO ()
writeFileAtomic targetFile content = do
  (tmpFile, tmpHandle) <- openBinaryTempFile targetDir template
  Exception.handle (\err -> do hClose tmpHandle
                               removeFile tmpFile
                               Exception.throwIO err) $ do
      BS.hPut tmpHandle content
      hClose tmpHandle
      renameFile tmpFile targetFile
  where
    template = targetName <.> "tmp"
    targetDir | null targetDir_ = "."
              | otherwise       = targetDir_
    --TODO: remove this when takeDirectory/splitFileName is fixed
    --      to always return a valid dir
    (targetDir_,targetName) = splitFileName targetFile

-- | Compare the modification times of two files to see if the first is newer
-- than the second. The first file must exist but the second need not.
-- The expected use case is when the second file is generated using the first.
-- In this use case, if the result is True then the second file is out of date.
--
moreRecentFile :: FilePath -> FilePath -> IO Bool
moreRecentFile a b = do
  exists <- doesFileExist b
  if not exists
    then return True
    else do tb <- getModificationTime b
            ta <- getModificationTime a
            return (ta > tb)

-- | Write a file but only if it would have new content. If we would be writing
-- the same as the existing content then leave the file as is so that we do not
-- update the file's modification time.
--
rewriteFile :: FilePath -> String -> IO ()
rewriteFile path newContent =
  flip catch mightNotExist $ do
    existingContent <- readFile path
    Exception.evaluate (length existingContent)
    unless (existingContent == newContent) $
      writeFile path newContent
  where
    mightNotExist e | isDoesNotExistError e = writeFile path newContent
                    | otherwise             = ioError e

-- | Executes the action in the specified directory.
inDir :: Maybe FilePath -> IO () -> IO ()
inDir Nothing m = m
inDir (Just d) m = do
  old <- getCurrentDirectory
  setCurrentDirectory d
  m `Exception.finally` setCurrentDirectory old