diff -C5 -r darcs-2.5/Distribution/ShellHarness.hs darcs-for-7/Distribution/ShellHarness.hs
*** darcs-2.5/Distribution/ShellHarness.hs	2010-10-24 10:29:26.000000000 -0500
--- darcs-for-7/Distribution/ShellHarness.hs	2011-01-25 16:01:12.729083168 -0600
***************
*** 1,18 ****
  {-# OPTIONS_GHC -cpp #-}
  module Distribution.ShellHarness ( runTests ) where
  
  import Prelude hiding( catch )
  import System.Directory ( getCurrentDirectory, setPermissions,
                            Permissions(..), getDirectoryContents,
                            findExecutable, createDirectoryIfMissing,
                            renameFile, removeFile )
  import System.Environment ( getEnv, getEnvironment )
  import System.Exit ( ExitCode (..) )
  import System.FilePath
  import System.IO
! import System( system )
  import System.Process ( ProcessHandle,
                          runInteractiveProcess, waitForProcess,
                          getProcessExitCode )
  import Data.Maybe
  import Data.List ( isInfixOf, isPrefixOf, (\\), nubBy, isSuffixOf )
--- 1,19 ----
  {-# OPTIONS_GHC -cpp #-}
  module Distribution.ShellHarness ( runTests ) where
  
  import Prelude hiding( catch )
  import System.Directory ( getCurrentDirectory, setPermissions,
+                           emptyPermissions,
                            Permissions(..), getDirectoryContents,
                            findExecutable, createDirectoryIfMissing,
                            renameFile, removeFile )
  import System.Environment ( getEnv, getEnvironment )
  import System.Exit ( ExitCode (..) )
  import System.FilePath
  import System.IO
! import System.Cmd( system )
  import System.Process ( ProcessHandle,
                          runInteractiveProcess, waitForProcess,
                          getProcessExitCode )
  import Data.Maybe
  import Data.List ( isInfixOf, isPrefixOf, (\\), nubBy, isSuffixOf )
***************
*** 109,119 ****
                                                           , ".tix" `isSuffixOf` f ]
                   system $ "hpc sum --union --output=" ++ tixdir </> "sum.tix" ++ " " ++ unwords tixfiles
                   forM tixfiles $ \f -> removeFile f
                   return ()
               mapM_ (\x->
!                   setPermissions x (Permissions
                                     {readable = True
                                     ,writable = True
                                     ,executable = False
                                     ,searchable = True}
                                     )
--- 110,120 ----
                                                           , ".tix" `isSuffixOf` f ]
                   system $ "hpc sum --union --output=" ++ tixdir </> "sum.tix" ++ " " ++ unwords tixfiles
                   forM tixfiles $ \f -> removeFile f
                   return ()
               mapM_ (\x->
!                   setPermissions x (emptyPermissions
                                     {readable = True
                                     ,writable = True
                                     ,executable = False
                                     ,searchable = True}
                                     )
diff -C5 -r darcs-2.5/src/Darcs/Commands/Changes.lhs darcs-for-7/src/Darcs/Commands/Changes.lhs
*** darcs-2.5/src/Darcs/Commands/Changes.lhs	2010-10-24 10:29:26.000000000 -0500
--- darcs-for-7/src/Darcs/Commands/Changes.lhs	2011-01-25 16:37:07.001078845 -0600
***************
*** 118,128 ****
    unless (Debug `elem` opts) $ setProgressMode False
    files <- sort `fmap` fixSubPaths opts args
    Sealed unrec <- if null files then return (Sealed identity)
                    else Sealed `fmap` unrecordedChanges opts repository files
                    `catch` \_ -> return (Sealed identity) -- this is triggered when repository is remote
!   let filez = map (fn2fp . normPath . fp2fn) $ applyToFilepaths (invert unrec) $ map toFilePath files
        filtered_changes p = maybe_reverse $ getChangesInfo opts filez p
    debugMessage "About to read the repository..."
    patches <- readRepo repository
    debugMessage "Done reading the repository."
    if Interactive `elem` opts
--- 118,131 ----
    unless (Debug `elem` opts) $ setProgressMode False
    files <- sort `fmap` fixSubPaths opts args
    Sealed unrec <- if null files then return (Sealed identity)
                    else Sealed `fmap` unrecordedChanges opts repository files
                    `catch` \_ -> return (Sealed identity) -- this is triggered when repository is remote
!   let filez :: [FilePath]
!       filez = map (fn2fp . normPath . fp2fn) $ applyToFilepaths (invert unrec) $ map toFilePath files
!       filtered_changes :: (RepoPatch p) => PatchSet p ->
!           ([(Sealed2 (PatchInfoAnd p), [FilePath])], [FilePath], Doc)
        filtered_changes p = maybe_reverse $ getChangesInfo opts filez p
    debugMessage "About to read the repository..."
    patches <- readRepo repository
    debugMessage "Done reading the repository."
    if Interactive `elem` opts
***************
*** 134,144 ****
              debugMessage "About to print the changes..."
              let printers = if XMLOutput `elem` opts then simplePrinters else fancyPrinters
              ps <- readRepo repository -- read repo again to prevent holding onto
                                         -- values forced by filtered_changes
              putDocLnWith printers $ changelog opts ps $ filtered_changes patches
!   where maybe_reverse (xs,b,c) = if doReverse opts
                                   then (reverse xs, b, c)
                                   else (xs, b, c)
  
  
  -- FIXME: this prose is unreadable. --twb, 2009-08
--- 137,148 ----
              debugMessage "About to print the changes..."
              let printers = if XMLOutput `elem` opts then simplePrinters else fancyPrinters
              ps <- readRepo repository -- read repo again to prevent holding onto
                                         -- values forced by filtered_changes
              putDocLnWith printers $ changelog opts ps $ filtered_changes patches
!   where maybe_reverse :: ([a],b,c) -> ([a],b,c)
!         maybe_reverse (xs,b,c) = if doReverse opts
                                   then (reverse xs, b, c)
                                   else (xs, b, c)
  
  
  -- FIXME: this prose is unreadable. --twb, 2009-08
diff -C5 -r darcs-2.5/src/Darcs/Commands/Convert.lhs darcs-for-7/src/Darcs/Commands/Convert.lhs
*** darcs-2.5/src/Darcs/Commands/Convert.lhs	2010-10-24 10:29:26.000000000 -0500
--- darcs-for-7/src/Darcs/Commands/Convert.lhs	2011-01-25 16:49:18.409079217 -0600
***************
*** 221,231 ****
        copyFileOrUrl [NoLinks] (repodir </> prefsRelPath)
           prefsRelPath Uncachable `catchall` return ()
  
        optimizeInventory repository
        putInfo opts $ text "Finished converting."
!       where revertable x = x `clarifyErrors` 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."]
  
  convertCmd _ _ = fail "You must provide 'convert' with either one or two arguments."
--- 221,232 ----
        copyFileOrUrl [NoLinks] (repodir </> prefsRelPath)
           prefsRelPath Uncachable `catchall` return ()
  
        optimizeInventory repository
        putInfo opts $ text "Finished converting."
!       where revertable :: IO a -> IO a
!             revertable x = x `clarifyErrors` 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."]
  
  convertCmd _ _ = fail "You must provide 'convert' with either one or two arguments."
diff -C5 -r darcs-2.5/src/Darcs/Commands/Get.lhs darcs-for-7/src/Darcs/Commands/Get.lhs
*** darcs-2.5/src/Darcs/Commands/Get.lhs	2010-10-24 10:29:26.000000000 -0500
--- darcs-for-7/src/Darcs/Commands/Get.lhs	2011-01-25 16:51:49.173083233 -0600
***************
*** 190,202 ****
  copyRepoAndGoToChosenVersion opts repodir rfsource rf = do
    copyRepo `catchInterrupt` (when (formatHas HashedInventory rfsource)
                                     (putInfo opts $ text "Using lazy repository."))
    withRepository opts $- \repository -> goToChosenVersion repository opts
    putInfo opts $ text "Finished getting."
!       where copyRepo =
                  withRepository opts $- \repository -> do
!                   let hashUs   = formatHas HashedInventory rf
                        hashThem = formatHas HashedInventory rfsource
                    case () of _ | hashUs && hashThem -> do
                                     debugMessage "Identifying and copying repository..."
                                     copyRepoHashed repository
                                 | hashUs -> do
--- 190,205 ----
  copyRepoAndGoToChosenVersion opts repodir rfsource rf = do
    copyRepo `catchInterrupt` (when (formatHas HashedInventory rfsource)
                                     (putInfo opts $ text "Using lazy repository."))
    withRepository opts $- \repository -> goToChosenVersion repository opts
    putInfo opts $ text "Finished getting."
!       where copyRepo :: IO ()
!             copyRepo =
                  withRepository opts $- \repository -> do
!                   let hashUs :: Bool
!                       hashUs   = formatHas HashedInventory rf
!                       hashThem :: Bool
                        hashThem = formatHas HashedInventory rfsource
                    case () of _ | hashUs && hashThem -> do
                                     debugMessage "Identifying and copying repository..."
                                     copyRepoHashed repository
                                 | hashUs -> do
***************
*** 208,217 ****
--- 211,221 ----
                                     copyRepoHashed repository
                                 | hashThem -> do
                                     putInfo opts $ text "Fetching a hashed repository as an old-fashioned one..."
                                     copyRepoHashed repository
                                 | otherwise -> copyRepoOldFashioned repository opts repodir
+             copyRepoHashed :: (RepoPatch p) => Repository p -> IO ()
              copyRepoHashed repository =
                do identifyRepositoryFor repository repodir >>= copyRepository
                   when (SetScriptsExecutable `elem` opts) setScriptsExecutable
  
  makeRepoName :: [DarcsFlag] -> FilePath -> IO String
diff -C5 -r darcs-2.5/src/Darcs/Commands/Record.lhs darcs-for-7/src/Darcs/Commands/Record.lhs
*** darcs-2.5/src/Darcs/Commands/Record.lhs	2010-10-24 10:29:26.000000000 -0500
--- darcs-for-7/src/Darcs/Commands/Record.lhs	2011-01-25 16:53:43.326069503 -0600
***************
*** 331,340 ****
--- 331,341 ----
                do t <- (lines.filter (/='\r')) `fmap` readLocaleFile f
                   case t of [] -> return (oldname, [], Just f)
                             (n:ls) -> return (n, takeWhile
                                               (not.(eod `isPrefixOf`)) ls,
                                               Just f)
+           append_info :: (FilePathLike a) => a -> String -> IO ()
            append_info f oldname =
                do fc <- readLocaleFile f
                   appendToFile f $ \h ->
                       do case fc of
                            _ | null (lines fc) -> B.hPut h (encodeLocale (oldname ++ "\n"))
diff -C5 -r darcs-2.5/src/Darcs/Commands/Send.lhs darcs-for-7/src/Darcs/Commands/Send.lhs
*** darcs-2.5/src/Darcs/Commands/Send.lhs	2010-10-24 10:29:26.000000000 -0500
--- darcs-for-7/src/Darcs/Commands/Send.lhs	2011-01-25 16:55:15.501082399 -0600
***************
*** 158,168 ****
          setDefaultrepo repodir input_opts
          when (old_default == [repodir] && not (Quiet `elem` input_opts)) $
               putStrLn $ "Creating patch to "++formatPath repodir++"..."
          wtds <- decideOnBehavior input_opts repo
          sendToThem repository input_opts wtds repodir them
!     where the_context [] = return Nothing
            the_context (Context foo:_)
                = (Just . scanContext )`fmap` mmapFilePS (toFilePath foo)
            the_context (_:fs) = the_context fs
  sendCmd _ _ = impossible
  
--- 158,169 ----
          setDefaultrepo repodir input_opts
          when (old_default == [repodir] && not (Quiet `elem` input_opts)) $
               putStrLn $ "Creating patch to "++formatPath repodir++"..."
          wtds <- decideOnBehavior input_opts repo
          sendToThem repository input_opts wtds repodir them
!     where the_context :: (RepoPatch p) => [DarcsFlag] -> IO (Maybe (PatchSet p))
!           the_context [] = return Nothing
            the_context (Context foo:_)
                = (Just . scanContext )`fmap` mmapFilePS (toFilePath foo)
            the_context (_:fs) = the_context fs
  sendCmd _ _ = impossible
  
diff -C5 -r darcs-2.5/src/Darcs/Commands/ShowTags.lhs darcs-for-7/src/Darcs/Commands/ShowTags.lhs
*** darcs-2.5/src/Darcs/Commands/ShowTags.lhs	2010-10-24 10:29:26.000000000 -0500
--- darcs-for-7/src/Darcs/Commands/ShowTags.lhs	2011-01-25 17:09:04.821028007 -0600
***************
*** 18,28 ****
  \darcsCommand{show tags}
  \begin{code}
  module Darcs.Commands.ShowTags ( showTags ) where
  import Darcs.Arguments ( DarcsFlag(..), workingRepoDir )
  import Darcs.Commands ( DarcsCommand(..), nodefaults )
! import Darcs.Hopefully ( info )
  import Darcs.Repository ( amInRepository, readRepo, withRepository, ($-) )
  import Darcs.Patch.Info ( piTag )
  import Darcs.Patch.Set ( newset2RL )
  import Darcs.Witnesses.Ordered ( mapRL )
  import System.IO ( stderr, hPutStrLn )
--- 18,28 ----
  \darcsCommand{show tags}
  \begin{code}
  module Darcs.Commands.ShowTags ( showTags ) where
  import Darcs.Arguments ( DarcsFlag(..), workingRepoDir )
  import Darcs.Commands ( DarcsCommand(..), nodefaults )
! import Darcs.Hopefully ( info, PatchInfoAnd )
  import Darcs.Repository ( amInRepository, readRepo, withRepository, ($-) )
  import Darcs.Patch.Info ( piTag )
  import Darcs.Patch.Set ( newset2RL )
  import Darcs.Witnesses.Ordered ( mapRL )
  import System.IO ( stderr, hPutStrLn )
***************
*** 56,66 ****
  
  tagsCmd :: [DarcsFlag] -> [String] -> IO ()
  tagsCmd opts _ = withRepository opts $- \repository -> do
    patches <- readRepo repository
    sequence_ $ mapRL process $ newset2RL patches
!   where process hp =
              case piTag $ info hp of
                Just t -> do
                   t' <- normalize t t False
                   putStrLn t'
                Nothing -> return ()
--- 56,67 ----
  
  tagsCmd :: [DarcsFlag] -> [String] -> IO ()
  tagsCmd opts _ = withRepository opts $- \repository -> do
    patches <- readRepo repository
    sequence_ $ mapRL process $ newset2RL patches
!   where process :: PatchInfoAnd p -> IO ()
!         process hp =
              case piTag $ info hp of
                Just t -> do
                   t' <- normalize t t False
                   putStrLn t'
                Nothing -> return ()
diff -C5 -r darcs-2.5/src/Darcs/Patch/Set.hs darcs-for-7/src/Darcs/Patch/Set.hs
*** darcs-2.5/src/Darcs/Patch/Set.hs	2010-10-24 10:29:26.000000000 -0500
--- darcs-for-7/src/Darcs/Patch/Set.hs	2011-01-25 16:19:01.029103914 -0600
***************
*** 50,60 ****
  newset2FL :: PatchSet p C(start x6) -> FL (PatchInfoAnd p) C(start x6)
  newset2FL = reverseRL . newset2RL
  
  progressPatchSet :: String -> PatchSet p C(start x7) -> PatchSet p C(start x7)
  progressPatchSet k (PatchSet ps0 ts0) = PatchSet (mapRL_RL prog ps0) $ mapRL_RL pts ts0
!     where prog = progress k
            pts :: Tagged p C(x8 y) -> Tagged p C(x8 y)
            pts (Tagged t h ps) = Tagged (prog t) h (mapRL_RL prog ps)
  
  tags :: PatchSet p C(start x13) -> [PatchInfo]
  tags (PatchSet _ ts) = mapRL f ts
--- 50,61 ----
  newset2FL :: PatchSet p C(start x6) -> FL (PatchInfoAnd p) C(start x6)
  newset2FL = reverseRL . newset2RL
  
  progressPatchSet :: String -> PatchSet p C(start x7) -> PatchSet p C(start x7)
  progressPatchSet k (PatchSet ps0 ts0) = PatchSet (mapRL_RL prog ps0) $ mapRL_RL pts ts0
!     where prog :: a -> a
!           prog = progress k
            pts :: Tagged p C(x8 y) -> Tagged p C(x8 y)
            pts (Tagged t h ps) = Tagged (prog t) h (mapRL_RL prog ps)
  
  tags :: PatchSet p C(start x13) -> [PatchInfo]
  tags (PatchSet _ ts) = mapRL f ts
diff -C5 -r darcs-2.5/src/Darcs/Population.hs darcs-for-7/src/Darcs/Population.hs
*** darcs-2.5/src/Darcs/Population.hs	2010-10-24 10:29:26.000000000 -0500
--- darcs-for-7/src/Darcs/Population.hs	2011-01-25 16:24:37.758051161 -0600
***************
*** 85,95 ****
  
  getRepoPopVersion :: FilePath -> PatchInfo -> IO Population
  getRepoPopVersion repobasedir pinfo = withRepositoryDirectory [] repobasedir $- \repository ->
     do pips <- newset2RL `liftM` readRepo repository
        return $ (unseal applyPatchSetPop) (mkPatchSet $ dropWhileRL ((/=pinfo).info) pips) initPop
!              where mkPatchSet (Sealed xs) = seal $ PatchSet xs NilRL
                     dropWhileRL :: (FORALL(x y) a C(x y) -> Bool) -> RL a C(r v) -> Sealed (RL a C(r))
                     dropWhileRL _ NilRL = seal NilRL
                     dropWhileRL p xs@(x:<:xs')
                                 | p x       = dropWhileRL p xs'
                                 | otherwise = seal xs
--- 85,96 ----
  
  getRepoPopVersion :: FilePath -> PatchInfo -> IO Population
  getRepoPopVersion repobasedir pinfo = withRepositoryDirectory [] repobasedir $- \repository ->
     do pips <- newset2RL `liftM` readRepo repository
        return $ (unseal applyPatchSetPop) (mkPatchSet $ dropWhileRL ((/=pinfo).info) pips) initPop
!              where mkPatchSet :: Sealed (RL (PatchInfoAnd a)) -> Sealed (PatchSet a)
!                    mkPatchSet (Sealed xs) = seal $ PatchSet xs NilRL
                     dropWhileRL :: (FORALL(x y) a C(x y) -> Bool) -> RL a C(r v) -> Sealed (RL a C(r))
                     dropWhileRL _ NilRL = seal NilRL
                     dropWhileRL p xs@(x:<:xs')
                                 | p x       = dropWhileRL p xs'
                                 | otherwise = seal xs
diff -C5 -r darcs-2.5/src/DateMatcher.hs darcs-for-7/src/DateMatcher.hs
*** darcs-2.5/src/DateMatcher.hs	2010-10-24 10:29:26.000000000 -0500
--- darcs-for-7/src/DateMatcher.hs	2011-01-25 16:15:35.113030574 -0600
***************
*** 31,41 ****
  import IsoDate ( parseDate, englishDateTime, englishInterval, englishLast, iso8601Interval,
                   resetCalendar, subtractFromMCal, getLocalTz,
                   MCalendarTime(..), toMCalendarTime, unsafeToCalendarTime,
                   unsetTime,
                 )
! import Text.ParserCombinators.Parsec ( eof, parse, ParseError )
  
  -- | 'withinDay' @x y@ is true if @x <= y < (x + one_day)@
  -- Note that this converts the two dates to @ClockTime@ to avoid
  -- any timezone-related errors
  withinDay :: CalendarTime -> CalendarTime -> Bool
--- 31,41 ----
  import IsoDate ( parseDate, englishDateTime, englishInterval, englishLast, iso8601Interval,
                   resetCalendar, subtractFromMCal, getLocalTz,
                   MCalendarTime(..), toMCalendarTime, unsafeToCalendarTime,
                   unsetTime,
                 )
! import Text.ParserCombinators.Parsec ( eof, parse, ParseError, Parser )
  
  -- | 'withinDay' @x y@ is true if @x <= y < (x + one_day)@
  -- Note that this converts the two dates to @ClockTime@ to avoid
  -- any timezone-related errors
  withinDay :: CalendarTime -> CalendarTime -> Bool
***************
*** 151,161 ****
--- 151,163 ----
                  matchIsoInterval
            , DM "CVS, ISO 8601, or old style date"
                  (parseDate tzNow d)
                  samePartialDate ]
   where
+    tillEof :: Parser a -> Parser a
     tillEof p = do { x <- p; eof; return x }
+    parseDateWith :: Parser a -> Either ParseError a
     parseDateWith p = parse (tillEof p) "" d
  
  -- | 'tryMatchers' @ms@ returns the first successful match in @ms@
  --   It is an error if there are no matches
  tryMatchers :: [DateMatcher] -> (CalendarTime -> Bool)