Common.hs

{-
 - Copyright (C) 2010 Joachim Breitner
 - 
 - This program is free software; you can redistribute it and/or modify
 - it under the terms of the GNU General Public License as published by
 - the Free Software Foundation; either version 2, or (at your option)
 - any later version.
 - 
 - This program is distributed in the hope that it will be useful,
 - but WITHOUT ANY WARRANTY; without even the implied warranty of
 - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 - GNU General Public License for more details.
 - 
 - You should have received a copy of the GNU General Public License
 - along with this program; see the file COPYING.  If not, write to
 - the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 - Boston, MA 02110-1301, USA.
 -}
{-# LANGUAGE Rank2Types #-}
module IPatch.Common where

import Control.Applicative ( (<$>) )
import Control.Monad (when)
import System.Posix.Files ( getSymbolicLinkStatus, isRegularFile, isDirectory )
import System.Directory ( createDirectoryIfMissing, doesFileExist, removeFile )
import System.FilePath.Posix ( (</>), takeDirectory, normalise )

import Darcs.Arguments ( DarcsFlag(LookForAdds) )
import Darcs.Repository
    ( createRepository,
      applyToWorking,
      finalizeRepositoryChanges,
      tentativelyAddPatch,
      withGutsOf,
      withRepoLock,
      invalidateIndex,
      unrecordedChanges )
import Darcs.Flags ( Compression(..) )
import Darcs.RepoPath ( AbsolutePath, FilePathLike(..) )
import Darcs.External ( cloneFile )
import Darcs.Lock ( withTempDir )
import Darcs.Patch ( invert, fromPrims, namepatch )
import Darcs.Global ( debugMessage )
import Darcs.Hopefully ( n2pia )
import Darcs.Utils ( clarifyErrors )

import IPatch.DiffFile ( applyDiff )

clonePathWithDeletion :: FilePath -> FilePath -> FilePath -> IO ()
clonePathWithDeletion source dest path = do
    let source' = source </> path
        dest' = dest </> path
    ex <- doesFileExist source'
    if ex
     then do
        fs <- getSymbolicLinkStatus source'
        if isDirectory fs
         then do
            createDirectoryIfMissing True dest'
         else
            if isRegularFile fs
             then do
                createDirectoryIfMissing True (dest </> takeDirectory path)
                cloneFile source' dest'
             else
                fail ("clonePathWithDeletion: Bad file " ++ source')
     else do
        exT <- doesFileExist dest'
        when exT $ removeFile dest'
   `catch` fail ("clonePathWithDeletion: Bad file " ++ source </> path)

clonePathsWithDeletion source dest = mapM_ (clonePathWithDeletion source dest)


withTempRepository :: String -> (AbsolutePath -> IO a) -> IO a
withTempRepository name job =
    withTempDir ("ipatch-repo-" ++ name) $ \rdir -> do
        debugMessage $ "Creating temporary repository in directory " ++ show rdir
        createRepository []
        job rdir

initializeBaseState rdir sdir files = do
    debugMessage $ "Copying " ++ show (length files) ++ " files to temporary repository."  
    clonePathsWithDeletion sdir (toFilePath rdir) files
    -- Create a patch from the newly added files
    debugMessage $ "Creating initial check  in patch"
    withRepoLock [LookForAdds] $ \repo -> do
        init_ps <- unrecordedChanges [LookForAdds] repo [] -- Correct flags?
        init_patch <- n2pia <$> namepatch "NODATE" "Initial state" "NOAUTHOR" [] (fromPrims init_ps)
        tentativelyAddPatch repo [] init_patch
        invalidateIndex repo
        withGutsOf repo (finalizeRepositoryChanges repo)
            `clarifyErrors` "Failed to apply inital patch"
        return init_ps


diffToPrims diff = do
    debugMessage $ "Applying the user provided diff"
    -- Now apply the patch
    applyDiff diff

    debugMessage $ "Creating a patch from the user changes"
    withRepoLock [LookForAdds] $ \repo -> do
        -- Create another patch from the changed files
        patch_ps <- unrecordedChanges [LookForAdds] repo []
        -- patch_patch <- n2pia <$> namepatch date "Patch effect" author [] (fromPrims patch_ps)
        -- tentativelyAddPatch repo [] patch_patch
        -- Now we obliterate the patch, undoing its effects
        applyToWorking repo [] (invert patch_ps) `catch` \e ->
            fail ("Couldn't undo diff effect in working dir.\n" ++ show e)
        return patch_ps
      
stdindefault :: a -> [String] -> IO [String]
stdindefault _ [] = return ["-"]
stdindefault _ x = return x