%  Copyright (C) 2002-2005,2007 David Roundy
%
%  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.

\subsection{darcs convert}
\begin{code}
{-# OPTIONS_GHC -cpp -fglasgow-exts #-}
{-# LANGUAGE CPP #-}
-- , MagicHash #-}

#include "gadts.h"

module Darcs.Commands.Convert ( convert ) where

import System.Directory ( setCurrentDirectory, doesDirectoryExist, doesFileExist,
                   createDirectory )
import Workaround ( getCurrentDirectory )
import Control.Monad ( when )
import GHC.Base ( unsafeCoerce# )
import Data.Maybe ( catMaybes )

import Darcs.Hopefully ( PatchInfoAnd, n2pia, info, hopefully )
import Darcs.Commands ( DarcsCommand(..), nodefaults )
import Darcs.Arguments ( DarcsFlag( AllowConflicts, NewRepo,
                                    SetScriptsExecutable, UseFormat2, NoUpdateWorking,
                                    Verbose, Quiet ),
                        reponame,
                        set_scripts_executable,
                        network_options )
import Darcs.Repository ( Repository, withRepoLock, ($-), withRepositoryDirectory, read_repo,
                          createRepository,
                          slurp_recorded, optimizeInventory,
                          tentativelyMergePatches, patchSetToPatches,
                          createPristineDirectoryTree,
                          revertRepositoryChanges, finalizeRepositoryChanges, sync_repo )
import Darcs.Global ( darcsdir )
import Darcs.Patch ( RealPatch, Patch, Named, showPatch, patch2patchinfo, fromPrims, infopatch,
                     modernize_patch,
                     adddeps, getdeps, effect, flattenFL, is_merger, patchcontents )
import Darcs.Ordered ( FL(..), RL(..), EqCheck(..), (=/\=), bunchFL, mapFL, mapFL_FL,
                             concatFL, concatRL, mapRL )
import Darcs.Patch.Info ( pi_rename, pi_tag, is_tag )
import Darcs.Patch.Commute ( public_unravel )
import Darcs.Patch.Real ( mergeUnravelled )
import Darcs.RepoPath ( ioAbsoluteOrRemote, toPath )
import Darcs.Repository.Motd ( show_motd )
import Darcs.Utils ( clarify_errors, askUser )
import Darcs.ProgressPatches ( progressFL )
import Darcs.Sealed ( FlippedSeal(..) )
import Printer ( text, putDocLn, ($$) )
import Darcs.ColorPrinter ( traceDoc )
import Darcs.SlurpDirectory ( list_slurpy_files )
import Darcs.Lock ( writeBinFile )
import Workaround ( setExecutable )
import qualified Data.ByteString as B (isPrefixOf, readFile)
import qualified Data.ByteString.Char8 as BC (pack)

convert_description :: String
convert_description =
 "Convert a repository to darcs-2 format."
\end{code}

\options{convert}

You may specify the name of the repository created by providing a second
argument to convert, which is a directory name.

\begin{code}
convert_help :: String
convert_help =
 "Convert is used to convert a repository to darcs-2 format.\n\n" ++
 "The recommended way to convert an existing project from darcs 1 to\n" ++
 "darcs 2 is to merge all branches, `darcs convert' the resulting\n" ++
 "repository, re-create each branch by using `darcs get' on the\n" ++
 "converted repository, then using `darcs obliterate' to delete patches\n" ++
 "of branches.\n"

convert :: DarcsCommand
convert = DarcsCommand {command_name = "convert",
                    command_help = convert_help,
                    command_description = convert_description,
                    command_extra_args = -1,
                    command_extra_arg_help = ["<REPOSITORY>", "[<DIRECTORY>]"],
                    command_command = convert_cmd,
                    command_prereq = \_ -> return $ Right (),
                    command_get_arg_possibilities = return [],
                    command_argdefaults = nodefaults,
                    command_advanced_options = network_options,
                    command_basic_options = [reponame,set_scripts_executable]}

convert_cmd :: [DarcsFlag] -> [String] -> IO ()
convert_cmd opts [inrepodir, outname] = convert_cmd (NewRepo outname:opts) [inrepodir]
convert_cmd orig_opts [inrepodir] = do
  putDocLn $ text "WARNING: the repository produced by this command is not understood by" $$
             text "the darcs 1 program, and patches cannot be exchanged between" $$
             text "repositories in darcs 1 and darcs 2 formats.\n" $$
             text "Furthermore, darcs 2 repositories created by different invocations of" $$
             text "this command SHOULD NOT exchange patches, unless those repositories" $$
             text "had no patches in common when they were converted.  (That is, within a" $$
             text "set of repos that exchange patches, no patch should be converted more" $$
             text "than once.)\n" $$
             text "This command DOES NOT modify the source repository.  It is safe to run" $$
             text "this command more than once on a single repository, but the resulting" $$
             text "repositories will not be able to exchange patches.\n" $$
             text "Please confirm that you have read and understood the above"
  let vow = "I understand the consequences of my action"
  vow' <- askUser ("by typing `" ++ vow ++ "': ")
  when (vow' /= vow) $ fail "User didn't understand the consequences."
  let opts = UseFormat2:orig_opts
  typed_repodir <- ioAbsoluteOrRemote inrepodir
  let repodir = toPath typed_repodir
  show_motd opts repodir
  mysimplename <- make_repo_name opts repodir
  createDirectory mysimplename
  setCurrentDirectory mysimplename
  createRepository opts
  writeBinFile (darcsdir++"/hashed_inventory") ""
  withRepoLock (NoUpdateWorking:opts) $- \repositoryfoo ->
    withRepositoryDirectory opts repodir $- \themrepobar -> do
      -- We really ought to have special versions of withRepoLock and
      -- withRepositoryDirectory that check at runtime that it's the right
      -- sort of repository and accept a function of (Repository Patch) or
      -- (Repository (FL RealPatch)), but that seems like a lot of work
      -- when these functions would be used exactly once, right here.  So I
      -- go with a horrible evil hack.

      -- The other alternative (which is what we used to do) is to use
      -- "universal" functions to do the conversion, but that's also
      -- unsatisfying.

      let repository = unsafeCoerce# repositoryfoo :: Repository (FL RealPatch)
          themrepo = unsafeCoerce# themrepobar :: Repository Patch
      theirstuff <- read_repo themrepo
      let patches = mapFL_FL convertNamed $ patchSetToPatches theirstuff
          inOrderTags = iot theirstuff
              where iot ((t:<:NilRL):<:r) = info t : iot r
                    iot (NilRL:<:r) = iot r
                    iot NilRL = []
                    iot ((_:<:x):<:y) = iot (x:<:y)
          outOfOrderTags = catMaybes $ mapRL oot $ concatRL theirstuff
              where oot t = if is_tag (info t) && not (info t `elem` inOrderTags)
                            then Just (info t, getdeps $ hopefully t)
                            else Nothing
          fixDep p = case lookup p outOfOrderTags of
                     Just d -> p : concatMap fixDep d
                     Nothing -> [p]
          convertOne :: Patch -> FL RealPatch
          convertOne x | is_merger x = case mergeUnravelled $ public_unravel $ modernize_patch x of
                                       Just (FlippedSeal y) ->
                                           case effect y =/\= effect x of
                                           IsEq -> y :>: NilFL
                                           NotEq ->
                                               traceDoc (text "lossy conversion:" $$
                                                         showPatch x)
                                               fromPrims (effect x)
                                       Nothing -> traceDoc (text
                                                            "lossy conversion of complicated conflict:" $$
                                                            showPatch x)
                                                  fromPrims (effect x)
                       | otherwise = case flattenFL x of
                                     NilFL -> NilFL
                                     (x':>:NilFL) -> fromPrims $ effect x'
                                     xs -> concatFL $ mapFL_FL convertOne xs
          convertNamed :: Named Patch -> PatchInfoAnd (FL RealPatch)
          convertNamed n = n2pia $
                           adddeps (infopatch (convertInfo $ patch2patchinfo n) $
                                              convertOne $ patchcontents n)
                                   (map convertInfo $ concatMap fixDep $ getdeps n)
          convertInfo n | n `elem` inOrderTags = n
                        | otherwise = maybe n (\t -> pi_rename n ("old tag: "++t)) $ pi_tag n
          applySome xs = do tentativelyMergePatches repository "convert" (AllowConflicts:opts) NilFL xs
                            finalizeRepositoryChanges repository -- this is to clean out pristine.hashed
                            revertRepositoryChanges repository
      sequence_ $ mapFL applySome $ bunchFL 100 $ progressFL "Converting patch" patches
      revertable $ createPristineDirectoryTree repository "."
      when (SetScriptsExecutable `elem` opts) $
               do putVerbose $ text "Making scripts executable"
                  c <- list_slurpy_files `fmap` slurp_recorded repository
                  let setExecutableIfScript f =
                            do contents <- B.readFile f
                               when (BC.pack "#!" `B.isPrefixOf` contents) $ do
                                 putVerbose $ text ("Making executable: " ++ f)
                                 setExecutable f True
                  mapM_ setExecutableIfScript c
      sync_repo repository
      optimizeInventory repository
      putInfo $ text "Finished converting."
      where am_verbose = Verbose `elem` orig_opts
            am_informative = not $ Quiet `elem` orig_opts
            putVerbose s = when am_verbose $ putDocLn s
            putInfo s = when am_informative $ putDocLn s
            revertable x = x `clarify_errors` unlines
                  ["An error may have left your new working directory an inconsistent",
                   "but recoverable state. You should be able to make the new",
                   "repository consistent again by running darcs revert -a."]

convert_cmd _ _ = fail "You must provide 'convert' with either one or two arguments."

make_repo_name :: [DarcsFlag] -> FilePath -> IO String
make_repo_name (NewRepo n:_) _ =
    do exists <- doesDirectoryExist n
       file_exists <- doesFileExist n
       if exists || file_exists
          then fail $ "Directory or file named '" ++ n ++ "' already exists."
          else return n
make_repo_name (_:as) d = make_repo_name as d
make_repo_name [] d =
  case dropWhile (=='.') $ reverse $
       takeWhile (\c -> c /= '/' && c /= ':') $
       dropWhile (=='/') $ reverse d of
  "" -> modify_repo_name "anonymous_repo"
  base -> modify_repo_name base

modify_repo_name :: String -> IO String
modify_repo_name name =
    if head name == '/'
    then mrn name (-1)
    else do cwd <- getCurrentDirectory
            mrn (cwd ++ "/" ++ name) (-1)
 where
  mrn :: String -> Int -> IO String
  mrn n i = do
    exists <- doesDirectoryExist thename
    file_exists <- doesFileExist thename
    if not exists && not file_exists
       then do when (i /= -1) $
                    putStrLn $ "Directory '"++ n ++
                               "' already exists, creating repository as '"++
                               thename ++"'"
               return thename
       else mrn n $ i+1
    where thename = if i == -1 then n else n++"_"++show i
                        
\end{code}