%  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 #-}
#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.Commands.Init ( initialize )
import Darcs.Arguments ( DarcsFlag( AllowConflicts, WorkDir,
                                    SetScriptsExecutable, UseFormat2, NoUpdateWorking,
                                    Verbose, Quiet, Context ),
                        reponame,
                        set_scripts_executable,
                        ssh_cm )
import Darcs.Repository ( Repository, withRepoLock, ($-), withRepositoryDirectory, read_repo,
                          slurp_recorded, optimizeInventory,
                          tentativelyMergePatches, patchSetToPatches,
                          createPristineDirectoryTree,
                          revertRepositoryChanges, finalizeRepositoryChanges, sync_repo )
import Darcs.Global ( darcsdir )
import Darcs.FilePathUtils ( absolute_dir )
import Darcs.Patch ( RealPatch, Patch, Named, showPatch, patch2patchinfo, fromPrims, infopatch,
                     modernize_patch,
                     adddeps, getdeps, effect, flattenFL, is_merger, patchcontents )
import Darcs.Patch.Ordered ( FL(..), RL(..), EqCheck(..), (=/\=), bunchFL, mapFL, mapFL_FL,
                             concatFL, concatRL, mapRL )
import Darcs.Patch.Depends ( is_tag )
import Darcs.Patch.Info ( pi_rename, pi_tag )
import Darcs.Patch.Commute ( public_unravel )
import Darcs.Patch.Real ( mergeUnravelled )
import Darcs.Repository.Motd ( show_motd )
import Darcs.Utils ( clarify_errors, askUser )
import Darcs.Progress ( progressFL )
import Darcs.Sealed ( Sealed(..), FlippedSeal(..) )
import Printer ( text, putDocLn, ($$), redText, (<+>) )
import Darcs.ColorPrinter ( traceDoc )
import Darcs.SlurpDirectory ( list_slurpy_files )
import Darcs.Lock ( writeBinFile )
import Workaround ( setExecutable )
import FastPackedString ( packString, readFilePS, takePS )

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"
\end{code}
\begin{code}
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 = [ssh_cm],
                    command_basic_options = [reponame,set_scripts_executable]}
\end{code}
\begin{code}
convert_cmd :: [DarcsFlag] -> [String] -> IO ()
convert_cmd opts [inrepodir, outname] = convert_cmd (WorkDir outname:opts) [inrepodir]
convert_cmd orig_opts [inrepodir] = do
  putDocLn $ text "WARNING:  You can only run darcs convert" <+> redText "once" <+> text "for" $$
             text "any related set of repositories.  Failure to do this can result in" $$
             text "repository corruption!\n" $$
             text "If you fully understand the implications and promise not to run convert again"
  let vow = "I understand the consequences of my action"
  vow' <- askUser ("then type '" ++ vow ++ "': ")
  when (vow' /= vow) $ fail "User didn't understand the consequences."
  former_dir <- getCurrentDirectory
  let opts = UseFormat2:fix_context orig_opts
      fix_context o@(Context ('/':_):_) = o
      fix_context (Context f:os) = Context (former_dir++"/"++f):os
      fix_context (o:os) = o : fix_context os
      fix_context [] = []
  repodir <- absolute_dir inrepodir
  show_motd opts repodir
  mysimplename <- make_repo_name opts repodir
  createDirectory mysimplename
  setCurrentDirectory mysimplename
  (command_command initialize) 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
      Sealed 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 <- readFilePS f
                               when (takePS 2 contents == packString "#!") $ 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."
\end{code}

\begin{code}
make_repo_name :: [DarcsFlag] -> FilePath -> IO String
make_repo_name (WorkDir 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}