darcs-beta 2.4.99.1 → 2.7.98.1
raw patch · 1465 files changed
+31392/−26996 lines, 1465 filesdep +cmdlibdep +shellishdep +vectordep ~HTTPdep ~QuickCheckdep ~basesetup-changednew-component:exe:darcs-testnew-uploaderbinary-addedPVP ok
version bump matches the API change (PVP)
Dependencies added: cmdlib, shellish, vector
Dependency ranges changed: HTTP, QuickCheck, base, containers, directory, filepath, hashed-storage, haskeline, mtl, network, parsec, regex-compat, regex-posix, test-framework-quickcheck2, text
API changes (from Hackage documentation)
- ByteStringUtils: encodeLatin1 :: String -> ByteString
- ByteStringUtils: ifHeadThenTail :: Word8 -> ByteString -> Maybe ByteString
- ByteStringUtils: utf8ToLocale :: ByteString -> ByteString
- Darcs.Arguments: Ephemeral :: DarcsFlag
- Darcs.Arguments: FancyMoveAdd :: DarcsFlag
- Darcs.Arguments: NoFancyMoveAdd :: DarcsFlag
- Darcs.Arguments: NoLinks :: DarcsFlag
- Darcs.Arguments: Partial :: DarcsFlag
- Darcs.Arguments: PristineNone :: DarcsFlag
- Darcs.Arguments: PristinePlain :: DarcsFlag
- Darcs.Arguments: RelinkPristine :: DarcsFlag
- Darcs.Arguments: RemoteDarcs :: String -> DarcsFlag
- Darcs.Arguments: UseOldFashionedInventory :: DarcsFlag
- Darcs.Arguments: areFileArgs :: [SubPath] -> Bool
- Darcs.Arguments: defineChanges :: (Patchy p) => p -> IO ()
- Darcs.Arguments: definePatches :: (RepoPatch p) => FL (PatchInfoAnd p) -> IO ()
- Darcs.Arguments: fancyMoveAdd :: DarcsOption
- Darcs.Arguments: getInventoryChoices :: DarcsOption
- Darcs.Arguments: inventoryChoices :: DarcsOption
- Darcs.Arguments: nolinks :: DarcsOption
- Darcs.Arguments: partialCheck :: DarcsOption
- Darcs.Arguments: relinkPristine :: DarcsOption
- Darcs.Commands.Annotate: createdAsXml :: PatchInfo -> String -> Doc
- Darcs.Commands.MarkConflicts: resolve :: DarcsCommand
- Darcs.Commands.Repair: repair :: DarcsCommand
- Darcs.Commands.Repair: repairCmd :: [DarcsFlag] -> [String] -> IO ()
- Darcs.Commands.WhatsNew: announceFiles :: (RepoPatch p) => Repository p -> [SubPath] -> String -> IO [SubPath]
- Darcs.External: clonePartialsTree :: FilePath -> FilePath -> [FilePath] -> IO ()
- Darcs.External: clonePaths :: FilePath -> FilePath -> [FilePath] -> IO ()
- Darcs.External: copyFilesOrUrls :: [DarcsFlag] -> FilePath -> [String] -> FilePath -> Cachable -> IO ()
- Darcs.External: remoteDarcsCmd :: [DarcsFlag] -> String
- Darcs.FilePathMonad: data FilePathMonad a
- Darcs.FilePathMonad: instance Functor FilePathMonad
- Darcs.FilePathMonad: instance Monad FilePathMonad
- Darcs.FilePathMonad: instance MonadPlus FilePathMonad
- Darcs.FilePathMonad: instance ReadableDirectory FilePathMonad
- Darcs.FilePathMonad: instance WriteableDirectory FilePathMonad
- Darcs.FilePathMonad: withFilePaths :: [FilePath] -> FilePathMonad a -> [FilePath]
- Darcs.Flags: Ephemeral :: DarcsFlag
- Darcs.Flags: FancyMoveAdd :: DarcsFlag
- Darcs.Flags: NoFancyMoveAdd :: DarcsFlag
- Darcs.Flags: NoLinks :: DarcsFlag
- Darcs.Flags: Partial :: DarcsFlag
- Darcs.Flags: PristineNone :: DarcsFlag
- Darcs.Flags: PristinePlain :: DarcsFlag
- Darcs.Flags: RelinkPristine :: DarcsFlag
- Darcs.Flags: UseOldFashionedInventory :: DarcsFlag
- Darcs.Flags: willStoreInMemory :: [DarcsFlag] -> Bool
- Darcs.Global: setVerboseMode :: IO ()
- Darcs.Global: verboseMode :: Bool
- Darcs.Hopefully: actually :: a -> Hopefully a
- Darcs.Hopefully: compareWPatchInfo :: WPatchInfo -> WPatchInfo -> EqCheck
- Darcs.Hopefully: conscientiously :: (Doc -> Doc) -> PatchInfoAnd p -> Named p
- Darcs.Hopefully: createHashed :: String -> (String -> IO (Sealed (a))) -> IO (Sealed (Hopefully a))
- Darcs.Hopefully: data Hopefully a
- Darcs.Hopefully: data PatchInfoAnd p
- Darcs.Hopefully: data WPatchInfo
- Darcs.Hopefully: extractHash :: PatchInfoAnd p -> Either (Named p) String
- Darcs.Hopefully: hopefully :: PatchInfoAnd p -> Named p
- Darcs.Hopefully: hopefullyM :: (Monad m) => PatchInfoAnd p -> m (Named p)
- Darcs.Hopefully: info :: PatchInfoAnd p -> PatchInfo
- Darcs.Hopefully: instance (Apply p) => Apply (PatchInfoAnd p)
- Darcs.Hopefully: instance (Commute p) => Commute (PatchInfoAnd p)
- Darcs.Hopefully: instance (Conflict p) => Conflict (PatchInfoAnd p)
- Darcs.Hopefully: instance (Conflict p, Effect p, ShowPatch p) => ShowPatch (PatchInfoAnd p)
- Darcs.Hopefully: instance (Effect p) => Effect (PatchInfoAnd p)
- Darcs.Hopefully: instance (Invert p) => Invert (PatchInfoAnd p)
- Darcs.Hopefully: instance (MyEq p) => MyEq (PatchInfoAnd p)
- Darcs.Hopefully: instance (ReadPatch p) => ReadPatch (PatchInfoAnd p)
- Darcs.Hopefully: instance (RepoPatch p) => Patchy (PatchInfoAnd p)
- Darcs.Hopefully: instance MyEq WPatchInfo
- Darcs.Hopefully: n2pia :: Named p -> PatchInfoAnd p
- Darcs.Hopefully: patchDesc :: PatchInfoAnd p -> String
- Darcs.Hopefully: patchInfoAndPatch :: PatchInfo -> Hopefully (Named p) -> PatchInfoAnd p
- Darcs.Hopefully: piap :: PatchInfo -> Named p -> PatchInfoAnd p
- Darcs.Hopefully: unWPatchInfo :: WPatchInfo -> PatchInfo
- Darcs.Hopefully: unavailable :: String -> Hopefully a
- Darcs.Hopefully: winfo :: PatchInfoAnd p -> WPatchInfo
- Darcs.IO: class (Functor m, MonadPlus m) => ReadableDirectory m
- Darcs.IO: class (ReadableDirectory m) => WriteableDirectory m
- Darcs.IO: data TolerantIO a
- Darcs.IO: instance (Functor m, MonadPlus m, MonadError e m) => ReadableDirectory (TreeMonad m)
- Darcs.IO: instance (Functor m, MonadPlus m, MonadError e m) => WriteableDirectory (TreeMonad m)
- Darcs.IO: instance MonadPlus SilentIO
- Darcs.IO: instance MonadPlus TolerantIO
- Darcs.IO: instance ReadableDirectory IO
- Darcs.IO: instance ReadableDirectory SilentIO
- Darcs.IO: instance ReadableDirectory TolerantIO
- Darcs.IO: instance WriteableDirectory IO
- Darcs.IO: instance WriteableDirectory SilentIO
- Darcs.IO: instance WriteableDirectory TolerantIO
- Darcs.IO: mCreateDirectory :: (WriteableDirectory m) => FileName -> m ()
- Darcs.IO: mCreateFile :: (WriteableDirectory m) => FileName -> m ()
- Darcs.IO: mDoesDirectoryExist :: (ReadableDirectory m) => FileName -> m Bool
- Darcs.IO: mDoesFileExist :: (ReadableDirectory m) => FileName -> m Bool
- Darcs.IO: mGetDirectoryContents :: (ReadableDirectory m) => m [FileName]
- Darcs.IO: mInCurrentDirectory :: (ReadableDirectory m) => FileName -> m a -> m a
- Darcs.IO: mModifyFilePS :: (WriteableDirectory m) => FileName -> (ByteString -> m ByteString) -> m ()
- Darcs.IO: mModifyFilePSs :: (WriteableDirectory m) => FileName -> ([ByteString] -> m [ByteString]) -> m ()
- Darcs.IO: mReadBinFile :: (ReadableDirectory m) => FileName -> m String
- Darcs.IO: mReadFilePS :: (ReadableDirectory m) => FileName -> m ByteString
- Darcs.IO: mReadFilePSs :: (ReadableDirectory m) => FileName -> m [ByteString]
- Darcs.IO: mRemoveDirectory :: (WriteableDirectory m) => FileName -> m ()
- Darcs.IO: mRemoveFile :: (WriteableDirectory m) => FileName -> m ()
- Darcs.IO: mRename :: (WriteableDirectory m) => FileName -> FileName -> m ()
- Darcs.IO: mSetFileExecutable :: (WriteableDirectory m) => FileName -> Bool -> m ()
- Darcs.IO: mWithCurrentDirectory :: (WriteableDirectory m) => FileName -> m a -> m a
- Darcs.IO: mWriteBinFile :: (WriteableDirectory m) => FileName -> String -> m ()
- Darcs.IO: mWriteDoc :: (WriteableDirectory m) => FileName -> Doc -> m ()
- Darcs.IO: mWriteFilePS :: (WriteableDirectory m) => FileName -> ByteString -> m ()
- Darcs.IO: mWriteFilePSs :: (WriteableDirectory m) => FileName -> [ByteString] -> m ()
- Darcs.Patch: AddedDir :: DirMark
- Darcs.Patch: AddedFile :: DirMark
- Darcs.Patch: AddedLine :: PatchInfo -> LineMark
- Darcs.Patch: AddedRemovedLine :: PatchInfo -> PatchInfo -> LineMark
- Darcs.Patch: DullDir :: DirMark
- Darcs.Patch: DullFile :: DirMark
- Darcs.Patch: ModifiedFile :: DirMark
- Darcs.Patch: MovedDir :: !String -> DirMark
- Darcs.Patch: MovedFile :: String -> DirMark
- Darcs.Patch: None :: LineMark
- Darcs.Patch: RemovedDir :: DirMark
- Darcs.Patch: RemovedFile :: DirMark
- Darcs.Patch: RemovedLine :: PatchInfo -> LineMark
- Darcs.Patch: applyToPop :: PatchInfo -> FL Prim -> Population -> Population
- Darcs.Patch: data DirMark
- Darcs.Patch: data LineMark
- Darcs.Patch: data Patch
- Darcs.Patch: data Prim
- Darcs.Patch: data RealPatch
- Darcs.Patch: elegantMerge :: (Patch :\/: Patch) -> Maybe ((Patch :/\: Patch))
- Darcs.Patch: emptyMarkedupFile :: MarkedUpFile
- Darcs.Patch: flattenFL :: Patch -> FL Patch
- Darcs.Patch: identity :: (Invert p) => p
- Darcs.Patch: instance (Conflict p, Effect p, Patchy p) => Patchy (Named p)
- Darcs.Patch: instance (RepoPatchBase p) => RepoPatch (FL p)
- Darcs.Patch: instance Patchy Patch
- Darcs.Patch: instance RepoPatch Patch
- Darcs.Patch: instance RepoPatchBase Patch
- Darcs.Patch: instance RepoPatchBase RealPatch
- Darcs.Patch: isMerger :: Patch -> Bool
- Darcs.Patch: isNullPatch :: Patch -> Bool
- Darcs.Patch: isSimilar :: Prim -> Prim -> Bool
- Darcs.Patch: markupFile :: (Effect p) => PatchInfo -> p -> (FilePath, MarkedUpFile) -> (FilePath, MarkedUpFile)
- Darcs.Patch: modernizePatch :: Patch -> Patch
- Darcs.Patch: nullP :: Patch -> EqCheck
- Darcs.Patch: patchChanges :: Prim -> [(String, DirMark)]
- Darcs.Patch: type MarkedUpFile = [(ByteString, LineMark)]
- Darcs.Patch.Apply: AddedLine :: PatchInfo -> LineMark
- Darcs.Patch.Apply: AddedRemovedLine :: PatchInfo -> PatchInfo -> LineMark
- Darcs.Patch.Apply: None :: LineMark
- Darcs.Patch.Apply: RemovedLine :: PatchInfo -> LineMark
- Darcs.Patch.Apply: applyToPop :: PatchInfo -> FL Prim -> Population -> Population
- Darcs.Patch.Apply: data LineMark
- Darcs.Patch.Apply: emptyMarkedupFile :: MarkedUpFile
- Darcs.Patch.Apply: forceTokReplace :: String -> String -> String -> FileContents -> Maybe FileContents
- Darcs.Patch.Apply: instance (Apply p) => Apply (Named p)
- Darcs.Patch.Apply: instance Apply Patch
- Darcs.Patch.Apply: instance Apply Prim
- Darcs.Patch.Apply: instance Show LineMark
- Darcs.Patch.Apply: markupFile :: (Effect p) => PatchInfo -> p -> (FilePath, MarkedUpFile) -> (FilePath, MarkedUpFile)
- Darcs.Patch.Apply: patchChanges :: Prim -> [(String, DirMark)]
- Darcs.Patch.Apply: type MarkedUpFile = [(ByteString, LineMark)]
- Darcs.Patch.Bundle: makeBundle :: (RepoPatch p) => Maybe (Tree IO) -> RL (PatchInfoAnd p) -> FL (Named p) -> IO Doc
- Darcs.Patch.Choices: instance (Commute p) => Commute (PatchChoice p)
- Darcs.Patch.Choices: instance (Commute p) => Commute (TaggedPatch p)
- Darcs.Patch.Choices: instance (Invert p) => Invert (TaggedPatch p)
- Darcs.Patch.Choices: instance (MyEq p) => MyEq (PatchChoice p)
- Darcs.Patch.Choices: instance (MyEq p) => MyEq (TaggedPatch p)
- Darcs.Patch.Commute: Failed :: Perhaps a
- Darcs.Patch.Commute: Succeeded :: a -> Perhaps a
- Darcs.Patch.Commute: Unknown :: Perhaps a
- Darcs.Patch.Commute: data Perhaps a
- Darcs.Patch.Commute: elegantMerge :: (Patch :\/: Patch) -> Maybe ((Patch :/\: Patch))
- Darcs.Patch.Commute: fromPrims :: (FromPrims p) => FL Prim -> p
- Darcs.Patch.Commute: instance (Commute p) => Commute (Named p)
- Darcs.Patch.Commute: instance (Conflict p) => Conflict (Named p)
- Darcs.Patch.Commute: instance (Invert p) => Invert (Named p)
- Darcs.Patch.Commute: instance (MyEq p) => MyEq (Named p)
- Darcs.Patch.Commute: instance Commute Patch
- Darcs.Patch.Commute: instance Conflict Patch
- Darcs.Patch.Commute: instance Effect Patch
- Darcs.Patch.Commute: instance FromPrims Patch
- Darcs.Patch.Commute: instance Invert Patch
- Darcs.Patch.Commute: instance Monad Perhaps
- Darcs.Patch.Commute: instance MonadPlus Perhaps
- Darcs.Patch.Commute: instance MyEq Patch
- Darcs.Patch.Commute: mangleUnravelled :: [Sealed (FL Prim)] -> Sealed (FL Prim)
- Darcs.Patch.Commute: merge :: (Commute p) => (p :\/: p) -> (p :/\: p)
- Darcs.Patch.Commute: merger :: String -> Patch -> Patch -> Sealed (Patch)
- Darcs.Patch.Commute: modernizePatch :: Patch -> Patch
- Darcs.Patch.Commute: publicUnravel :: Patch -> [Sealed (FL Prim)]
- Darcs.Patch.Commute: toMaybe :: Perhaps a -> Maybe a
- Darcs.Patch.Commute: type CommuteFunction = (Patch :< Patch) -> Perhaps ((Patch :< Patch))
- Darcs.Patch.Commute: unravel :: Patch -> [Sealed (FL Prim)]
- Darcs.Patch.Core: ComP :: FL Patch -> Patch
- Darcs.Patch.Core: Merger :: Patch -> RL Patch -> Patch -> Patch -> Patch
- Darcs.Patch.Core: NamedP :: !PatchInfo -> ![PatchInfo] -> !p -> Named p
- Darcs.Patch.Core: PP :: Prim -> Patch
- Darcs.Patch.Core: Regrem :: Patch -> RL Patch -> Patch -> Patch -> Patch
- Darcs.Patch.Core: adddeps :: Named p -> [PatchInfo] -> Named p
- Darcs.Patch.Core: anonymous :: (Patchy p) => p -> IO (Named p)
- Darcs.Patch.Core: concatFL :: FL (FL a) -> FL a
- Darcs.Patch.Core: data Named p
- Darcs.Patch.Core: data Patch
- Darcs.Patch.Core: flattenFL :: Patch -> FL Patch
- Darcs.Patch.Core: getdeps :: Named p -> [PatchInfo]
- Darcs.Patch.Core: infopatch :: (Patchy p) => PatchInfo -> p -> Named p
- Darcs.Patch.Core: instance (Effect p) => Effect (Named p)
- Darcs.Patch.Core: instance FromPrim Patch
- Darcs.Patch.Core: isMerger :: Patch -> Bool
- Darcs.Patch.Core: isNullPatch :: Patch -> Bool
- Darcs.Patch.Core: joinPatchesFL :: FL Patch -> Patch
- Darcs.Patch.Core: mergerUndo :: Patch -> Patch
- Darcs.Patch.Core: nFn :: FilePath -> FilePath
- Darcs.Patch.Core: namepatch :: (Patchy p) => String -> String -> String -> [String] -> p -> IO (Named p)
- Darcs.Patch.Core: nullP :: Patch -> EqCheck
- Darcs.Patch.Core: patch2patchinfo :: Named p -> PatchInfo
- Darcs.Patch.Core: patchcontents :: Named p -> p
- Darcs.Patch.Core: patchname :: Named p -> String
- Darcs.Patch.Non: (*>) :: (Patchy p, ToFromPrim p) => Non p -> p -> Maybe (Non p)
- Darcs.Patch.Non: (*>>) :: (Effect q, Patchy q, Patchy p, ToFromPrim p) => Non p -> q -> Maybe (Non p)
- Darcs.Patch.Non: (>*) :: (Patchy p, ToFromPrim p) => p -> Non p -> Maybe (Non p)
- Darcs.Patch.Non: (>>*) :: (Effect q, Patchy p, ToFromPrim p) => q -> Non p -> Maybe (Non p)
- Darcs.Patch.Non: Non :: FL p -> Prim -> Non p
- Darcs.Patch.Non: add :: (Effect q, Patchy p, ToFromPrim p) => q -> Non p -> Non p
- Darcs.Patch.Non: addP :: (Patchy p, ToFromPrim p) => p -> Non p -> Non p
- Darcs.Patch.Non: addPs :: (Patchy p, ToFromPrim p) => RL p -> Non p -> Non p
- Darcs.Patch.Non: class Nonable p
- Darcs.Patch.Non: data Non p
- Darcs.Patch.Non: instance (Commute p, MyEq p) => Eq (Non p)
- Darcs.Patch.Non: instance (Show2 p) => Show (Non p)
- Darcs.Patch.Non: instance (Show2 p) => Show1 (Non p)
- Darcs.Patch.Non: instance Nonable Prim
- Darcs.Patch.Non: instance Patchy Prim
- Darcs.Patch.Non: non :: (Nonable p) => p -> Non p
- Darcs.Patch.Non: propAdjustTwice :: (Patchy p, ToFromPrim p) => p -> Non p -> Maybe Doc
- Darcs.Patch.Non: readNon :: (ReadPatch p, ParserM m) => m (Maybe (Non p))
- Darcs.Patch.Non: readNons :: (ReadPatch p, ParserM m) => m [Non p]
- Darcs.Patch.Non: rem :: (Effect q, Patchy p, ToFromPrim p) => q -> Non p -> Maybe (Non p)
- Darcs.Patch.Non: remAddP :: (Patchy p, ToFromPrim p) => p -> Non p -> Non p
- Darcs.Patch.Non: remAddPs :: (Patchy p, ToFromPrim p) => RL p -> Non p -> Non p
- Darcs.Patch.Non: remNons :: (Nonable p, Effect p, Patchy p, ToFromPrim p, ShowPatch p) => [Non p] -> Non p -> Non p
- Darcs.Patch.Non: remP :: (Patchy p, ToFromPrim p) => p -> Non p -> Maybe (Non p)
- Darcs.Patch.Non: remPs :: (Patchy p, ToFromPrim p) => FL p -> Non p -> Maybe (Non p)
- Darcs.Patch.Non: showNon :: (ShowPatch (FL p)) => Non p -> Doc
- Darcs.Patch.Non: showNons :: (ShowPatch (FL p)) => [Non p] -> Doc
- Darcs.Patch.Non: unNon :: (FromPrim p) => Non p -> Sealed (FL p)
- Darcs.Patch.Patchy: applyAndTryToFix :: (Apply p, WriteableDirectory m) => p -> m (Maybe (String, p))
- Darcs.Patch.Patchy: applyAndTryToFixFL :: (Apply p, WriteableDirectory m) => p -> m (Maybe (String, FL p))
- Darcs.Patch.Patchy: bracketedFL :: (ReadPatch p, ParserM m) => (m (Maybe (Sealed (p)))) -> Word8 -> Word8 -> m (Maybe (Sealed (FL p)))
- Darcs.Patch.Patchy: commuteFL :: (Commute p) => (p :> FL p) -> Maybe ((FL p :> p))
- Darcs.Patch.Patchy: commuteFLorComplain :: (Commute p) => (p :> FL p) -> Either (Sealed2 p) ((FL p :> p))
- Darcs.Patch.Patchy: commuteRL :: (Commute p) => (RL p :> p) -> Maybe ((p :> RL p))
- Darcs.Patch.Patchy: commuteRLFL :: (Commute p) => (RL p :> FL p) -> Maybe ((FL p :> RL p))
- Darcs.Patch.Patchy: gzWritePatch :: (ShowPatch p) => FilePath -> p -> IO ()
- Darcs.Patch.Patchy: identity :: (Invert p) => p
- Darcs.Patch.Patchy: instance (Apply p) => Apply (FL p)
- Darcs.Patch.Patchy: instance (Apply p) => Apply (RL p)
- Darcs.Patch.Patchy: instance (Commute p) => Commute (FL p)
- Darcs.Patch.Patchy: instance (Commute p) => Commute (RL p)
- Darcs.Patch.Patchy: instance (ReadPatch p) => ReadPatch (FL p)
- Darcs.Patch.Patchy: instance (ReadPatch p) => ReadPatch (RL p)
- Darcs.Patch.Patchy: invertFL :: (Invert p) => FL p -> RL p
- Darcs.Patch.Patchy: invertRL :: (Invert p) => RL p -> FL p
- Darcs.Patch.Patchy: mapMaybeSnd :: (a -> b) -> Maybe (c, a) -> Maybe (c, b)
- Darcs.Patch.Patchy: merge :: (Commute p) => (p :\/: p) -> (p :/\: p)
- Darcs.Patch.Patchy: mergeFL :: (Commute p) => (p :\/: FL p) -> (FL p :/\: p)
- Darcs.Patch.Patchy: peekfor :: (ParserM m) => String -> m a -> m a -> m a
- Darcs.Patch.Patchy: sloppyIdentity :: (Invert p) => p -> EqCheck
- Darcs.Patch.Patchy: toFwdCommute :: (Commute p, Commute q, Monad m) => ((p :< q) -> m ((q :< p))) -> (q :> p) -> m ((p :> q))
- Darcs.Patch.Patchy: toRevCommute :: (Commute p, Commute q, Monad m) => ((p :> q) -> m ((q :> p))) -> (q :< p) -> m ((p :< q))
- Darcs.Patch.Patchy: writePatch :: (ShowPatch p) => FilePath -> p -> IO ()
- Darcs.Patch.Prim: AddDir :: DirPatchType
- Darcs.Patch.Prim: AddFile :: FilePatchType
- Darcs.Patch.Prim: Binary :: ByteString -> ByteString -> FilePatchType
- Darcs.Patch.Prim: ChangePref :: !String -> !String -> !String -> Prim
- Darcs.Patch.Prim: Conflicted :: ConflictState
- Darcs.Patch.Prim: DP :: !FileName -> !DirPatchType -> Prim
- Darcs.Patch.Prim: Duplicated :: ConflictState
- Darcs.Patch.Prim: FP :: !FileName -> !FilePatchType -> Prim
- Darcs.Patch.Prim: Failed :: Perhaps a
- Darcs.Patch.Prim: Hunk :: !Int -> [ByteString] -> [ByteString] -> FilePatchType
- Darcs.Patch.Prim: Identity :: Prim
- Darcs.Patch.Prim: IsC :: !ConflictState -> !Prim -> IsConflictedPrim
- Darcs.Patch.Prim: Move :: !FileName -> !FileName -> Prim
- Darcs.Patch.Prim: NewFormat :: FileNameFormat
- Darcs.Patch.Prim: Okay :: ConflictState
- Darcs.Patch.Prim: OldFormat :: FileNameFormat
- Darcs.Patch.Prim: RmDir :: DirPatchType
- Darcs.Patch.Prim: RmFile :: FilePatchType
- Darcs.Patch.Prim: Split :: FL Prim -> Prim
- Darcs.Patch.Prim: Succeeded :: a -> Perhaps a
- Darcs.Patch.Prim: TokReplace :: !String -> !String -> !String -> FilePatchType
- Darcs.Patch.Prim: Unknown :: Perhaps a
- Darcs.Patch.Prim: class (Invert p, Commute p, Effect p) => Conflict p
- Darcs.Patch.Prim: class Effect p
- Darcs.Patch.Prim: commuteNoConflicts :: (Conflict p) => (p :> p) -> Maybe ((p :> p))
- Darcs.Patch.Prim: commuteNoConflictsFL :: (Conflict p) => (p :> FL p) -> Maybe ((FL p :> p))
- Darcs.Patch.Prim: commuteNoConflictsRL :: (Conflict p) => (RL p :> p) -> Maybe ((p :> RL p))
- Darcs.Patch.Prim: conflictedEffect :: (Conflict p) => p -> [IsConflictedPrim]
- Darcs.Patch.Prim: data ConflictState
- Darcs.Patch.Prim: data DirPatchType
- Darcs.Patch.Prim: data FileNameFormat
- Darcs.Patch.Prim: data FilePatchType
- Darcs.Patch.Prim: data IsConflictedPrim
- Darcs.Patch.Prim: data Perhaps a
- Darcs.Patch.Prim: data Prim
- Darcs.Patch.Prim: effect :: (Effect p) => p -> FL Prim
- Darcs.Patch.Prim: effectRL :: (Effect p) => p -> RL Prim
- Darcs.Patch.Prim: formatFileName :: FileNameFormat -> FileName -> Doc
- Darcs.Patch.Prim: instance (Conflict p) => Conflict (FL p)
- Darcs.Patch.Prim: instance (Conflict p) => Conflict (RL p)
- Darcs.Patch.Prim: instance (Effect p) => Effect (FL p)
- Darcs.Patch.Prim: instance (Effect p) => Effect (RL p)
- Darcs.Patch.Prim: instance (FromPrim p) => FromPrims (FL p)
- Darcs.Patch.Prim: instance (FromPrim p) => FromPrims (RL p)
- Darcs.Patch.Prim: instance Commute Prim
- Darcs.Patch.Prim: instance Conflict Prim
- Darcs.Patch.Prim: instance Effect Prim
- Darcs.Patch.Prim: instance Eq ConflictState
- Darcs.Patch.Prim: instance Eq DirPatchType
- Darcs.Patch.Prim: instance Eq FilePatchType
- Darcs.Patch.Prim: instance FromPrim Prim
- Darcs.Patch.Prim: instance Invert Prim
- Darcs.Patch.Prim: instance Monad Perhaps
- Darcs.Patch.Prim: instance MonadPlus Perhaps
- Darcs.Patch.Prim: instance MyEq DirPatchType
- Darcs.Patch.Prim: instance MyEq FilePatchType
- Darcs.Patch.Prim: instance MyEq Prim
- Darcs.Patch.Prim: instance Ord ConflictState
- Darcs.Patch.Prim: instance Ord DirPatchType
- Darcs.Patch.Prim: instance Ord FilePatchType
- Darcs.Patch.Prim: instance Read ConflictState
- Darcs.Patch.Prim: instance Show ConflictState
- Darcs.Patch.Prim: instance Show DirPatchType
- Darcs.Patch.Prim: instance Show FilePatchType
- Darcs.Patch.Prim: instance Show Prim
- Darcs.Patch.Prim: instance Show Simple
- Darcs.Patch.Prim: instance Show2 Prim
- Darcs.Patch.Prim: instance ToFromPrim Prim
- Darcs.Patch.Prim: isHunk :: (Effect p) => p -> Maybe (Prim)
- Darcs.Patch.Prim: isIdentity :: Prim -> EqCheck
- Darcs.Patch.Prim: isInconsistent :: (Conflict p) => p -> Maybe Doc
- Darcs.Patch.Prim: isNullPatch :: Prim -> Bool
- Darcs.Patch.Prim: isSimilar :: Prim -> Prim -> Bool
- Darcs.Patch.Prim: listConflictedFiles :: (Conflict p) => p -> [FilePath]
- Darcs.Patch.Prim: modernizePrim :: Prim -> FL Prim
- Darcs.Patch.Prim: nFn :: FilePath -> FilePath
- Darcs.Patch.Prim: nullP :: Prim -> EqCheck
- Darcs.Patch.Prim: null_patch :: Prim
- Darcs.Patch.Prim: resolveConflicts :: (Conflict p) => p -> [[Sealed (FL Prim)]]
- Darcs.Patch.Prim: showHunk :: FileNameFormat -> FileName -> Int -> [ByteString] -> [ByteString] -> Doc
- Darcs.Patch.Prim: subcommutes :: [(String, (Prim :< Prim) -> Perhaps ((Prim :< Prim)))]
- Darcs.Patch.Prim: tryTokInternal :: String -> ByteString -> ByteString -> ByteString -> Maybe [ByteString]
- Darcs.Patch.Prim: type CommuteFunction = (Prim :< Prim) -> Perhaps ((Prim :< Prim))
- Darcs.Patch.Properties: commuteInverses :: (Patchy p) => ((p :> p) -> Maybe ((p :> p))) -> (p :> p) -> Maybe Doc
- Darcs.Patch.Properties: identityCommutes :: (Patchy p) => p -> Maybe Doc
- Darcs.Patch.Properties: inverseDoesntCommute :: (Patchy p) => p -> Maybe Doc
- Darcs.Patch.Properties: joinCommute :: ((Prim :> Prim) -> Maybe (Prim)) -> (Prim :> (Prim :> Prim)) -> Maybe Doc
- Darcs.Patch.Properties: joinInverses :: ((Prim :> Prim) -> Maybe (Prim)) -> Prim -> Maybe Doc
- Darcs.Patch.Properties: mergeArgumentsConsistent :: (Patchy p) => (p -> Maybe Doc) -> (p :\/: p) -> Maybe Doc
- Darcs.Patch.Properties: mergeCommute :: (Patchy p) => (p :\/: p) -> Maybe Doc
- Darcs.Patch.Properties: mergeConsistent :: (Patchy p) => (p -> Maybe Doc) -> (p :\/: p) -> Maybe Doc
- Darcs.Patch.Properties: mergeEitherWay :: (Patchy p) => (p :\/: p) -> Maybe Doc
- Darcs.Patch.Properties: partialPermutivity :: (Patchy p) => ((p :> p) -> Maybe ((p :> p))) -> (p :> (p :> p)) -> Maybe Doc
- Darcs.Patch.Properties: patchAndInverseCommute :: (Patchy p) => ((p :> p) -> Maybe ((p :> p))) -> (p :> p) -> Maybe Doc
- Darcs.Patch.Properties: permutivity :: (Patchy p) => ((p :> p) -> Maybe ((p :> p))) -> (p :> (p :> p)) -> Maybe Doc
- Darcs.Patch.Properties: recommute :: (Patchy p) => (((p :> p) -> Maybe ((p :> p)))) -> (p :> p) -> Maybe Doc
- Darcs.Patch.Properties: show_read :: (Show2 p, Patchy p) => p -> Maybe Doc
- Darcs.Patch.Read: instance (ReadPatch p) => ReadPatch (Named p)
- Darcs.Patch.Read: instance ReadPatch Patch
- Darcs.Patch.Read: instance ReadPatch Prim
- Darcs.Patch.Read: readPrim :: (ParserM m) => FileNameFormat -> m (Maybe (Sealed (Prim)))
- Darcs.Patch.ReadMonads: alterInput :: (ParserM m) => (ByteString -> ByteString) -> m ()
- Darcs.Patch.ReadMonads: lexStrings :: (ParserM m) => [String] -> m String
- Darcs.Patch.ReadMonads: maybeWork :: (ParserM m) => (ByteString -> Maybe (a, ByteString)) -> m (Maybe a)
- Darcs.Patch.ReadMonads: myLex :: ByteString -> Maybe (ByteString, ByteString)
- Darcs.Patch.ReadMonads: peekInput :: (ParserM m) => m ByteString
- Darcs.Patch.ReadMonads: work :: (ParserM m) => (ByteString -> Maybe (a, ByteString)) -> m a
- Darcs.Patch.Real: Conflictor :: [Non RealPatch] -> FL Prim -> Non RealPatch -> RealPatch
- Darcs.Patch.Real: Duplicate :: Non RealPatch -> RealPatch
- Darcs.Patch.Real: Etacilpud :: Non RealPatch -> RealPatch
- Darcs.Patch.Real: InvConflictor :: [Non RealPatch] -> FL Prim -> Non RealPatch -> RealPatch
- Darcs.Patch.Real: Normal :: Prim -> RealPatch
- Darcs.Patch.Real: data RealPatch
- Darcs.Patch.Real: instance Apply RealPatch
- Darcs.Patch.Real: instance Commute RealPatch
- Darcs.Patch.Real: instance Conflict RealPatch
- Darcs.Patch.Real: instance Effect RealPatch
- Darcs.Patch.Real: instance FromPrim RealPatch
- Darcs.Patch.Real: instance Invert RealPatch
- Darcs.Patch.Real: instance MyEq RealPatch
- Darcs.Patch.Real: instance Nonable RealPatch
- Darcs.Patch.Real: instance Patchy RealPatch
- Darcs.Patch.Real: instance ReadPatch RealPatch
- Darcs.Patch.Real: instance Show RealPatch
- Darcs.Patch.Real: instance Show2 RealPatch
- Darcs.Patch.Real: instance ShowPatch RealPatch
- Darcs.Patch.Real: instance ToFromPrim RealPatch
- Darcs.Patch.Real: isConsistent :: RealPatch -> Maybe Doc
- Darcs.Patch.Real: isDuplicate :: RealPatch -> Bool
- Darcs.Patch.Real: isForward :: RealPatch -> Maybe Doc
- Darcs.Patch.Real: mergeUnravelled :: [Sealed ((FL Prim))] -> Maybe (FlippedSeal RealPatch)
- Darcs.Patch.Real: prim2real :: Prim -> RealPatch
- Darcs.Patch.Real: pullCommon :: (Patchy p) => FL p -> FL p -> Common p
- Darcs.Patch.Show: instance Show Patch
- Darcs.Patch.Show: instance Show2 Patch
- Darcs.Patch.Show: showPatch_ :: Patch -> Doc
- Darcs.Patch.Viewing: instance (Conflict p, Apply p, Effect p, ShowPatch p) => ShowPatch (FL p)
- Darcs.Patch.Viewing: instance (Conflict p, Apply p, ShowPatch p) => ShowPatch (RL p)
- Darcs.Patch.Viewing: instance (Conflict p, Patchy p) => Patchy (FL p)
- Darcs.Patch.Viewing: instance (Conflict p, Patchy p) => Patchy (RL p)
- Darcs.Patch.Viewing: instance (Conflict p, ShowPatch p) => Show (Named p)
- Darcs.Patch.Viewing: instance (Conflict p, ShowPatch p) => ShowPatch (Named p)
- Darcs.Patch.Viewing: instance Eq SummChunk
- Darcs.Patch.Viewing: instance Eq SummDetail
- Darcs.Patch.Viewing: instance Eq SummOp
- Darcs.Patch.Viewing: instance Ord SummChunk
- Darcs.Patch.Viewing: instance Ord SummDetail
- Darcs.Patch.Viewing: instance Ord SummOp
- Darcs.Patch.Viewing: instance ShowPatch Patch
- Darcs.Patch.Viewing: instance ShowPatch Prim
- Darcs.Patch.Viewing: plainSummary :: (Conflict e, Effect e) => e -> Doc
- Darcs.Patch.Viewing: xmlSummary :: (Effect p, Patchy p, Conflict p) => Named p -> Doc
- Darcs.Population: AddedDir :: DirMark
- Darcs.Population: AddedFile :: DirMark
- Darcs.Population: DullDir :: DirMark
- Darcs.Population: DullFile :: DirMark
- Darcs.Population: ModifiedFile :: DirMark
- Darcs.Population: MovedDir :: !String -> DirMark
- Darcs.Population: MovedFile :: String -> DirMark
- Darcs.Population: RemovedDir :: DirMark
- Darcs.Population: RemovedFile :: DirMark
- Darcs.Population: applyToPop :: PatchInfo -> FL Prim -> Population -> Population
- Darcs.Population: data DirMark
- Darcs.Population: data Population
- Darcs.Population: getPopFrom :: FilePath -> PatchInfo -> IO Population
- Darcs.Population: getRepoPop :: FilePath -> IO Population
- Darcs.Population: getRepoPopVersion :: FilePath -> PatchInfo -> IO Population
- Darcs.Population: lookupCreationPop :: PatchInfo -> FilePath -> Population -> Maybe Population
- Darcs.Population: lookupPop :: FilePath -> Population -> Maybe Population
- Darcs.Population: modifiedToXml :: Info -> Doc
- Darcs.Population: patchChanges :: Prim -> [(String, DirMark)]
- Darcs.Population: setPopState :: PatchInfo -> Population -> Population
- Darcs.PopulationData: AddedDir :: DirMark
- Darcs.PopulationData: AddedFile :: DirMark
- Darcs.PopulationData: DullDir :: DirMark
- Darcs.PopulationData: DullFile :: DirMark
- Darcs.PopulationData: Info :: !ByteString -> !PatchInfo -> !DirMark -> !Maybe PatchInfo -> !Maybe ByteString -> Info
- Darcs.PopulationData: ModifiedFile :: DirMark
- Darcs.PopulationData: MovedDir :: !String -> DirMark
- Darcs.PopulationData: MovedFile :: String -> DirMark
- Darcs.PopulationData: Pop :: PatchInfo -> PopTree -> Population
- Darcs.PopulationData: PopDir :: !Info -> ![PopTree] -> PopTree
- Darcs.PopulationData: PopFile :: !Info -> PopTree
- Darcs.PopulationData: RemovedDir :: DirMark
- Darcs.PopulationData: RemovedFile :: DirMark
- Darcs.PopulationData: createdByI :: Info -> !Maybe PatchInfo
- Darcs.PopulationData: creationNameI :: Info -> !Maybe ByteString
- Darcs.PopulationData: data DirMark
- Darcs.PopulationData: data Info
- Darcs.PopulationData: data PopTree
- Darcs.PopulationData: data Population
- Darcs.PopulationData: getPopFrom :: FilePath -> PatchInfo -> IO Population
- Darcs.PopulationData: instance Eq DirMark
- Darcs.PopulationData: instance Eq Info
- Darcs.PopulationData: instance Eq PopTree
- Darcs.PopulationData: instance Eq Population
- Darcs.PopulationData: instance Ord DirMark
- Darcs.PopulationData: instance Ord Info
- Darcs.PopulationData: instance Ord PopTree
- Darcs.PopulationData: instance Show DirMark
- Darcs.PopulationData: instance Show Info
- Darcs.PopulationData: instance Show PopTree
- Darcs.PopulationData: instance Show Population
- Darcs.PopulationData: modifiedByI :: Info -> !PatchInfo
- Darcs.PopulationData: modifiedHowI :: Info -> !DirMark
- Darcs.PopulationData: nameI :: Info -> !ByteString
- Darcs.PopulationData: notModified :: Info -> Bool
- Darcs.PopulationData: popState :: Population -> PatchInfo
- Darcs.PopulationData: popTree :: Population -> PopTree
- Darcs.PopulationData: setPopState :: PatchInfo -> Population -> Population
- Darcs.PopulationData: setState :: Info -> PatchInfo -> Info
- Darcs.RepoPath: instance (CharLike c) => FilePathLike [c]
- Darcs.RepoPath: instance (CharLike c) => FilePathOrURL [c]
- Darcs.Repository: ($-) :: ((forall p. (RepoPatch p) => Repository p -> IO a) -> IO a) -> (forall p. (RepoPatch p) => Repository p -> IO a) -> IO a
- Darcs.Repository: copyOldrepoPatches :: (RepoPatch p) => [DarcsFlag] -> Repository p -> FilePath -> IO ()
- Darcs.Repository: getMarkedupFile :: (RepoPatch p) => Repository p -> PatchInfo -> FilePath -> IO MarkedUpFile
- Darcs.Repository: instance Eq PorNP
- Darcs.Repository.ApplyPatches: applyPatchesWithFeedback :: (Patchy p) => [DarcsFlag] -> String -> FL (PatchInfoAnd p) -> IO ()
- Darcs.Repository.Checkpoint: getCheckpoint :: (RepoPatch p) => Repository p -> IO (Maybe (Sealed (Named p)))
- Darcs.Repository.Checkpoint: getCheckpointByDefault :: (RepoPatch p) => Repository p -> IO (Maybe (Sealed (Named p)))
- Darcs.Repository.Checkpoint: identifyCheckpoint :: (RepoPatch p) => Repository p -> IO (Maybe PatchInfo)
- Darcs.Repository.Checkpoint: writeCheckpointPatch :: (RepoPatch p) => Named p -> IO ()
- Darcs.Repository.DarcsRepo: addToInventory :: FilePath -> [PatchInfo] -> IO ()
- Darcs.Repository.DarcsRepo: addToTentativeInventory :: (RepoPatch p) => [DarcsFlag] -> Named p -> IO FilePath
- Darcs.Repository.DarcsRepo: addToTentativePristine :: (Effect p) => p -> IO ()
- Darcs.Repository.DarcsRepo: copyPatches :: [DarcsFlag] -> FilePath -> FilePath -> [PatchInfo] -> IO ()
- Darcs.Repository.DarcsRepo: finalizePristineChanges :: IO ()
- Darcs.Repository.DarcsRepo: finalizeTentativeChanges :: IO ()
- Darcs.Repository.DarcsRepo: readCheckpoints :: String -> IO [PatchInfo]
- Darcs.Repository.DarcsRepo: readRepo :: (RepoPatch p) => [DarcsFlag] -> String -> IO (SealedPatchSet p)
- Darcs.Repository.DarcsRepo: readTentativeRepo :: (RepoPatch p) => [DarcsFlag] -> String -> IO (SealedPatchSet p)
- Darcs.Repository.DarcsRepo: removeFromTentativeInventory :: (RepoPatch p) => Bool -> [DarcsFlag] -> FL (PatchInfoAnd p) -> IO ()
- Darcs.Repository.DarcsRepo: revertTentativeChanges :: IO ()
- Darcs.Repository.DarcsRepo: writeAndReadPatch :: (RepoPatch p) => [DarcsFlag] -> PatchInfoAnd p -> IO (PatchInfoAnd p)
- Darcs.Repository.DarcsRepo: writeInventory :: (RepoPatch p) => FilePath -> PatchSet p -> IO ()
- Darcs.Repository.DarcsRepo: writeInventoryAndPatches :: (RepoPatch p) => [DarcsFlag] -> PatchSet p -> IO ()
- Darcs.Repository.Format: formatHasTogether :: [RepoProperty] -> RepoFormat -> Bool
- Darcs.Repository.HashedIO: instance ReadableDirectory (HashedIO r p)
- Darcs.Repository.HashedIO: instance WriteableDirectory (HashedIO RW p)
- Darcs.Repository.Internal: ($-) :: ((forall p. (RepoPatch p) => Repository p -> IO a) -> IO a) -> (forall p. (RepoPatch p) => Repository p -> IO a) -> IO a
- Darcs.Repository.Internal: data PatchSet p
- Darcs.Repository.Internal: getMarkedupFile :: (RepoPatch p) => Repository p -> PatchInfo -> FilePath -> IO MarkedUpFile
- Darcs.Repository.Internal: identifyDarcs1Repository :: [DarcsFlag] -> String -> IO (Repository Patch)
- Darcs.Repository.Internal: instance Functor (RIO p)
- Darcs.Repository.Internal: instance Monad (RIO p)
- Darcs.Repository.Internal: type SealedPatchSet p = Sealed ((PatchSet p))
- Darcs.Repository.InternalTypes: instance Show (Repository p)
- Darcs.Repository.LowLevel: readPendingfile :: String -> IO (Sealed (FL Prim))
- Darcs.Repository.LowLevel: readPrims :: ByteString -> Sealed (FL Prim)
- Darcs.Repository.Merge: tentativelyMergePatches_ :: (RepoPatch p) => MakeChanges -> Repository p -> String -> [DarcsFlag] -> FL (PatchInfoAnd p) -> FL (PatchInfoAnd p) -> IO (Sealed (FL Prim))
- Darcs.Repository.Pristine: applyPristine :: (Patchy p) => Pristine -> p -> IO ()
- Darcs.Repository.Pristine: createPristine :: Pristine -> IO Pristine
- Darcs.Repository.Pristine: createPristineFromWorking :: Pristine -> IO ()
- Darcs.Repository.Pristine: data Pristine
- Darcs.Repository.Pristine: easyCreatePartialsPristineDirectoryTree :: (FilePathLike fp) => [fp] -> Pristine -> FilePath -> IO Bool
- Darcs.Repository.Pristine: easyCreatePristineDirectoryTree :: Pristine -> FilePath -> IO Bool
- Darcs.Repository.Pristine: flagsToPristine :: [DarcsFlag] -> RepoFormat -> Pristine
- Darcs.Repository.Pristine: getPristinePop :: PatchInfo -> Pristine -> IO (Maybe Population)
- Darcs.Repository.Pristine: identifyPristine :: IO (Pristine)
- Darcs.Repository.Pristine: nopristine :: Pristine
- Darcs.Repository.Pristine: pristineDirectory :: Pristine -> Maybe String
- Darcs.Repository.Pristine: pristineToFlagString :: Pristine -> String
- Darcs.Repository.Pristine: removePristine :: Pristine -> IO ()
- Darcs.URL: isSsh :: String -> Bool
- Darcs.URL: isUrl :: String -> Bool
- Darcs.Utils: firstJustM :: (Monad m) => [m (Maybe a)] -> m (Maybe a)
- Darcs.Utils: firstNotBlank :: [String] -> Maybe String
- Darcs.Utils: putDocLnError :: Doc -> IO ()
- Darcs.Utils: putStrLnError :: String -> IO ()
- Darcs.Witnesses.Ordered: (:>>) :: (a1) -> (a2) -> :>> a1 a2
- Darcs.Witnesses.Ordered: (=/\=) :: (MyEq p) => p -> p -> EqCheck
- Darcs.Witnesses.Ordered: (=\/=) :: (MyEq p) => p -> p -> EqCheck
- Darcs.Witnesses.Ordered: IsEq :: EqCheck
- Darcs.Witnesses.Ordered: NotEq :: EqCheck
- Darcs.Witnesses.Ordered: Proof :: a -> Proof a
- Darcs.Witnesses.Ordered: class MyEq p
- Darcs.Witnesses.Ordered: concatReverseFL :: FL (RL a) -> RL a
- Darcs.Witnesses.Ordered: data EqCheck
- Darcs.Witnesses.Ordered: data Proof a
- Darcs.Witnesses.Ordered: filterE :: (a -> EqCheck) -> [a] -> [Proof a]
- Darcs.Witnesses.Ordered: headRL :: RL a -> FlippedSeal a
- Darcs.Witnesses.Ordered: instance (MyEq a) => Eq (Sealed a)
- Darcs.Witnesses.Ordered: instance (Show2 a) => Show (FL a)
- Darcs.Witnesses.Ordered: instance (Show2 a) => Show2 (FL a)
- Darcs.Witnesses.Ordered: instance (Show2 a, Show2 b) => Show (a :> b)
- Darcs.Witnesses.Ordered: instance (Show2 a, Show2 b) => Show (a :\/: b)
- Darcs.Witnesses.Ordered: instance Eq EqCheck
- Darcs.Witnesses.Ordered: instance Show EqCheck
- Darcs.Witnesses.Ordered: isEq :: EqCheck -> Bool
- Darcs.Witnesses.Ordered: unsafeCoerceP :: a -> a
- Darcs.Witnesses.Ordered: unsafeCoerceP2 :: t -> t
- Darcs.Witnesses.Ordered: unsafeCoercePEnd :: a -> a
- Darcs.Witnesses.Ordered: unsafeCoercePStart :: a -> a
- Darcs.Witnesses.Ordered: unsafeCompare :: (MyEq p) => p -> p -> Bool
- Darcs.Witnesses.Ordered: unsafeMap_l2f :: (a -> b) -> [a] -> FL b
- Darcs.Witnesses.Sealed: instance (Show1 a) => Show (Sealed a)
- Darcs.Witnesses.Sealed: instance (Show2 a) => Show (Sealed2 a)
- Lcs: aLen :: (IArray a e) => a Int e -> Int
- Lcs: type BArray = UArray Int Bool
- Lcs: type BSTArray s = STUArray s Int Bool
- Lcs: type PArray = Array Int ByteString
- Ssh: copySSHs :: String -> String -> [String] -> FilePath -> IO ()
- Ssh: grabSSH :: String -> Connection -> IO ByteString
+ Darcs.Annotate: annotate :: Apply p => FL (PatchInfoAnd p) x y -> FileName -> ByteString -> Annotated
+ Darcs.Annotate: annotateDirectory :: Apply p => FL (PatchInfoAnd p) x y -> FileName -> [FileName] -> Annotated
+ Darcs.Annotate: format :: ByteString -> Annotated -> String
+ Darcs.Annotate: instance ApplyMonad AnnotatedM
+ Darcs.Annotate: instance Eq FileOrDirectory
+ Darcs.Annotate: instance Show Annotated
+ Darcs.Annotate: instance Show FileOrDirectory
+ Darcs.Annotate: machineFormat :: ByteString -> Annotated -> String
+ Darcs.Arguments: DarcsInternalOption :: DarcsFlag -> DarcsAtomicOption
+ Darcs.Arguments: GenContext :: DarcsFlag
+ Darcs.Arguments: NoPacks :: DarcsFlag
+ Darcs.Arguments: NoRecordRollback :: DarcsFlag
+ Darcs.Arguments: Packs :: DarcsFlag
+ Darcs.Arguments: RecordRollback :: DarcsFlag
+ Darcs.Arguments: RemoteDarcsOpt :: String -> DarcsFlag
+ Darcs.Arguments: makeScriptsExecutable :: Patchy p => [DarcsFlag] -> p x y -> IO ()
+ Darcs.Arguments: maybeFixSubPaths :: [DarcsFlag] -> [FilePath] -> IO [Maybe SubPath]
+ Darcs.Arguments: patchFormatChoices :: DarcsOption
+ Darcs.Arguments: recordRollback :: DarcsOption
+ Darcs.Arguments: setEnvDarcsFiles :: Patchy p => p x y -> IO ()
+ Darcs.Arguments: setEnvDarcsPatches :: RepoPatch p => FL (PatchInfoAnd p) x y -> IO ()
+ Darcs.Arguments: usePacks :: DarcsOption
+ Darcs.Commands: commandProgramName :: DarcsCommand -> String
+ Darcs.Commands.Check: repair :: DarcsCommand
+ Darcs.Commands.Replace: defaultToks :: String
+ Darcs.Commands.Util: announceFiles :: Maybe [SubPath] -> String -> IO ()
+ Darcs.Commands.Util: filterExistingFiles :: RepoPatch p => Repository p r u t -> [SubPath] -> IO [SubPath]
+ Darcs.Commands.WhatsNew: status :: DarcsCommand
+ Darcs.CommandsAux: isMaliciousPath :: String -> Bool
+ Darcs.CommandsAux: isMaliciousSubPath :: String -> Bool
+ Darcs.External: haveSendmail :: IO Bool
+ Darcs.Flags: DefaultRemoteDarcs :: RemoteDarcs
+ Darcs.Flags: GenContext :: DarcsFlag
+ Darcs.Flags: IgnoreIndex :: UseIndex
+ Darcs.Flags: NoPacks :: DarcsFlag
+ Darcs.Flags: NoRecordRollback :: DarcsFlag
+ Darcs.Flags: Packs :: DarcsFlag
+ Darcs.Flags: RecordRollback :: DarcsFlag
+ Darcs.Flags: RemoteDarcsOpt :: String -> DarcsFlag
+ Darcs.Flags: ScanAll :: ScanKnown
+ Darcs.Flags: ScanKnown :: ScanKnown
+ Darcs.Flags: UseIndex :: UseIndex
+ Darcs.Flags: data RemoteDarcs
+ Darcs.Flags: data ScanKnown
+ Darcs.Flags: data UseIndex
+ Darcs.Flags: diffingOpts :: [DarcsFlag] -> (UseIndex, ScanKnown)
+ Darcs.Flags: isNotUnified :: [DarcsFlag] -> Bool
+ Darcs.Flags: remoteDarcs :: [DarcsFlag] -> RemoteDarcs
+ Darcs.Flags: rollbackInWorkingDir :: [DarcsFlag] -> Bool
+ Darcs.Flags: usePacks :: [DarcsFlag] -> Bool
+ Darcs.Global: addBadSource :: String -> IO ()
+ Darcs.Global: addReachableSource :: String -> IO ()
+ Darcs.Global: getBadSourcesList :: IO [String]
+ Darcs.Global: isBadSource :: IO (String -> Bool)
+ Darcs.Global: isReachableSource :: IO (String -> Bool)
+ Darcs.IO: instance ApplyMonad IO
+ Darcs.IO: instance ApplyMonad SilentIO
+ Darcs.IO: instance ApplyMonad TolerantIO
+ Darcs.Match: getNonrangeMatchS :: (ApplyMonad m, MonadProgress m, RepoPatch p) => [DarcsFlag] -> PatchSet p Origin x -> m ()
+ Darcs.MonadProgress: ProgressAction :: m a -> Doc -> Doc -> ProgressAction m a
+ Darcs.MonadProgress: class Monad m => MonadProgress m
+ Darcs.MonadProgress: data ProgressAction m a
+ Darcs.MonadProgress: instance (Functor m, Monad m) => MonadProgress (TreeMonad m)
+ Darcs.MonadProgress: instance MonadProgress IO
+ Darcs.MonadProgress: paAction :: ProgressAction m a -> m a
+ Darcs.MonadProgress: paMessage :: ProgressAction m a -> Doc
+ Darcs.MonadProgress: paOnError :: ProgressAction m a -> Doc
+ Darcs.MonadProgress: runProgressActions :: MonadProgress m => String -> [ProgressAction m ()] -> m ()
+ Darcs.MonadProgress: silentlyRunProgressActions :: Monad m => String -> [ProgressAction m ()] -> m ()
+ Darcs.Patch: class (Patchy prim, PatchListFormat prim, IsHunk prim, RepairToFL prim, PrimConstruct prim, PrimCanonize prim, PrimClassify prim, PrimDetails prim, PrimShow prim, PrimRead prim, PrimApply prim) => PrimPatch prim
+ Darcs.Patch: forceTokReplace :: String -> String -> String -> ByteString -> Maybe ByteString
+ Darcs.Patch: instance (CommuteNoConflicts p, Conflict p, IsHunk p, PatchListFormat p, PrimPatchBase p, Patchy p) => Patchy (Named p)
+ Darcs.Patch: plainSummaryPrims :: PrimDetails prim => FL prim x y -> Doc
+ Darcs.Patch: readPatchPartial :: ReadPatch p => ByteString -> Maybe (Sealed (p x), ByteString)
+ Darcs.Patch: summaryFL :: ShowPatch p => FL p x y -> Doc
+ Darcs.Patch.Apply: apply :: (Apply p, ApplyMonad m) => p x y -> m ()
+ Darcs.Patch.Apply: class Apply p
+ Darcs.Patch.Apply: instance Apply p => Apply (FL p)
+ Darcs.Patch.Apply: instance Apply p => Apply (RL p)
+ Darcs.Patch.ApplyMonad: class (Functor m, Monad m) => ApplyMonad m
+ Darcs.Patch.ApplyMonad: instance (Functor m, Monad m) => ApplyMonad (TreeMonad m)
+ Darcs.Patch.ApplyMonad: instance ApplyMonad FilePathMonad
+ Darcs.Patch.ApplyMonad: instance ApplyMonad RestrictedApply
+ Darcs.Patch.ApplyMonad: instance MonadProgress FilePathMonad
+ Darcs.Patch.ApplyMonad: instance MonadProgress RestrictedApply
+ Darcs.Patch.ApplyMonad: mChangePref :: ApplyMonad m => String -> String -> String -> m ()
+ Darcs.Patch.ApplyMonad: mCreateDirectory :: ApplyMonad m => FileName -> m ()
+ Darcs.Patch.ApplyMonad: mCreateFile :: ApplyMonad m => FileName -> m ()
+ Darcs.Patch.ApplyMonad: mDoesDirectoryExist :: ApplyMonad m => FileName -> m Bool
+ Darcs.Patch.ApplyMonad: mModifyFilePS :: ApplyMonad m => FileName -> (ByteString -> m ByteString) -> m ()
+ Darcs.Patch.ApplyMonad: mModifyFilePSs :: ApplyMonad m => FileName -> ([ByteString] -> m [ByteString]) -> m ()
+ Darcs.Patch.ApplyMonad: mReadFilePS :: ApplyMonad m => FileName -> m ByteString
+ Darcs.Patch.ApplyMonad: mReadFilePSs :: ApplyMonad m => FileName -> m [ByteString]
+ Darcs.Patch.ApplyMonad: mRemoveDirectory :: ApplyMonad m => FileName -> m ()
+ Darcs.Patch.ApplyMonad: mRemoveFile :: ApplyMonad m => FileName -> m ()
+ Darcs.Patch.ApplyMonad: mRename :: ApplyMonad m => FileName -> FileName -> m ()
+ Darcs.Patch.ApplyMonad: withFilePaths :: [FileName] -> FilePathMonad a -> [FileName]
+ Darcs.Patch.ApplyMonad: withFiles :: [(FileName, ByteString)] -> RestrictedApply a -> [(FileName, ByteString)]
+ Darcs.Patch.Bracketed: Braced :: BracketedFL p x y -> Bracketed p x y
+ Darcs.Patch.Bracketed: Parens :: BracketedFL p x y -> Bracketed p x y
+ Darcs.Patch.Bracketed: Singleton :: p x y -> Bracketed p x y
+ Darcs.Patch.Bracketed: data Bracketed p x y
+ Darcs.Patch.Bracketed: instance PatchListFormat (Bracketed p)
+ Darcs.Patch.Bracketed: mapBracketed :: (forall a b. p a b -> q a b) -> Bracketed p x y -> Bracketed q x y
+ Darcs.Patch.Bracketed: mapBracketedFL_FL :: (forall a b. p a b -> q a b) -> BracketedFL p x y -> BracketedFL q x y
+ Darcs.Patch.Bracketed: type BracketedFL p x y = FL (Bracketed p) x y
+ Darcs.Patch.Bracketed: unBracketed :: Bracketed p x y -> FL p x y
+ Darcs.Patch.Bracketed: unBracketedFL :: BracketedFL p x y -> FL p x y
+ Darcs.Patch.Bracketed.Instances: instance ShowPatchBasic p => ShowPatchBasic (Bracketed p)
+ Darcs.Patch.Bundle: getContext :: ByteString -> ([PatchInfo], ByteString)
+ Darcs.Patch.Bundle: parseBundle :: RepoPatch p => ByteString -> Either String (Sealed ((PatchSet p :> FL (PatchInfoAnd p)) Origin))
+ Darcs.Patch.Choices: instance Commute p => Commute (PatchChoice p)
+ Darcs.Patch.Choices: instance Commute p => Commute (TaggedPatch p)
+ Darcs.Patch.Choices: instance Invert p => Invert (TaggedPatch p)
+ Darcs.Patch.Choices: instance Merge p => Merge (PatchChoice p)
+ Darcs.Patch.Choices: instance Merge p => Merge (TaggedPatch p)
+ Darcs.Patch.Choices: instance MyEq p => MyEq (PatchChoice p)
+ Darcs.Patch.Choices: instance MyEq p => MyEq (TaggedPatch p)
+ Darcs.Patch.Choices: instance PatchInspect p => PatchInspect (PatchChoice p)
+ Darcs.Patch.Choices: instance PatchInspect p => PatchInspect (TaggedPatch p)
+ Darcs.Patch.Commute: class Commute p
+ Darcs.Patch.Commute: commute :: Commute p => (p :> p) x y -> Maybe ((p :> p) x y)
+ Darcs.Patch.Commute: commuteFL :: Commute p => (p :> FL p) x y -> Maybe ((FL p :> p) x y)
+ Darcs.Patch.Commute: commuteFLorComplain :: Commute p => (p :> FL p) x y -> Either (Sealed2 p) ((FL p :> p) x y)
+ Darcs.Patch.Commute: commuteRL :: Commute p => (RL p :> p) x y -> Maybe ((p :> RL p) x y)
+ Darcs.Patch.Commute: commuteRLFL :: Commute p => (RL p :> FL p) x y -> Maybe ((FL p :> RL p) x y)
+ Darcs.Patch.Commute: instance Commute p => Commute (FL p)
+ Darcs.Patch.Commute: instance Commute p => Commute (RL p)
+ Darcs.Patch.Commute: toFwdCommute :: (Commute p, Commute q, Monad m) => ((p :< q) x y -> m ((q :< p) x y)) -> (q :> p) x y -> m ((p :> q) x y)
+ Darcs.Patch.Commute: toRevCommute :: (Commute p, Commute q, Monad m) => ((p :> q) x y -> m ((q :> p) x y)) -> (q :< p) x y -> m ((p :< q) x y)
+ Darcs.Patch.Conflict: Conflicted :: ConflictState
+ Darcs.Patch.Conflict: Duplicated :: ConflictState
+ Darcs.Patch.Conflict: IsC :: !ConflictState -> !prim x y -> IsConflictedPrim prim
+ Darcs.Patch.Conflict: Okay :: ConflictState
+ Darcs.Patch.Conflict: class CommuteNoConflicts p
+ Darcs.Patch.Conflict: class (Effect p, PatchInspect (PrimOf p)) => Conflict p
+ Darcs.Patch.Conflict: commuteNoConflicts :: CommuteNoConflicts p => (p :> p) x y -> Maybe ((p :> p) x y)
+ Darcs.Patch.Conflict: conflictedEffect :: Conflict p => p x y -> [IsConflictedPrim (PrimOf p)]
+ Darcs.Patch.Conflict: data ConflictState
+ Darcs.Patch.Conflict: data IsConflictedPrim prim
+ Darcs.Patch.Conflict: instance (CommuteNoConflicts p, Conflict p) => Conflict (FL p)
+ Darcs.Patch.Conflict: instance (CommuteNoConflicts p, Conflict p) => Conflict (RL p)
+ Darcs.Patch.Conflict: instance CommuteNoConflicts p => CommuteNoConflicts (FL p)
+ Darcs.Patch.Conflict: instance CommuteNoConflicts p => CommuteNoConflicts (RL p)
+ Darcs.Patch.Conflict: instance Eq ConflictState
+ Darcs.Patch.Conflict: instance Ord ConflictState
+ Darcs.Patch.Conflict: instance Read ConflictState
+ Darcs.Patch.Conflict: instance Show ConflictState
+ Darcs.Patch.Conflict: listConflictedFiles :: Conflict p => p x y -> [FilePath]
+ Darcs.Patch.Conflict: resolveConflicts :: Conflict p => p x y -> [[Sealed (FL (PrimOf p) y)]]
+ Darcs.Patch.ConflictMarking: mangleUnravelled :: PrimPatch prim => [Sealed (FL prim x)] -> Sealed (FL prim x)
+ Darcs.Patch.Dummy: data DummyPatch x y
+ Darcs.Patch.Dummy: instance Apply DummyPatch
+ Darcs.Patch.Dummy: instance Commute DummyPatch
+ Darcs.Patch.Dummy: instance Invert DummyPatch
+ Darcs.Patch.Dummy: instance IsHunk DummyPatch
+ Darcs.Patch.Dummy: instance MyEq DummyPatch
+ Darcs.Patch.Dummy: instance PatchInspect DummyPatch
+ Darcs.Patch.Dummy: instance PatchListFormat DummyPatch
+ Darcs.Patch.Dummy: instance Patchy DummyPatch
+ Darcs.Patch.Dummy: instance ReadPatch DummyPatch
+ Darcs.Patch.Dummy: instance ShowPatch DummyPatch
+ Darcs.Patch.Dummy: instance ShowPatchBasic DummyPatch
+ Darcs.Patch.Effect: class Effect p
+ Darcs.Patch.Effect: effect :: Effect p => p x y -> FL (PrimOf p) x y
+ Darcs.Patch.Effect: effectRL :: Effect p => p x y -> RL (PrimOf p) x y
+ Darcs.Patch.Effect: instance Effect p => Effect (FL p)
+ Darcs.Patch.Effect: instance Effect p => Effect (RL p)
+ Darcs.Patch.FileHunk: FileHunk :: !FileName -> !Int -> [ByteString] -> [ByteString] -> FileHunk x y
+ Darcs.Patch.FileHunk: class IsHunk p
+ Darcs.Patch.FileHunk: data FileHunk x y
+ Darcs.Patch.FileHunk: isHunk :: IsHunk p => p x y -> Maybe (FileHunk x y)
+ Darcs.Patch.FileHunk: showFileHunk :: FileNameFormat -> FileHunk x y -> Doc
+ Darcs.Patch.Format: ListFormatDefault :: ListFormat
+ Darcs.Patch.Format: ListFormatV1 :: ListFormat
+ Darcs.Patch.Format: ListFormatV2 :: ListFormat
+ Darcs.Patch.Format: NewFormat :: FileNameFormat
+ Darcs.Patch.Format: OldFormat :: FileNameFormat
+ Darcs.Patch.Format: class PatchListFormat p
+ Darcs.Patch.Format: data FileNameFormat
+ Darcs.Patch.Format: data ListFormat p :: (* -> * -> *)
+ Darcs.Patch.Format: patchListFormat :: PatchListFormat p => ListFormat p
+ Darcs.Patch.Info: escapeXML :: String -> Doc
+ Darcs.Patch.Info: makePatchname :: PatchInfo -> String
+ Darcs.Patch.Info: readPatchInfos :: ByteString -> [PatchInfo]
+ Darcs.Patch.Inspect: class PatchInspect p
+ Darcs.Patch.Inspect: hunkMatches :: PatchInspect p => (ByteString -> Bool) -> p x y -> Bool
+ Darcs.Patch.Inspect: instance PatchInspect p => PatchInspect (FL p)
+ Darcs.Patch.Inspect: instance PatchInspect p => PatchInspect (RL p)
+ Darcs.Patch.Inspect: listTouchedFiles :: PatchInspect p => p x y -> [FilePath]
+ Darcs.Patch.Invert: class Invert p
+ Darcs.Patch.Invert: invert :: Invert p => p x y -> p y x
+ Darcs.Patch.Invert: invertFL :: Invert p => FL p x y -> RL p y x
+ Darcs.Patch.Invert: invertRL :: Invert p => RL p x y -> FL p y x
+ Darcs.Patch.Merge: class Commute p => Merge p
+ Darcs.Patch.Merge: instance Merge p => Merge (FL p)
+ Darcs.Patch.Merge: instance Merge p => Merge (RL p)
+ Darcs.Patch.Merge: merge :: Merge p => (p :\/: p) x y -> (p :/\: p) x y
+ Darcs.Patch.Merge: mergeFL :: Merge p => (p :\/: FL p) x y -> (FL p :/\: p) x y
+ Darcs.Patch.Named: NamedP :: !PatchInfo -> ![PatchInfo] -> !FL p x y -> Named p x y
+ Darcs.Patch.Named: adddeps :: Named p x y -> [PatchInfo] -> Named p x y
+ Darcs.Patch.Named: anonymous :: Patchy p => FL p x y -> IO (Named p x y)
+ Darcs.Patch.Named: data Named p x y
+ Darcs.Patch.Named: fmapFL_Named :: (FL p x y -> FL q x y) -> Named p x y -> Named q x y
+ Darcs.Patch.Named: fmapNamed :: (forall a b. p a b -> q a b) -> Named p x y -> Named q x y
+ Darcs.Patch.Named: getdeps :: Named p x y -> [PatchInfo]
+ Darcs.Patch.Named: infopatch :: Patchy p => PatchInfo -> FL p x y -> Named p x y
+ Darcs.Patch.Named: instance (Apply p, CommuteNoConflicts p, Conflict p, IsHunk p, PatchListFormat p, PrimPatchBase p, ShowPatch p) => ShowPatch (Named p)
+ Darcs.Patch.Named: instance (Commute p, Invert p) => Invert (Named p)
+ Darcs.Patch.Named: instance (Commute p, MyEq p) => MyEq (Named p)
+ Darcs.Patch.Named: instance (CommuteNoConflicts p, Conflict p) => Conflict (Named p)
+ Darcs.Patch.Named: instance (PatchListFormat p, ShowPatch p) => Show (Named p x y)
+ Darcs.Patch.Named: instance (PatchListFormat p, ShowPatch p) => Show1 (Named p x)
+ Darcs.Patch.Named: instance (PatchListFormat p, ShowPatch p) => Show2 (Named p)
+ Darcs.Patch.Named: instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (Named p)
+ Darcs.Patch.Named: instance (ReadPatch p, PatchListFormat p) => ReadPatch (Named p)
+ Darcs.Patch.Named: instance Apply p => Apply (Named p)
+ Darcs.Patch.Named: instance Check p => Check (Named p)
+ Darcs.Patch.Named: instance Commute p => Commute (Named p)
+ Darcs.Patch.Named: instance Effect p => Effect (Named p)
+ Darcs.Patch.Named: instance IsHunk (Named p)
+ Darcs.Patch.Named: instance Merge p => Merge (Named p)
+ Darcs.Patch.Named: instance PatchInspect p => PatchInspect (Named p)
+ Darcs.Patch.Named: instance PatchListFormat (Named p)
+ Darcs.Patch.Named: instance PrimPatchBase p => PrimPatchBase (Named p)
+ Darcs.Patch.Named: instance RepairToFL p => Repair (Named p)
+ Darcs.Patch.Named: namepatch :: Patchy p => String -> String -> String -> [String] -> FL p x y -> IO (Named p x y)
+ Darcs.Patch.Named: patch2patchinfo :: Named p x y -> PatchInfo
+ Darcs.Patch.Named: patchcontents :: Named p x y -> FL p x y
+ Darcs.Patch.Named: patchname :: Named p x y -> String
+ Darcs.Patch.PatchInfoAnd: actually :: a x y -> Hopefully a x y
+ Darcs.Patch.PatchInfoAnd: compareWPatchInfo :: WPatchInfo a b -> WPatchInfo c d -> EqCheck (a, b) (c, d)
+ Darcs.Patch.PatchInfoAnd: conscientiously :: (Doc -> Doc) -> PatchInfoAnd p a b -> Named p a b
+ Darcs.Patch.PatchInfoAnd: createHashed :: String -> (String -> IO (Sealed (a x))) -> IO (Sealed (Hopefully a x))
+ Darcs.Patch.PatchInfoAnd: data Hopefully a x y
+ Darcs.Patch.PatchInfoAnd: data PatchInfoAnd p a b
+ Darcs.Patch.PatchInfoAnd: data WPatchInfo a b
+ Darcs.Patch.PatchInfoAnd: extractHash :: PatchInfoAnd p a b -> Either (Named p a b) String
+ Darcs.Patch.PatchInfoAnd: fmapFL_PIAP :: (FL p x y -> FL q x y) -> PatchInfoAnd p x y -> PatchInfoAnd q x y
+ Darcs.Patch.PatchInfoAnd: fmapPIAP :: (forall a b. p a b -> q a b) -> PatchInfoAnd p x y -> PatchInfoAnd q x y
+ Darcs.Patch.PatchInfoAnd: hopefully :: PatchInfoAnd p a b -> Named p a b
+ Darcs.Patch.PatchInfoAnd: hopefullyM :: Monad m => PatchInfoAnd p a b -> m (Named p a b)
+ Darcs.Patch.PatchInfoAnd: info :: PatchInfoAnd p a b -> PatchInfo
+ Darcs.Patch.PatchInfoAnd: instance (Apply p, Conflict p, CommuteNoConflicts p, IsHunk p, PatchListFormat p, PrimPatchBase p, ShowPatch p) => ShowPatch (PatchInfoAnd p)
+ Darcs.Patch.PatchInfoAnd: instance (Commute p, Invert p) => Invert (PatchInfoAnd p)
+ Darcs.Patch.PatchInfoAnd: instance (Commute p, MyEq p) => MyEq (PatchInfoAnd p)
+ Darcs.Patch.PatchInfoAnd: instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (PatchInfoAnd p)
+ Darcs.Patch.PatchInfoAnd: instance (ReadPatch p, PatchListFormat p) => ReadPatch (PatchInfoAnd p)
+ Darcs.Patch.PatchInfoAnd: instance Apply p => Apply (PatchInfoAnd p)
+ Darcs.Patch.PatchInfoAnd: instance Commute p => Commute (PatchInfoAnd p)
+ Darcs.Patch.PatchInfoAnd: instance Effect p => Effect (PatchInfoAnd p)
+ Darcs.Patch.PatchInfoAnd: instance IsHunk (PatchInfoAnd p)
+ Darcs.Patch.PatchInfoAnd: instance Merge p => Merge (PatchInfoAnd p)
+ Darcs.Patch.PatchInfoAnd: instance MyEq WPatchInfo
+ Darcs.Patch.PatchInfoAnd: instance PatchInspect p => PatchInspect (PatchInfoAnd p)
+ Darcs.Patch.PatchInfoAnd: instance PatchListFormat (PatchInfoAnd p)
+ Darcs.Patch.PatchInfoAnd: instance PrimPatchBase p => PrimPatchBase (PatchInfoAnd p)
+ Darcs.Patch.PatchInfoAnd: instance RepairToFL p => Repair (PatchInfoAnd p)
+ Darcs.Patch.PatchInfoAnd: instance RepoPatch p => Patchy (PatchInfoAnd p)
+ Darcs.Patch.PatchInfoAnd: n2pia :: Named p x y -> PatchInfoAnd p x y
+ Darcs.Patch.PatchInfoAnd: patchDesc :: PatchInfoAnd p x y -> String
+ Darcs.Patch.PatchInfoAnd: patchInfoAndPatch :: PatchInfo -> Hopefully (Named p) a b -> PatchInfoAnd p a b
+ Darcs.Patch.PatchInfoAnd: piap :: PatchInfo -> Named p a b -> PatchInfoAnd p a b
+ Darcs.Patch.PatchInfoAnd: unWPatchInfo :: WPatchInfo a b -> PatchInfo
+ Darcs.Patch.PatchInfoAnd: unavailable :: String -> Hopefully a x y
+ Darcs.Patch.PatchInfoAnd: winfo :: PatchInfoAnd p a b -> WPatchInfo a b
+ Darcs.Patch.Patchy: class PatchInspect p
+ Darcs.Patch.Patchy: summaryFL :: ShowPatch p => FL p x y -> Doc
+ Darcs.Patch.Patchy.Instances: instance (IsHunk p, PatchListFormat p, Patchy p) => Patchy (FL p)
+ Darcs.Patch.Patchy.Instances: instance (IsHunk p, PatchListFormat p, Patchy p) => Patchy (RL p)
+ Darcs.Patch.Permutations: commuterFLId :: CommuteFn p1 p2 -> CommuteFn (FL p1) p2
+ Darcs.Patch.Permutations: commuterIdFL :: CommuteFn p1 p2 -> CommuteFn p1 (FL p2)
+ Darcs.Patch.Prim: applyPrimFL :: (PrimApply prim, ApplyMonad m) => FL prim x y -> m ()
+ Darcs.Patch.Prim: class (Patchy prim, PatchListFormat prim, IsHunk prim, RepairToFL prim, PrimConstruct prim, PrimCanonize prim, PrimClassify prim, PrimDetails prim, PrimShow prim, PrimRead prim, PrimApply prim) => PrimPatch prim
+ Darcs.Patch.Prim: class PrimPatch (PrimOf p) => PrimPatchBase p where { type family PrimOf p :: (* -> * -> *) :: * -> * -> *; }
+ Darcs.Patch.Prim: primFromHunk :: PrimConstruct prim => FileHunk x y -> prim x y
+ Darcs.Patch.Prim: readPrim :: (PrimRead prim, ParserM m) => FileNameFormat -> m (Sealed (prim x))
+ Darcs.Patch.Prim: summarizePrim :: PrimDetails prim => prim x y -> [SummDetail]
+ Darcs.Patch.Prim.Class: adddir :: PrimConstruct prim => FilePath -> prim x y
+ Darcs.Patch.Prim.Class: addfile :: PrimConstruct prim => FilePath -> prim x y
+ Darcs.Patch.Prim.Class: applyPrimFL :: (PrimApply prim, ApplyMonad m) => FL prim x y -> m ()
+ Darcs.Patch.Prim.Class: binary :: PrimConstruct prim => FilePath -> ByteString -> ByteString -> prim x y
+ Darcs.Patch.Prim.Class: canonize :: PrimCanonize prim => prim x y -> FL prim x y
+ Darcs.Patch.Prim.Class: canonizeFL :: PrimCanonize prim => FL prim x y -> FL prim x y
+ Darcs.Patch.Prim.Class: changepref :: PrimConstruct prim => String -> String -> String -> prim x y
+ Darcs.Patch.Prim.Class: class FromPrim p
+ Darcs.Patch.Prim.Class: class FromPrims p
+ Darcs.Patch.Prim.Class: class PrimApply prim
+ Darcs.Patch.Prim.Class: class PrimCanonize prim
+ Darcs.Patch.Prim.Class: class PrimClassify prim
+ Darcs.Patch.Prim.Class: class PrimConstruct prim
+ Darcs.Patch.Prim.Class: class PrimDetails prim
+ Darcs.Patch.Prim.Class: class (Patchy prim, PatchListFormat prim, IsHunk prim, RepairToFL prim, PrimConstruct prim, PrimCanonize prim, PrimClassify prim, PrimDetails prim, PrimShow prim, PrimRead prim, PrimApply prim) => PrimPatch prim
+ Darcs.Patch.Prim.Class: class PrimPatch (PrimOf p) => PrimPatchBase p where { type family PrimOf p :: (* -> * -> *) :: * -> * -> *; }
+ Darcs.Patch.Prim.Class: class PrimRead prim
+ Darcs.Patch.Prim.Class: class PrimShow prim
+ Darcs.Patch.Prim.Class: class FromPrim p => ToFromPrim p
+ Darcs.Patch.Prim.Class: fromPrim :: FromPrim p => PrimOf p x y -> p x y
+ Darcs.Patch.Prim.Class: fromPrims :: FromPrims p => FL (PrimOf p) x y -> p x y
+ Darcs.Patch.Prim.Class: hunk :: PrimConstruct prim => FilePath -> Int -> [ByteString] -> [ByteString] -> prim x y
+ Darcs.Patch.Prim.Class: instance FromPrim p => FromPrim (FL p)
+ Darcs.Patch.Prim.Class: instance FromPrim p => FromPrims (FL p)
+ Darcs.Patch.Prim.Class: instance FromPrim p => FromPrims (RL p)
+ Darcs.Patch.Prim.Class: instance PrimPatchBase p => PrimPatchBase (FL p)
+ Darcs.Patch.Prim.Class: instance PrimPatchBase p => PrimPatchBase (RL p)
+ Darcs.Patch.Prim.Class: is_filepatch :: PrimClassify prim => prim x y -> Maybe FileName
+ Darcs.Patch.Prim.Class: join :: PrimCanonize prim => (prim :> prim) x y -> Maybe (FL prim x y)
+ Darcs.Patch.Prim.Class: joinPatches :: FromPrims p => FL p x y -> p x y
+ Darcs.Patch.Prim.Class: move :: PrimConstruct prim => FilePath -> FilePath -> prim x y
+ Darcs.Patch.Prim.Class: primFromHunk :: PrimConstruct prim => FileHunk x y -> prim x y
+ Darcs.Patch.Prim.Class: primIsAdddir :: PrimClassify prim => prim x y -> Bool
+ Darcs.Patch.Prim.Class: primIsAddfile :: PrimClassify prim => prim x y -> Bool
+ Darcs.Patch.Prim.Class: primIsBinary :: PrimClassify prim => prim x y -> Bool
+ Darcs.Patch.Prim.Class: primIsHunk :: PrimClassify prim => prim x y -> Bool
+ Darcs.Patch.Prim.Class: primIsSetpref :: PrimClassify prim => prim x y -> Bool
+ Darcs.Patch.Prim.Class: readPrim :: (PrimRead prim, ParserM m) => FileNameFormat -> m (Sealed (prim x))
+ Darcs.Patch.Prim.Class: rmdir :: PrimConstruct prim => FilePath -> prim x y
+ Darcs.Patch.Prim.Class: rmfile :: PrimConstruct prim => FilePath -> prim x y
+ Darcs.Patch.Prim.Class: showPrim :: PrimShow prim => FileNameFormat -> prim a b -> Doc
+ Darcs.Patch.Prim.Class: showPrimFL :: PrimShow prim => FileNameFormat -> FL prim a b -> Doc
+ Darcs.Patch.Prim.Class: sortCoalesceFL :: PrimCanonize prim => FL prim x y -> FL prim x y
+ Darcs.Patch.Prim.Class: summarizePrim :: PrimDetails prim => prim x y -> [SummDetail]
+ Darcs.Patch.Prim.Class: toPrim :: ToFromPrim p => p x y -> Maybe (PrimOf p x y)
+ Darcs.Patch.Prim.Class: tokreplace :: PrimConstruct prim => FilePath -> String -> String -> String -> prim x y
+ Darcs.Patch.Prim.Class: tryShrinkingInverse :: PrimCanonize prim => FL prim x y -> Maybe (FL prim x y)
+ Darcs.Patch.Prim.Class: tryToShrink :: PrimCanonize prim => FL prim x y -> FL prim x y
+ Darcs.Patch.Prim.V1: data Prim x y
+ Darcs.Patch.Prim.V1: instance Patchy Prim
+ Darcs.Patch.Prim.V1: instance PrimPatch Prim
+ Darcs.Patch.Prim.V1.Apply: instance Apply Prim
+ Darcs.Patch.Prim.V1.Apply: instance PrimApply Prim
+ Darcs.Patch.Prim.V1.Apply: instance RepairToFL Prim
+ Darcs.Patch.Prim.V1.Coalesce: instance PrimCanonize Prim
+ Darcs.Patch.Prim.V1.Coalesce: instance Show (Simple x y)
+ Darcs.Patch.Prim.V1.Commute: Failed :: Perhaps a
+ Darcs.Patch.Prim.V1.Commute: Succeeded :: a -> Perhaps a
+ Darcs.Patch.Prim.V1.Commute: Unknown :: Perhaps a
+ Darcs.Patch.Prim.V1.Commute: WrappedCommuteFunction :: CommuteFunction -> WrappedCommuteFunction
+ Darcs.Patch.Prim.V1.Commute: data Perhaps a
+ Darcs.Patch.Prim.V1.Commute: instance Commute Prim
+ Darcs.Patch.Prim.V1.Commute: instance Monad Perhaps
+ Darcs.Patch.Prim.V1.Commute: instance MonadPlus Perhaps
+ Darcs.Patch.Prim.V1.Commute: newtype WrappedCommuteFunction
+ Darcs.Patch.Prim.V1.Commute: runWrappedCommuteFunction :: WrappedCommuteFunction -> CommuteFunction
+ Darcs.Patch.Prim.V1.Commute: subcommutes :: [(String, WrappedCommuteFunction)]
+ Darcs.Patch.Prim.V1.Core: AddDir :: DirPatchType x y
+ Darcs.Patch.Prim.V1.Core: AddFile :: FilePatchType x y
+ Darcs.Patch.Prim.V1.Core: Binary :: ByteString -> ByteString -> FilePatchType x y
+ Darcs.Patch.Prim.V1.Core: ChangePref :: !String -> !String -> !String -> Prim x y
+ Darcs.Patch.Prim.V1.Core: DP :: !FileName -> !DirPatchType x y -> Prim x y
+ Darcs.Patch.Prim.V1.Core: FP :: !FileName -> !FilePatchType x y -> Prim x y
+ Darcs.Patch.Prim.V1.Core: Hunk :: !Int -> [ByteString] -> [ByteString] -> FilePatchType x y
+ Darcs.Patch.Prim.V1.Core: Move :: !FileName -> !FileName -> Prim x y
+ Darcs.Patch.Prim.V1.Core: RmDir :: DirPatchType x y
+ Darcs.Patch.Prim.V1.Core: RmFile :: FilePatchType x y
+ Darcs.Patch.Prim.V1.Core: TokReplace :: !String -> !String -> !String -> FilePatchType x y
+ Darcs.Patch.Prim.V1.Core: comparePrim :: Prim x y -> Prim w z -> Ordering
+ Darcs.Patch.Prim.V1.Core: data DirPatchType x y
+ Darcs.Patch.Prim.V1.Core: data FilePatchType x y
+ Darcs.Patch.Prim.V1.Core: data Prim x y
+ Darcs.Patch.Prim.V1.Core: instance Eq (DirPatchType x y)
+ Darcs.Patch.Prim.V1.Core: instance Eq (FilePatchType x y)
+ Darcs.Patch.Prim.V1.Core: instance Eq (Prim x y)
+ Darcs.Patch.Prim.V1.Core: instance Invert Prim
+ Darcs.Patch.Prim.V1.Core: instance IsHunk Prim
+ Darcs.Patch.Prim.V1.Core: instance MyEq DirPatchType
+ Darcs.Patch.Prim.V1.Core: instance MyEq FilePatchType
+ Darcs.Patch.Prim.V1.Core: instance MyEq Prim
+ Darcs.Patch.Prim.V1.Core: instance Ord (DirPatchType x y)
+ Darcs.Patch.Prim.V1.Core: instance Ord (FilePatchType x y)
+ Darcs.Patch.Prim.V1.Core: instance PatchInspect Prim
+ Darcs.Patch.Prim.V1.Core: instance PrimClassify Prim
+ Darcs.Patch.Prim.V1.Core: instance PrimConstruct Prim
+ Darcs.Patch.Prim.V1.Core: isIdentity :: Prim x y -> EqCheck x y
+ Darcs.Patch.Prim.V1.Details: instance PrimDetails Prim
+ Darcs.Patch.Prim.V1.Read: instance PrimRead Prim
+ Darcs.Patch.Prim.V1.Read: instance ReadPatch Prim
+ Darcs.Patch.Prim.V1.Show: instance PatchListFormat Prim
+ Darcs.Patch.Prim.V1.Show: instance PrimShow Prim
+ Darcs.Patch.Prim.V1.Show: instance Show (DirPatchType x y)
+ Darcs.Patch.Prim.V1.Show: instance Show (FilePatchType x y)
+ Darcs.Patch.Prim.V1.Show: instance Show (Prim x y)
+ Darcs.Patch.Prim.V1.Show: instance Show1 (Prim x)
+ Darcs.Patch.Prim.V1.Show: instance Show2 Prim
+ Darcs.Patch.Prim.V1.Show: instance ShowPatch Prim
+ Darcs.Patch.Prim.V1.Show: instance ShowPatchBasic Prim
+ Darcs.Patch.Prim.V1.Show: showHunk :: FileNameFormat -> FileName -> Int -> [ByteString] -> [ByteString] -> Doc
+ Darcs.Patch.Read: bracketedFL :: ParserM m => (forall y. m (Sealed (p y))) -> Char -> Char -> m (Sealed (FL p x))
+ Darcs.Patch.Read: class ReadPatch p
+ Darcs.Patch.Read: instance (ReadPatch p, PatchListFormat p) => ReadPatch (FL p)
+ Darcs.Patch.Read: instance (ReadPatch p, PatchListFormat p) => ReadPatch (RL p)
+ Darcs.Patch.Read: instance ReadPatch p => ReadPatch (Bracketed p)
+ Darcs.Patch.Read: peekfor :: ParserM m => ByteString -> m a -> m a -> m a
+ Darcs.Patch.Read: readFileName :: FileNameFormat -> ByteString -> FileName
+ Darcs.Patch.Read: readPatch' :: (ReadPatch p, ParserM m) => m (Sealed (p x))
+ Darcs.Patch.Read: readPatchPartial :: ReadPatch p => ByteString -> Maybe (Sealed (p x), ByteString)
+ Darcs.Patch.ReadMonads: anyChar :: ParserM m => m Char
+ Darcs.Patch.ReadMonads: char :: ParserM m => Char -> m ()
+ Darcs.Patch.ReadMonads: checkConsumes :: ParserM m => m a -> m a
+ Darcs.Patch.ReadMonads: choice :: Alternative f => [f a] -> f a
+ Darcs.Patch.ReadMonads: endOfInput :: ParserM m => m ()
+ Darcs.Patch.ReadMonads: instance Alternative SM
+ Darcs.Patch.ReadMonads: instance Applicative SM
+ Darcs.Patch.ReadMonads: instance Functor SM
+ Darcs.Patch.ReadMonads: instance MonadPlus SM
+ Darcs.Patch.ReadMonads: int :: ParserM m => m Int
+ Darcs.Patch.ReadMonads: linesStartingWith :: ParserM m => Char -> m [ByteString]
+ Darcs.Patch.ReadMonads: linesStartingWithEndingWith :: ParserM m => Char -> Char -> m [ByteString]
+ Darcs.Patch.ReadMonads: myLex' :: ParserM m => m ByteString
+ Darcs.Patch.ReadMonads: option :: Alternative f => a -> f a -> f a
+ Darcs.Patch.ReadMonads: parse :: ParserM m => m a -> ByteString -> Maybe (a, ByteString)
+ Darcs.Patch.ReadMonads: skipSpace :: ParserM m => m ()
+ Darcs.Patch.ReadMonads: skipWhile :: ParserM m => (Char -> Bool) -> m ()
+ Darcs.Patch.ReadMonads: string :: ParserM m => ByteString -> m ()
+ Darcs.Patch.ReadMonads: take :: ParserM m => Int -> m ByteString
+ Darcs.Patch.ReadMonads: takeTill :: ParserM m => (Char -> Bool) -> m ByteString
+ Darcs.Patch.ReadMonads: takeTillChar :: ParserM m => Char -> m ByteString
+ Darcs.Patch.Repair: applyAndTryToFix :: (Repair p, ApplyMonad m) => p x y -> m (Maybe (String, p x y))
+ Darcs.Patch.Repair: applyAndTryToFixFL :: (RepairToFL p, ApplyMonad m) => p x y -> m (Maybe (String, FL p x y))
+ Darcs.Patch.Repair: class Check p
+ Darcs.Patch.Repair: class Repair p
+ Darcs.Patch.Repair: class Apply p => RepairToFL p
+ Darcs.Patch.Repair: instance Check p => Check (FL p)
+ Darcs.Patch.Repair: instance Check p => Check (RL p)
+ Darcs.Patch.Repair: instance RepairToFL p => Repair (FL p)
+ Darcs.Patch.Repair: isInconsistent :: Check p => p x y -> Maybe Doc
+ Darcs.Patch.Repair: mapMaybeSnd :: (a -> b) -> Maybe (c, a) -> Maybe (c, b)
+ Darcs.Patch.RepoPatch: class (Patchy p, Merge p, Effect p, IsHunk p, FromPrim p, Conflict p, CommuteNoConflicts p, Check p, RepairToFL p, PatchListFormat p, PrimPatchBase p, Patchy (PrimOf p), IsHunk (PrimOf p)) => RepoPatch p
+ Darcs.Patch.Set: appendPSFL :: PatchSet p start x -> FL (PatchInfoAnd p) x y -> PatchSet p start y
+ Darcs.Patch.Show: class ShowPatchBasic p => ShowPatch p
+ Darcs.Patch.Show: class ShowPatchBasic p
+ Darcs.Patch.Show: description :: ShowPatch p => p x y -> Doc
+ Darcs.Patch.Show: formatFileName :: FileNameFormat -> FileName -> Doc
+ Darcs.Patch.Show: gzWritePatch :: ShowPatchBasic p => FilePath -> p x y -> IO ()
+ Darcs.Patch.Show: showContextPatch :: ShowPatch p => p x y -> TreeIO Doc
+ Darcs.Patch.Show: showNicely :: ShowPatch p => p x y -> Doc
+ Darcs.Patch.Show: showPatch :: ShowPatchBasic p => p x y -> Doc
+ Darcs.Patch.Show: summary :: ShowPatch p => p x y -> Doc
+ Darcs.Patch.Show: summaryFL :: ShowPatch p => FL p x y -> Doc
+ Darcs.Patch.Show: thing :: ShowPatch p => p x y -> String
+ Darcs.Patch.Show: things :: ShowPatch p => p x y -> String
+ Darcs.Patch.Show: writePatch :: ShowPatchBasic p => FilePath -> p x y -> IO ()
+ Darcs.Patch.Split: reversePrimSplitter :: PrimPatch prim => Splitter prim
+ Darcs.Patch.Summary: instance Eq SummChunk
+ Darcs.Patch.Summary: instance Ord SummChunk
+ Darcs.Patch.Summary: plainSummary :: (Conflict e, Effect e, PrimPatchBase e) => e x y -> Doc
+ Darcs.Patch.Summary: plainSummaryPrim :: PrimDetails prim => prim x y -> Doc
+ Darcs.Patch.Summary: plainSummaryPrims :: PrimDetails prim => FL prim x y -> Doc
+ Darcs.Patch.Summary: xmlSummary :: (Effect p, Conflict p, PrimPatchBase p) => p x y -> Doc
+ Darcs.Patch.SummaryData: SummAdd :: SummOp
+ Darcs.Patch.SummaryData: SummAddDir :: FileName -> SummDetail
+ Darcs.Patch.SummaryData: SummFile :: SummOp -> FileName -> Int -> Int -> Int -> SummDetail
+ Darcs.Patch.SummaryData: SummMod :: SummOp
+ Darcs.Patch.SummaryData: SummMv :: FileName -> FileName -> SummDetail
+ Darcs.Patch.SummaryData: SummNone :: SummDetail
+ Darcs.Patch.SummaryData: SummRm :: SummOp
+ Darcs.Patch.SummaryData: SummRmDir :: FileName -> SummDetail
+ Darcs.Patch.SummaryData: data SummDetail
+ Darcs.Patch.SummaryData: data SummOp
+ Darcs.Patch.SummaryData: instance Eq SummDetail
+ Darcs.Patch.SummaryData: instance Eq SummOp
+ Darcs.Patch.SummaryData: instance Ord SummDetail
+ Darcs.Patch.SummaryData: instance Ord SummOp
+ Darcs.Patch.TokenReplace: forceTokReplace :: String -> String -> String -> ByteString -> Maybe ByteString
+ Darcs.Patch.TokenReplace: tryTokInternal :: String -> ByteString -> ByteString -> ByteString -> Maybe [ByteString]
+ Darcs.Patch.V1: data Patch prim x y
+ Darcs.Patch.V1: instance PrimPatch prim => Patchy (Patch prim)
+ Darcs.Patch.V1: instance PrimPatch prim => RepoPatch (Patch prim)
+ Darcs.Patch.V1.Apply: instance PrimPatch prim => Apply (Patch prim)
+ Darcs.Patch.V1.Apply: instance PrimPatch prim => RepairToFL (Patch prim)
+ Darcs.Patch.V1.Commute: instance Invert prim => Invert (Patch prim)
+ Darcs.Patch.V1.Commute: instance IsHunk prim => IsHunk (Patch prim)
+ Darcs.Patch.V1.Commute: instance Monad Perhaps
+ Darcs.Patch.V1.Commute: instance MonadPlus Perhaps
+ Darcs.Patch.V1.Commute: instance MyEq prim => Eq (Patch prim x y)
+ Darcs.Patch.V1.Commute: instance MyEq prim => MyEq (Patch prim)
+ Darcs.Patch.V1.Commute: instance PrimPatch prim => Commute (Patch prim)
+ Darcs.Patch.V1.Commute: instance PrimPatch prim => CommuteNoConflicts (Patch prim)
+ Darcs.Patch.V1.Commute: instance PrimPatch prim => Conflict (Patch prim)
+ Darcs.Patch.V1.Commute: instance PrimPatch prim => Effect (Patch prim)
+ Darcs.Patch.V1.Commute: instance PrimPatch prim => Merge (Patch prim)
+ Darcs.Patch.V1.Commute: instance PrimPatch prim => PatchInspect (Patch prim)
+ Darcs.Patch.V1.Commute: merge :: Merge p => (p :\/: p) x y -> (p :/\: p) x y
+ Darcs.Patch.V1.Commute: merger :: PrimPatch prim => String -> Patch prim x y -> Patch prim x z -> Sealed (Patch prim y)
+ Darcs.Patch.V1.Commute: publicUnravel :: PrimPatch prim => Patch prim x y -> [Sealed (FL prim y)]
+ Darcs.Patch.V1.Commute: unravel :: PrimPatch prim => Patch prim x y -> [Sealed (FL prim x)]
+ Darcs.Patch.V1.Core: Merger :: FL (Patch prim) x y -> RL (Patch prim) x b -> Patch prim c b -> Patch prim c d -> Patch prim x y
+ Darcs.Patch.V1.Core: PP :: prim x y -> Patch prim x y
+ Darcs.Patch.V1.Core: Regrem :: FL (Patch prim) x y -> RL (Patch prim) x b -> Patch prim c b -> Patch prim c a -> Patch prim y x
+ Darcs.Patch.V1.Core: data Patch prim x y
+ Darcs.Patch.V1.Core: instance Check (Patch prim)
+ Darcs.Patch.V1.Core: instance FromPrim (Patch prim)
+ Darcs.Patch.V1.Core: instance PatchListFormat (Patch prim)
+ Darcs.Patch.V1.Core: instance PrimPatch prim => PrimPatchBase (Patch prim)
+ Darcs.Patch.V1.Core: isMerger :: Patch prim a b -> Bool
+ Darcs.Patch.V1.Core: mergerUndo :: Patch prim x y -> FL (Patch prim) x y
+ Darcs.Patch.V1.Read: instance PrimPatch prim => ReadPatch (Patch prim)
+ Darcs.Patch.V1.Show: instance PrimPatch prim => Show (Patch prim x y)
+ Darcs.Patch.V1.Show: instance PrimPatch prim => Show1 (Patch prim x)
+ Darcs.Patch.V1.Show: instance PrimPatch prim => Show2 (Patch prim)
+ Darcs.Patch.V1.Show: showPatch_ :: PrimPatch prim => Patch prim a b -> Doc
+ Darcs.Patch.V1.Viewing: instance PrimPatch prim => ShowPatch (Patch prim)
+ Darcs.Patch.V1.Viewing: instance PrimPatch prim => ShowPatchBasic (Patch prim)
+ Darcs.Patch.V2: data RealPatch prim x y
+ Darcs.Patch.V2: instance PrimPatch prim => RepoPatch (RealPatch prim)
+ Darcs.Patch.V2: prim2real :: prim x y -> RealPatch prim x y
+ Darcs.Patch.V2.Non: (*>) :: (Patchy p, ToFromPrim p) => Non p x -> p x y -> Maybe (Non p y)
+ Darcs.Patch.V2.Non: (*>>) :: (WL l, Patchy p, ToFromPrim p, PrimPatchBase p) => Non p x -> l (PrimOf p) x y -> Maybe (Non p y)
+ Darcs.Patch.V2.Non: (>*) :: (Patchy p, ToFromPrim p) => p x y -> Non p y -> Maybe (Non p x)
+ Darcs.Patch.V2.Non: (>>*) :: (WL l, Patchy p, ToFromPrim p) => l (PrimOf p) x y -> Non p y -> Maybe (Non p x)
+ Darcs.Patch.V2.Non: Non :: FL p a x -> PrimOf p x y -> Non p a
+ Darcs.Patch.V2.Non: add :: (WL l, Patchy p, ToFromPrim p) => l (PrimOf p) x y -> Non p y -> Non p x
+ Darcs.Patch.V2.Non: addP :: (Patchy p, ToFromPrim p) => p x y -> Non p y -> Non p x
+ Darcs.Patch.V2.Non: addPs :: (Patchy p, ToFromPrim p) => RL p x y -> Non p y -> Non p x
+ Darcs.Patch.V2.Non: class Nonable p
+ Darcs.Patch.V2.Non: data Non p x
+ Darcs.Patch.V2.Non: instance (Commute p, MyEq p, MyEq (PrimOf p)) => Eq (Non p x)
+ Darcs.Patch.V2.Non: instance (Show2 p, Show2 (PrimOf p)) => Show (Non p x)
+ Darcs.Patch.V2.Non: instance (Show2 p, Show2 (PrimOf p)) => Show1 (Non p)
+ Darcs.Patch.V2.Non: instance WL FL
+ Darcs.Patch.V2.Non: instance WL RL
+ Darcs.Patch.V2.Non: non :: Nonable p => p x y -> Non p x
+ Darcs.Patch.V2.Non: propAdjustTwice :: (Patchy p, ToFromPrim p, MyEq (PrimOf p)) => p x y -> Non p y -> Maybe Doc
+ Darcs.Patch.V2.Non: readNon :: (ReadPatch p, PatchListFormat p, PrimPatchBase p, ParserM m) => m (Non p x)
+ Darcs.Patch.V2.Non: readNons :: (ReadPatch p, PatchListFormat p, PrimPatchBase p, ParserM m) => m [Non p x]
+ Darcs.Patch.V2.Non: remNons :: (Nonable p, Effect p, Patchy p, ToFromPrim p, PrimPatchBase p, MyEq (PrimOf p)) => [Non p x] -> Non p x -> Non p x
+ Darcs.Patch.V2.Non: remP :: (Patchy p, ToFromPrim p) => p x y -> Non p x -> Maybe (Non p y)
+ Darcs.Patch.V2.Non: remPs :: (Patchy p, ToFromPrim p) => FL p x y -> Non p x -> Maybe (Non p y)
+ Darcs.Patch.V2.Non: showNon :: (ShowPatchBasic p, PatchListFormat p, PrimPatchBase p) => Non p x -> Doc
+ Darcs.Patch.V2.Non: showNons :: (ShowPatchBasic p, PatchListFormat p, PrimPatchBase p) => [Non p x] -> Doc
+ Darcs.Patch.V2.Non: unNon :: FromPrim p => Non p x -> Sealed (FL p x)
+ Darcs.Patch.V2.Real: Conflictor :: [Non (RealPatch prim) x] -> FL prim x y -> Non (RealPatch prim) x -> RealPatch prim y x
+ Darcs.Patch.V2.Real: Duplicate :: Non (RealPatch prim) x -> RealPatch prim x x
+ Darcs.Patch.V2.Real: Etacilpud :: Non (RealPatch prim) x -> RealPatch prim x x
+ Darcs.Patch.V2.Real: InvConflictor :: [Non (RealPatch prim) x] -> FL prim x y -> Non (RealPatch prim) x -> RealPatch prim x y
+ Darcs.Patch.V2.Real: Normal :: prim x y -> RealPatch prim x y
+ Darcs.Patch.V2.Real: data RealPatch prim x y
+ Darcs.Patch.V2.Real: instance FromPrim (RealPatch prim)
+ Darcs.Patch.V2.Real: instance Invert prim => Invert (RealPatch prim)
+ Darcs.Patch.V2.Real: instance IsHunk prim => IsHunk (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PatchInspect prim => PatchInspect (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PatchListFormat (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PrimPatch prim => Apply (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PrimPatch prim => Check (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PrimPatch prim => Commute (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PrimPatch prim => CommuteNoConflicts (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PrimPatch prim => Conflict (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PrimPatch prim => Effect (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PrimPatch prim => Merge (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PrimPatch prim => MyEq (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PrimPatch prim => Nonable (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PrimPatch prim => Patchy (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PrimPatch prim => PrimPatchBase (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PrimPatch prim => ReadPatch (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PrimPatch prim => RepairToFL (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PrimPatch prim => Show (RealPatch prim x y)
+ Darcs.Patch.V2.Real: instance PrimPatch prim => Show2 (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PrimPatch prim => ShowPatch (RealPatch prim)
+ Darcs.Patch.V2.Real: instance PrimPatch prim => ShowPatchBasic (RealPatch prim)
+ Darcs.Patch.V2.Real: instance ToFromPrim (RealPatch prim)
+ Darcs.Patch.V2.Real: isConsistent :: PrimPatch prim => RealPatch prim x y -> Maybe Doc
+ Darcs.Patch.V2.Real: isDuplicate :: RealPatch prim s y -> Bool
+ Darcs.Patch.V2.Real: isForward :: PrimPatch prim => RealPatch prim s y -> Maybe Doc
+ Darcs.Patch.V2.Real: mergeUnravelled :: PrimPatch prim => [Sealed ((FL prim) x)] -> Maybe (FlippedSeal (RealPatch prim) x)
+ Darcs.Patch.V2.Real: prim2real :: prim x y -> RealPatch prim x y
+ Darcs.Patch.Viewing: instance (Apply p, IsHunk p, PatchListFormat p, ShowPatch p) => ShowPatch (FL p)
+ Darcs.Patch.Viewing: instance (Apply p, IsHunk p, PatchListFormat p, ShowPatch p) => ShowPatch (RL p)
+ Darcs.Patch.Viewing: instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (FL p)
+ Darcs.Patch.Viewing: instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (RL p)
+ Darcs.Patch.Viewing: showContextHunk :: FileHunk x y -> TreeIO Doc
+ Darcs.Patch.Viewing: showContextSeries :: (Apply p, ShowPatch p, IsHunk p) => FL p x y -> TreeIO Doc
+ Darcs.RepoPath: instance CharLike c => FilePathLike [c]
+ Darcs.RepoPath: instance CharLike c => FilePathOrURL [c]
+ Darcs.Repository: RepoJob :: (forall p r u. RepoPatch p => Repository p r u r -> IO a) -> RepoJob a
+ Darcs.Repository: V1Job :: (forall r u. Repository (Patch Prim) r u r -> IO a) -> RepoJob a
+ Darcs.Repository: V2Job :: (forall r u. Repository (RealPatch Prim) r u r -> IO a) -> RepoJob a
+ Darcs.Repository: amInHashedRepository :: [DarcsFlag] -> IO (Either String ())
+ Darcs.Repository: cacheSource :: CacheLoc -> !String
+ Darcs.Repository: cacheType :: CacheLoc -> !CacheType
+ Darcs.Repository: cacheWritable :: CacheLoc -> !WritableOrNot
+ Darcs.Repository: data RepoJob a
+ Darcs.Repository: reportBadSources :: IO ()
+ Darcs.Repository: setScriptsExecutablePatches :: Patchy p => p x y -> IO ()
+ Darcs.Repository.Cache: cacheSource :: CacheLoc -> !String
+ Darcs.Repository.Cache: cacheType :: CacheLoc -> !CacheType
+ Darcs.Repository.Cache: cacheWritable :: CacheLoc -> !WritableOrNot
+ Darcs.Repository.Cache: reportBadSources :: IO ()
+ Darcs.Repository.Format: tryIdentifyRepoFormat :: String -> IO (Either String RepoFormat)
+ Darcs.Repository.HashedIO: RW :: RW
+ Darcs.Repository.HashedIO: data RW
+ Darcs.Repository.HashedIO: instance ApplyMonad (HashedIO p)
+ Darcs.Repository.HashedRepo: listInventories :: IO [String]
+ Darcs.Repository.Internal: RepoJob :: (forall p r u. RepoPatch p => Repository p r u r -> IO a) -> RepoJob a
+ Darcs.Repository.Internal: V1Job :: (forall r u. Repository (Patch Prim) r u r -> IO a) -> RepoJob a
+ Darcs.Repository.Internal: V2Job :: (forall r u. Repository (RealPatch Prim) r u r -> IO a) -> RepoJob a
+ Darcs.Repository.Internal: amInHashedRepository :: [DarcsFlag] -> IO (Either String ())
+ Darcs.Repository.Internal: data RepoJob a
+ Darcs.Repository.Internal: identifyDarcsRepository :: [DarcsFlag] -> String -> IO (Repository p r u t)
+ Darcs.Repository.Internal: instance Functor (RIO p r u t t)
+ Darcs.Repository.Internal: instance Monad (RIO p r u t t)
+ Darcs.Repository.Internal: seekRepo :: IO (Maybe (Either String ()))
+ Darcs.Repository.Internal: setScriptsExecutablePatches :: Patchy p => p x y -> IO ()
+ Darcs.Repository.InternalTypes: instance Eq Pristine
+ Darcs.Repository.InternalTypes: instance Show (Repository p recordedstate unrecordedstate tentativestate)
+ Darcs.Repository.LowLevel: instance ReadPatch p => ReadPatch (FLM p)
+ Darcs.Repository.LowLevel: instance ShowPatchBasic p => ShowPatchBasic (FLM p)
+ Darcs.Repository.LowLevel: readNewPending :: RepoPatch p => Repository p r u t -> IO (Sealed (FL (PrimOf p) t))
+ Darcs.Repository.LowLevel: readTentativePending :: RepoPatch p => Repository p r u t -> IO (Sealed (FL (PrimOf p) t))
+ Darcs.Repository.LowLevel: writeNewPending :: RepoPatch p => Repository p r u t -> FL (PrimOf p) t y -> IO ()
+ Darcs.Repository.LowLevel: writeTentativePending :: RepoPatch p => Repository p r u t -> FL (PrimOf p) t y -> IO ()
+ Darcs.Repository.Old: oldRepoFailMsg :: String
+ Darcs.Repository.Old: readOldRepo :: RepoPatch p => String -> IO (SealedPatchSet p Origin)
+ Darcs.Repository.Old: revertTentativeChanges :: IO ()
+ Darcs.Repository.Prefs: boringFileHelp :: [String]
+ Darcs.Repository.Prefs: globalPrefsDirDoc :: String
+ Darcs.Repository.State: IgnoreIndex :: UseIndex
+ Darcs.Repository.State: ScanAll :: ScanKnown
+ Darcs.Repository.State: ScanKnown :: ScanKnown
+ Darcs.Repository.State: UseIndex :: UseIndex
+ Darcs.Repository.State: data ScanKnown
+ Darcs.Repository.State: data UseIndex
+ Darcs.URL: data SshFilePath
+ Darcs.URL: isHttpUrl :: String -> Bool
+ Darcs.URL: isSshUrl :: String -> Bool
+ Darcs.URL: splitSshUrl :: String -> SshFilePath
+ Darcs.URL: sshFile :: SshFilePath -> String
+ Darcs.URL: sshRepo :: SshFilePath -> String
+ Darcs.URL: sshUhost :: SshFilePath -> String
+ Darcs.URL: urlOf :: SshFilePath -> String
+ Darcs.Utils: askUserListItem :: String -> [String] -> IO String
+ Darcs.Witnesses.Eq: (=/\=) :: MyEq p => p a c -> p b c -> EqCheck a b
+ Darcs.Witnesses.Eq: (=\/=) :: MyEq p => p a b -> p a c -> EqCheck b c
+ Darcs.Witnesses.Eq: IsEq :: EqCheck a a
+ Darcs.Witnesses.Eq: NotEq :: EqCheck a b
+ Darcs.Witnesses.Eq: class MyEq p
+ Darcs.Witnesses.Eq: data EqCheck a b
+ Darcs.Witnesses.Eq: instance Eq (EqCheck a b)
+ Darcs.Witnesses.Eq: instance Show (EqCheck a b)
+ Darcs.Witnesses.Eq: isIsEq :: EqCheck a b -> Bool
+ Darcs.Witnesses.Eq: unsafeCompare :: MyEq p => p a b -> p c d -> Bool
+ Darcs.Witnesses.Ordered: dropWhileFL :: (forall x y. a x y -> Bool) -> FL a r v -> FlippedSeal (FL a) v
+ Darcs.Witnesses.Ordered: dropWhileRL :: (forall x y. a x y -> Bool) -> RL a r v -> Sealed (RL a r)
+ Darcs.Witnesses.Ordered: eqFL :: MyEq a => FL a x y -> FL a x z -> EqCheck y z
+ Darcs.Witnesses.Ordered: eqFLRev :: MyEq a => FL a x z -> FL a y z -> EqCheck x y
+ Darcs.Witnesses.Ordered: eqFLUnsafe :: MyEq a => FL a x y -> FL a z w -> Bool
+ Darcs.Witnesses.Ordered: instance (MyEq a, MyEq b) => Eq ((:<) a b x y)
+ Darcs.Witnesses.Ordered: instance (MyEq a, MyEq b) => Eq ((:>) a b x y)
+ Darcs.Witnesses.Ordered: instance (Show2 a, Show2 b) => Show ((:>) a b x y)
+ Darcs.Witnesses.Ordered: instance (Show2 a, Show2 b) => Show ((:\/:) a b x y)
+ Darcs.Witnesses.Ordered: instance Show2 a => Show (FL a x z)
+ Darcs.Witnesses.Ordered: instance Show2 a => Show (RL a x z)
+ Darcs.Witnesses.Ordered: instance Show2 a => Show1 (FL a x)
+ Darcs.Witnesses.Ordered: instance Show2 a => Show1 (RL a x)
+ Darcs.Witnesses.Ordered: instance Show2 a => Show2 (FL a)
+ Darcs.Witnesses.Ordered: instance Show2 a => Show2 (RL a)
+ Darcs.Witnesses.Sealed: instance MyEq a => Eq (Sealed (a x))
+ Darcs.Witnesses.Sealed: instance Show1 a => Show (Sealed a)
+ Darcs.Witnesses.Sealed: instance Show2 a => Show (Sealed2 a)
+ Darcs.Witnesses.Unsafe: unsafeCoerceP :: a x y -> a b c
+ Darcs.Witnesses.Unsafe: unsafeCoerceP1 :: a x -> a y
+ Darcs.Witnesses.Unsafe: unsafeCoerceP2 :: t w x y z -> t a b c d
+ Darcs.Witnesses.Unsafe: unsafeCoercePEnd :: a x y1 -> a x y2
+ Darcs.Witnesses.Unsafe: unsafeCoercePStart :: a x1 y -> a x2 y
+ English: It :: Pronoun
+ English: data Pronoun
+ English: instance Countable Pronoun
+ HTTP: CouldNotConnectToServer :: ConnectionError
+ HTTP: CouldNotResolveHost :: ConnectionError
+ HTTP: OperationTimeout :: ConnectionError
+ HTTP: data ConnectionError
+ HTTP: instance Eq ConnectionError
+ HTTP: instance Read ConnectionError
+ HTTP: instance Show ConnectionError
+ Ssh: remoteDarcs :: RemoteDarcs -> String
+ URL: data ConnectionError
- Darcs.Arguments: NoSetDefault :: DarcsFlag
+ Darcs.Arguments: NoSetDefault :: Bool -> DarcsFlag
- Darcs.Arguments: SetDefault :: DarcsFlag
+ Darcs.Arguments: SetDefault :: Bool -> DarcsFlag
- Darcs.Arguments: getEasyAuthor :: IO (Maybe String)
+ Darcs.Arguments: getEasyAuthor :: IO [String]
- Darcs.Arguments: printDryRunMessageAndExit :: (RepoPatch p) => String -> [DarcsFlag] -> FL (PatchInfoAnd p) -> IO ()
+ Darcs.Arguments: printDryRunMessageAndExit :: RepoPatch p => String -> [DarcsFlag] -> FL (PatchInfoAnd p) x y -> IO ()
- Darcs.Arguments: showFriendly :: (Patchy p) => [DarcsFlag] -> p -> Doc
+ Darcs.Arguments: showFriendly :: Patchy p => [DarcsFlag] -> p x y -> Doc
- Darcs.Commands: DarcsCommand :: String -> String -> String -> Int -> [String] -> ([DarcsFlag] -> [String] -> IO ()) -> ([DarcsFlag] -> IO (Either String ())) -> IO [String] -> ([DarcsFlag] -> AbsolutePath -> [String] -> IO [String]) -> [DarcsOption] -> [DarcsOption] -> DarcsCommand
+ Darcs.Commands: DarcsCommand :: String -> String -> String -> String -> Int -> [String] -> ([DarcsFlag] -> [String] -> IO ()) -> ([DarcsFlag] -> IO (Either String ())) -> IO [String] -> ([DarcsFlag] -> AbsolutePath -> [String] -> IO [String]) -> [DarcsOption] -> [DarcsOption] -> DarcsCommand
- Darcs.Commands: SuperCommand :: String -> String -> String -> ([DarcsFlag] -> IO (Either String ())) -> [CommandControl] -> DarcsCommand
+ Darcs.Commands: SuperCommand :: String -> String -> String -> String -> ([DarcsFlag] -> IO (Either String ())) -> [CommandControl] -> DarcsCommand
- Darcs.Commands.Record: askAboutDepends :: (RepoPatch p) => Repository p -> FL Prim -> [DarcsFlag] -> [PatchInfo] -> IO [PatchInfo]
+ Darcs.Commands.Record: askAboutDepends :: RepoPatch p => Repository p r u t -> FL (PrimOf p) t y -> [DarcsFlag] -> [PatchInfo] -> IO [PatchInfo]
- Darcs.Commands.Record: getLog :: [DarcsFlag] -> Maybe (String, [String]) -> IO String -> FL Prim -> IO (String, [String], Maybe String)
+ Darcs.Commands.Record: getLog :: (Patchy prim, PrimPatch prim) => [DarcsFlag] -> Maybe (String, [String]) -> IO String -> FL prim x y -> IO (String, [String], Maybe String)
- Darcs.Commands.Unrecord: getLastPatches :: (RepoPatch p) => [DarcsFlag] -> PatchSet p -> FlippedSeal (RL (PatchInfoAnd p))
+ Darcs.Commands.Unrecord: getLastPatches :: RepoPatch p => [DarcsFlag] -> PatchSet p Origin r -> ((PatchSet p) :> (FL (PatchInfoAnd p))) Origin r
- Darcs.Commands.Unrevert: writeUnrevert :: (RepoPatch p) => Repository p -> FL Prim -> Tree IO -> FL Prim -> IO ()
+ Darcs.Commands.Unrevert: writeUnrevert :: RepoPatch p => Repository p r u t -> FL (PrimOf p) x y -> Tree IO -> FL (PrimOf p) r x -> IO ()
- Darcs.CommandsAux: checkPaths :: (Patchy p) => [DarcsFlag] -> FL p -> IO ()
+ Darcs.CommandsAux: checkPaths :: Patchy p => [DarcsFlag] -> FL p x y -> IO ()
- Darcs.CommandsAux: hasMaliciousPath :: (Patchy p) => p -> Bool
+ Darcs.CommandsAux: hasMaliciousPath :: Patchy p => p x y -> Bool
- Darcs.CommandsAux: maliciousPatches :: (Patchy p) => [Sealed2 p] -> [Sealed2 p]
+ Darcs.CommandsAux: maliciousPatches :: Patchy p => [Sealed2 p] -> [Sealed2 p]
- Darcs.Diff: treeDiff :: (Functor m, Monad m, Gap w) => (FilePath -> FileType) -> Tree m -> Tree m -> m (w (FL Prim))
+ Darcs.Diff: treeDiff :: (Functor m, Monad m, Gap w, PrimPatch prim) => (FilePath -> FileType) -> Tree m -> Tree m -> m (w (FL prim))
- Darcs.External: copyFileOrUrl :: [DarcsFlag] -> FilePath -> FilePath -> Cachable -> IO ()
+ Darcs.External: copyFileOrUrl :: RemoteDarcs -> FilePath -> FilePath -> Cachable -> IO ()
- Darcs.External: copyLocal :: [DarcsFlag] -> String -> FilePath -> IO ()
+ Darcs.External: copyLocal :: String -> FilePath -> IO ()
- Darcs.External: execSSH :: String -> String -> IO ExitCode
+ Darcs.External: execSSH :: SshFilePath -> String -> IO ExitCode
- Darcs.External: pipeDocSSH :: String -> [String] -> Doc -> IO ExitCode
+ Darcs.External: pipeDocSSH :: SshFilePath -> [String] -> Doc -> IO ExitCode
- Darcs.Flags: NoSetDefault :: DarcsFlag
+ Darcs.Flags: NoSetDefault :: Bool -> DarcsFlag
- Darcs.Flags: RemoteDarcs :: String -> DarcsFlag
+ Darcs.Flags: RemoteDarcs :: String -> RemoteDarcs
- Darcs.Flags: SetDefault :: DarcsFlag
+ Darcs.Flags: SetDefault :: Bool -> DarcsFlag
- Darcs.Lock: appendBinFile :: (FilePathLike p) => p -> String -> IO ()
+ Darcs.Lock: appendBinFile :: FilePathLike p => p -> String -> IO ()
- Darcs.Lock: appendDocBinFile :: (FilePathLike p) => p -> Doc -> IO ()
+ Darcs.Lock: appendDocBinFile :: FilePathLike p => p -> Doc -> IO ()
- Darcs.Lock: appendToFile :: (FilePathLike p) => p -> (Handle -> IO ()) -> IO ()
+ Darcs.Lock: appendToFile :: FilePathLike p => p -> (Handle -> IO ()) -> IO ()
- Darcs.Lock: gzWriteAtomicFilePS :: (FilePathLike p) => p -> ByteString -> IO ()
+ Darcs.Lock: gzWriteAtomicFilePS :: FilePathLike p => p -> ByteString -> IO ()
- Darcs.Lock: gzWriteAtomicFilePSs :: (FilePathLike p) => p -> [ByteString] -> IO ()
+ Darcs.Lock: gzWriteAtomicFilePSs :: FilePathLike p => p -> [ByteString] -> IO ()
- Darcs.Lock: gzWriteDocFile :: (FilePathLike p) => p -> Doc -> IO ()
+ Darcs.Lock: gzWriteDocFile :: FilePathLike p => p -> Doc -> IO ()
- Darcs.Lock: readBinFile :: (FilePathLike p) => p -> IO String
+ Darcs.Lock: readBinFile :: FilePathLike p => p -> IO String
- Darcs.Lock: readDocBinFile :: (FilePathLike p) => p -> IO Doc
+ Darcs.Lock: readDocBinFile :: FilePathLike p => p -> IO Doc
- Darcs.Lock: readLocaleFile :: (FilePathLike p) => p -> IO String
+ Darcs.Lock: readLocaleFile :: FilePathLike p => p -> IO String
- Darcs.Lock: removeFileMayNotExist :: (FilePathLike p) => p -> IO ()
+ Darcs.Lock: removeFileMayNotExist :: FilePathLike p => p -> IO ()
- Darcs.Lock: writeAtomicFilePS :: (FilePathLike p) => p -> ByteString -> IO ()
+ Darcs.Lock: writeAtomicFilePS :: FilePathLike p => p -> ByteString -> IO ()
- Darcs.Lock: writeBinFile :: (FilePathLike p) => p -> String -> IO ()
+ Darcs.Lock: writeBinFile :: FilePathLike p => p -> String -> IO ()
- Darcs.Lock: writeDocBinFile :: (FilePathLike p) => p -> Doc -> IO ()
+ Darcs.Lock: writeDocBinFile :: FilePathLike p => p -> Doc -> IO ()
- Darcs.Lock: writeLocaleFile :: (FilePathLike p) => p -> String -> IO ()
+ Darcs.Lock: writeLocaleFile :: FilePathLike p => p -> String -> IO ()
- Darcs.Lock: writeToFile :: (FilePathLike p) => p -> (Handle -> IO ()) -> IO ()
+ Darcs.Lock: writeToFile :: FilePathLike p => p -> (Handle -> IO ()) -> IO ()
- Darcs.Match: applyInvToMatcher :: (RepoPatch p, WriteableDirectory m) => InclusiveOrExclusive -> Matcher p -> PatchSet p -> m ()
+ Darcs.Match: applyInvToMatcher :: (RepoPatch p, ApplyMonad m) => InclusiveOrExclusive -> Matcher p -> PatchSet p Origin x -> m ()
- Darcs.Match: getFirstMatch :: (RepoPatch p) => Repository p -> [DarcsFlag] -> IO ()
+ Darcs.Match: getFirstMatch :: RepoPatch p => Repository p r u t -> [DarcsFlag] -> IO ()
- Darcs.Match: getNonrangeMatch :: (RepoPatch p) => Repository p -> [DarcsFlag] -> IO ()
+ Darcs.Match: getNonrangeMatch :: RepoPatch p => Repository p r u t -> [DarcsFlag] -> IO ()
- Darcs.Match: getOnePatchset :: (RepoPatch p) => Repository p -> [DarcsFlag] -> IO (SealedPatchSet p)
+ Darcs.Match: getOnePatchset :: RepoPatch p => Repository p r u t -> [DarcsFlag] -> IO (SealedPatchSet p Origin)
- Darcs.Match: getPartialFirstMatch :: (RepoPatch p) => Repository p -> [DarcsFlag] -> [FileName] -> IO ()
+ Darcs.Match: getPartialFirstMatch :: RepoPatch p => Repository p r u t -> [DarcsFlag] -> Maybe [FileName] -> IO ()
- Darcs.Match: getPartialNonrangeMatch :: (RepoPatch p) => Repository p -> [DarcsFlag] -> [FileName] -> IO ()
+ Darcs.Match: getPartialNonrangeMatch :: RepoPatch p => Repository p r u t -> [DarcsFlag] -> [FileName] -> IO ()
- Darcs.Match: getPartialSecondMatch :: (RepoPatch p) => Repository p -> [DarcsFlag] -> [FileName] -> IO ()
+ Darcs.Match: getPartialSecondMatch :: RepoPatch p => Repository p r u t -> [DarcsFlag] -> Maybe [FileName] -> IO ()
- Darcs.Match: matchAPatch :: (Patchy p) => [DarcsFlag] -> Named p -> Bool
+ Darcs.Match: matchAPatch :: Patchy p => [DarcsFlag] -> Named p x y -> Bool
- Darcs.Match: matchAPatchread :: (Patchy p) => [DarcsFlag] -> PatchInfoAnd p -> Bool
+ Darcs.Match: matchAPatchread :: Patchy p => [DarcsFlag] -> PatchInfoAnd p x y -> Bool
- Darcs.Match: matchExists :: Matcher p -> PatchSet p -> Bool
+ Darcs.Match: matchExists :: Matcher p -> PatchSet p start x -> Bool
- Darcs.Match: matchFirstPatchset :: (RepoPatch p) => [DarcsFlag] -> PatchSet p -> SealedPatchSet p
+ Darcs.Match: matchFirstPatchset :: RepoPatch p => [DarcsFlag] -> PatchSet p start x -> SealedPatchSet p start
- Darcs.Match: matchPatch :: (RepoPatch p) => [DarcsFlag] -> PatchSet p -> Sealed2 (Named p)
+ Darcs.Match: matchPatch :: RepoPatch p => [DarcsFlag] -> PatchSet p start x -> Sealed2 (Named p)
- Darcs.Match: matchSecondPatchset :: (RepoPatch p) => [DarcsFlag] -> PatchSet p -> SealedPatchSet p
+ Darcs.Match: matchSecondPatchset :: RepoPatch p => [DarcsFlag] -> PatchSet p start x -> SealedPatchSet p start
- Darcs.Match: nonrangeMatcher :: (Patchy p) => [DarcsFlag] -> Maybe (Matcher p)
+ Darcs.Match: nonrangeMatcher :: Patchy p => [DarcsFlag] -> Maybe (Matcher p)
- Darcs.Patch: adddeps :: Named p -> [PatchInfo] -> Named p
+ Darcs.Patch: adddeps :: Named p x y -> [PatchInfo] -> Named p x y
- Darcs.Patch: adddir :: FilePath -> Prim
+ Darcs.Patch: adddir :: PrimConstruct prim => FilePath -> prim x y
- Darcs.Patch: addfile :: FilePath -> Prim
+ Darcs.Patch: addfile :: PrimConstruct prim => FilePath -> prim x y
- Darcs.Patch: anonymous :: (Patchy p) => p -> IO (Named p)
+ Darcs.Patch: anonymous :: Patchy p => FL p x y -> IO (Named p x y)
- Darcs.Patch: apply :: (Apply p, WriteableDirectory m) => [DarcsFlag] -> p -> m ()
+ Darcs.Patch: apply :: (Apply p, ApplyMonad m) => p x y -> m ()
- Darcs.Patch: applyToFilepaths :: (Apply p) => p -> [FilePath] -> [FilePath]
+ Darcs.Patch: applyToFilepaths :: Apply p => p x y -> [FilePath] -> [FilePath]
- Darcs.Patch: applyToTree :: (Apply p) => p -> Tree IO -> IO (Tree IO)
+ Darcs.Patch: applyToTree :: (Apply p, Functor m, MonadPlus m) => p x y -> Tree m -> m (Tree m)
- Darcs.Patch: binary :: FilePath -> ByteString -> ByteString -> Prim
+ Darcs.Patch: binary :: PrimConstruct prim => FilePath -> ByteString -> ByteString -> prim x y
- Darcs.Patch: canonize :: Prim -> FL Prim
+ Darcs.Patch: canonize :: PrimCanonize prim => prim x y -> FL prim x y
- Darcs.Patch: changepref :: String -> String -> String -> Prim
+ Darcs.Patch: changepref :: PrimConstruct prim => String -> String -> String -> prim x y
- Darcs.Patch: class (Apply p, Commute p, ShowPatch p, ReadPatch p, Invert p) => Patchy p
+ Darcs.Patch: class (MyEq p, Apply p, Commute p, PatchInspect p, ShowPatch p, ReadPatch p, Invert p) => Patchy p
- Darcs.Patch: class (Patchy p, Effect p, FromPrims p, Conflict p) => RepoPatch p
+ Darcs.Patch: class (Patchy p, Merge p, Effect p, IsHunk p, FromPrim p, Conflict p, CommuteNoConflicts p, Check p, RepairToFL p, PatchListFormat p, PrimPatchBase p, Patchy (PrimOf p), IsHunk (PrimOf p)) => RepoPatch p
- Darcs.Patch: commute :: (Commute p) => (p :> p) -> Maybe ((p :> p))
+ Darcs.Patch: commute :: Commute p => (p :> p) x y -> Maybe ((p :> p) x y)
- Darcs.Patch: commuteFLorComplain :: (Commute p) => (p :> FL p) -> Either (Sealed2 p) ((FL p :> p))
+ Darcs.Patch: commuteFLorComplain :: Commute p => (p :> FL p) x y -> Either (Sealed2 p) ((FL p :> p) x y)
- Darcs.Patch: commuteRL :: (Commute p) => (RL p :> p) -> Maybe ((p :> RL p))
+ Darcs.Patch: commuteRL :: Commute p => (RL p :> p) x y -> Maybe ((p :> RL p) x y)
- Darcs.Patch: data Named p
+ Darcs.Patch: data Named p x y
- Darcs.Patch: description :: (ShowPatch p) => p -> Doc
+ Darcs.Patch: description :: ShowPatch p => p x y -> Doc
- Darcs.Patch: effect :: (Effect p) => p -> FL Prim
+ Darcs.Patch: effect :: Effect p => p x y -> FL (PrimOf p) x y
- Darcs.Patch: fromPrim :: (FromPrim p) => Prim -> p
+ Darcs.Patch: fromPrim :: FromPrim p => PrimOf p x y -> p x y
- Darcs.Patch: fromPrims :: (FromPrims p) => FL Prim -> p
+ Darcs.Patch: fromPrims :: FromPrims p => FL (PrimOf p) x y -> p x y
- Darcs.Patch: getdeps :: Named p -> [PatchInfo]
+ Darcs.Patch: getdeps :: Named p x y -> [PatchInfo]
- Darcs.Patch: gzWritePatch :: (ShowPatch p) => FilePath -> p -> IO ()
+ Darcs.Patch: gzWritePatch :: ShowPatchBasic p => FilePath -> p x y -> IO ()
- Darcs.Patch: hunk :: FilePath -> Int -> [ByteString] -> [ByteString] -> Prim
+ Darcs.Patch: hunk :: PrimConstruct prim => FilePath -> Int -> [ByteString] -> [ByteString] -> prim x y
- Darcs.Patch: hunkMatches :: (Commute p) => (ByteString -> Bool) -> p -> Bool
+ Darcs.Patch: hunkMatches :: PatchInspect p => (ByteString -> Bool) -> p x y -> Bool
- Darcs.Patch: infopatch :: (Patchy p) => PatchInfo -> p -> Named p
+ Darcs.Patch: infopatch :: Patchy p => PatchInfo -> FL p x y -> Named p x y
- Darcs.Patch: invert :: (Invert p) => p -> p
+ Darcs.Patch: invert :: Invert p => p x y -> p y x
- Darcs.Patch: invertFL :: (Invert p) => FL p -> RL p
+ Darcs.Patch: invertFL :: Invert p => FL p x y -> RL p y x
- Darcs.Patch: invertRL :: (Invert p) => RL p -> FL p
+ Darcs.Patch: invertRL :: Invert p => RL p x y -> FL p y x
- Darcs.Patch: isInconsistent :: (Conflict p) => p -> Maybe Doc
+ Darcs.Patch: isInconsistent :: Check p => p x y -> Maybe Doc
- Darcs.Patch: joinPatches :: (FromPrims p) => FL p -> p
+ Darcs.Patch: joinPatches :: FromPrims p => FL p x y -> p x y
- Darcs.Patch: listConflictedFiles :: (Conflict p) => p -> [FilePath]
+ Darcs.Patch: listConflictedFiles :: Conflict p => p x y -> [FilePath]
- Darcs.Patch: listTouchedFiles :: (Commute p) => p -> [FilePath]
+ Darcs.Patch: listTouchedFiles :: PatchInspect p => p x y -> [FilePath]
- Darcs.Patch: merge :: (Commute p) => (p :\/: p) -> (p :/\: p)
+ Darcs.Patch: merge :: Merge p => (p :\/: p) x y -> (p :/\: p) x y
- Darcs.Patch: move :: FilePath -> FilePath -> Prim
+ Darcs.Patch: move :: PrimConstruct prim => FilePath -> FilePath -> prim x y
- Darcs.Patch: namepatch :: (Patchy p) => String -> String -> String -> [String] -> p -> IO (Named p)
+ Darcs.Patch: namepatch :: Patchy p => String -> String -> String -> [String] -> FL p x y -> IO (Named p x y)
- Darcs.Patch: patch2patchinfo :: Named p -> PatchInfo
+ Darcs.Patch: patch2patchinfo :: Named p x y -> PatchInfo
- Darcs.Patch: patchcontents :: Named p -> p
+ Darcs.Patch: patchcontents :: Named p x y -> FL p x y
- Darcs.Patch: patchname :: Named p -> String
+ Darcs.Patch: patchname :: Named p x y -> String
- Darcs.Patch: plainSummary :: (Conflict e, Effect e) => e -> Doc
+ Darcs.Patch: plainSummary :: (Conflict e, Effect e, PrimPatchBase e) => e x y -> Doc
- Darcs.Patch: primIsAdddir :: Prim -> Bool
+ Darcs.Patch: primIsAdddir :: PrimClassify prim => prim x y -> Bool
- Darcs.Patch: primIsAddfile :: Prim -> Bool
+ Darcs.Patch: primIsAddfile :: PrimClassify prim => prim x y -> Bool
- Darcs.Patch: primIsBinary :: Prim -> Bool
+ Darcs.Patch: primIsBinary :: PrimClassify prim => prim x y -> Bool
- Darcs.Patch: primIsHunk :: Prim -> Bool
+ Darcs.Patch: primIsHunk :: PrimClassify prim => prim x y -> Bool
- Darcs.Patch: primIsSetpref :: Prim -> Bool
+ Darcs.Patch: primIsSetpref :: PrimClassify prim => prim x y -> Bool
- Darcs.Patch: readPatch :: (ReadPatch p) => ByteString -> Maybe (Sealed (p), ByteString)
+ Darcs.Patch: readPatch :: ReadPatch p => ByteString -> Maybe (Sealed (p x))
- Darcs.Patch: resolveConflicts :: (Conflict p) => p -> [[Sealed (FL Prim)]]
+ Darcs.Patch: resolveConflicts :: Conflict p => p x y -> [[Sealed (FL (PrimOf p) y)]]
- Darcs.Patch: rmdir :: FilePath -> Prim
+ Darcs.Patch: rmdir :: PrimConstruct prim => FilePath -> prim x y
- Darcs.Patch: rmfile :: FilePath -> Prim
+ Darcs.Patch: rmfile :: PrimConstruct prim => FilePath -> prim x y
- Darcs.Patch: showContextPatch :: (ShowPatch p) => p -> TreeIO Doc
+ Darcs.Patch: showContextPatch :: ShowPatch p => p x y -> TreeIO Doc
- Darcs.Patch: showNicely :: (ShowPatch p) => p -> Doc
+ Darcs.Patch: showNicely :: ShowPatch p => p x y -> Doc
- Darcs.Patch: showPatch :: (ShowPatch p) => p -> Doc
+ Darcs.Patch: showPatch :: ShowPatchBasic p => p x y -> Doc
- Darcs.Patch: sortCoalesceFL :: FL Prim -> FL Prim
+ Darcs.Patch: sortCoalesceFL :: PrimCanonize prim => FL prim x y -> FL prim x y
- Darcs.Patch: summary :: (ShowPatch p) => p -> Doc
+ Darcs.Patch: summary :: ShowPatch p => p x y -> Doc
- Darcs.Patch: thing :: (ShowPatch p) => p -> String
+ Darcs.Patch: thing :: ShowPatch p => p x y -> String
- Darcs.Patch: things :: (ShowPatch p) => p -> String
+ Darcs.Patch: things :: ShowPatch p => p x y -> String
- Darcs.Patch: tokreplace :: FilePath -> String -> String -> String -> Prim
+ Darcs.Patch: tokreplace :: PrimConstruct prim => FilePath -> String -> String -> String -> prim x y
- Darcs.Patch: tryToShrink :: FL Prim -> FL Prim
+ Darcs.Patch: tryToShrink :: PrimCanonize prim => FL prim x y -> FL prim x y
- Darcs.Patch: writePatch :: (ShowPatch p) => FilePath -> p -> IO ()
+ Darcs.Patch: writePatch :: ShowPatchBasic p => FilePath -> p x y -> IO ()
- Darcs.Patch: xmlSummary :: (Effect p, Patchy p, Conflict p) => Named p -> Doc
+ Darcs.Patch: xmlSummary :: (Effect p, Conflict p, PrimPatchBase p) => p x y -> Doc
- Darcs.Patch.Apply: applyToFilepaths :: (Apply p) => p -> [FilePath] -> [FilePath]
+ Darcs.Patch.Apply: applyToFilepaths :: Apply p => p x y -> [FilePath] -> [FilePath]
- Darcs.Patch.Apply: applyToTree :: (Apply p) => p -> Tree IO -> IO (Tree IO)
+ Darcs.Patch.Apply: applyToTree :: (Apply p, Functor m, MonadPlus m) => p x y -> Tree m -> m (Tree m)
- Darcs.Patch.Bundle: contextPatches :: (RepoPatch p) => PatchSet p -> FlippedSeal (RL (PatchInfoAnd p))
+ Darcs.Patch.Bundle: contextPatches :: RepoPatch p => PatchSet p Origin x -> (PatchSet p :> (RL (PatchInfoAnd p))) Origin x
- Darcs.Patch.Bundle: hashBundle :: (RepoPatch p) => [PatchInfo] -> FL (Named p) -> String
+ Darcs.Patch.Bundle: hashBundle :: (PatchListFormat p, ShowPatchBasic p) => FL (Named p) x y -> String
- Darcs.Patch.Bundle: makeBundle2 :: (RepoPatch p) => Maybe (Tree IO) -> RL (PatchInfoAnd p) -> FL (Named p) -> FL (Named p) -> IO Doc
+ Darcs.Patch.Bundle: makeBundle2 :: RepoPatch p => Maybe (Tree IO) -> RL (PatchInfoAnd p) start x -> FL (Named p) x y -> FL (Named p) x y -> IO Doc
- Darcs.Patch.Bundle: makeBundleN :: (RepoPatch p) => Maybe (Tree IO) -> PatchSet p -> FL (Named p) -> IO Doc
+ Darcs.Patch.Bundle: makeBundleN :: RepoPatch p => Maybe (Tree IO) -> PatchSet p start x -> FL (Named p) x y -> IO Doc
- Darcs.Patch.Bundle: scanBundle :: (RepoPatch p) => ByteString -> Either String (SealedPatchSet p)
+ Darcs.Patch.Bundle: scanBundle :: RepoPatch p => ByteString -> Either String (SealedPatchSet p Origin)
- Darcs.Patch.Bundle: scanContext :: (RepoPatch p) => ByteString -> PatchSet p
+ Darcs.Patch.Bundle: scanContext :: RepoPatch p => ByteString -> PatchSet p Origin x
- Darcs.Patch.Choices: data PatchChoices p
+ Darcs.Patch.Choices: data PatchChoices p x y
- Darcs.Patch.Choices: data TaggedPatch p
+ Darcs.Patch.Choices: data TaggedPatch p x y
- Darcs.Patch.Choices: forceFirst :: (Patchy p) => Tag -> PatchChoices p -> PatchChoices p
+ Darcs.Patch.Choices: forceFirst :: Patchy p => Tag -> PatchChoices p a b -> PatchChoices p a b
- Darcs.Patch.Choices: forceFirsts :: (Patchy p) => [Tag] -> PatchChoices p -> PatchChoices p
+ Darcs.Patch.Choices: forceFirsts :: Patchy p => [Tag] -> PatchChoices p a b -> PatchChoices p a b
- Darcs.Patch.Choices: forceLast :: (Patchy p) => Tag -> PatchChoices p -> PatchChoices p
+ Darcs.Patch.Choices: forceLast :: Patchy p => Tag -> PatchChoices p a b -> PatchChoices p a b
- Darcs.Patch.Choices: forceLasts :: (Patchy p) => [Tag] -> PatchChoices p -> PatchChoices p
+ Darcs.Patch.Choices: forceLasts :: Patchy p => [Tag] -> PatchChoices p a b -> PatchChoices p a b
- Darcs.Patch.Choices: forceMatchingFirst :: (Patchy p) => (TaggedPatch p -> Bool) -> PatchChoices p -> PatchChoices p
+ Darcs.Patch.Choices: forceMatchingFirst :: Patchy p => (forall x y. TaggedPatch p x y -> Bool) -> PatchChoices p a b -> PatchChoices p a b
- Darcs.Patch.Choices: forceMatchingLast :: (Patchy p) => (TaggedPatch p -> Bool) -> PatchChoices p -> PatchChoices p
+ Darcs.Patch.Choices: forceMatchingLast :: Patchy p => (forall x y. TaggedPatch p x y -> Bool) -> PatchChoices p a b -> PatchChoices p a b
- Darcs.Patch.Choices: getChoices :: (Patchy p) => PatchChoices p -> (FL (TaggedPatch p) :> (FL (TaggedPatch p) :> FL (TaggedPatch p)))
+ Darcs.Patch.Choices: getChoices :: Patchy p => PatchChoices p x y -> (FL (TaggedPatch p) :> (FL (TaggedPatch p) :> FL (TaggedPatch p))) x y
- Darcs.Patch.Choices: makeEverythingLater :: (Patchy p) => PatchChoices p -> PatchChoices p
+ Darcs.Patch.Choices: makeEverythingLater :: Patchy p => PatchChoices p x y -> PatchChoices p x y
- Darcs.Patch.Choices: makeEverythingSooner :: (Patchy p) => PatchChoices p -> PatchChoices p
+ Darcs.Patch.Choices: makeEverythingSooner :: Patchy p => PatchChoices p x y -> PatchChoices p x y
- Darcs.Patch.Choices: makeUncertain :: (Patchy p) => Tag -> PatchChoices p -> PatchChoices p
+ Darcs.Patch.Choices: makeUncertain :: Patchy p => Tag -> PatchChoices p a b -> PatchChoices p a b
- Darcs.Patch.Choices: patchChoices :: (Patchy p) => FL p -> PatchChoices p
+ Darcs.Patch.Choices: patchChoices :: Patchy p => FL p x y -> PatchChoices p x y
- Darcs.Patch.Choices: patchChoicesTps :: (Patchy p) => FL p -> (PatchChoices p, FL (TaggedPatch p))
+ Darcs.Patch.Choices: patchChoicesTps :: Patchy p => FL p x y -> (PatchChoices p x y, FL (TaggedPatch p) x y)
- Darcs.Patch.Choices: patchChoicesTpsSub :: (Patchy p) => Maybe Tag -> FL p -> (PatchChoices p, FL (TaggedPatch p))
+ Darcs.Patch.Choices: patchChoicesTpsSub :: Patchy p => Maybe Tag -> FL p x y -> (PatchChoices p x y, FL (TaggedPatch p) x y)
- Darcs.Patch.Choices: patchSlot :: (Patchy p) => TaggedPatch p -> PatchChoices p -> (Slot, PatchChoices p)
+ Darcs.Patch.Choices: patchSlot :: Patchy p => TaggedPatch p a b -> PatchChoices p x y -> (Slot, PatchChoices p x y)
- Darcs.Patch.Choices: patchSlot' :: (Patchy p) => TaggedPatch p -> State (PatchChoices p) Slot
+ Darcs.Patch.Choices: patchSlot' :: Patchy p => TaggedPatch p a b -> StateT (PatchChoices p x y) Identity Slot
- Darcs.Patch.Choices: refineChoices :: (Patchy p, Monad m, Functor m) => (FL (TaggedPatch p) -> PatchChoices p -> m (PatchChoices p)) -> PatchChoices p -> m (PatchChoices p)
+ Darcs.Patch.Choices: refineChoices :: (Patchy p, Monad m, Functor m) => (forall u v. FL (TaggedPatch p) u v -> PatchChoices p u v -> m (PatchChoices p u v)) -> PatchChoices p x y -> m (PatchChoices p x y)
- Darcs.Patch.Choices: selectAllMiddles :: (Patchy p) => Bool -> PatchChoices p -> PatchChoices p
+ Darcs.Patch.Choices: selectAllMiddles :: Patchy p => Bool -> PatchChoices p x y -> PatchChoices p x y
- Darcs.Patch.Choices: separateFirstFromMiddleLast :: (Patchy p) => PatchChoices p -> (FL (TaggedPatch p) :> FL (TaggedPatch p))
+ Darcs.Patch.Choices: separateFirstFromMiddleLast :: Patchy p => PatchChoices p x z -> (FL (TaggedPatch p) :> FL (TaggedPatch p)) x z
- Darcs.Patch.Choices: separateFirstMiddleFromLast :: (Patchy p) => PatchChoices p -> (FL (TaggedPatch p) :> FL (TaggedPatch p))
+ Darcs.Patch.Choices: separateFirstMiddleFromLast :: Patchy p => PatchChoices p x z -> (FL (TaggedPatch p) :> FL (TaggedPatch p)) x z
- Darcs.Patch.Choices: substitute :: (Patchy p) => Sealed2 (TaggedPatch p :||: FL (TaggedPatch p)) -> PatchChoices p -> PatchChoices p
+ Darcs.Patch.Choices: substitute :: Patchy p => Sealed2 (TaggedPatch p :||: FL (TaggedPatch p)) -> PatchChoices p x y -> PatchChoices p x y
- Darcs.Patch.Choices: tag :: TaggedPatch p -> Tag
+ Darcs.Patch.Choices: tag :: TaggedPatch p x y -> Tag
- Darcs.Patch.Choices: tpPatch :: TaggedPatch p -> p
+ Darcs.Patch.Choices: tpPatch :: TaggedPatch p x y -> p x y
- Darcs.Patch.Depends: areUnrelatedRepos :: (RepoPatch p) => PatchSet p -> PatchSet p -> Bool
+ Darcs.Patch.Depends: areUnrelatedRepos :: RepoPatch p => PatchSet p start x -> PatchSet p start y -> Bool
- Darcs.Patch.Depends: commuteToEnd :: (RepoPatch p) => RL (PatchInfoAnd p) -> PatchSet p -> (PatchSet p :>> RL (PatchInfoAnd p))
+ Darcs.Patch.Depends: commuteToEnd :: RepoPatch p => RL (PatchInfoAnd p) x y -> PatchSet p start y -> (PatchSet p :> RL (PatchInfoAnd p)) start x
- Darcs.Patch.Depends: countUsThem :: (RepoPatch p) => PatchSet p -> PatchSet p -> (Int, Int)
+ Darcs.Patch.Depends: countUsThem :: RepoPatch p => PatchSet p start x -> PatchSet p start y -> (Int, Int)
- Darcs.Patch.Depends: deepOptimizePatchset :: PatchSet p -> PatchSet p
+ Darcs.Patch.Depends: deepOptimizePatchset :: PatchSet p start x -> PatchSet p start x
- Darcs.Patch.Depends: findCommonWithThem :: (RepoPatch p) => PatchSet p -> PatchSet p -> (PatchSet p :>> FL (PatchInfoAnd p))
+ Darcs.Patch.Depends: findCommonWithThem :: RepoPatch p => PatchSet p start x -> PatchSet p start y -> (PatchSet p :> FL (PatchInfoAnd p)) start x
- Darcs.Patch.Depends: findUncommon :: (RepoPatch p) => PatchSet p -> PatchSet p -> (FL (PatchInfoAnd p) :\/: FL (PatchInfoAnd p))
+ Darcs.Patch.Depends: findUncommon :: RepoPatch p => PatchSet p start x -> PatchSet p start y -> (FL (PatchInfoAnd p) :\/: FL (PatchInfoAnd p)) x y
- Darcs.Patch.Depends: getPatchesBeyondTag :: (RepoPatch p) => PatchInfo -> PatchSet p -> FlippedSeal (RL (PatchInfoAnd p))
+ Darcs.Patch.Depends: getPatchesBeyondTag :: RepoPatch p => PatchInfo -> PatchSet p start x -> FlippedSeal (RL (PatchInfoAnd p)) x
- Darcs.Patch.Depends: getPatchesInTag :: (RepoPatch p) => PatchInfo -> PatchSet p -> SealedPatchSet p
+ Darcs.Patch.Depends: getPatchesInTag :: RepoPatch p => PatchInfo -> PatchSet p start x -> SealedPatchSet p start
- Darcs.Patch.Depends: getTagsRight :: PatchSet p -> [PatchInfo]
+ Darcs.Patch.Depends: getTagsRight :: PatchSet p start x -> [PatchInfo]
- Darcs.Patch.Depends: merge2FL :: (RepoPatch p) => FL (PatchInfoAnd p) -> FL (PatchInfoAnd p) -> Sealed (FL (PatchInfoAnd p))
+ Darcs.Patch.Depends: merge2FL :: RepoPatch p => FL (PatchInfoAnd p) x y -> FL (PatchInfoAnd p) x z -> Sealed (FL (PatchInfoAnd p) y)
- Darcs.Patch.Depends: mergeThem :: (RepoPatch p) => PatchSet p -> PatchSet p -> Sealed (FL (PatchInfoAnd p))
+ Darcs.Patch.Depends: mergeThem :: RepoPatch p => PatchSet p start x -> PatchSet p start y -> Sealed (FL (PatchInfoAnd p) x)
- Darcs.Patch.Depends: newsetIntersection :: (RepoPatch p) => [SealedPatchSet p] -> SealedPatchSet p
+ Darcs.Patch.Depends: newsetIntersection :: RepoPatch p => [SealedPatchSet p start] -> SealedPatchSet p start
- Darcs.Patch.Depends: newsetUnion :: (RepoPatch p) => [SealedPatchSet p] -> SealedPatchSet p
+ Darcs.Patch.Depends: newsetUnion :: RepoPatch p => [SealedPatchSet p start] -> SealedPatchSet p start
- Darcs.Patch.Depends: optimizePatchset :: PatchSet p -> PatchSet p
+ Darcs.Patch.Depends: optimizePatchset :: PatchSet p start x -> PatchSet p start x
- Darcs.Patch.Depends: removeFromPatchSet :: (RepoPatch p) => FL (PatchInfoAnd p) -> PatchSet p -> Maybe (PatchSet p)
+ Darcs.Patch.Depends: removeFromPatchSet :: RepoPatch p => FL (PatchInfoAnd p) x y -> PatchSet p start y -> Maybe (PatchSet p start x)
- Darcs.Patch.Depends: slightlyOptimizePatchset :: PatchSet p -> PatchSet p
+ Darcs.Patch.Depends: slightlyOptimizePatchset :: PatchSet p start x -> PatchSet p start x
- Darcs.Patch.Depends: splitOnTag :: (RepoPatch p) => PatchInfo -> PatchSet p -> (PatchSet p :>> RL (PatchInfoAnd p))
+ Darcs.Patch.Depends: splitOnTag :: RepoPatch p => PatchInfo -> PatchSet p start x -> (PatchSet p :> RL (PatchInfoAnd p)) start x
- Darcs.Patch.Info: readPatchInfo :: ByteString -> Maybe (PatchInfo, ByteString)
+ Darcs.Patch.Info: readPatchInfo :: ParserM m => m (PatchInfo)
- Darcs.Patch.Match: applyMatcher :: Matcher p -> PatchInfoAnd p -> Bool
+ Darcs.Patch.Match: applyMatcher :: Matcher p -> PatchInfoAnd p x y -> Bool
- Darcs.Patch.Match: matchParser :: (Patchy p) => CharParser st (MatchFun p)
+ Darcs.Patch.Match: matchParser :: Patchy p => CharParser st (MatchFun p)
- Darcs.Patch.Match: matchPattern :: (Patchy p) => PatchMatch -> Matcher p
+ Darcs.Patch.Match: matchPattern :: Patchy p => PatchMatch -> Matcher p
- Darcs.Patch.Match: parseMatch :: (Patchy p) => PatchMatch -> Either String (MatchFun p)
+ Darcs.Patch.Match: parseMatch :: Patchy p => PatchMatch -> Either String (MatchFun p)
- Darcs.Patch.Patchy: apply :: (Apply p, WriteableDirectory m) => [DarcsFlag] -> p -> m ()
+ Darcs.Patch.Patchy: apply :: (Apply p, ApplyMonad m) => p x y -> m ()
- Darcs.Patch.Patchy: class (MyEq p) => Invert p
+ Darcs.Patch.Patchy: class Invert p
- Darcs.Patch.Patchy: class (Apply p, Commute p, ShowPatch p, ReadPatch p, Invert p) => Patchy p
+ Darcs.Patch.Patchy: class (MyEq p, Apply p, Commute p, PatchInspect p, ShowPatch p, ReadPatch p, Invert p) => Patchy p
- Darcs.Patch.Patchy: class (Commute p) => ShowPatch p
+ Darcs.Patch.Patchy: class ShowPatchBasic p => ShowPatch p
- Darcs.Patch.Patchy: commute :: (Commute p) => (p :> p) -> Maybe ((p :> p))
+ Darcs.Patch.Patchy: commute :: Commute p => (p :> p) x y -> Maybe ((p :> p) x y)
- Darcs.Patch.Patchy: description :: (ShowPatch p) => p -> Doc
+ Darcs.Patch.Patchy: description :: ShowPatch p => p x y -> Doc
- Darcs.Patch.Patchy: hunkMatches :: (Commute p) => (ByteString -> Bool) -> p -> Bool
+ Darcs.Patch.Patchy: hunkMatches :: PatchInspect p => (ByteString -> Bool) -> p x y -> Bool
- Darcs.Patch.Patchy: invert :: (Invert p) => p -> p
+ Darcs.Patch.Patchy: invert :: Invert p => p x y -> p y x
- Darcs.Patch.Patchy: listTouchedFiles :: (Commute p) => p -> [FilePath]
+ Darcs.Patch.Patchy: listTouchedFiles :: PatchInspect p => p x y -> [FilePath]
- Darcs.Patch.Patchy: readPatch' :: (ReadPatch p, ParserM m) => Bool -> m (Maybe (Sealed (p)))
+ Darcs.Patch.Patchy: readPatch' :: (ReadPatch p, ParserM m) => m (Sealed (p x))
- Darcs.Patch.Patchy: showContextPatch :: (ShowPatch p) => p -> TreeIO Doc
+ Darcs.Patch.Patchy: showContextPatch :: ShowPatch p => p x y -> TreeIO Doc
- Darcs.Patch.Patchy: showNicely :: (ShowPatch p) => p -> Doc
+ Darcs.Patch.Patchy: showNicely :: ShowPatch p => p x y -> Doc
- Darcs.Patch.Patchy: showPatch :: (ShowPatch p) => p -> Doc
+ Darcs.Patch.Patchy: showPatch :: ShowPatchBasic p => p x y -> Doc
- Darcs.Patch.Patchy: summary :: (ShowPatch p) => p -> Doc
+ Darcs.Patch.Patchy: summary :: ShowPatch p => p x y -> Doc
- Darcs.Patch.Patchy: thing :: (ShowPatch p) => p -> String
+ Darcs.Patch.Patchy: thing :: ShowPatch p => p x y -> String
- Darcs.Patch.Patchy: things :: (ShowPatch p) => p -> String
+ Darcs.Patch.Patchy: things :: ShowPatch p => p x y -> String
- Darcs.Patch.Permutations: commuteWhatWeCanFL :: (Commute p) => (p :> FL p) -> (FL p :> (p :> FL p))
+ Darcs.Patch.Permutations: commuteWhatWeCanFL :: Commute p => (p :> FL p) x y -> (FL p :> (p :> FL p)) x y
- Darcs.Patch.Permutations: commuteWhatWeCanRL :: (Commute p) => (RL p :> p) -> (RL p :> (p :> RL p))
+ Darcs.Patch.Permutations: commuteWhatWeCanRL :: Commute p => (RL p :> p) x y -> (RL p :> (p :> RL p)) x y
- Darcs.Patch.Permutations: genCommuteWhatWeCanRL :: (((p :> p) -> Maybe ((p :> p)))) -> (RL p :> p) -> (RL p :> (p :> RL p))
+ Darcs.Patch.Permutations: genCommuteWhatWeCanRL :: (forall a b. (p :> p) a b -> Maybe ((p :> p) a b)) -> (RL p :> p) x y -> (RL p :> (p :> RL p)) x y
- Darcs.Patch.Permutations: headPermutationsFL :: (Commute p) => FL p -> [(p :> FL p)]
+ Darcs.Patch.Permutations: headPermutationsFL :: Commute p => FL p x y -> [(p :> FL p) x y]
- Darcs.Patch.Permutations: headPermutationsRL :: (Commute p) => RL p -> [RL p]
+ Darcs.Patch.Permutations: headPermutationsRL :: Commute p => RL p x y -> [RL p x y]
- Darcs.Patch.Permutations: partitionConflictingFL :: (Commute p1, Invert p1) => CommuteFn p1 p2 -> FL p1 -> p2 -> (FL p1 :> FL p1)
+ Darcs.Patch.Permutations: partitionConflictingFL :: (Commute p1, Invert p1) => CommuteFn p1 p2 -> FL p1 x y -> p2 x z -> (FL p1 :> FL p1) x y
- Darcs.Patch.Permutations: partitionFL :: (Commute p) => (p -> Bool) -> FL p -> ((FL p :> (FL p :> FL p)))
+ Darcs.Patch.Permutations: partitionFL :: Commute p => (forall u v. p u v -> Bool) -> FL p x y -> ((FL p :> (FL p :> FL p)) x y)
- Darcs.Patch.Permutations: partitionRL :: (Commute p) => (p -> Bool) -> RL p -> (RL p :> RL p)
+ Darcs.Patch.Permutations: partitionRL :: Commute p => (forall u v. p u v -> Bool) -> RL p x y -> (RL p :> RL p) x y
- Darcs.Patch.Permutations: removeCommon :: (MyEq p, Commute p) => (FL p :\/: FL p) -> (FL p :\/: FL p)
+ Darcs.Patch.Permutations: removeCommon :: (MyEq p, Commute p) => (FL p :\/: FL p) x y -> (FL p :\/: FL p) x y
- Darcs.Patch.Permutations: removeFL :: (MyEq p, Commute p) => p -> FL p -> Maybe (FL p)
+ Darcs.Patch.Permutations: removeFL :: (MyEq p, Commute p) => p x y -> FL p x z -> Maybe (FL p y z)
- Darcs.Patch.Permutations: removeRL :: (MyEq p, Commute p) => p -> RL p -> Maybe (RL p)
+ Darcs.Patch.Permutations: removeRL :: (MyEq p, Commute p) => p y z -> RL p x z -> Maybe (RL p x y)
- Darcs.Patch.Permutations: removeSubsequenceFL :: (MyEq p, Commute p) => FL p -> FL p -> Maybe (FL p)
+ Darcs.Patch.Permutations: removeSubsequenceFL :: (MyEq p, Commute p) => FL p a b -> FL p a c -> Maybe (FL p b c)
- Darcs.Patch.Permutations: removeSubsequenceRL :: (MyEq p, Commute p) => RL p -> RL p -> Maybe (RL p)
+ Darcs.Patch.Permutations: removeSubsequenceRL :: (MyEq p, Commute p) => RL p ab abc -> RL p a abc -> Maybe (RL p a ab)
- Darcs.Patch.Permutations: selfCommuter :: (Commute p) => CommuteFn p p
+ Darcs.Patch.Permutations: selfCommuter :: Commute p => CommuteFn p p
- Darcs.Patch.Permutations: simpleHeadPermutationsFL :: (Commute p) => FL p -> [FL p]
+ Darcs.Patch.Permutations: simpleHeadPermutationsFL :: Commute p => FL p x y -> [FL p x y]
- Darcs.Patch.Permutations: type CommuteFn p1 p2 = (p1 :> p2) -> Maybe ((p2 :> p1))
+ Darcs.Patch.Permutations: type CommuteFn p1 p2 = forall x y. (p1 :> p2) x y -> Maybe ((p2 :> p1) x y)
- Darcs.Patch.Prim: adddir :: FilePath -> Prim
+ Darcs.Patch.Prim: adddir :: PrimConstruct prim => FilePath -> prim x y
- Darcs.Patch.Prim: addfile :: FilePath -> Prim
+ Darcs.Patch.Prim: addfile :: PrimConstruct prim => FilePath -> prim x y
- Darcs.Patch.Prim: binary :: FilePath -> ByteString -> ByteString -> Prim
+ Darcs.Patch.Prim: binary :: PrimConstruct prim => FilePath -> ByteString -> ByteString -> prim x y
- Darcs.Patch.Prim: canonize :: Prim -> FL Prim
+ Darcs.Patch.Prim: canonize :: PrimCanonize prim => prim x y -> FL prim x y
- Darcs.Patch.Prim: canonizeFL :: FL Prim -> FL Prim
+ Darcs.Patch.Prim: canonizeFL :: PrimCanonize prim => FL prim x y -> FL prim x y
- Darcs.Patch.Prim: changepref :: String -> String -> String -> Prim
+ Darcs.Patch.Prim: changepref :: PrimConstruct prim => String -> String -> String -> prim x y
- Darcs.Patch.Prim: class (FromPrim p) => ToFromPrim p
+ Darcs.Patch.Prim: class FromPrim p => ToFromPrim p
- Darcs.Patch.Prim: fromPrim :: (FromPrim p) => Prim -> p
+ Darcs.Patch.Prim: fromPrim :: FromPrim p => PrimOf p x y -> p x y
- Darcs.Patch.Prim: fromPrims :: (FromPrims p) => FL Prim -> p
+ Darcs.Patch.Prim: fromPrims :: FromPrims p => FL (PrimOf p) x y -> p x y
- Darcs.Patch.Prim: hunk :: FilePath -> Int -> [ByteString] -> [ByteString] -> Prim
+ Darcs.Patch.Prim: hunk :: PrimConstruct prim => FilePath -> Int -> [ByteString] -> [ByteString] -> prim x y
- Darcs.Patch.Prim: is_filepatch :: Prim -> Maybe FileName
+ Darcs.Patch.Prim: is_filepatch :: PrimClassify prim => prim x y -> Maybe FileName
- Darcs.Patch.Prim: join :: (Prim :> Prim) -> Maybe (Prim)
+ Darcs.Patch.Prim: join :: PrimCanonize prim => (prim :> prim) x y -> Maybe (FL prim x y)
- Darcs.Patch.Prim: joinPatches :: (FromPrims p) => FL p -> p
+ Darcs.Patch.Prim: joinPatches :: FromPrims p => FL p x y -> p x y
- Darcs.Patch.Prim: move :: FilePath -> FilePath -> Prim
+ Darcs.Patch.Prim: move :: PrimConstruct prim => FilePath -> FilePath -> prim x y
- Darcs.Patch.Prim: primIsAdddir :: Prim -> Bool
+ Darcs.Patch.Prim: primIsAdddir :: PrimClassify prim => prim x y -> Bool
- Darcs.Patch.Prim: primIsAddfile :: Prim -> Bool
+ Darcs.Patch.Prim: primIsAddfile :: PrimClassify prim => prim x y -> Bool
- Darcs.Patch.Prim: primIsBinary :: Prim -> Bool
+ Darcs.Patch.Prim: primIsBinary :: PrimClassify prim => prim x y -> Bool
- Darcs.Patch.Prim: primIsHunk :: Prim -> Bool
+ Darcs.Patch.Prim: primIsHunk :: PrimClassify prim => prim x y -> Bool
- Darcs.Patch.Prim: primIsSetpref :: Prim -> Bool
+ Darcs.Patch.Prim: primIsSetpref :: PrimClassify prim => prim x y -> Bool
- Darcs.Patch.Prim: rmdir :: FilePath -> Prim
+ Darcs.Patch.Prim: rmdir :: PrimConstruct prim => FilePath -> prim x y
- Darcs.Patch.Prim: rmfile :: FilePath -> Prim
+ Darcs.Patch.Prim: rmfile :: PrimConstruct prim => FilePath -> prim x y
- Darcs.Patch.Prim: showPrim :: FileNameFormat -> Prim -> Doc
+ Darcs.Patch.Prim: showPrim :: PrimShow prim => FileNameFormat -> prim a b -> Doc
- Darcs.Patch.Prim: showPrimFL :: FileNameFormat -> FL Prim -> Doc
+ Darcs.Patch.Prim: showPrimFL :: PrimShow prim => FileNameFormat -> FL prim a b -> Doc
- Darcs.Patch.Prim: sortCoalesceFL :: FL Prim -> FL Prim
+ Darcs.Patch.Prim: sortCoalesceFL :: PrimCanonize prim => FL prim x y -> FL prim x y
- Darcs.Patch.Prim: toPrim :: (ToFromPrim p) => p -> Maybe (Prim)
+ Darcs.Patch.Prim: toPrim :: ToFromPrim p => p x y -> Maybe (PrimOf p x y)
- Darcs.Patch.Prim: tokreplace :: FilePath -> String -> String -> String -> Prim
+ Darcs.Patch.Prim: tokreplace :: PrimConstruct prim => FilePath -> String -> String -> String -> prim x y
- Darcs.Patch.Prim: tryShrinkingInverse :: FL Prim -> Maybe (FL Prim)
+ Darcs.Patch.Prim: tryShrinkingInverse :: PrimCanonize prim => FL prim x y -> Maybe (FL prim x y)
- Darcs.Patch.Prim: tryToShrink :: FL Prim -> FL Prim
+ Darcs.Patch.Prim: tryToShrink :: PrimCanonize prim => FL prim x y -> FL prim x y
- Darcs.Patch.Read: readPatch :: (ReadPatch p) => ByteString -> Maybe (Sealed (p), ByteString)
+ Darcs.Patch.Read: readPatch :: ReadPatch p => ByteString -> Maybe (Sealed (p x))
- Darcs.Patch.ReadMonads: class (Monad m) => ParserM m
+ Darcs.Patch.ReadMonads: class (Functor m, Applicative m, Alternative m, Monad m, MonadPlus m) => ParserM m
- Darcs.Patch.ReadMonads: lexChar :: (ParserM m) => Char -> m ()
+ Darcs.Patch.ReadMonads: lexChar :: ParserM m => Char -> m ()
- Darcs.Patch.ReadMonads: lexEof :: (ParserM m) => m ()
+ Darcs.Patch.ReadMonads: lexEof :: ParserM m => m ()
- Darcs.Patch.ReadMonads: lexString :: (ParserM m) => String -> m ()
+ Darcs.Patch.ReadMonads: lexString :: ParserM m => ByteString -> m ()
- Darcs.Patch.Set: PatchSet :: RL (PatchInfoAnd p) -> RL (Tagged p) -> PatchSet p
+ Darcs.Patch.Set: PatchSet :: RL (PatchInfoAnd p) y x -> RL (Tagged p) start y -> PatchSet p start x
- Darcs.Patch.Set: Tagged :: PatchInfoAnd p -> Maybe String -> RL (PatchInfoAnd p) -> Tagged p
+ Darcs.Patch.Set: Tagged :: PatchInfoAnd p y z -> Maybe String -> RL (PatchInfoAnd p) x3 y -> Tagged p x3 z
- Darcs.Patch.Set: data PatchSet p
+ Darcs.Patch.Set: data PatchSet p start x
- Darcs.Patch.Set: data Tagged p
+ Darcs.Patch.Set: data Tagged p x2 z
- Darcs.Patch.Set: newset2FL :: PatchSet p -> FL (PatchInfoAnd p)
+ Darcs.Patch.Set: newset2FL :: PatchSet p start x6 -> FL (PatchInfoAnd p) start x6
- Darcs.Patch.Set: newset2RL :: PatchSet p -> RL (PatchInfoAnd p)
+ Darcs.Patch.Set: newset2RL :: PatchSet p start x4 -> RL (PatchInfoAnd p) start x4
- Darcs.Patch.Set: progressPatchSet :: String -> PatchSet p -> PatchSet p
+ Darcs.Patch.Set: progressPatchSet :: String -> PatchSet p start x7 -> PatchSet p start x7
- Darcs.Patch.Set: tags :: PatchSet p -> [PatchInfo]
+ Darcs.Patch.Set: tags :: PatchSet p start x13 -> [PatchInfo]
- Darcs.Patch.Set: type SealedPatchSet p = Sealed ((PatchSet p))
+ Darcs.Patch.Set: type SealedPatchSet p start = Sealed ((PatchSet p) start)
- Darcs.Patch.Split: Splitter :: (p -> Maybe (ByteString, ByteString -> Maybe (FL p))) -> (FL p -> FL p) -> Splitter p
+ Darcs.Patch.Split: Splitter :: (forall x y. p x y -> Maybe (ByteString, ByteString -> Maybe (FL p x y))) -> (forall x y. FL p x y -> FL p x y) -> Splitter p
- Darcs.Patch.Split: applySplitter :: Splitter p -> p -> Maybe (ByteString, ByteString -> Maybe (FL p))
+ Darcs.Patch.Split: applySplitter :: Splitter p -> forall x y. p x y -> Maybe (ByteString, ByteString -> Maybe (FL p x y))
- Darcs.Patch.Split: canonizeSplit :: Splitter p -> FL p -> FL p
+ Darcs.Patch.Split: canonizeSplit :: Splitter p -> forall x y. FL p x y -> FL p x y
- Darcs.Patch.Split: primSplitter :: Splitter Prim
+ Darcs.Patch.Split: primSplitter :: PrimPatch p => Splitter p
- Darcs.Patch.TouchesFiles: choosePreTouching :: (Patchy p) => [FilePath] -> FL p -> Sealed (FL p)
+ Darcs.Patch.TouchesFiles: choosePreTouching :: Patchy p => Maybe [FilePath] -> FL p x y -> Sealed (FL p x)
- Darcs.Patch.TouchesFiles: chooseTouching :: (Patchy p) => [FilePath] -> FL p -> Sealed (FL p)
+ Darcs.Patch.TouchesFiles: chooseTouching :: Patchy p => Maybe [FilePath] -> FL p x y -> Sealed (FL p x)
- Darcs.Patch.TouchesFiles: deselectNotTouching :: (Patchy p) => [FilePath] -> PatchChoices p -> PatchChoices p
+ Darcs.Patch.TouchesFiles: deselectNotTouching :: Patchy p => Maybe [FilePath] -> PatchChoices p x y -> PatchChoices p x y
- Darcs.Patch.TouchesFiles: lookTouch :: (Patchy p) => [FilePath] -> p -> (Bool, [FilePath])
+ Darcs.Patch.TouchesFiles: lookTouch :: Patchy p => [FilePath] -> p x y -> (Bool, [FilePath])
- Darcs.Patch.TouchesFiles: selectNotTouching :: (Patchy p) => [FilePath] -> PatchChoices p -> PatchChoices p
+ Darcs.Patch.TouchesFiles: selectNotTouching :: Patchy p => Maybe [FilePath] -> PatchChoices p x y -> PatchChoices p x y
- Darcs.Patch.TouchesFiles: selectTouching :: (Patchy p) => [FilePath] -> PatchChoices p -> PatchChoices p
+ Darcs.Patch.TouchesFiles: selectTouching :: Patchy p => Maybe [FilePath] -> PatchChoices p x y -> PatchChoices p x y
- Darcs.PrintPatch: contextualPrintPatch :: (Patchy p) => Tree IO -> p -> IO ()
+ Darcs.PrintPatch: contextualPrintPatch :: Patchy p => Tree IO -> p x y -> IO ()
- Darcs.PrintPatch: printFriendly :: (Patchy p) => [DarcsFlag] -> p -> IO ()
+ Darcs.PrintPatch: printFriendly :: Patchy p => [DarcsFlag] -> p x y -> IO ()
- Darcs.PrintPatch: printPatch :: (Patchy p) => p -> IO ()
+ Darcs.PrintPatch: printPatch :: Patchy p => p x y -> IO ()
- Darcs.PrintPatch: printPatchPager :: (Patchy p) => p -> IO ()
+ Darcs.PrintPatch: printPatchPager :: Patchy p => p x y -> IO ()
- Darcs.ProgressPatches: progressFL :: String -> FL a -> FL a
+ Darcs.ProgressPatches: progressFL :: String -> FL a x y -> FL a x y
- Darcs.ProgressPatches: progressRL :: String -> RL a -> RL a
+ Darcs.ProgressPatches: progressRL :: String -> RL a x y -> RL a x y
- Darcs.ProgressPatches: progressRLShowTags :: String -> RL (PatchInfoAnd p) -> RL (PatchInfoAnd p)
+ Darcs.ProgressPatches: progressRLShowTags :: String -> RL (PatchInfoAnd p) x y -> RL (PatchInfoAnd p) x y
- Darcs.RepoPath: class (FilePathOrURL a) => FilePathLike a
+ Darcs.RepoPath: class FilePathOrURL a => FilePathLike a
- Darcs.RepoPath: setCurrentDirectory :: (FilePathLike p) => p -> IO ()
+ Darcs.RepoPath: setCurrentDirectory :: FilePathLike p => p -> IO ()
- Darcs.RepoPath: toFilePath :: (FilePathLike a) => a -> FilePath
+ Darcs.RepoPath: toFilePath :: FilePathLike a => a -> FilePath
- Darcs.RepoPath: toPath :: (FilePathOrURL a) => a -> String
+ Darcs.RepoPath: toPath :: FilePathOrURL a => a -> String
- Darcs.Repository: addToPending :: (RepoPatch p) => Repository p -> FL Prim -> IO ()
+ Darcs.Repository: addToPending :: RepoPatch p => Repository p r u t -> FL (PrimOf p) u y -> IO ()
- Darcs.Repository: applyToWorking :: (Patchy p) => Repository p1 -> [DarcsFlag] -> p -> IO (Repository p1)
+ Darcs.Repository: applyToWorking :: RepoPatch p => Repository p r u t -> [DarcsFlag] -> FL (PrimOf p) u y -> IO (Repository p r y t)
- Darcs.Repository: checkUnrelatedRepos :: (RepoPatch p) => [DarcsFlag] -> PatchSet p -> PatchSet p -> IO ()
+ Darcs.Repository: checkUnrelatedRepos :: RepoPatch p => [DarcsFlag] -> PatchSet p start x -> PatchSet p start y -> IO ()
- Darcs.Repository: cleanRepository :: (RepoPatch p) => Repository p -> IO ()
+ Darcs.Repository: cleanRepository :: RepoPatch p => Repository p r u t -> IO ()
- Darcs.Repository: considerMergeToWorking :: (RepoPatch p) => Repository p -> String -> [DarcsFlag] -> FL (PatchInfoAnd p) -> FL (PatchInfoAnd p) -> IO (Sealed (FL Prim))
+ Darcs.Repository: considerMergeToWorking :: RepoPatch p => Repository p r u t -> String -> [DarcsFlag] -> FL (PatchInfoAnd p) x t -> FL (PatchInfoAnd p) x y -> IO (Sealed (FL (PrimOf p) u))
- Darcs.Repository: copyRepository :: (RepoPatch p) => Repository p -> IO ()
+ Darcs.Repository: copyRepository :: RepoPatch p => Repository p r u t -> IO ()
- Darcs.Repository: createPartialsPristineDirectoryTree :: (FilePathLike fp, RepoPatch p) => Repository p -> [fp] -> FilePath -> IO ()
+ Darcs.Repository: createPartialsPristineDirectoryTree :: (FilePathLike fp, RepoPatch p) => Repository p r u t -> [fp] -> FilePath -> IO ()
- Darcs.Repository: createPristineDirectoryTree :: (RepoPatch p) => Repository p -> FilePath -> IO ()
+ Darcs.Repository: createPristineDirectoryTree :: RepoPatch p => Repository p r u t -> FilePath -> IO ()
- Darcs.Repository: data PatchInfoAnd p
+ Darcs.Repository: data PatchInfoAnd p a b
- Darcs.Repository: data PatchSet p
+ Darcs.Repository: data PatchSet p start x
- Darcs.Repository: data Repository p
+ Darcs.Repository: data Repository p :: (* -> * -> *) recordedstate unrecordedstate tentativestate
- Darcs.Repository: extractOptions :: Repository p -> [DarcsFlag]
+ Darcs.Repository: extractOptions :: Repository p r u t -> [DarcsFlag]
- Darcs.Repository: finalizeRepositoryChanges :: (RepoPatch p) => Repository p -> IO ()
+ Darcs.Repository: finalizeRepositoryChanges :: RepoPatch p => Repository p r u t -> IO ()
- Darcs.Repository: identifyRepositoryFor :: (RepoPatch p) => Repository p -> String -> IO (Repository p)
+ Darcs.Repository: identifyRepositoryFor :: RepoPatch p => Repository p r u t -> String -> IO (Repository p r u t)
- Darcs.Repository: makePatchLazy :: (RepoPatch p) => Repository p -> PatchInfoAnd p -> IO (PatchInfoAnd p)
+ Darcs.Repository: makePatchLazy :: RepoPatch p => Repository p r u t -> PatchInfoAnd p x y -> IO (PatchInfoAnd p x y)
- Darcs.Repository: maybeIdentifyRepository :: [DarcsFlag] -> String -> IO (IdentifyRepo p)
+ Darcs.Repository: maybeIdentifyRepository :: [DarcsFlag] -> String -> IO (IdentifyRepo p r u t)
- Darcs.Repository: modifyCache :: (RepoPatch p) => Repository p -> (Cache -> Cache) -> Repository p
+ Darcs.Repository: modifyCache :: RepoPatch p => Repository p r u t -> (Cache -> Cache) -> Repository p r u t
- Darcs.Repository: optimizeInventory :: (RepoPatch p) => Repository p -> IO ()
+ Darcs.Repository: optimizeInventory :: RepoPatch p => Repository p r u t -> IO ()
- Darcs.Repository: patchSetToPatches :: (RepoPatch p) => PatchSet p -> FL (Named p)
+ Darcs.Repository: patchSetToPatches :: RepoPatch p => PatchSet p x y -> FL (Named p) x y
- Darcs.Repository: patchSetToRepository :: (RepoPatch p) => Repository p -> PatchSet p -> [DarcsFlag] -> IO (Repository p)
+ Darcs.Repository: patchSetToRepository :: RepoPatch p => Repository p r1 u1 r1 -> PatchSet p Origin x -> [DarcsFlag] -> IO (Repository p r u t)
- Darcs.Repository: prefsUrl :: Repository p -> String
+ Darcs.Repository: prefsUrl :: Repository p r u t -> String
- Darcs.Repository: readIndex :: (RepoPatch p) => Repository p -> IO Index
+ Darcs.Repository: readIndex :: RepoPatch p => Repository p r u t -> IO Index
- Darcs.Repository: readPending :: (RepoPatch p) => Repository p -> IO (Tree IO, Sealed (FL Prim))
+ Darcs.Repository: readPending :: RepoPatch p => Repository p r u t -> IO (Tree IO, Sealed (FL (PrimOf p) t))
- Darcs.Repository: readRecorded :: (RepoPatch p) => Repository p -> IO (Tree IO)
+ Darcs.Repository: readRecorded :: RepoPatch p => Repository p r u t -> IO (Tree IO)
- Darcs.Repository: readRecordedAndPending :: (RepoPatch p) => Repository p -> IO (Tree IO)
+ Darcs.Repository: readRecordedAndPending :: RepoPatch p => Repository p r u t -> IO (Tree IO)
- Darcs.Repository: readRepo :: (RepoPatch p) => Repository p -> IO (PatchSet p)
+ Darcs.Repository: readRepo :: RepoPatch p => Repository p r u t -> IO (PatchSet p Origin r)
- Darcs.Repository: readTentativeRepo :: (RepoPatch p) => Repository p -> IO (PatchSet p)
+ Darcs.Repository: readTentativeRepo :: RepoPatch p => Repository p r u t -> IO (PatchSet p Origin t)
- Darcs.Repository: readUnrecorded :: (RepoPatch p) => Repository p -> [SubPath] -> IO (Tree IO)
+ Darcs.Repository: readUnrecorded :: RepoPatch p => Repository p r u t -> Maybe [SubPath] -> IO (Tree IO)
- Darcs.Repository: replacePristine :: Repository p -> Tree IO -> IO ()
+ Darcs.Repository: replacePristine :: Repository p r u t -> Tree IO -> IO ()
- Darcs.Repository: revertRepositoryChanges :: (RepoPatch p) => Repository p -> IO ()
+ Darcs.Repository: revertRepositoryChanges :: RepoPatch p => Repository p r u t -> IO ()
- Darcs.Repository: tentativelyAddPatch :: (RepoPatch p) => Repository p -> [DarcsFlag] -> PatchInfoAnd p -> IO (Repository p)
+ Darcs.Repository: tentativelyAddPatch :: RepoPatch p => Repository p r u t -> Compression -> PatchInfoAnd p t y -> IO (Repository p r u y)
- Darcs.Repository: tentativelyAddToPending :: (RepoPatch p) => Repository p -> [DarcsFlag] -> FL Prim -> IO ()
+ Darcs.Repository: tentativelyAddToPending :: RepoPatch p => Repository p r u t -> [DarcsFlag] -> FL (PrimOf p) x y -> IO ()
- Darcs.Repository: tentativelyMergePatches :: (RepoPatch p) => Repository p -> String -> [DarcsFlag] -> FL (PatchInfoAnd p) -> FL (PatchInfoAnd p) -> IO (Sealed (FL Prim))
+ Darcs.Repository: tentativelyMergePatches :: RepoPatch p => Repository p r u t -> String -> [DarcsFlag] -> FL (PatchInfoAnd p) x t -> FL (PatchInfoAnd p) x y -> IO (Sealed (FL (PrimOf p) u))
- Darcs.Repository: tentativelyRemovePatches :: (RepoPatch p) => Repository p -> [DarcsFlag] -> FL (PatchInfoAnd p) -> IO (Repository p)
+ Darcs.Repository: tentativelyRemovePatches :: RepoPatch p => Repository p r u t -> Compression -> FL (PatchInfoAnd p) x t -> IO (Repository p r u x)
- Darcs.Repository: tentativelyReplacePatches :: (RepoPatch p) => Repository p -> [DarcsFlag] -> FL (PatchInfoAnd p) -> IO (Repository p)
+ Darcs.Repository: tentativelyReplacePatches :: RepoPatch p => Repository p r u t -> Compression -> FL (PatchInfoAnd p) x t -> IO (Repository p r u t)
- Darcs.Repository: testRecorded :: (RepoPatch p) => Repository p -> IO ()
+ Darcs.Repository: testRecorded :: RepoPatch p => Repository p r u t -> IO (ExitCode)
- Darcs.Repository: testTentative :: (RepoPatch p) => Repository p -> IO ()
+ Darcs.Repository: testTentative :: RepoPatch p => Repository p r u t -> IO (ExitCode)
- Darcs.Repository: type SealedPatchSet p = Sealed ((PatchSet p))
+ Darcs.Repository: type SealedPatchSet p start = Sealed ((PatchSet p) start)
- Darcs.Repository: unrecordedChanges :: (RepoPatch p) => [DarcsFlag] -> Repository p -> [SubPath] -> IO (FL Prim)
+ Darcs.Repository: unrecordedChanges :: RepoPatch p => (UseIndex, ScanKnown) -> Repository p r u t -> Maybe [SubPath] -> IO (FL (PrimOf p) t u)
- Darcs.Repository: unrevertUrl :: Repository p -> String
+ Darcs.Repository: unrevertUrl :: Repository p r u t -> String
- Darcs.Repository: withGutsOf :: Repository p -> IO () -> IO ()
+ Darcs.Repository: withGutsOf :: Repository p r u t -> IO a -> IO a
- Darcs.Repository: withRecorded :: (RepoPatch p) => Repository p -> ((AbsolutePath -> IO a) -> IO a) -> (AbsolutePath -> IO a) -> IO a
+ Darcs.Repository: withRecorded :: RepoPatch p => Repository p r u t -> ((AbsolutePath -> IO a) -> IO a) -> (AbsolutePath -> IO a) -> IO a
- Darcs.Repository: withRepoLock :: [DarcsFlag] -> (forall p. (RepoPatch p) => Repository p -> IO a) -> IO a
+ Darcs.Repository: withRepoLock :: [DarcsFlag] -> RepoJob a -> IO a
- Darcs.Repository: withRepoReadLock :: [DarcsFlag] -> (forall p. (RepoPatch p) => Repository p -> IO a) -> IO a
+ Darcs.Repository: withRepoReadLock :: [DarcsFlag] -> RepoJob a -> IO a
- Darcs.Repository: withRepository :: [DarcsFlag] -> (forall p. (RepoPatch p) => Repository p -> IO a) -> IO a
+ Darcs.Repository: withRepository :: [DarcsFlag] -> RepoJob a -> IO a
- Darcs.Repository: withRepositoryDirectory :: [DarcsFlag] -> String -> (forall p. (RepoPatch p) => Repository p -> IO a) -> IO a
+ Darcs.Repository: withRepositoryDirectory :: [DarcsFlag] -> String -> RepoJob a -> IO a
- Darcs.Repository: writePatchSet :: (RepoPatch p) => PatchSet p -> [DarcsFlag] -> IO (Repository p)
+ Darcs.Repository: writePatchSet :: RepoPatch p => PatchSet p Origin x -> [DarcsFlag] -> IO (Repository p r u t)
- Darcs.Repository.ApplyPatches: applyPatches :: (Patchy p) => [DarcsFlag] -> FL (PatchInfoAnd p) -> IO ()
+ Darcs.Repository.ApplyPatches: applyPatches :: (MonadProgress m, ApplyMonad m, Patchy p) => FL (PatchInfoAnd p) x y -> m ()
- Darcs.Repository.Format: identifyRepoFormat :: String -> IO (Either String RepoFormat)
+ Darcs.Repository.Format: identifyRepoFormat :: String -> IO RepoFormat
- Darcs.Repository.HashedIO: copyPartialsHashed :: (FilePathLike fp) => Cache -> Compression -> String -> [fp] -> IO ()
+ Darcs.Repository.HashedIO: copyPartialsHashed :: FilePathLike fp => Cache -> Compression -> String -> [fp] -> IO ()
- Darcs.Repository.HashedIO: type HashedIO r p = StateT (HashDir r p) IO
+ Darcs.Repository.HashedIO: type HashedIO p = StateT (HashDir RW p) IO
- Darcs.Repository.HashedRepo: addToTentativeInventory :: (RepoPatch p) => Cache -> Compression -> PatchInfoAnd p -> IO FilePath
+ Darcs.Repository.HashedRepo: addToTentativeInventory :: RepoPatch p => Cache -> Compression -> PatchInfoAnd p x y -> IO FilePath
- Darcs.Repository.HashedRepo: applyToTentativePristine :: (Patchy q) => [DarcsFlag] -> q -> IO ()
+ Darcs.Repository.HashedRepo: applyToTentativePristine :: Patchy q => q x y -> IO ()
- Darcs.Repository.HashedRepo: cleanPristine :: Repository p -> IO ()
+ Darcs.Repository.HashedRepo: cleanPristine :: Repository p r u t -> IO ()
- Darcs.Repository.HashedRepo: copyPartialsPristine :: (FilePathLike fp) => Cache -> Compression -> String -> String -> [fp] -> IO ()
+ Darcs.Repository.HashedRepo: copyPartialsPristine :: FilePathLike fp => Cache -> Compression -> String -> String -> [fp] -> IO ()
- Darcs.Repository.HashedRepo: copyRepo :: (RepoPatch p) => Repository p -> [DarcsFlag] -> String -> IO ()
+ Darcs.Repository.HashedRepo: copyRepo :: RepoPatch p => Repository p r u t -> RemoteDarcs -> String -> IO ()
- Darcs.Repository.HashedRepo: copySources :: (RepoPatch p) => Repository p -> String -> IO ()
+ Darcs.Repository.HashedRepo: copySources :: RepoPatch p => Repository p r u t -> String -> IO ()
- Darcs.Repository.HashedRepo: finalizeTentativeChanges :: (RepoPatch p) => Repository p -> Compression -> IO ()
+ Darcs.Repository.HashedRepo: finalizeTentativeChanges :: RepoPatch p => Repository p r u t -> Compression -> IO ()
- Darcs.Repository.HashedRepo: readHashedPristineRoot :: Repository p -> IO (Maybe String)
+ Darcs.Repository.HashedRepo: readHashedPristineRoot :: Repository p r u t -> IO (Maybe String)
- Darcs.Repository.HashedRepo: readRepo :: (RepoPatch p) => Repository p -> String -> IO (PatchSet p)
+ Darcs.Repository.HashedRepo: readRepo :: RepoPatch p => Repository p r u t -> String -> IO (PatchSet p Origin r)
- Darcs.Repository.HashedRepo: readTentativeRepo :: (RepoPatch p) => Repository p -> String -> IO (PatchSet p)
+ Darcs.Repository.HashedRepo: readTentativeRepo :: RepoPatch p => Repository p r u t -> String -> IO (PatchSet p Origin t)
- Darcs.Repository.HashedRepo: removeFromTentativeInventory :: (RepoPatch p) => Repository p -> Compression -> FL (PatchInfoAnd p) -> IO ()
+ Darcs.Repository.HashedRepo: removeFromTentativeInventory :: RepoPatch p => Repository p r u t -> Compression -> FL (PatchInfoAnd p) x t -> IO ()
- Darcs.Repository.HashedRepo: writeAndReadPatch :: (RepoPatch p) => Cache -> Compression -> PatchInfoAnd p -> IO (PatchInfoAnd p)
+ Darcs.Repository.HashedRepo: writeAndReadPatch :: RepoPatch p => Cache -> Compression -> PatchInfoAnd p x y -> IO (PatchInfoAnd p x y)
- Darcs.Repository.HashedRepo: writeTentativeInventory :: (RepoPatch p) => Cache -> Compression -> PatchSet p -> IO ()
+ Darcs.Repository.HashedRepo: writeTentativeInventory :: RepoPatch p => Cache -> Compression -> PatchSet p Origin x -> IO ()
- Darcs.Repository.Internal: BadRepository :: String -> IdentifyRepo p
+ Darcs.Repository.Internal: BadRepository :: String -> IdentifyRepo p r u t
- Darcs.Repository.Internal: GoodRepository :: (Repository p) -> IdentifyRepo p
+ Darcs.Repository.Internal: GoodRepository :: (Repository p r u t) -> IdentifyRepo p r u t
- Darcs.Repository.Internal: NonRepository :: String -> IdentifyRepo p
+ Darcs.Repository.Internal: NonRepository :: String -> IdentifyRepo p r u t
- Darcs.Repository.Internal: Repo :: !String -> ![DarcsFlag] -> !RepoFormat -> !RepoType p -> Repository
+ Darcs.Repository.Internal: Repo :: !String -> ![DarcsFlag] -> !RepoFormat -> !RepoType p -> Repository recordedstate unrecordedstate tentativestate
- Darcs.Repository.Internal: announceMergeConflicts :: String -> [DarcsFlag] -> FL Prim -> IO Bool
+ Darcs.Repository.Internal: announceMergeConflicts :: (PrimPatch p, PatchInspect p) => String -> [DarcsFlag] -> FL p x y -> IO Bool
- Darcs.Repository.Internal: applyToTentativePristine :: (Effect q, Patchy q) => Repository p -> q -> IO ()
+ Darcs.Repository.Internal: applyToTentativePristine :: (Effect q, Patchy q, PrimPatchBase q) => Repository p r u t -> q t y -> IO ()
- Darcs.Repository.Internal: applyToWorking :: (Patchy p) => Repository p1 -> [DarcsFlag] -> p -> IO (Repository p1)
+ Darcs.Repository.Internal: applyToWorking :: RepoPatch p => Repository p r u t -> [DarcsFlag] -> FL (PrimOf p) u y -> IO (Repository p r y t)
- Darcs.Repository.Internal: checkUnrecordedConflicts :: (RepoPatch p) => [DarcsFlag] -> FL (Named p) -> IO Bool
+ Darcs.Repository.Internal: checkUnrecordedConflicts :: RepoPatch p => [DarcsFlag] -> FL (Named p) t y -> IO Bool
- Darcs.Repository.Internal: cleanRepository :: (RepoPatch p) => Repository p -> IO ()
+ Darcs.Repository.Internal: cleanRepository :: RepoPatch p => Repository p r u t -> IO ()
- Darcs.Repository.Internal: createPartialsPristineDirectoryTree :: (FilePathLike fp, RepoPatch p) => Repository p -> [fp] -> FilePath -> IO ()
+ Darcs.Repository.Internal: createPartialsPristineDirectoryTree :: (FilePathLike fp, RepoPatch p) => Repository p r u t -> [fp] -> FilePath -> IO ()
- Darcs.Repository.Internal: createPristineDirectoryTree :: (RepoPatch p) => Repository p -> FilePath -> IO ()
+ Darcs.Repository.Internal: createPristineDirectoryTree :: RepoPatch p => Repository p r u t -> FilePath -> IO ()
- Darcs.Repository.Internal: data IdentifyRepo p
+ Darcs.Repository.Internal: data IdentifyRepo p r u t
- Darcs.Repository.Internal: data RIO p a
+ Darcs.Repository.Internal: data RIO p r u t t1 a
- Darcs.Repository.Internal: data RepoType p
+ Darcs.Repository.Internal: data RepoType p :: (* -> * -> *)
- Darcs.Repository.Internal: data Repository p
+ Darcs.Repository.Internal: data Repository p :: (* -> * -> *) recordedstate unrecordedstate tentativestate
- Darcs.Repository.Internal: finalizeRepositoryChanges :: (RepoPatch p) => Repository p -> IO ()
+ Darcs.Repository.Internal: finalizeRepositoryChanges :: RepoPatch p => Repository p r u t -> IO ()
- Darcs.Repository.Internal: getRepository :: RIO p (Repository p)
+ Darcs.Repository.Internal: getRepository :: RIO p r u t t (Repository p r u t)
- Darcs.Repository.Internal: identifyRepositoryFor :: (RepoPatch p) => Repository p -> String -> IO (Repository p)
+ Darcs.Repository.Internal: identifyRepositoryFor :: RepoPatch p => Repository p r u t -> String -> IO (Repository p r u t)
- Darcs.Repository.Internal: makeNewPending :: (RepoPatch p) => Repository p -> FL Prim -> IO ()
+ Darcs.Repository.Internal: makeNewPending :: RepoPatch p => Repository p r u t -> FL (PrimOf p) t y -> IO ()
- Darcs.Repository.Internal: makePatchLazy :: (RepoPatch p) => Repository p -> PatchInfoAnd p -> IO (PatchInfoAnd p)
+ Darcs.Repository.Internal: makePatchLazy :: RepoPatch p => Repository p r u t -> PatchInfoAnd p x y -> IO (PatchInfoAnd p x y)
- Darcs.Repository.Internal: maybeIdentifyRepository :: [DarcsFlag] -> String -> IO (IdentifyRepo p)
+ Darcs.Repository.Internal: maybeIdentifyRepository :: [DarcsFlag] -> String -> IO (IdentifyRepo p r u t)
- Darcs.Repository.Internal: optimizeInventory :: (RepoPatch p) => Repository p -> IO ()
+ Darcs.Repository.Internal: optimizeInventory :: RepoPatch p => Repository p r u t -> IO ()
- Darcs.Repository.Internal: patchSetToPatches :: (RepoPatch p) => PatchSet p -> FL (Named p)
+ Darcs.Repository.Internal: patchSetToPatches :: RepoPatch p => PatchSet p x y -> FL (Named p) x y
- Darcs.Repository.Internal: prefsUrl :: Repository p -> String
+ Darcs.Repository.Internal: prefsUrl :: Repository p r u t -> String
- Darcs.Repository.Internal: rIO :: IO a -> RIO p a
+ Darcs.Repository.Internal: rIO :: IO a -> RIO p r u t t a
- Darcs.Repository.Internal: readRepo :: (RepoPatch p) => Repository p -> IO (PatchSet p)
+ Darcs.Repository.Internal: readRepo :: RepoPatch p => Repository p r u t -> IO (PatchSet p Origin r)
- Darcs.Repository.Internal: readTentativeRepo :: (RepoPatch p) => Repository p -> IO (PatchSet p)
+ Darcs.Repository.Internal: readTentativeRepo :: RepoPatch p => Repository p r u t -> IO (PatchSet p Origin t)
- Darcs.Repository.Internal: revertRepositoryChanges :: (RepoPatch p) => Repository p -> IO ()
+ Darcs.Repository.Internal: revertRepositoryChanges :: RepoPatch p => Repository p r u t -> IO ()
- Darcs.Repository.Internal: setTentativePending :: (RepoPatch p) => Repository p -> FL Prim -> IO ()
+ Darcs.Repository.Internal: setTentativePending :: RepoPatch p => Repository p r u t -> FL (PrimOf p) x y -> IO ()
- Darcs.Repository.Internal: tentativelyAddPatch :: (RepoPatch p) => Repository p -> [DarcsFlag] -> PatchInfoAnd p -> IO (Repository p)
+ Darcs.Repository.Internal: tentativelyAddPatch :: RepoPatch p => Repository p r u t -> Compression -> PatchInfoAnd p t y -> IO (Repository p r u y)
- Darcs.Repository.Internal: tentativelyAddPatch_ :: (RepoPatch p) => UpdatePristine -> Repository p -> [DarcsFlag] -> PatchInfoAnd p -> IO (Repository p)
+ Darcs.Repository.Internal: tentativelyAddPatch_ :: RepoPatch p => UpdatePristine -> Repository p r u t -> Compression -> PatchInfoAnd p t y -> IO (Repository p r u y)
- Darcs.Repository.Internal: tentativelyAddToPending :: (RepoPatch p) => Repository p -> [DarcsFlag] -> FL Prim -> IO ()
+ Darcs.Repository.Internal: tentativelyAddToPending :: RepoPatch p => Repository p r u t -> [DarcsFlag] -> FL (PrimOf p) x y -> IO ()
- Darcs.Repository.Internal: tentativelyRemovePatches :: (RepoPatch p) => Repository p -> [DarcsFlag] -> FL (PatchInfoAnd p) -> IO (Repository p)
+ Darcs.Repository.Internal: tentativelyRemovePatches :: RepoPatch p => Repository p r u t -> Compression -> FL (PatchInfoAnd p) x t -> IO (Repository p r u x)
- Darcs.Repository.Internal: tentativelyReplacePatches :: (RepoPatch p) => Repository p -> [DarcsFlag] -> FL (PatchInfoAnd p) -> IO (Repository p)
+ Darcs.Repository.Internal: tentativelyReplacePatches :: RepoPatch p => Repository p r u t -> Compression -> FL (PatchInfoAnd p) x t -> IO (Repository p r u t)
- Darcs.Repository.Internal: testRecorded :: (RepoPatch p) => Repository p -> IO ()
+ Darcs.Repository.Internal: testRecorded :: RepoPatch p => Repository p r u t -> IO (ExitCode)
- Darcs.Repository.Internal: testTentative :: (RepoPatch p) => Repository p -> IO ()
+ Darcs.Repository.Internal: testTentative :: RepoPatch p => Repository p r u t -> IO (ExitCode)
- Darcs.Repository.Internal: unrevertUrl :: Repository p -> String
+ Darcs.Repository.Internal: unrevertUrl :: Repository p r u t -> String
- Darcs.Repository.Internal: withGutsOf :: Repository p -> IO () -> IO ()
+ Darcs.Repository.Internal: withGutsOf :: Repository p r u t -> IO a -> IO a
- Darcs.Repository.Internal: withRecorded :: (RepoPatch p) => Repository p -> ((AbsolutePath -> IO a) -> IO a) -> (AbsolutePath -> IO a) -> IO a
+ Darcs.Repository.Internal: withRecorded :: RepoPatch p => Repository p r u t -> ((AbsolutePath -> IO a) -> IO a) -> (AbsolutePath -> IO a) -> IO a
- Darcs.Repository.Internal: withRepoLock :: [DarcsFlag] -> (forall p. (RepoPatch p) => Repository p -> IO a) -> IO a
+ Darcs.Repository.Internal: withRepoLock :: [DarcsFlag] -> RepoJob a -> IO a
- Darcs.Repository.Internal: withRepoReadLock :: [DarcsFlag] -> (forall p. (RepoPatch p) => Repository p -> IO a) -> IO a
+ Darcs.Repository.Internal: withRepoReadLock :: [DarcsFlag] -> RepoJob a -> IO a
- Darcs.Repository.Internal: withRepository :: [DarcsFlag] -> (forall p. (RepoPatch p) => Repository p -> IO a) -> IO a
+ Darcs.Repository.Internal: withRepository :: [DarcsFlag] -> RepoJob a -> IO a
- Darcs.Repository.Internal: withRepositoryDirectory :: [DarcsFlag] -> String -> (forall p. (RepoPatch p) => Repository p -> IO a) -> IO a
+ Darcs.Repository.Internal: withRepositoryDirectory :: [DarcsFlag] -> String -> RepoJob a -> IO a
- Darcs.Repository.InternalTypes: NoPristine :: !String -> Pristine
+ Darcs.Repository.InternalTypes: NoPristine :: Pristine
- Darcs.Repository.InternalTypes: PlainPristine :: !String -> Pristine
+ Darcs.Repository.InternalTypes: PlainPristine :: Pristine
- Darcs.Repository.InternalTypes: Repo :: !String -> ![DarcsFlag] -> !RepoFormat -> !RepoType p -> Repository
+ Darcs.Repository.InternalTypes: Repo :: !String -> ![DarcsFlag] -> !RepoFormat -> !RepoType p -> Repository recordedstate unrecordedstate tentativestate
- Darcs.Repository.InternalTypes: data RepoType p
+ Darcs.Repository.InternalTypes: data RepoType p :: (* -> * -> *)
- Darcs.Repository.InternalTypes: data Repository p
+ Darcs.Repository.InternalTypes: data Repository p :: (* -> * -> *) recordedstate unrecordedstate tentativestate
- Darcs.Repository.InternalTypes: extractCache :: Repository p -> Cache
+ Darcs.Repository.InternalTypes: extractCache :: Repository p r u t -> Cache
- Darcs.Repository.InternalTypes: extractOptions :: Repository p -> [DarcsFlag]
+ Darcs.Repository.InternalTypes: extractOptions :: Repository p r u t -> [DarcsFlag]
- Darcs.Repository.InternalTypes: modifyCache :: (RepoPatch p) => Repository p -> (Cache -> Cache) -> Repository p
+ Darcs.Repository.InternalTypes: modifyCache :: RepoPatch p => Repository p r u t -> (Cache -> Cache) -> Repository p r u t
- Darcs.Repository.LowLevel: readPending :: (RepoPatch p) => Repository p -> IO (Sealed (FL Prim))
+ Darcs.Repository.LowLevel: readPending :: RepoPatch p => Repository p r u t -> IO (Sealed (FL (PrimOf p) t))
- Darcs.Repository.Merge: considerMergeToWorking :: (RepoPatch p) => Repository p -> String -> [DarcsFlag] -> FL (PatchInfoAnd p) -> FL (PatchInfoAnd p) -> IO (Sealed (FL Prim))
+ Darcs.Repository.Merge: considerMergeToWorking :: RepoPatch p => Repository p r u t -> String -> [DarcsFlag] -> FL (PatchInfoAnd p) x t -> FL (PatchInfoAnd p) x y -> IO (Sealed (FL (PrimOf p) u))
- Darcs.Repository.Merge: tentativelyMergePatches :: (RepoPatch p) => Repository p -> String -> [DarcsFlag] -> FL (PatchInfoAnd p) -> FL (PatchInfoAnd p) -> IO (Sealed (FL Prim))
+ Darcs.Repository.Merge: tentativelyMergePatches :: RepoPatch p => Repository p r u t -> String -> [DarcsFlag] -> FL (PatchInfoAnd p) x t -> FL (PatchInfoAnd p) x y -> IO (Sealed (FL (PrimOf p) u))
- Darcs.Repository.Prefs: addToPreflist :: (WriteableDirectory m) => String -> String -> m ()
+ Darcs.Repository.Prefs: addToPreflist :: String -> String -> IO ()
- Darcs.Repository.Prefs: changePrefval :: (WriteableDirectory m) => String -> String -> String -> m ()
+ Darcs.Repository.Prefs: changePrefval :: String -> String -> String -> IO ()
- Darcs.Repository.Prefs: getPreflist :: (ReadableDirectory m) => String -> m [String]
+ Darcs.Repository.Prefs: getPreflist :: String -> IO [String]
- Darcs.Repository.Prefs: getPrefval :: (ReadableDirectory m) => String -> m (Maybe String)
+ Darcs.Repository.Prefs: getPrefval :: String -> IO (Maybe String)
- Darcs.Repository.Prefs: setPreflist :: (WriteableDirectory m) => String -> [String] -> m ()
+ Darcs.Repository.Prefs: setPreflist :: String -> [String] -> IO ()
- Darcs.Repository.Prefs: setPrefval :: (WriteableDirectory m) => String -> String -> m ()
+ Darcs.Repository.Prefs: setPrefval :: String -> String -> IO ()
- Darcs.Repository.Repair: BrokenPatches :: (Tree IO) -> (PatchSet p) -> RepositoryConsistency p
+ Darcs.Repository.Repair: BrokenPatches :: (Tree IO) -> (PatchSet p Origin x) -> RepositoryConsistency p x
- Darcs.Repository.Repair: BrokenPristine :: (Tree IO) -> RepositoryConsistency p
+ Darcs.Repository.Repair: BrokenPristine :: (Tree IO) -> RepositoryConsistency p x
- Darcs.Repository.Repair: RepositoryConsistent :: RepositoryConsistency p
+ Darcs.Repository.Repair: RepositoryConsistent :: RepositoryConsistency p x
- Darcs.Repository.Repair: checkIndex :: (RepoPatch p) => Repository p -> Bool -> IO Bool
+ Darcs.Repository.Repair: checkIndex :: RepoPatch p => Repository p r u t -> Bool -> IO Bool
- Darcs.Repository.Repair: data RepositoryConsistency p
+ Darcs.Repository.Repair: data RepositoryConsistency p x
- Darcs.Repository.Repair: replayRepository :: (RepoPatch p) => Repository p -> [DarcsFlag] -> (RepositoryConsistency p -> IO a) -> IO a
+ Darcs.Repository.Repair: replayRepository :: RepoPatch p => Repository p r u t -> [DarcsFlag] -> (RepositoryConsistency p r -> IO a) -> IO a
- Darcs.Repository.State: TreeFilter :: (forall tr. (FilterTree tr m) => tr m -> tr m) -> TreeFilter m
+ Darcs.Repository.State: TreeFilter :: (forall tr. FilterTree tr m => tr m -> tr m) -> TreeFilter m
- Darcs.Repository.State: applyTreeFilter :: TreeFilter m -> forall tr. (FilterTree tr m) => tr m -> tr m
+ Darcs.Repository.State: applyTreeFilter :: TreeFilter m -> forall tr. FilterTree tr m => tr m -> tr m
- Darcs.Repository.State: readIndex :: (RepoPatch p) => Repository p -> IO Index
+ Darcs.Repository.State: readIndex :: RepoPatch p => Repository p r u t -> IO Index
- Darcs.Repository.State: readPending :: (RepoPatch p) => Repository p -> IO (Tree IO, Sealed (FL Prim))
+ Darcs.Repository.State: readPending :: RepoPatch p => Repository p r u t -> IO (Tree IO, Sealed (FL (PrimOf p) t))
- Darcs.Repository.State: readRecorded :: (RepoPatch p) => Repository p -> IO (Tree IO)
+ Darcs.Repository.State: readRecorded :: RepoPatch p => Repository p r u t -> IO (Tree IO)
- Darcs.Repository.State: readRecordedAndPending :: (RepoPatch p) => Repository p -> IO (Tree IO)
+ Darcs.Repository.State: readRecordedAndPending :: RepoPatch p => Repository p r u t -> IO (Tree IO)
- Darcs.Repository.State: readUnrecorded :: (RepoPatch p) => Repository p -> [SubPath] -> IO (Tree IO)
+ Darcs.Repository.State: readUnrecorded :: RepoPatch p => Repository p r u t -> Maybe [SubPath] -> IO (Tree IO)
- Darcs.Repository.State: restrictSubpaths :: (RepoPatch p) => Repository p -> [SubPath] -> IO (TreeFilter m)
+ Darcs.Repository.State: restrictSubpaths :: RepoPatch p => Repository p r u t -> [SubPath] -> IO (TreeFilter m)
- Darcs.Repository.State: unrecordedChanges :: (RepoPatch p) => [DarcsFlag] -> Repository p -> [SubPath] -> IO (FL Prim)
+ Darcs.Repository.State: unrecordedChanges :: RepoPatch p => (UseIndex, ScanKnown) -> Repository p r u t -> Maybe [SubPath] -> IO (FL (PrimOf p) t u)
- Darcs.Resolution: externalResolution :: (RepoPatch p) => Tree IO -> String -> FL Prim -> FL Prim -> p -> IO (Sealed (FL Prim))
+ Darcs.Resolution: externalResolution :: RepoPatch p => Tree IO -> String -> FL (PrimOf p) x y -> FL (PrimOf p) x z -> FL p y a -> IO (Sealed (FL (PrimOf p) a))
- Darcs.Resolution: patchsetConflictResolutions :: (RepoPatch p) => PatchSet p -> Sealed (FL Prim)
+ Darcs.Resolution: patchsetConflictResolutions :: RepoPatch p => PatchSet p Origin x -> Sealed (FL (PrimOf p) x)
- Darcs.Resolution: standardResolution :: (RepoPatch p) => p -> Sealed (FL Prim)
+ Darcs.Resolution: standardResolution :: RepoPatch p => FL p x y -> Sealed (FL (PrimOf p) y)
- Darcs.SelectChanges: filterOutConflicts :: (RepoPatch p) => [DarcsFlag] -> RL (PatchInfoAnd p) -> Repository p -> FL (PatchInfoAnd p) -> IO (Bool, Sealed (FL (PatchInfoAnd p)))
+ Darcs.SelectChanges: filterOutConflicts :: RepoPatch p => [DarcsFlag] -> RL (PatchInfoAnd p) x t -> Repository p r u t -> FL (PatchInfoAnd p) x z -> IO (Bool, Sealed (FL (PatchInfoAnd p) x))
- Darcs.SelectChanges: runSelection :: (Patchy p) => PatchSelection p -> PatchSelectionContext p -> IO ((FL p :> FL p))
+ Darcs.SelectChanges: runSelection :: Patchy p => PatchSelection p x y -> PatchSelectionContext p -> IO ((FL p :> FL p) x y)
- Darcs.SelectChanges: selectChanges :: (Patchy p) => WhichChanges -> FL p -> PatchSelection p
+ Darcs.SelectChanges: selectChanges :: Patchy p => WhichChanges -> FL p x y -> PatchSelection p x y
- Darcs.SelectChanges: selectionContext :: (RepoPatch p) => String -> [DarcsFlag] -> Maybe (Splitter (PatchInfoAnd p)) -> [FilePath] -> PatchSelectionContext (PatchInfoAnd p)
+ Darcs.SelectChanges: selectionContext :: RepoPatch p => String -> [DarcsFlag] -> Maybe (Splitter (PatchInfoAnd p)) -> Maybe [FilePath] -> PatchSelectionContext (PatchInfoAnd p)
- Darcs.SelectChanges: selectionContextPrim :: String -> [DarcsFlag] -> Maybe (Splitter Prim) -> [FilePath] -> PatchSelectionContext Prim
+ Darcs.SelectChanges: selectionContextPrim :: PrimPatch prim => String -> [DarcsFlag] -> Maybe (Splitter prim) -> Maybe [FilePath] -> PatchSelectionContext prim
- Darcs.SelectChanges: viewChanges :: (Patchy p) => [DarcsFlag] -> [Sealed2 p] -> IO ()
+ Darcs.SelectChanges: viewChanges :: Patchy p => [DarcsFlag] -> [Sealed2 p] -> IO ()
- Darcs.SelectChanges: withSelectedPatchFromRepo :: (RepoPatch p) => String -> Repository p -> [DarcsFlag] -> ((FL (PatchInfoAnd p) :> PatchInfoAnd p) -> IO ()) -> IO ()
+ Darcs.SelectChanges: withSelectedPatchFromRepo :: RepoPatch p => String -> Repository p r u t -> [DarcsFlag] -> (forall a. (FL (PatchInfoAnd p) :> PatchInfoAnd p) a r -> IO ()) -> IO ()
- Darcs.SignalHandler: withSignalsBlocked :: IO () -> IO ()
+ Darcs.SignalHandler: withSignalsBlocked :: IO a -> IO a
- Darcs.Utils: editFile :: (FilePathLike p) => p -> IO ExitCode
+ Darcs.Utils: editFile :: FilePathLike p => p -> IO (ExitCode, Bool)
- Darcs.Utils: nubsort :: (Ord a) => [a] -> [a]
+ Darcs.Utils: nubsort :: Ord a => [a] -> [a]
- Darcs.Utils: promptYorn :: [Char] -> IO Char
+ Darcs.Utils: promptYorn :: [Char] -> IO Bool
- Darcs.Utils: showHexLen :: (Integral a) => Int -> a -> String
+ Darcs.Utils: showHexLen :: Integral a => Int -> a -> String
- Darcs.Utils: withCurrentDirectory :: (FilePathLike p) => p -> IO a -> IO a
+ Darcs.Utils: withCurrentDirectory :: FilePathLike p => p -> IO a -> IO a
- Darcs.Witnesses.Ordered: (+<+) :: RL a -> RL a -> RL a
+ Darcs.Witnesses.Ordered: (+<+) :: RL a y z -> RL a x y -> RL a x z
- Darcs.Witnesses.Ordered: (+>+) :: FL a -> FL a -> FL a
+ Darcs.Witnesses.Ordered: (+>+) :: FL a x y -> FL a y z -> FL a x z
- Darcs.Witnesses.Ordered: (:/\:) :: (a1) -> (a2) -> :/\: a1 a2
+ Darcs.Witnesses.Ordered: (:/\:) :: (a1 x z) -> (a2 y z) -> :/\: a1 a2 x y
- Darcs.Witnesses.Ordered: (:<) :: (a1) -> (a2) -> :< a1 a2
+ Darcs.Witnesses.Ordered: (:<) :: (a1 z y) -> (a2 x z) -> :< a1 a2 x y
- Darcs.Witnesses.Ordered: (:<:) :: a -> RL a -> RL a
+ Darcs.Witnesses.Ordered: (:<:) :: a y z -> RL a x y -> RL a x z
- Darcs.Witnesses.Ordered: (:>) :: (a1) -> (a2) -> :> a1 a2
+ Darcs.Witnesses.Ordered: (:>) :: (a1 x z) -> (a2 z y) -> :> a1 a2 x y
- Darcs.Witnesses.Ordered: (:>:) :: a -> FL a -> FL a
+ Darcs.Witnesses.Ordered: (:>:) :: a x y -> FL a y z -> FL a x z
- Darcs.Witnesses.Ordered: (:\/:) :: (a1) -> (a2) -> :\/: a1 a2
+ Darcs.Witnesses.Ordered: (:\/:) :: (a1 z x) -> (a2 z y) -> :\/: a1 a2 x y
- Darcs.Witnesses.Ordered: (:||:) :: (a1) -> (a2) -> :||: a1 a2
+ Darcs.Witnesses.Ordered: (:||:) :: (a1 x y) -> (a2 x y) -> :||: a1 a2 x y
- Darcs.Witnesses.Ordered: NilFL :: FL a
+ Darcs.Witnesses.Ordered: NilFL :: FL a x x
- Darcs.Witnesses.Ordered: NilRL :: RL a
+ Darcs.Witnesses.Ordered: NilRL :: RL a x x
- Darcs.Witnesses.Ordered: allFL :: (a -> Bool) -> FL a -> Bool
+ Darcs.Witnesses.Ordered: allFL :: (forall x y. a x y -> Bool) -> FL a w z -> Bool
- Darcs.Witnesses.Ordered: anyFL :: (a -> Bool) -> FL a -> Bool
+ Darcs.Witnesses.Ordered: anyFL :: (forall x y. a x y -> Bool) -> FL a w z -> Bool
- Darcs.Witnesses.Ordered: bunchFL :: Int -> FL a -> FL (FL a)
+ Darcs.Witnesses.Ordered: bunchFL :: Int -> FL a x y -> FL (FL a) x y
- Darcs.Witnesses.Ordered: concatFL :: FL (FL a) -> FL a
+ Darcs.Witnesses.Ordered: concatFL :: FL (FL a) x z -> FL a x z
- Darcs.Witnesses.Ordered: concatRL :: RL (RL a) -> RL a
+ Darcs.Witnesses.Ordered: concatRL :: RL (RL a) x z -> RL a x z
- Darcs.Witnesses.Ordered: consRLSealed :: a -> FlippedSeal (RL a) -> FlippedSeal (RL a)
+ Darcs.Witnesses.Ordered: consRLSealed :: a y z -> FlippedSeal (RL a) y -> FlippedSeal (RL a) z
- Darcs.Witnesses.Ordered: data (:>>) a1 a2
+ Darcs.Witnesses.Ordered: data (:||:) a1 a2 x y
- Darcs.Witnesses.Ordered: data FL a
+ Darcs.Witnesses.Ordered: data FL a x z
- Darcs.Witnesses.Ordered: data RL a
+ Darcs.Witnesses.Ordered: data RL a x z
- Darcs.Witnesses.Ordered: filterFL :: (a -> Bool) -> FL a -> [Sealed2 a]
+ Darcs.Witnesses.Ordered: filterFL :: (forall x y. a x y -> Bool) -> FL a w z -> [Sealed2 a]
- Darcs.Witnesses.Ordered: filterFLFL :: (p -> EqCheck) -> FL p -> FL p
+ Darcs.Witnesses.Ordered: filterFLFL :: (forall x y. p x y -> EqCheck x y) -> FL p w z -> FL p w z
- Darcs.Witnesses.Ordered: filterRL :: (p -> Bool) -> RL p -> [Sealed2 p]
+ Darcs.Witnesses.Ordered: filterRL :: (forall x y. p x y -> Bool) -> RL p a b -> [Sealed2 p]
- Darcs.Witnesses.Ordered: foldlFL :: (a -> b -> a) -> a -> FL b -> a
+ Darcs.Witnesses.Ordered: foldlFL :: (forall w y. a -> b w y -> a) -> a -> FL b x z -> a
- Darcs.Witnesses.Ordered: foldlRL :: (a -> b -> a) -> a -> RL b -> a
+ Darcs.Witnesses.Ordered: foldlRL :: (forall w y. a -> b w y -> a) -> a -> RL b x z -> a
- Darcs.Witnesses.Ordered: isShorterThanRL :: RL a -> Int -> Bool
+ Darcs.Witnesses.Ordered: isShorterThanRL :: RL a x y -> Int -> Bool
- Darcs.Witnesses.Ordered: lengthFL :: FL a -> Int
+ Darcs.Witnesses.Ordered: lengthFL :: FL a x z -> Int
- Darcs.Witnesses.Ordered: lengthRL :: RL a -> Int
+ Darcs.Witnesses.Ordered: lengthRL :: RL a x z -> Int
- Darcs.Witnesses.Ordered: mapFL :: (a -> b) -> FL a -> [b]
+ Darcs.Witnesses.Ordered: mapFL :: (forall w z. a w z -> b) -> FL a x y -> [b]
- Darcs.Witnesses.Ordered: mapFL_FL :: (a -> b) -> FL a -> FL b
+ Darcs.Witnesses.Ordered: mapFL_FL :: (forall w y. a w y -> b w y) -> FL a x z -> FL b x z
- Darcs.Witnesses.Ordered: mapRL :: (a -> b) -> RL a -> [b]
+ Darcs.Witnesses.Ordered: mapRL :: (forall w z. a w z -> b) -> RL a x y -> [b]
- Darcs.Witnesses.Ordered: mapRL_RL :: (a -> b) -> RL a -> RL b
+ Darcs.Witnesses.Ordered: mapRL_RL :: (forall w y. a w y -> b w y) -> RL a x z -> RL b x z
- Darcs.Witnesses.Ordered: nullFL :: FL a -> Bool
+ Darcs.Witnesses.Ordered: nullFL :: FL a x z -> Bool
- Darcs.Witnesses.Ordered: nullRL :: RL a -> Bool
+ Darcs.Witnesses.Ordered: nullRL :: RL a x z -> Bool
- Darcs.Witnesses.Ordered: reverseFL :: FL a -> RL a
+ Darcs.Witnesses.Ordered: reverseFL :: FL a x z -> RL a x z
- Darcs.Witnesses.Ordered: reverseRL :: RL a -> FL a
+ Darcs.Witnesses.Ordered: reverseRL :: RL a x z -> FL a x z
- Darcs.Witnesses.Ordered: spanFL :: (a -> Bool) -> FL a -> (FL a :> FL a)
+ Darcs.Witnesses.Ordered: spanFL :: (forall w y. a w y -> Bool) -> FL a x z -> (FL a :> FL a) x z
- Darcs.Witnesses.Ordered: spanFL_M :: (Monad m) => (a -> m Bool) -> FL a -> m ((FL a :> FL a))
+ Darcs.Witnesses.Ordered: spanFL_M :: Monad m => (forall w y. a w y -> m Bool) -> FL a x z -> m ((FL a :> FL a) x z)
- Darcs.Witnesses.Ordered: splitAtFL :: Int -> FL a -> (FL a :> FL a)
+ Darcs.Witnesses.Ordered: splitAtFL :: Int -> FL a x z -> (FL a :> FL a) x z
- Darcs.Witnesses.Ordered: splitAtRL :: Int -> RL a -> (RL a :< RL a)
+ Darcs.Witnesses.Ordered: splitAtRL :: Int -> RL a x z -> (RL a :< RL a) x z
- Darcs.Witnesses.Ordered: toFL :: [FreeLeft a] -> Sealed (FL a)
+ Darcs.Witnesses.Ordered: toFL :: [FreeLeft a] -> Sealed (FL a x)
- Darcs.Witnesses.Ordered: zipWithFL :: (a -> p -> q) -> [a] -> FL p -> FL q
+ Darcs.Witnesses.Ordered: zipWithFL :: (forall x y. a -> p x y -> q x y) -> [a] -> FL p w z -> FL q w z
- Darcs.Witnesses.Sealed: FlippedSeal :: !a -> FlippedSeal a
+ Darcs.Witnesses.Sealed: FlippedSeal :: !a x y -> FlippedSeal a y
- Darcs.Witnesses.Sealed: Sealed :: a -> Sealed a
+ Darcs.Witnesses.Sealed: Sealed :: a x -> Sealed a
- Darcs.Witnesses.Sealed: Sealed2 :: !a -> Sealed2 a
+ Darcs.Witnesses.Sealed: Sealed2 :: !a x y -> Sealed2 a
- Darcs.Witnesses.Sealed: data FlippedSeal a
+ Darcs.Witnesses.Sealed: data FlippedSeal a y
- Darcs.Witnesses.Sealed: emptyGap :: (Gap w) => (p) -> w p
+ Darcs.Witnesses.Sealed: emptyGap :: Gap w => (forall x. p x x) -> w p
- Darcs.Witnesses.Sealed: flipSeal :: a -> FlippedSeal a
+ Darcs.Witnesses.Sealed: flipSeal :: a x y -> FlippedSeal a y
- Darcs.Witnesses.Sealed: freeGap :: (Gap w) => (p) -> w p
+ Darcs.Witnesses.Sealed: freeGap :: Gap w => (forall x y. p x y) -> w p
- Darcs.Witnesses.Sealed: joinGap :: (Gap w) => (p -> q -> r) -> w p -> w q -> w r
+ Darcs.Witnesses.Sealed: joinGap :: Gap w => (forall x y z. p x y -> q y z -> r x z) -> w p -> w q -> w r
- Darcs.Witnesses.Sealed: liftSM :: (Monad m) => (a -> b) -> m (Sealed a) -> m b
+ Darcs.Witnesses.Sealed: liftSM :: Monad m => (forall x. a x -> b) -> m (Sealed a) -> m b
- Darcs.Witnesses.Sealed: mapFlipped :: (a -> b) -> FlippedSeal a -> FlippedSeal b
+ Darcs.Witnesses.Sealed: mapFlipped :: (forall x. a x y -> b x z) -> FlippedSeal a y -> FlippedSeal b z
- Darcs.Witnesses.Sealed: mapSeal :: (a -> b) -> Sealed a -> Sealed b
+ Darcs.Witnesses.Sealed: mapSeal :: (forall x. a x -> b x) -> Sealed a -> Sealed b
- Darcs.Witnesses.Sealed: mapSeal2 :: (a -> b) -> Sealed2 a -> Sealed2 b
+ Darcs.Witnesses.Sealed: mapSeal2 :: (forall x y. a x y -> b x y) -> Sealed2 a -> Sealed2 b
- Darcs.Witnesses.Sealed: seal :: a -> Sealed a
+ Darcs.Witnesses.Sealed: seal :: a x -> Sealed a
- Darcs.Witnesses.Sealed: seal2 :: a -> Sealed2 a
+ Darcs.Witnesses.Sealed: seal2 :: a x y -> Sealed2 a
- Darcs.Witnesses.Sealed: unFreeLeft :: FreeLeft p -> Sealed (p)
+ Darcs.Witnesses.Sealed: unFreeLeft :: FreeLeft p -> Sealed (p x)
- Darcs.Witnesses.Sealed: unFreeRight :: FreeRight p -> FlippedSeal p
+ Darcs.Witnesses.Sealed: unFreeRight :: FreeRight p -> FlippedSeal p x
- Darcs.Witnesses.Sealed: unsafeUnseal :: Sealed a -> a
+ Darcs.Witnesses.Sealed: unsafeUnseal :: Sealed a -> a x
- Darcs.Witnesses.Sealed: unsafeUnseal2 :: Sealed2 a -> a
+ Darcs.Witnesses.Sealed: unsafeUnseal2 :: Sealed2 a -> a x y
- Darcs.Witnesses.Sealed: unsafeUnsealFlipped :: FlippedSeal a -> a
+ Darcs.Witnesses.Sealed: unsafeUnsealFlipped :: FlippedSeal a y -> a x y
- Darcs.Witnesses.Sealed: unseal :: (a -> b) -> Sealed a -> b
+ Darcs.Witnesses.Sealed: unseal :: (forall x. a x -> b) -> Sealed a -> b
- Darcs.Witnesses.Sealed: unseal2 :: (a -> b) -> Sealed2 a -> b
+ Darcs.Witnesses.Sealed: unseal2 :: (forall x y. a x y -> b) -> Sealed2 a -> b
- Darcs.Witnesses.Sealed: unsealFlipped :: (a -> b) -> FlippedSeal a -> b
+ Darcs.Witnesses.Sealed: unsealFlipped :: (forall x y. a x y -> b) -> FlippedSeal a z -> b
- Darcs.Witnesses.Sealed: unsealM :: (Monad m) => m (Sealed a) -> (a -> m b) -> m b
+ Darcs.Witnesses.Sealed: unsealM :: Monad m => m (Sealed a) -> (forall x. a x -> m b) -> m b
- Darcs.Witnesses.Show: show1 :: (Show1 a) => a -> String
+ Darcs.Witnesses.Show: show1 :: Show1 a => a x -> String
- Darcs.Witnesses.Show: show2 :: (Show2 a) => a -> String
+ Darcs.Witnesses.Show: show2 :: Show2 a => a x y -> String
- Darcs.Witnesses.Show: showDict1 :: (Show1 a) => ShowDict (a)
+ Darcs.Witnesses.Show: showDict1 :: Show1 a => ShowDict (a x)
- Darcs.Witnesses.Show: showDict2 :: (Show2 a) => ShowDict (a)
+ Darcs.Witnesses.Show: showDict2 :: Show2 a => ShowDict (a x y)
- Darcs.Witnesses.Show: showOp2 :: (Show2 a, Show2 b) => Int -> String -> Int -> a -> b -> String -> String
+ Darcs.Witnesses.Show: showOp2 :: (Show2 a, Show2 b) => Int -> String -> Int -> a w x -> b y z -> String -> String
- Darcs.Witnesses.Show: showsPrec1 :: (Show1 a) => Int -> a -> ShowS
+ Darcs.Witnesses.Show: showsPrec1 :: Show1 a => Int -> a x -> ShowS
- Darcs.Witnesses.Show: showsPrec2 :: (Show2 a) => Int -> a -> ShowS
+ Darcs.Witnesses.Show: showsPrec2 :: Show2 a => Int -> a x y -> ShowS
- Darcs.Witnesses.WZipper: FZipper :: RL a -> FL a -> FZipper a
+ Darcs.Witnesses.WZipper: FZipper :: RL a x y -> FL a y z -> FZipper a x z
- Darcs.Witnesses.WZipper: clowns :: FZipper a -> Sealed ((RL a))
+ Darcs.Witnesses.WZipper: clowns :: FZipper a x y -> Sealed ((RL a) x)
- Darcs.Witnesses.WZipper: data FZipper a
+ Darcs.Witnesses.WZipper: data FZipper a x z
- Darcs.Witnesses.WZipper: flToZipper :: FL a -> FZipper a
+ Darcs.Witnesses.WZipper: flToZipper :: FL a x y -> FZipper a x y
- Darcs.Witnesses.WZipper: focus :: FZipper a -> Maybe (Sealed2 a)
+ Darcs.Witnesses.WZipper: focus :: FZipper a x y -> Maybe (Sealed2 a)
- Darcs.Witnesses.WZipper: jokers :: FZipper a -> FlippedSeal (FL a)
+ Darcs.Witnesses.WZipper: jokers :: FZipper a x y -> FlippedSeal (FL a) y
- Darcs.Witnesses.WZipper: left :: FZipper p -> FZipper p
+ Darcs.Witnesses.WZipper: left :: FZipper p x y -> FZipper p x y
- Darcs.Witnesses.WZipper: leftmost :: FZipper p -> Bool
+ Darcs.Witnesses.WZipper: leftmost :: FZipper p x y -> Bool
- Darcs.Witnesses.WZipper: lengthFZ :: FZipper a -> Int
+ Darcs.Witnesses.WZipper: lengthFZ :: FZipper a x y -> Int
- Darcs.Witnesses.WZipper: nullFZ :: FZipper a -> Bool
+ Darcs.Witnesses.WZipper: nullFZ :: FZipper a x y -> Bool
- Darcs.Witnesses.WZipper: right :: FZipper p -> FZipper p
+ Darcs.Witnesses.WZipper: right :: FZipper p x y -> FZipper p x y
- Darcs.Witnesses.WZipper: rightmost :: FZipper p -> Bool
+ Darcs.Witnesses.WZipper: rightmost :: FZipper p x y -> Bool
- Darcs.Witnesses.WZipper: toEnd :: FZipper p -> FZipper p
+ Darcs.Witnesses.WZipper: toEnd :: FZipper p x y -> FZipper p x y
- English: englishNum :: (Countable n) => Int -> n -> ShowS
+ English: englishNum :: Countable n => Int -> n -> ShowS
- English: plural :: (Countable a) => a -> ShowS
+ English: plural :: Countable a => a -> ShowS
- English: singular :: (Countable a) => a -> ShowS
+ English: singular :: Countable a => a -> ShowS
- HTTP: waitNextUrl :: IO (String, String)
+ HTTP: waitNextUrl :: IO (String, String, Maybe ConnectionError)
- Ssh: copySSH :: String -> String -> FilePath -> IO ()
+ Ssh: copySSH :: RemoteDarcs -> SshFilePath -> FilePath -> IO ()
- Ssh: getSSH :: SSHCmd -> String -> IO (String, [String])
+ Ssh: getSSH :: SSHCmd -> SshFilePath -> IO (String, [String])
- Ssh: runSSH :: SSHCmd -> String -> [String] -> [String] -> Redirects -> IO ExitCode
+ Ssh: runSSH :: SSHCmd -> SshFilePath -> [String] -> Redirects -> IO ExitCode
Files
- Distribution/ShellHarness.hs +0/−196
- GNUmakefile +8/−17
- NEWS +59/−0
- README +19/−14
- Setup.lhs +22/−164
- contrib/update_roundup.pl +4/−3
- darcs-beta.cabal +224/−235
- dist/build/ByteStringUtils.hi binary
- dist/build/ByteStringUtils.o binary
- dist/build/CommandLine.hi binary
- dist/build/CommandLine.o binary
- dist/build/Crypt/SHA256.hi binary
- dist/build/Crypt/SHA256.o binary
- dist/build/Darcs/Annotate.hi binary
- dist/build/Darcs/Annotate.o binary
- dist/build/Darcs/ArgumentDefaults.hi binary
- dist/build/Darcs/ArgumentDefaults.o binary
- dist/build/Darcs/Arguments.hi binary
- dist/build/Darcs/Arguments.o binary
- dist/build/Darcs/Bug.hi binary
- dist/build/Darcs/Bug.o binary
- dist/build/Darcs/ColorPrinter.hi binary
- dist/build/Darcs/ColorPrinter.o binary
- dist/build/Darcs/Commands.hi binary
- dist/build/Darcs/Commands.o binary
- dist/build/Darcs/Commands/Add.hi binary
- dist/build/Darcs/Commands/Add.o binary
- dist/build/Darcs/Commands/AmendRecord.hi binary
- dist/build/Darcs/Commands/AmendRecord.o binary
- dist/build/Darcs/Commands/Annotate.hi binary
- dist/build/Darcs/Commands/Annotate.o binary
- dist/build/Darcs/Commands/Apply.hi binary
- dist/build/Darcs/Commands/Apply.o binary
- dist/build/Darcs/Commands/Changes.hi binary
- dist/build/Darcs/Commands/Changes.o binary
- dist/build/Darcs/Commands/Check.hi binary
- dist/build/Darcs/Commands/Check.o binary
- dist/build/Darcs/Commands/Convert.hi binary
- dist/build/Darcs/Commands/Convert.o binary
- dist/build/Darcs/Commands/Diff.hi binary
- dist/build/Darcs/Commands/Diff.o binary
- dist/build/Darcs/Commands/Dist.hi binary
- dist/build/Darcs/Commands/Dist.o binary
- dist/build/Darcs/Commands/GZCRCs.hi binary
- dist/build/Darcs/Commands/GZCRCs.o binary
- dist/build/Darcs/Commands/Get.hi binary
- dist/build/Darcs/Commands/Get.o binary
- dist/build/Darcs/Commands/Help.hi binary
- dist/build/Darcs/Commands/Help.o binary
- dist/build/Darcs/Commands/Init.hi binary
- dist/build/Darcs/Commands/Init.o binary
- dist/build/Darcs/Commands/MarkConflicts.hi binary
- dist/build/Darcs/Commands/MarkConflicts.o binary
- dist/build/Darcs/Commands/Move.hi binary
- dist/build/Darcs/Commands/Move.o binary
- dist/build/Darcs/Commands/Optimize.hi binary
- dist/build/Darcs/Commands/Optimize.o binary
- dist/build/Darcs/Commands/Pull.hi binary
- dist/build/Darcs/Commands/Pull.o binary
- dist/build/Darcs/Commands/Push.hi binary
- dist/build/Darcs/Commands/Push.o binary
- dist/build/Darcs/Commands/Put.hi binary
- dist/build/Darcs/Commands/Put.o binary
- dist/build/Darcs/Commands/Record.hi binary
- dist/build/Darcs/Commands/Record.o binary
- dist/build/Darcs/Commands/Remove.hi binary
- dist/build/Darcs/Commands/Remove.o binary
- dist/build/Darcs/Commands/Replace.hi binary
- dist/build/Darcs/Commands/Replace.o binary
- dist/build/Darcs/Commands/Revert.hi binary
- dist/build/Darcs/Commands/Revert.o binary
- dist/build/Darcs/Commands/Rollback.hi binary
- dist/build/Darcs/Commands/Rollback.o binary
- dist/build/Darcs/Commands/Send.hi binary
- dist/build/Darcs/Commands/Send.o binary
- dist/build/Darcs/Commands/SetPref.hi binary
- dist/build/Darcs/Commands/SetPref.o binary
- dist/build/Darcs/Commands/Show.hi binary
- dist/build/Darcs/Commands/Show.o binary
- dist/build/Darcs/Commands/ShowAuthors.hi binary
- dist/build/Darcs/Commands/ShowAuthors.o binary
- dist/build/Darcs/Commands/ShowBug.hi binary
- dist/build/Darcs/Commands/ShowBug.o binary
- dist/build/Darcs/Commands/ShowContents.hi binary
- dist/build/Darcs/Commands/ShowContents.o binary
- dist/build/Darcs/Commands/ShowFiles.hi binary
- dist/build/Darcs/Commands/ShowFiles.o binary
- dist/build/Darcs/Commands/ShowIndex.hi binary
- dist/build/Darcs/Commands/ShowIndex.o binary
- dist/build/Darcs/Commands/ShowRepo.hi binary
- dist/build/Darcs/Commands/ShowRepo.o binary
- dist/build/Darcs/Commands/ShowTags.hi binary
- dist/build/Darcs/Commands/ShowTags.o binary
- dist/build/Darcs/Commands/Tag.hi binary
- dist/build/Darcs/Commands/Tag.o binary
- dist/build/Darcs/Commands/TrackDown.hi binary
- dist/build/Darcs/Commands/TrackDown.o binary
- dist/build/Darcs/Commands/TransferMode.hi binary
- dist/build/Darcs/Commands/TransferMode.o binary
- dist/build/Darcs/Commands/Unrecord.hi binary
- dist/build/Darcs/Commands/Unrecord.o binary
- dist/build/Darcs/Commands/Unrevert.hi binary
- dist/build/Darcs/Commands/Unrevert.o binary
- dist/build/Darcs/Commands/Util.hi binary
- dist/build/Darcs/Commands/Util.o binary
- dist/build/Darcs/Commands/WhatsNew.hi binary
- dist/build/Darcs/Commands/WhatsNew.o binary
- dist/build/Darcs/CommandsAux.hi binary
- dist/build/Darcs/CommandsAux.o binary
- dist/build/Darcs/Compat.hi binary
- dist/build/Darcs/Compat.o binary
- dist/build/Darcs/Diff.hi binary
- dist/build/Darcs/Diff.o binary
- dist/build/Darcs/Email.hi binary
- dist/build/Darcs/Email.o binary
- dist/build/Darcs/External.hi binary
- dist/build/Darcs/External.o binary
- dist/build/Darcs/Flags.hi binary
- dist/build/Darcs/Flags.o binary
- dist/build/Darcs/Global.hi binary
- dist/build/Darcs/Global.o binary
- dist/build/Darcs/IO.hi binary
- dist/build/Darcs/IO.o binary
- dist/build/Darcs/Lock.hi binary
- dist/build/Darcs/Lock.o binary
- dist/build/Darcs/Match.hi binary
- dist/build/Darcs/Match.o binary
- dist/build/Darcs/MonadProgress.hi binary
- dist/build/Darcs/MonadProgress.o binary
- dist/build/Darcs/Patch.hi binary
- dist/build/Darcs/Patch.o binary
- dist/build/Darcs/Patch/Apply.hi binary
- dist/build/Darcs/Patch/Apply.o binary
- dist/build/Darcs/Patch/ApplyMonad.hi binary
- dist/build/Darcs/Patch/ApplyMonad.o binary
- dist/build/Darcs/Patch/Bracketed.hi binary
- dist/build/Darcs/Patch/Bracketed.o binary
- dist/build/Darcs/Patch/Bracketed/Instances.hi binary
- dist/build/Darcs/Patch/Bracketed/Instances.o binary
- dist/build/Darcs/Patch/Bundle.hi binary
- dist/build/Darcs/Patch/Bundle.o binary
- dist/build/Darcs/Patch/Choices.hi binary
- dist/build/Darcs/Patch/Choices.o binary
- dist/build/Darcs/Patch/Commute.hi binary
- dist/build/Darcs/Patch/Commute.o binary
- dist/build/Darcs/Patch/Conflict.hi binary
- dist/build/Darcs/Patch/Conflict.o binary
- dist/build/Darcs/Patch/ConflictMarking.hi binary
- dist/build/Darcs/Patch/ConflictMarking.o binary
- dist/build/Darcs/Patch/Depends.hi binary
- dist/build/Darcs/Patch/Depends.o binary
- dist/build/Darcs/Patch/Dummy.hi binary
- dist/build/Darcs/Patch/Dummy.o binary
- dist/build/Darcs/Patch/Effect.hi binary
- dist/build/Darcs/Patch/Effect.o binary
- dist/build/Darcs/Patch/FileHunk.hi binary
- dist/build/Darcs/Patch/FileHunk.o binary
- dist/build/Darcs/Patch/FileName.hi binary
- dist/build/Darcs/Patch/FileName.o binary
- dist/build/Darcs/Patch/Format.hi binary
- dist/build/Darcs/Patch/Format.o binary
- dist/build/Darcs/Patch/Info.hi binary
- dist/build/Darcs/Patch/Info.o binary
- dist/build/Darcs/Patch/Inspect.hi binary
- dist/build/Darcs/Patch/Inspect.o binary
- dist/build/Darcs/Patch/Invert.hi binary
- dist/build/Darcs/Patch/Invert.o binary
- dist/build/Darcs/Patch/Match.hi binary
- dist/build/Darcs/Patch/Match.o binary
- dist/build/Darcs/Patch/MatchData.hi binary
- dist/build/Darcs/Patch/MatchData.o binary
- dist/build/Darcs/Patch/Merge.hi binary
- dist/build/Darcs/Patch/Merge.o binary
- dist/build/Darcs/Patch/Named.hi binary
- dist/build/Darcs/Patch/Named.o binary
- dist/build/Darcs/Patch/OldDate.hi binary
- dist/build/Darcs/Patch/OldDate.o binary
- dist/build/Darcs/Patch/PatchInfoAnd.hi binary
- dist/build/Darcs/Patch/PatchInfoAnd.o binary
- dist/build/Darcs/Patch/Patchy.hi binary
- dist/build/Darcs/Patch/Patchy.o binary
- dist/build/Darcs/Patch/Patchy/Instances.hi binary
- dist/build/Darcs/Patch/Patchy/Instances.o binary
- dist/build/Darcs/Patch/Permutations.hi binary
- dist/build/Darcs/Patch/Permutations.o binary
- dist/build/Darcs/Patch/Prim.hi binary
- dist/build/Darcs/Patch/Prim.o binary
- dist/build/Darcs/Patch/Prim/Class.hi binary
- dist/build/Darcs/Patch/Prim/Class.o binary
- dist/build/Darcs/Patch/Prim/V1.hi binary
- dist/build/Darcs/Patch/Prim/V1.o binary
- dist/build/Darcs/Patch/Prim/V1/Apply.hi binary
- dist/build/Darcs/Patch/Prim/V1/Apply.o binary
- dist/build/Darcs/Patch/Prim/V1/Coalesce.hi binary
- dist/build/Darcs/Patch/Prim/V1/Coalesce.o binary
- dist/build/Darcs/Patch/Prim/V1/Commute.hi binary
- dist/build/Darcs/Patch/Prim/V1/Commute.o binary
- dist/build/Darcs/Patch/Prim/V1/Core.hi binary
- dist/build/Darcs/Patch/Prim/V1/Core.o binary
- dist/build/Darcs/Patch/Prim/V1/Details.hi binary
- dist/build/Darcs/Patch/Prim/V1/Details.o binary
- dist/build/Darcs/Patch/Prim/V1/Read.hi binary
- dist/build/Darcs/Patch/Prim/V1/Read.o binary
- dist/build/Darcs/Patch/Prim/V1/Show.hi binary
- dist/build/Darcs/Patch/Prim/V1/Show.o binary
- dist/build/Darcs/Patch/Read.hi binary
- dist/build/Darcs/Patch/Read.o binary
- dist/build/Darcs/Patch/ReadMonads.hi binary
- dist/build/Darcs/Patch/ReadMonads.o binary
- dist/build/Darcs/Patch/RegChars.hi binary
- dist/build/Darcs/Patch/RegChars.o binary
- dist/build/Darcs/Patch/Repair.hi binary
- dist/build/Darcs/Patch/Repair.o binary
- dist/build/Darcs/Patch/RepoPatch.hi binary
- dist/build/Darcs/Patch/RepoPatch.o binary
- dist/build/Darcs/Patch/Set.hi binary
- dist/build/Darcs/Patch/Set.o binary
- dist/build/Darcs/Patch/Show.hi binary
- dist/build/Darcs/Patch/Show.o binary
- dist/build/Darcs/Patch/Split.hi binary
- dist/build/Darcs/Patch/Split.o binary
- dist/build/Darcs/Patch/Summary.hi binary
- dist/build/Darcs/Patch/Summary.o binary
- dist/build/Darcs/Patch/SummaryData.hi binary
- dist/build/Darcs/Patch/SummaryData.o binary
- dist/build/Darcs/Patch/TokenReplace.hi binary
- dist/build/Darcs/Patch/TokenReplace.o binary
- dist/build/Darcs/Patch/TouchesFiles.hi binary
- dist/build/Darcs/Patch/TouchesFiles.o binary
- dist/build/Darcs/Patch/V1.hi binary
- dist/build/Darcs/Patch/V1.o binary
- dist/build/Darcs/Patch/V1/Apply.hi binary
- dist/build/Darcs/Patch/V1/Apply.o binary
- dist/build/Darcs/Patch/V1/Commute.hi binary
- dist/build/Darcs/Patch/V1/Commute.o binary
- dist/build/Darcs/Patch/V1/Core.hi binary
- dist/build/Darcs/Patch/V1/Core.o binary
- dist/build/Darcs/Patch/V1/Read.hi binary
- dist/build/Darcs/Patch/V1/Read.o binary
- dist/build/Darcs/Patch/V1/Show.hi binary
- dist/build/Darcs/Patch/V1/Show.o binary
- dist/build/Darcs/Patch/V1/Viewing.hi binary
- dist/build/Darcs/Patch/V1/Viewing.o binary
- dist/build/Darcs/Patch/V2.hi binary
- dist/build/Darcs/Patch/V2.o binary
- dist/build/Darcs/Patch/V2/Non.hi binary
- dist/build/Darcs/Patch/V2/Non.o binary
- dist/build/Darcs/Patch/V2/Real.hi binary
- dist/build/Darcs/Patch/V2/Real.o binary
- dist/build/Darcs/Patch/Viewing.hi binary
- dist/build/Darcs/Patch/Viewing.o binary
- dist/build/Darcs/PrintPatch.hi binary
- dist/build/Darcs/PrintPatch.o binary
- dist/build/Darcs/ProgressPatches.hi binary
- dist/build/Darcs/ProgressPatches.o binary
- dist/build/Darcs/RemoteApply.hi binary
- dist/build/Darcs/RemoteApply.o binary
- dist/build/Darcs/RepoPath.hi binary
- dist/build/Darcs/RepoPath.o binary
- dist/build/Darcs/Repository.hi binary
- dist/build/Darcs/Repository.o binary
- dist/build/Darcs/Repository/ApplyPatches.hi binary
- dist/build/Darcs/Repository/ApplyPatches.o binary
- dist/build/Darcs/Repository/Cache.hi binary
- dist/build/Darcs/Repository/Cache.o binary
- dist/build/Darcs/Repository/Format.hi binary
- dist/build/Darcs/Repository/Format.o binary
- dist/build/Darcs/Repository/HashedIO.hi binary
- dist/build/Darcs/Repository/HashedIO.o binary
- dist/build/Darcs/Repository/HashedRepo.hi binary
- dist/build/Darcs/Repository/HashedRepo.o binary
- dist/build/Darcs/Repository/Internal.hi binary
- dist/build/Darcs/Repository/Internal.o binary
- dist/build/Darcs/Repository/InternalTypes.hi binary
- dist/build/Darcs/Repository/InternalTypes.o binary
- dist/build/Darcs/Repository/LowLevel.hi binary
- dist/build/Darcs/Repository/LowLevel.o binary
- dist/build/Darcs/Repository/Merge.hi binary
- dist/build/Darcs/Repository/Merge.o binary
- dist/build/Darcs/Repository/Motd.hi binary
- dist/build/Darcs/Repository/Motd.o binary
- dist/build/Darcs/Repository/Old.hi binary
- dist/build/Darcs/Repository/Old.o binary
- dist/build/Darcs/Repository/Prefs.hi binary
- dist/build/Darcs/Repository/Prefs.o binary
- dist/build/Darcs/Repository/Repair.hi binary
- dist/build/Darcs/Repository/Repair.o binary
- dist/build/Darcs/Repository/State.hi binary
- dist/build/Darcs/Repository/State.o binary
- dist/build/Darcs/Resolution.hi binary
- dist/build/Darcs/Resolution.o binary
- dist/build/Darcs/RunCommand.hi binary
- dist/build/Darcs/RunCommand.o binary
- dist/build/Darcs/SelectChanges.hi binary
- dist/build/Darcs/SelectChanges.o binary
- dist/build/Darcs/SignalHandler.hi binary
- dist/build/Darcs/SignalHandler.o binary
- dist/build/Darcs/Test.hi binary
- dist/build/Darcs/Test.o binary
- dist/build/Darcs/TheCommands.hi binary
- dist/build/Darcs/TheCommands.o binary
- dist/build/Darcs/URL.hi binary
- dist/build/Darcs/URL.o binary
- dist/build/Darcs/Utils.hi binary
- dist/build/Darcs/Utils.o binary
- dist/build/Darcs/Witnesses/Eq.hi binary
- dist/build/Darcs/Witnesses/Eq.o binary
- dist/build/Darcs/Witnesses/Ordered.hi binary
- dist/build/Darcs/Witnesses/Ordered.o binary
- dist/build/Darcs/Witnesses/Sealed.hi binary
- dist/build/Darcs/Witnesses/Sealed.o binary
- dist/build/Darcs/Witnesses/Show.hi binary
- dist/build/Darcs/Witnesses/Show.o binary
- dist/build/Darcs/Witnesses/Unsafe.hi binary
- dist/build/Darcs/Witnesses/Unsafe.o binary
- dist/build/Darcs/Witnesses/WZipper.hi binary
- dist/build/Darcs/Witnesses/WZipper.o binary
- dist/build/DateMatcher.hi binary
- dist/build/DateMatcher.o binary
- dist/build/English.hi binary
- dist/build/English.o binary
- dist/build/Exec.hi binary
- dist/build/Exec.o binary
- dist/build/HSdarcs-beta-2.7.98.1.o too large to diff
- dist/build/HTTP.hi binary
- dist/build/HTTP.o binary
- dist/build/IsoDate.hi binary
- dist/build/IsoDate.o binary
- dist/build/Lcs.hi binary
- dist/build/Lcs.o binary
- dist/build/Printer.hi binary
- dist/build/Printer.o binary
- dist/build/Progress.hi binary
- dist/build/Progress.o binary
- dist/build/Ratified.hi binary
- dist/build/Ratified.o binary
- dist/build/SHA1.hi binary
- dist/build/SHA1.o binary
- dist/build/Ssh.hi binary
- dist/build/Ssh.o binary
- dist/build/URL.hi binary
- dist/build/URL.o binary
- dist/build/Version.hi binary
- dist/build/Version.o binary
- dist/build/Workaround.hi binary
- dist/build/Workaround.o binary
- dist/build/autogen/Paths_darcs_beta.hs +29/−0
- dist/build/autogen/Version.hs +5/−0
- dist/build/autogen/cabal_macros.h +226/−0
- dist/build/darcs-test/darcs-test too large to diff
- dist/build/darcs-test/darcs-test-tmp/ByteStringUtils.hi binary
- dist/build/darcs-test/darcs-test-tmp/ByteStringUtils.o binary
- dist/build/darcs-test/darcs-test-tmp/CommandLine.hi binary
- dist/build/darcs-test/darcs-test-tmp/CommandLine.o binary
- dist/build/darcs-test/darcs-test-tmp/Crypt/SHA256.hi binary
- dist/build/darcs-test/darcs-test-tmp/Crypt/SHA256.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Arguments.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Arguments.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Bug.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Bug.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/ColorPrinter.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/ColorPrinter.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Commands.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Commands.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Commands/Replace.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Commands/Replace.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/CommandsAux.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/CommandsAux.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Compat.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Compat.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Diff.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Diff.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Email.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Email.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/External.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/External.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Flags.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Flags.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Global.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Global.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/IO.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/IO.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Lock.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Lock.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/MonadProgress.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/MonadProgress.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Apply.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Apply.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/ApplyMonad.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/ApplyMonad.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Bracketed.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Bracketed.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Bracketed/Instances.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Bracketed/Instances.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Bundle.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Bundle.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Commute.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Commute.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Conflict.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Conflict.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/ConflictMarking.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/ConflictMarking.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Depends.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Depends.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Dummy.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Dummy.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Effect.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Effect.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/FileHunk.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/FileHunk.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/FileName.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/FileName.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Format.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Format.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Info.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Info.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Inspect.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Inspect.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Invert.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Invert.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/MatchData.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/MatchData.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Merge.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Merge.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Named.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Named.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/OldDate.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/OldDate.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/PatchInfoAnd.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/PatchInfoAnd.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Patchy.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Patchy.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Patchy/Instances.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Patchy/Instances.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Permutations.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Permutations.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/Class.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/Class.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Apply.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Apply.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Coalesce.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Coalesce.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Commute.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Commute.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Core.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Core.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Details.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Details.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Read.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Read.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Show.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Show.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Read.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Read.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/ReadMonads.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/ReadMonads.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/RegChars.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/RegChars.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Repair.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Repair.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/RepoPatch.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/RepoPatch.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Set.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Set.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Show.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Show.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Summary.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Summary.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/SummaryData.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/SummaryData.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/TokenReplace.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/TokenReplace.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Apply.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Apply.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Commute.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Commute.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Core.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Core.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Read.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Read.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Show.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Show.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Viewing.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Viewing.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V2.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V2.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V2/Non.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V2/Non.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V2/Real.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V2/Real.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Viewing.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Viewing.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/ProgressPatches.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/ProgressPatches.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/RepoPath.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/RepoPath.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/ApplyPatches.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/ApplyPatches.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Cache.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Cache.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Format.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Format.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/HashedIO.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/HashedIO.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/HashedRepo.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/HashedRepo.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Internal.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Internal.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/InternalTypes.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/InternalTypes.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/LowLevel.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/LowLevel.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Merge.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Merge.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Old.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Old.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Prefs.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Prefs.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/State.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/State.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Resolution.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Resolution.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/SignalHandler.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/SignalHandler.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Email.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Email.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Misc.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Misc.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Check.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Check.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Examples.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Examples.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Examples2.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Examples2.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Info.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Info.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Prim/V1.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Prim/V1.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Properties.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Properties.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Properties2.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Properties2.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/QuickCheck.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/QuickCheck.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/RepoModel.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/RepoModel.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Test.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Test.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Unit.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Unit.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Unit2.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Unit2.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Utils.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Utils.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/WithState.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/WithState.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Util/QuickCheck.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Util/QuickCheck.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Util/TestResult.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Util/TestResult.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/URL.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/URL.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Utils.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Utils.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Eq.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Eq.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Ordered.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Ordered.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Sealed.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Sealed.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Show.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Show.o binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Unsafe.hi binary
- dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Unsafe.o binary
- dist/build/darcs-test/darcs-test-tmp/English.hi binary
- dist/build/darcs-test/darcs-test-tmp/English.o binary
- dist/build/darcs-test/darcs-test-tmp/Exec.hi binary
- dist/build/darcs-test/darcs-test-tmp/Exec.o binary
- dist/build/darcs-test/darcs-test-tmp/HTTP.hi binary
- dist/build/darcs-test/darcs-test-tmp/HTTP.o binary
- dist/build/darcs-test/darcs-test-tmp/Lcs.hi binary
- dist/build/darcs-test/darcs-test-tmp/Lcs.o binary
- dist/build/darcs-test/darcs-test-tmp/Main.hi binary
- dist/build/darcs-test/darcs-test-tmp/Main.o binary
- dist/build/darcs-test/darcs-test-tmp/Printer.hi binary
- dist/build/darcs-test/darcs-test-tmp/Printer.o binary
- dist/build/darcs-test/darcs-test-tmp/Progress.hi binary
- dist/build/darcs-test/darcs-test-tmp/Progress.o binary
- dist/build/darcs-test/darcs-test-tmp/Ratified.hi binary
- dist/build/darcs-test/darcs-test-tmp/Ratified.o binary
- dist/build/darcs-test/darcs-test-tmp/SHA1.hi binary
- dist/build/darcs-test/darcs-test-tmp/SHA1.o binary
- dist/build/darcs-test/darcs-test-tmp/Ssh.hi binary
- dist/build/darcs-test/darcs-test-tmp/Ssh.o binary
- dist/build/darcs-test/darcs-test-tmp/URL.hi binary
- dist/build/darcs-test/darcs-test-tmp/URL.o binary
- dist/build/darcs-test/darcs-test-tmp/Version.hi binary
- dist/build/darcs-test/darcs-test-tmp/Version.o binary
- dist/build/darcs-test/darcs-test-tmp/Workaround.hi binary
- dist/build/darcs-test/darcs-test-tmp/Workaround.o binary
- dist/build/darcs-test/darcs-test-tmp/src/Crypt/sha2.o binary
- dist/build/darcs-test/darcs-test-tmp/src/atomic_create.o binary
- dist/build/darcs-test/darcs-test-tmp/src/fpstring.o binary
- dist/build/darcs-test/darcs-test-tmp/src/maybe_relink.o binary
- dist/build/darcs-test/darcs-test-tmp/src/umask.o binary
- dist/build/darcs/darcs too large to diff
- dist/build/darcs/darcs-tmp/ByteStringUtils.hi binary
- dist/build/darcs/darcs-tmp/ByteStringUtils.o binary
- dist/build/darcs/darcs-tmp/CommandLine.hi binary
- dist/build/darcs/darcs-tmp/CommandLine.o binary
- dist/build/darcs/darcs-tmp/Crypt/SHA256.hi binary
- dist/build/darcs/darcs-tmp/Crypt/SHA256.o binary
- dist/build/darcs/darcs-tmp/Darcs/Annotate.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Annotate.o binary
- dist/build/darcs/darcs-tmp/Darcs/ArgumentDefaults.hi binary
- dist/build/darcs/darcs-tmp/Darcs/ArgumentDefaults.o binary
- dist/build/darcs/darcs-tmp/Darcs/Arguments.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Arguments.o binary
- dist/build/darcs/darcs-tmp/Darcs/Bug.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Bug.o binary
- dist/build/darcs/darcs-tmp/Darcs/ColorPrinter.hi binary
- dist/build/darcs/darcs-tmp/Darcs/ColorPrinter.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Add.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Add.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/AmendRecord.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/AmendRecord.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Annotate.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Annotate.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Apply.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Apply.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Changes.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Changes.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Check.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Check.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Convert.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Convert.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Diff.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Diff.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Dist.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Dist.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/GZCRCs.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/GZCRCs.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Get.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Get.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Help.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Help.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Init.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Init.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/MarkConflicts.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/MarkConflicts.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Move.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Move.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Optimize.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Optimize.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Pull.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Pull.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Push.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Push.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Put.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Put.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Record.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Record.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Remove.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Remove.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Replace.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Replace.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Revert.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Revert.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Rollback.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Rollback.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Send.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Send.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/SetPref.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/SetPref.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Show.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Show.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/ShowAuthors.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/ShowAuthors.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/ShowBug.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/ShowBug.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/ShowContents.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/ShowContents.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/ShowFiles.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/ShowFiles.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/ShowIndex.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/ShowIndex.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/ShowRepo.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/ShowRepo.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/ShowTags.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/ShowTags.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Tag.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Tag.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/TrackDown.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/TrackDown.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/TransferMode.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/TransferMode.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Unrecord.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Unrecord.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Unrevert.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Unrevert.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Util.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/Util.o binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/WhatsNew.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Commands/WhatsNew.o binary
- dist/build/darcs/darcs-tmp/Darcs/CommandsAux.hi binary
- dist/build/darcs/darcs-tmp/Darcs/CommandsAux.o binary
- dist/build/darcs/darcs-tmp/Darcs/Compat.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Compat.o binary
- dist/build/darcs/darcs-tmp/Darcs/Diff.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Diff.o binary
- dist/build/darcs/darcs-tmp/Darcs/Email.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Email.o binary
- dist/build/darcs/darcs-tmp/Darcs/External.hi binary
- dist/build/darcs/darcs-tmp/Darcs/External.o binary
- dist/build/darcs/darcs-tmp/Darcs/Flags.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Flags.o binary
- dist/build/darcs/darcs-tmp/Darcs/Global.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Global.o binary
- dist/build/darcs/darcs-tmp/Darcs/IO.hi binary
- dist/build/darcs/darcs-tmp/Darcs/IO.o binary
- dist/build/darcs/darcs-tmp/Darcs/Lock.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Lock.o binary
- dist/build/darcs/darcs-tmp/Darcs/Match.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Match.o binary
- dist/build/darcs/darcs-tmp/Darcs/MonadProgress.hi binary
- dist/build/darcs/darcs-tmp/Darcs/MonadProgress.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Apply.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Apply.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/ApplyMonad.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/ApplyMonad.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Bracketed.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Bracketed.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Bracketed/Instances.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Bracketed/Instances.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Bundle.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Bundle.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Choices.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Choices.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Commute.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Commute.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Conflict.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Conflict.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/ConflictMarking.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/ConflictMarking.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Depends.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Depends.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Dummy.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Dummy.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Effect.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Effect.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/FileHunk.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/FileHunk.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/FileName.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/FileName.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Format.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Format.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Info.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Info.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Inspect.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Inspect.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Invert.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Invert.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Match.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Match.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/MatchData.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/MatchData.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Merge.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Merge.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Named.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Named.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/OldDate.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/OldDate.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/PatchInfoAnd.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/PatchInfoAnd.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Patchy.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Patchy.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Patchy/Instances.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Patchy/Instances.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Permutations.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Permutations.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/Class.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/Class.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Apply.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Apply.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Coalesce.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Coalesce.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Commute.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Commute.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Core.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Core.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Details.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Details.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Read.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Read.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Show.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Show.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Read.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Read.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/ReadMonads.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/ReadMonads.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/RegChars.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/RegChars.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Repair.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Repair.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/RepoPatch.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/RepoPatch.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Set.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Set.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Show.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Show.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Split.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Split.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Summary.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Summary.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/SummaryData.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/SummaryData.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/TokenReplace.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/TokenReplace.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/TouchesFiles.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/TouchesFiles.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V1.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V1.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Apply.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Apply.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Commute.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Commute.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Core.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Core.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Read.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Read.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Show.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Show.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Viewing.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Viewing.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V2.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V2.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V2/Non.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V2/Non.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V2/Real.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/V2/Real.o binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Viewing.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Patch/Viewing.o binary
- dist/build/darcs/darcs-tmp/Darcs/PrintPatch.hi binary
- dist/build/darcs/darcs-tmp/Darcs/PrintPatch.o binary
- dist/build/darcs/darcs-tmp/Darcs/ProgressPatches.hi binary
- dist/build/darcs/darcs-tmp/Darcs/ProgressPatches.o binary
- dist/build/darcs/darcs-tmp/Darcs/RemoteApply.hi binary
- dist/build/darcs/darcs-tmp/Darcs/RemoteApply.o binary
- dist/build/darcs/darcs-tmp/Darcs/RepoPath.hi binary
- dist/build/darcs/darcs-tmp/Darcs/RepoPath.o binary
- dist/build/darcs/darcs-tmp/Darcs/Repository.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Repository.o binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/ApplyPatches.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/ApplyPatches.o binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/Cache.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/Cache.o binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/Format.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/Format.o binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/HashedIO.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/HashedIO.o binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/HashedRepo.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/HashedRepo.o binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/Internal.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/Internal.o binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/InternalTypes.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/InternalTypes.o binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/LowLevel.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/LowLevel.o binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/Merge.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/Merge.o binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/Motd.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/Motd.o binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/Old.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/Old.o binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/Prefs.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/Prefs.o binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/Repair.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/Repair.o binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/State.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Repository/State.o binary
- dist/build/darcs/darcs-tmp/Darcs/Resolution.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Resolution.o binary
- dist/build/darcs/darcs-tmp/Darcs/RunCommand.hi binary
- dist/build/darcs/darcs-tmp/Darcs/RunCommand.o binary
- dist/build/darcs/darcs-tmp/Darcs/SelectChanges.hi binary
- dist/build/darcs/darcs-tmp/Darcs/SelectChanges.o binary
- dist/build/darcs/darcs-tmp/Darcs/SignalHandler.hi binary
- dist/build/darcs/darcs-tmp/Darcs/SignalHandler.o binary
- dist/build/darcs/darcs-tmp/Darcs/Test.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Test.o binary
- dist/build/darcs/darcs-tmp/Darcs/TheCommands.hi binary
- dist/build/darcs/darcs-tmp/Darcs/TheCommands.o binary
- dist/build/darcs/darcs-tmp/Darcs/URL.hi binary
- dist/build/darcs/darcs-tmp/Darcs/URL.o binary
- dist/build/darcs/darcs-tmp/Darcs/Utils.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Utils.o binary
- dist/build/darcs/darcs-tmp/Darcs/Witnesses/Eq.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Witnesses/Eq.o binary
- dist/build/darcs/darcs-tmp/Darcs/Witnesses/Ordered.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Witnesses/Ordered.o binary
- dist/build/darcs/darcs-tmp/Darcs/Witnesses/Sealed.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Witnesses/Sealed.o binary
- dist/build/darcs/darcs-tmp/Darcs/Witnesses/Show.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Witnesses/Show.o binary
- dist/build/darcs/darcs-tmp/Darcs/Witnesses/Unsafe.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Witnesses/Unsafe.o binary
- dist/build/darcs/darcs-tmp/Darcs/Witnesses/WZipper.hi binary
- dist/build/darcs/darcs-tmp/Darcs/Witnesses/WZipper.o binary
- dist/build/darcs/darcs-tmp/DateMatcher.hi binary
- dist/build/darcs/darcs-tmp/DateMatcher.o binary
- dist/build/darcs/darcs-tmp/English.hi binary
- dist/build/darcs/darcs-tmp/English.o binary
- dist/build/darcs/darcs-tmp/Exec.hi binary
- dist/build/darcs/darcs-tmp/Exec.o binary
- dist/build/darcs/darcs-tmp/HTTP.hi binary
- dist/build/darcs/darcs-tmp/HTTP.o binary
- dist/build/darcs/darcs-tmp/IsoDate.hi binary
- dist/build/darcs/darcs-tmp/IsoDate.o binary
- dist/build/darcs/darcs-tmp/Lcs.hi binary
- dist/build/darcs/darcs-tmp/Lcs.o binary
- dist/build/darcs/darcs-tmp/Main.hi binary
- dist/build/darcs/darcs-tmp/Main.o binary
- dist/build/darcs/darcs-tmp/Preproc.hi binary
- dist/build/darcs/darcs-tmp/Preproc.o binary
- dist/build/darcs/darcs-tmp/Printer.hi binary
- dist/build/darcs/darcs-tmp/Printer.o binary
- dist/build/darcs/darcs-tmp/Progress.hi binary
- dist/build/darcs/darcs-tmp/Progress.o binary
- dist/build/darcs/darcs-tmp/Ratified.hi binary
- dist/build/darcs/darcs-tmp/Ratified.o binary
- dist/build/darcs/darcs-tmp/SHA1.hi binary
- dist/build/darcs/darcs-tmp/SHA1.o binary
- dist/build/darcs/darcs-tmp/Ssh.hi binary
- dist/build/darcs/darcs-tmp/Ssh.o binary
- dist/build/darcs/darcs-tmp/URL.hi binary
- dist/build/darcs/darcs-tmp/URL.o binary
- dist/build/darcs/darcs-tmp/Version.hi binary
- dist/build/darcs/darcs-tmp/Version.o binary
- dist/build/darcs/darcs-tmp/Workaround.hi binary
- dist/build/darcs/darcs-tmp/Workaround.o binary
- dist/build/darcs/darcs-tmp/src/Crypt/sha2.o binary
- dist/build/darcs/darcs-tmp/src/atomic_create.o binary
- dist/build/darcs/darcs-tmp/src/fpstring.o binary
- dist/build/darcs/darcs-tmp/src/hscurl.o binary
- dist/build/darcs/darcs-tmp/src/maybe_relink.o binary
- dist/build/darcs/darcs-tmp/src/umask.o binary
- dist/build/darcs/darcs.1 +1213/−0
- dist/build/libHSdarcs-beta-2.7.98.1.a too large to diff
- dist/build/src/Crypt/sha2.o binary
- dist/build/src/atomic_create.o binary
- dist/build/src/fpstring.o binary
- dist/build/src/hscurl.o binary
- dist/build/src/maybe_relink.o binary
- dist/build/src/umask.o binary
- dist/package.conf.inplace +2/−0
- dist/setup-config +2/−0
- doc/darcs.css +5/−0
- doc/src/best_practices.tex +612/−0
- doc/src/building_darcs.tex +33/−0
- doc/src/configuring_darcs.tex +472/−0
- doc/src/darcs.tex +1548/−0
- doc/src/features.tex +71/−0
- doc/src/gpl.tex +420/−0
- release/distributed-context +1/−1
- src/ByteStringUtils.hs +10/−21
- src/CommandLine.hs +3/−3
- src/Darcs/Annotate.hs +167/−0
- src/Darcs/ArgumentDefaults.hs +79/−0
- src/Darcs/ArgumentDefaults.lhs +0/−172
- src/Darcs/Arguments.hs +1552/−0
- src/Darcs/Arguments.lhs +0/−1833
- src/Darcs/Commands.hs +242/−0
- src/Darcs/Commands.lhs +0/−312
- src/Darcs/Commands/Add.hs +253/−0
- src/Darcs/Commands/Add.lhs +0/−269
- src/Darcs/Commands/AmendRecord.hs +255/−0
- src/Darcs/Commands/AmendRecord.lhs +0/−219
- src/Darcs/Commands/Annotate.hs +152/−0
- src/Darcs/Commands/Annotate.lhs +0/−416
- src/Darcs/Commands/Apply.hs +365/−0
- src/Darcs/Commands/Apply.lhs +0/−392
- src/Darcs/Commands/Changes.hs +326/−0
- src/Darcs/Commands/Changes.lhs +0/−306
- src/Darcs/Commands/Check.hs +153/−0
- src/Darcs/Commands/Check.lhs +0/−121
- src/Darcs/Commands/Convert.hs +261/−0
- src/Darcs/Commands/Convert.lhs +0/−268
- src/Darcs/Commands/Diff.hs +208/−0
- src/Darcs/Commands/Diff.lhs +0/−248
- src/Darcs/Commands/Dist.hs +151/−0
- src/Darcs/Commands/Dist.lhs +0/−154
- src/Darcs/Commands/GZCRCs.hs +185/−0
- src/Darcs/Commands/GZCRCs.lhs +0/−188
- src/Darcs/Commands/Get.hs +260/−0
- src/Darcs/Commands/Get.lhs +0/−357
- src/Darcs/Commands/Help.hs +289/−0
- src/Darcs/Commands/Help.lhs +0/−284
- src/Darcs/Commands/Init.hs +61/−0
- src/Darcs/Commands/Init.lhs +0/−89
- src/Darcs/Commands/MarkConflicts.hs +109/−0
- src/Darcs/Commands/MarkConflicts.lhs +0/−109
- src/Darcs/Commands/Move.hs +201/−0
- src/Darcs/Commands/Move.lhs +0/−192
- src/Darcs/Commands/Optimize.hs +371/−0
- src/Darcs/Commands/Optimize.lhs +0/−400
- src/Darcs/Commands/Pull.hs +325/−0
- src/Darcs/Commands/Pull.lhs +0/−385
- src/Darcs/Commands/Push.hs +194/−0
- src/Darcs/Commands/Push.lhs +0/−272
- src/Darcs/Commands/Put.hs +127/−0
- src/Darcs/Commands/Put.lhs +0/−136
- src/Darcs/Commands/Record.hs +412/−0
- src/Darcs/Commands/Record.lhs +0/−487
- src/Darcs/Commands/Remove.hs +164/−0
- src/Darcs/Commands/Remove.lhs +0/−166
- src/Darcs/Commands/Repair.lhs +0/−74
- src/Darcs/Commands/Replace.hs +233/−0
- src/Darcs/Commands/Replace.lhs +0/−266
- src/Darcs/Commands/Revert.hs +119/−0
- src/Darcs/Commands/Revert.lhs +0/−117
- src/Darcs/Commands/Rollback.hs +187/−0
- src/Darcs/Commands/Rollback.lhs +0/−152
- src/Darcs/Commands/Send.hs +366/−0
- src/Darcs/Commands/Send.lhs +0/−451
- src/Darcs/Commands/SetPref.hs +108/−0
- src/Darcs/Commands/SetPref.lhs +0/−111
- src/Darcs/Commands/Show.hs +82/−0
- src/Darcs/Commands/Show.lhs +0/−94
- src/Darcs/Commands/ShowAuthors.hs +192/−0
- src/Darcs/Commands/ShowAuthors.lhs +0/−194
- src/Darcs/Commands/ShowBug.hs +51/−0
- src/Darcs/Commands/ShowBug.lhs +0/−53
- src/Darcs/Commands/ShowContents.hs +90/−0
- src/Darcs/Commands/ShowContents.lhs +0/−86
- src/Darcs/Commands/ShowFiles.hs +121/−0
- src/Darcs/Commands/ShowFiles.lhs +0/−124
- src/Darcs/Commands/ShowIndex.hs +84/−0
- src/Darcs/Commands/ShowIndex.lhs +0/−87
- src/Darcs/Commands/ShowRepo.hs +146/−0
- src/Darcs/Commands/ShowRepo.lhs +0/−150
- src/Darcs/Commands/ShowTags.hs +82/−0
- src/Darcs/Commands/ShowTags.lhs +0/−81
- src/Darcs/Commands/Tag.hs +123/−0
- src/Darcs/Commands/Tag.lhs +0/−125
- src/Darcs/Commands/TrackDown.hs +188/−0
- src/Darcs/Commands/TrackDown.lhs +0/−228
- src/Darcs/Commands/TransferMode.hs +86/−0
- src/Darcs/Commands/TransferMode.lhs +0/−88
- src/Darcs/Commands/Unrecord.hs +253/−0
- src/Darcs/Commands/Unrecord.lhs +0/−352
- src/Darcs/Commands/Unrevert.hs +132/−0
- src/Darcs/Commands/Unrevert.lhs +0/−134
- src/Darcs/Commands/Util.hs +57/−0
- src/Darcs/Commands/WhatsNew.hs +163/−0
- src/Darcs/Commands/WhatsNew.lhs +0/−182
- src/Darcs/CommandsAux.hs +13/−3
- src/Darcs/Compat.hs +4/−2
- src/Darcs/Diff.hs +8/−8
- src/Darcs/Email.hs +17/−5
- src/Darcs/External.hs +81/−135
- src/Darcs/FilePathMonad.hs +0/−83
- src/Darcs/Flags.hs +53/−14
- src/Darcs/Global.hs +30/−13
- src/Darcs/Hopefully.hs +0/−207
- src/Darcs/IO.hs +36/−126
- src/Darcs/Lock.hs +11/−9
- src/Darcs/Match.hs +443/−0
- src/Darcs/Match.lhs +0/−473
- src/Darcs/MonadProgress.hs +69/−0
- src/Darcs/Patch.hs +93/−0
- src/Darcs/Patch.lhs +0/−139
- src/Darcs/Patch/Apply.hs +57/−0
- src/Darcs/Patch/Apply.lhs +0/−524
- src/Darcs/Patch/ApplyMonad.hs +103/−0
- src/Darcs/Patch/Bracketed.hs +40/−0
- src/Darcs/Patch/Bracketed/Instances.hs +21/−0
- src/Darcs/Patch/Bundle.hs +78/−59
- src/Darcs/Patch/Choices.hs +50/−37
- src/Darcs/Patch/Commute.hs +74/−0
- src/Darcs/Patch/Commute.lhs +0/−870
- src/Darcs/Patch/Conflict.hs +89/−0
- src/Darcs/Patch/ConflictMarking.hs +99/−0
- src/Darcs/Patch/Core.lhs +0/−181
- src/Darcs/Patch/Depends.hs +67/−29
- src/Darcs/Patch/Dummy.hs +27/−0
- src/Darcs/Patch/Effect.hs +29/−0
- src/Darcs/Patch/FileHunk.hs +27/−0
- src/Darcs/Patch/FileName.hs +0/−1
- src/Darcs/Patch/Format.hs +31/−0
- src/Darcs/Patch/Info.hs +54/−56
- src/Darcs/Patch/Inspect.hs +24/−0
- src/Darcs/Patch/Invert.hs +19/−0
- src/Darcs/Patch/Match.hs +228/−0
- src/Darcs/Patch/Match.lhs +0/−372
- src/Darcs/Patch/Merge.hs +36/−0
- src/Darcs/Patch/Named.hs +196/−0
- src/Darcs/Patch/Non.hs +0/−202
- src/Darcs/Patch/OldDate.hs +18/−18
- src/Darcs/Patch/PatchInfoAnd.hs +230/−0
- src/Darcs/Patch/Patchy.hs +14/−225
- src/Darcs/Patch/Patchy/Instances.hs +13/−0
- src/Darcs/Patch/Permutations.hs +30/−18
- src/Darcs/Patch/Prim.hs +28/−0
- src/Darcs/Patch/Prim.lhs +0/−1165
- src/Darcs/Patch/Prim/Class.hs +130/−0
- src/Darcs/Patch/Prim/V1.hs +16/−0
- src/Darcs/Patch/Prim/V1/Apply.hs +131/−0
- src/Darcs/Patch/Prim/V1/Coalesce.hs +239/−0
- src/Darcs/Patch/Prim/V1/Commute.hs +215/−0
- src/Darcs/Patch/Prim/V1/Core.hs +166/−0
- src/Darcs/Patch/Prim/V1/Details.hs +29/−0
- src/Darcs/Patch/Prim/V1/Read.hs +164/−0
- src/Darcs/Patch/Prim/V1/Show.hs +149/−0
- src/Darcs/Patch/Properties.lhs +0/−357
- src/Darcs/Patch/Read.hs +84/−212
- src/Darcs/Patch/ReadMonads.hs +223/−43
- src/Darcs/Patch/Real.hs +0/−783
- src/Darcs/Patch/Repair.hs +52/−0
- src/Darcs/Patch/RepoPatch.hs +17/−0
- src/Darcs/Patch/Set.hs +7/−4
- src/Darcs/Patch/Show.hs +78/−0
- src/Darcs/Patch/Show.lhs +0/−92
- src/Darcs/Patch/Split.hs +27/−11
- src/Darcs/Patch/Summary.hs +134/−0
- src/Darcs/Patch/SummaryData.hs +13/−0
- src/Darcs/Patch/TokenReplace.hs +45/−0
- src/Darcs/Patch/TouchesFiles.hs +15/−19
- src/Darcs/Patch/V1.hs +16/−0
- src/Darcs/Patch/V1/Apply.hs +22/−0
- src/Darcs/Patch/V1/Commute.hs +446/−0
- src/Darcs/Patch/V1/Core.hs +51/−0
- src/Darcs/Patch/V1/Read.hs +46/−0
- src/Darcs/Patch/V1/Show.hs +34/−0
- src/Darcs/Patch/V1/Viewing.hs +26/−0
- src/Darcs/Patch/V2.hs +9/−0
- src/Darcs/Patch/V2/Non.hs +227/−0
- src/Darcs/Patch/V2/Real.hs +820/−0
- src/Darcs/Patch/Viewing.hs +53/−213
- src/Darcs/Population.hs +0/−147
- src/Darcs/PopulationData.hs +0/−123
- src/Darcs/PrintPatch.hs +0/−1
- src/Darcs/ProgressPatches.hs +1/−1
- src/Darcs/RemoteApply.hs +16/−17
- src/Darcs/RepoPath.hs +14/−3
- src/Darcs/Repository.hs +247/−188
- src/Darcs/Repository/ApplyPatches.hs +13/−25
- src/Darcs/Repository/Cache.hs +127/−34
- src/Darcs/Repository/Checkpoint.hs +0/−99
- src/Darcs/Repository/DarcsRepo.lhs +0/−362
- src/Darcs/Repository/Format.hs +47/−44
- src/Darcs/Repository/HashedIO.hs +65/−72
- src/Darcs/Repository/HashedRepo.hs +56/−52
- src/Darcs/Repository/Internal.hs +249/−258
- src/Darcs/Repository/InternalTypes.hs +4/−6
- src/Darcs/Repository/LowLevel.hs +72/−16
- src/Darcs/Repository/Merge.hs +12/−12
- src/Darcs/Repository/Motd.hs +40/−0
- src/Darcs/Repository/Motd.lhs +0/−49
- src/Darcs/Repository/Old.hs +130/−0
- src/Darcs/Repository/Prefs.hs +433/−0
- src/Darcs/Repository/Prefs.lhs +0/−540
- src/Darcs/Repository/Pristine.hs +0/−162
- src/Darcs/Repository/Repair.hs +16/−17
- src/Darcs/Repository/State.hs +33/−33
- src/Darcs/Resolution.hs +149/−0
- src/Darcs/Resolution.lhs +0/−239
- src/Darcs/RunCommand.hs +3/−3
- src/Darcs/SelectChanges.hs +52/−53
- src/Darcs/SignalHandler.hs +19/−17
- src/Darcs/Test.hs +95/−0
- src/Darcs/Test.lhs +0/−121
- src/Darcs/Test/Email.hs +12/−6
- src/Darcs/Test/Misc.hs +107/−0
- src/Darcs/Test/Patch.hs +31/−0
- src/Darcs/Test/Patch/Check.hs +36/−30
- src/Darcs/Test/Patch/Examples.hs +604/−0
- src/Darcs/Test/Patch/Examples2.hs +274/−0
- src/Darcs/Test/Patch/Info.hs +12/−7
- src/Darcs/Test/Patch/Prim/V1.hs +305/−0
- src/Darcs/Test/Patch/Properties.hs +340/−0
- src/Darcs/Test/Patch/Properties2.hs +343/−0
- src/Darcs/Test/Patch/QuickCheck.hs +88/−560
- src/Darcs/Test/Patch/RepoModel.hs +291/−0
- src/Darcs/Test/Patch/Test.hs +170/−486
- src/Darcs/Test/Patch/Unit.hs +254/−185
- src/Darcs/Test/Patch/Unit2.hs +244/−0
- src/Darcs/Test/Patch/Utils.hs +24/−0
- src/Darcs/Test/Patch/WithState.hs +118/−0
- src/Darcs/Test/Unit.lhs +0/−766
- src/Darcs/Test/Util/QuickCheck.hs +58/−0
- src/Darcs/Test/Util/TestResult.hs +63/−0
- src/Darcs/TheCommands.hs +7/−8
- src/Darcs/URL.hs +62/−17
- src/Darcs/Utils.hs +66/−51
- src/Darcs/Witnesses/Eq.hs +54/−0
- src/Darcs/Witnesses/Ordered.hs +62/−83
- src/Darcs/Witnesses/Sealed.hs +13/−9
- src/Darcs/Witnesses/Show.hs +0/−1
- src/Darcs/Witnesses/Unsafe.hs +24/−0
- src/Darcs/Witnesses/WZipper.hs +4/−1
- src/DateMatcher.hs +0/−1
- src/English.hs +8/−0
- src/Exec.hs +5/−4
- src/HTTP.hs +43/−35
- src/IsoDate.hs +36/−36
- src/Lcs.hs +29/−33
- src/Preproc.hs +23/−20
- src/Progress.hs +5/−5
- src/SHA1.hs +1/−5
- src/Ssh.hs +88/−127
- src/URL.hs +50/−14
- src/Workaround.hs +2/−2
- src/best_practices.tex +0/−611
- src/building_darcs.tex +0/−76
- src/configuring_darcs.tex +0/−264
- src/darcs.hs +6/−5
- src/darcs.tex +0/−674
- src/features.tex +0/−88
- src/formats.tex +0/−69
- src/gadts.h +2/−0
- src/gpl.tex +0/−414
- src/hscurl.c +42/−4
- src/hscurl.h +5/−1
- src/switching.tex +0/−147
- src/test.hs +179/−0
- src/unit.hs +0/−3
- src/win32/System/Posix.hs +2/−31
- src/win32/System/Posix/Files.hsc +6/−4
- src/win32/System/Posix/IO.hsc +1/−0
- src/witnesses.hs +0/−55
- tests/EXAMPLE.sh +0/−1
- tests/README.test_maintainers.txt +14/−2
- tests/annotate.sh +4/−7
- tests/bad-format.sh +5/−8
- tests/bad_pending_after_pull.sh +3/−3
- tests/bin/hspwd.hi binary
- tests/bin/hspwd.hs +5/−0
- tests/bin/hspwd.o binary
- tests/bin/trackdown-bisect-helper.hi binary
- tests/bin/trackdown-bisect-helper.hs +38/−0
- tests/bin/trackdown-bisect-helper.o binary
- tests/binary.sh +1/−1
- tests/changes_with_move.sh +3/−9
- tests/checkpoint.sh +0/−45
- tests/conflict-doppleganger.sh +14/−157
- tests/convert.sh +60/−0
- tests/data/README +4/−0
- tests/data/badrepo.tgz binary
- tests/data/braced.dpatch +25/−0
- tests/data/braced.tgz binary
- tests/data/context-v1.dpatch +48/−0
- tests/data/context-v1.tgz binary
- tests/data/context-v2.dpatch +46/−0
- tests/data/context-v2.tgz binary
- tests/data/convert/darcs1/resolution.dpatch +74/−0
- tests/data/convert/darcs1/simple.dpatch +20/−0
- tests/data/convert/darcs1/threewayanddep.dpatch +83/−0
- tests/data/convert/darcs1/threewayandmultideps.dpatch +235/−0
- tests/data/convert/darcs1/threewayconflict.dpatch +61/−0
- tests/data/convert/darcs1/tworesolutions.dpatch +131/−0
- tests/data/convert/darcs1/twowayconflict.dpatch +41/−0
- tests/data/convert/darcs2/resolution.dpatch +62/−0
- tests/data/convert/darcs2/simple.dpatch +18/−0
- tests/data/convert/darcs2/threewayanddep.dpatch +69/−0
- tests/data/convert/darcs2/threewayandmultideps.dpatch +97/−0
- tests/data/convert/darcs2/threewayconflict.dpatch +57/−0
- tests/data/convert/darcs2/tworesolutions.dpatch +84/−0
- tests/data/convert/darcs2/twowayconflict.dpatch +40/−0
- tests/data/example_binary.png binary
- tests/data/many-files--darcs-2.tgz binary
- tests/data/many-files--hashed.tgz binary
- tests/data/many-files--old-fashioned-inventory.tgz binary
- tests/data/maybench-crc.tgz binary
- tests/data/minimal-darcs-2_4.tgz binary
- tests/data/old-with-checkpoint.tgz binary
- tests/data/oldfashioned-compressed.tgz binary
- tests/data/oldfashioned.tgz binary
- tests/data/simple-v1.dpatch +20/−0
- tests/data/simple-v1.tgz binary
- tests/data/simple-v2.dpatch +18/−0
- tests/data/simple-v2.tgz binary
- tests/data/split--darcs-1.dpatch +23/−0
- tests/data/split--darcs-2.tgz binary
- tests/data/split--hashed.tgz binary
- tests/data/split--old-fashioned-inventory.tgz binary
- tests/data/split2--darcs-1.dpatch +51/−0
- tests/devnull.sh +31/−0
- tests/diff.sh +3/−3
- tests/directory_confusion.sh +2/−2
- tests/emailformat.sh +12/−3
- tests/example_binary.png binary
- tests/external.sh +0/−37
- tests/failed-amend-should-not-break-repo.sh +1/−1
- tests/failing-add_permissions.sh +1/−1
- tests/failing-haskell_policy.sh +41/−0
- tests/failing-issue1190_unmarked_hunk_replace_conflict.sh +1/−1
- tests/failing-issue1266_init_inside_a_repo.sh +1/−1
- tests/failing-issue1317_list-options_subdir.sh +1/−1
- tests/failing-issue1325_pending_minimisation.sh +1/−1
- tests/failing-issue1332_add_r_boring.sh +1/−1
- tests/failing-issue1396_changepref-conflict.sh +1/−1
- tests/failing-issue1401_bug_in_get_extra.sh +1/−1
- tests/failing-issue1406.sh +4/−4
- tests/failing-issue1442_encoding_round-trip.sh +1/−1
- tests/failing-issue1461_case_folding.sh +1/−1
- tests/failing-issue1473_annotate_repodir.sh +1/−1
- tests/failing-issue1609_ot_convergence.sh +1/−1
- tests/failing-issue1610_get_extra.sh +1/−1
- tests/failing-issue1632_changes_nonexisting.sh +1/−1
- tests/failing-issue1702-optimize-relink-vs-cache.sh +1/−1
- tests/failing-issue1727_move_current_directory.sh +1/−1
- tests/failing-issue1737-move_args.sh +0/−38
- tests/failing-issue1790_darcs-send.sh +69/−0
- tests/failing-issue1829-inconsistent-conflictor.sh +62/−0
- tests/failing-issue1909-unrecord-O-misses-tag.sh +0/−20
- tests/failing-issue1926_amend-record_ignores_--index.sh +48/−0
- tests/failing-issue1928-file-dir-replace.sh +36/−0
- tests/failing-issue1932-colon-breaks-add.sh +77/−0
- tests/failing-issue2017-missing-tag.sh +85/−0
- tests/failing-issue2066_add_and_remove.sh +41/−0
- tests/failing-issue2076-move_into_dir.sh +40/−0
- tests/failing-issue612_repo_not_writable.sh +39/−0
- tests/failing-issue944_partial_inventory.sh +0/−46
- tests/failing-merging_newlines.sh +1/−1
- tests/failing-pristine-problems.sh +57/−0
- tests/failing-record-scaling.sh +1/−1
- tests/get-http-packed-detect.sh +41/−0
- tests/get-http-packed.sh +30/−0
- tests/get-http.sh +41/−0
- tests/gzcrcs.sh +2/−2
- tests/harness.sh +11/−4
- tests/hashed_inventory.sh +3/−23
- tests/haskell_policy.sh +0/−41
- tests/hidden_conflict2.sh +1/−1
- tests/hspwd.hs +0/−5
- tests/hunk-editor.sh +46/−0
- tests/illegal_mv.sh +1/−1
- tests/invalid_absolute_paths.sh +54/−0
- tests/issue1039.sh +4/−4
- tests/issue1110_get_hashed.sh +5/−5
- tests/issue1110_get_old-fashioned.sh +0/−30
- tests/issue1111-pull-intersection.sh +25/−0
- tests/issue1139-diff-last.sh +2/−2
- tests/issue1139-diff-with-no-args.sh +2/−2
- tests/issue121.sh +1/−1
- tests/issue1224_convert-darcs2-repository.sh +2/−2
- tests/issue1232_convert_forgets_prefs.sh +0/−62
- tests/issue1248.sh +4/−13
- tests/issue1290-diff-index.sh +23/−3
- tests/issue1300_record_delete-file.sh +1/−1
- tests/issue1337_darcs_changes_false_positives.sh +1/−1
- tests/issue1344_abort_early_cant_send.sh +73/−0
- tests/issue1392_authorspelling.sh +1/−1
- tests/issue142_record-log.sh +1/−1
- tests/issue1465_ortryrunning.sh +56/−13
- tests/issue1472_read_too_much.sh +1/−1
- tests/issue1488_whatsnew-l.sh +1/−1
- tests/issue1558_xml_output_gz_extension.sh +35/−0
- tests/issue1584_optimize_upgrade.sh +6/−8
- tests/issue1599-automatically-expire-unused-caches.sh +57/−0
- tests/issue1611_amend-tag.sh +42/−0
- tests/issue1618-amend-preserve-logfile.sh +2/−2
- tests/issue1620-record-lies-about-leaving-logfile.sh +2/−2
- tests/issue1636-match-hunk.sh +1/−1
- tests/issue1640_verbose_stdin.sh +58/−0
- tests/issue1726_darcs_always-boring.sh +1/−1
- tests/issue1737-move_args.sh +38/−0
- tests/issue1739-escape-multibyte-chars-correctly.sh +1/−1
- tests/issue1749-rmdir.sh +1/−1
- tests/issue1837_get-partial.sh +0/−44
- tests/issue1857-pristine-conversion.sh +1/−1
- tests/issue1871-record-dot.sh +22/−1
- tests/issue1879-same-patchinfo-uncommon.sh +1/−1
- tests/issue1909-unrecord-O-misses-tag.sh +20/−0
- tests/issue1922-obliterate-o-context.sh +47/−0
- tests/issue1923-cache-warning.sh +55/−0
- tests/issue1977-darcs-repair.sh +12/−0
- tests/issue1978.sh +35/−0
- tests/issue2012_send_output_no_address.sh +50/−0
- tests/issue2013_send_to_context.sh +57/−0
- tests/issue2035-malicious-subpath.sh +28/−0
- tests/issue2041_dont_add_symlinks.sh +53/−0
- tests/issue2049-dir-case-change.sh +43/−0
- tests/issue2049-file-in-boring-dir.sh +33/−0
- tests/issue2052-default-unified-diff.sh +40/−0
- tests/issue257.sh +1/−1
- tests/issue27.sh +4/−4
- tests/issue612_repo_not_writeable.sh +0/−42
- tests/issue691.sh +1/−1
- tests/issue942_push_apply_prehook.sh +1/−1
- tests/lib +30/−3
- tests/merging_newlines.sh +1/−1
- tests/mv.sh +1/−1
- tests/mv_and_remove_tests.sh +2/−2
- tests/mv_then_add.sh +4/−4
- tests/network/external.sh +37/−0
- tests/network/issue1503_prefer_local_caches_to_remote_one.sh +1/−1
- tests/network/ssh.sh +143/−0
- tests/nfs-failure.sh +2/−2
- tests/oldfashioned_refusal.sh +58/−0
- tests/oldfashioned_support.sh +44/−0
- tests/partial.sh +0/−63
- tests/pending.sh +2/−2
- tests/prefs.sh +2/−2
- tests/pull.sh +1/−1
- tests/pull_binary.sh +23/−0
- tests/pull_compl.sh +25/−1
- tests/pull_conflicts.sh +1/−1
- tests/pull_many_files.sh +2/−2
- tests/push-formerly-pl.sh +1/−1
- tests/push.sh +2/−2
- tests/push_conflicts.sh +1/−1
- tests/query_manifest.sh +4/−4
- tests/record_editor.sh +22/−0
- tests/remove.sh +1/−1
- tests/replace_after_pending_mv.sh +1/−1
- tests/repoformat.sh +109/−5
- tests/repos/README +0/−4
- tests/repos/many-files--darcs-2.tgz binary
- tests/repos/many-files--hashed.tgz binary
- tests/repos/many-files--old-fashioned-inventory.tgz binary
- tests/repos/maybench-crc.tgz binary
- tests/repos/minimal-darcs-2.4.tgz binary
- tests/repos/old-with-checkpoint.tgz binary
- tests/rollback-no-record.sh +67/−0
- tests/rollback.sh +1/−1
- tests/send-output-v1.sh +53/−0
- tests/send-output-v2.sh +54/−0
- tests/set-default-hint.sh +51/−0
- tests/set_scripts_executable.sh +1/−1
- tests/show-authors.sh +0/−7
- tests/show-bug.sh +0/−8
- tests/show_tags-remote.sh +46/−0
- tests/split-patches.sh +64/−0
- tests/ssh.sh +0/−143
- tests/tag.sh +1/−1
- tests/tentative_revert.sh +1/−1
- tests/trackdown-bisect-helper.hs +0/−38
- tests/trackdown-bisect.sh +1/−1
- tests/tricky_unrecord.sh +3/−3
- tests/unrecord.sh +0/−31
- tests/utf8.sh +1/−1
- tests/v1-braced.sh +48/−0
- tests/whatsnew-pending.sh +23/−0
- tests/xmlschema.sh +127/−0
− Distribution/ShellHarness.hs
@@ -1,196 +0,0 @@-{-# 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 )-import Control.Concurrent-import qualified Control.Exception as Exception-import Control.Monad---- Handle exceptions migration. We could use extensible-exceptions--- but Cabal can't handle package dependencies of Setup.lhs--- automatically so it'd be disruptive for users.--- Once we drop older GHCs we can clean up the use sites properly--- and perhaps think about being more restrictive in which exceptions--- are caught at each site.-#if __GLASGOW_HASKELL__ >= 610-catchAny f h = Exception.catch f (\e -> h (e :: Exception.SomeException))-#else-catchAny = Exception.catch-#endif--runTests :: Maybe FilePath -> String -> [String] -> IO Bool-runTests darcs_path cwd tests = do- fails <- run darcs_path tests- if "bugs" `isInfixOf` cwd- then if (length tests /= length fails)- then do putStrLn $ "Some bug tests passed:"- mapM_ putStrLn (tests \\ fails)- return False- else do putStrLn "All bug tests OK"- return True- else if fails /= []- then do putStrLn "Some tests failed:"- mapM_ putStrLn fails- return False- else do putStrLn "All tests OK"- return True--run :: Maybe FilePath -> [String] -> IO [String]-run set_darcs_path tests = do- cwd <- getCurrentDirectory- path <- getEnv "PATH"- env <- getEnvironment- bash <- find_bash- darcs_path <- case set_darcs_path of- Nothing -> case lookup "DARCS" env of- Nothing -> return (cwd ++ "/..")- Just d -> return $ takeDirectory d- Just x -> return x- let myenv = [("HOME",cwd)- ,("TESTS_WD",cwd)- ,("DARCS_TESTING_PREFS_DIR",cwd </> ".darcs")- ,("EMAIL","tester")- ,("DARCSEMAIL","tester")- ,("PATH",(darcs_path++":"++path))- ,("DARCS_DONT_COLOR","1")- ,("DARCS_DONT_ESCAPE_ANYTHING","1")]- shell = takeWhile (/= '\n') bash- putStrLn $ "Using bash shell in '"++shell++"'"- catchAny (appendFile (".darcs/defaults") "\nALL ignore-times\nsend no-edit-description\n")- (\e -> fail $ "Unable to set preferences: " ++ show e)- run_helper shell tests [] (set_env myenv env)--data Status = Success | Failed | Skipped--run_helper :: String -> [String] -> [String] ->- [(String,String)] -> IO [String]-run_helper _ [] fails _ = return fails-run_helper shell (test:ts) fails env = do- putStr $ "Running " ++ test ++ " ..." ++ (replicate (36 - (length test)) ' ')- (output,result) <- backtick shell test env- cleanup- case result of- Skipped -> do putStrLn " skipped."- run_helper shell ts fails env- Success -> do putStrLn " passed."- run_helper shell ts fails env- Failed -> do putStrLn " failed."- putStrLn $ "Probable reason :" ++ output- run_helper shell ts (fails++[test]) env- where cleanup :: IO ()- cleanup =- do dirfiles <- getDirectoryContents (fromJust $ lookup "TESTS_WD" env)- let tempfiles = (filter ("temp" `isPrefixOf`) dirfiles) ++- (filter ("tmp" `isPrefixOf`) dirfiles)- when (isJust $ lookup "HPCTIXDIR" env) $ do- let tixdir = fromJust $ lookup "HPCTIXDIR" env- tixlist <- getDirectoryContents tixdir- oldsum <- if ("sum.tix" `elem` tixlist)- then do renameFile (tixdir </> "sum.tix")- (tixdir </> "oldsum.tix")- return [tixdir </> "oldsum.tix"]- else return []- let tixfiles = oldsum ++ [ tixdir </> f | f <- tixlist- , "darcs-" `isPrefixOf` f- , ".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}- )- ) tempfiles--backtick :: String -> String -> [(String, String)]-> IO (String,Status)-backtick cmd args env = do- (exitcode,res) <- backtick_helper cmd args env- case exitcode of- ExitSuccess -> return (res, Success)- ExitFailure 200 -> return (res, Skipped)- ExitFailure _ -> return (res, Failed)--backtick_helper :: String -> String -> [(String,String)] ->- IO (ExitCode, String)-backtick_helper cmd args env = process_wrapper (runInteractiveProcess- cmd [args] Nothing- (Just env)- ) ""--find_bash :: IO FilePath-find_bash =- do sh <- findExecutable "bash"- case sh of- Just p -> return p- Nothing -> error "Could not find bash in PATH"---- | Run a process with a list of arguments and return anything from--- /stderr/ or /stdout/-process_wrapper :: IO (Handle, Handle, Handle, ProcessHandle) ->- String -> IO (ExitCode, String)-process_wrapper f _ = do- (_,o,e,pid) <- f- hSetBuffering o LineBuffering- hSetBuffering e LineBuffering- ch <- newChan- -- WARNING: beware of hokeyness ahead!- let readWrite i = do x <- hGetLine i- writeChan ch $ Just x- readWrite i- `catchAny` \_ -> writeChan ch Nothing- readEO = do x <- readChan ch- case x of- Just l -> do y <- readEO- return $ l:y- Nothing -> readEO'- readEO' = do x <- readChan ch- case x of- Just l -> do y <- readEO'- return $ l:y- Nothing -> return []- forkIO $ readWrite o- forkIO $ readWrite e- outerr <- readEO- ec <- waitForProcessNonBlocking pid- threadDelay 1000- case ec of- ExitFailure 127 -> fail $ "timeout running command\n\n"- ++unlines outerr- _ -> return (ec, unlines outerr)------- waitForProcess uses a very hokey heuristic to try to avoid burning too--- much CPU time in a busy wait, while also not adding too much extra--- latency.--waitForProcessNonBlocking :: ProcessHandle -> IO ExitCode-waitForProcessNonBlocking = if rtsSupportsBoundThreads- then waitForProcess- else wfp 0- where wfp n pid = do mec <- getProcessExitCode pid- case mec of- Just ec -> return ec- Nothing -> do threadDelay n- wfp (min 100000 (n+1+n`div`4)) pid----set_env :: [(String,String)] -> [(String,String)] -> [(String, String)]-set_env es env = nubBy (\(x,_) (y,_) -> x == y) (es ++ env)
GNUmakefile view
@@ -6,40 +6,33 @@ DARCS = dist/build/darcs/darcs PREPROC=./dist/build/darcs/darcs --preprocess-manual PREPROCHTML=--html-TEXSOURCES = src/darcs.tex $(wildcard src/*.tex) $(filter %.lhs,$(DARCS_FILES))+TEXSOURCES = doc/src/darcs.tex $(wildcard doc/src/*.tex) $(filter %.lhs,$(DARCS_FILES)) doc/manual/darcs.tex: $(TEXSOURCES) $(DARCS) mkdir -p doc/manual $(PREPROC) darcs.tex $(PREPROCHTML) >$@ doc/manual/darcs_print.tex: $(TEXSOURCES) $(DARCS) mkdir -p doc/manual $(PREPROC) darcs.tex >$@-doc/manual/patch-theory.tex: $(TEXSOURCES) $(UNIT_FILES) $(DARCS)- mkdir -p doc/manual- $(PREPROC) Darcs/Patch/Properties.lhs >$@ %.pdf: %.tex cd $(<D) && $(RUBBER) --pdf $(<F)-%.ps: %.tex- cd $(<D) && $(RUBBER) --ps $(<F) -ps pdf: %: doc/manual/darcs.% doc/manual/patch-theory.%+pdf: %: doc/manual/darcs.% html: doc/manual/index.html-website: ps pdf html doc/manual/bigpage.html+website: pdf html doc/manual/bigpage.html ### TODO use latex2html since bigpage seems to needslatex2html anyway; ### we can restore hevea/tex4ht support when we move this to Setup.lhs-doc/manual/index.html: doc/manual/darcs.tex src/gpl.tex doc/darcs.css- latex2html -split +1 -dir doc/manual doc/manual/darcs.tex+doc/manual/index.html: doc/manual/darcs.tex doc/src/gpl.tex doc/darcs.css+ latex2html -long_titles 2 -split +1 -dir doc/manual doc/manual/darcs.tex cp -f doc/darcs.css doc/manual/darcs.css -doc/manual/bigpage.html: doc/manual/darcs.tex src/gpl.tex doc/darcs.css+doc/manual/bigpage.html: doc/manual/darcs.tex doc/src/gpl.tex doc/darcs.css ln -sf darcs.tex doc/manual/bigpage.tex latex2html -split 0 -external_file darcs -prefix big \ -no_auto_link -dir doc/manual doc/manual/bigpage.tex cp -f doc/darcs.css doc/manual/bigpage.css -doc/manual/darcs.ps: doc/manual/darcs_print.ps- cp $< $@ doc/manual/darcs.pdf: doc/manual/darcs_print.pdf cp $< $@ @@ -62,10 +55,8 @@ rm -f doc/manual/bigimg*.png doc/manual/bigimages.* rm -f doc/manual/*.html doc/manual/darcs*.??? doc/manual/darcs.lg rm -f doc/manual/darcs.html- rm -f doc/manual/darcs.xref c_context.c doc/darcs_print.ps- rm -f doc/manual/patch-theory.??? doc/manual/patch-theory.ps+ rm -f doc/manual/darcs.xref c_context.c rm -f doc/manual/WARNINGS doc/manual/*.pl rm -f doc/manual/images.* doc/manual/img*.png doc/manual/*.html- rm -f doc/manual/darcs_print.ps doc/manual/darcs.ps -.PHONY: ps pdf html clean website+.PHONY: pdf html clean website
NEWS view
@@ -1,3 +1,62 @@+Darcs 2.5, 30 October 2010:++ * Important changes in Darcs 2.5++ * trackdown can now do binary search with the --bisect option+ * darcs always stores patch metadata encoded with UTF-8+ * diff now supports the --index option+ * amend-record now supports the --ask-deps option+ * apply now supports the --match option+ * amend-record has a new --keep-date option+ * inventory-changing commands (like record and pull) now operate in+ constant time with respect to the number of patches in the repository+ * the push, pull, send and fetch commands no longer set the default+ repository by default+ * the --edit-description option is now on by default for the send command++ * Issues resolved in Darcs 2.5++ * 64: store metadata as UTF-8+ * 121: add --ask-deps support to amend-record+ * 643: darcs send -o outputs remote repo email address+ * 1159: avoid bogus repository cache entries+ * 1176: caches interfere with --remote-repo flag+ * 1208: add trackdown --bisect+ * 1210: global cache gets recorded in _darcs/prefs/sources+ * 1232: darcs convert copies _darcs/prefs/prefs+ * 1250: check for newlines in setpref values+ * 1277: percolate repository format errors correctly+ * 1288: the main darcs code now compiles and runs with witnesses+ * 1290: support diff --index+ * 1337: don't show unrelated patches in darcs changes on untracked path+ * 1389: change predist pref to point people to use 'cabal sdist'+ * 1427: accept gzipped patch bundles in darcs apply+ * 1456: make dist write more portable archives+ * 1473: make annotate accept '.' as argument+ * 1503: prefer local caches to remote ones+ * 1713: shorter interactive prompts+ * 1716: allow mail header lines of all whitespace in test+ * 1719: do not back up files when no conflict markers are inserted+ * 1726: don't consider all files with _darcs prefix boring+ * 1739: make ColorPrinter handle characters > 255+ * 1763: use correct filename encoding in conflictors+ * 1765: refuse to remove non-tracked directories recursively+ * 1769: add support for --match 'comment ...'+ * 1784: push and pull print remote address right away+ * 1815: work around Cabal sdist permissions issue+ * 1817: fix support for external merge tools+ * 1824: avoid PACKAGE_VERSION under Windows+ * 1825: do not omit important prims in unrecordedChanges w/ files+ * 1860: (un)applying move patches doesn't corrupt pristine+ * 1861: fix typo in --no-boring help+ * 1874: recognise network tests on cabal test command line+ * 1875: avoid accidentally setting default+ * 1879: notice unexpected commute failure on merge+ * 1887: add a missing newline to --list-options output+ * 1893: move fields of conditional builds within scope of condition+ * 1898: notify user when they can use set-default+ * 1913: sort changes in treeDiff+ Darcs 2.4.4, 9 May 2010 * Important changes in Darcs 2.4.4
README view
@@ -11,20 +11,9 @@ Compilation and Installation ============================ -Building Darcs requires the cabal package, version 1.6 or higher. The-cabal-install package is also recommended.--Using GHC 6.10.3 or newer is STRONGLY RECOMMENDED. You can compile darcs with-GHC 6.8, but there are several caveats. If you are using 6.8.2 or older, please-disable mmap support (pass -f-mmap to cabal install or runghc Setup configure-below). Note that the GHC 6.8.2 that ships with Debian Lenny is not affected-and it should be safe to keep mmap enabled. It is also recommended to disable-use of Hackage zlib when compiling with GHC 6.8.2 (including the Debian Lenny-version): pass -f-zlib to cabal. When using zlib, we have seen occasional-crashes with error messages like "openBinaryFile: file locked" -- this is a-known GHC 6.8.2 bug (and is fixed in GHC 6.8.3). Last, if you are using a-64-bit system, darcs may hang when you exit a pager when compiled with GHC-older than 6.10.3. Although this is harmless, it is quite inconvenient.+Building Darcs requires GHC, version 6.10.3 or higher. It also requires the+Cabal package, version 1.6 or higher. The cabal-install package is also+recommended. If you have the "cabal-install" package on your system (that is, there is a "cabal" executable in your path), you can use the following command to create@@ -61,6 +50,22 @@ Of particular interest are the following documents: * http://wiki.darcs.net/Development/GettingStarted * http://wiki.darcs.net/Development/FAQ++Comments about do-notation warnings+===================================+You may find a number of comments (163 of them at the time of writing) looking+like:+-- Warning: A do-notation statement discarded a result of type Whatever.+They signal warnings issued by GHC that have been automatically silenced.+See http://bugs.darcs.net/issue1988 for more detail.++These warnings were most certainly harmless, but who knows... If you stumble+upon one such comment, take a minute or two to check if it is really okay to+ignore the return value (look for "_ <- " on the line next to the comment). If+everything is correct, please remove the comment and send a patch (mentioning+issue1988). If it isn't, you have found a bug, congratulations! Fix it, or+fill a bug report on http//bugs.darcs.net/. Finally, if in doubt, leave it as+is. Many thanks. Testing =======
Setup.lhs view
@@ -1,5 +1,5 @@ \begin{code}-{-# OPTIONS_GHC -cpp #-}+{-# LANGUAGE CPP #-} -- copyright (c) 2008 Duncan Coutts -- portions copyright (c) 2008 David Roundy @@ -26,7 +26,7 @@ (buildVerbosity, copyDest, copyVerbosity, fromFlag, haddockVerbosity, installVerbosity, sDistVerbosity) import Distribution.Simple.BuildPaths- ( autogenModulesDir )+ ( autogenModulesDir, exeExtension ) import Distribution.System ( OS(Windows), buildOS ) import Distribution.Simple.Utils@@ -50,14 +50,14 @@ import System.IO.Error ( isDoesNotExistError ) import Data.List( isPrefixOf, isSuffixOf, sort, partition ) -import System.FilePath ( (</>), splitDirectories, isAbsolute )+import System.Cmd( rawSystem )+import System.Exit( exitWith )+import System.FilePath ( (</>), (<.>), splitDirectories, isAbsolute ) import Foreign.Marshal.Utils ( with ) import Foreign.Storable ( peek ) import Foreign.Ptr ( castPtr ) import Data.Word ( Word8, Word32 ) -import qualified Distribution.ShellHarness as Harness ( runTests )- import qualified Control.Exception as Exception -- Handle exceptions migration. We could use extensible-exceptions@@ -89,31 +89,23 @@ postInst = \ _ flags pkg lbi -> installManpage pkg lbi (fromFlag $ installVerbosity flags) NoCopyDest, - runTests = \ args _ _ lbi -> do+ runTests = \ args0 _ _ lbi -> do cwd <- getCurrentDirectory let isabs = isAbsolute $ buildDir lbi- path = (if isabs then id else (cwd </>))- (buildDir lbi </> "darcs")- what = if null args then ["tests"] else args- (series, tests) = partition- (`elem` ["bugs", "network", "tests"]) what- sequence_ [ case w of- "bugs" -> allTests path Bug []- "network" -> execTests path Network "" []- "tests" -> allTests path Test []- _ -> return () {- impossible, silence -Wall -}- | w <- series ]- when (not $ null tests) $ individualTests path tests,-- -- Remove the temporary directories created by "cabal test".- postClean = \ _ _ _ _ -> mapM_ rmRf- ["tests-darcs-2.dir",- "tests-hashed.dir",- "tests-old-fashioned-inventory.dir",- "bugs-darcs-2.dir",- "bugs-hashed.dir",- "bugs-old-fashioned-inventory.dir",- "tests-network.dir"],+ builddir = (if isabs then id else (cwd </>)) $ buildDir lbi+ darcs = builddir </> "darcs" </> "darcs" <.> exeExtension+ darcstest = builddir </> "darcs-test" </> "darcs-test" <.> exeExtension+ (flags, args1) = partition ('=' `elem`) args0+ (what', args2) = partition (`elem` ["bugs", "network", "tests", "unit"]) args1+ what = if null what' then ["tests"] else what'+ opts = [ "--darcs", darcs ] ++ concat [ ["-t", x] | x <- args2 ] +++ [ "--no-unit" | "unit" `notElem` what] +++ [ "--network" | "network" <- what ] ++ [ "--failing" | "bugs" <- what ] +++ [ "--no-shell" | _ <- [()], "tests" `notElem` what ] +++ [ "--threads=" ++ drop 8 t | t <- flags, "threads" `isPrefixOf` t ] +++ [ "--plain" | "output=plain" <- flags ]+ rawSystem darcstest opts >>= exitWith+ , sDistHook = \ pkg lbi hooks flags -> do let pkgVer = packageVersion pkg@@ -244,12 +236,8 @@ context :: Verbosity -> Version -> IO (Maybe String) context verbosity version = do contextDarcs <- do- -- FIXME currently we run changes --from-tag to at least assert that the- -- requested version is tagged in this repository... it is a weak check,- -- but otherwise, my ~/_darcs context tends to gets used when running- -- from an unpacked distribution- rawSystemStdout verbosity "darcs"- ["changes", "--from-tag", display version ]+ inrepo <- doesDirectoryExist "_darcs"+ unless inrepo $ fail "Not a repository." out <- rawSystemStdout verbosity "darcs" ["changes", "--context"] return $ Just out `catchAny` \_ -> return Nothing@@ -270,135 +258,5 @@ ((s,_):_) -> return s _ -> return Nothing else return Nothing------------------------------------------ Running the testsuite-----data TestKind = Bug | Test | Network deriving Eq--testDir :: TestKind -> String-testDir Bug = "tests"-testDir Test = "tests"-testDir Network = "tests/network"--deslash :: Char -> Char-deslash '/' = '-'-deslash x = x--isSh :: FilePath -> Bool-isSh = (".sh" `isSuffixOf`)---- | By convention, a test script starts with "failing-" iff it is--- expected to fail, i.e. it is a bug that hasn't been fixed yet.-isTest :: TestKind -> FilePath -> Bool-isTest Bug = ("failing-" `isPrefixOf`)-isTest _ = not . isTest Bug--execTests :: FilePath -> TestKind -> String -> [String] -> IO ()-execTests darcs_path k fmt tests = do- let dir = map deslash (testDir k) ++ (if null fmt then fmt else "-" ++ fmt) ++ ".dir"- rmRf dir- cloneTree (testDir k) dir- withCurrentDirectory dir $ do- createDirectory ".darcs"- when (not $ null fmt) $ appendFile ".darcs/defaults" $ "ALL " ++ fmt ++ "\n"- putStrLn $ "Running tests for format: " ++ fmt- fs <- case tests of- [] -> sort `fmap` getDirectoryContents "."- x -> return x- let run = filter (\f -> isSh f && isTest k f) fs- cwd <- getCurrentDirectory- res <- Harness.runTests (Just darcs_path) cwd run- when ((not res) && (k /= Bug)) $ fail "Tests failed"- return ()--individualTests :: FilePath -> [String] -> IO ()-individualTests darcs_path tests = do- run <- concat `fmap` mapM find tests- sequence_ [ do exec kind [test | (kind', test) <- run, kind' == kind]- | kind <- [Test, Bug, Network] ]- where tryin w t' = [w </> t', w </> (t' ++ ".sh")]- exec _ [] = return ()- exec kind to_run = allTests darcs_path kind to_run- find t = do- let c = [t, t ++ ".sh"] ++ tryin "tests" t- ++ tryin "network" t- run <- map kindify `fmap` filterM doesFileExist c- return $ take 1 run- kindify test = case splitDirectories test of- ["tests", y] -> (parse_kind y, y)- ["tests","network",y] -> (Network, y)- xs -> error $ "Bad format in " ++ test ++- ": expected type/test" ++ " but got " ++ show xs- parse_kind y = if isTest Bug y then Bug else Test--allTests :: FilePath -> TestKind -> [String] -> IO ()-allTests darcs_path k s =- do test `mapM` repotypes- return ()- where repotypes = ["darcs-2", "hashed", "old-fashioned-inventory"]- test x = execTests darcs_path k x s------------------------------------------------------------ Utility functions (FIXME)--- copy & paste & edit: darcs wants to share these-----withCurrentDirectory :: FilePath -> IO a -> IO a-withCurrentDirectory name m =- bracket- (do cwd <- getCurrentDirectory- when (name /= "") (setCurrentDirectory name)- return cwd)- (\oldwd -> setCurrentDirectory oldwd `catchAny` (\_ -> return ()))- (const m)--cloneTree :: FilePath -> FilePath -> IO ()-cloneTree = cloneTreeExcept []--cloneTreeExcept :: [FilePath] -> FilePath -> FilePath -> IO ()-cloneTreeExcept except source dest =- do isdir <- doesDirectoryExist source- if isdir then do- createDirectoryIfMissing True dest- fps <- getDirectoryContents source- let fps' = filter (`notElem` (".":"..":except)) fps- mk_source fp = source ++ "/" ++ fp- mk_dest fp = dest ++ "/" ++ fp- zipWithM_ cloneSubTree (map mk_source fps') (map mk_dest fps')- else fail ("cloneTreeExcept: Bad source " ++ source)- `catchAny` fail ("cloneTreeExcept: Bad source " ++ source)--cloneSubTree :: FilePath -> FilePath -> IO ()-cloneSubTree source dest =- do isdir <- doesDirectoryExist source- isfile <- doesFileExist source- if isdir then do- createDirectory dest- fps <- getDirectoryContents source- let fps' = filter (`notElem` [".", ".."]) fps- mk_source fp = source ++ "/" ++ fp- mk_dest fp = dest ++ "/" ++ fp- zipWithM_ cloneSubTree (map mk_source fps') (map mk_dest fps')- else if isfile then do- cloneFile source dest- else fail ("cloneSubTree: Bad source "++ source)- `Prelude.catch` (\e -> if isDoesNotExistError e- then return ()- else ioError e)--cloneFile :: FilePath -> FilePath -> IO ()-cloneFile = copyFile--rmRf :: FilePath -> IO ()-rmRf path = do- isdir <- doesDirectoryExist path- isf <- doesFileExist path- when isdir $ removeDirectoryRecursive path- when isf $ removeFile path- return ()---- (END FIXME) \end{code}
contrib/update_roundup.pl view
@@ -41,7 +41,7 @@ # 'some other patch' => { ... }, for my $patch_name (keys %{ $xml->{patch} }) {- my $issue_re = qr/resolved? \s+ (issue\d+)/msxi;+ my $issue_re = qr/resolved? \s+ (issue ?\d+)/msxi; next unless ($patch_name =~ $issue_re); my $issue = $1;@@ -63,12 +63,13 @@ # Each patches can potentially update the status of a different issue, so generates a different e-mail my $msg = MIME::Lite->new(- From => $email, + From => 'noreply@darcs.net', To =>'bugs@lists.osuosl.org', #To =>'mark@stosberg.com', Subject =>"[$issue] [$UPDATE_STRING]", Type =>'text/plain',- Data => qq!The following patch updated issue $issue with $UPDATE_STRING+ Data => qq!The following patch sent by $email updated issue $issue with+$UPDATE_STRING * $patch_name $comment
darcs-beta.cabal view
@@ -1,5 +1,5 @@ Name: darcs-beta-version: 2.4.99.1+version: 2.7.98.1 License: GPL License-file: COPYING Author: David Roundy <droundy@darcs.net>, <darcs-users@darcs.net>@@ -47,8 +47,8 @@ contrib/darcs-errors.hlint, -- documentation files- src/best_practices.tex, src/building_darcs.tex, src/configuring_darcs.tex,- src/features.tex, src/formats.tex, src/gpl.tex, src/switching.tex, src/darcs.tex+ doc/src/best_practices.tex, doc/src/building_darcs.tex, doc/src/configuring_darcs.tex,+ doc/src/features.tex, doc/src/gpl.tex, doc/src/darcs.tex doc/darcs.css README, NEWS@@ -57,15 +57,15 @@ release/distributed-version, release/distributed-context -- testsuite- Distribution/ShellHarness.hs- tests/repos/*.tgz tests/repos/README- tests/repos/minimal-darcs-2.4.tgz+ tests/data/*.tgz tests/data/README+ tests/data/*.dpatch+ tests/data/convert/darcs1/*.dpatch tests/data/convert/darcs2/*.dpatch tests/*.sh- tests/trackdown-bisect-helper.hs- tests/hspwd.hs+ tests/bin/trackdown-bisect-helper.hs+ tests/bin/hspwd.hs tests/network/*.sh tests/lib- tests/example_binary.png+ tests/data/example_binary.png tests/README.test_maintainers.txt GNUmakefile@@ -91,10 +91,6 @@ description: Use threading and SMP support. default: True -flag type-witnesses- description: Use GADT type witnesses.- default: False- flag library description: Build darcs library default: True@@ -105,10 +101,6 @@ flag mmap description: Compile with mmap support. -flag test- description: Compile unit tests (requires QuickCheck >= 2.1.0.0).- default: False- flag hpc default: False @@ -116,79 +108,18 @@ default: False description: A cunning trick to have cabal install build dependencies -Executable witnesses- main-is: witnesses.hs-- if !flag(type-witnesses)- buildable: False- else- buildable: True-- hs-source-dirs: src- include-dirs: src- cpp-options: -DGADT_WITNESSES=1- -- FIXME...- c-sources: src/atomic_create.c- src/fpstring.c- src/maybe_relink.c- src/umask.c- src/Crypt/sha2.c- -- this module isn't exported by libdarcs, so not included in the tarball- -- if not mentioned- other-modules: Darcs.Test.Patch.Check-- extensions:- CPP- PatternGuards- UndecidableInstances- ScopedTypeVariables- -- PatternSignatures is needed for GHC 6.8- PatternSignatures- RankNTypes- GADTs- TypeOperators-- if os(windows)- hs-source-dirs: src/win32- include-dirs: src/win32- other-modules: CtrlC- System.Posix- System.Posix.Files- System.Posix.IO- cpp-options: -DWIN32- c-sources: src/win32/send_email.c- build-depends: unix-compat >= 0.1.2,- regex-posix >= 0.94.4 && < 0.95+flag test+ default: False+ description: Build test harness - build-depends: base < 5,- extensible-exceptions >= 0.1 && < 0.2,- regex-compat >= 0.71 && < 0.94,- mtl >= 1.0 && < 1.2,- parsec >= 2.0 && < 3.1,- html == 1.0.*,- filepath == 1.1.*,- haskeline >= 0.6.2.2 && < 0.7,- hashed-storage >= 0.5.2 && < 0.6,- base >= 3,- bytestring >= 0.9.0 && < 0.10,- text >= 0.3,- old-time == 1.0.*,- directory == 1.0.*,- process == 1.0.*,- containers >= 0.1 && < 0.4,- array >= 0.1 && < 0.4,- random == 1.0.*,- tar == 0.3.*,- zlib >= 0.5.1.0 && < 0.6.0.0,- QuickCheck >= 2.1.0.0,- test-framework >= 0.2.2,- test-framework-quickcheck2 >= 0.2.2- if !os(windows)- build-depends: unix >= 1.0 && < 2.5- if flag(http)- build-depends: network == 2.2.*,- HTTP >= 3000.0 && < 4000.1+-- We need optimizations by default, regardless of what Hackage says+flag optimize+ default: True+ description: Build with optimizations (-O2) +flag warn-as-error+ default: False+ description: Build with warnings-as-errors -- ---------------------------------------------------------------------- -- darcs library@@ -203,8 +134,11 @@ hs-source-dirs: src include-dirs: src + cpp-options: -DGADT_WITNESSES=1+ exposed-modules: CommandLine Crypt.SHA256+ Darcs.Annotate Darcs.ArgumentDefaults Darcs.Arguments Darcs.Bug@@ -232,7 +166,6 @@ Darcs.Commands.Put Darcs.Commands.Record Darcs.Commands.Remove- Darcs.Commands.Repair Darcs.Commands.Replace Darcs.Commands.Revert Darcs.Commands.Rollback@@ -249,6 +182,7 @@ Darcs.Commands.Tag Darcs.Commands.TrackDown Darcs.Commands.TransferMode+ Darcs.Commands.Util Darcs.Commands.Unrecord Darcs.Commands.Unrevert Darcs.Commands.WhatsNew@@ -256,43 +190,73 @@ Darcs.Diff Darcs.Email Darcs.External- Darcs.FilePathMonad Darcs.Flags Darcs.Global- Darcs.Hopefully Darcs.IO Darcs.Lock Darcs.Match- Darcs.Witnesses.Ordered- Darcs.Witnesses.WZipper+ Darcs.MonadProgress Darcs.Patch Darcs.Patch.Apply+ Darcs.Patch.ApplyMonad+ Darcs.Patch.Bracketed+ Darcs.Patch.Bracketed.Instances Darcs.Patch.Bundle Darcs.Patch.Choices Darcs.Patch.Commute- Darcs.Patch.Core+ Darcs.Patch.Conflict+ Darcs.Patch.ConflictMarking Darcs.Patch.Depends+ Darcs.Patch.Dummy+ Darcs.Patch.Effect Darcs.Patch.FileName+ Darcs.Patch.FileHunk+ Darcs.Patch.Format Darcs.Patch.Info+ Darcs.Patch.Inspect+ Darcs.Patch.Invert Darcs.Patch.Match Darcs.Patch.MatchData- Darcs.Patch.Non+ Darcs.Patch.Merge+ Darcs.Patch.Named Darcs.Patch.OldDate+ Darcs.Patch.PatchInfoAnd Darcs.Patch.Patchy+ Darcs.Patch.Patchy.Instances Darcs.Patch.Permutations Darcs.Patch.Prim- Darcs.Patch.Properties+ Darcs.Patch.Prim.Class+ Darcs.Patch.Prim.V1+ Darcs.Patch.Prim.V1.Apply+ Darcs.Patch.Prim.V1.Coalesce+ Darcs.Patch.Prim.V1.Commute+ Darcs.Patch.Prim.V1.Core+ Darcs.Patch.Prim.V1.Details+ Darcs.Patch.Prim.V1.Read+ Darcs.Patch.Prim.V1.Show Darcs.Patch.Read Darcs.Patch.ReadMonads- Darcs.Patch.Real Darcs.Patch.RegChars+ Darcs.Patch.Repair+ Darcs.Patch.RepoPatch Darcs.Patch.Set Darcs.Patch.Show Darcs.Patch.Split+ Darcs.Patch.Summary+ Darcs.Patch.SummaryData+ Darcs.Patch.TokenReplace Darcs.Patch.TouchesFiles Darcs.Patch.Viewing- Darcs.Population- Darcs.PopulationData+ Darcs.Patch.V1+ Darcs.Patch.V1.Apply+ Darcs.Patch.V1.Commute+ Darcs.Patch.V1.Core+ Darcs.Patch.V1.Read+ Darcs.Patch.V1.Show+ Darcs.Patch.V1.Viewing+ Darcs.Patch.V2+ Darcs.Patch.V2.Non+ Darcs.Patch.V2.Real Darcs.PrintPatch Darcs.ProgressPatches Darcs.RemoteApply@@ -300,8 +264,6 @@ Darcs.Repository Darcs.Repository.ApplyPatches Darcs.Repository.Cache- Darcs.Repository.Checkpoint- Darcs.Repository.DarcsRepo Darcs.Repository.Format Darcs.Repository.HashedIO Darcs.Repository.HashedRepo@@ -310,20 +272,24 @@ Darcs.Repository.Merge Darcs.Repository.InternalTypes Darcs.Repository.Motd+ Darcs.Repository.Old Darcs.Repository.Prefs- Darcs.Repository.Pristine Darcs.Repository.Repair Darcs.Repository.State Darcs.Resolution Darcs.RunCommand- Darcs.Witnesses.Sealed Darcs.SelectChanges- Darcs.Witnesses.Show Darcs.SignalHandler Darcs.Test Darcs.TheCommands Darcs.URL Darcs.Utils+ Darcs.Witnesses.Eq+ Darcs.Witnesses.Ordered+ Darcs.Witnesses.Sealed+ Darcs.Witnesses.Show+ Darcs.Witnesses.Unsafe+ Darcs.Witnesses.WZipper DateMatcher English Exec@@ -356,49 +322,55 @@ System.Posix.Files System.Posix.IO cpp-options: -DWIN32+ c-sources: src/win32/send_email.c build-depends: unix-compat >= 0.1.2,- regex-posix >= 0.94.4 && < 0.95+ regex-posix >= 0.95.1 if os(solaris) cc-options: -DHAVE_SIGINFO_H - build-depends: base < 5,+ build-depends: base >= 4 && < 5, extensible-exceptions >= 0.1 && < 0.2,- regex-compat >= 0.71 && < 0.94,- mtl >= 1.0 && < 1.2,- parsec >= 2.0 && < 3.1,+ regex-compat >= 0.95.1,+ mtl >= 1.0 && < 2.1,+ parsec >= 2.0 && < 3.2, html == 1.0.*,- filepath == 1.1.*,- haskeline >= 0.6.2.2 && < 0.7,- hashed-storage >= 0.5.2 && < 0.6,+ filepath >= 1.1.0.0 && < 1.3.0.0,+ haskeline >= 0.6.3 && < 0.7,+ hashed-storage >= 0.5.6 && < 0.6,+ vector >= 0.7, tar == 0.3.* if !os(windows) build-depends: unix >= 1.0 && < 2.5 - build-depends: base >= 3,+ build-depends: base >= 4 && < 5, bytestring >= 0.9.0 && < 0.10,- text >= 0.3,+ text == 0.11.*, old-time == 1.0.*,- directory == 1.0.*,+ directory >= 1.0.0.0 && < 1.2.0.0, process == 1.0.*,- containers >= 0.1 && < 0.4,+ containers >= 0.1 && < 0.5, array >= 0.1 && < 0.4, random == 1.0.* - -- We need optimizations, regardless of what Hackage says+ if flag(optimize)+ ghc-options: -O2+ else+ ghc-options: -O0++ if flag(warn-as-error)+ ghc-options: -Werror+ -- Note: "if true" works around a cabal bug with order of flag composition if true- ghc-options: -Wall -O2 -funbox-strict-fields -fwarn-tabs-- if impl(ghc>=6.12)- ghc-options: -fno-warn-unused-do-bind+ ghc-options: -Wall -funbox-strict-fields -fwarn-tabs ghc-prof-options: -prof -auto-all if flag(hpc)- ghc-prof-options: -fhpc+ ghc-prof-options: -fhpc -hpcdir dist/hpc/libdarcs if flag(curl) extra-libraries: curl@@ -408,8 +380,8 @@ cc-options: -DHAVE_CURL if flag(http)- build-depends: network == 2.2.*,- HTTP >= 3000.0 && < 4000.1+ build-depends: network >= 2.2 && < 2.4,+ HTTP >= 3000.0 && < 4000.2 cpp-options: -DHAVE_HTTP x-have-http: @@ -430,29 +402,25 @@ if flag(color) x-use-color: - extensions:- CPP,- ForeignFunctionInterface,- BangPatterns,- PatternGuards,- MagicHash,- UndecidableInstances,- DeriveDataTypeable,- GADTs,- TypeOperators,- ExistentialQuantification,- FlexibleContexts,- FlexibleInstances,- ScopedTypeVariables,- -- PatternSignatures is needed for GHC 6.8- PatternSignatures,- KindSignatures,- TypeSynonymInstances,- Rank2Types,- RankNTypes,- GeneralizedNewtypeDeriving,- MultiParamTypeClasses+ -- if true to work around cabal bug with flag ordering+ if true+ extensions:+ CPP+ BangPatterns+ PatternGuards+ GADTs+ TypeOperators+ FlexibleContexts+ FlexibleInstances+ ScopedTypeVariables+ KindSignatures+ RankNTypes+ TypeFamilies + if impl(ghc>=7.0)+ extensions:+ NoMonoLocalBinds+ -- ---------------------------------------------------------------------- -- darcs itself -- ----------------------------------------------------------------------@@ -467,13 +435,18 @@ src/umask.c src/Crypt/sha2.c - -- We need optimizations, regardless of what Hackage says++ if flag(optimize)+ ghc-options: -O2+ else+ ghc-options: -O0++ if flag(warn-as-error)+ ghc-options: -Werror+ -- Note: "if true" works around a cabal bug with order of flag composition if true- ghc-options: -Wall -O2 -funbox-strict-fields -fwarn-tabs-- if impl(ghc>=6.12)- ghc-options: -fno-warn-unused-do-bind+ ghc-options: -Wall -funbox-strict-fields -fwarn-tabs ghc-prof-options: -prof -auto-all if flag(threaded)@@ -483,7 +456,7 @@ ghc-options: -static -optl-static -optl-pthread if flag(hpc)- ghc-prof-options: -fhpc+ ghc-prof-options: -fhpc -hpcdir dist/hpc/darcs cc-options: -D_REENTRANT @@ -498,32 +471,33 @@ cpp-options: -DWIN32 c-sources: src/win32/send_email.c build-depends: unix-compat >= 0.1.2,- regex-posix >= 0.94.4 && < 0.95+ regex-posix >= 0.95.1 if os(solaris) cc-options: -DHAVE_SIGINFO_H - build-depends: base < 5,+ build-depends: base >= 4 && < 5, extensible-exceptions >= 0.1 && < 0.2,- regex-compat >= 0.71 && < 0.94,- mtl >= 1.0 && < 1.2,- parsec >= 2.0 && < 3.1,+ regex-compat >= 0.95.1,+ mtl >= 1.0 && < 2.1,+ parsec >= 2.0 && < 3.2, html == 1.0.*,- filepath == 1.1.*,- haskeline >= 0.6.2.2 && < 0.7,- hashed-storage >= 0.5.2 && < 0.6,+ filepath >= 1.1.0.0 && < 1.3.0.0,+ haskeline >= 0.6.3 && < 0.7,+ hashed-storage >= 0.5.6 && < 0.6,+ vector >= 0.7, tar == 0.3.* if !os(windows) build-depends: unix >= 1.0 && < 2.5 - build-depends: base >= 3,+ build-depends: base >= 4 && < 5, bytestring >= 0.9.0 && < 0.10,- text >= 0.3,+ text == 0.11.*, old-time == 1.0.*,- directory == 1.0.*,+ directory >= 1.0.0.0 && < 1.2.0.0, process == 1.0.*,- containers >= 0.1 && < 0.4,+ containers >= 0.1 && < 0.5, array >= 0.1 && < 0.4, random == 1.0.* @@ -535,8 +509,8 @@ cc-options: -DHAVE_CURL if flag(http)- build-depends: network == 2.2.*,- HTTP >= 3000.0 && < 4000.1+ build-depends: network >= 2.2 && < 2.4,+ HTTP >= 3000.0 && < 4000.2 cpp-options: -DHAVE_HTTP x-have-http: @@ -557,35 +531,31 @@ if flag(color) x-use-color: - extensions:- CPP,- ForeignFunctionInterface,- BangPatterns,- PatternGuards,- MagicHash,- UndecidableInstances,- DeriveDataTypeable,- GADTs,- TypeOperators,- ExistentialQuantification,- FlexibleContexts,- FlexibleInstances,- ScopedTypeVariables,- -- PatternSignatures is needed for GHC 6.8- PatternSignatures,- KindSignatures,- TypeSynonymInstances,- Rank2Types,- RankNTypes,- GeneralizedNewtypeDeriving,- MultiParamTypeClasses+ -- if true to work around cabal bug with flag ordering+ if true+ extensions:+ CPP+ BangPatterns+ PatternGuards+ GADTs+ TypeOperators+ FlexibleContexts+ FlexibleInstances+ ScopedTypeVariables+ KindSignatures+ RankNTypes+ TypeFamilies + if impl(ghc>=7.0)+ extensions:+ NoMonoLocalBinds+ -- ---------------------------------------------------------------------- -- unit test driver -- ---------------------------------------------------------------------- -Executable unit- main-is: unit.hs+Executable darcs-test+ main-is: test.hs if !flag(test) buildable: False@@ -593,17 +563,18 @@ buildable: True build-depends: base < 5, extensible-exceptions >= 0.1 && < 0.2,- regex-compat >= 0.71 && < 0.94,- mtl >= 1.0 && < 1.2,- parsec >= 2.0 && < 3.1,+ regex-compat >= 0.95.1,+ mtl >= 1.0 && < 2.1,+ parsec >= 2.0 && < 3.2, html == 1.0.*,- filepath == 1.1.*,- QuickCheck >= 2.1.0.0,+ filepath >= 1.1.0.0 && < 1.3.0.0,+ QuickCheck >= 2.3, HUnit >= 1.0,+ cmdlib >= 0.2.1 && < 0.4,+ shellish >= 0.1.3 && < 0.2, test-framework >= 0.2.2, test-framework-hunit >= 0.2.2,- test-framework-quickcheck2 >= 0.2.2-+ test-framework-quickcheck2 >= 0.2.8 hs-source-dirs: src include-dirs: src@@ -616,26 +587,47 @@ -- include them in the tarball other-modules: Darcs.Test.Email Darcs.Test.Patch.Check+ Darcs.Test.Patch.Examples+ Darcs.Test.Patch.Examples2 Darcs.Test.Patch.Info+ Darcs.Test.Patch.Prim.V1+ Darcs.Test.Patch.Properties+ Darcs.Test.Patch.Properties2 Darcs.Test.Patch.QuickCheck+ Darcs.Test.Patch.RepoModel Darcs.Test.Patch.Test Darcs.Test.Patch.Unit- Darcs.Test.Unit+ Darcs.Test.Patch.Unit2+ Darcs.Test.Patch.Utils+ Darcs.Test.Patch.WithState+ Darcs.Test.Patch+ Darcs.Test.Misc+ Darcs.Test.Util.TestResult+ Darcs.Test.Util.QuickCheck - -- We need optimizations, regardless of what Hackage says+ if flag(optimize)+ ghc-options: -O2+ else+ ghc-options: -O0++ if flag(warn-as-error)+ ghc-options: -Werror+ -- Note: "if true" works around a cabal bug with order of flag composition if true- ghc-options: -Wall -O2 -funbox-strict-fields -fwarn-tabs-- if impl(ghc>=6.12)- ghc-options: -fno-warn-unused-do-bind+ ghc-options: -Wall -funbox-strict-fields -fwarn-tabs ghc-prof-options: -prof -auto-all if flag(threaded) ghc-options: -threaded + if flag(hpc)+ ghc-prof-options: -fhpc -hpcdir dist/hpc/darcs-test+ cc-options: -D_REENTRANT + cpp-options: -DGADT_WITNESSES=1+ if os(windows) hs-source-dirs: src/win32 include-dirs: src/win32@@ -646,7 +638,7 @@ cpp-options: -DWIN32 c-sources: src/win32/send_email.c build-depends: unix-compat >= 0.1.2,- regex-posix >= 0.94.4 && < 0.95+ regex-posix >= 0.95.1 if os(solaris) cc-options: -DHAVE_SIGINFO_H@@ -654,16 +646,18 @@ if !os(windows) build-depends: unix >= 1.0 && < 2.5 - build-depends: base >= 3,+ build-depends: base >= 4 && < 5, bytestring >= 0.9.0 && < 0.10,- haskeline >= 0.6.2.2 && < 0.7,- text >= 0.3,+ haskeline >= 0.6.3 && < 0.7,+ text == 0.11.*, old-time == 1.0.*,- directory == 1.0.*,+ directory >= 1.0.0.0 && < 1.2.0.0, process == 1.0.*,- containers >= 0.1 && < 0.4,+ containers >= 0.1 && < 0.5, array >= 0.1 && < 0.4,- hashed-storage >= 0.5.2 && < 0.6,+ hashed-storage >= 0.5.6 && < 0.6,+ vector >= 0.7,+ tar == 0.3.*, random == 1.0.* if flag(mmap) && !os(windows)@@ -678,32 +672,27 @@ cpp-options: -DHAVE_TERMINFO if flag(http)- build-depends: network == 2.2.*,- HTTP >= 3000.0 && < 4000.1+ build-depends: network >= 2.2 && < 2.4,+ HTTP >= 3000.0 && < 4000.2 if flag(color) x-use-color: - extensions:- CPP,- ForeignFunctionInterface,- BangPatterns,- PatternGuards,- MagicHash,- UndecidableInstances,- DeriveDataTypeable,- GADTs,- TypeOperators,- ExistentialQuantification,- FlexibleContexts,- FlexibleInstances,- ScopedTypeVariables,- -- PatternSignatures is needed for GHC 6.8- PatternSignatures,- KindSignatures,- TypeSynonymInstances,- Rank2Types,- RankNTypes,- GeneralizedNewtypeDeriving,- MultiParamTypeClasses- OverlappingInstances+ -- if true to work around cabal bug with flag ordering+ if true+ extensions:+ CPP+ BangPatterns+ PatternGuards+ GADTs+ TypeOperators+ FlexibleContexts+ FlexibleInstances+ ScopedTypeVariables+ KindSignatures+ RankNTypes+ TypeFamilies++ if impl(ghc>=7.0)+ extensions:+ NoMonoLocalBinds
+ dist/build/ByteStringUtils.hi view
binary file changed (absent → 33404 bytes)
+ dist/build/ByteStringUtils.o view
binary file changed (absent → 116416 bytes)
+ dist/build/CommandLine.hi view
binary file changed (absent → 2466 bytes)
+ dist/build/CommandLine.o view
binary file changed (absent → 61872 bytes)
+ dist/build/Crypt/SHA256.hi view
binary file changed (absent → 3003 bytes)
+ dist/build/Crypt/SHA256.o view
binary file changed (absent → 8944 bytes)
+ dist/build/Darcs/Annotate.hi view
binary file changed (absent → 18503 bytes)
+ dist/build/Darcs/Annotate.o view
binary file changed (absent → 133008 bytes)
+ dist/build/Darcs/ArgumentDefaults.hi view
binary file changed (absent → 9007 bytes)
+ dist/build/Darcs/ArgumentDefaults.o view
binary file changed (absent → 27096 bytes)
+ dist/build/Darcs/Arguments.hi view
binary file changed (absent → 161367 bytes)
+ dist/build/Darcs/Arguments.o view
binary file changed (absent → 662248 bytes)
+ dist/build/Darcs/Bug.hi view
binary file changed (absent → 3137 bytes)
+ dist/build/Darcs/Bug.o view
binary file changed (absent → 12904 bytes)
+ dist/build/Darcs/ColorPrinter.hi view
binary file changed (absent → 7569 bytes)
+ dist/build/Darcs/ColorPrinter.o view
binary file changed (absent → 96776 bytes)
+ dist/build/Darcs/Commands.hi view
binary file changed (absent → 20727 bytes)
+ dist/build/Darcs/Commands.o view
binary file changed (absent → 87600 bytes)
+ dist/build/Darcs/Commands/Add.hi view
binary file changed (absent → 13704 bytes)
+ dist/build/Darcs/Commands/Add.o view
binary file changed (absent → 158192 bytes)
+ dist/build/Darcs/Commands/AmendRecord.hi view
binary file changed (absent → 16156 bytes)
+ dist/build/Darcs/Commands/AmendRecord.o view
binary file changed (absent → 118144 bytes)
+ dist/build/Darcs/Commands/Annotate.hi view
binary file changed (absent → 12775 bytes)
+ dist/build/Darcs/Commands/Annotate.o view
binary file changed (absent → 91688 bytes)
+ dist/build/Darcs/Commands/Apply.hi view
binary file changed (absent → 16521 bytes)
+ dist/build/Darcs/Commands/Apply.o view
binary file changed (absent → 210752 bytes)
+ dist/build/Darcs/Commands/Changes.hi view
binary file changed (absent → 14394 bytes)
+ dist/build/Darcs/Commands/Changes.o view
binary file changed (absent → 137488 bytes)
+ dist/build/Darcs/Commands/Check.hi view
binary file changed (absent → 11562 bytes)
+ dist/build/Darcs/Commands/Check.o view
binary file changed (absent → 51104 bytes)
+ dist/build/Darcs/Commands/Convert.hi view
binary file changed (absent → 13713 bytes)
+ dist/build/Darcs/Commands/Convert.o view
binary file changed (absent → 132224 bytes)
+ dist/build/Darcs/Commands/Diff.hi view
binary file changed (absent → 13919 bytes)
+ dist/build/Darcs/Commands/Diff.o view
binary file changed (absent → 64400 bytes)
+ dist/build/Darcs/Commands/Dist.hi view
binary file changed (absent → 10686 bytes)
+ dist/build/Darcs/Commands/Dist.o view
binary file changed (absent → 38112 bytes)
+ dist/build/Darcs/Commands/GZCRCs.hi view
binary file changed (absent → 15583 bytes)
+ dist/build/Darcs/Commands/GZCRCs.o view
binary file changed (absent → 96224 bytes)
+ dist/build/Darcs/Commands/Get.hi view
binary file changed (absent → 13888 bytes)
+ dist/build/Darcs/Commands/Get.o view
binary file changed (absent → 111296 bytes)
+ dist/build/Darcs/Commands/Help.hi view
binary file changed (absent → 16402 bytes)
+ dist/build/Darcs/Commands/Help.o view
binary file changed (absent → 120024 bytes)
+ dist/build/Darcs/Commands/Init.hi view
binary file changed (absent → 8660 bytes)
+ dist/build/Darcs/Commands/Init.o view
binary file changed (absent → 10544 bytes)
+ dist/build/Darcs/Commands/MarkConflicts.hi view
binary file changed (absent → 9954 bytes)
+ dist/build/Darcs/Commands/MarkConflicts.o view
binary file changed (absent → 35584 bytes)
+ dist/build/Darcs/Commands/Move.hi view
binary file changed (absent → 11101 bytes)
+ dist/build/Darcs/Commands/Move.o view
binary file changed (absent → 76152 bytes)
+ dist/build/Darcs/Commands/Optimize.hi view
binary file changed (absent → 13939 bytes)
+ dist/build/Darcs/Commands/Optimize.o view
binary file changed (absent → 180992 bytes)
+ dist/build/Darcs/Commands/Pull.hi view
binary file changed (absent → 17859 bytes)
+ dist/build/Darcs/Commands/Pull.o view
binary file changed (absent → 158144 bytes)
+ dist/build/Darcs/Commands/Push.hi view
binary file changed (absent → 14066 bytes)
+ dist/build/Darcs/Commands/Push.o view
binary file changed (absent → 89576 bytes)
+ dist/build/Darcs/Commands/Put.hi view
binary file changed (absent → 11889 bytes)
+ dist/build/Darcs/Commands/Put.o view
binary file changed (absent → 63072 bytes)
+ dist/build/Darcs/Commands/Record.hi view
binary file changed (absent → 19869 bytes)
+ dist/build/Darcs/Commands/Record.o view
binary file changed (absent → 253984 bytes)
+ dist/build/Darcs/Commands/Remove.hi view
binary file changed (absent → 12932 bytes)
+ dist/build/Darcs/Commands/Remove.o view
binary file changed (absent → 54328 bytes)
+ dist/build/Darcs/Commands/Replace.hi view
binary file changed (absent → 11572 bytes)
+ dist/build/Darcs/Commands/Replace.o view
binary file changed (absent → 129400 bytes)
+ dist/build/Darcs/Commands/Revert.hi view
binary file changed (absent → 11310 bytes)
+ dist/build/Darcs/Commands/Revert.o view
binary file changed (absent → 50176 bytes)
+ dist/build/Darcs/Commands/Rollback.hi view
binary file changed (absent → 14050 bytes)
+ dist/build/Darcs/Commands/Rollback.o view
binary file changed (absent → 123336 bytes)
+ dist/build/Darcs/Commands/Send.hi view
binary file changed (absent → 17693 bytes)
+ dist/build/Darcs/Commands/Send.o view
binary file changed (absent → 212048 bytes)
+ dist/build/Darcs/Commands/SetPref.hi view
binary file changed (absent → 11830 bytes)
+ dist/build/Darcs/Commands/SetPref.o view
binary file changed (absent → 43808 bytes)
+ dist/build/Darcs/Commands/Show.hi view
binary file changed (absent → 11003 bytes)
+ dist/build/Darcs/Commands/Show.o view
binary file changed (absent → 20296 bytes)
+ dist/build/Darcs/Commands/ShowAuthors.hi view
binary file changed (absent → 10368 bytes)
+ dist/build/Darcs/Commands/ShowAuthors.o view
binary file changed (absent → 93536 bytes)
+ dist/build/Darcs/Commands/ShowBug.hi view
binary file changed (absent → 8436 bytes)
+ dist/build/Darcs/Commands/ShowBug.o view
binary file changed (absent → 11200 bytes)
+ dist/build/Darcs/Commands/ShowContents.hi view
binary file changed (absent → 10160 bytes)
+ dist/build/Darcs/Commands/ShowContents.o view
binary file changed (absent → 34976 bytes)
+ dist/build/Darcs/Commands/ShowFiles.hi view
binary file changed (absent → 13727 bytes)
+ dist/build/Darcs/Commands/ShowFiles.o view
binary file changed (absent → 44432 bytes)
+ dist/build/Darcs/Commands/ShowIndex.hi view
binary file changed (absent → 11105 bytes)
+ dist/build/Darcs/Commands/ShowIndex.o view
binary file changed (absent → 31480 bytes)
+ dist/build/Darcs/Commands/ShowRepo.hi view
binary file changed (absent → 9933 bytes)
+ dist/build/Darcs/Commands/ShowRepo.o view
binary file changed (absent → 64224 bytes)
+ dist/build/Darcs/Commands/ShowTags.hi view
binary file changed (absent → 12968 bytes)
+ dist/build/Darcs/Commands/ShowTags.o view
binary file changed (absent → 18536 bytes)
+ dist/build/Darcs/Commands/Tag.hi view
binary file changed (absent → 11115 bytes)
+ dist/build/Darcs/Commands/Tag.o view
binary file changed (absent → 29952 bytes)
+ dist/build/Darcs/Commands/TrackDown.hi view
binary file changed (absent → 13397 bytes)
+ dist/build/Darcs/Commands/TrackDown.o view
binary file changed (absent → 89224 bytes)
+ dist/build/Darcs/Commands/TransferMode.hi view
binary file changed (absent → 10653 bytes)
+ dist/build/Darcs/Commands/TransferMode.o view
binary file changed (absent → 24344 bytes)
+ dist/build/Darcs/Commands/Unrecord.hi view
binary file changed (absent → 17042 bytes)
+ dist/build/Darcs/Commands/Unrecord.o view
binary file changed (absent → 113168 bytes)
+ dist/build/Darcs/Commands/Unrevert.hi view
binary file changed (absent → 14337 bytes)
+ dist/build/Darcs/Commands/Unrevert.o view
binary file changed (absent → 49752 bytes)
+ dist/build/Darcs/Commands/Util.hi view
binary file changed (absent → 9002 bytes)
+ dist/build/Darcs/Commands/Util.o view
binary file changed (absent → 28360 bytes)
+ dist/build/Darcs/Commands/WhatsNew.hi view
binary file changed (absent → 12990 bytes)
+ dist/build/Darcs/Commands/WhatsNew.o view
binary file changed (absent → 57512 bytes)
+ dist/build/Darcs/CommandsAux.hi view
binary file changed (absent → 7633 bytes)
+ dist/build/Darcs/CommandsAux.o view
binary file changed (absent → 20664 bytes)
+ dist/build/Darcs/Compat.hi view
binary file changed (absent → 4698 bytes)
+ dist/build/Darcs/Compat.o view
binary file changed (absent → 27024 bytes)
+ dist/build/Darcs/Diff.hi view
binary file changed (absent → 6377 bytes)
+ dist/build/Darcs/Diff.o view
binary file changed (absent → 79136 bytes)
+ dist/build/Darcs/Email.hi view
binary file changed (absent → 4608 bytes)
+ dist/build/Darcs/Email.o view
binary file changed (absent → 114824 bytes)
+ dist/build/Darcs/External.hi view
binary file changed (absent → 26572 bytes)
+ dist/build/Darcs/External.o view
binary file changed (absent → 344408 bytes)
+ dist/build/Darcs/Flags.hi view
binary file changed (absent → 14751 bytes)
+ dist/build/Darcs/Flags.o view
binary file changed (absent → 294576 bytes)
+ dist/build/Darcs/Global.hi view
binary file changed (absent → 14860 bytes)
+ dist/build/Darcs/Global.o view
binary file changed (absent → 47728 bytes)
+ dist/build/Darcs/IO.hi view
binary file changed (absent → 31819 bytes)
+ dist/build/Darcs/IO.o view
binary file changed (absent → 101928 bytes)
+ dist/build/Darcs/Lock.hi view
binary file changed (absent → 35790 bytes)
+ dist/build/Darcs/Lock.o view
binary file changed (absent → 153032 bytes)
+ dist/build/Darcs/Match.hi view
binary file changed (absent → 50904 bytes)
+ dist/build/Darcs/Match.o view
binary file changed (absent → 155600 bytes)
+ dist/build/Darcs/MonadProgress.hi view
binary file changed (absent → 5759 bytes)
+ dist/build/Darcs/MonadProgress.o view
binary file changed (absent → 20552 bytes)
+ dist/build/Darcs/Patch.hi view
binary file changed (absent → 8065 bytes)
+ dist/build/Darcs/Patch.o view
binary file changed (absent → 4056 bytes)
+ dist/build/Darcs/Patch/Apply.hi view
binary file changed (absent → 6371 bytes)
+ dist/build/Darcs/Patch/Apply.o view
binary file changed (absent → 10280 bytes)
+ dist/build/Darcs/Patch/ApplyMonad.hi view
binary file changed (absent → 27068 bytes)
+ dist/build/Darcs/Patch/ApplyMonad.o view
binary file changed (absent → 75872 bytes)
+ dist/build/Darcs/Patch/Bracketed.hi view
binary file changed (absent → 3673 bytes)
+ dist/build/Darcs/Patch/Bracketed.o view
binary file changed (absent → 7704 bytes)
+ dist/build/Darcs/Patch/Bracketed/Instances.hi view
binary file changed (absent → 3057 bytes)
+ dist/build/Darcs/Patch/Bracketed/Instances.o view
binary file changed (absent → 10144 bytes)
+ dist/build/Darcs/Patch/Bundle.hi view
binary file changed (absent → 13549 bytes)
+ dist/build/Darcs/Patch/Bundle.o view
binary file changed (absent → 99616 bytes)
+ dist/build/Darcs/Patch/Choices.hi view
binary file changed (absent → 37741 bytes)
+ dist/build/Darcs/Patch/Choices.o view
binary file changed (absent → 91368 bytes)
+ dist/build/Darcs/Patch/Commute.hi view
binary file changed (absent → 14224 bytes)
+ dist/build/Darcs/Patch/Commute.o view
binary file changed (absent → 21152 bytes)
+ dist/build/Darcs/Patch/Conflict.hi view
binary file changed (absent → 23930 bytes)
+ dist/build/Darcs/Patch/Conflict.o view
binary file changed (absent → 63448 bytes)
+ dist/build/Darcs/Patch/ConflictMarking.hi view
binary file changed (absent → 4611 bytes)
+ dist/build/Darcs/Patch/ConflictMarking.o view
binary file changed (absent → 49624 bytes)
+ dist/build/Darcs/Patch/Depends.hi view
binary file changed (absent → 22562 bytes)
+ dist/build/Darcs/Patch/Depends.o view
binary file changed (absent → 148936 bytes)
+ dist/build/Darcs/Patch/Dummy.hi view
binary file changed (absent → 10235 bytes)
+ dist/build/Darcs/Patch/Dummy.o view
binary file changed (absent → 25072 bytes)
+ dist/build/Darcs/Patch/Effect.hi view
binary file changed (absent → 7575 bytes)
+ dist/build/Darcs/Patch/Effect.o view
binary file changed (absent → 10664 bytes)
+ dist/build/Darcs/Patch/FileHunk.hi view
binary file changed (absent → 3811 bytes)
+ dist/build/Darcs/Patch/FileHunk.o view
binary file changed (absent → 14576 bytes)
+ dist/build/Darcs/Patch/FileName.hi view
binary file changed (absent → 10567 bytes)
+ dist/build/Darcs/Patch/FileName.o view
binary file changed (absent → 48104 bytes)
+ dist/build/Darcs/Patch/Format.hi view
binary file changed (absent → 1085 bytes)
+ dist/build/Darcs/Patch/Format.o view
binary file changed (absent → 4224 bytes)
+ dist/build/Darcs/Patch/Info.hi view
binary file changed (absent → 31587 bytes)
+ dist/build/Darcs/Patch/Info.o view
binary file changed (absent → 207752 bytes)
+ dist/build/Darcs/Patch/Inspect.hi view
binary file changed (absent → 4375 bytes)
+ dist/build/Darcs/Patch/Inspect.o view
binary file changed (absent → 9208 bytes)
+ dist/build/Darcs/Patch/Invert.hi view
binary file changed (absent → 1972 bytes)
+ dist/build/Darcs/Patch/Invert.o view
binary file changed (absent → 4192 bytes)
+ dist/build/Darcs/Patch/Match.hi view
binary file changed (absent → 27602 bytes)
+ dist/build/Darcs/Patch/Match.o view
binary file changed (absent → 145760 bytes)
+ dist/build/Darcs/Patch/MatchData.hi view
binary file changed (absent → 3283 bytes)
+ dist/build/Darcs/Patch/MatchData.o view
binary file changed (absent → 11296 bytes)
+ dist/build/Darcs/Patch/Merge.hi view
binary file changed (absent → 7058 bytes)
+ dist/build/Darcs/Patch/Merge.o view
binary file changed (absent → 11824 bytes)
+ dist/build/Darcs/Patch/Named.hi view
binary file changed (absent → 47590 bytes)
+ dist/build/Darcs/Patch/Named.o view
binary file changed (absent → 104080 bytes)
+ dist/build/Darcs/Patch/OldDate.hi view
binary file changed (absent → 2277 bytes)
+ dist/build/Darcs/Patch/OldDate.o view
binary file changed (absent → 371928 bytes)
+ dist/build/Darcs/Patch/PatchInfoAnd.hi view
binary file changed (absent → 49571 bytes)
+ dist/build/Darcs/Patch/PatchInfoAnd.o view
binary file changed (absent → 100296 bytes)
+ dist/build/Darcs/Patch/Patchy.hi view
binary file changed (absent → 4105 bytes)
+ dist/build/Darcs/Patch/Patchy.o view
binary file changed (absent → 6240 bytes)
+ dist/build/Darcs/Patch/Patchy/Instances.hi view
binary file changed (absent → 4457 bytes)
+ dist/build/Darcs/Patch/Patchy/Instances.o view
binary file changed (absent → 3456 bytes)
+ dist/build/Darcs/Patch/Permutations.hi view
binary file changed (absent → 27692 bytes)
+ dist/build/Darcs/Patch/Permutations.o view
binary file changed (absent → 61760 bytes)
+ dist/build/Darcs/Patch/Prim.hi view
binary file changed (absent → 4378 bytes)
+ dist/build/Darcs/Patch/Prim.o view
binary file changed (absent → 1464 bytes)
+ dist/build/Darcs/Patch/Prim/Class.hi view
binary file changed (absent → 12742 bytes)
+ dist/build/Darcs/Patch/Prim/Class.o view
binary file changed (absent → 33848 bytes)
+ dist/build/Darcs/Patch/Prim/V1.hi view
binary file changed (absent → 5460 bytes)
+ dist/build/Darcs/Patch/Prim/V1.o view
binary file changed (absent → 5368 bytes)
+ dist/build/Darcs/Patch/Prim/V1/Apply.hi view
binary file changed (absent → 6748 bytes)
+ dist/build/Darcs/Patch/Prim/V1/Apply.o view
binary file changed (absent → 65432 bytes)
+ dist/build/Darcs/Patch/Prim/V1/Coalesce.hi view
binary file changed (absent → 16233 bytes)
+ dist/build/Darcs/Patch/Prim/V1/Coalesce.o view
binary file changed (absent → 73600 bytes)
+ dist/build/Darcs/Patch/Prim/V1/Commute.hi view
binary file changed (absent → 11144 bytes)
+ dist/build/Darcs/Patch/Prim/V1/Commute.o view
binary file changed (absent → 60664 bytes)
+ dist/build/Darcs/Patch/Prim/V1/Core.hi view
binary file changed (absent → 29513 bytes)
+ dist/build/Darcs/Patch/Prim/V1/Core.o view
binary file changed (absent → 74408 bytes)
+ dist/build/Darcs/Patch/Prim/V1/Details.hi view
binary file changed (absent → 5879 bytes)
+ dist/build/Darcs/Patch/Prim/V1/Details.o view
binary file changed (absent → 8032 bytes)
+ dist/build/Darcs/Patch/Prim/V1/Read.hi view
binary file changed (absent → 5713 bytes)
+ dist/build/Darcs/Patch/Prim/V1/Read.o view
binary file changed (absent → 80896 bytes)
+ dist/build/Darcs/Patch/Prim/V1/Show.hi view
binary file changed (absent → 14904 bytes)
+ dist/build/Darcs/Patch/Prim/V1/Show.o view
binary file changed (absent → 83032 bytes)
+ dist/build/Darcs/Patch/Read.hi view
binary file changed (absent → 10915 bytes)
+ dist/build/Darcs/Patch/Read.o view
binary file changed (absent → 40888 bytes)
+ dist/build/Darcs/Patch/ReadMonads.hi view
binary file changed (absent → 28696 bytes)
+ dist/build/Darcs/Patch/ReadMonads.o view
binary file changed (absent → 96640 bytes)
+ dist/build/Darcs/Patch/RegChars.hi view
binary file changed (absent → 4142 bytes)
+ dist/build/Darcs/Patch/RegChars.o view
binary file changed (absent → 18480 bytes)
+ dist/build/Darcs/Patch/Repair.hi view
binary file changed (absent → 6974 bytes)
+ dist/build/Darcs/Patch/Repair.o view
binary file changed (absent → 14320 bytes)
+ dist/build/Darcs/Patch/RepoPatch.hi view
binary file changed (absent → 4478 bytes)
+ dist/build/Darcs/Patch/RepoPatch.o view
binary file changed (absent → 9152 bytes)
+ dist/build/Darcs/Patch/Set.hi view
binary file changed (absent → 8728 bytes)
+ dist/build/Darcs/Patch/Set.o view
binary file changed (absent → 10400 bytes)
+ dist/build/Darcs/Patch/Show.hi view
binary file changed (absent → 12046 bytes)
+ dist/build/Darcs/Patch/Show.o view
binary file changed (absent → 26824 bytes)
+ dist/build/Darcs/Patch/Split.hi view
binary file changed (absent → 10651 bytes)
+ dist/build/Darcs/Patch/Split.o view
binary file changed (absent → 43832 bytes)
+ dist/build/Darcs/Patch/Summary.hi view
binary file changed (absent → 14781 bytes)
+ dist/build/Darcs/Patch/Summary.o view
binary file changed (absent → 92216 bytes)
+ dist/build/Darcs/Patch/SummaryData.hi view
binary file changed (absent → 6635 bytes)
+ dist/build/Darcs/Patch/SummaryData.o view
binary file changed (absent → 31272 bytes)
+ dist/build/Darcs/Patch/TokenReplace.hi view
binary file changed (absent → 2322 bytes)
+ dist/build/Darcs/Patch/TokenReplace.o view
binary file changed (absent → 35800 bytes)
+ dist/build/Darcs/Patch/TouchesFiles.hi view
binary file changed (absent → 10785 bytes)
+ dist/build/Darcs/Patch/TouchesFiles.o view
binary file changed (absent → 28328 bytes)
+ dist/build/Darcs/Patch/V1.hi view
binary file changed (absent → 5674 bytes)
+ dist/build/Darcs/Patch/V1.o view
binary file changed (absent → 3872 bytes)
+ dist/build/Darcs/Patch/V1/Apply.hi view
binary file changed (absent → 7135 bytes)
+ dist/build/Darcs/Patch/V1/Apply.o view
binary file changed (absent → 8112 bytes)
+ dist/build/Darcs/Patch/V1/Commute.hi view
binary file changed (absent → 26795 bytes)
+ dist/build/Darcs/Patch/V1/Commute.o view
binary file changed (absent → 174224 bytes)
+ dist/build/Darcs/Patch/V1/Core.hi view
binary file changed (absent → 6474 bytes)
+ dist/build/Darcs/Patch/V1/Core.o view
binary file changed (absent → 10552 bytes)
+ dist/build/Darcs/Patch/V1/Read.hi view
binary file changed (absent → 4839 bytes)
+ dist/build/Darcs/Patch/V1/Read.o view
binary file changed (absent → 29544 bytes)
+ dist/build/Darcs/Patch/V1/Show.hi view
binary file changed (absent → 7552 bytes)
+ dist/build/Darcs/Patch/V1/Show.o view
binary file changed (absent → 19360 bytes)
+ dist/build/Darcs/Patch/V1/Viewing.hi view
binary file changed (absent → 11098 bytes)
+ dist/build/Darcs/Patch/V1/Viewing.o view
binary file changed (absent → 21240 bytes)
+ dist/build/Darcs/Patch/V2.hi view
binary file changed (absent → 4735 bytes)
+ dist/build/Darcs/Patch/V2.o view
binary file changed (absent → 2504 bytes)
+ dist/build/Darcs/Patch/V2/Non.hi view
binary file changed (absent → 25541 bytes)
+ dist/build/Darcs/Patch/V2/Non.o view
binary file changed (absent → 86184 bytes)
+ dist/build/Darcs/Patch/V2/Real.hi view
binary file changed (absent → 38970 bytes)
+ dist/build/Darcs/Patch/V2/Real.o view
binary file changed (absent → 416968 bytes)
+ dist/build/Darcs/Patch/Viewing.hi view
binary file changed (absent → 23011 bytes)
+ dist/build/Darcs/Patch/Viewing.o view
binary file changed (absent → 81736 bytes)
+ dist/build/Darcs/PrintPatch.hi view
binary file changed (absent → 11324 bytes)
+ dist/build/Darcs/PrintPatch.o view
binary file changed (absent → 12136 bytes)
+ dist/build/Darcs/ProgressPatches.hi view
binary file changed (absent → 5122 bytes)
+ dist/build/Darcs/ProgressPatches.o view
binary file changed (absent → 24456 bytes)
+ dist/build/Darcs/RemoteApply.hi view
binary file changed (absent → 3850 bytes)
+ dist/build/Darcs/RemoteApply.o view
binary file changed (absent → 19432 bytes)
+ dist/build/Darcs/RepoPath.hi view
binary file changed (absent → 29443 bytes)
+ dist/build/Darcs/RepoPath.o view
binary file changed (absent → 111520 bytes)
+ dist/build/Darcs/Repository.hi view
binary file changed (absent → 22388 bytes)
+ dist/build/Darcs/Repository.o view
binary file changed (absent → 217656 bytes)
+ dist/build/Darcs/Repository/ApplyPatches.hi view
binary file changed (absent → 7670 bytes)
+ dist/build/Darcs/Repository/ApplyPatches.o view
binary file changed (absent → 9552 bytes)
+ dist/build/Darcs/Repository/Cache.hi view
binary file changed (absent → 24540 bytes)
+ dist/build/Darcs/Repository/Cache.o view
binary file changed (absent → 219392 bytes)
+ dist/build/Darcs/Repository/Format.hi view
binary file changed (absent → 17325 bytes)
+ dist/build/Darcs/Repository/Format.o view
binary file changed (absent → 80320 bytes)
+ dist/build/Darcs/Repository/HashedIO.hi view
binary file changed (absent → 24516 bytes)
+ dist/build/Darcs/Repository/HashedIO.o view
binary file changed (absent → 188776 bytes)
+ dist/build/Darcs/Repository/HashedRepo.hi view
binary file changed (absent → 27606 bytes)
+ dist/build/Darcs/Repository/HashedRepo.o view
binary file changed (absent → 288256 bytes)
+ dist/build/Darcs/Repository/Internal.hi view
binary file changed (absent → 61507 bytes)
+ dist/build/Darcs/Repository/Internal.o view
binary file changed (absent → 401088 bytes)
+ dist/build/Darcs/Repository/InternalTypes.hi view
binary file changed (absent → 13538 bytes)
+ dist/build/Darcs/Repository/InternalTypes.o view
binary file changed (absent → 37320 bytes)
+ dist/build/Darcs/Repository/LowLevel.hi view
binary file changed (absent → 16234 bytes)
+ dist/build/Darcs/Repository/LowLevel.o view
binary file changed (absent → 36848 bytes)
+ dist/build/Darcs/Repository/Merge.hi view
binary file changed (absent → 10512 bytes)
+ dist/build/Darcs/Repository/Merge.o view
binary file changed (absent → 67408 bytes)
+ dist/build/Darcs/Repository/Motd.hi view
binary file changed (absent → 6374 bytes)
+ dist/build/Darcs/Repository/Motd.o view
binary file changed (absent → 11536 bytes)
+ dist/build/Darcs/Repository/Old.hi view
binary file changed (absent → 8796 bytes)
+ dist/build/Darcs/Repository/Old.o view
binary file changed (absent → 60816 bytes)
+ dist/build/Darcs/Repository/Prefs.hi view
binary file changed (absent → 24121 bytes)
+ dist/build/Darcs/Repository/Prefs.o view
binary file changed (absent → 228680 bytes)
+ dist/build/Darcs/Repository/Repair.hi view
binary file changed (absent → 11590 bytes)
+ dist/build/Darcs/Repository/Repair.o view
binary file changed (absent → 119008 bytes)
+ dist/build/Darcs/Repository/State.hi view
binary file changed (absent → 22528 bytes)
+ dist/build/Darcs/Repository/State.o view
binary file changed (absent → 94656 bytes)
+ dist/build/Darcs/Resolution.hi view
binary file changed (absent → 11251 bytes)
+ dist/build/Darcs/Resolution.o view
binary file changed (absent → 54328 bytes)
+ dist/build/Darcs/RunCommand.hi view
binary file changed (absent → 11037 bytes)
+ dist/build/Darcs/RunCommand.o view
binary file changed (absent → 67912 bytes)
+ dist/build/Darcs/SelectChanges.hi view
binary file changed (absent → 23864 bytes)
+ dist/build/Darcs/SelectChanges.o view
binary file changed (absent → 250672 bytes)
+ dist/build/Darcs/SignalHandler.hi view
binary file changed (absent → 11848 bytes)
+ dist/build/Darcs/SignalHandler.o view
binary file changed (absent → 53600 bytes)
+ dist/build/Darcs/Test.hi view
binary file changed (absent → 7586 bytes)
+ dist/build/Darcs/Test.o view
binary file changed (absent → 26144 bytes)
+ dist/build/Darcs/TheCommands.hi view
binary file changed (absent → 22024 bytes)
+ dist/build/Darcs/TheCommands.o view
binary file changed (absent → 32632 bytes)
+ dist/build/Darcs/URL.hi view
binary file changed (absent → 6279 bytes)
+ dist/build/Darcs/URL.o view
binary file changed (absent → 35464 bytes)
+ dist/build/Darcs/Utils.hi view
binary file changed (absent → 35004 bytes)
+ dist/build/Darcs/Utils.o view
binary file changed (absent → 163248 bytes)
+ dist/build/Darcs/Witnesses/Eq.hi view
binary file changed (absent → 5883 bytes)
+ dist/build/Darcs/Witnesses/Eq.o view
binary file changed (absent → 14992 bytes)
+ dist/build/Darcs/Witnesses/Ordered.hi view
binary file changed (absent → 33106 bytes)
+ dist/build/Darcs/Witnesses/Ordered.o view
binary file changed (absent → 101984 bytes)
+ dist/build/Darcs/Witnesses/Sealed.hi view
binary file changed (absent → 18101 bytes)
+ dist/build/Darcs/Witnesses/Sealed.o view
binary file changed (absent → 39680 bytes)
+ dist/build/Darcs/Witnesses/Show.hi view
binary file changed (absent → 4782 bytes)
+ dist/build/Darcs/Witnesses/Show.o view
binary file changed (absent → 11704 bytes)
+ dist/build/Darcs/Witnesses/Unsafe.hi view
binary file changed (absent → 2790 bytes)
+ dist/build/Darcs/Witnesses/Unsafe.o view
binary file changed (absent → 3792 bytes)
+ dist/build/Darcs/Witnesses/WZipper.hi view
binary file changed (absent → 6634 bytes)
+ dist/build/Darcs/Witnesses/WZipper.o view
binary file changed (absent → 11672 bytes)
+ dist/build/DateMatcher.hi view
binary file changed (absent → 5214 bytes)
+ dist/build/DateMatcher.o view
binary file changed (absent → 61432 bytes)
+ dist/build/English.hi view
binary file changed (absent → 6965 bytes)
+ dist/build/English.o view
binary file changed (absent → 28240 bytes)
+ dist/build/Exec.hi view
binary file changed (absent → 10588 bytes)
+ dist/build/Exec.o view
binary file changed (absent → 58360 bytes)
+ dist/build/HSdarcs-beta-2.7.98.1.o view
file too large to diff
+ dist/build/HTTP.hi view
binary file changed (absent → 14161 bytes)
+ dist/build/HTTP.o view
binary file changed (absent → 59176 bytes)
+ dist/build/IsoDate.hi view
binary file changed (absent → 17455 bytes)
+ dist/build/IsoDate.o view
binary file changed (absent → 831040 bytes)
+ dist/build/Lcs.hi view
binary file changed (absent → 3505 bytes)
+ dist/build/Lcs.o view
binary file changed (absent → 274872 bytes)
+ dist/build/Printer.hi view
binary file changed (absent → 33768 bytes)
+ dist/build/Printer.o view
binary file changed (absent → 117448 bytes)
+ dist/build/Progress.hi view
binary file changed (absent → 10698 bytes)
+ dist/build/Progress.o view
binary file changed (absent → 68416 bytes)
+ dist/build/Ratified.hi view
binary file changed (absent → 514 bytes)
+ dist/build/Ratified.o view
binary file changed (absent → 1408 bytes)
+ dist/build/SHA1.hi view
binary file changed (absent → 2353 bytes)
+ dist/build/SHA1.o view
binary file changed (absent → 47640 bytes)
+ dist/build/Ssh.hi view
binary file changed (absent → 15294 bytes)
+ dist/build/Ssh.o view
binary file changed (absent → 120312 bytes)
+ dist/build/URL.hi view
binary file changed (absent → 18900 bytes)
+ dist/build/URL.o view
binary file changed (absent → 169664 bytes)
+ dist/build/Version.hi view
binary file changed (absent → 678 bytes)
+ dist/build/Version.o view
binary file changed (absent → 5096 bytes)
+ dist/build/Workaround.hi view
binary file changed (absent → 2903 bytes)
+ dist/build/Workaround.o view
binary file changed (absent → 4376 bytes)
+ dist/build/autogen/Paths_darcs_beta.hs view
@@ -0,0 +1,29 @@+module Paths_darcs_beta (+ version,+ getBinDir, getLibDir, getDataDir, getLibexecDir,+ getDataFileName+ ) where++import Data.Version (Version(..))+import System.Environment (getEnv)++version :: Version+version = Version {versionBranch = [2,7,98,1], versionTags = []}++bindir, libdir, datadir, libexecdir :: FilePath++bindir = "/home/florent/.cabal/bin"+libdir = "/home/florent/.cabal/lib/darcs-beta-2.7.98.1/ghc-7.0.3"+datadir = "/home/florent/.cabal/share/darcs-beta-2.7.98.1"+libexecdir = "/home/florent/.cabal/libexec"++getBinDir, getLibDir, getDataDir, getLibexecDir :: IO FilePath+getBinDir = catch (getEnv "darcs_beta_bindir") (\_ -> return bindir)+getLibDir = catch (getEnv "darcs_beta_libdir") (\_ -> return libdir)+getDataDir = catch (getEnv "darcs_beta_datadir") (\_ -> return datadir)+getLibexecDir = catch (getEnv "darcs_beta_libexecdir") (\_ -> return libexecdir)++getDataFileName :: FilePath -> IO FilePath+getDataFileName name = do+ dir <- getDataDir+ return (dir ++ "/" ++ name)
+ dist/build/autogen/Version.hs view
@@ -0,0 +1,5 @@+module Version where+builddeps, version, context :: String+version = "2.7.98.1 (+ 7 patches)"+builddeps = "HTTP-4000.1.1\narray-0.3.0.2\nbase-4.3.1.0\nbytestring-0.9.1.10\ncontainers-0.4.0.0\ndirectory-1.1.0.0\nextensible-exceptions-0.1.1.2\nfilepath-1.2.0.0\nhashed-storage-0.5.7\nhaskeline-0.6.4.0\nhtml-1.0.1.2\nmmap-0.5.7\nmtl-2.0.1.0\nnetwork-2.3.0.2\nold-time-1.0.0.6\nparsec-3.1.1\nprocess-1.0.1.5\nrandom-1.0.0.3\nregex-compat-0.95.1\ntar-0.3.1.0\nterminfo-0.3.1.3\ntext-0.11.0.6\nunix-2.4.2.0\nvector-0.7.0.1\nzlib-0.5.3.1\nHUnit-1.2.2.3\nQuickCheck-2.4.1.1\ncmdlib-0.3\nshellish-0.1.4\ntest-framework-0.4.0\ntest-framework-hunit-0.2.6\ntest-framework-quickcheck2-0.2.10\n"+context = "\nContext:\n\n[use shell harness to run unit tests\nFlorent Becker <florent.becker@ens-lyon.org>**20110622121539\n Ignore-this: 90d1278826a355d026a1d1031328001\n] \n\n[allow shell harness to run unit tests\nFlorent Becker <florent.becker@ens-lyon.org>**20110622121520\n Ignore-this: 75a60c8708eab52ca96757c096843fdf\n] \n\n[add .dpatch test data\nFlorent Becker <florent.becker@ens-lyon.org>**20110621095836\n Ignore-this: fff511bd3980260ad03e9781dec4c384\n] \n\n[do not use dots in filenames for test/data, it confuses cabal sdist\nFlorent Becker <florent.becker@ens-lyon.org>**20110621095753\n Ignore-this: 8b50b23e13e63ba5eb9069763c7dd0df\n] \n\n[Remove ShellHarness in darcs.cabal\nFlorent Becker <florent.becker@ens-lyon.org>**20110621090001\n Ignore-this: f619960851f793c75bc0c29a7193d1fb\n] \n\n[Correct documentation files location in darcs.cabal\nFlorent Becker <florent.becker@ens-lyon.org>**20110621085512\n Ignore-this: 867399fa63cbb8f93fe988e409f0720f\n] \n\n[Remove test_stub.hs since it freaks cabal sdist out :-(\nFlorent Becker <florent.becker@ens-lyon.org>**20110621084645\n Ignore-this: 13f57c2e2035b5f429195abecda6abf\n] \n\n[TAG 2.7.98.1\nFlorent Becker <florent.becker@ens-lyon.org>**20110620163546\n Ignore-this: e91e53fb1f42bf61544c256a2e411e3d\n] \n"
+ dist/build/autogen/cabal_macros.h view
@@ -0,0 +1,226 @@+/* DO NOT EDIT: This file is automatically generated by Cabal */++/* package HTTP-4000.1.1 */+#define VERSION_HTTP "4000.1.1"+#define MIN_VERSION_HTTP(major1,major2,minor) (\+ (major1) < 4000 || \+ (major1) == 4000 && (major2) < 1 || \+ (major1) == 4000 && (major2) == 1 && (minor) <= 1)++/* package array-0.3.0.2 */+#define VERSION_array "0.3.0.2"+#define MIN_VERSION_array(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 3 || \+ (major1) == 0 && (major2) == 3 && (minor) <= 0)++/* package base-4.3.1.0 */+#define VERSION_base "4.3.1.0"+#define MIN_VERSION_base(major1,major2,minor) (\+ (major1) < 4 || \+ (major1) == 4 && (major2) < 3 || \+ (major1) == 4 && (major2) == 3 && (minor) <= 1)++/* package bytestring-0.9.1.10 */+#define VERSION_bytestring "0.9.1.10"+#define MIN_VERSION_bytestring(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 9 || \+ (major1) == 0 && (major2) == 9 && (minor) <= 1)++/* package containers-0.4.0.0 */+#define VERSION_containers "0.4.0.0"+#define MIN_VERSION_containers(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 4 || \+ (major1) == 0 && (major2) == 4 && (minor) <= 0)++/* package directory-1.1.0.0 */+#define VERSION_directory "1.1.0.0"+#define MIN_VERSION_directory(major1,major2,minor) (\+ (major1) < 1 || \+ (major1) == 1 && (major2) < 1 || \+ (major1) == 1 && (major2) == 1 && (minor) <= 0)++/* package extensible-exceptions-0.1.1.2 */+#define VERSION_extensible_exceptions "0.1.1.2"+#define MIN_VERSION_extensible_exceptions(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 1 || \+ (major1) == 0 && (major2) == 1 && (minor) <= 1)++/* package filepath-1.2.0.0 */+#define VERSION_filepath "1.2.0.0"+#define MIN_VERSION_filepath(major1,major2,minor) (\+ (major1) < 1 || \+ (major1) == 1 && (major2) < 2 || \+ (major1) == 1 && (major2) == 2 && (minor) <= 0)++/* package hashed-storage-0.5.7 */+#define VERSION_hashed_storage "0.5.7"+#define MIN_VERSION_hashed_storage(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 5 || \+ (major1) == 0 && (major2) == 5 && (minor) <= 7)++/* package haskeline-0.6.4.0 */+#define VERSION_haskeline "0.6.4.0"+#define MIN_VERSION_haskeline(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 6 || \+ (major1) == 0 && (major2) == 6 && (minor) <= 4)++/* package html-1.0.1.2 */+#define VERSION_html "1.0.1.2"+#define MIN_VERSION_html(major1,major2,minor) (\+ (major1) < 1 || \+ (major1) == 1 && (major2) < 0 || \+ (major1) == 1 && (major2) == 0 && (minor) <= 1)++/* package mmap-0.5.7 */+#define VERSION_mmap "0.5.7"+#define MIN_VERSION_mmap(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 5 || \+ (major1) == 0 && (major2) == 5 && (minor) <= 7)++/* package mtl-2.0.1.0 */+#define VERSION_mtl "2.0.1.0"+#define MIN_VERSION_mtl(major1,major2,minor) (\+ (major1) < 2 || \+ (major1) == 2 && (major2) < 0 || \+ (major1) == 2 && (major2) == 0 && (minor) <= 1)++/* package network-2.3.0.2 */+#define VERSION_network "2.3.0.2"+#define MIN_VERSION_network(major1,major2,minor) (\+ (major1) < 2 || \+ (major1) == 2 && (major2) < 3 || \+ (major1) == 2 && (major2) == 3 && (minor) <= 0)++/* package old-time-1.0.0.6 */+#define VERSION_old_time "1.0.0.6"+#define MIN_VERSION_old_time(major1,major2,minor) (\+ (major1) < 1 || \+ (major1) == 1 && (major2) < 0 || \+ (major1) == 1 && (major2) == 0 && (minor) <= 0)++/* package parsec-3.1.1 */+#define VERSION_parsec "3.1.1"+#define MIN_VERSION_parsec(major1,major2,minor) (\+ (major1) < 3 || \+ (major1) == 3 && (major2) < 1 || \+ (major1) == 3 && (major2) == 1 && (minor) <= 1)++/* package process-1.0.1.5 */+#define VERSION_process "1.0.1.5"+#define MIN_VERSION_process(major1,major2,minor) (\+ (major1) < 1 || \+ (major1) == 1 && (major2) < 0 || \+ (major1) == 1 && (major2) == 0 && (minor) <= 1)++/* package random-1.0.0.3 */+#define VERSION_random "1.0.0.3"+#define MIN_VERSION_random(major1,major2,minor) (\+ (major1) < 1 || \+ (major1) == 1 && (major2) < 0 || \+ (major1) == 1 && (major2) == 0 && (minor) <= 0)++/* package regex-compat-0.95.1 */+#define VERSION_regex_compat "0.95.1"+#define MIN_VERSION_regex_compat(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 95 || \+ (major1) == 0 && (major2) == 95 && (minor) <= 1)++/* package tar-0.3.1.0 */+#define VERSION_tar "0.3.1.0"+#define MIN_VERSION_tar(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 3 || \+ (major1) == 0 && (major2) == 3 && (minor) <= 1)++/* package terminfo-0.3.1.3 */+#define VERSION_terminfo "0.3.1.3"+#define MIN_VERSION_terminfo(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 3 || \+ (major1) == 0 && (major2) == 3 && (minor) <= 1)++/* package text-0.11.0.6 */+#define VERSION_text "0.11.0.6"+#define MIN_VERSION_text(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 11 || \+ (major1) == 0 && (major2) == 11 && (minor) <= 0)++/* package unix-2.4.2.0 */+#define VERSION_unix "2.4.2.0"+#define MIN_VERSION_unix(major1,major2,minor) (\+ (major1) < 2 || \+ (major1) == 2 && (major2) < 4 || \+ (major1) == 2 && (major2) == 4 && (minor) <= 2)++/* package vector-0.7.0.1 */+#define VERSION_vector "0.7.0.1"+#define MIN_VERSION_vector(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 7 || \+ (major1) == 0 && (major2) == 7 && (minor) <= 0)++/* package zlib-0.5.3.1 */+#define VERSION_zlib "0.5.3.1"+#define MIN_VERSION_zlib(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 5 || \+ (major1) == 0 && (major2) == 5 && (minor) <= 3)++/* package HUnit-1.2.2.3 */+#define VERSION_HUnit "1.2.2.3"+#define MIN_VERSION_HUnit(major1,major2,minor) (\+ (major1) < 1 || \+ (major1) == 1 && (major2) < 2 || \+ (major1) == 1 && (major2) == 2 && (minor) <= 2)++/* package QuickCheck-2.4.1.1 */+#define VERSION_QuickCheck "2.4.1.1"+#define MIN_VERSION_QuickCheck(major1,major2,minor) (\+ (major1) < 2 || \+ (major1) == 2 && (major2) < 4 || \+ (major1) == 2 && (major2) == 4 && (minor) <= 1)++/* package cmdlib-0.3 */+#define VERSION_cmdlib "0.3"+#define MIN_VERSION_cmdlib(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 3 || \+ (major1) == 0 && (major2) == 3 && (minor) <= 0)++/* package shellish-0.1.4 */+#define VERSION_shellish "0.1.4"+#define MIN_VERSION_shellish(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 1 || \+ (major1) == 0 && (major2) == 1 && (minor) <= 4)++/* package test-framework-0.4.0 */+#define VERSION_test_framework "0.4.0"+#define MIN_VERSION_test_framework(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 4 || \+ (major1) == 0 && (major2) == 4 && (minor) <= 0)++/* package test-framework-hunit-0.2.6 */+#define VERSION_test_framework_hunit "0.2.6"+#define MIN_VERSION_test_framework_hunit(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 2 || \+ (major1) == 0 && (major2) == 2 && (minor) <= 6)++/* package test-framework-quickcheck2-0.2.10 */+#define VERSION_test_framework_quickcheck2 "0.2.10"+#define MIN_VERSION_test_framework_quickcheck2(major1,major2,minor) (\+ (major1) < 0 || \+ (major1) == 0 && (major2) < 2 || \+ (major1) == 0 && (major2) == 2 && (minor) <= 10)+
+ dist/build/darcs-test/darcs-test view
file too large to diff
+ dist/build/darcs-test/darcs-test-tmp/ByteStringUtils.hi view
binary file changed (absent → 33389 bytes)
+ dist/build/darcs-test/darcs-test-tmp/ByteStringUtils.o view
binary file changed (absent → 111672 bytes)
+ dist/build/darcs-test/darcs-test-tmp/CommandLine.hi view
binary file changed (absent → 2451 bytes)
+ dist/build/darcs-test/darcs-test-tmp/CommandLine.o view
binary file changed (absent → 61448 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Crypt/SHA256.hi view
binary file changed (absent → 2988 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Crypt/SHA256.o view
binary file changed (absent → 8640 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Arguments.hi view
binary file changed (absent → 161352 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Arguments.o view
binary file changed (absent → 606784 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Bug.hi view
binary file changed (absent → 3122 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Bug.o view
binary file changed (absent → 12128 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/ColorPrinter.hi view
binary file changed (absent → 7554 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/ColorPrinter.o view
binary file changed (absent → 95112 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Commands.hi view
binary file changed (absent → 20712 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Commands.o view
binary file changed (absent → 82320 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Commands/Replace.hi view
binary file changed (absent → 11557 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Commands/Replace.o view
binary file changed (absent → 126880 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/CommandsAux.hi view
binary file changed (absent → 7618 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/CommandsAux.o view
binary file changed (absent → 19640 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Compat.hi view
binary file changed (absent → 4683 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Compat.o view
binary file changed (absent → 26024 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Diff.hi view
binary file changed (absent → 6362 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Diff.o view
binary file changed (absent → 77792 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Email.hi view
binary file changed (absent → 4593 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Email.o view
binary file changed (absent → 113112 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/External.hi view
binary file changed (absent → 26557 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/External.o view
binary file changed (absent → 335560 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Flags.hi view
binary file changed (absent → 14736 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Flags.o view
binary file changed (absent → 276912 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Global.hi view
binary file changed (absent → 14845 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Global.o view
binary file changed (absent → 43856 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/IO.hi view
binary file changed (absent → 31804 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/IO.o view
binary file changed (absent → 94072 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Lock.hi view
binary file changed (absent → 35775 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Lock.o view
binary file changed (absent → 143160 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/MonadProgress.hi view
binary file changed (absent → 5744 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/MonadProgress.o view
binary file changed (absent → 19120 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch.hi view
binary file changed (absent → 8050 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch.o view
binary file changed (absent → 3480 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Apply.hi view
binary file changed (absent → 6356 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Apply.o view
binary file changed (absent → 9600 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/ApplyMonad.hi view
binary file changed (absent → 27053 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/ApplyMonad.o view
binary file changed (absent → 69720 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Bracketed.hi view
binary file changed (absent → 3658 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Bracketed.o view
binary file changed (absent → 6840 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Bracketed/Instances.hi view
binary file changed (absent → 3042 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Bracketed/Instances.o view
binary file changed (absent → 9712 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Bundle.hi view
binary file changed (absent → 13534 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Bundle.o view
binary file changed (absent → 95800 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Commute.hi view
binary file changed (absent → 14209 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Commute.o view
binary file changed (absent → 19976 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Conflict.hi view
binary file changed (absent → 23915 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Conflict.o view
binary file changed (absent → 59040 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/ConflictMarking.hi view
binary file changed (absent → 4596 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/ConflictMarking.o view
binary file changed (absent → 48696 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Depends.hi view
binary file changed (absent → 22547 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Depends.o view
binary file changed (absent → 144560 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Dummy.hi view
binary file changed (absent → 10220 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Dummy.o view
binary file changed (absent → 22640 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Effect.hi view
binary file changed (absent → 7560 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Effect.o view
binary file changed (absent → 9496 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/FileHunk.hi view
binary file changed (absent → 3796 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/FileHunk.o view
binary file changed (absent → 13592 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/FileName.hi view
binary file changed (absent → 10552 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/FileName.o view
binary file changed (absent → 45552 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Format.hi view
binary file changed (absent → 1070 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Format.o view
binary file changed (absent → 3688 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Info.hi view
binary file changed (absent → 31572 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Info.o view
binary file changed (absent → 200360 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Inspect.hi view
binary file changed (absent → 4360 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Inspect.o view
binary file changed (absent → 8496 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Invert.hi view
binary file changed (absent → 1957 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Invert.o view
binary file changed (absent → 3864 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/MatchData.hi view
binary file changed (absent → 3268 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/MatchData.o view
binary file changed (absent → 10536 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Merge.hi view
binary file changed (absent → 7043 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Merge.o view
binary file changed (absent → 10896 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Named.hi view
binary file changed (absent → 47575 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Named.o view
binary file changed (absent → 96048 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/OldDate.hi view
binary file changed (absent → 2262 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/OldDate.o view
binary file changed (absent → 371632 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/PatchInfoAnd.hi view
binary file changed (absent → 49541 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/PatchInfoAnd.o view
binary file changed (absent → 92000 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Patchy.hi view
binary file changed (absent → 4090 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Patchy.o view
binary file changed (absent → 5520 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Patchy/Instances.hi view
binary file changed (absent → 4442 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Patchy/Instances.o view
binary file changed (absent → 3080 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Permutations.hi view
binary file changed (absent → 27677 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Permutations.o view
binary file changed (absent → 58440 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim.hi view
binary file changed (absent → 4363 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim.o view
binary file changed (absent → 1392 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/Class.hi view
binary file changed (absent → 12727 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/Class.o view
binary file changed (absent → 29536 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1.hi view
binary file changed (absent → 5445 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1.o view
binary file changed (absent → 4568 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Apply.hi view
binary file changed (absent → 6733 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Apply.o view
binary file changed (absent → 63728 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Coalesce.hi view
binary file changed (absent → 16218 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Coalesce.o view
binary file changed (absent → 70280 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Commute.hi view
binary file changed (absent → 11129 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Commute.o view
binary file changed (absent → 58464 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Core.hi view
binary file changed (absent → 29498 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Core.o view
binary file changed (absent → 69160 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Details.hi view
binary file changed (absent → 5864 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Details.o view
binary file changed (absent → 7480 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Read.hi view
binary file changed (absent → 5698 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Read.o view
binary file changed (absent → 79496 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Show.hi view
binary file changed (absent → 14889 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Prim/V1/Show.o view
binary file changed (absent → 79656 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Read.hi view
binary file changed (absent → 10900 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Read.o view
binary file changed (absent → 38888 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/ReadMonads.hi view
binary file changed (absent → 28681 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/ReadMonads.o view
binary file changed (absent → 90976 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/RegChars.hi view
binary file changed (absent → 4127 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/RegChars.o view
binary file changed (absent → 18056 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Repair.hi view
binary file changed (absent → 6959 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Repair.o view
binary file changed (absent → 13240 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/RepoPatch.hi view
binary file changed (absent → 4463 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/RepoPatch.o view
binary file changed (absent → 8080 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Set.hi view
binary file changed (absent → 8713 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Set.o view
binary file changed (absent → 9312 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Show.hi view
binary file changed (absent → 12031 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Show.o view
binary file changed (absent → 23840 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Summary.hi view
binary file changed (absent → 14766 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Summary.o view
binary file changed (absent → 88888 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/SummaryData.hi view
binary file changed (absent → 6620 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/SummaryData.o view
binary file changed (absent → 29280 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/TokenReplace.hi view
binary file changed (absent → 2307 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/TokenReplace.o view
binary file changed (absent → 35304 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1.hi view
binary file changed (absent → 5659 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1.o view
binary file changed (absent → 3400 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Apply.hi view
binary file changed (absent → 7120 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Apply.o view
binary file changed (absent → 7368 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Commute.hi view
binary file changed (absent → 26780 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Commute.o view
binary file changed (absent → 168608 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Core.hi view
binary file changed (absent → 6459 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Core.o view
binary file changed (absent → 9480 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Read.hi view
binary file changed (absent → 4824 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Read.o view
binary file changed (absent → 28624 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Show.hi view
binary file changed (absent → 7537 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Show.o view
binary file changed (absent → 18016 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Viewing.hi view
binary file changed (absent → 11083 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V1/Viewing.o view
binary file changed (absent → 19464 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V2.hi view
binary file changed (absent → 4720 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V2.o view
binary file changed (absent → 2280 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V2/Non.hi view
binary file changed (absent → 25526 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V2/Non.o view
binary file changed (absent → 80968 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V2/Real.hi view
binary file changed (absent → 38955 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/V2/Real.o view
binary file changed (absent → 406544 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Viewing.hi view
binary file changed (absent → 22996 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Patch/Viewing.o view
binary file changed (absent → 77912 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/ProgressPatches.hi view
binary file changed (absent → 5107 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/ProgressPatches.o view
binary file changed (absent → 23528 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/RepoPath.hi view
binary file changed (absent → 29428 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/RepoPath.o view
binary file changed (absent → 104016 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository.hi view
binary file changed (absent → 22373 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository.o view
binary file changed (absent → 210248 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/ApplyPatches.hi view
binary file changed (absent → 7655 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/ApplyPatches.o view
binary file changed (absent → 8680 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Cache.hi view
binary file changed (absent → 24525 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Cache.o view
binary file changed (absent → 212056 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Format.hi view
binary file changed (absent → 17310 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Format.o view
binary file changed (absent → 75928 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/HashedIO.hi view
binary file changed (absent → 24501 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/HashedIO.o view
binary file changed (absent → 183448 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/HashedRepo.hi view
binary file changed (absent → 27591 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/HashedRepo.o view
binary file changed (absent → 279384 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Internal.hi view
binary file changed (absent → 61492 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Internal.o view
binary file changed (absent → 381280 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/InternalTypes.hi view
binary file changed (absent → 13523 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/InternalTypes.o view
binary file changed (absent → 34856 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/LowLevel.hi view
binary file changed (absent → 16219 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/LowLevel.o view
binary file changed (absent → 33720 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Merge.hi view
binary file changed (absent → 10497 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Merge.o view
binary file changed (absent → 63464 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Old.hi view
binary file changed (absent → 8781 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Old.o view
binary file changed (absent → 58336 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Prefs.hi view
binary file changed (absent → 24106 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/Prefs.o view
binary file changed (absent → 221472 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/State.hi view
binary file changed (absent → 22513 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Repository/State.o view
binary file changed (absent → 89632 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Resolution.hi view
binary file changed (absent → 11236 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Resolution.o view
binary file changed (absent → 52152 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/SignalHandler.hi view
binary file changed (absent → 11833 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/SignalHandler.o view
binary file changed (absent → 51456 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Email.hi view
binary file changed (absent → 10637 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Email.o view
binary file changed (absent → 35456 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Misc.hi view
binary file changed (absent → 19356 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Misc.o view
binary file changed (absent → 239616 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch.hi view
binary file changed (absent → 7982 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch.o view
binary file changed (absent → 6344 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Check.hi view
binary file changed (absent → 18853 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Check.o view
binary file changed (absent → 116488 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Examples.hi view
binary file changed (absent → 183452 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Examples.o view
binary file changed (absent → 651216 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Examples2.hi view
binary file changed (absent → 43757 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Examples2.o view
binary file changed (absent → 322264 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Info.hi view
binary file changed (absent → 24523 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Info.o view
binary file changed (absent → 124232 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Prim/V1.hi view
binary file changed (absent → 18671 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Prim/V1.o view
binary file changed (absent → 121888 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Properties.hi view
binary file changed (absent → 23975 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Properties.o view
binary file changed (absent → 208640 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Properties2.hi view
binary file changed (absent → 35988 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Properties2.o view
binary file changed (absent → 230344 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/QuickCheck.hi view
binary file changed (absent → 45457 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/QuickCheck.o view
binary file changed (absent → 134824 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/RepoModel.hi view
binary file changed (absent → 30399 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/RepoModel.o view
binary file changed (absent → 101040 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Test.hi view
binary file changed (absent → 41497 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Test.o view
binary file changed (absent → 222040 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Unit.hi view
binary file changed (absent → 152538 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Unit.o view
binary file changed (absent → 465976 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Unit2.hi view
binary file changed (absent → 87886 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Unit2.o view
binary file changed (absent → 260296 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Utils.hi view
binary file changed (absent → 4392 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/Utils.o view
binary file changed (absent → 6760 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/WithState.hi view
binary file changed (absent → 27415 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Patch/WithState.o view
binary file changed (absent → 72400 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Util/QuickCheck.hi view
binary file changed (absent → 6366 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Util/QuickCheck.o view
binary file changed (absent → 13616 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Util/TestResult.hi view
binary file changed (absent → 5007 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Test/Util/TestResult.o view
binary file changed (absent → 11616 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/URL.hi view
binary file changed (absent → 6264 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/URL.o view
binary file changed (absent → 33488 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Utils.hi view
binary file changed (absent → 34989 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Utils.o view
binary file changed (absent → 154824 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Eq.hi view
binary file changed (absent → 5868 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Eq.o view
binary file changed (absent → 13808 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Ordered.hi view
binary file changed (absent → 33091 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Ordered.o view
binary file changed (absent → 94784 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Sealed.hi view
binary file changed (absent → 18086 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Sealed.o view
binary file changed (absent → 36128 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Show.hi view
binary file changed (absent → 4767 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Show.o view
binary file changed (absent → 10800 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Unsafe.hi view
binary file changed (absent → 2775 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Darcs/Witnesses/Unsafe.o view
binary file changed (absent → 3344 bytes)
+ dist/build/darcs-test/darcs-test-tmp/English.hi view
binary file changed (absent → 6950 bytes)
+ dist/build/darcs-test/darcs-test-tmp/English.o view
binary file changed (absent → 26096 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Exec.hi view
binary file changed (absent → 10573 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Exec.o view
binary file changed (absent → 55800 bytes)
+ dist/build/darcs-test/darcs-test-tmp/HTTP.hi view
binary file changed (absent → 14146 bytes)
+ dist/build/darcs-test/darcs-test-tmp/HTTP.o view
binary file changed (absent → 56152 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Lcs.hi view
binary file changed (absent → 3490 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Lcs.o view
binary file changed (absent → 274352 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Main.hi view
binary file changed (absent → 44938 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Main.o view
binary file changed (absent → 213880 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Printer.hi view
binary file changed (absent → 33753 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Printer.o view
binary file changed (absent → 107080 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Progress.hi view
binary file changed (absent → 10683 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Progress.o view
binary file changed (absent → 66584 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Ratified.hi view
binary file changed (absent → 524 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Ratified.o view
binary file changed (absent → 1360 bytes)
+ dist/build/darcs-test/darcs-test-tmp/SHA1.hi view
binary file changed (absent → 2338 bytes)
+ dist/build/darcs-test/darcs-test-tmp/SHA1.o view
binary file changed (absent → 47072 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Ssh.hi view
binary file changed (absent → 15279 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Ssh.o view
binary file changed (absent → 115800 bytes)
+ dist/build/darcs-test/darcs-test-tmp/URL.hi view
binary file changed (absent → 18599 bytes)
+ dist/build/darcs-test/darcs-test-tmp/URL.o view
binary file changed (absent → 140800 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Version.hi view
binary file changed (absent → 663 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Version.o view
binary file changed (absent → 4896 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Workaround.hi view
binary file changed (absent → 2888 bytes)
+ dist/build/darcs-test/darcs-test-tmp/Workaround.o view
binary file changed (absent → 4176 bytes)
+ dist/build/darcs-test/darcs-test-tmp/src/Crypt/sha2.o view
binary file changed (absent → 9600 bytes)
+ dist/build/darcs-test/darcs-test-tmp/src/atomic_create.o view
binary file changed (absent → 4480 bytes)
+ dist/build/darcs-test/darcs-test-tmp/src/fpstring.o view
binary file changed (absent → 2008 bytes)
+ dist/build/darcs-test/darcs-test-tmp/src/maybe_relink.o view
binary file changed (absent → 3616 bytes)
+ dist/build/darcs-test/darcs-test-tmp/src/umask.o view
binary file changed (absent → 1680 bytes)
+ dist/build/darcs/darcs view
file too large to diff
+ dist/build/darcs/darcs-tmp/ByteStringUtils.hi view
binary file changed (absent → 33389 bytes)
+ dist/build/darcs/darcs-tmp/ByteStringUtils.o view
binary file changed (absent → 111672 bytes)
+ dist/build/darcs/darcs-tmp/CommandLine.hi view
binary file changed (absent → 2451 bytes)
+ dist/build/darcs/darcs-tmp/CommandLine.o view
binary file changed (absent → 61136 bytes)
+ dist/build/darcs/darcs-tmp/Crypt/SHA256.hi view
binary file changed (absent → 2988 bytes)
+ dist/build/darcs/darcs-tmp/Crypt/SHA256.o view
binary file changed (absent → 8624 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Annotate.hi view
binary file changed (absent → 18436 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Annotate.o view
binary file changed (absent → 128400 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/ArgumentDefaults.hi view
binary file changed (absent → 8992 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/ArgumentDefaults.o view
binary file changed (absent → 26368 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Arguments.hi view
binary file changed (absent → 160077 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Arguments.o view
binary file changed (absent → 606408 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Bug.hi view
binary file changed (absent → 3122 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Bug.o view
binary file changed (absent → 12128 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/ColorPrinter.hi view
binary file changed (absent → 7554 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/ColorPrinter.o view
binary file changed (absent → 95112 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands.hi view
binary file changed (absent → 20712 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands.o view
binary file changed (absent → 82320 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Add.hi view
binary file changed (absent → 13689 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Add.o view
binary file changed (absent → 159976 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/AmendRecord.hi view
binary file changed (absent → 16141 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/AmendRecord.o view
binary file changed (absent → 108672 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Annotate.hi view
binary file changed (absent → 12584 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Annotate.o view
binary file changed (absent → 73992 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Apply.hi view
binary file changed (absent → 16472 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Apply.o view
binary file changed (absent → 203176 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Changes.hi view
binary file changed (absent → 14379 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Changes.o view
binary file changed (absent → 131848 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Check.hi view
binary file changed (absent → 11547 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Check.o view
binary file changed (absent → 48376 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Convert.hi view
binary file changed (absent → 13698 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Convert.o view
binary file changed (absent → 128408 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Diff.hi view
binary file changed (absent → 13904 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Diff.o view
binary file changed (absent → 60888 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Dist.hi view
binary file changed (absent → 10671 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Dist.o view
binary file changed (absent → 36384 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/GZCRCs.hi view
binary file changed (absent → 15568 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/GZCRCs.o view
binary file changed (absent → 92968 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Get.hi view
binary file changed (absent → 13873 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Get.o view
binary file changed (absent → 106656 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Help.hi view
binary file changed (absent → 16387 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Help.o view
binary file changed (absent → 117072 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Init.hi view
binary file changed (absent → 8645 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Init.o view
binary file changed (absent → 9720 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/MarkConflicts.hi view
binary file changed (absent → 9939 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/MarkConflicts.o view
binary file changed (absent → 33744 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Move.hi view
binary file changed (absent → 11086 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Move.o view
binary file changed (absent → 73328 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Optimize.hi view
binary file changed (absent → 13924 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Optimize.o view
binary file changed (absent → 176880 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Pull.hi view
binary file changed (absent → 17809 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Pull.o view
binary file changed (absent → 131960 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Push.hi view
binary file changed (absent → 14016 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Push.o view
binary file changed (absent → 82744 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Put.hi view
binary file changed (absent → 11839 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Put.o view
binary file changed (absent → 59904 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Record.hi view
binary file changed (absent → 18819 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Record.o view
binary file changed (absent → 245456 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Remove.hi view
binary file changed (absent → 12917 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Remove.o view
binary file changed (absent → 50280 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Replace.hi view
binary file changed (absent → 11557 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Replace.o view
binary file changed (absent → 125152 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Revert.hi view
binary file changed (absent → 11295 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Revert.o view
binary file changed (absent → 47512 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Rollback.hi view
binary file changed (absent → 14035 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Rollback.o view
binary file changed (absent → 117568 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Send.hi view
binary file changed (absent → 17627 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Send.o view
binary file changed (absent → 167896 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/SetPref.hi view
binary file changed (absent → 11815 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/SetPref.o view
binary file changed (absent → 41408 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Show.hi view
binary file changed (absent → 10988 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Show.o view
binary file changed (absent → 18368 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/ShowAuthors.hi view
binary file changed (absent → 10353 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/ShowAuthors.o view
binary file changed (absent → 92744 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/ShowBug.hi view
binary file changed (absent → 8421 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/ShowBug.o view
binary file changed (absent → 10400 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/ShowContents.hi view
binary file changed (absent → 10145 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/ShowContents.o view
binary file changed (absent → 33632 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/ShowFiles.hi view
binary file changed (absent → 13712 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/ShowFiles.o view
binary file changed (absent → 42112 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/ShowIndex.hi view
binary file changed (absent → 10902 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/ShowIndex.o view
binary file changed (absent → 30048 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/ShowRepo.hi view
binary file changed (absent → 9918 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/ShowRepo.o view
binary file changed (absent → 62448 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/ShowTags.hi view
binary file changed (absent → 12661 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/ShowTags.o view
binary file changed (absent → 16888 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Tag.hi view
binary file changed (absent → 11100 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Tag.o view
binary file changed (absent → 28000 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/TrackDown.hi view
binary file changed (absent → 13294 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/TrackDown.o view
binary file changed (absent → 86424 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/TransferMode.hi view
binary file changed (absent → 10638 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/TransferMode.o view
binary file changed (absent → 23072 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Unrecord.hi view
binary file changed (absent → 16876 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Unrecord.o view
binary file changed (absent → 89144 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Unrevert.hi view
binary file changed (absent → 13688 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Unrevert.o view
binary file changed (absent → 46440 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Util.hi view
binary file changed (absent → 8849 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/Util.o view
binary file changed (absent → 27608 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/WhatsNew.hi view
binary file changed (absent → 12975 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Commands/WhatsNew.o view
binary file changed (absent → 53784 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/CommandsAux.hi view
binary file changed (absent → 7280 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/CommandsAux.o view
binary file changed (absent → 19656 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Compat.hi view
binary file changed (absent → 4683 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Compat.o view
binary file changed (absent → 26024 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Diff.hi view
binary file changed (absent → 6346 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Diff.o view
binary file changed (absent → 76936 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Email.hi view
binary file changed (absent → 4593 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Email.o view
binary file changed (absent → 113248 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/External.hi view
binary file changed (absent → 26557 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/External.o view
binary file changed (absent → 335560 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Flags.hi view
binary file changed (absent → 14736 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Flags.o view
binary file changed (absent → 278056 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Global.hi view
binary file changed (absent → 14845 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Global.o view
binary file changed (absent → 43856 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/IO.hi view
binary file changed (absent → 31804 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/IO.o view
binary file changed (absent → 94072 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Lock.hi view
binary file changed (absent → 35775 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Lock.o view
binary file changed (absent → 143160 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Match.hi view
binary file changed (absent → 35913 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Match.o view
binary file changed (absent → 139264 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/MonadProgress.hi view
binary file changed (absent → 5744 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/MonadProgress.o view
binary file changed (absent → 19120 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch.hi view
binary file changed (absent → 8046 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch.o view
binary file changed (absent → 3480 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Apply.hi view
binary file changed (absent → 6115 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Apply.o view
binary file changed (absent → 9600 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/ApplyMonad.hi view
binary file changed (absent → 27053 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/ApplyMonad.o view
binary file changed (absent → 69720 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Bracketed.hi view
binary file changed (absent → 3098 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Bracketed.o view
binary file changed (absent → 6824 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Bracketed/Instances.hi view
binary file changed (absent → 2994 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Bracketed/Instances.o view
binary file changed (absent → 9712 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Bundle.hi view
binary file changed (absent → 12144 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Bundle.o view
binary file changed (absent → 95760 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Choices.hi view
binary file changed (absent → 30814 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Choices.o view
binary file changed (absent → 88480 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Commute.hi view
binary file changed (absent → 7984 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Commute.o view
binary file changed (absent → 16136 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Conflict.hi view
binary file changed (absent → 22066 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Conflict.o view
binary file changed (absent → 57680 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/ConflictMarking.hi view
binary file changed (absent → 4567 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/ConflictMarking.o view
binary file changed (absent → 47880 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Depends.hi view
binary file changed (absent → 19639 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Depends.o view
binary file changed (absent → 132048 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Dummy.hi view
binary file changed (absent → 9172 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Dummy.o view
binary file changed (absent → 22144 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Effect.hi view
binary file changed (absent → 6464 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Effect.o view
binary file changed (absent → 9496 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/FileHunk.hi view
binary file changed (absent → 3686 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/FileHunk.o view
binary file changed (absent → 13592 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/FileName.hi view
binary file changed (absent → 10552 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/FileName.o view
binary file changed (absent → 45704 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Format.hi view
binary file changed (absent → 1042 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Format.o view
binary file changed (absent → 3688 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Info.hi view
binary file changed (absent → 31572 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Info.o view
binary file changed (absent → 200360 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Inspect.hi view
binary file changed (absent → 3785 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Inspect.o view
binary file changed (absent → 8480 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Invert.hi view
binary file changed (absent → 1827 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Invert.o view
binary file changed (absent → 3856 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Match.hi view
binary file changed (absent → 28166 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Match.o view
binary file changed (absent → 142976 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/MatchData.hi view
binary file changed (absent → 3268 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/MatchData.o view
binary file changed (absent → 10536 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Merge.hi view
binary file changed (absent → 3814 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Merge.o view
binary file changed (absent → 9096 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Named.hi view
binary file changed (absent → 40907 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Named.o view
binary file changed (absent → 93960 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/OldDate.hi view
binary file changed (absent → 2262 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/OldDate.o view
binary file changed (absent → 371632 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/PatchInfoAnd.hi view
binary file changed (absent → 43782 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/PatchInfoAnd.o view
binary file changed (absent → 94672 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Patchy.hi view
binary file changed (absent → 4086 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Patchy.o view
binary file changed (absent → 5520 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Patchy/Instances.hi view
binary file changed (absent → 4434 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Patchy/Instances.o view
binary file changed (absent → 3080 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Permutations.hi view
binary file changed (absent → 14733 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Permutations.o view
binary file changed (absent → 52888 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim.hi view
binary file changed (absent → 4363 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim.o view
binary file changed (absent → 1392 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/Class.hi view
binary file changed (absent → 10950 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/Class.o view
binary file changed (absent → 29536 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1.hi view
binary file changed (absent → 5445 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1.o view
binary file changed (absent → 4568 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Apply.hi view
binary file changed (absent → 6639 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Apply.o view
binary file changed (absent → 63760 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Coalesce.hi view
binary file changed (absent → 13344 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Coalesce.o view
binary file changed (absent → 69656 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Commute.hi view
binary file changed (absent → 10886 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Commute.o view
binary file changed (absent → 64000 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Core.hi view
binary file changed (absent → 21957 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Core.o view
binary file changed (absent → 66328 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Details.hi view
binary file changed (absent → 5800 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Details.o view
binary file changed (absent → 7480 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Read.hi view
binary file changed (absent → 5642 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Read.o view
binary file changed (absent → 79496 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Show.hi view
binary file changed (absent → 13705 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Prim/V1/Show.o view
binary file changed (absent → 79656 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Read.hi view
binary file changed (absent → 10133 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Read.o view
binary file changed (absent → 38888 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/ReadMonads.hi view
binary file changed (absent → 28681 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/ReadMonads.o view
binary file changed (absent → 91224 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/RegChars.hi view
binary file changed (absent → 4127 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/RegChars.o view
binary file changed (absent → 18056 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Repair.hi view
binary file changed (absent → 6407 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Repair.o view
binary file changed (absent → 13240 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/RepoPatch.hi view
binary file changed (absent → 4459 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/RepoPatch.o view
binary file changed (absent → 8080 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Set.hi view
binary file changed (absent → 8000 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Set.o view
binary file changed (absent → 10120 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Show.hi view
binary file changed (absent → 11246 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Show.o view
binary file changed (absent → 23840 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Split.hi view
binary file changed (absent → 9461 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Split.o view
binary file changed (absent → 41944 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Summary.hi view
binary file changed (absent → 14231 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Summary.o view
binary file changed (absent → 88888 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/SummaryData.hi view
binary file changed (absent → 6620 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/SummaryData.o view
binary file changed (absent → 29384 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/TokenReplace.hi view
binary file changed (absent → 2307 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/TokenReplace.o view
binary file changed (absent → 35448 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/TouchesFiles.hi view
binary file changed (absent → 11298 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/TouchesFiles.o view
binary file changed (absent → 31376 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V1.hi view
binary file changed (absent → 5651 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V1.o view
binary file changed (absent → 3400 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Apply.hi view
binary file changed (absent → 6727 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Apply.o view
binary file changed (absent → 7368 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Commute.hi view
binary file changed (absent → 22958 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Commute.o view
binary file changed (absent → 146184 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Core.hi view
binary file changed (absent → 5869 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Core.o view
binary file changed (absent → 9480 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Read.hi view
binary file changed (absent → 4796 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Read.o view
binary file changed (absent → 28320 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Show.hi view
binary file changed (absent → 7016 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Show.o view
binary file changed (absent → 17720 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Viewing.hi view
binary file changed (absent → 10197 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V1/Viewing.o view
binary file changed (absent → 18960 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V2.hi view
binary file changed (absent → 4716 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V2.o view
binary file changed (absent → 2280 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V2/Non.hi view
binary file changed (absent → 23098 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V2/Non.o view
binary file changed (absent → 79624 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V2/Real.hi view
binary file changed (absent → 35006 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/V2/Real.o view
binary file changed (absent → 398488 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Viewing.hi view
binary file changed (absent → 20548 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Patch/Viewing.o view
binary file changed (absent → 77168 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/PrintPatch.hi view
binary file changed (absent → 10695 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/PrintPatch.o view
binary file changed (absent → 10840 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/ProgressPatches.hi view
binary file changed (absent → 4981 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/ProgressPatches.o view
binary file changed (absent → 23528 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/RemoteApply.hi view
binary file changed (absent → 3835 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/RemoteApply.o view
binary file changed (absent → 18608 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/RepoPath.hi view
binary file changed (absent → 29428 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/RepoPath.o view
binary file changed (absent → 104320 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository.hi view
binary file changed (absent → 21094 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository.o view
binary file changed (absent → 211808 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/ApplyPatches.hi view
binary file changed (absent → 7482 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/ApplyPatches.o view
binary file changed (absent → 8680 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/Cache.hi view
binary file changed (absent → 24525 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/Cache.o view
binary file changed (absent → 212056 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/Format.hi view
binary file changed (absent → 17310 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/Format.o view
binary file changed (absent → 75928 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/HashedIO.hi view
binary file changed (absent → 24501 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/HashedIO.o view
binary file changed (absent → 183448 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/HashedRepo.hi view
binary file changed (absent → 26041 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/HashedRepo.o view
binary file changed (absent → 262232 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/Internal.hi view
binary file changed (absent → 52145 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/Internal.o view
binary file changed (absent → 383424 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/InternalTypes.hi view
binary file changed (absent → 12702 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/InternalTypes.o view
binary file changed (absent → 34856 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/LowLevel.hi view
binary file changed (absent → 14869 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/LowLevel.o view
binary file changed (absent → 33608 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/Merge.hi view
binary file changed (absent → 8748 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/Merge.o view
binary file changed (absent → 55504 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/Motd.hi view
binary file changed (absent → 6359 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/Motd.o view
binary file changed (absent → 10536 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/Old.hi view
binary file changed (absent → 8703 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/Old.o view
binary file changed (absent → 58336 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/Prefs.hi view
binary file changed (absent → 24106 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/Prefs.o view
binary file changed (absent → 221472 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/Repair.hi view
binary file changed (absent → 11207 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/Repair.o view
binary file changed (absent → 116928 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/State.hi view
binary file changed (absent → 20577 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Repository/State.o view
binary file changed (absent → 88728 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Resolution.hi view
binary file changed (absent → 10587 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Resolution.o view
binary file changed (absent → 52280 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/RunCommand.hi view
binary file changed (absent → 11022 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/RunCommand.o view
binary file changed (absent → 65736 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/SelectChanges.hi view
binary file changed (absent → 20346 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/SelectChanges.o view
binary file changed (absent → 245512 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/SignalHandler.hi view
binary file changed (absent → 11833 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/SignalHandler.o view
binary file changed (absent → 51624 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Test.hi view
binary file changed (absent → 7571 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Test.o view
binary file changed (absent → 25224 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/TheCommands.hi view
binary file changed (absent → 22009 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/TheCommands.o view
binary file changed (absent → 27704 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/URL.hi view
binary file changed (absent → 6264 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/URL.o view
binary file changed (absent → 33488 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Utils.hi view
binary file changed (absent → 34989 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Utils.o view
binary file changed (absent → 155112 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Witnesses/Eq.hi view
binary file changed (absent → 4474 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Witnesses/Eq.o view
binary file changed (absent → 13680 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Witnesses/Ordered.hi view
binary file changed (absent → 24704 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Witnesses/Ordered.o view
binary file changed (absent → 94728 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Witnesses/Sealed.hi view
binary file changed (absent → 14818 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Witnesses/Sealed.o view
binary file changed (absent → 35848 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Witnesses/Show.hi view
binary file changed (absent → 4231 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Witnesses/Show.o view
binary file changed (absent → 10800 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Witnesses/Unsafe.hi view
binary file changed (absent → 973 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Witnesses/Unsafe.o view
binary file changed (absent → 2656 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Witnesses/WZipper.hi view
binary file changed (absent → 5457 bytes)
+ dist/build/darcs/darcs-tmp/Darcs/Witnesses/WZipper.o view
binary file changed (absent → 10168 bytes)
+ dist/build/darcs/darcs-tmp/DateMatcher.hi view
binary file changed (absent → 5199 bytes)
+ dist/build/darcs/darcs-tmp/DateMatcher.o view
binary file changed (absent → 60176 bytes)
+ dist/build/darcs/darcs-tmp/English.hi view
binary file changed (absent → 6950 bytes)
+ dist/build/darcs/darcs-tmp/English.o view
binary file changed (absent → 26096 bytes)
+ dist/build/darcs/darcs-tmp/Exec.hi view
binary file changed (absent → 10573 bytes)
+ dist/build/darcs/darcs-tmp/Exec.o view
binary file changed (absent → 55976 bytes)
+ dist/build/darcs/darcs-tmp/HTTP.hi view
binary file changed (absent → 14146 bytes)
+ dist/build/darcs/darcs-tmp/HTTP.o view
binary file changed (absent → 56312 bytes)
+ dist/build/darcs/darcs-tmp/IsoDate.hi view
binary file changed (absent → 17440 bytes)
+ dist/build/darcs/darcs-tmp/IsoDate.o view
binary file changed (absent → 827360 bytes)
+ dist/build/darcs/darcs-tmp/Lcs.hi view
binary file changed (absent → 3490 bytes)
+ dist/build/darcs/darcs-tmp/Lcs.o view
binary file changed (absent → 274352 bytes)
+ dist/build/darcs/darcs-tmp/Main.hi view
binary file changed (absent → 10953 bytes)
+ dist/build/darcs/darcs-tmp/Main.o view
binary file changed (absent → 31384 bytes)
+ dist/build/darcs/darcs-tmp/Preproc.hi view
binary file changed (absent → 9548 bytes)
+ dist/build/darcs/darcs-tmp/Preproc.o view
binary file changed (absent → 71920 bytes)
+ dist/build/darcs/darcs-tmp/Printer.hi view
binary file changed (absent → 33753 bytes)
+ dist/build/darcs/darcs-tmp/Printer.o view
binary file changed (absent → 107080 bytes)
+ dist/build/darcs/darcs-tmp/Progress.hi view
binary file changed (absent → 10683 bytes)
+ dist/build/darcs/darcs-tmp/Progress.o view
binary file changed (absent → 66848 bytes)
+ dist/build/darcs/darcs-tmp/Ratified.hi view
binary file changed (absent → 499 bytes)
+ dist/build/darcs/darcs-tmp/Ratified.o view
binary file changed (absent → 1360 bytes)
+ dist/build/darcs/darcs-tmp/SHA1.hi view
binary file changed (absent → 2338 bytes)
+ dist/build/darcs/darcs-tmp/SHA1.o view
binary file changed (absent → 47304 bytes)
+ dist/build/darcs/darcs-tmp/Ssh.hi view
binary file changed (absent → 15279 bytes)
+ dist/build/darcs/darcs-tmp/Ssh.o view
binary file changed (absent → 115224 bytes)
+ dist/build/darcs/darcs-tmp/URL.hi view
binary file changed (absent → 18885 bytes)
+ dist/build/darcs/darcs-tmp/URL.o view
binary file changed (absent → 164352 bytes)
+ dist/build/darcs/darcs-tmp/Version.hi view
binary file changed (absent → 663 bytes)
+ dist/build/darcs/darcs-tmp/Version.o view
binary file changed (absent → 4896 bytes)
+ dist/build/darcs/darcs-tmp/Workaround.hi view
binary file changed (absent → 2888 bytes)
+ dist/build/darcs/darcs-tmp/Workaround.o view
binary file changed (absent → 4176 bytes)
+ dist/build/darcs/darcs-tmp/src/Crypt/sha2.o view
binary file changed (absent → 9600 bytes)
+ dist/build/darcs/darcs-tmp/src/atomic_create.o view
binary file changed (absent → 4480 bytes)
+ dist/build/darcs/darcs-tmp/src/fpstring.o view
binary file changed (absent → 2008 bytes)
+ dist/build/darcs/darcs-tmp/src/hscurl.o view
binary file changed (absent → 8088 bytes)
+ dist/build/darcs/darcs-tmp/src/maybe_relink.o view
binary file changed (absent → 3616 bytes)
+ dist/build/darcs/darcs-tmp/src/umask.o view
binary file changed (absent → 1680 bytes)
+ dist/build/darcs/darcs.1 view
@@ -0,0 +1,1213 @@+.TH DARCS 1 "2.7.98.1 (+ 7 patches)"+.SH NAME+darcs \- an advanced revision control system+.SH SYNOPSIS+.B darcs+.I command+.RI < arguments |[ options ]>...++Where the+.I commands+and their respective+.I arguments+are++.B darcs help+.RI "[<" "darcs" "_" "command" "> [" "darcs" "_" "subcommand" "]] "+.br+.B darcs add+.RI "<" "file" "|" "directory" "> ..."+.br+.B darcs remove+.RI "<" "file" "|" "directory" "> ..."+.br+.B darcs move+.RI "<" "source" "> ... <" "destination" ">"+.br+.B darcs replace+.RI "<" "old" ">"+.RI "<" "new" ">"+.RI "<" "file" "> ..."+.br+.B darcs revert+.RI "[" "file" "|" "directory" "]..."+.br+.B darcs unrevert+.br+.B darcs whatsnew+.RI "[" "file" "|" "directory" "]..."+.br+.B darcs record+.RI "[" "file" "|" "directory" "]..."+.br+.B darcs unrecord+.br+.B darcs amend-record+.RI "[" "file" "|" "directory" "]..."+.br+.B darcs mark-conflicts+.br+.B darcs tag+.RI "[" "tagname" "]"+.br+.B darcs setpref+.RI "<" "pref" ">"+.RI "<" "value" ">"+.br+.B darcs diff+.RI "[" "file" "|" "directory" "]..."+.br+.B darcs changes+.RI "[" "file" "|" "directory" "]..."+.br+.B darcs annotate+.RI "[" "file" "|" "directory" "]..."+.br+.B darcs dist+.br+.B darcs trackdown+.RI "[[" "initialization" "]"+.RI "command" "]"+.br+.B darcs show contents+.RI "[" "file" "]..."+.br+.B darcs show files+.RI "[" "file" "|" "directory" "]..."+.br+.B darcs show index+.br+.B darcs show pristine+.br+.B darcs show repo+.br+.B darcs show authors+.br+.B darcs show tags+.br+.B darcs pull+.RI "[" "repository" "]..."+.br+.B darcs fetch+.RI "[" "repository" "]..."+.br+.B darcs obliterate+.br+.B darcs rollback+.RI "[" "file" "|" "directory" "]..."+.br+.B darcs push+.RI "[" "repository" "]"+.br+.B darcs send+.RI "[" "repository" "]"+.br+.B darcs apply+.RI "<" "patchfile" ">"+.br+.B darcs get+.RI "<" "repository" ">"+.RI "[<" "directory" ">]"+.br+.B darcs put+.RI "<" "new" " " "repository" ">"+.br+.B darcs initialize+.br+.B darcs optimize+.br+.B darcs check+.br+.B darcs repair+.br+.B darcs convert+.RI "<" "source" ">"+.RI "[<" "destination" ">]"+.br++.SH DESCRIPTION+Darcs is a free, open source revision control+system. It is:+.TP 3+\(bu+Distributed: Every user has access to the full+command set, removing boundaries between server and+client or committer and non\(hycommitters.+.TP+\(bu+Interactive: Darcs is easy to learn and efficient to+use because it asks you questions in response to+simple commands, giving you choices in your work+flow. You can choose to record one change in a file,+while ignoring another. As you update from upstream,+you can review each patch name, even the full `diff'+for interesting patches.+.TP+\(bu+Smart: Originally developed by physicist David+Roundy, darcs is based on a unique algebra of+patches.+This smartness lets you respond to changing demands+in ways that would otherwise not be possible. Learn+more about spontaneous branches with darcs.+.SH OPTIONS+Different options are accepted by different Darcs commands.+Each command's most important options are listed in the+.B COMMANDS+section. For a full list of all options accepted by+a particular command, run `darcs+.I command+\-\-help'.+.SS Selecting Patches:++The \-\-patches option yields patches with names matching an `extended'+regular expression. See regex(7) for details. The \-\-matches option+yields patches that match a logical (Boolean) expression: one or more+primitive expressions combined by grouping (parentheses) and the+complement (not), conjunction (and) and disjunction (or) operators.+The C notation for logic operators (!, && and ||) can also be used.++ \-\-patches=regex is a synonym for \-\-matches='name regex'+ \-\-from\-patch and \-\-to\-patch are synonyms for \-\-from\-match='name... and \-\-to\-match='name...+ \-\-from\-patch and \-\-to\-match can be unproblematically combined:+ darcs changes \-\-from\-patch='html.*documentation' \-\-to\-match='date 20040212'++The following primitive Boolean expressions are supported:+ exact \- check a literal string against the patch name.+ name \- check a regular expression against the patch name.+ author \- check a regular expression against the author name.+ hunk \- check a regular expression against the contents of a hunk patch.+ comment \- check a regular expression against the log message.+ hash \- match the darcs hash for a patch.+ date \- match the patch date.+ touch \- match file paths for a patch.++Here are some examples:+ darcs annotate \-\-summary \-\-match 'exact "Resolve issue17: use dynamic memory allocation."'+ darcs annotate \-\-summary \-\-match 'name issue17'+ darcs annotate \-\-summary \-\-match 'name "^[Rr]esolve issue17\\>"'+ darcs annotate \-\-summary \-\-match 'author "David Roundy"'+ darcs annotate \-\-summary \-\-match 'author droundy'+ darcs annotate \-\-summary \-\-match 'author droundy@darcs.net'+ darcs annotate \-\-summary \-\-match 'hunk "foo = 2"'+ darcs annotate \-\-summary \-\-match 'hunk "^instance .* Foo where$"'+ darcs annotate \-\-summary \-\-match 'comment "prevent deadlocks"'+ darcs annotate \-\-summary \-\-match 'hash 20040403105958\-53a90\-c719567e92c3b0ab9eddd5290b705712b8b918ef'+ darcs annotate \-\-summary \-\-match 'date "2006\-04\-02 22:41"'+ darcs annotate \-\-summary \-\-match 'date "tea time yesterday"'+ darcs annotate \-\-summary \-\-match 'touch src/foo.c'+ darcs annotate \-\-summary \-\-match 'touch src/'+ darcs annotate \-\-summary \-\-match 'touch "src/*.(c|h)"'++.SH COMMANDS+.B darcs help+.RI "[<" "darcs" "_" "command" "> [" "darcs" "_" "subcommand" "]] "+.RS 4+Without arguments, `darcs help' prints a categorized list of darcs+commands and a short description of each one. With an extra argument,+`darcs help foo' prints detailed help about the darcs command foo.++.RE+.SS "Changing and querying the working copy:"+.B darcs add+.RI "<" "file" "|" "directory" "> ..."+.RS 4+Generally a repository contains both files that should be version+controlled (such as source code) and files that Darcs should ignore+(such as executables compiled from the source code). The `darcs add'+command is used to tell Darcs which files to version control.++When an existing project is first imported into a Darcs repository, it+is common to run `darcs add \-r *' or `darcs record \-l' to add all+initial source files into darcs.++Adding symbolic links (symlinks) is not supported.++Darcs will ignore all files and folders that look `boring'. The+\-\-boring option overrides this behaviour.++Darcs will not add file if another file in the same folder has the+same name, except for case. The \-\-case\-ok option overrides this+behaviour. Windows and OS X usually use filesystems that do not allow+files a folder to have the same name except for case (for example,+`ReadMe' and `README'). If \-\-case\-ok is used, the repository might be+unusable on those systems!+++.RE+.B darcs remove+.RI "<" "file" "|" "directory" "> ..."+.RS 4+The `darcs remove' command exists primarily for symmetry with `darcs+add', as the normal way to remove a file from version control is+simply to delete it from the working tree. This command is only+useful in the unusual case where one wants to record a removal patch+WITHOUT deleting the copy in the working tree (which can be re\-added).++Note that applying a removal patch to a repository (e.g. by pulling+the patch) will ALWAYS affect the working tree of that repository.++.RE+.B darcs move+.RI "<" "source" "> ... <" "destination" ">"+.RS 4+Darcs cannot reliably distinguish between a file being deleted and a+new one added, and a file being moved. Therefore Darcs always assumes+the former, and provides the `darcs mv' command to let Darcs know when+you want the latter. This command will also move the file in the+working tree (unlike `darcs remove'), unless it has already been moved.++Darcs will not rename a file if another file in the same folder has+the same name, except for case. The \-\-case\-ok option overrides this+behaviour. Windows and OS X usually use filesystems that do not allow+files a folder to have the same name except for case (for example,+`ReadMe' and `README'). If \-\-case\-ok is used, the repository might be+unusable on those systems!++.RE+.B darcs replace+.RI "<" "old" ">"+.RI "<" "new" ">"+.RI "<" "file" "> ..."+.RS 4+In addition to line\-based patches, Darcs supports a limited form of+lexical substitution. Files are treated as sequences of words, and+each occurrence of the old word is replaced by the new word.+This is intended to provide a clean way to rename a function or+variable. Such renamings typically affect lines all through the+source code, so a traditional line\-based patch would be very likely to+conflict with other branches, requiring manual merging.++Files are tokenized according to one simple rule: words are strings of+valid token characters, and everything between them (punctuation and+whitespace) is discarded. By default, valid token characters are+letters, numbers and the underscore (i.e. [A\-Za\-z0\-9_]). However if+the old and/or new token contains either a hyphen or period, BOTH+hyphen and period are treated as valid (i.e. [A\-Za\-z0\-9_.\-]).++The set of valid characters can be customized using the \-\-token\-chars+option. The argument must be surrounded by square brackets. If a+hyphen occurs between two characters in the set, it is treated as a+set range. For example, in most locales [A\-Z] denotes all uppercase+letters. If the first character is a caret, valid tokens are taken to+be the complement of the remaining characters. For example, [^:\\n]+could be used to match fields in the passwd(5), where records and+fields are separated by newlines and colons respectively.++If you choose to use \-\-token\-chars, you are STRONGLY encouraged to do+so consistently. The consequences of using multiple replace patches+with different \-\-token\-chars arguments on the same file are not well+tested nor well understood.++By default Darcs will refuse to perform a replacement if the new token+is already in use, because the replacements would be not be+distinguishable from the existing tokens. This behaviour can be+overridden by supplying the \-\-force option, but an attempt to `darcs+rollback' the resulting patch will affect these existing tokens.++Limitations:++The tokenizer treats files as byte strings, so it is not possible for+\-\-token\-chars to include multi\-byte characters, such as the non\-ASCII+parts of UTF\-8. Similarly, trying to replace a `high\-bit' character+from a unibyte encoding will also result in replacement of the same+byte in files with different encodings. For example, an acute a from+ISO 8859\-1 will also match an alpha from ISO 8859\-7.++Due to limitations in the patch file format, \-\-token\-chars arguments+cannot contain literal whitespace. For example, [^ \\n\\t] cannot be+used to declare all characters except the space, tab and newline as+valid within a word, because it contains a literal space.++Unlike POSIX regex(7) bracket expressions, character classes (such as+[[:alnum:]]) are NOT supported by \-\-token\-chars, and will be silently+treated as a simple set of characters.++.RE+.B darcs revert+.RI "[" "file" "|" "directory" "]..."+.RS 4+The `darcs revert' command discards unrecorded changes the working+tree. As with `darcs record', you will be asked which hunks (changes)+to revert. The \-\-all switch can be used to avoid such prompting. If+files or directories are specified, other parts of the working tree+are not reverted.++In you accidentally reverted something you wanted to keep (for+example, typing `darcs rev \-a' instead of `darcs rec \-a'), you can+immediately run `darcs unrevert' to restore it. This is only+guaranteed to work if the repository has not changed since `darcs+revert' ran.++.RE+.B darcs unrevert+.RS 4+Unrevert is a rescue command in case you accidentally reverted+something you wanted to keep (for example, typing `darcs rev \-a'+instead of `darcs rec \-a').++This command may fail if the repository has changed since the revert+took place. Darcs will ask for confirmation before executing an+interactive command that will DEFINITELY prevent unreversion.++.RE+.B darcs whatsnew+.RI "[" "file" "|" "directory" "]..."+.RS 4+The `darcs whatsnew' command lists unrecorded changes to the working+tree. If you specify a set of files and directories, only unrecorded+changes to those files and directories are listed.++With the \-\-summary option, the changes are condensed to one line per+file, with mnemonics to indicate the nature and extent of the change.+The \-\-look\-for\-adds option causes candidates for `darcs add' to be+included in the summary output. Summary mnemonics are as follows:++ `A f' and `A d/' respectively mean an added file or directory.+ `R f' and `R d/' respectively mean a removed file or directory.+ `M f \-N +M rP' means a modified file, with N lines deleted, M+ lines added, and P lexical replacements.+ `f \-> g' means a moved file or directory.++ An exclamation mark (!) as in `R! foo.c', means the hunk is known to+ conflict with a hunk in another patch. The phrase `duplicated'+ means the hunk is known to be identical to a hunk in another patch.++By default, `darcs whatsnew' uses Darcs' internal format for changes.+To see some context (unchanged lines) around each change, use the+\-\-unified option. To view changes in conventional `diff' format, use+the `darcs diff' command; but note that `darcs whatsnew' is faster.++This command exits unsuccessfully (returns a non\-zero exit status) if+there are no unrecorded changes.++.RE+.SS "Copying changes between the working copy and the repository:"+.B darcs record+.RI "[" "file" "|" "directory" "]..."+.RS 4+The `darcs record' command is used to create a patch from changes in+the working tree. If you specify a set of files and directories,+changes to other files will be skipped.++Every patch has a name, an optional description, an author and a date.++The patch name should be a short sentence that concisely describes the+patch, such as `Add error handling to main event loop.' You can+supply it in advance with the \-m option, or provide it when prompted.++The patch description is an optional block of free\-form text. It is+used to supply additional information that doesn't fit in the patch+name. For example, it might include a rationale of WHY the change was+necessary. By default Darcs asks if you want to add a description;+the \-\-edit\-long\-comment and \-\-skip\-long\-comment can be used to answer+`yes' or `no' (respectively) to this prompt. Finally, the \-\-logfile+option allows you to supply a file that already contains the patch+name (first line) and patch description (subsequent lines). This is+useful if a previous record failed and left a darcs\-record\-0 file.++Each patch is attributed to its author, usually by email address (for+example, `Fred Bloggs <fred@example.net>'). Darcs looks in several+places for this author string: the \-\-author option, the files+_darcs/prefs/author (in the repository) and ~/.darcs/author (in your+home directory), and the environment variables $DARCS_EMAIL and+$EMAIL. If none of those exist, Darcs will prompt you for an author+string and write it to _darcs/prefs/author. Note that if if you have more+than one email address, note that you can put them all in ~/.darcs/author,+one author per line. Darcs will still prompt you for an author, but it+allow you to select from the list or type in an alternative.++The patch date is generated automatically. It can only be spoofed by+using the \-\-pipe option.++If a test command has been defined with `darcs setpref', attempting to+record a patch will cause the test command to be run in a clean copy+of the working tree (that is, including only recorded changes). If+the test fails, you will be offered to abort the record operation.++The \-\-set\-scripts\-executable option causes scripts to be made+executable in the clean copy of the working tree, prior to running the+test. See `darcs get' for an explanation of the script heuristic.++If your test command is tediously slow (e.g. `make all') and you are+recording several patches in a row, you may wish to use \-\-no\-test to+skip all but the final test.++.RE+.B darcs unrecord+.RS 4+Unrecord does the opposite of record in that it makes the changes from+patches active changes again which you may record or revert later. The+working copy itself will not change.+Beware that you should not use this command if you are going to+re\-record the changes in any way and there is a possibility that+another user may have already pulled the patch.++.RE+.B darcs amend-record+.RI "[" "file" "|" "directory" "]..."+.RS 4+Amend\-record updates a `draft' patch with additions or improvements,+resulting in a single `finished' patch. This is better than recording+the additions and improvements as separate patches, because then+whenever the `draft' patch is copied between repositories, you would+need to make sure all the extra patches are copied, too.++Do not copy draft patches between repositories, because a finished+patch cannot be copied into a repository that contains a draft of the+same patch. If this has already happened, `darcs obliterate' can be+used to remove the draft patch.++Do not run amend\-record in repository that other developers can pull+from, because if they pull while an amend\-record is in progress, their+repository may be corrupted.++When recording a draft patch, it is a good idea to start the name with+`DRAFT:' so that other developers know it is not finished. When+finished, remove it with `darcs amend\-record \-\-edit\-long\-comment'.+To change the patch name without starting an editor, use \-\-patch\-name.++Like `darcs record', if you call amend\-record with files as arguments,+you will only be asked about changes to those files. So to amend a+patch to foo.c with improvements in bar.c, you would run:++ darcs amend\-record \-\-match 'touch foo.c' bar.c++It is usually a bad idea to amend another developer's patch. To make+amend\-record only ask about your own patches by default, you can add+something like `amend\-record match David Roundy' to ~/.darcs/defaults, +where `David Roundy' is your name.++.RE+.B darcs mark-conflicts+.RS 4+Darcs requires human guidance to unify changes to the same part of a+source file. When a conflict first occurs, darcs will add the+initial state and both choices to the working tree, delimited by the+markers `v v v', `=====', `* * *' and `^ ^ ^', as follows:++v v v v v v v+Initial state.+=============+First choice.+*************+Second choice.+^ ^ ^ ^ ^ ^ ^++However, you might revert or manually delete these markers without+actually resolving the conflict. In this case, `darcs mark\-conflicts'+is useful to show where any unresolved conflicts. It is also useful+if `darcs apply' is called with \-\-apply\-conflicts, where conflicts+aren't marked initially.++Any unrecorded changes to the working tree WILL be lost forever when+you run this command! You will be prompted for confirmation before+this takes place.++.RE+.SS "Direct modification of the repository:"+.B darcs tag+.RI "[" "tagname" "]"+.RS 4+The `darcs tag' command names the current repository state, so that it+can easily be referred to later. Every `important' state should be+tagged; in particular it is good practice to tag each stable release+with a number or codename. Advice on release numbering can be found+at http://producingoss.com/en/development\-cycle.html.++To reproduce the state of a repository `R' as at tag `t', use the+command `darcs get \-\-tag t R'. The command `darcs show tags' lists+all tags in the current repository.++Tagging also provides significant performance benefits: when Darcs+reaches a shared tag that depends on all antecedent patches, it can+simply stop processing.++Like normal patches, a tag has a name, an author, a timestamp and an+optional long description, but it does not change the working tree.+A tag can have any name, but it is generally best to pick a naming+scheme and stick to it.++The `darcs tag' command accepts the \-\-pipe option, which behaves as+described in `darcs record'.++.RE+.B darcs setpref+.RI "<" "pref" ">"+.RI "<" "value" ">"+.RS 4+When working on project with multiple repositories and contributors,+it is sometimes desirable for a preference to be set consistently+project\-wide. This is achieved by treating a preference set with+`darcs setpref' as an unrecorded change, which can then be recorded+and then treated like any other patch.++Valid preferences are:++ test \-\- a shell command that runs regression tests+ predist \-\- a shell command to run before `darcs dist'+ boringfile \-\- the path to a version\-controlled boring file+ binariesfile \-\- the path to a version\-controlled binaries file++For example, a project using GNU autotools, with a `make test' target+to perform regression tests, might enable Darcs' integrated regression+testing with the following command:++ darcs setpref test 'autoconf && ./configure && make && make test'++Note that merging is not currently implemented for preferences: if two+patches attempt to set the same preference, the last patch applied to+the repository will always take precedence. This is considered a+low\-priority bug, because preferences are seldom set.++.RE+.SS "Querying the repository:"+.B darcs diff+.RI "[" "file" "|" "directory" "]..."+.RS 4+The `darcs diff' command compares two versions of the working tree of+the current repository. Without options, the pristine (recorded) and+unrecorded working trees are compared. This is lower\-level than+the `darcs whatsnew' command, since it outputs a line\-by\-line diff,+and it is also slower. As with `darcs whatsnew', if you specify+files or directories, changes to other files are not listed.++With the \-\-patch option, the comparison will be made between working+trees with and without that patch. Patches `after' the selected patch+are not present in either of the compared working trees. The+\-\-from\-patch and \-\-to\-patch options allow the set of patches in the+`old' and `new' working trees to be specified separately.++The associated tag and match options are also understood, e.g. `darcs+diff \-\-from\-tag 1.0 \-\-to\-tag 1.1'. All these options assume an+ordering of the patch set, so results may be affected by operations+such as `darcs optimize \-\-reorder'.++diff(1) is called with the arguments \-rN. The \-\-unified option causes+\-u to be passed to diff(1). An additional argument can be passed+using \-\-diff\-opts, such as \-\-diff\-opts=\-ud or \-\-diff\-opts=\-wU9.++The \-\-diff\-command option can be used to specify an alternative+utility, such as meld (GNOME) or opendiff (OS X). Arguments may be+included, separated by whitespace. The value is not interpreted by a+shell, so shell constructs cannot be used. The arguments %1 and %2+MUST be included, these are substituted for the two working trees+being compared. If this option is used, \-\-diff\-opts is ignored.++.RE+.B darcs changes+.RI "[" "file" "|" "directory" "]..."+.RS 4+The `darcs changes' command lists the patches that constitute the+current repository or, with \-\-repo, a remote repository. Without+options or arguments, ALL patches will be listed.++When given one or more files or directories as arguments, only+patches which affect those files or directories are listed. This+includes changes that happened to files before they were moved or+renamed.++When given a \-\-from\-tag, \-\-from\-patch or \-\-from\-match, only changes+since that tag or patch are listed. Similarly, the \-\-to\-tag,+\-\-to\-patch and \-\-to\-match options restrict the list to older patches.++The \-\-last and \-\-max\-count options both limit the number of patches+listed. The former applies BEFORE other filters, whereas the latter+applies AFTER other filters. For example `darcs changes foo.c+\-\-max\-count 3' will print the last three patches that affect foo.c,+whereas `darcs changes \-\-last 3 foo.c' will, of the last three+patches, print only those that affect foo.c.++Three output formats exist. The default is \-\-human\-readable. You can+also select \-\-context, which is the internal format (as seen in patch+bundles) that can be re\-read by Darcs (e.g. `darcs get \-\-context').++Finally, there is \-\-xml\-output, which emits valid XML... unless a the+patch metadata (author, name or description) contains a non\-ASCII+character and was recorded in a non\-UTF8 locale.++Note that while the \-\-context flag may be used in conjunction with+\-\-xml\-output or \-\-human\-readable, in neither case will darcs get be+able to read the output. On the other hand, sufficient information+WILL be output for a knowledgeable human to recreate the current state+of the repository.++.RE+.B darcs annotate+.RI "[" "file" "|" "directory" "]..."+.RS 4+The `darcs annotate' command provides two unrelated operations. When+called on a file, it will find the patch that last modified each line+in that file. When called on a patch (e.g. using \-\-patch), it will+print the internal representation of that patch.++The \-\-summary option will result in a summarized patch annotation,+similar to `darcs whatsnew'. It has no effect on file annotations.++By default, output is in a human\-readable format. The \-\-xml\-output+option can be used to generate output for machine postprocessing.++.RE+.B darcs dist+.RS 4+The `darcs dist' command creates a compressed archive (a `tarball') in+the repository's root directory, containing the recorded state of the+working tree (unrecorded changes and the _darcs directory are+excluded).++If a predist command is set (see `darcs setpref'), that command will+be run on the tarball contents prior to archiving. For example,+autotools projects would set it to `autoconf && automake'.++By default, the tarball (and the top\-level directory within the+tarball) has the same name as the repository, but this can be+overridden with the \-\-dist\-name option.++.RE+.B darcs trackdown+.RI "[[" "initialization" "]"+.RI "command" "]"+.RS 4+Trackdown tries to find the most recent version in the repository which+passes a test. Given no arguments, it uses the default repository test.+Given one argument, it treats it as a test command. Given two arguments,+the first is an initialization command with is run only once, and the+second is the test command.++Without the \-\-bisect option, trackdown does linear search starting from head,+and moving away from head. With the \-\-bisect option, it does binary search.++Under the assumption that failure is monotonous, trackdown produces+the same result with and without \-\-bisect. (Monotonous means that when+moving away from head, the test result changes only once from "fail" to "ok".)+If failure is not monotonous, any one of the patches that break the test is+found at random.+.RE+.B darcs show contents+.RI "[" "file" "]..."+.RS 4+Show contents can be used to display an earlier version of some file(s).+If you give show contents no version arguments, it displays the recorded+version of the file(s).++.RE+.B darcs show files+.RI "[" "file" "|" "directory" "]..."+.RS 4+The `darcs show files' command lists those files and directories in+the working tree that are under version control. This command is+primarily for scripting purposes; end users will probably want `darcs+whatsnew \-\-summary'.++A file is `pending' if it has been added but not recorded. By+default, pending files (and directories) are listed; the \-\-no\-pending+option prevents this.++By default `darcs show files' lists both files and directories, but+the alias `darcs show manifest' only lists files. The \-\-files,+\-\-directories, \-\-no\-files and \-\-no\-directories modify this behaviour.++By default entries are one\-per\-line (i.e. newline separated). This+can cause problems if the files themselves contain newlines or other+control characters. To get aroudn this, the \-\-null option uses the+null character instead. The script interpreting output from this+command needs to understand this idiom; `xargs \-0' is such a command.++For example, to list version\-controlled files by size:++ darcs show files \-0 | xargs \-0 ls \-ldS++.RE+.B darcs show index+.RS 4+The `darcs show index' command lists all version\-controlled files and directories along with their hashes as stored in _darcs/index. For files, the fields correspond to file size, sha256 of the current file content and the filename.+.RE+.B darcs show pristine+.RS 4+The `darcs show pristine' command lists all version\-controlled files and directories along with the hashes of their pristine copies. For files, the fields correspond to file size, sha256 of the pristine file content and the filename.+.RE+.B darcs show repo+.RS 4+The `darcs show repo' command displays statistics about the current+repository, allowing third\-party scripts to access this information+without inspecting _darcs directly (and without breaking when the+_darcs format changes).++By default, the number of patches is shown. If this data isn't+needed, use \-\-no\-files to accelerate this command from O(n) to O(1).++By default, output is in a human\-readable format. The \-\-xml\-output+option can be used to generate output for machine postprocessing.++.RE+.B darcs show authors+.RS 4+The `darcs show authors' command lists the authors of the current+repository, sorted by the number of patches contributed. With the+\-\-verbose option, this command simply lists the author of each patch+(without aggregation or sorting).++An author's name or email address may change over time. To tell Darcs+when multiple author strings refer to the same individual, create an+`.authorspellings' file in the root of the working tree. Each line in+this file begins with an author's canonical name and address, and may+be followed by a comma separated list of extended regular expressions.+Blank lines and lines beginning with two hyphens are ignored.+The format of .authorspelling can be described by this pattern:++ name <address> [, regexp ]*++There are some pitfalls concerning special characters:+Whitespaces are stripped, if you need space in regexp use [ ]. +Because comma serves as a separator you have to escape it if you want+it in regexp. Note that .authorspelingfile use extended regular+expressions so +, ? and so on are metacharacters and you need to +escape them to be interpreted literally.++Any patch with an author string that matches the canonical address or+any of the associated regexps is considered to be the work of that+author. All matching is case\-insensitive and partial (it can match a+substring). Use ^,$ to match the whole string in regexps++Currently this canonicalization step is done only in `darcs show+authors'. Other commands, such as `darcs changes' use author strings+verbatim.++An example .authorspelling file is:++ \-\- This is a comment.+ Fred Nurk <fred@example.com>+ John Snagge <snagge@bbc.co.uk>, John, snagge@, js@(si|mit).edu+ Chuck Jones\\, Jr. <chuck@pobox.com>, cj\\+user@example.com++.RE+.B darcs show tags+.RS 4+The tags command writes a list of all tags in the repository to standard+output.++Tab characters (ASCII character 9) in tag names are changed to spaces+for better interoperability with shell tools. A warning is printed if+this happens.+.RE+.SS "Copying patches between repositories with working copy update:"+.B darcs pull+.RI "[" "repository" "]..."+.RS 4+Pull is used to bring changes made in another repository into the current+repository (that is, either the one in the current directory, or the one+specified with the \-\-repodir option). Pull allows you to bring over all or+some of the patches that are in that repository but not in this one. Pull+accepts arguments, which are URLs from which to pull, and when called+without an argument, pull will use the repository from which you have most+recently either pushed or pulled.++.RE+.B darcs fetch+.RI "[" "repository" "]..."+.RS 4+fetch is used to bring changes made in another repository+into the current repository without actually applying+them. Fetch allows you to bring over all or+some of the patches that are in that repository but not in this one. Fetch+accepts arguments, which are URLs from which to fetch, and when called+without an argument, fetch will use the repository from which you have most+recently either pushed or pulled.+The fetched patches are stored into a patch bundle, to be later+applied using "darcs apply".+.RE+.B darcs obliterate+.RS 4+Obliterate completely removes recorded patches from your local repository.+The changes will be undone in your working copy and the patches will not be+shown in your changes list anymore.+Beware that you can lose precious code by obliterating!++.RE+.B darcs rollback+.RI "[" "file" "|" "directory" "]..."+.RS 4+Rollback is used to undo the effects of one or more patches without actually+deleting them. Instead, it creates a new patch reversing selected portions.+of those changes. Unlike obliterate and unrecord (which accomplish a similar+goal) rollback is perfectly safe, since it leaves in the repository a record+of its changes.++.RE+.B darcs push+.RI "[" "repository" "]"+.RS 4+Push is the opposite of pull. Push allows you to copy changes from the+current repository into another repository.++.RE+.B darcs send+.RI "[" "repository" "]"+.RS 4+Send is used to prepare a bundle of patches that can be applied to a target+repository. Send accepts the URL of the repository as an argument. When+called without an argument, send will use the most recent repository that+was either pushed to, pulled from or sent to. By default, the patch bundle+is sent by email, although you may save it to a file.++.RE+.B darcs apply+.RI "<" "patchfile" ">"+.RS 4+The `darcs apply' command takes a patch bundle and attempts to insert+it into the current repository. In addition to invoking it directly+on bundles created by `darcs send', it is used internally by `darcs+push' and `darcs put' on the remote end of an SSH connection.++If no file is supplied, the bundle is read from standard input.++If given an email instead of a patch bundle, Darcs will look for the+bundle as a MIME attachment to that email. Currently this will fail+if the MIME boundary is rewritten, such as in Courier and Mail.app.++If the `\-\-reply noreply@example.net' option is used, and the bundle is+attached to an email, Darcs will send a report (indicating success or+failure) to the sender of the bundle (the To field). The argument to+noreply is the address the report will appear to originate FROM.++The \-\-cc option will cause the report to be CC'd to another address,+for example `\-\-cc reports@lists.example.net,admin@lists.example.net'.+Using \-\-cc without \-\-reply is undefined.++If gpg(1) is installed, you can use `\-\-verify pubring.gpg' to reject+bundles that aren't signed by a key in pubring.gpg.++If \-\-test is supplied and a test is defined (see `darcs setpref'), the+bundle will be rejected if the test fails after applying it. In that+case, the rejection email from \-\-reply will include the test output.++A patch bundle may introduce unresolved conflicts with existing+patches or with the working tree. By default, Darcs will add conflict+markers (see `darcs mark\-conflicts').++The \-\-allow\-conflicts option will skip conflict marking; this is+useful when you want to treat a repository as just a bunch of patches,+such as using `darcs pull \-\-union' to download of your co\-workers+patches before going offline.++This can mess up unrecorded changes in the working tree, forcing you+to resolve the conflict immediately. To simply reject bundles that+introduce unresolved conflicts, using the \-\-dont\-allow\-conflicts+option. Making this the default in push\-based workflows is strongly+recommended.++Unlike most Darcs commands, `darcs apply' defaults to \-\-all. Use the+\-\-interactive option to pick which patches to apply from a bundle.++.RE+.B darcs get+.RI "<" "repository" ">"+.RI "[<" "directory" ">]"+.RS 4+Get creates a local copy of a repository. The optional second+argument specifies a destination directory for the new copy; if+omitted, it is inferred from the source location.++By default Darcs will copy every patch from the original repository.+This means the copy is completely independent of the original; you can+operate on the new repository even when the original is inaccessible.+If you expect the original repository to remain accessible, you can+use \-\-lazy to avoid copying patches until they are needed (`copy on+demand'). This is particularly useful when copying a remote+repository with a long history that you don't care about.++The \-\-lazy option isn't as useful for local copies, because Darcs will+automatically use `hard linking' where possible. As well as saving+time and space, you can move or delete the original repository without+affecting a complete, hard\-linked copy. Hard linking requires that+the copy be on the same filesystem and the original repository, and+that the filesystem support hard linking. This includes NTFS, HFS++and all general\-purpose Unix filesystems (such as ext3, UFS and ZFS).+FAT does not support hard links.++Darcs get will not copy unrecorded changes to the source repository's+working tree.++It is often desirable to make a copy of a repository that excludes+some patches. For example, if releases are tagged then `darcs get+\-\-tag .' would make a copy of the repository as at the latest release.++An untagged repository state can still be identified unambiguously by+a context file, as generated by `darcs changes \-\-context'. Given the+name of such a file, the \-\-context option will create a repository+that includes only the patches from that context. When a user reports+a bug in an unreleased version of your project, the recommended way to+find out exactly what version they were running is to have them+include a context file in the bug report.++You can also make a copy of an untagged state using the \-\-to\-patch or+\-\-to\-match options, which exclude patches `after' the first matching+patch. Because these options treat the set of patches as an ordered+sequence, you may get different results after reordering with `darcs+optimize', so tagging is preferred.++.RE+.B darcs put+.RI "<" "new" " " "repository" ">"+.RS 4+The `darcs put' command creates a copy of the current repository. It+is currently very inefficient, so when creating local copies you+should use `darcs get . x' instead of `darcs put x'.++Currently this command just uses `darcs init' to create the target+repository, then `darcs push \-\-all' to copy patches to it. Options+passed to `darcs put' are passed to the init and/or push commands as+appropriate. See those commands for an explanation of each option.++.RE+.SS "Administrating repositories:"+.B darcs initialize+.RS 4+The `darcs initialize' command turns the current directory into a+Darcs repository. Any existing files and subdirectories become+UNSAVED changes: record them with `darcs record \-\-look\-for\-adds'.++This command creates the `_darcs' directory, which stores version+control metadata. It also contains per\-repository settings in+_darcs/prefs/, which you can read about in the user manual.++By default, patches of the new repository are in the darcs\-2 semantics.+However it is possible to create a repository in darcs\-1 semantics with+the flag `\-\-hashed', althought this is not recommended except for sharing+patches with a project that uses patches in the darcs\-1 semantics.++Initialize is commonly abbreviated to `init'.++.RE+.B darcs optimize+.RS 4+The `darcs optimize' command modifies the current repository in an+attempt to reduce its resource requirements. By default a single+fast, safe optimization is performed; additional optimization+techniques can be enabled by passing options to `darcs optimize'.++The default optimization moves recent patches (those not included in+the latest tag) to the `front', reducing the amount that a typical+remote command needs to download. It should also reduce the CPU time+needed for some operations.++The `darcs optimize \-\-relink' command hard\-links patches that the+current repository has in common with its peers. Peers are those+repositories listed in _darcs/prefs/sources, or defined with the+`\-\-sibling' option (which can be used multiple times).++Darcs uses hard\-links automatically, so this command is rarely needed.+It is most useful if you used `cp \-r' instead of `darcs get' to copy a+repository, or if you pulled the same patch from a remote repository+into multiple local repositories.++By default patches are compressed with zlib (RFC 1951) to reduce+storage (and download) size. In exceptional circumstances, it may be+preferable to avoid compression. In this case the `\-\-dont\-compress'+option can be used (e.g. with `darcs record') to avoid compression.++The `darcs optimize \-\-uncompress' and `darcs optimize \-\-compress'+commands can be used to ensure existing patches in the current+repository are respectively uncompressed or compressed. Note that+repositories in the legacy `old\-fashioned\-inventory' format have a .gz+extension on patch files even when uncompressed.++There is one more optimization which CAN NOT be performed by this+command. Every time your record a patch, a new inventory file is+written to _darcs/inventories/, and old inventories are never reaped.++If _darcs/inventories/ is consuming a relatively large amount of+space, you can safely reclaim it by using `darcs get' to make a+complete copy of the repo. When doing so, don't forget to copy over+any unsaved changes you have made to the working tree or to+unversioned files in _darcs/prefs/ (such as _darcs/prefs/author).++.RE+.B darcs check+.RS 4+This command verifies that the patches in the repository, when applied+successively to an empty tree, result in the pristine tree. If not,+the differences are printed and Darcs exits unsucessfully (with a+non\-zero exit status).++If a regression test is defined (see `darcs setpref') it will be run+by `darcs check'. Use the \-\-no\-test option to disable this.++.RE+.B darcs repair+.RS 4+The `darcs repair' command attempts to fix corruption in the current+repository. Currently it can only repair damage to the pristine tree,+which is where most corruption occurs.++.RE+.B darcs convert+.RI "<" "source" ">"+.RI "[<" "destination" ">]"+.RS 4+The current repository format is called `darcs\-2'. It was introduced+in Darcs 2.0 and became the default for new projects in Darcs 2.2.+The `darcs convert' command allows existing projects to migrate to+this format from the older `darcs\-1' format.++This command DOES NOT modify the source repository; a new destination+repository is created. It is safe to run this command more than once+on a repository (e.g. for testing), before the final conversion.++WARNING: the repository produced by this command is not understood by+Darcs 1.x, and patches cannot be exchanged between repositories in+darcs\-1 and darcs\-2 formats.++Furthermore, darcs 2 repositories created by different invocations of+this command SHOULD NOT exchange patches, unless those repositories+had no patches in common when they were converted. (That is, within a+set of repos that exchange patches, no patch should be converted more+than once.)++Due to this limitation, migrating a multi\-branch project is a little+awkward. Sorry! Here is the recommended process:++ 1. for each branch `foo', tag that branch with `foo\-final';+ 2. merge all branches together (\-\-allow\-conflicts may help);+ 3. run `darcs optimize \-\-reorder' on the result;+ 4. run `darcs convert' to create a merged darcs\-2 repository;+ 5. re\-create each branch by calling `darcs get \-\-tag foo\-final' on+ the darcs\-2 repository; and finally+ 6. use `darcs obliterate' to delete the foo\-final tags.++.RE++.SH ENVIRONMENT+.SS "HOME and APPDATA"+Per\-user preferences are set in $HOME/.darcs (on Unix) or+%APPDATA%/darcs (on Windows). This is also the default location of+the cache.+.SS "DARCS_EDITOR, DARCSEDITOR, VISUAL and EDITOR"+To edit a patch description of email comment, Darcs will invoke an+external editor. Your preferred editor can be set as any of the+environment variables $DARCS_EDITOR, $DARCSEDITOR, $VISUAL or $EDITOR.+If none of these are set, vi(1) is used. If vi crashes or is not+found in your PATH, emacs, emacs \-nw, nano and (on Windows) edit are+each tried in turn.+.SS "DARCS_PAGER and PAGER"+Darcs will sometimes invoke a pager if it deems output to be too long+to fit onscreen. Darcs will use the pager specified by $DARCS_PAGER+or $PAGER. If neither are set, `less' will be used.+.SS "DARCS_TMPDIR and TMPDIR"+Darcs often creates temporary directories. For example, the `darcs+diff' command creates two for the working trees to be diffed. By+default temporary directories are created in /tmp, or if that doesn't+exist, in _darcs (within the current repo). This can be overridden by+specifying some other directory in the file _darcs/prefs/tmpdir or the+environment variable $DARCS_TMPDIR or $TMPDIR.+.SS "DARCS_KEEP_TMPDIR"+If the environment variable DARCS_KEEP_TMPDIR is defined, darcs will+not remove the temporary directories it creates. This is intended+primarily for debugging Darcs itself, but it can also be useful, for+example, to determine why your test preference (see `darcs setpref')+is failing when you run `darcs record', but working when run manually.+.SS "DARCS_EMAIL and EMAIL"+Each patch is attributed to its author, usually by email address (for+example, `Fred Bloggs <fred@example.net>'). Darcs looks in several+places for this author string: the \-\-author option, the files+_darcs/prefs/author (in the repository) and ~/.darcs/author (in your+home directory), and the environment variables $DARCS_EMAIL and+$EMAIL. If none of those exist, Darcs will prompt you for an author+string and write it to _darcs/prefs/author. Note that if if you have more+than one email address, note that you can put them all in ~/.darcs/author,+one author per line. Darcs will still prompt you for an author, but it+allow you to select from the list or type in an alternative.+.SS "SENDMAIL"+On Unix, the `darcs send' command relies on sendmail(8). The+`\-\-sendmail\-command' or $SENDMAIL environment variable can be used to+provide an explicit path to this program; otherwise the standard+locations /usr/sbin/sendmail and /usr/lib/sendmail will be tried.+.SS "DARCS_SSH"+Repositories of the form [user@]host:[dir] are taken to be remote+repositories, which Darcs accesses with the external program ssh(1).++The environment variable $DARCS_SSH can be used to specify an+alternative SSH client. Arguments may be included, separated by+whitespace. The value is not interpreted by a shell, so shell+constructs cannot be used; in particular, it is not possible for the+program name to contain whitespace by using quoting or escaping.+.SS "DARCS_SCP and DARCS_SFTP"+When reading from a remote repository, Darcs will attempt to run+`darcs transfer\-mode' on the remote host. This will fail if the+remote host only has Darcs 1 installed, doesn't have Darcs installed+at all, or only allows SFTP.++If transfer\-mode fails, Darcs will fall back on scp(1) and sftp(1).+The commands invoked can be customized with the environment variables+$DARCS_SCP and $DARCS_SFTP respectively, which behave like $DARCS_SSH.+If the remote end allows only sftp, try setting DARCS_SCP=sftp.+.SS "SSH_PORT"+If this environment variable is set, it will be used as the port+number for all SSH calls made by Darcs (when accessing remote+repositories over SSH). This is useful if your SSH server does not+run on the default port, and your SSH client does not support+ssh_config(5). OpenSSH users will probably prefer to put something+like `Host *.example.net Port 443' into their ~/.ssh/config file.+.SS "HTTP_PROXY, HTTPS_PROXY, FTP_PROXY, ALL_PROXY and NO_PROXY"+If Darcs was built with libcurl, the environment variables HTTP_PROXY,+HTTPS_PROXY and FTP_PROXY can be set to the URL of a proxy in the form++ [protocol://]<host>[:port]++In which case libcurl will use the proxy for the associated protocol+(HTTP, HTTPS and FTP). The environment variable ALL_PROXY can be used+to set a single proxy for all libcurl requests.++If the environment variable NO_PROXY is a comma\-separated list of host+names, access to those hosts will bypass proxies defined by the above+variables. For example, it is quite common to avoid proxying requests+to machines on the local network with++ NO_PROXY=localhost,*.localdomain++For compatibility with lynx et al, lowercase equivalents of these+environment variables (e.g. $http_proxy) are also understood and are+used in preference to the uppercase versions.++If Darcs was not built with libcurl, all these environment variables+are silently ignored, and there is no way to use a web proxy.+.SS "DARCS_PROXYUSERPWD"+If Darcs was built with libcurl, and you are using a web proxy that+requires authentication, you can set the $DARCS_PROXYUSERPWD+environment variable to the username and password expected by the+proxy, separated by a colon. This environment variable is silently+ignored if Darcs was not built with libcurl.++.SH FILES+.SS "_darcs/prefs/binaries"+This file contains a list of extended regular expressions, one per+line. A file path matching any of these expressions is assumed to+contain binary data (not text). The entries in ~/.darcs/binaries (if+it exists) supplement those in this file.++Blank lines, and lines beginning with an octothorpe (#) are ignored.+See regex(7) for a description of extended regular expressions.++.SS "_darcs/prefs/boring"+This file contains a list of extended regular expressions, one per+line. A file path matching any of these expressions will be filtered+out during `darcs add', or when the `\-\-look\-for\-adds' flag is passed+to `darcs whatsnew' and `record'. The entries in ~/.darcs/boring (if+it exists) supplement those in this file.++Blank lines, and lines beginning with an octothorpe (#) are ignored.+See regex(7) for a description of extended regular expressions.++.SH BUGS+At http://bugs.darcs.net/ you can find a list of known+bugs in Darcs. Unknown bugs can be reported at that+site (after creating an account) or by emailing the+report to bugs@darcs.net.+.SH SEE ALSO+A user manual is included with Darcs, in PDF and HTML+form. It can also be found at http://darcs.net/manual/.+.SH LICENSE+Darcs 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.
+ dist/build/libHSdarcs-beta-2.7.98.1.a view
file too large to diff
+ dist/build/src/Crypt/sha2.o view
binary file changed (absent → 9600 bytes)
+ dist/build/src/atomic_create.o view
binary file changed (absent → 4480 bytes)
+ dist/build/src/fpstring.o view
binary file changed (absent → 2008 bytes)
+ dist/build/src/hscurl.o view
binary file changed (absent → 8088 bytes)
+ dist/build/src/maybe_relink.o view
binary file changed (absent → 3616 bytes)
+ dist/build/src/umask.o view
binary file changed (absent → 1680 bytes)
+ dist/package.conf.inplace view
@@ -0,0 +1,2 @@+[InstalledPackageInfo {installedPackageId = InstalledPackageId "darcs-beta-2.7.98.1-inplace", sourcePackageId = PackageIdentifier {pkgName = PackageName "darcs-beta", pkgVersion = Version {versionBranch = [2,7,98,1], versionTags = []}}, license = GPL Nothing, copyright = "", maintainer = "<darcs-users@darcs.net>", author = "David Roundy <droundy@darcs.net>, <darcs-users@darcs.net>", stability = "Experimental", homepage = "http://darcs.net/", pkgUrl = "", description = "Darcs is a free, open source revision control\nsystem. It is:\n\n* Distributed: Every user has access to the full\ncommand set, removing boundaries between server and\nclient or committer and non-committers.\n\n* Interactive: Darcs is easy to learn and efficient to\nuse because it asks you questions in response to\nsimple commands, giving you choices in your work\nflow. You can choose to record one change in a file,\nwhile ignoring another. As you update from upstream,\nyou can review each patch name, even the full \"diff\"\nfor interesting patches.\n\n* Smart: Originally developed by physicist David\nRoundy, darcs is based on a unique algebra of\npatches.\n\nThis smartness lets you respond to changing demands\nin ways that would otherwise not be possible. Learn\nmore about spontaneous branches with darcs.", category = "Development", exposed = True, exposedModules = ["CommandLine","Crypt.SHA256","Darcs.Annotate","Darcs.ArgumentDefaults","Darcs.Arguments","Darcs.Bug","Darcs.ColorPrinter","Darcs.Commands","Darcs.Commands.Add","Darcs.Commands.AmendRecord","Darcs.Commands.Annotate","Darcs.Commands.Apply","Darcs.CommandsAux","Darcs.Commands.Changes","Darcs.Commands.Check","Darcs.Commands.Convert","Darcs.Commands.Diff","Darcs.Commands.Dist","Darcs.Commands.Get","Darcs.Commands.GZCRCs","Darcs.Commands.Help","Darcs.Commands.Init","Darcs.Commands.MarkConflicts","Darcs.Commands.Move","Darcs.Commands.Optimize","Darcs.Commands.Pull","Darcs.Commands.Push","Darcs.Commands.Put","Darcs.Commands.Record","Darcs.Commands.Remove","Darcs.Commands.Replace","Darcs.Commands.Revert","Darcs.Commands.Rollback","Darcs.Commands.Send","Darcs.Commands.SetPref","Darcs.Commands.Show","Darcs.Commands.ShowAuthors","Darcs.Commands.ShowBug","Darcs.Commands.ShowContents","Darcs.Commands.ShowFiles","Darcs.Commands.ShowIndex","Darcs.Commands.ShowRepo","Darcs.Commands.ShowTags","Darcs.Commands.Tag","Darcs.Commands.TrackDown","Darcs.Commands.TransferMode","Darcs.Commands.Util","Darcs.Commands.Unrecord","Darcs.Commands.Unrevert","Darcs.Commands.WhatsNew","Darcs.Compat","Darcs.Diff","Darcs.Email","Darcs.External","Darcs.Flags","Darcs.Global","Darcs.IO","Darcs.Lock","Darcs.Match","Darcs.MonadProgress","Darcs.Patch","Darcs.Patch.Apply","Darcs.Patch.ApplyMonad","Darcs.Patch.Bracketed","Darcs.Patch.Bracketed.Instances","Darcs.Patch.Bundle","Darcs.Patch.Choices","Darcs.Patch.Commute","Darcs.Patch.Conflict","Darcs.Patch.ConflictMarking","Darcs.Patch.Depends","Darcs.Patch.Dummy","Darcs.Patch.Effect","Darcs.Patch.FileName","Darcs.Patch.FileHunk","Darcs.Patch.Format","Darcs.Patch.Info","Darcs.Patch.Inspect","Darcs.Patch.Invert","Darcs.Patch.Match","Darcs.Patch.MatchData","Darcs.Patch.Merge","Darcs.Patch.Named","Darcs.Patch.OldDate","Darcs.Patch.PatchInfoAnd","Darcs.Patch.Patchy","Darcs.Patch.Patchy.Instances","Darcs.Patch.Permutations","Darcs.Patch.Prim","Darcs.Patch.Prim.Class","Darcs.Patch.Prim.V1","Darcs.Patch.Prim.V1.Apply","Darcs.Patch.Prim.V1.Coalesce","Darcs.Patch.Prim.V1.Commute","Darcs.Patch.Prim.V1.Core","Darcs.Patch.Prim.V1.Details","Darcs.Patch.Prim.V1.Read","Darcs.Patch.Prim.V1.Show","Darcs.Patch.Read","Darcs.Patch.ReadMonads","Darcs.Patch.RegChars","Darcs.Patch.Repair","Darcs.Patch.RepoPatch","Darcs.Patch.Set","Darcs.Patch.Show","Darcs.Patch.Split","Darcs.Patch.Summary","Darcs.Patch.SummaryData","Darcs.Patch.TokenReplace","Darcs.Patch.TouchesFiles","Darcs.Patch.Viewing","Darcs.Patch.V1","Darcs.Patch.V1.Apply","Darcs.Patch.V1.Commute","Darcs.Patch.V1.Core","Darcs.Patch.V1.Read","Darcs.Patch.V1.Show","Darcs.Patch.V1.Viewing","Darcs.Patch.V2","Darcs.Patch.V2.Non","Darcs.Patch.V2.Real","Darcs.PrintPatch","Darcs.ProgressPatches","Darcs.RemoteApply","Darcs.RepoPath","Darcs.Repository","Darcs.Repository.ApplyPatches","Darcs.Repository.Cache","Darcs.Repository.Format","Darcs.Repository.HashedIO","Darcs.Repository.HashedRepo","Darcs.Repository.Internal","Darcs.Repository.LowLevel","Darcs.Repository.Merge","Darcs.Repository.InternalTypes","Darcs.Repository.Motd","Darcs.Repository.Old","Darcs.Repository.Prefs","Darcs.Repository.Repair","Darcs.Repository.State","Darcs.Resolution","Darcs.RunCommand","Darcs.SelectChanges","Darcs.SignalHandler","Darcs.Test","Darcs.TheCommands","Darcs.URL","Darcs.Utils","Darcs.Witnesses.Eq","Darcs.Witnesses.Ordered","Darcs.Witnesses.Sealed","Darcs.Witnesses.Show","Darcs.Witnesses.Unsafe","Darcs.Witnesses.WZipper","DateMatcher","English","Exec","ByteStringUtils","HTTP","IsoDate","Lcs","Printer","Progress","Ratified","SHA1","Ssh","URL","Workaround"], hiddenModules = ["Version"], importDirs = ["/tmp/darcs-beta-2.7.98.1/dist/build"], libraryDirs = ["/tmp/darcs-beta-2.7.98.1/dist/build"], hsLibraries = ["HSdarcs-beta-2.7.98.1"], extraLibraries = ["curl"], extraGHCiLibraries = [], includeDirs = ["/tmp/darcs-beta-2.7.98.1/src"], includes = ["curl/curl.h"], depends = [InstalledPackageId "HTTP-4000.1.1-e1c3272cf0835ac9d10671ed8dc862f9",InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e",InstalledPackageId "directory-1.1.0.0-393d8e95f1c0dd6ee908e122f924ac85",InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831",InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653",InstalledPackageId "hashed-storage-0.5.7-f2baae72d60d89cab6d2b5facd274d47",InstalledPackageId "haskeline-0.6.4.0-ea83f091fcdad61446c62afc5c94a9ed",InstalledPackageId "html-1.0.1.2-0cdd616c514cf10f5323f121a96991b6",InstalledPackageId "mmap-0.5.7-127e379f104e2b945de5325ba3158467",InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b",InstalledPackageId "network-2.3.0.2-824dddd7e2ce0e065568730d1c080c4a",InstalledPackageId "old-time-1.0.0.6-7f15fd4b960098b2776b8c05bc17519f",InstalledPackageId "parsec-3.1.1-33474162d2bbd21ea1e4f1e3830243d8",InstalledPackageId "process-1.0.1.5-da4848a2eec47420cd09fe9edba7e83c",InstalledPackageId "random-1.0.0.3-7511feaba03eecc22356464da8976c7e",InstalledPackageId "regex-compat-0.95.1-3e607bc84f3c3925033bb247b8ebab65",InstalledPackageId "tar-0.3.1.0-e78ec4eae84b755f8263c8666140ed0b",InstalledPackageId "terminfo-0.3.1.3-d898a3b030f2d808d2a44c5ff0e2a0e1",InstalledPackageId "text-0.11.0.6-139d7472dd2398472c7d962de013c741",InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff",InstalledPackageId "vector-0.7.0.1-f3d66d9edbfc37118398d6cdca0ca5ee",InstalledPackageId "zlib-0.5.3.1-7e19941cbd00147a79723e25160ffc8b"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/tmp/darcs-beta-2.7.98.1/dist/doc/html/darcs-beta/darcs-beta.haddock"], haddockHTMLs = ["/tmp/darcs-beta-2.7.98.1/dist/doc/html/darcs-beta"]}+]
+ dist/setup-config view
@@ -0,0 +1,2 @@+Saved package config for darcs-beta-2.7.98.1 written by Cabal-1.10.2.0 using ghc-7.0+LocalBuildInfo {configFlags = ConfigFlags {configPrograms = [], configProgramPaths = [], configProgramArgs = [], configHcFlavor = Flag GHC, configHcPath = NoFlag, configHcPkg = NoFlag, configVanillaLib = Flag True, configProfLib = Flag False, configSharedLib = Flag False, configProfExe = Flag False, configConfigureArgs = [], configOptimization = Flag NormalOptimisation, configProgPrefix = Flag "", configProgSuffix = Flag "", configInstallDirs = InstallDirs {prefix = NoFlag, bindir = NoFlag, libdir = NoFlag, libsubdir = NoFlag, dynlibdir = NoFlag, libexecdir = NoFlag, progdir = NoFlag, includedir = NoFlag, datadir = NoFlag, datasubdir = NoFlag, docdir = NoFlag, mandir = NoFlag, htmldir = NoFlag, haddockdir = NoFlag}, configScratchDir = NoFlag, configExtraLibDirs = [], configExtraIncludeDirs = [], configDistPref = Flag "dist", configVerbosity = Flag Normal, configUserInstall = Flag True, configPackageDB = NoFlag, configGHCiLib = Flag True, configSplitObjs = Flag False, configStripExes = Flag True, configConstraints = [], configConfigurationsFlags = [(FlagName "type-witnesses",True),(FlagName "test",True)], configTests = Flag False}, extraConfigArgs = [], installDirTemplates = InstallDirs {prefix = "/home/florent/.cabal", bindir = "$prefix/bin", libdir = "$prefix/lib", libsubdir = "$pkgid/$compiler", dynlibdir = "$libdir", libexecdir = "$prefix/libexec", progdir = "$libdir/hugs/programs", includedir = "$libdir/$libsubdir/include", datadir = "$prefix/share", datasubdir = "$pkgid", docdir = "$datadir/doc/$pkgid", mandir = "$datadir/man", htmldir = "$docdir/html", haddockdir = "$htmldir"}, compiler = Compiler {compilerId = CompilerId GHC (Version {versionBranch = [7,0,3], versionTags = []}), compilerLanguages = [(Haskell98,"-XHaskell98"),(Haskell2010,"-XHaskell2010")], compilerExtensions = [(UnknownExtension "Haskell98","-XHaskell98"),(UnknownExtension "Haskell2010","-XHaskell2010"),(CPP,"-XCPP"),(UnknownExtension "NoCPP","-XNoCPP"),(PostfixOperators,"-XPostfixOperators"),(UnknownExtension "NoPostfixOperators","-XNoPostfixOperators"),(TupleSections,"-XTupleSections"),(UnknownExtension "NoTupleSections","-XNoTupleSections"),(PatternGuards,"-XPatternGuards"),(UnknownExtension "NoPatternGuards","-XNoPatternGuards"),(UnicodeSyntax,"-XUnicodeSyntax"),(UnknownExtension "NoUnicodeSyntax","-XNoUnicodeSyntax"),(MagicHash,"-XMagicHash"),(UnknownExtension "NoMagicHash","-XNoMagicHash"),(PolymorphicComponents,"-XPolymorphicComponents"),(UnknownExtension "NoPolymorphicComponents","-XNoPolymorphicComponents"),(ExistentialQuantification,"-XExistentialQuantification"),(UnknownExtension "NoExistentialQuantification","-XNoExistentialQuantification"),(KindSignatures,"-XKindSignatures"),(UnknownExtension "NoKindSignatures","-XNoKindSignatures"),(EmptyDataDecls,"-XEmptyDataDecls"),(UnknownExtension "NoEmptyDataDecls","-XNoEmptyDataDecls"),(ParallelListComp,"-XParallelListComp"),(UnknownExtension "NoParallelListComp","-XNoParallelListComp"),(TransformListComp,"-XTransformListComp"),(UnknownExtension "NoTransformListComp","-XNoTransformListComp"),(ForeignFunctionInterface,"-XForeignFunctionInterface"),(UnknownExtension "NoForeignFunctionInterface","-XNoForeignFunctionInterface"),(UnliftedFFITypes,"-XUnliftedFFITypes"),(UnknownExtension "NoUnliftedFFITypes","-XNoUnliftedFFITypes"),(GHCForeignImportPrim,"-XGHCForeignImportPrim"),(UnknownExtension "NoGHCForeignImportPrim","-XNoGHCForeignImportPrim"),(LiberalTypeSynonyms,"-XLiberalTypeSynonyms"),(UnknownExtension "NoLiberalTypeSynonyms","-XNoLiberalTypeSynonyms"),(Rank2Types,"-XRank2Types"),(UnknownExtension "NoRank2Types","-XNoRank2Types"),(RankNTypes,"-XRankNTypes"),(UnknownExtension "NoRankNTypes","-XNoRankNTypes"),(ImpredicativeTypes,"-XImpredicativeTypes"),(UnknownExtension "NoImpredicativeTypes","-XNoImpredicativeTypes"),(TypeOperators,"-XTypeOperators"),(UnknownExtension "NoTypeOperators","-XNoTypeOperators"),(RecursiveDo,"-XRecursiveDo"),(UnknownExtension "NoRecursiveDo","-XNoRecursiveDo"),(DoRec,"-XDoRec"),(UnknownExtension "NoDoRec","-XNoDoRec"),(Arrows,"-XArrows"),(UnknownExtension "NoArrows","-XNoArrows"),(UnknownExtension "PArr","-XPArr"),(UnknownExtension "NoPArr","-XNoPArr"),(TemplateHaskell,"-XTemplateHaskell"),(UnknownExtension "NoTemplateHaskell","-XNoTemplateHaskell"),(QuasiQuotes,"-XQuasiQuotes"),(UnknownExtension "NoQuasiQuotes","-XNoQuasiQuotes"),(Generics,"-XGenerics"),(UnknownExtension "NoGenerics","-XNoGenerics"),(NoImplicitPrelude,"-XNoImplicitPrelude"),(NoImplicitPrelude,"-XNoImplicitPrelude"),(RecordWildCards,"-XRecordWildCards"),(UnknownExtension "NoRecordWildCards","-XNoRecordWildCards"),(NamedFieldPuns,"-XNamedFieldPuns"),(UnknownExtension "NoNamedFieldPuns","-XNoNamedFieldPuns"),(RecordPuns,"-XRecordPuns"),(UnknownExtension "NoRecordPuns","-XNoRecordPuns"),(DisambiguateRecordFields,"-XDisambiguateRecordFields"),(UnknownExtension "NoDisambiguateRecordFields","-XNoDisambiguateRecordFields"),(OverloadedStrings,"-XOverloadedStrings"),(UnknownExtension "NoOverloadedStrings","-XNoOverloadedStrings"),(GADTs,"-XGADTs"),(UnknownExtension "NoGADTs","-XNoGADTs"),(ViewPatterns,"-XViewPatterns"),(UnknownExtension "NoViewPatterns","-XNoViewPatterns"),(TypeFamilies,"-XTypeFamilies"),(UnknownExtension "NoTypeFamilies","-XNoTypeFamilies"),(BangPatterns,"-XBangPatterns"),(UnknownExtension "NoBangPatterns","-XNoBangPatterns"),(NoMonomorphismRestriction,"-XNoMonomorphismRestriction"),(NoMonomorphismRestriction,"-XNoMonomorphismRestriction"),(NPlusKPatterns,"-XNPlusKPatterns"),(UnknownExtension "NoNPlusKPatterns","-XNoNPlusKPatterns"),(DoAndIfThenElse,"-XDoAndIfThenElse"),(UnknownExtension "NoDoAndIfThenElse","-XNoDoAndIfThenElse"),(RebindableSyntax,"-XRebindableSyntax"),(UnknownExtension "NoRebindableSyntax","-XNoRebindableSyntax"),(NoMonoPatBinds,"-XNoMonoPatBinds"),(NoMonoPatBinds,"-XNoMonoPatBinds"),(ExplicitForAll,"-XExplicitForAll"),(UnknownExtension "NoExplicitForAll","-XNoExplicitForAll"),(UnknownExtension "AlternativeLayoutRule","-XAlternativeLayoutRule"),(UnknownExtension "NoAlternativeLayoutRule","-XNoAlternativeLayoutRule"),(UnknownExtension "AlternativeLayoutRuleTransitional","-XAlternativeLayoutRuleTransitional"),(UnknownExtension "NoAlternativeLayoutRuleTransitional","-XNoAlternativeLayoutRuleTransitional"),(DatatypeContexts,"-XDatatypeContexts"),(UnknownExtension "NoDatatypeContexts","-XNoDatatypeContexts"),(MonoLocalBinds,"-XMonoLocalBinds"),(UnknownExtension "NoMonoLocalBinds","-XNoMonoLocalBinds"),(RelaxedPolyRec,"-XRelaxedPolyRec"),(UnknownExtension "NoRelaxedPolyRec","-XNoRelaxedPolyRec"),(ExtendedDefaultRules,"-XExtendedDefaultRules"),(UnknownExtension "NoExtendedDefaultRules","-XNoExtendedDefaultRules"),(ImplicitParams,"-XImplicitParams"),(UnknownExtension "NoImplicitParams","-XNoImplicitParams"),(ScopedTypeVariables,"-XScopedTypeVariables"),(UnknownExtension "NoScopedTypeVariables","-XNoScopedTypeVariables"),(PatternSignatures,"-XPatternSignatures"),(UnknownExtension "NoPatternSignatures","-XNoPatternSignatures"),(UnboxedTuples,"-XUnboxedTuples"),(UnknownExtension "NoUnboxedTuples","-XNoUnboxedTuples"),(StandaloneDeriving,"-XStandaloneDeriving"),(UnknownExtension "NoStandaloneDeriving","-XNoStandaloneDeriving"),(DeriveDataTypeable,"-XDeriveDataTypeable"),(UnknownExtension "NoDeriveDataTypeable","-XNoDeriveDataTypeable"),(DeriveFunctor,"-XDeriveFunctor"),(UnknownExtension "NoDeriveFunctor","-XNoDeriveFunctor"),(DeriveTraversable,"-XDeriveTraversable"),(UnknownExtension "NoDeriveTraversable","-XNoDeriveTraversable"),(DeriveFoldable,"-XDeriveFoldable"),(UnknownExtension "NoDeriveFoldable","-XNoDeriveFoldable"),(TypeSynonymInstances,"-XTypeSynonymInstances"),(UnknownExtension "NoTypeSynonymInstances","-XNoTypeSynonymInstances"),(FlexibleContexts,"-XFlexibleContexts"),(UnknownExtension "NoFlexibleContexts","-XNoFlexibleContexts"),(FlexibleInstances,"-XFlexibleInstances"),(UnknownExtension "NoFlexibleInstances","-XNoFlexibleInstances"),(ConstrainedClassMethods,"-XConstrainedClassMethods"),(UnknownExtension "NoConstrainedClassMethods","-XNoConstrainedClassMethods"),(MultiParamTypeClasses,"-XMultiParamTypeClasses"),(UnknownExtension "NoMultiParamTypeClasses","-XNoMultiParamTypeClasses"),(FunctionalDependencies,"-XFunctionalDependencies"),(UnknownExtension "NoFunctionalDependencies","-XNoFunctionalDependencies"),(GeneralizedNewtypeDeriving,"-XGeneralizedNewtypeDeriving"),(UnknownExtension "NoGeneralizedNewtypeDeriving","-XNoGeneralizedNewtypeDeriving"),(OverlappingInstances,"-XOverlappingInstances"),(UnknownExtension "NoOverlappingInstances","-XNoOverlappingInstances"),(UndecidableInstances,"-XUndecidableInstances"),(UnknownExtension "NoUndecidableInstances","-XNoUndecidableInstances"),(IncoherentInstances,"-XIncoherentInstances"),(UnknownExtension "NoIncoherentInstances","-XNoIncoherentInstances"),(PackageImports,"-XPackageImports"),(UnknownExtension "NoPackageImports","-XNoPackageImports"),(NewQualifiedOperators,"-XNewQualifiedOperators"),(UnknownExtension "NoNewQualifiedOperators","-XNoNewQualifiedOperators")]}, buildDir = "dist/build", scratchDir = "dist/scratch", libraryConfig = Just (ComponentLocalBuildInfo {componentPackageDeps = [(InstalledPackageId "HTTP-4000.1.1-e1c3272cf0835ac9d10671ed8dc862f9",PackageIdentifier {pkgName = PackageName "HTTP", pkgVersion = Version {versionBranch = [4000,1,1], versionTags = []}}),(InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",PackageIdentifier {pkgName = PackageName "array", pkgVersion = Version {versionBranch = [0,3,0,2], versionTags = []}}),(InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,3,1,0], versionTags = []}}),(InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",PackageIdentifier {pkgName = PackageName "bytestring", pkgVersion = Version {versionBranch = [0,9,1,10], versionTags = []}}),(InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e",PackageIdentifier {pkgName = PackageName "containers", pkgVersion = Version {versionBranch = [0,4,0,0], versionTags = []}}),(InstalledPackageId "directory-1.1.0.0-393d8e95f1c0dd6ee908e122f924ac85",PackageIdentifier {pkgName = PackageName "directory", pkgVersion = Version {versionBranch = [1,1,0,0], versionTags = []}}),(InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831",PackageIdentifier {pkgName = PackageName "extensible-exceptions", pkgVersion = Version {versionBranch = [0,1,1,2], versionTags = []}}),(InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653",PackageIdentifier {pkgName = PackageName "filepath", pkgVersion = Version {versionBranch = [1,2,0,0], versionTags = []}}),(InstalledPackageId "hashed-storage-0.5.7-f2baae72d60d89cab6d2b5facd274d47",PackageIdentifier {pkgName = PackageName "hashed-storage", pkgVersion = Version {versionBranch = [0,5,7], versionTags = []}}),(InstalledPackageId "haskeline-0.6.4.0-ea83f091fcdad61446c62afc5c94a9ed",PackageIdentifier {pkgName = PackageName "haskeline", pkgVersion = Version {versionBranch = [0,6,4,0], versionTags = []}}),(InstalledPackageId "html-1.0.1.2-0cdd616c514cf10f5323f121a96991b6",PackageIdentifier {pkgName = PackageName "html", pkgVersion = Version {versionBranch = [1,0,1,2], versionTags = []}}),(InstalledPackageId "mmap-0.5.7-127e379f104e2b945de5325ba3158467",PackageIdentifier {pkgName = PackageName "mmap", pkgVersion = Version {versionBranch = [0,5,7], versionTags = []}}),(InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b",PackageIdentifier {pkgName = PackageName "mtl", pkgVersion = Version {versionBranch = [2,0,1,0], versionTags = []}}),(InstalledPackageId "network-2.3.0.2-824dddd7e2ce0e065568730d1c080c4a",PackageIdentifier {pkgName = PackageName "network", pkgVersion = Version {versionBranch = [2,3,0,2], versionTags = []}}),(InstalledPackageId "old-time-1.0.0.6-7f15fd4b960098b2776b8c05bc17519f",PackageIdentifier {pkgName = PackageName "old-time", pkgVersion = Version {versionBranch = [1,0,0,6], versionTags = []}}),(InstalledPackageId "parsec-3.1.1-33474162d2bbd21ea1e4f1e3830243d8",PackageIdentifier {pkgName = PackageName "parsec", pkgVersion = Version {versionBranch = [3,1,1], versionTags = []}}),(InstalledPackageId "process-1.0.1.5-da4848a2eec47420cd09fe9edba7e83c",PackageIdentifier {pkgName = PackageName "process", pkgVersion = Version {versionBranch = [1,0,1,5], versionTags = []}}),(InstalledPackageId "random-1.0.0.3-7511feaba03eecc22356464da8976c7e",PackageIdentifier {pkgName = PackageName "random", pkgVersion = Version {versionBranch = [1,0,0,3], versionTags = []}}),(InstalledPackageId "regex-compat-0.95.1-3e607bc84f3c3925033bb247b8ebab65",PackageIdentifier {pkgName = PackageName "regex-compat", pkgVersion = Version {versionBranch = [0,95,1], versionTags = []}}),(InstalledPackageId "tar-0.3.1.0-e78ec4eae84b755f8263c8666140ed0b",PackageIdentifier {pkgName = PackageName "tar", pkgVersion = Version {versionBranch = [0,3,1,0], versionTags = []}}),(InstalledPackageId "terminfo-0.3.1.3-d898a3b030f2d808d2a44c5ff0e2a0e1",PackageIdentifier {pkgName = PackageName "terminfo", pkgVersion = Version {versionBranch = [0,3,1,3], versionTags = []}}),(InstalledPackageId "text-0.11.0.6-139d7472dd2398472c7d962de013c741",PackageIdentifier {pkgName = PackageName "text", pkgVersion = Version {versionBranch = [0,11,0,6], versionTags = []}}),(InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff",PackageIdentifier {pkgName = PackageName "unix", pkgVersion = Version {versionBranch = [2,4,2,0], versionTags = []}}),(InstalledPackageId "vector-0.7.0.1-f3d66d9edbfc37118398d6cdca0ca5ee",PackageIdentifier {pkgName = PackageName "vector", pkgVersion = Version {versionBranch = [0,7,0,1], versionTags = []}}),(InstalledPackageId "zlib-0.5.3.1-7e19941cbd00147a79723e25160ffc8b",PackageIdentifier {pkgName = PackageName "zlib", pkgVersion = Version {versionBranch = [0,5,3,1], versionTags = []}})]}), executableConfigs = [("darcs",ComponentLocalBuildInfo {componentPackageDeps = [(InstalledPackageId "HTTP-4000.1.1-e1c3272cf0835ac9d10671ed8dc862f9",PackageIdentifier {pkgName = PackageName "HTTP", pkgVersion = Version {versionBranch = [4000,1,1], versionTags = []}}),(InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",PackageIdentifier {pkgName = PackageName "array", pkgVersion = Version {versionBranch = [0,3,0,2], versionTags = []}}),(InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,3,1,0], versionTags = []}}),(InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",PackageIdentifier {pkgName = PackageName "bytestring", pkgVersion = Version {versionBranch = [0,9,1,10], versionTags = []}}),(InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e",PackageIdentifier {pkgName = PackageName "containers", pkgVersion = Version {versionBranch = [0,4,0,0], versionTags = []}}),(InstalledPackageId "directory-1.1.0.0-393d8e95f1c0dd6ee908e122f924ac85",PackageIdentifier {pkgName = PackageName "directory", pkgVersion = Version {versionBranch = [1,1,0,0], versionTags = []}}),(InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831",PackageIdentifier {pkgName = PackageName "extensible-exceptions", pkgVersion = Version {versionBranch = [0,1,1,2], versionTags = []}}),(InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653",PackageIdentifier {pkgName = PackageName "filepath", pkgVersion = Version {versionBranch = [1,2,0,0], versionTags = []}}),(InstalledPackageId "hashed-storage-0.5.7-f2baae72d60d89cab6d2b5facd274d47",PackageIdentifier {pkgName = PackageName "hashed-storage", pkgVersion = Version {versionBranch = [0,5,7], versionTags = []}}),(InstalledPackageId "haskeline-0.6.4.0-ea83f091fcdad61446c62afc5c94a9ed",PackageIdentifier {pkgName = PackageName "haskeline", pkgVersion = Version {versionBranch = [0,6,4,0], versionTags = []}}),(InstalledPackageId "html-1.0.1.2-0cdd616c514cf10f5323f121a96991b6",PackageIdentifier {pkgName = PackageName "html", pkgVersion = Version {versionBranch = [1,0,1,2], versionTags = []}}),(InstalledPackageId "mmap-0.5.7-127e379f104e2b945de5325ba3158467",PackageIdentifier {pkgName = PackageName "mmap", pkgVersion = Version {versionBranch = [0,5,7], versionTags = []}}),(InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b",PackageIdentifier {pkgName = PackageName "mtl", pkgVersion = Version {versionBranch = [2,0,1,0], versionTags = []}}),(InstalledPackageId "network-2.3.0.2-824dddd7e2ce0e065568730d1c080c4a",PackageIdentifier {pkgName = PackageName "network", pkgVersion = Version {versionBranch = [2,3,0,2], versionTags = []}}),(InstalledPackageId "old-time-1.0.0.6-7f15fd4b960098b2776b8c05bc17519f",PackageIdentifier {pkgName = PackageName "old-time", pkgVersion = Version {versionBranch = [1,0,0,6], versionTags = []}}),(InstalledPackageId "parsec-3.1.1-33474162d2bbd21ea1e4f1e3830243d8",PackageIdentifier {pkgName = PackageName "parsec", pkgVersion = Version {versionBranch = [3,1,1], versionTags = []}}),(InstalledPackageId "process-1.0.1.5-da4848a2eec47420cd09fe9edba7e83c",PackageIdentifier {pkgName = PackageName "process", pkgVersion = Version {versionBranch = [1,0,1,5], versionTags = []}}),(InstalledPackageId "random-1.0.0.3-7511feaba03eecc22356464da8976c7e",PackageIdentifier {pkgName = PackageName "random", pkgVersion = Version {versionBranch = [1,0,0,3], versionTags = []}}),(InstalledPackageId "regex-compat-0.95.1-3e607bc84f3c3925033bb247b8ebab65",PackageIdentifier {pkgName = PackageName "regex-compat", pkgVersion = Version {versionBranch = [0,95,1], versionTags = []}}),(InstalledPackageId "tar-0.3.1.0-e78ec4eae84b755f8263c8666140ed0b",PackageIdentifier {pkgName = PackageName "tar", pkgVersion = Version {versionBranch = [0,3,1,0], versionTags = []}}),(InstalledPackageId "terminfo-0.3.1.3-d898a3b030f2d808d2a44c5ff0e2a0e1",PackageIdentifier {pkgName = PackageName "terminfo", pkgVersion = Version {versionBranch = [0,3,1,3], versionTags = []}}),(InstalledPackageId "text-0.11.0.6-139d7472dd2398472c7d962de013c741",PackageIdentifier {pkgName = PackageName "text", pkgVersion = Version {versionBranch = [0,11,0,6], versionTags = []}}),(InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff",PackageIdentifier {pkgName = PackageName "unix", pkgVersion = Version {versionBranch = [2,4,2,0], versionTags = []}}),(InstalledPackageId "vector-0.7.0.1-f3d66d9edbfc37118398d6cdca0ca5ee",PackageIdentifier {pkgName = PackageName "vector", pkgVersion = Version {versionBranch = [0,7,0,1], versionTags = []}}),(InstalledPackageId "zlib-0.5.3.1-7e19941cbd00147a79723e25160ffc8b",PackageIdentifier {pkgName = PackageName "zlib", pkgVersion = Version {versionBranch = [0,5,3,1], versionTags = []}})]}),("darcs-test",ComponentLocalBuildInfo {componentPackageDeps = [(InstalledPackageId "HTTP-4000.1.1-e1c3272cf0835ac9d10671ed8dc862f9",PackageIdentifier {pkgName = PackageName "HTTP", pkgVersion = Version {versionBranch = [4000,1,1], versionTags = []}}),(InstalledPackageId "HUnit-1.2.2.3-8fe95e501b1318ef285c39ed79ca4209",PackageIdentifier {pkgName = PackageName "HUnit", pkgVersion = Version {versionBranch = [1,2,2,3], versionTags = []}}),(InstalledPackageId "QuickCheck-2.4.1.1-6b2df10756c9ae534bddffc57c532df8",PackageIdentifier {pkgName = PackageName "QuickCheck", pkgVersion = Version {versionBranch = [2,4,1,1], versionTags = []}}),(InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",PackageIdentifier {pkgName = PackageName "array", pkgVersion = Version {versionBranch = [0,3,0,2], versionTags = []}}),(InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,3,1,0], versionTags = []}}),(InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",PackageIdentifier {pkgName = PackageName "bytestring", pkgVersion = Version {versionBranch = [0,9,1,10], versionTags = []}}),(InstalledPackageId "cmdlib-0.3-30b0b48ba7f087d1e853499831429cfa",PackageIdentifier {pkgName = PackageName "cmdlib", pkgVersion = Version {versionBranch = [0,3], versionTags = []}}),(InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e",PackageIdentifier {pkgName = PackageName "containers", pkgVersion = Version {versionBranch = [0,4,0,0], versionTags = []}}),(InstalledPackageId "directory-1.1.0.0-393d8e95f1c0dd6ee908e122f924ac85",PackageIdentifier {pkgName = PackageName "directory", pkgVersion = Version {versionBranch = [1,1,0,0], versionTags = []}}),(InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831",PackageIdentifier {pkgName = PackageName "extensible-exceptions", pkgVersion = Version {versionBranch = [0,1,1,2], versionTags = []}}),(InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653",PackageIdentifier {pkgName = PackageName "filepath", pkgVersion = Version {versionBranch = [1,2,0,0], versionTags = []}}),(InstalledPackageId "hashed-storage-0.5.7-f2baae72d60d89cab6d2b5facd274d47",PackageIdentifier {pkgName = PackageName "hashed-storage", pkgVersion = Version {versionBranch = [0,5,7], versionTags = []}}),(InstalledPackageId "haskeline-0.6.4.0-ea83f091fcdad61446c62afc5c94a9ed",PackageIdentifier {pkgName = PackageName "haskeline", pkgVersion = Version {versionBranch = [0,6,4,0], versionTags = []}}),(InstalledPackageId "html-1.0.1.2-0cdd616c514cf10f5323f121a96991b6",PackageIdentifier {pkgName = PackageName "html", pkgVersion = Version {versionBranch = [1,0,1,2], versionTags = []}}),(InstalledPackageId "mmap-0.5.7-127e379f104e2b945de5325ba3158467",PackageIdentifier {pkgName = PackageName "mmap", pkgVersion = Version {versionBranch = [0,5,7], versionTags = []}}),(InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b",PackageIdentifier {pkgName = PackageName "mtl", pkgVersion = Version {versionBranch = [2,0,1,0], versionTags = []}}),(InstalledPackageId "network-2.3.0.2-824dddd7e2ce0e065568730d1c080c4a",PackageIdentifier {pkgName = PackageName "network", pkgVersion = Version {versionBranch = [2,3,0,2], versionTags = []}}),(InstalledPackageId "old-time-1.0.0.6-7f15fd4b960098b2776b8c05bc17519f",PackageIdentifier {pkgName = PackageName "old-time", pkgVersion = Version {versionBranch = [1,0,0,6], versionTags = []}}),(InstalledPackageId "parsec-3.1.1-33474162d2bbd21ea1e4f1e3830243d8",PackageIdentifier {pkgName = PackageName "parsec", pkgVersion = Version {versionBranch = [3,1,1], versionTags = []}}),(InstalledPackageId "process-1.0.1.5-da4848a2eec47420cd09fe9edba7e83c",PackageIdentifier {pkgName = PackageName "process", pkgVersion = Version {versionBranch = [1,0,1,5], versionTags = []}}),(InstalledPackageId "random-1.0.0.3-7511feaba03eecc22356464da8976c7e",PackageIdentifier {pkgName = PackageName "random", pkgVersion = Version {versionBranch = [1,0,0,3], versionTags = []}}),(InstalledPackageId "regex-compat-0.95.1-3e607bc84f3c3925033bb247b8ebab65",PackageIdentifier {pkgName = PackageName "regex-compat", pkgVersion = Version {versionBranch = [0,95,1], versionTags = []}}),(InstalledPackageId "shellish-0.1.4-5b908e0ef83b4d4990e862a2d582acb1",PackageIdentifier {pkgName = PackageName "shellish", pkgVersion = Version {versionBranch = [0,1,4], versionTags = []}}),(InstalledPackageId "tar-0.3.1.0-e78ec4eae84b755f8263c8666140ed0b",PackageIdentifier {pkgName = PackageName "tar", pkgVersion = Version {versionBranch = [0,3,1,0], versionTags = []}}),(InstalledPackageId "terminfo-0.3.1.3-d898a3b030f2d808d2a44c5ff0e2a0e1",PackageIdentifier {pkgName = PackageName "terminfo", pkgVersion = Version {versionBranch = [0,3,1,3], versionTags = []}}),(InstalledPackageId "test-framework-0.4.0-3570e5fce12246859c27f7b4577044ed",PackageIdentifier {pkgName = PackageName "test-framework", pkgVersion = Version {versionBranch = [0,4,0], versionTags = []}}),(InstalledPackageId "test-framework-hunit-0.2.6-ca043988073add792f5cddeb80a08ce9",PackageIdentifier {pkgName = PackageName "test-framework-hunit", pkgVersion = Version {versionBranch = [0,2,6], versionTags = []}}),(InstalledPackageId "test-framework-quickcheck2-0.2.10-48c3729ab4f2ea19741d59800542207a",PackageIdentifier {pkgName = PackageName "test-framework-quickcheck2", pkgVersion = Version {versionBranch = [0,2,10], versionTags = []}}),(InstalledPackageId "text-0.11.0.6-139d7472dd2398472c7d962de013c741",PackageIdentifier {pkgName = PackageName "text", pkgVersion = Version {versionBranch = [0,11,0,6], versionTags = []}}),(InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff",PackageIdentifier {pkgName = PackageName "unix", pkgVersion = Version {versionBranch = [2,4,2,0], versionTags = []}}),(InstalledPackageId "vector-0.7.0.1-f3d66d9edbfc37118398d6cdca0ca5ee",PackageIdentifier {pkgName = PackageName "vector", pkgVersion = Version {versionBranch = [0,7,0,1], versionTags = []}}),(InstalledPackageId "zlib-0.5.3.1-7e19941cbd00147a79723e25160ffc8b",PackageIdentifier {pkgName = PackageName "zlib", pkgVersion = Version {versionBranch = [0,5,3,1], versionTags = []}})]})], testSuiteConfigs = [], installedPkgs = PackageIndex (fromList [(InstalledPackageId "HTTP-4000.1.1-e1c3272cf0835ac9d10671ed8dc862f9",InstalledPackageInfo {installedPackageId = InstalledPackageId "HTTP-4000.1.1-e1c3272cf0835ac9d10671ed8dc862f9", sourcePackageId = PackageIdentifier {pkgName = PackageName "HTTP", pkgVersion = Version {versionBranch = [4000,1,1], versionTags = []}}, license = BSD3, copyright = "Copyright (c) 2002, Warrick Gray\nCopyright (c) 2002-2005, Ian Lynagh\nCopyright (c) 2003-2006, Bjorn Bringert\nCopyright (c) 2004, Andre Furtado\nCopyright (c) 2004, Ganesh Sittampalam\nCopyright (c) 2004-2005, Dominic Steinitz\nCopyright 2007 Robin Bate Boerop\nCopyright 2008- Sigbjorn Finne", maintainer = "Ganesh Sittampalam <ganesh@earth.li>", author = "Warrick Gray <warrick.gray@hotmail.com>", stability = "", homepage = "http://projects.haskell.org/http/", pkgUrl = "", description = "The HTTP package supports client-side web programming in Haskell. It lets you set up\nHTTP connections, transmitting requests and processing the responses coming back, all\nfrom within the comforts of Haskell. It's dependent on the network package to operate,\nbut other than that, the implementation is all written in Haskell.\n\nA basic API for issuing single HTTP requests + receiving responses is provided. On top\nof that, a session-level abstraction is also on offer (the @BrowserAction@ monad);\nit taking care of handling the management of persistent connections, proxies,\nstate (cookies) and authentication credentials required to handle multi-step\ninteractions with a web server.\n\nThe representation of the bytes flowing across is extensible via the use of a type class,\nletting you pick the representation of requests and responses that best fits your use.\nSome pre-packaged, common instances are provided for you (@ByteString@, @String@.)\n\nHere's an example use:\n\n>\n> do\n> rsp <- Network.HTTP.simpleHTTP (getRequest \"http://www.haskell.org/\")\n> -- fetch document and return it (as a 'String'.)\n> fmap (take 100) (getResponseBody rsp)\n>\n> do\n> rsp <- Network.Browser.browse $ do\n> setAllowRedirects True -- handle HTTP redirects\n> request $ getRequest \"http://google.com/\"\n> fmap (take 100) (getResponseBody rsp)\n>\n\nGit repository available at <git://github.com/haskell/HTTP.git>", category = "Network", exposed = True, exposedModules = [ModuleName ["Network","BufferType"],ModuleName ["Network","Stream"],ModuleName ["Network","StreamDebugger"],ModuleName ["Network","StreamSocket"],ModuleName ["Network","TCP"],ModuleName ["Network","HTTP"],ModuleName ["Network","HTTP","Headers"],ModuleName ["Network","HTTP","Base"],ModuleName ["Network","HTTP","Stream"],ModuleName ["Network","HTTP","Auth"],ModuleName ["Network","HTTP","Cookie"],ModuleName ["Network","HTTP","Proxy"],ModuleName ["Network","HTTP","HandleStream"],ModuleName ["Network","Browser"]], hiddenModules = [ModuleName ["Network","HTTP","Base64"],ModuleName ["Network","HTTP","MD5"],ModuleName ["Network","HTTP","MD5Aux"],ModuleName ["Network","HTTP","Utils"]], importDirs = ["/home/florent/.cabal/lib/HTTP-4000.1.1/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/HTTP-4000.1.1/ghc-7.0.3"], hsLibraries = ["HSHTTP-4000.1.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b",InstalledPackageId "network-2.3.0.2-824dddd7e2ce0e065568730d1c080c4a",InstalledPackageId "old-time-1.0.0.6-7f15fd4b960098b2776b8c05bc17519f",InstalledPackageId "parsec-3.1.1-33474162d2bbd21ea1e4f1e3830243d8"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/HTTP-4000.1.1/html/HTTP.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/HTTP-4000.1.1/html"]}),(InstalledPackageId "HUnit-1.2.2.3-8fe95e501b1318ef285c39ed79ca4209",InstalledPackageInfo {installedPackageId = InstalledPackageId "HUnit-1.2.2.3-8fe95e501b1318ef285c39ed79ca4209", sourcePackageId = PackageIdentifier {pkgName = PackageName "HUnit", pkgVersion = Version {versionBranch = [1,2,2,3], versionTags = []}}, license = BSD3, copyright = "", maintainer = "hunit@richardg.name", author = "Dean Herington", stability = "stable", homepage = "http://hunit.sourceforge.net/", pkgUrl = "", description = "HUnit is a unit testing framework for Haskell, inspired by the\nJUnit tool for Java, see: <http://www.junit.org>.", category = "Testing", exposed = True, exposedModules = [ModuleName ["Test","HUnit","Base"],ModuleName ["Test","HUnit","Lang"],ModuleName ["Test","HUnit","Terminal"],ModuleName ["Test","HUnit","Text"],ModuleName ["Test","HUnit"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/HUnit-1.2.2.3/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/HUnit-1.2.2.3/ghc-7.0.3"], hsLibraries = ["HSHUnit-1.2.2.3"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/hunit-1.2.2.3/HUnit.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-hunit-doc/html/"]}),(InstalledPackageId "QuickCheck-2.4.1.1-6b2df10756c9ae534bddffc57c532df8",InstalledPackageInfo {installedPackageId = InstalledPackageId "QuickCheck-2.4.1.1-6b2df10756c9ae534bddffc57c532df8", sourcePackageId = PackageIdentifier {pkgName = PackageName "QuickCheck", pkgVersion = Version {versionBranch = [2,4,1,1], versionTags = []}}, license = BSD3, copyright = "2000-2011 Koen Claessen, 2006-2008 Bj\246rn Bringert, 2009-2011 Nick Smallbone", maintainer = "QuickCheck developers <quickcheck@projects.haskell.org>", author = "Koen Claessen <koen@chalmers.se>", stability = "", homepage = "http://code.haskell.org/QuickCheck", pkgUrl = "", description = "QuickCheck is a library for random testing of program properties.\n\nThe programmer provides a specification of the program, in\nthe form of properties which functions should satisfy, and\nQuickCheck then tests that the properties hold in a large number\nof randomly generated cases.\n\nSpecifications are expressed in\nHaskell, using combinators defined in the QuickCheck library.\nQuickCheck provides combinators to define properties, observe\nthe distribution of test data, and define test\ndata generators.", category = "Testing", exposed = True, exposedModules = [ModuleName ["Test","QuickCheck","All"],ModuleName ["Test","QuickCheck","Function"],ModuleName ["Test","QuickCheck"],ModuleName ["Test","QuickCheck","Arbitrary"],ModuleName ["Test","QuickCheck","Gen"],ModuleName ["Test","QuickCheck","Monadic"],ModuleName ["Test","QuickCheck","Modifiers"],ModuleName ["Test","QuickCheck","Property"],ModuleName ["Test","QuickCheck","Test"],ModuleName ["Test","QuickCheck","Text"],ModuleName ["Test","QuickCheck","Poly"],ModuleName ["Test","QuickCheck","State"]], hiddenModules = [ModuleName ["Test","QuickCheck","Exception"]], importDirs = ["/usr/lib/haskell-packages/ghc/lib/QuickCheck-2.4.1.1/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/QuickCheck-2.4.1.1/ghc-7.0.3"], hsLibraries = ["HSQuickCheck-2.4.1.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831",InstalledPackageId "random-1.0.0.3-7511feaba03eecc22356464da8976c7e",InstalledPackageId "template-haskell-2.5.0.0-957162165c2e6480a35f6d14f7e5220f"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/quickcheck2-2.4.1.1/QuickCheck.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-quickcheck2-doc/html/"]}),(InstalledPackageId "ansi-terminal-0.5.5-572a1d0154fb2632bb4e9431adf0cdb1",InstalledPackageInfo {installedPackageId = InstalledPackageId "ansi-terminal-0.5.5-572a1d0154fb2632bb4e9431adf0cdb1", sourcePackageId = PackageIdentifier {pkgName = PackageName "ansi-terminal", pkgVersion = Version {versionBranch = [0,5,5], versionTags = []}}, license = BSD3, copyright = "", maintainer = "batterseapower@hotmail.com", author = "Max Bolingbroke", stability = "", homepage = "http://batterseapower.github.com/ansi-terminal", pkgUrl = "", description = "ANSI terminal support for Haskell: allows cursor movement, screen clearing, color output showing or hiding the cursor, and\nchanging the title. Compatible with Windows and those Unixes with ANSI terminals, but only GHC is supported as a compiler.", category = "User Interfaces", exposed = True, exposedModules = [ModuleName ["System","Console","ANSI"]], hiddenModules = [ModuleName ["System","Console","ANSI","Unix"],ModuleName ["System","Console","ANSI","Common"]], importDirs = ["/home/florent/.cabal/lib/ansi-terminal-0.5.5/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/ansi-terminal-0.5.5/ghc-7.0.3"], hsLibraries = ["HSansi-terminal-0.5.5"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/ansi-terminal-0.5.5/html/ansi-terminal.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/ansi-terminal-0.5.5/html"]}),(InstalledPackageId "ansi-wl-pprint-0.6.3-e572fb77d5bf7bcb04a7444a9b54f822",InstalledPackageInfo {installedPackageId = InstalledPackageId "ansi-wl-pprint-0.6.3-e572fb77d5bf7bcb04a7444a9b54f822", sourcePackageId = PackageIdentifier {pkgName = PackageName "ansi-wl-pprint", pkgVersion = Version {versionBranch = [0,6,3], versionTags = []}}, license = BSD3, copyright = "", maintainer = "batterseapower@hotmail.com", author = "Daan Leijen, Max Bolingbroke", stability = "", homepage = "http://github.com/batterseapower/ansi-wl-pprint", pkgUrl = "", description = "This is a pretty printing library based on Wadler's paper \"A Prettier Printer\". It has been enhanced with support for ANSI terminal colored output using the ansi-terminal package.", category = "User Interfaces, Text", exposed = True, exposedModules = [ModuleName ["Text","PrettyPrint","ANSI","Leijen"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/ansi-wl-pprint-0.6.3/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/ansi-wl-pprint-0.6.3/ghc-7.0.3"], hsLibraries = ["HSansi-wl-pprint-0.6.3"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "ansi-terminal-0.5.5-572a1d0154fb2632bb4e9431adf0cdb1",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/ansi-wl-pprint-0.6.3/html/ansi-wl-pprint.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/ansi-wl-pprint-0.6.3/html"]}),(InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageInfo {installedPackageId = InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8", sourcePackageId = PackageIdentifier {pkgName = PackageName "array", pkgVersion = Version {versionBranch = [0,3,0,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package defines the classes @IArray@ of immutable arrays and\n@MArray@ of arrays mutable within appropriate monads, as well as\nsome instances of these classes.", category = "Data Structures", exposed = True, exposedModules = [ModuleName ["Data","Array","Base"],ModuleName ["Data","Array","IArray"],ModuleName ["Data","Array","IO"],ModuleName ["Data","Array","IO","Internals"],ModuleName ["Data","Array","MArray"],ModuleName ["Data","Array","ST"],ModuleName ["Data","Array","Storable"],ModuleName ["Data","Array","Unboxed"],ModuleName ["Data","Array"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/array-0.3.0.2"], libraryDirs = ["/usr/lib/ghc-7.0.3/array-0.3.0.2"], hsLibraries = ["HSarray-0.3.0.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/array-0.3.0.2/array.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/array-0.3.0.2"]}),(InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageInfo {installedPackageId = InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c", sourcePackageId = PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,3,1,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package contains the Prelude and its support libraries,\nand a large collection of useful libraries ranging from data\nstructures to parsing combinators and debugging utilities.", category = "", exposed = True, exposedModules = [ModuleName ["Foreign","Concurrent"],ModuleName ["GHC","Arr"],ModuleName ["GHC","Base"],ModuleName ["GHC","Classes"],ModuleName ["GHC","Conc"],ModuleName ["GHC","Conc","IO"],ModuleName ["GHC","Conc","Signal"],ModuleName ["GHC","Conc","Sync"],ModuleName ["GHC","ConsoleHandler"],ModuleName ["GHC","Constants"],ModuleName ["GHC","Desugar"],ModuleName ["GHC","Enum"],ModuleName ["GHC","Environment"],ModuleName ["GHC","Err"],ModuleName ["GHC","Exception"],ModuleName ["GHC","Exts"],ModuleName ["GHC","Float"],ModuleName ["GHC","ForeignPtr"],ModuleName ["GHC","MVar"],ModuleName ["GHC","IO"],ModuleName ["GHC","IO","IOMode"],ModuleName ["GHC","IO","Buffer"],ModuleName ["GHC","IO","Device"],ModuleName ["GHC","IO","BufferedIO"],ModuleName ["GHC","IO","FD"],ModuleName ["GHC","IO","Exception"],ModuleName ["GHC","IO","Encoding"],ModuleName ["GHC","IO","Encoding","Latin1"],ModuleName ["GHC","IO","Encoding","UTF8"],ModuleName ["GHC","IO","Encoding","UTF16"],ModuleName ["GHC","IO","Encoding","UTF32"],ModuleName ["GHC","IO","Encoding","Types"],ModuleName ["GHC","IO","Encoding","Iconv"],ModuleName ["GHC","IO","Encoding","CodePage"],ModuleName ["GHC","IO","Handle"],ModuleName ["GHC","IO","Handle","Types"],ModuleName ["GHC","IO","Handle","Internals"],ModuleName ["GHC","IO","Handle","FD"],ModuleName ["GHC","IO","Handle","Text"],ModuleName ["GHC","IOBase"],ModuleName ["GHC","Handle"],ModuleName ["GHC","IORef"],ModuleName ["GHC","IOArray"],ModuleName ["GHC","Int"],ModuleName ["GHC","List"],ModuleName ["GHC","Num"],ModuleName ["GHC","PArr"],ModuleName ["GHC","Pack"],ModuleName ["GHC","Ptr"],ModuleName ["GHC","Read"],ModuleName ["GHC","Real"],ModuleName ["GHC","ST"],ModuleName ["GHC","STRef"],ModuleName ["GHC","Show"],ModuleName ["GHC","Stable"],ModuleName ["GHC","Storable"],ModuleName ["GHC","TopHandler"],ModuleName ["GHC","Unicode"],ModuleName ["GHC","Weak"],ModuleName ["GHC","Word"],ModuleName ["System","Timeout"],ModuleName ["System","Event"],ModuleName ["Control","Applicative"],ModuleName ["Control","Arrow"],ModuleName ["Control","Category"],ModuleName ["Control","Concurrent"],ModuleName ["Control","Concurrent","Chan"],ModuleName ["Control","Concurrent","MVar"],ModuleName ["Control","Concurrent","QSem"],ModuleName ["Control","Concurrent","QSemN"],ModuleName ["Control","Concurrent","SampleVar"],ModuleName ["Control","Exception"],ModuleName ["Control","Exception","Base"],ModuleName ["Control","OldException"],ModuleName ["Control","Monad"],ModuleName ["Control","Monad","Fix"],ModuleName ["Control","Monad","Instances"],ModuleName ["Control","Monad","ST"],ModuleName ["Control","Monad","ST","Lazy"],ModuleName ["Control","Monad","ST","Strict"],ModuleName ["Data","Bits"],ModuleName ["Data","Bool"],ModuleName ["Data","Char"],ModuleName ["Data","Complex"],ModuleName ["Data","Dynamic"],ModuleName ["Data","Either"],ModuleName ["Data","Eq"],ModuleName ["Data","Data"],ModuleName ["Data","Fixed"],ModuleName ["Data","Foldable"],ModuleName ["Data","Function"],ModuleName ["Data","Functor"],ModuleName ["Data","HashTable"],ModuleName ["Data","IORef"],ModuleName ["Data","Int"],ModuleName ["Data","Ix"],ModuleName ["Data","List"],ModuleName ["Data","Maybe"],ModuleName ["Data","Monoid"],ModuleName ["Data","Ord"],ModuleName ["Data","Ratio"],ModuleName ["Data","STRef"],ModuleName ["Data","STRef","Lazy"],ModuleName ["Data","STRef","Strict"],ModuleName ["Data","String"],ModuleName ["Data","Traversable"],ModuleName ["Data","Tuple"],ModuleName ["Data","Typeable"],ModuleName ["Data","Unique"],ModuleName ["Data","Version"],ModuleName ["Data","Word"],ModuleName ["Debug","Trace"],ModuleName ["Foreign"],ModuleName ["Foreign","C"],ModuleName ["Foreign","C","Error"],ModuleName ["Foreign","C","String"],ModuleName ["Foreign","C","Types"],ModuleName ["Foreign","ForeignPtr"],ModuleName ["Foreign","Marshal"],ModuleName ["Foreign","Marshal","Alloc"],ModuleName ["Foreign","Marshal","Array"],ModuleName ["Foreign","Marshal","Error"],ModuleName ["Foreign","Marshal","Pool"],ModuleName ["Foreign","Marshal","Utils"],ModuleName ["Foreign","Ptr"],ModuleName ["Foreign","StablePtr"],ModuleName ["Foreign","Storable"],ModuleName ["Numeric"],ModuleName ["Prelude"],ModuleName ["System","Console","GetOpt"],ModuleName ["System","CPUTime"],ModuleName ["System","Environment"],ModuleName ["System","Exit"],ModuleName ["System","IO"],ModuleName ["System","IO","Error"],ModuleName ["System","IO","Unsafe"],ModuleName ["System","Info"],ModuleName ["System","Mem"],ModuleName ["System","Mem","StableName"],ModuleName ["System","Mem","Weak"],ModuleName ["System","Posix","Internals"],ModuleName ["System","Posix","Types"],ModuleName ["Text","ParserCombinators","ReadP"],ModuleName ["Text","ParserCombinators","ReadPrec"],ModuleName ["Text","Printf"],ModuleName ["Text","Read"],ModuleName ["Text","Read","Lex"],ModuleName ["Text","Show"],ModuleName ["Text","Show","Functions"],ModuleName ["Unsafe","Coerce"]], hiddenModules = [ModuleName ["System","Event","Array"],ModuleName ["System","Event","Clock"],ModuleName ["System","Event","Control"],ModuleName ["System","Event","EPoll"],ModuleName ["System","Event","IntMap"],ModuleName ["System","Event","Internal"],ModuleName ["System","Event","KQueue"],ModuleName ["System","Event","Manager"],ModuleName ["System","Event","PSQ"],ModuleName ["System","Event","Poll"],ModuleName ["System","Event","Thread"],ModuleName ["System","Event","Unique"]], importDirs = ["/usr/lib/ghc-7.0.3/base-4.3.1.0"], libraryDirs = ["/usr/lib/ghc-7.0.3/base-4.3.1.0"], hsLibraries = ["HSbase-4.3.1.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/ghc-7.0.3/base-4.3.1.0/include"], includes = ["HsBase.h"], depends = [InstalledPackageId "ghc-prim-0.2.0.0-d9df11f804556f362beb0ea4e67261ba",InstalledPackageId "integer-gmp-0.2.0.3-298c59ba68b7aaa7e76ae5b1fe5e876e",InstalledPackageId "builtin_rts"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/base-4.3.1.0/base.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/base-4.3.1.0"]}),(InstalledPackageId "binary-0.5.0.2-b471fd4ae9e6a992eed4cf652dba019b",InstalledPackageInfo {installedPackageId = InstalledPackageId "binary-0.5.0.2-b471fd4ae9e6a992eed4cf652dba019b", sourcePackageId = PackageIdentifier {pkgName = PackageName "binary", pkgVersion = Version {versionBranch = [0,5,0,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Lennart Kolmodin, Don Stewart <dons@galois.com>", author = "Lennart Kolmodin <kolmodin@dtek.chalmers.se>", stability = "provisional", homepage = "http://code.haskell.org/binary/", pkgUrl = "", description = "Efficient, pure binary serialisation using lazy ByteStrings.\nHaskell values may be encoded to and from binary formats,\nwritten to disk as binary, or sent over the network.\nSerialisation speeds of over 1 G\\/sec have been observed,\nso this library should be suitable for high performance\nscenarios.", category = "Data, Parsing", exposed = True, exposedModules = [ModuleName ["Data","Binary"],ModuleName ["Data","Binary","Put"],ModuleName ["Data","Binary","Get"],ModuleName ["Data","Binary","Builder"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/binary-0.5.0.2/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/binary-0.5.0.2/ghc-7.0.3"], hsLibraries = ["HSbinary-0.5.0.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/binary-0.5.0.2/binary.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-binary-doc/html/"]}),(InstalledPackageId "builtin_rts",InstalledPackageInfo {installedPackageId = InstalledPackageId "builtin_rts", sourcePackageId = PackageIdentifier {pkgName = PackageName "rts", pkgVersion = Version {versionBranch = [1,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "glasgow-haskell-users@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "", category = "", exposed = True, exposedModules = [], hiddenModules = [], importDirs = [], libraryDirs = ["/usr/lib/ghc-7.0.3"], hsLibraries = ["HSrts"], extraLibraries = ["ffi","m","rt","dl"], extraGHCiLibraries = [], includeDirs = ["/usr/lib/ghc-7.0.3/include"], includes = ["Stg.h"], depends = [], hugsOptions = [], ccOptions = [], ldOptions = ["-u","ghczmprim_GHCziTypes_Izh_static_info","-u","ghczmprim_GHCziTypes_Czh_static_info","-u","ghczmprim_GHCziTypes_Fzh_static_info","-u","ghczmprim_GHCziTypes_Dzh_static_info","-u","base_GHCziPtr_Ptr_static_info","-u","base_GHCziWord_Wzh_static_info","-u","base_GHCziInt_I8zh_static_info","-u","base_GHCziInt_I16zh_static_info","-u","base_GHCziInt_I32zh_static_info","-u","base_GHCziInt_I64zh_static_info","-u","base_GHCziWord_W8zh_static_info","-u","base_GHCziWord_W16zh_static_info","-u","base_GHCziWord_W32zh_static_info","-u","base_GHCziWord_W64zh_static_info","-u","base_GHCziStable_StablePtr_static_info","-u","ghczmprim_GHCziTypes_Izh_con_info","-u","ghczmprim_GHCziTypes_Czh_con_info","-u","ghczmprim_GHCziTypes_Fzh_con_info","-u","ghczmprim_GHCziTypes_Dzh_con_info","-u","base_GHCziPtr_Ptr_con_info","-u","base_GHCziPtr_FunPtr_con_info","-u","base_GHCziStable_StablePtr_con_info","-u","ghczmprim_GHCziBool_False_closure","-u","ghczmprim_GHCziBool_True_closure","-u","base_GHCziPack_unpackCString_closure","-u","base_GHCziIOziException_stackOverflow_closure","-u","base_GHCziIOziException_heapOverflow_closure","-u","base_ControlziExceptionziBase_nonTermination_closure","-u","base_GHCziIOziException_blockedIndefinitelyOnMVar_closure","-u","base_GHCziIOziException_blockedIndefinitelyOnSTM_closure","-u","base_ControlziExceptionziBase_nestedAtomically_closure","-u","base_GHCziWeak_runFinalizzerBatch_closure","-u","base_GHCziTopHandler_runIO_closure","-u","base_GHCziTopHandler_runNonIO_closure","-u","base_GHCziConcziIO_ensureIOManagerIsRunning_closure","-u","base_GHCziConcziSync_runSparks_closure","-u","base_GHCziConcziSignal_runHandlers_closure"], frameworkDirs = [], frameworks = [], haddockInterfaces = [], haddockHTMLs = []}),(InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageInfo {installedPackageId = InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4", sourcePackageId = PackageIdentifier {pkgName = PackageName "bytestring", pkgVersion = Version {versionBranch = [0,9,1,10], versionTags = []}}, license = BSD3, copyright = "Copyright (c) Don Stewart 2005-2009,\n(c) Duncan Coutts 2006-2009,\n(c) David Roundy 2003-2005.", maintainer = "dons@galois.com, duncan@haskell.org", author = "Don Stewart, Duncan Coutts", stability = "", homepage = "http://www.cse.unsw.edu.au/~dons/fps.html", pkgUrl = "", description = "A time and space-efficient implementation of byte vectors using\npacked Word8 arrays, suitable for high performance use, both in terms\nof large data quantities, or high speed requirements. Byte vectors\nare encoded as strict 'Word8' arrays of bytes, and lazy lists of\nstrict chunks, held in a 'ForeignPtr', and can be passed between C\nand Haskell with little effort.\n\nTest coverage data for this library is available at:\n<http://code.haskell.org/~dons/tests/bytestring/hpc_index.html>", category = "Data", exposed = True, exposedModules = [ModuleName ["Data","ByteString"],ModuleName ["Data","ByteString","Char8"],ModuleName ["Data","ByteString","Unsafe"],ModuleName ["Data","ByteString","Internal"],ModuleName ["Data","ByteString","Lazy"],ModuleName ["Data","ByteString","Lazy","Char8"],ModuleName ["Data","ByteString","Lazy","Internal"],ModuleName ["Data","ByteString","Fusion"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/bytestring-0.9.1.10"], libraryDirs = ["/usr/lib/ghc-7.0.3/bytestring-0.9.1.10"], hsLibraries = ["HSbytestring-0.9.1.10"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/ghc-7.0.3/bytestring-0.9.1.10/include"], includes = ["fpstring.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "ghc-prim-0.2.0.0-d9df11f804556f362beb0ea4e67261ba"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/bytestring-0.9.1.10/bytestring.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/bytestring-0.9.1.10"]}),(InstalledPackageId "cmdlib-0.3-30b0b48ba7f087d1e853499831429cfa",InstalledPackageInfo {installedPackageId = InstalledPackageId "cmdlib-0.3-30b0b48ba7f087d1e853499831429cfa", sourcePackageId = PackageIdentifier {pkgName = PackageName "cmdlib", pkgVersion = Version {versionBranch = [0,3], versionTags = []}}, license = BSD3, copyright = "", maintainer = "me@mornfall.net", author = "Petr Rockai", stability = "", homepage = "", pkgUrl = "", description = "A commandline parsing library, based on getopt. Comes with a\npowerful attribute system. Supports complex interfaces with many\noptions and commands, with option & command grouping, with simple\nand convenient API. Even though quite powerful, it strives to keep\nsimple things simple. The library uses \"System.Console.GetOpt\" as\nits backend.\n\nIn comparison to the other commandline handling libraries:\n\nCompared to cmdargs, cmdlib has a pure attribute system and is\nbased on GetOpt for help formatting & argument parsing. Cmdlib may\nalso be more extendable due to typeclass design, and can use\nuser-supplied types for option arguments.\n\nCmdargs >= 0.4 can optionally use a pure attribute system,\nalthough this is clearly an add-on and the API is a second-class\ncitizen in relation to the impure version.\n\nGetOpt and parseargs both require explicit flag representation, so\nthey live a level below cmdlib. GetOpt is in fact used as a\nbackend by cmdlib.", category = "System", exposed = True, exposedModules = [ModuleName ["System","Console","CmdLib"]], hiddenModules = [ModuleName ["System","Console","CmdLib","Attribute"],ModuleName ["System","Console","CmdLib","Flag"],ModuleName ["System","Console","CmdLib","Command"],ModuleName ["System","Console","CmdLib","ADTs"],ModuleName ["System","Console","CmdLib","Record"]], importDirs = ["/home/florent/.cabal/lib/cmdlib-0.3/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/cmdlib-0.3/ghc-7.0.3"], hsLibraries = ["HScmdlib-0.3"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b",InstalledPackageId "split-0.1.4-25b8dac0b87dfab6d3ad4b8a7e345e45",InstalledPackageId "syb-0.3-00d8c06f799942b01364e795b2a54d70"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/cmdlib-0.3/html/cmdlib.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/cmdlib-0.3/html"]}),(InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e",InstalledPackageInfo {installedPackageId = InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e", sourcePackageId = PackageIdentifier {pkgName = PackageName "containers", pkgVersion = Version {versionBranch = [0,4,0,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package contains efficient general-purpose implementations\nof various basic immutable container types. The declared cost of\neach operation is either worst-case or amortized, but remains\nvalid even if structures are shared.", category = "Data Structures", exposed = True, exposedModules = [ModuleName ["Data","Graph"],ModuleName ["Data","Sequence"],ModuleName ["Data","Tree"],ModuleName ["Data","IntMap"],ModuleName ["Data","IntSet"],ModuleName ["Data","Map"],ModuleName ["Data","Set"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/containers-0.4.0.0"], libraryDirs = ["/usr/lib/ghc-7.0.3/containers-0.4.0.0"], hsLibraries = ["HScontainers-0.4.0.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/containers-0.4.0.0/containers.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/containers-0.4.0.0"]}),(InstalledPackageId "dataenc-0.13.0.4-35faf9ef6ab96b77e6a414944a7a49d8",InstalledPackageInfo {installedPackageId = InstalledPackageId "dataenc-0.13.0.4-35faf9ef6ab96b77e6a414944a7a49d8", sourcePackageId = PackageIdentifier {pkgName = PackageName "dataenc", pkgVersion = Version {versionBranch = [0,13,0,4], versionTags = []}}, license = BSD3, copyright = "Magnus Therning, 2007-2009", maintainer = "magnus@therning.org", author = "Magnus Therning", stability = "", homepage = "http://www.haskell.org/haskellwiki/Library/Data_encoding", pkgUrl = "", description = "Data encoding library currently providing Base16, Base32,\nBase32Hex, Base64, Base64Url, Base85, Python string escaping,\nQuoted-Printable, URL encoding, uuencode, xxencode, and yEncoding.", category = "Codec", exposed = True, exposedModules = [ModuleName ["Codec","Binary","Base16"],ModuleName ["Codec","Binary","Base32"],ModuleName ["Codec","Binary","Base32Hex"],ModuleName ["Codec","Binary","Base64"],ModuleName ["Codec","Binary","Base64Url"],ModuleName ["Codec","Binary","Base85"],ModuleName ["Codec","Binary","DataEncoding"],ModuleName ["Codec","Binary","PythonString"],ModuleName ["Codec","Binary","QuotedPrintable"],ModuleName ["Codec","Binary","Url"],ModuleName ["Codec","Binary","Uu"],ModuleName ["Codec","Binary","Xx"],ModuleName ["Codec","Binary","Yenc"]], hiddenModules = [ModuleName ["Codec","Binary","Util"]], importDirs = ["/usr/lib/haskell-packages/ghc/lib/dataenc-0.13.0.4/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/dataenc-0.13.0.4/ghc-7.0.3"], hsLibraries = ["HSdataenc-0.13.0.4"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/dataenc-0.13.0.4/dataenc.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-dataenc-doc/html/"]}),(InstalledPackageId "deepseq-1.1.0.2-0465f803f7d27d264907e7e03e72a71f",InstalledPackageInfo {installedPackageId = InstalledPackageId "deepseq-1.1.0.2-0465f803f7d27d264907e7e03e72a71f", sourcePackageId = PackageIdentifier {pkgName = PackageName "deepseq", pkgVersion = Version {versionBranch = [1,1,0,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package provides methods for fully evaluating data structures\n(\\\"deep evaluation\\\"). Deep evaluation is often used for adding\nstrictness to a program, e.g. in order to force pending exceptions,\nremove space leaks, or force lazy I/O to happen. It is also useful\nin parallel programs, to ensure pending work does not migrate to the\nwrong thread.\n\nThe primary use of this package is via the 'deepseq' function, a\n\\\"deep\\\" version of 'seq'. It is implemented on top of an 'NFData'\ntypeclass (\\\"Normal Form Data\\\", data structures with no unevaluated\ncomponents) which defines strategies for fully evaluating different\ndata types.", category = "Control", exposed = True, exposedModules = [ModuleName ["Control","DeepSeq"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/deepseq-1.1.0.2/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/deepseq-1.1.0.2/ghc-7.0.3"], hsLibraries = ["HSdeepseq-1.1.0.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/deepseq-1.1.0.2/deepseq.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-deepseq-doc/html/"]}),(InstalledPackageId "directory-1.1.0.0-393d8e95f1c0dd6ee908e122f924ac85",InstalledPackageInfo {installedPackageId = InstalledPackageId "directory-1.1.0.0-393d8e95f1c0dd6ee908e122f924ac85", sourcePackageId = PackageIdentifier {pkgName = PackageName "directory", pkgVersion = Version {versionBranch = [1,1,0,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package provides a library for handling directories.", category = "System", exposed = True, exposedModules = [ModuleName ["System","Directory"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/directory-1.1.0.0"], libraryDirs = ["/usr/lib/ghc-7.0.3/directory-1.1.0.0"], hsLibraries = ["HSdirectory-1.1.0.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/ghc-7.0.3/directory-1.1.0.0/include"], includes = ["HsDirectory.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653",InstalledPackageId "old-time-1.0.0.6-7f15fd4b960098b2776b8c05bc17519f",InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/directory-1.1.0.0/directory.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/directory-1.1.0.0"]}),(InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831",InstalledPackageInfo {installedPackageId = InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831", sourcePackageId = PackageIdentifier {pkgName = PackageName "extensible-exceptions", pkgVersion = Version {versionBranch = [0,1,1,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package provides extensible exceptions for both new and\nold versions of GHC (i.e., < 6.10).", category = "Control", exposed = True, exposedModules = [ModuleName ["Control","Exception","Extensible"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/extensible-exceptions-0.1.1.2"], libraryDirs = ["/usr/lib/ghc-7.0.3/extensible-exceptions-0.1.1.2"], hsLibraries = ["HSextensible-exceptions-0.1.1.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/extensible-exceptions-0.1.1.2/extensible-exceptions.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/extensible-exceptions-0.1.1.2"]}),(InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653",InstalledPackageInfo {installedPackageId = InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653", sourcePackageId = PackageIdentifier {pkgName = PackageName "filepath", pkgVersion = Version {versionBranch = [1,2,0,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "", author = "Neil Mitchell", stability = "", homepage = "http://www-users.cs.york.ac.uk/~ndm/filepath/", pkgUrl = "", description = "", category = "System", exposed = True, exposedModules = [ModuleName ["System","FilePath"],ModuleName ["System","FilePath","Posix"],ModuleName ["System","FilePath","Windows"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/filepath-1.2.0.0"], libraryDirs = ["/usr/lib/ghc-7.0.3/filepath-1.2.0.0"], hsLibraries = ["HSfilepath-1.2.0.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/filepath-1.2.0.0/filepath.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/filepath-1.2.0.0"]}),(InstalledPackageId "ghc-prim-0.2.0.0-d9df11f804556f362beb0ea4e67261ba",InstalledPackageInfo {installedPackageId = InstalledPackageId "ghc-prim-0.2.0.0-d9df11f804556f362beb0ea4e67261ba", sourcePackageId = PackageIdentifier {pkgName = PackageName "ghc-prim", pkgVersion = Version {versionBranch = [0,2,0,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "GHC primitives.", category = "", exposed = True, exposedModules = [ModuleName ["GHC","Prim"],ModuleName ["GHC","Bool"],ModuleName ["GHC","Debug"],ModuleName ["GHC","Generics"],ModuleName ["GHC","Magic"],ModuleName ["GHC","Ordering"],ModuleName ["GHC","PrimopWrappers"],ModuleName ["GHC","IntWord32"],ModuleName ["GHC","IntWord64"],ModuleName ["GHC","Tuple"],ModuleName ["GHC","Types"],ModuleName ["GHC","Unit"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/ghc-prim-0.2.0.0"], libraryDirs = ["/usr/lib/ghc-7.0.3/ghc-prim-0.2.0.0"], hsLibraries = ["HSghc-prim-0.2.0.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "builtin_rts"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/ghc-prim-0.2.0.0/ghc-prim.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/ghc-prim-0.2.0.0"]}),(InstalledPackageId "hashed-storage-0.5.7-f2baae72d60d89cab6d2b5facd274d47",InstalledPackageInfo {installedPackageId = InstalledPackageId "hashed-storage-0.5.7-f2baae72d60d89cab6d2b5facd274d47", sourcePackageId = PackageIdentifier {pkgName = PackageName "hashed-storage", pkgVersion = Version {versionBranch = [0,5,7], versionTags = []}}, license = BSD3, copyright = "2009 Petr Rockai <me@mornfall.net>", maintainer = "Petr Rockai <me@mornfall.net>", author = "Petr Rockai <me@mornfall.net>", stability = "", homepage = "", pkgUrl = "", description = "Support code for reading and manipulating hashed file storage\n(where each file and directory is associated with a\ncryptographic hash, for corruption-resistant storage and fast\ncomparisons).\n\nThe supported storage formats include darcs hashed pristine, a\nplain filesystem tree and an indexed plain tree (where the index\nmaintains hashes of the plain files and directories).", category = "System", exposed = True, exposedModules = [ModuleName ["Storage","Hashed"],ModuleName ["Storage","Hashed","AnchoredPath"],ModuleName ["Storage","Hashed","Index"],ModuleName ["Storage","Hashed","Monad"],ModuleName ["Storage","Hashed","Tree"],ModuleName ["Storage","Hashed","Hash"],ModuleName ["Storage","Hashed","Packed"],ModuleName ["Storage","Hashed","Plain"],ModuleName ["Storage","Hashed","Darcs"]], hiddenModules = [ModuleName ["Bundled","Posix"],ModuleName ["Bundled","SHA256"],ModuleName ["Storage","Hashed","Utils"]], importDirs = ["/home/florent/.cabal/lib/hashed-storage-0.5.7/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/hashed-storage-0.5.7/ghc-7.0.3"], hsLibraries = ["HShashed-storage-0.5.7"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "binary-0.5.0.2-b471fd4ae9e6a992eed4cf652dba019b",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e",InstalledPackageId "dataenc-0.13.0.4-35faf9ef6ab96b77e6a414944a7a49d8",InstalledPackageId "directory-1.1.0.0-393d8e95f1c0dd6ee908e122f924ac85",InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831",InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653",InstalledPackageId "mmap-0.5.7-127e379f104e2b945de5325ba3158467",InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b",InstalledPackageId "zlib-0.5.3.1-7e19941cbd00147a79723e25160ffc8b"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/hashed-storage-0.5.7/html/hashed-storage.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/hashed-storage-0.5.7/html"]}),(InstalledPackageId "haskeline-0.6.4.0-ea83f091fcdad61446c62afc5c94a9ed",InstalledPackageInfo {installedPackageId = InstalledPackageId "haskeline-0.6.4.0-ea83f091fcdad61446c62afc5c94a9ed", sourcePackageId = PackageIdentifier {pkgName = PackageName "haskeline", pkgVersion = Version {versionBranch = [0,6,4,0], versionTags = []}}, license = BSD3, copyright = "(c) Judah Jacobson", maintainer = "Judah Jacobson <judah.jacobson@gmail.com>", author = "Judah Jacobson", stability = "Experimental", homepage = "http://trac.haskell.org/haskeline", pkgUrl = "", description = "Haskeline provides a user interface for line input in command-line\nprograms. This library is similar in purpose to readline, but since\nit is written in Haskell it is (hopefully) more easily used in other\nHaskell programs.\n\nHaskeline runs both on POSIX-compatible systems and on Windows.", category = "User Interfaces", exposed = True, exposedModules = [ModuleName ["System","Console","Haskeline"],ModuleName ["System","Console","Haskeline","Completion"],ModuleName ["System","Console","Haskeline","Encoding"],ModuleName ["System","Console","Haskeline","MonadException"],ModuleName ["System","Console","Haskeline","History"],ModuleName ["System","Console","Haskeline","IO"]], hiddenModules = [ModuleName ["System","Console","Haskeline","Backend","Terminfo"],ModuleName ["System","Console","Haskeline","Backend","WCWidth"],ModuleName ["System","Console","Haskeline","Backend","Posix"],ModuleName ["System","Console","Haskeline","Backend","IConv"],ModuleName ["System","Console","Haskeline","Backend","DumbTerm"],ModuleName ["System","Console","Haskeline","Backend"],ModuleName ["System","Console","Haskeline","Command"],ModuleName ["System","Console","Haskeline","Command","Completion"],ModuleName ["System","Console","Haskeline","Command","History"],ModuleName ["System","Console","Haskeline","Command","KillRing"],ModuleName ["System","Console","Haskeline","Directory"],ModuleName ["System","Console","Haskeline","Emacs"],ModuleName ["System","Console","Haskeline","InputT"],ModuleName ["System","Console","Haskeline","Key"],ModuleName ["System","Console","Haskeline","LineState"],ModuleName ["System","Console","Haskeline","Monads"],ModuleName ["System","Console","Haskeline","Prefs"],ModuleName ["System","Console","Haskeline","RunCommand"],ModuleName ["System","Console","Haskeline","Term"],ModuleName ["System","Console","Haskeline","Command","Undo"],ModuleName ["System","Console","Haskeline","Vi"]], importDirs = ["/usr/lib/haskell-packages/ghc/lib/haskeline-0.6.4.0/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/haskeline-0.6.4.0/ghc-7.0.3"], hsLibraries = ["HShaskeline-0.6.4.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/haskell-packages/ghc/lib/haskeline-0.6.4.0/ghc-7.0.3/include"], includes = ["h_iconv.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e",InstalledPackageId "directory-1.1.0.0-393d8e95f1c0dd6ee908e122f924ac85",InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831",InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653",InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b",InstalledPackageId "terminfo-0.3.1.3-d898a3b030f2d808d2a44c5ff0e2a0e1",InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff",InstalledPackageId "utf8-string-0.3.6-48af7e77f29b232f389e99d0a9a1d604"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/haskeline-0.6.4.0/haskeline.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-haskeline-doc/html/"]}),(InstalledPackageId "hostname-1.0-75071817127be63d3548cd759f6b627c",InstalledPackageInfo {installedPackageId = InstalledPackageId "hostname-1.0-75071817127be63d3548cd759f6b627c", sourcePackageId = PackageIdentifier {pkgName = PackageName "hostname", pkgVersion = Version {versionBranch = [1,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Max Bolingbroke <batterseapower@hotmail.com>", author = "Max Bolingbroke <batterseapower@hotmail.com>", stability = "", homepage = "", pkgUrl = "", description = "", category = "Network", exposed = True, exposedModules = [ModuleName ["Network","HostName"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/hostname-1.0/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/hostname-1.0/ghc-7.0.3"], hsLibraries = ["HShostname-1.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/hostname-1.0/html/hostname.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/hostname-1.0/html"]}),(InstalledPackageId "html-1.0.1.2-0cdd616c514cf10f5323f121a96991b6",InstalledPackageInfo {installedPackageId = InstalledPackageId "html-1.0.1.2-0cdd616c514cf10f5323f121a96991b6", sourcePackageId = PackageIdentifier {pkgName = PackageName "html", pkgVersion = Version {versionBranch = [1,0,1,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package contains a combinator library for constructing\nHTML documents.", category = "Web", exposed = True, exposedModules = [ModuleName ["Text","Html"],ModuleName ["Text","Html","BlockTable"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/html-1.0.1.2/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/html-1.0.1.2/ghc-7.0.3"], hsLibraries = ["HShtml-1.0.1.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/html-1.0.1.2/html.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-html-doc/html/"]}),(InstalledPackageId "integer-gmp-0.2.0.3-298c59ba68b7aaa7e76ae5b1fe5e876e",InstalledPackageInfo {installedPackageId = InstalledPackageId "integer-gmp-0.2.0.3-298c59ba68b7aaa7e76ae5b1fe5e876e", sourcePackageId = PackageIdentifier {pkgName = PackageName "integer-gmp", pkgVersion = Version {versionBranch = [0,2,0,3], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package contains an Integer library based on GMP.", category = "", exposed = True, exposedModules = [ModuleName ["GHC","Integer"],ModuleName ["GHC","Integer","GMP","Internals"]], hiddenModules = [ModuleName ["GHC","Integer","Type"]], importDirs = ["/usr/lib/ghc-7.0.3/integer-gmp-0.2.0.3"], libraryDirs = ["/usr/lib/ghc-7.0.3/integer-gmp-0.2.0.3"], hsLibraries = ["HSinteger-gmp-0.2.0.3"], extraLibraries = ["gmp"], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "ghc-prim-0.2.0.0-d9df11f804556f362beb0ea4e67261ba"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/integer-gmp-0.2.0.3/integer-gmp.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/integer-gmp-0.2.0.3"]}),(InstalledPackageId "mmap-0.5.7-127e379f104e2b945de5325ba3158467",InstalledPackageInfo {installedPackageId = InstalledPackageId "mmap-0.5.7-127e379f104e2b945de5325ba3158467", sourcePackageId = PackageIdentifier {pkgName = PackageName "mmap", pkgVersion = Version {versionBranch = [0,5,7], versionTags = []}}, license = BSD3, copyright = "2008, Gracjan Polak", maintainer = "Gracjan Polak <gracjanpolak@gmail.com>", author = "Gracjan Polak <gracjanpolak@gmail.com>", stability = "alpha", homepage = "", pkgUrl = "", description = "This library provides a wrapper to mmap(2) or MapViewOfFile,\nallowing files or devices to be lazily loaded into memory as\nstrict or lazy ByteStrings, ForeignPtrs or plain Ptrs, using\nthe virtual memory subsystem to do on-demand loading.\nModifications are also supported.", category = "System", exposed = True, exposedModules = [ModuleName ["System","IO","MMap"]], hiddenModules = [], importDirs = ["/usr/local/lib/mmap-0.5.7/ghc-7.0.3"], libraryDirs = ["/usr/local/lib/mmap-0.5.7/ghc-7.0.3"], hsLibraries = ["HSmmap-0.5.7"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/local/share/doc/mmap-0.5.7/html/mmap.haddock"], haddockHTMLs = ["/usr/local/share/doc/mmap-0.5.7/html"]}),(InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b",InstalledPackageInfo {installedPackageId = InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b", sourcePackageId = PackageIdentifier {pkgName = PackageName "mtl", pkgVersion = Version {versionBranch = [2,0,1,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "Andy Gill", stability = "", homepage = "", pkgUrl = "", description = "Monad classes using functional dependencies, with instances\nfor various monad transformers, inspired by the paper\n/Functional Programming with Overloading and Higher-Order Polymorphism/,\nby Mark P Jones, in /Advanced School of Functional Programming/, 1995\n(<http://web.cecs.pdx.edu/~mpj/pubs/springschool.html>).", category = "Control", exposed = True, exposedModules = [ModuleName ["Control","Monad","Cont"],ModuleName ["Control","Monad","Cont","Class"],ModuleName ["Control","Monad","Error"],ModuleName ["Control","Monad","Error","Class"],ModuleName ["Control","Monad","Identity"],ModuleName ["Control","Monad","List"],ModuleName ["Control","Monad","RWS"],ModuleName ["Control","Monad","RWS","Class"],ModuleName ["Control","Monad","RWS","Lazy"],ModuleName ["Control","Monad","RWS","Strict"],ModuleName ["Control","Monad","Reader"],ModuleName ["Control","Monad","Reader","Class"],ModuleName ["Control","Monad","State"],ModuleName ["Control","Monad","State","Class"],ModuleName ["Control","Monad","State","Lazy"],ModuleName ["Control","Monad","State","Strict"],ModuleName ["Control","Monad","Trans"],ModuleName ["Control","Monad","Writer"],ModuleName ["Control","Monad","Writer","Class"],ModuleName ["Control","Monad","Writer","Lazy"],ModuleName ["Control","Monad","Writer","Strict"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/mtl-2.0.1.0/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/mtl-2.0.1.0/ghc-7.0.3"], hsLibraries = ["HSmtl-2.0.1.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "transformers-0.2.2.0-4bbbfde1fb5c4eb17cdb1963dda698f3"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/mtl-2.0.1.0/mtl.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-mtl-doc/html/"]}),(InstalledPackageId "network-2.3.0.2-824dddd7e2ce0e065568730d1c080c4a",InstalledPackageInfo {installedPackageId = InstalledPackageId "network-2.3.0.2-824dddd7e2ce0e065568730d1c080c4a", sourcePackageId = PackageIdentifier {pkgName = PackageName "network", pkgVersion = Version {versionBranch = [2,3,0,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Johan Tibell <johan.tibell@gmail.com>", author = "", stability = "", homepage = "http://github.com/haskell/network", pkgUrl = "", description = "Low-level networking interface", category = "Network", exposed = True, exposedModules = [ModuleName ["Network"],ModuleName ["Network","BSD"],ModuleName ["Network","Socket"],ModuleName ["Network","Socket","ByteString"],ModuleName ["Network","Socket","ByteString","Lazy"],ModuleName ["Network","Socket","Internal"],ModuleName ["Network","URI"]], hiddenModules = [ModuleName ["Network","Socket","ByteString","IOVec"],ModuleName ["Network","Socket","ByteString","MsgHdr"],ModuleName ["Network","Socket","ByteString","Internal"]], importDirs = ["/usr/lib/haskell-packages/ghc/lib/network-2.3.0.2/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/network-2.3.0.2/ghc-7.0.3"], hsLibraries = ["HSnetwork-2.3.0.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/haskell-packages/ghc/lib/network-2.3.0.2/ghc-7.0.3/include"], includes = ["HsNet.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "parsec-3.1.1-33474162d2bbd21ea1e4f1e3830243d8",InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/network-2.3.0.2/network.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-network-doc/html/"]}),(InstalledPackageId "old-locale-1.0.0.2-161f79060c89cc16ca11576ceb440486",InstalledPackageInfo {installedPackageId = InstalledPackageId "old-locale-1.0.0.2-161f79060c89cc16ca11576ceb440486", sourcePackageId = PackageIdentifier {pkgName = PackageName "old-locale", pkgVersion = Version {versionBranch = [1,0,0,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package provides the old locale library.\nFor new code, the new locale library is recommended.", category = "System", exposed = True, exposedModules = [ModuleName ["System","Locale"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/old-locale-1.0.0.2"], libraryDirs = ["/usr/lib/ghc-7.0.3/old-locale-1.0.0.2"], hsLibraries = ["HSold-locale-1.0.0.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/old-locale-1.0.0.2/old-locale.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/old-locale-1.0.0.2"]}),(InstalledPackageId "old-time-1.0.0.6-7f15fd4b960098b2776b8c05bc17519f",InstalledPackageInfo {installedPackageId = InstalledPackageId "old-time-1.0.0.6-7f15fd4b960098b2776b8c05bc17519f", sourcePackageId = PackageIdentifier {pkgName = PackageName "old-time", pkgVersion = Version {versionBranch = [1,0,0,6], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package provides the old time library.\nFor new code, the new time library is recommended.", category = "System", exposed = True, exposedModules = [ModuleName ["System","Time"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/old-time-1.0.0.6"], libraryDirs = ["/usr/lib/ghc-7.0.3/old-time-1.0.0.6"], hsLibraries = ["HSold-time-1.0.0.6"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/ghc-7.0.3/old-time-1.0.0.6/include"], includes = ["HsTime.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "old-locale-1.0.0.2-161f79060c89cc16ca11576ceb440486"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/old-time-1.0.0.6/old-time.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/old-time-1.0.0.6"]}),(InstalledPackageId "parsec-3.1.1-33474162d2bbd21ea1e4f1e3830243d8",InstalledPackageInfo {installedPackageId = InstalledPackageId "parsec-3.1.1-33474162d2bbd21ea1e4f1e3830243d8", sourcePackageId = PackageIdentifier {pkgName = PackageName "parsec", pkgVersion = Version {versionBranch = [3,1,1], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Antoine Latter <aslatter@gmail.com>", author = "Daan Leijen <daan@microsoft.com>, Paolo Martini <paolo@nemail.it>", stability = "", homepage = "http://www.cs.uu.nl/~daan/parsec.html", pkgUrl = "", description = "Parsec is designed from scratch as an industrial-strength parser\nlibrary. It is simple, safe, well documented (on the package\nhomepage), has extensive libraries and good error messages,\nand is also fast. It is defined as a monad transformer that can be\nstacked on arbitrary monads, and it is also parametric in the\ninput stream type.", category = "Parsing", exposed = True, exposedModules = [ModuleName ["Text","Parsec"],ModuleName ["Text","Parsec","String"],ModuleName ["Text","Parsec","ByteString"],ModuleName ["Text","Parsec","ByteString","Lazy"],ModuleName ["Text","Parsec","Pos"],ModuleName ["Text","Parsec","Error"],ModuleName ["Text","Parsec","Prim"],ModuleName ["Text","Parsec","Char"],ModuleName ["Text","Parsec","Combinator"],ModuleName ["Text","Parsec","Token"],ModuleName ["Text","Parsec","Expr"],ModuleName ["Text","Parsec","Language"],ModuleName ["Text","Parsec","Perm"],ModuleName ["Text","ParserCombinators","Parsec"],ModuleName ["Text","ParserCombinators","Parsec","Char"],ModuleName ["Text","ParserCombinators","Parsec","Combinator"],ModuleName ["Text","ParserCombinators","Parsec","Error"],ModuleName ["Text","ParserCombinators","Parsec","Expr"],ModuleName ["Text","ParserCombinators","Parsec","Language"],ModuleName ["Text","ParserCombinators","Parsec","Perm"],ModuleName ["Text","ParserCombinators","Parsec","Pos"],ModuleName ["Text","ParserCombinators","Parsec","Prim"],ModuleName ["Text","ParserCombinators","Parsec","Token"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/parsec-3.1.1/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/parsec-3.1.1/ghc-7.0.3"], hsLibraries = ["HSparsec-3.1.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/parsec3-3.1.1/parsec.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-parsec3-doc/html/"]}),(InstalledPackageId "pretty-1.0.1.2-f8dc299a95cc94a3e513e27c5b80f951",InstalledPackageInfo {installedPackageId = InstalledPackageId "pretty-1.0.1.2-f8dc299a95cc94a3e513e27c5b80f951", sourcePackageId = PackageIdentifier {pkgName = PackageName "pretty", pkgVersion = Version {versionBranch = [1,0,1,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package contains John Hughes's pretty-printing library,\nheavily modified by Simon Peyton Jones.", category = "Text", exposed = True, exposedModules = [ModuleName ["Text","PrettyPrint"],ModuleName ["Text","PrettyPrint","HughesPJ"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/pretty-1.0.1.2"], libraryDirs = ["/usr/lib/ghc-7.0.3/pretty-1.0.1.2"], hsLibraries = ["HSpretty-1.0.1.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/pretty-1.0.1.2/pretty.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/pretty-1.0.1.2"]}),(InstalledPackageId "primitive-0.3.1-c9e4468cc744c0e030467f8c31383955",InstalledPackageInfo {installedPackageId = InstalledPackageId "primitive-0.3.1-c9e4468cc744c0e030467f8c31383955", sourcePackageId = PackageIdentifier {pkgName = PackageName "primitive", pkgVersion = Version {versionBranch = [0,3,1], versionTags = []}}, license = BSD3, copyright = "(c) Roman Leshchinskiy 2009-2010", maintainer = "Roman Leshchinskiy <rl@cse.unsw.edu.au>", author = "Roman Leshchinskiy <rl@cse.unsw.edu.au>", stability = "", homepage = "http://code.haskell.org/primitive", pkgUrl = "", description = ".\nThis package provides wrappers for primitive array operations from\nGHC.Prim.", category = "Data", exposed = True, exposedModules = [ModuleName ["Control","Monad","Primitive"],ModuleName ["Data","Primitive"],ModuleName ["Data","Primitive","MachDeps"],ModuleName ["Data","Primitive","Types"],ModuleName ["Data","Primitive","Array"],ModuleName ["Data","Primitive","ByteArray"],ModuleName ["Data","Primitive","Addr"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/primitive-0.3.1/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/primitive-0.3.1/ghc-7.0.3"], hsLibraries = ["HSprimitive-0.3.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/haskell-packages/ghc/lib/primitive-0.3.1/ghc-7.0.3/include"], includes = ["primitive-memops.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "ghc-prim-0.2.0.0-d9df11f804556f362beb0ea4e67261ba"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/primitive-0.3.1/primitive.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-primitive-doc/html/"]}),(InstalledPackageId "process-1.0.1.5-da4848a2eec47420cd09fe9edba7e83c",InstalledPackageInfo {installedPackageId = InstalledPackageId "process-1.0.1.5-da4848a2eec47420cd09fe9edba7e83c", sourcePackageId = PackageIdentifier {pkgName = PackageName "process", pkgVersion = Version {versionBranch = [1,0,1,5], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package contains libraries for dealing with system processes.", category = "System", exposed = True, exposedModules = [ModuleName ["System","Process","Internals"],ModuleName ["System","Process"],ModuleName ["System","Cmd"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/process-1.0.1.5"], libraryDirs = ["/usr/lib/ghc-7.0.3/process-1.0.1.5"], hsLibraries = ["HSprocess-1.0.1.5"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/ghc-7.0.3/process-1.0.1.5/include"], includes = ["runProcess.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "directory-1.1.0.0-393d8e95f1c0dd6ee908e122f924ac85",InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653",InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/process-1.0.1.5/process.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/process-1.0.1.5"]}),(InstalledPackageId "random-1.0.0.3-7511feaba03eecc22356464da8976c7e",InstalledPackageInfo {installedPackageId = InstalledPackageId "random-1.0.0.3-7511feaba03eecc22356464da8976c7e", sourcePackageId = PackageIdentifier {pkgName = PackageName "random", pkgVersion = Version {versionBranch = [1,0,0,3], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package provides a random number library.", category = "System", exposed = True, exposedModules = [ModuleName ["System","Random"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/random-1.0.0.3"], libraryDirs = ["/usr/lib/ghc-7.0.3/random-1.0.0.3"], hsLibraries = ["HSrandom-1.0.0.3"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "time-1.2.0.3-3493203919ef238f1a58223fa55b1ceb"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/random-1.0.0.3/random.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/random-1.0.0.3"]}),(InstalledPackageId "regex-base-0.93.2-ea22834f5565d6f16b2cec3e7a63917a",InstalledPackageInfo {installedPackageId = InstalledPackageId "regex-base-0.93.2-ea22834f5565d6f16b2cec3e7a63917a", sourcePackageId = PackageIdentifier {pkgName = PackageName "regex-base", pkgVersion = Version {versionBranch = [0,93,2], versionTags = []}}, license = BSD3, copyright = "Copyright (c) 2006, Christopher Kuklewicz", maintainer = "TextRegexLazy@personal.mightyreason.com", author = "Christopher Kuklewicz", stability = "Seems to work, passes a few tests", homepage = "http://sourceforge.net/projects/lazy-regex", pkgUrl = "http://darcs.haskell.org/packages/regex-unstable/regex-base/", description = "Interface API for regex-posix,pcre,parsec,tdfa,dfa", category = "Text", exposed = True, exposedModules = [ModuleName ["Text","Regex","Base"],ModuleName ["Text","Regex","Base","RegexLike"],ModuleName ["Text","Regex","Base","Context"],ModuleName ["Text","Regex","Base","Impl"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/regex-base-0.93.2/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/regex-base-0.93.2/ghc-7.0.3"], hsLibraries = ["HSregex-base-0.93.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e",InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/regex-base-0.93.2/regex-base.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-regex-base-doc/html/"]}),(InstalledPackageId "regex-compat-0.95.1-3e607bc84f3c3925033bb247b8ebab65",InstalledPackageInfo {installedPackageId = InstalledPackageId "regex-compat-0.95.1-3e607bc84f3c3925033bb247b8ebab65", sourcePackageId = PackageIdentifier {pkgName = PackageName "regex-compat", pkgVersion = Version {versionBranch = [0,95,1], versionTags = []}}, license = BSD3, copyright = "Copyright (c) 2006, Christopher Kuklewicz", maintainer = "TextRegexLazy@personal.mightyreason.com", author = "Christopher Kuklewicz", stability = "Seems to work, passes a few tests", homepage = "http://sourceforge.net/projects/lazy-regex", pkgUrl = "http://darcs.haskell.org/packages/regex-unstable/regex-compat/", description = "One module layer over regex-posix to replace Text.Regex", category = "Text", exposed = True, exposedModules = [ModuleName ["Text","Regex"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/regex-compat-0.95.1/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/regex-compat-0.95.1/ghc-7.0.3"], hsLibraries = ["HSregex-compat-0.95.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "regex-base-0.93.2-ea22834f5565d6f16b2cec3e7a63917a",InstalledPackageId "regex-posix-0.95.1-a7a63b8d8d2c01aa7eca73b4f7221d81"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/regex-compat-0.95.1/html/regex-compat.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/regex-compat-0.95.1/html"]}),(InstalledPackageId "regex-posix-0.95.1-a7a63b8d8d2c01aa7eca73b4f7221d81",InstalledPackageInfo {installedPackageId = InstalledPackageId "regex-posix-0.95.1-a7a63b8d8d2c01aa7eca73b4f7221d81", sourcePackageId = PackageIdentifier {pkgName = PackageName "regex-posix", pkgVersion = Version {versionBranch = [0,95,1], versionTags = []}}, license = BSD3, copyright = "Copyright (c) 2007-2010, Christopher Kuklewicz", maintainer = "TextRegexLazy@personal.mightyreason.com", author = "Christopher Kuklewicz", stability = "Seems to work, passes a few tests", homepage = "http://sourceforge.net/projects/lazy-regex", pkgUrl = "http://code.haskell.org/regex-posix/", description = "The posix regex backend for regex-base", category = "Text", exposed = True, exposedModules = [ModuleName ["Text","Regex","Posix"],ModuleName ["Text","Regex","Posix","Wrap"],ModuleName ["Text","Regex","Posix","String"],ModuleName ["Text","Regex","Posix","Sequence"],ModuleName ["Text","Regex","Posix","ByteString"],ModuleName ["Text","Regex","Posix","ByteString","Lazy"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/regex-posix-0.95.1/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/regex-posix-0.95.1/ghc-7.0.3"], hsLibraries = ["HSregex-posix-0.95.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e",InstalledPackageId "regex-base-0.93.2-ea22834f5565d6f16b2cec3e7a63917a"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/regex-posix-0.95.1/html/regex-posix.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/regex-posix-0.95.1/html"]}),(InstalledPackageId "shellish-0.1.4-5b908e0ef83b4d4990e862a2d582acb1",InstalledPackageInfo {installedPackageId = InstalledPackageId "shellish-0.1.4-5b908e0ef83b4d4990e862a2d582acb1", sourcePackageId = PackageIdentifier {pkgName = PackageName "shellish", pkgVersion = Version {versionBranch = [0,1,4], versionTags = []}}, license = BSD3, copyright = "", maintainer = "me@mornfall.net", author = "Petr Rockai <me@mornfall.net>", stability = "", homepage = "http://repos.mornfall.net/shellish", pkgUrl = "", description = "The shellisg package provides a single module for convenient\n\\\"systems\\\" programming in Haskell, similar in spirit to POSIX\nshells or PERL.\n\n* Elegance and safety is sacrificed for conciseness and\nswiss-army-knife-ness.\n\n* The interface exported by Shellish is thread-safe.\n\nOverall, the module should help you to get a job done quickly,\nwithout getting too dirty.", category = "Development", exposed = True, exposedModules = [ModuleName ["Shellish"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/shellish-0.1.4/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/shellish-0.1.4/ghc-7.0.3"], hsLibraries = ["HSshellish-0.1.4"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "directory-1.1.0.0-393d8e95f1c0dd6ee908e122f924ac85",InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653",InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b",InstalledPackageId "process-1.0.1.5-da4848a2eec47420cd09fe9edba7e83c",InstalledPackageId "strict-0.3.2-0f622b96a8041532e7c92ccfb057496f",InstalledPackageId "time-1.2.0.3-3493203919ef238f1a58223fa55b1ceb",InstalledPackageId "unix-compat-0.2.1.1-dd8ef5a3a99896df43dc15cc23b08467"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/shellish-0.1.4/html/shellish.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/shellish-0.1.4/html"]}),(InstalledPackageId "split-0.1.4-25b8dac0b87dfab6d3ad4b8a7e345e45",InstalledPackageInfo {installedPackageId = InstalledPackageId "split-0.1.4-25b8dac0b87dfab6d3ad4b8a7e345e45", sourcePackageId = PackageIdentifier {pkgName = PackageName "split", pkgVersion = Version {versionBranch = [0,1,4], versionTags = []}}, license = BSD3, copyright = "", maintainer = "byorgey@cis.upenn.edu", author = "Brent Yorgey", stability = "stable", homepage = "http://code.haskell.org/~byorgey/code/split", pkgUrl = "", description = "Combinator library and utility functions for splitting lists.", category = "List", exposed = True, exposedModules = [ModuleName ["Data","List","Split"],ModuleName ["Data","List","Split","Internals"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/split-0.1.4/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/split-0.1.4/ghc-7.0.3"], hsLibraries = ["HSsplit-0.1.4"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/split-0.1.4/html/split.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/split-0.1.4/html"]}),(InstalledPackageId "strict-0.3.2-0f622b96a8041532e7c92ccfb057496f",InstalledPackageInfo {installedPackageId = InstalledPackageId "strict-0.3.2-0f622b96a8041532e7c92ccfb057496f", sourcePackageId = PackageIdentifier {pkgName = PackageName "strict", pkgVersion = Version {versionBranch = [0,3,2], versionTags = []}}, license = BSD3, copyright = "(c) 2006-2007 by Roman Leshchinskiy", maintainer = "Don Stewart <dons@galois.com>", author = "Roman Leshchinskiy <rl@cse.unsw.edu.au>", stability = "", homepage = "http://www.cse.unsw.edu.au/~rl/code/strict.html", pkgUrl = "", description = "This package provides strict versions of some standard Haskell data\ntypes (pairs, Maybe and Either). It also contains strict IO\noperations.", category = "Data, System", exposed = True, exposedModules = [ModuleName ["Data","Strict","Tuple"],ModuleName ["Data","Strict","Maybe"],ModuleName ["Data","Strict","Either"],ModuleName ["Data","Strict"],ModuleName ["System","IO","Strict"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/strict-0.3.2/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/strict-0.3.2/ghc-7.0.3"], hsLibraries = ["HSstrict-0.3.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/strict-0.3.2/html/strict.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/strict-0.3.2/html"]}),(InstalledPackageId "syb-0.3-00d8c06f799942b01364e795b2a54d70",InstalledPackageInfo {installedPackageId = InstalledPackageId "syb-0.3-00d8c06f799942b01364e795b2a54d70", sourcePackageId = PackageIdentifier {pkgName = PackageName "syb", pkgVersion = Version {versionBranch = [0,3], versionTags = []}}, license = BSD3, copyright = "", maintainer = "generics@haskell.org", author = "Ralf Lammel, Simon Peyton Jones", stability = "provisional", homepage = "http://www.cs.uu.nl/wiki/GenericProgramming/SYB", pkgUrl = "", description = "This package contains the generics system described in the\n/Scrap Your Boilerplate/ papers (see\n<http://www.cs.uu.nl/wiki/GenericProgramming/SYB>).\nIt defines the @Data@ class of types permitting folding and unfolding\nof constructor applications, instances of this class for primitive\ntypes, and a variety of traversals.", category = "Generics", exposed = True, exposedModules = [ModuleName ["Data","Generics"],ModuleName ["Data","Generics","Basics"],ModuleName ["Data","Generics","Instances"],ModuleName ["Data","Generics","Aliases"],ModuleName ["Data","Generics","Schemes"],ModuleName ["Data","Generics","Text"],ModuleName ["Data","Generics","Twins"],ModuleName ["Data","Generics","Builders"],ModuleName ["Generics","SYB"],ModuleName ["Generics","SYB","Basics"],ModuleName ["Generics","SYB","Instances"],ModuleName ["Generics","SYB","Aliases"],ModuleName ["Generics","SYB","Schemes"],ModuleName ["Generics","SYB","Text"],ModuleName ["Generics","SYB","Twins"],ModuleName ["Generics","SYB","Builders"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/syb-0.3/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/syb-0.3/ghc-7.0.3"], hsLibraries = ["HSsyb-0.3"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/syb-0.3/syb.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-syb-doc/html/"]}),(InstalledPackageId "tar-0.3.1.0-e78ec4eae84b755f8263c8666140ed0b",InstalledPackageInfo {installedPackageId = InstalledPackageId "tar-0.3.1.0-e78ec4eae84b755f8263c8666140ed0b", sourcePackageId = PackageIdentifier {pkgName = PackageName "tar", pkgVersion = Version {versionBranch = [0,3,1,0], versionTags = []}}, license = BSD3, copyright = "2007 Bjorn Bringert <bjorn@bringert.net>\n2008-2009 Duncan Coutts <duncan@haskell.org>", maintainer = "Duncan Coutts <duncan@haskell.org>", author = "Bjorn Bringert <bjorn@bringert.net>\nDuncan Coutts <duncan@haskell.org>", stability = "", homepage = "", pkgUrl = "", description = "This library is for working with \\\"@.tar@\\\" archive files. It\ncan read and write a range of common variations of archive\nformat including V7, USTAR, POSIX and GNU formats. It provides\nsupport for packing and unpacking portable archives. This\nmakes it suitable for distribution but not backup because\ndetails like file ownership and exact permissions are not\npreserved.", category = "Codec", exposed = True, exposedModules = [ModuleName ["Codec","Archive","Tar"],ModuleName ["Codec","Archive","Tar","Entry"],ModuleName ["Codec","Archive","Tar","Check"]], hiddenModules = [ModuleName ["Codec","Archive","Tar","Types"],ModuleName ["Codec","Archive","Tar","Read"],ModuleName ["Codec","Archive","Tar","Write"],ModuleName ["Codec","Archive","Tar","Pack"],ModuleName ["Codec","Archive","Tar","Unpack"]], importDirs = ["/usr/lib/haskell-packages/ghc/lib/tar-0.3.1.0/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/tar-0.3.1.0/ghc-7.0.3"], hsLibraries = ["HStar-0.3.1.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "directory-1.1.0.0-393d8e95f1c0dd6ee908e122f924ac85",InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653",InstalledPackageId "old-time-1.0.0.6-7f15fd4b960098b2776b8c05bc17519f"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/tar-0.3.1.0/tar.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-tar-doc/html/"]}),(InstalledPackageId "template-haskell-2.5.0.0-957162165c2e6480a35f6d14f7e5220f",InstalledPackageInfo {installedPackageId = InstalledPackageId "template-haskell-2.5.0.0-957162165c2e6480a35f6d14f7e5220f", sourcePackageId = PackageIdentifier {pkgName = PackageName "template-haskell", pkgVersion = Version {versionBranch = [2,5,0,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "Facilities for manipulating Haskell source code using Template Haskell.", category = "", exposed = True, exposedModules = [ModuleName ["Language","Haskell","TH","Syntax","Internals"],ModuleName ["Language","Haskell","TH","Syntax"],ModuleName ["Language","Haskell","TH","PprLib"],ModuleName ["Language","Haskell","TH","Ppr"],ModuleName ["Language","Haskell","TH","Lib"],ModuleName ["Language","Haskell","TH","Quote"],ModuleName ["Language","Haskell","TH"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/template-haskell-2.5.0.0"], libraryDirs = ["/usr/lib/ghc-7.0.3/template-haskell-2.5.0.0"], hsLibraries = ["HStemplate-haskell-2.5.0.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e",InstalledPackageId "pretty-1.0.1.2-f8dc299a95cc94a3e513e27c5b80f951"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/template-haskell-2.5.0.0/template-haskell.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/template-haskell-2.5.0.0"]}),(InstalledPackageId "terminfo-0.3.1.3-d898a3b030f2d808d2a44c5ff0e2a0e1",InstalledPackageInfo {installedPackageId = InstalledPackageId "terminfo-0.3.1.3-d898a3b030f2d808d2a44c5ff0e2a0e1", sourcePackageId = PackageIdentifier {pkgName = PackageName "terminfo", pkgVersion = Version {versionBranch = [0,3,1,3], versionTags = []}}, license = BSD3, copyright = "(c) Judah Jacobson", maintainer = "Judah Jacobson <judah.jacobson@gmail.com>", author = "Judah Jacobson", stability = "Experimental", homepage = "http://code.haskell.org/terminfo", pkgUrl = "", description = "This library provides an interface to the terminfo database (via bindings to the\ncurses library). Terminfo allows POSIX systems to interact with a variety of terminals\nusing a standard set of capabilities.", category = "User Interfaces", exposed = True, exposedModules = [ModuleName ["System","Console","Terminfo"],ModuleName ["System","Console","Terminfo","Base"],ModuleName ["System","Console","Terminfo","Cursor"],ModuleName ["System","Console","Terminfo","Color"],ModuleName ["System","Console","Terminfo","Edit"],ModuleName ["System","Console","Terminfo","Effects"],ModuleName ["System","Console","Terminfo","Keys"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/terminfo-0.3.1.3/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/terminfo-0.3.1.3/ghc-7.0.3"], hsLibraries = ["HSterminfo-0.3.1.3"], extraLibraries = ["ncurses"], extraGHCiLibraries = [], includeDirs = [], includes = ["ncurses.h","term.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/terminfo-0.3.1.3/terminfo.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-terminfo-doc/html/"]}),(InstalledPackageId "test-framework-0.4.0-3570e5fce12246859c27f7b4577044ed",InstalledPackageInfo {installedPackageId = InstalledPackageId "test-framework-0.4.0-3570e5fce12246859c27f7b4577044ed", sourcePackageId = PackageIdentifier {pkgName = PackageName "test-framework", pkgVersion = Version {versionBranch = [0,4,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Max Bolingbroke <batterseapower@hotmail.com>", author = "Max Bolingbroke <batterseapower@hotmail.com>", stability = "", homepage = "http://batterseapower.github.com/test-framework/", pkgUrl = "", description = "Allows tests such as QuickCheck properties and HUnit test cases to be assembled into test groups, run in\nparallel (but reported in deterministic order, to aid diff interpretation) and filtered and controlled by\ncommand line options. All of this comes with colored test output, progress reporting and test statistics output.", category = "Testing", exposed = True, exposedModules = [ModuleName ["Test","Framework"],ModuleName ["Test","Framework","Options"],ModuleName ["Test","Framework","Providers","API"],ModuleName ["Test","Framework","Runners","Console"],ModuleName ["Test","Framework","Runners","Options"],ModuleName ["Test","Framework","Seed"]], hiddenModules = [ModuleName ["Test","Framework","Core"],ModuleName ["Test","Framework","Improving"],ModuleName ["Test","Framework","Runners","Console","Colors"],ModuleName ["Test","Framework","Runners","Console","ProgressBar"],ModuleName ["Test","Framework","Runners","Console","Run"],ModuleName ["Test","Framework","Runners","Console","Statistics"],ModuleName ["Test","Framework","Runners","Console","Table"],ModuleName ["Test","Framework","Runners","Console","Utilities"],ModuleName ["Test","Framework","Runners","Core"],ModuleName ["Test","Framework","Runners","Processors"],ModuleName ["Test","Framework","Runners","Statistics"],ModuleName ["Test","Framework","Runners","TestPattern"],ModuleName ["Test","Framework","Runners","ThreadPool"],ModuleName ["Test","Framework","Runners","TimedConsumption"],ModuleName ["Test","Framework","Runners","XML","JUnitWriter"],ModuleName ["Test","Framework","Runners","XML"],ModuleName ["Test","Framework","Utilities"]], importDirs = ["/home/florent/.cabal/lib/test-framework-0.4.0/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/test-framework-0.4.0/ghc-7.0.3"], hsLibraries = ["HStest-framework-0.4.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "ansi-terminal-0.5.5-572a1d0154fb2632bb4e9431adf0cdb1",InstalledPackageId "ansi-wl-pprint-0.6.3-e572fb77d5bf7bcb04a7444a9b54f822",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e",InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831",InstalledPackageId "hostname-1.0-75071817127be63d3548cd759f6b627c",InstalledPackageId "old-locale-1.0.0.2-161f79060c89cc16ca11576ceb440486",InstalledPackageId "random-1.0.0.3-7511feaba03eecc22356464da8976c7e",InstalledPackageId "regex-posix-0.95.1-a7a63b8d8d2c01aa7eca73b4f7221d81",InstalledPackageId "time-1.2.0.3-3493203919ef238f1a58223fa55b1ceb",InstalledPackageId "xml-1.3.8-f68d711e0aeaecb47b69c384ed0ad21a"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/test-framework-0.4.0/html/test-framework.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/test-framework-0.4.0/html"]}),(InstalledPackageId "test-framework-hunit-0.2.6-ca043988073add792f5cddeb80a08ce9",InstalledPackageInfo {installedPackageId = InstalledPackageId "test-framework-hunit-0.2.6-ca043988073add792f5cddeb80a08ce9", sourcePackageId = PackageIdentifier {pkgName = PackageName "test-framework-hunit", pkgVersion = Version {versionBranch = [0,2,6], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Max Bolingbroke <batterseapower@hotmail.com>", author = "Max Bolingbroke <batterseapower@hotmail.com>", stability = "", homepage = "http://batterseapower.github.com/test-framework/", pkgUrl = "", description = "", category = "Testing", exposed = True, exposedModules = [ModuleName ["Test","Framework","Providers","HUnit"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/test-framework-hunit-0.2.6/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/test-framework-hunit-0.2.6/ghc-7.0.3"], hsLibraries = ["HStest-framework-hunit-0.2.6"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "HUnit-1.2.2.3-8fe95e501b1318ef285c39ed79ca4209",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831",InstalledPackageId "test-framework-0.4.0-3570e5fce12246859c27f7b4577044ed"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/test-framework-hunit-0.2.6/html/test-framework-hunit.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/test-framework-hunit-0.2.6/html"]}),(InstalledPackageId "test-framework-quickcheck2-0.2.10-48c3729ab4f2ea19741d59800542207a",InstalledPackageInfo {installedPackageId = InstalledPackageId "test-framework-quickcheck2-0.2.10-48c3729ab4f2ea19741d59800542207a", sourcePackageId = PackageIdentifier {pkgName = PackageName "test-framework-quickcheck2", pkgVersion = Version {versionBranch = [0,2,10], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Max Bolingbroke <batterseapower@hotmail.com>", author = "Max Bolingbroke <batterseapower@hotmail.com>", stability = "", homepage = "http://batterseapower.github.com/test-framework/", pkgUrl = "", description = "", category = "Testing", exposed = True, exposedModules = [ModuleName ["Test","Framework","Providers","QuickCheck2"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/test-framework-quickcheck2-0.2.10/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/test-framework-quickcheck2-0.2.10/ghc-7.0.3"], hsLibraries = ["HStest-framework-quickcheck2-0.2.10"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "QuickCheck-2.4.1.1-6b2df10756c9ae534bddffc57c532df8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831",InstalledPackageId "random-1.0.0.3-7511feaba03eecc22356464da8976c7e",InstalledPackageId "test-framework-0.4.0-3570e5fce12246859c27f7b4577044ed"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/test-framework-quickcheck2-0.2.10/html/test-framework-quickcheck2.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/test-framework-quickcheck2-0.2.10/html"]}),(InstalledPackageId "text-0.11.0.6-139d7472dd2398472c7d962de013c741",InstalledPackageInfo {installedPackageId = InstalledPackageId "text-0.11.0.6-139d7472dd2398472c7d962de013c741", sourcePackageId = PackageIdentifier {pkgName = PackageName "text", pkgVersion = Version {versionBranch = [0,11,0,6], versionTags = []}}, license = BSD3, copyright = "2008-2009 Tom Harper, 2009-2010 Bryan O'Sullivan", maintainer = "Bryan O'Sullivan <bos@serpentine.com>\nTom Harper <rtomharper@googlemail.com>\nDuncan Coutts <duncan@haskell.org>", author = "Bryan O'Sullivan <bos@serpentine.com>", stability = "", homepage = "http://bitbucket.org/bos/text", pkgUrl = "", description = ".\nAn efficient packed, immutable Unicode text type (both strict and\nlazy), with a powerful loop fusion optimization framework.\n\nThe 'Text' type represents Unicode character strings, in a time and\nspace-efficient manner. This package provides text processing\ncapabilities that are optimized for performance critical use, both\nin terms of large data quantities and high speed.\n\nThe 'Text' type provides character-encoding, type-safe case\nconversion via whole-string case conversion functions. It also\nprovides a range of functions for converting 'Text' values to and from\n'ByteStrings', using several standard encodings.\n\nEfficient locale-sensitive support for text IO is also supported.\n\nThese modules are intended to be imported qualified, to avoid name\nclashes with Prelude functions, e.g.\n\n> import qualified Data.Text as T\n\nTo use an extended and very rich family of functions for working\nwith Unicode text (including normalization, regular expressions,\nnon-standard encodings, text breaking, and locales), see\nthe @text-icu@ package:\n<http://hackage.haskell.org/package/text-icu>", category = "Data, Text", exposed = True, exposedModules = [ModuleName ["Data","Text"],ModuleName ["Data","Text","Array"],ModuleName ["Data","Text","Encoding"],ModuleName ["Data","Text","Encoding","Error"],ModuleName ["Data","Text","Foreign"],ModuleName ["Data","Text","IO"],ModuleName ["Data","Text","Internal"],ModuleName ["Data","Text","Lazy"],ModuleName ["Data","Text","Lazy","Builder"],ModuleName ["Data","Text","Lazy","Encoding"],ModuleName ["Data","Text","Lazy","IO"],ModuleName ["Data","Text","Lazy","Internal"],ModuleName ["Data","Text","Lazy","Read"],ModuleName ["Data","Text","Read"]], hiddenModules = [ModuleName ["Data","Text","Encoding","Fusion"],ModuleName ["Data","Text","Encoding","Fusion","Common"],ModuleName ["Data","Text","Encoding","Utf16"],ModuleName ["Data","Text","Encoding","Utf32"],ModuleName ["Data","Text","Encoding","Utf8"],ModuleName ["Data","Text","Fusion"],ModuleName ["Data","Text","Fusion","CaseMapping"],ModuleName ["Data","Text","Fusion","Common"],ModuleName ["Data","Text","Fusion","Internal"],ModuleName ["Data","Text","Fusion","Size"],ModuleName ["Data","Text","IO","Internal"],ModuleName ["Data","Text","Lazy","Encoding","Fusion"],ModuleName ["Data","Text","Lazy","Fusion"],ModuleName ["Data","Text","Lazy","Search"],ModuleName ["Data","Text","Search"],ModuleName ["Data","Text","Unsafe"],ModuleName ["Data","Text","UnsafeChar"],ModuleName ["Data","Text","UnsafeShift"],ModuleName ["Data","Text","Util"]], importDirs = ["/usr/lib/haskell-packages/ghc/lib/text-0.11.0.6/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/text-0.11.0.6/ghc-7.0.3"], hsLibraries = ["HStext-0.11.0.6"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "deepseq-1.1.0.2-0465f803f7d27d264907e7e03e72a71f",InstalledPackageId "ghc-prim-0.2.0.0-d9df11f804556f362beb0ea4e67261ba"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/text-0.11.0.6/text.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-text-doc/html/"]}),(InstalledPackageId "time-1.2.0.3-3493203919ef238f1a58223fa55b1ceb",InstalledPackageInfo {installedPackageId = InstalledPackageId "time-1.2.0.3-3493203919ef238f1a58223fa55b1ceb", sourcePackageId = PackageIdentifier {pkgName = PackageName "time", pkgVersion = Version {versionBranch = [1,2,0,3], versionTags = []}}, license = BSD3, copyright = "", maintainer = "<ashley@semantic.org>", author = "Ashley Yakeley", stability = "stable", homepage = "http://semantic.org/TimeLib/", pkgUrl = "", description = "A time library", category = "System", exposed = True, exposedModules = [ModuleName ["Data","Time","Calendar"],ModuleName ["Data","Time","Calendar","MonthDay"],ModuleName ["Data","Time","Calendar","OrdinalDate"],ModuleName ["Data","Time","Calendar","WeekDate"],ModuleName ["Data","Time","Calendar","Julian"],ModuleName ["Data","Time","Calendar","Easter"],ModuleName ["Data","Time","Clock"],ModuleName ["Data","Time","Clock","POSIX"],ModuleName ["Data","Time","Clock","TAI"],ModuleName ["Data","Time","LocalTime"],ModuleName ["Data","Time","Format"],ModuleName ["Data","Time"]], hiddenModules = [ModuleName ["Data","Time","Calendar","Private"],ModuleName ["Data","Time","Calendar","Days"],ModuleName ["Data","Time","Calendar","Gregorian"],ModuleName ["Data","Time","Calendar","JulianYearDay"],ModuleName ["Data","Time","Clock","Scale"],ModuleName ["Data","Time","Clock","UTC"],ModuleName ["Data","Time","Clock","CTimeval"],ModuleName ["Data","Time","Clock","UTCDiff"],ModuleName ["Data","Time","LocalTime","TimeZone"],ModuleName ["Data","Time","LocalTime","TimeOfDay"],ModuleName ["Data","Time","LocalTime","LocalTime"],ModuleName ["Data","Time","Format","Parse"]], importDirs = ["/usr/lib/ghc-7.0.3/time-1.2.0.3"], libraryDirs = ["/usr/lib/ghc-7.0.3/time-1.2.0.3"], hsLibraries = ["HStime-1.2.0.3"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/ghc-7.0.3/time-1.2.0.3/include"], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "old-locale-1.0.0.2-161f79060c89cc16ca11576ceb440486"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/time-1.2.0.3/time.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/time-1.2.0.3"]}),(InstalledPackageId "transformers-0.2.2.0-4bbbfde1fb5c4eb17cdb1963dda698f3",InstalledPackageInfo {installedPackageId = InstalledPackageId "transformers-0.2.2.0-4bbbfde1fb5c4eb17cdb1963dda698f3", sourcePackageId = PackageIdentifier {pkgName = PackageName "transformers", pkgVersion = Version {versionBranch = [0,2,2,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Ross Paterson <ross@soi.city.ac.uk>", author = "Andy Gill, Ross Paterson", stability = "", homepage = "", pkgUrl = "", description = "Haskell 98 part of a monad transformer library, inspired by the paper\n\\\"Functional Programming with Overloading and Higher-Order Polymorphism\\\",\nby Mark P Jones, in /Advanced School of Functional Programming/, 1995\n(<http://web.cecs.pdx.edu/~mpj/pubs/springschool.html>).\n\nThis part contains the monad transformer class, the concrete monad\ntransformers, operations and liftings. It can be used on its own\nin Haskell 98 code, or with the monad classes in the @monads-fd@ or\n@monads-tf@ packages, which automatically lift operations introduced\nby monad transformers through other transformers.", category = "Control", exposed = True, exposedModules = [ModuleName ["Control","Monad","IO","Class"],ModuleName ["Control","Monad","Trans","Class"],ModuleName ["Control","Monad","Trans","Cont"],ModuleName ["Control","Monad","Trans","Error"],ModuleName ["Control","Monad","Trans","Identity"],ModuleName ["Control","Monad","Trans","List"],ModuleName ["Control","Monad","Trans","Maybe"],ModuleName ["Control","Monad","Trans","Reader"],ModuleName ["Control","Monad","Trans","RWS"],ModuleName ["Control","Monad","Trans","RWS","Lazy"],ModuleName ["Control","Monad","Trans","RWS","Strict"],ModuleName ["Control","Monad","Trans","State"],ModuleName ["Control","Monad","Trans","State","Lazy"],ModuleName ["Control","Monad","Trans","State","Strict"],ModuleName ["Control","Monad","Trans","Writer"],ModuleName ["Control","Monad","Trans","Writer","Lazy"],ModuleName ["Control","Monad","Trans","Writer","Strict"],ModuleName ["Data","Functor","Compose"],ModuleName ["Data","Functor","Constant"],ModuleName ["Data","Functor","Identity"],ModuleName ["Data","Functor","Product"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/transformers-0.2.2.0/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/transformers-0.2.2.0/ghc-7.0.3"], hsLibraries = ["HStransformers-0.2.2.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/transformers-0.2.2.0/transformers.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-transformers-doc/html/"]}),(InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff",InstalledPackageInfo {installedPackageId = InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff", sourcePackageId = PackageIdentifier {pkgName = PackageName "unix", pkgVersion = Version {versionBranch = [2,4,2,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package gives you access to the set of operating system\nservices standardised by POSIX 1003.1b (or the IEEE Portable\nOperating System Interface for Computing Environments -\nIEEE Std. 1003.1).\n\nThe package is not supported under Windows (except under Cygwin).", category = "System", exposed = True, exposedModules = [ModuleName ["System","Posix"],ModuleName ["System","Posix","DynamicLinker","Module"],ModuleName ["System","Posix","DynamicLinker","Prim"],ModuleName ["System","Posix","Directory"],ModuleName ["System","Posix","DynamicLinker"],ModuleName ["System","Posix","Env"],ModuleName ["System","Posix","Error"],ModuleName ["System","Posix","Files"],ModuleName ["System","Posix","IO"],ModuleName ["System","Posix","Process"],ModuleName ["System","Posix","Process","Internals"],ModuleName ["System","Posix","Resource"],ModuleName ["System","Posix","Temp"],ModuleName ["System","Posix","Terminal"],ModuleName ["System","Posix","Time"],ModuleName ["System","Posix","Unistd"],ModuleName ["System","Posix","User"],ModuleName ["System","Posix","Signals"],ModuleName ["System","Posix","Signals","Exts"],ModuleName ["System","Posix","Semaphore"],ModuleName ["System","Posix","SharedMem"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/unix-2.4.2.0"], libraryDirs = ["/usr/lib/ghc-7.0.3/unix-2.4.2.0"], hsLibraries = ["HSunix-2.4.2.0"], extraLibraries = ["rt","util","dl","pthread"], extraGHCiLibraries = [], includeDirs = ["/usr/lib/ghc-7.0.3/unix-2.4.2.0/include"], includes = ["HsUnix.h","execvpe.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/unix-2.4.2.0/unix.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/unix-2.4.2.0"]}),(InstalledPackageId "unix-compat-0.2.1.1-dd8ef5a3a99896df43dc15cc23b08467",InstalledPackageInfo {installedPackageId = InstalledPackageId "unix-compat-0.2.1.1-dd8ef5a3a99896df43dc15cc23b08467", sourcePackageId = PackageIdentifier {pkgName = PackageName "unix-compat", pkgVersion = Version {versionBranch = [0,2,1,1], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Jacob Stanley <jacob@stanley.io>", author = "Bj\246rn Bringert, Duncan Coutts, Jacob Stanley", stability = "", homepage = "http://github.com/jystic/unix-compat", pkgUrl = "", description = "This package provides portable implementations of parts\nof the unix package. This package re-exports the unix\npackage when available. When it isn't available,\nportable implementations are used.", category = "System", exposed = True, exposedModules = [ModuleName ["System","PosixCompat"],ModuleName ["System","PosixCompat","Extensions"],ModuleName ["System","PosixCompat","Files"],ModuleName ["System","PosixCompat","Time"],ModuleName ["System","PosixCompat","Types"],ModuleName ["System","PosixCompat","User"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/unix-compat-0.2.1.1/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/unix-compat-0.2.1.1/ghc-7.0.3"], hsLibraries = ["HSunix-compat-0.2.1.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/home/florent/.cabal/lib/unix-compat-0.2.1.1/ghc-7.0.3/include"], includes = ["HsUnixCompat.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/unix-compat-0.2.1.1/html/unix-compat.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/unix-compat-0.2.1.1/html"]}),(InstalledPackageId "utf8-string-0.3.6-48af7e77f29b232f389e99d0a9a1d604",InstalledPackageInfo {installedPackageId = InstalledPackageId "utf8-string-0.3.6-48af7e77f29b232f389e99d0a9a1d604", sourcePackageId = PackageIdentifier {pkgName = PackageName "utf8-string", pkgVersion = Version {versionBranch = [0,3,6], versionTags = []}}, license = BSD3, copyright = "", maintainer = "emertens@galois.com", author = "Eric Mertens", stability = "", homepage = "http://github.com/glguy/utf8-string/", pkgUrl = "", description = "A UTF8 layer for IO and Strings. The utf8-string\npackage provides operations for encoding UTF8\nstrings to Word8 lists and back, and for reading and\nwriting UTF8 without truncation.", category = "Codec", exposed = True, exposedModules = [ModuleName ["Codec","Binary","UTF8","String"],ModuleName ["Codec","Binary","UTF8","Generic"],ModuleName ["System","IO","UTF8"],ModuleName ["System","Environment","UTF8"],ModuleName ["Data","String","UTF8"],ModuleName ["Data","ByteString","UTF8"],ModuleName ["Data","ByteString","Lazy","UTF8"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/utf8-string-0.3.6/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/utf8-string-0.3.6/ghc-7.0.3"], hsLibraries = ["HSutf8-string-0.3.6"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/utf8-string-0.3.6/utf8-string.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-utf8-string-doc/html/"]}),(InstalledPackageId "vector-0.7.0.1-f3d66d9edbfc37118398d6cdca0ca5ee",InstalledPackageInfo {installedPackageId = InstalledPackageId "vector-0.7.0.1-f3d66d9edbfc37118398d6cdca0ca5ee", sourcePackageId = PackageIdentifier {pkgName = PackageName "vector", pkgVersion = Version {versionBranch = [0,7,0,1], versionTags = []}}, license = BSD3, copyright = "(c) Roman Leshchinskiy 2008-2010", maintainer = "Roman Leshchinskiy <rl@cse.unsw.edu.au>", author = "Roman Leshchinskiy <rl@cse.unsw.edu.au>", stability = "", homepage = "http://code.haskell.org/vector", pkgUrl = "", description = ".\nAn efficient implementation of Int-indexed arrays (both mutable\nand immutable), with a powerful loop fusion optimization framework .\n\nIt is structured as follows:\n\n[@Data.Vector@] Boxed vectors of arbitrary types.\n\n[@Data.Vector.Unboxed@] Unboxed vectors with an adaptive\nrepresentation based on data type families.\n\n[@Data.Vector.Storable@] Unboxed vectors of 'Storable' types.\n\n[@Data.Vector.Primitive@] Unboxed vectors of primitive types as\ndefined by the @primitive@ package. @Data.Vector.Unboxed@ is more\nflexible at no performance cost.\n\n[@Data.Vector.Generic@] Generic interface to the vector types.\n\nThere is also a (draft) tutorial on common uses of vector.\n\n* <http://haskell.org/haskellwiki/Numeric_Haskell:_A_Vector_Tutorial>\n\nPlease use the project trac to submit bug reports and feature\nrequests.\n\n* <http://trac.haskell.org/vector>\n\nChanges in version 0.7.0.1\n\n* Dependency on package ghc removed\n\nChanges in version 0.7\n\n* New functions for freezing, copying and thawing vectors: @freeze@,\n@thaw@, @unsafeThaw@ and @clone@\n\n* @newWith@ and @newUnsafeWith@ on mutable vectors replaced by\n@replicate@\n\n* New function: @concat@\n\n* New function for safe indexing: @(!?)@\n\n* @Monoid@ instances for all vector types\n\n* Significant recycling and fusion improvements\n\n* Bug fixes\n\n* Support for GHC 7.0", category = "Data, Data Structures", exposed = True, exposedModules = [ModuleName ["Data","Vector","Internal","Check"],ModuleName ["Data","Vector","Fusion","Util"],ModuleName ["Data","Vector","Fusion","Stream","Size"],ModuleName ["Data","Vector","Fusion","Stream","Monadic"],ModuleName ["Data","Vector","Fusion","Stream"],ModuleName ["Data","Vector","Generic","Mutable"],ModuleName ["Data","Vector","Generic","Base"],ModuleName ["Data","Vector","Generic","New"],ModuleName ["Data","Vector","Generic"],ModuleName ["Data","Vector","Primitive","Mutable"],ModuleName ["Data","Vector","Primitive"],ModuleName ["Data","Vector","Storable","Internal"],ModuleName ["Data","Vector","Storable","Mutable"],ModuleName ["Data","Vector","Storable"],ModuleName ["Data","Vector","Unboxed","Base"],ModuleName ["Data","Vector","Unboxed","Mutable"],ModuleName ["Data","Vector","Unboxed"],ModuleName ["Data","Vector","Mutable"],ModuleName ["Data","Vector"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/vector-0.7.0.1/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/vector-0.7.0.1/ghc-7.0.3"], hsLibraries = ["HSvector-0.7.0.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/haskell-packages/ghc/lib/vector-0.7.0.1/ghc-7.0.3/include"], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "primitive-0.3.1-c9e4468cc744c0e030467f8c31383955"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/vector-0.7.0.1/vector.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-vector-doc/html/"]}),(InstalledPackageId "xml-1.3.8-f68d711e0aeaecb47b69c384ed0ad21a",InstalledPackageInfo {installedPackageId = InstalledPackageId "xml-1.3.8-f68d711e0aeaecb47b69c384ed0ad21a", sourcePackageId = PackageIdentifier {pkgName = PackageName "xml", pkgVersion = Version {versionBranch = [1,3,8], versionTags = []}}, license = BSD3, copyright = "(c) 2007-2008 Galois Inc.", maintainer = "diatchki@galois.com", author = "Galois Inc.", stability = "", homepage = "http://code.galois.com", pkgUrl = "", description = "A simple XML library.", category = "Text, XML", exposed = True, exposedModules = [ModuleName ["Text","XML","Light"],ModuleName ["Text","XML","Light","Types"],ModuleName ["Text","XML","Light","Output"],ModuleName ["Text","XML","Light","Input"],ModuleName ["Text","XML","Light","Lexer"],ModuleName ["Text","XML","Light","Proc"],ModuleName ["Text","XML","Light","Cursor"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/xml-1.3.8/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/xml-1.3.8/ghc-7.0.3"], hsLibraries = ["HSxml-1.3.8"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/xml-1.3.8/html/xml.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/xml-1.3.8/html"]}),(InstalledPackageId "zlib-0.5.3.1-7e19941cbd00147a79723e25160ffc8b",InstalledPackageInfo {installedPackageId = InstalledPackageId "zlib-0.5.3.1-7e19941cbd00147a79723e25160ffc8b", sourcePackageId = PackageIdentifier {pkgName = PackageName "zlib", pkgVersion = Version {versionBranch = [0,5,3,1], versionTags = []}}, license = BSD3, copyright = "(c) 2006-2008 Duncan Coutts", maintainer = "Duncan Coutts <duncan@community.haskell.org>", author = "Duncan Coutts <duncan@community.haskell.org>", stability = "", homepage = "", pkgUrl = "", description = "This package provides a pure interface for compressing and\ndecompressing streams of data represented as lazy\n'ByteString's. It uses the zlib C library so it has high\nperformance. It supports the \\\"zlib\\\", \\\"gzip\\\" and \\\"raw\\\"\ncompression formats.\n\nIt provides a convenient high level API suitable for most\ntasks and for the few cases where more control is needed it\nprovides access to the full zlib feature set.", category = "Codec", exposed = True, exposedModules = [ModuleName ["Codec","Compression","GZip"],ModuleName ["Codec","Compression","Zlib"],ModuleName ["Codec","Compression","Zlib","Raw"],ModuleName ["Codec","Compression","Zlib","Internal"]], hiddenModules = [ModuleName ["Codec","Compression","Zlib","Stream"]], importDirs = ["/usr/lib/haskell-packages/ghc/lib/zlib-0.5.3.1/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/zlib-0.5.3.1/ghc-7.0.3"], hsLibraries = ["HSzlib-0.5.3.1"], extraLibraries = ["z"], extraGHCiLibraries = [], includeDirs = [], includes = ["zlib.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/zlib-0.5.3.1/zlib.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-zlib-doc/html/"]})]) (fromList [(PackageName "HTTP",fromList [(Version {versionBranch = [4000,1,1], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "HTTP-4000.1.1-e1c3272cf0835ac9d10671ed8dc862f9", sourcePackageId = PackageIdentifier {pkgName = PackageName "HTTP", pkgVersion = Version {versionBranch = [4000,1,1], versionTags = []}}, license = BSD3, copyright = "Copyright (c) 2002, Warrick Gray\nCopyright (c) 2002-2005, Ian Lynagh\nCopyright (c) 2003-2006, Bjorn Bringert\nCopyright (c) 2004, Andre Furtado\nCopyright (c) 2004, Ganesh Sittampalam\nCopyright (c) 2004-2005, Dominic Steinitz\nCopyright 2007 Robin Bate Boerop\nCopyright 2008- Sigbjorn Finne", maintainer = "Ganesh Sittampalam <ganesh@earth.li>", author = "Warrick Gray <warrick.gray@hotmail.com>", stability = "", homepage = "http://projects.haskell.org/http/", pkgUrl = "", description = "The HTTP package supports client-side web programming in Haskell. It lets you set up\nHTTP connections, transmitting requests and processing the responses coming back, all\nfrom within the comforts of Haskell. It's dependent on the network package to operate,\nbut other than that, the implementation is all written in Haskell.\n\nA basic API for issuing single HTTP requests + receiving responses is provided. On top\nof that, a session-level abstraction is also on offer (the @BrowserAction@ monad);\nit taking care of handling the management of persistent connections, proxies,\nstate (cookies) and authentication credentials required to handle multi-step\ninteractions with a web server.\n\nThe representation of the bytes flowing across is extensible via the use of a type class,\nletting you pick the representation of requests and responses that best fits your use.\nSome pre-packaged, common instances are provided for you (@ByteString@, @String@.)\n\nHere's an example use:\n\n>\n> do\n> rsp <- Network.HTTP.simpleHTTP (getRequest \"http://www.haskell.org/\")\n> -- fetch document and return it (as a 'String'.)\n> fmap (take 100) (getResponseBody rsp)\n>\n> do\n> rsp <- Network.Browser.browse $ do\n> setAllowRedirects True -- handle HTTP redirects\n> request $ getRequest \"http://google.com/\"\n> fmap (take 100) (getResponseBody rsp)\n>\n\nGit repository available at <git://github.com/haskell/HTTP.git>", category = "Network", exposed = True, exposedModules = [ModuleName ["Network","BufferType"],ModuleName ["Network","Stream"],ModuleName ["Network","StreamDebugger"],ModuleName ["Network","StreamSocket"],ModuleName ["Network","TCP"],ModuleName ["Network","HTTP"],ModuleName ["Network","HTTP","Headers"],ModuleName ["Network","HTTP","Base"],ModuleName ["Network","HTTP","Stream"],ModuleName ["Network","HTTP","Auth"],ModuleName ["Network","HTTP","Cookie"],ModuleName ["Network","HTTP","Proxy"],ModuleName ["Network","HTTP","HandleStream"],ModuleName ["Network","Browser"]], hiddenModules = [ModuleName ["Network","HTTP","Base64"],ModuleName ["Network","HTTP","MD5"],ModuleName ["Network","HTTP","MD5Aux"],ModuleName ["Network","HTTP","Utils"]], importDirs = ["/home/florent/.cabal/lib/HTTP-4000.1.1/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/HTTP-4000.1.1/ghc-7.0.3"], hsLibraries = ["HSHTTP-4000.1.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b",InstalledPackageId "network-2.3.0.2-824dddd7e2ce0e065568730d1c080c4a",InstalledPackageId "old-time-1.0.0.6-7f15fd4b960098b2776b8c05bc17519f",InstalledPackageId "parsec-3.1.1-33474162d2bbd21ea1e4f1e3830243d8"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/HTTP-4000.1.1/html/HTTP.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/HTTP-4000.1.1/html"]}])]),(PackageName "HUnit",fromList [(Version {versionBranch = [1,2,2,3], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "HUnit-1.2.2.3-8fe95e501b1318ef285c39ed79ca4209", sourcePackageId = PackageIdentifier {pkgName = PackageName "HUnit", pkgVersion = Version {versionBranch = [1,2,2,3], versionTags = []}}, license = BSD3, copyright = "", maintainer = "hunit@richardg.name", author = "Dean Herington", stability = "stable", homepage = "http://hunit.sourceforge.net/", pkgUrl = "", description = "HUnit is a unit testing framework for Haskell, inspired by the\nJUnit tool for Java, see: <http://www.junit.org>.", category = "Testing", exposed = True, exposedModules = [ModuleName ["Test","HUnit","Base"],ModuleName ["Test","HUnit","Lang"],ModuleName ["Test","HUnit","Terminal"],ModuleName ["Test","HUnit","Text"],ModuleName ["Test","HUnit"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/HUnit-1.2.2.3/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/HUnit-1.2.2.3/ghc-7.0.3"], hsLibraries = ["HSHUnit-1.2.2.3"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/hunit-1.2.2.3/HUnit.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-hunit-doc/html/"]}])]),(PackageName "QuickCheck",fromList [(Version {versionBranch = [2,4,1,1], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "QuickCheck-2.4.1.1-6b2df10756c9ae534bddffc57c532df8", sourcePackageId = PackageIdentifier {pkgName = PackageName "QuickCheck", pkgVersion = Version {versionBranch = [2,4,1,1], versionTags = []}}, license = BSD3, copyright = "2000-2011 Koen Claessen, 2006-2008 Bj\246rn Bringert, 2009-2011 Nick Smallbone", maintainer = "QuickCheck developers <quickcheck@projects.haskell.org>", author = "Koen Claessen <koen@chalmers.se>", stability = "", homepage = "http://code.haskell.org/QuickCheck", pkgUrl = "", description = "QuickCheck is a library for random testing of program properties.\n\nThe programmer provides a specification of the program, in\nthe form of properties which functions should satisfy, and\nQuickCheck then tests that the properties hold in a large number\nof randomly generated cases.\n\nSpecifications are expressed in\nHaskell, using combinators defined in the QuickCheck library.\nQuickCheck provides combinators to define properties, observe\nthe distribution of test data, and define test\ndata generators.", category = "Testing", exposed = True, exposedModules = [ModuleName ["Test","QuickCheck","All"],ModuleName ["Test","QuickCheck","Function"],ModuleName ["Test","QuickCheck"],ModuleName ["Test","QuickCheck","Arbitrary"],ModuleName ["Test","QuickCheck","Gen"],ModuleName ["Test","QuickCheck","Monadic"],ModuleName ["Test","QuickCheck","Modifiers"],ModuleName ["Test","QuickCheck","Property"],ModuleName ["Test","QuickCheck","Test"],ModuleName ["Test","QuickCheck","Text"],ModuleName ["Test","QuickCheck","Poly"],ModuleName ["Test","QuickCheck","State"]], hiddenModules = [ModuleName ["Test","QuickCheck","Exception"]], importDirs = ["/usr/lib/haskell-packages/ghc/lib/QuickCheck-2.4.1.1/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/QuickCheck-2.4.1.1/ghc-7.0.3"], hsLibraries = ["HSQuickCheck-2.4.1.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831",InstalledPackageId "random-1.0.0.3-7511feaba03eecc22356464da8976c7e",InstalledPackageId "template-haskell-2.5.0.0-957162165c2e6480a35f6d14f7e5220f"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/quickcheck2-2.4.1.1/QuickCheck.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-quickcheck2-doc/html/"]}])]),(PackageName "ansi-terminal",fromList [(Version {versionBranch = [0,5,5], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "ansi-terminal-0.5.5-572a1d0154fb2632bb4e9431adf0cdb1", sourcePackageId = PackageIdentifier {pkgName = PackageName "ansi-terminal", pkgVersion = Version {versionBranch = [0,5,5], versionTags = []}}, license = BSD3, copyright = "", maintainer = "batterseapower@hotmail.com", author = "Max Bolingbroke", stability = "", homepage = "http://batterseapower.github.com/ansi-terminal", pkgUrl = "", description = "ANSI terminal support for Haskell: allows cursor movement, screen clearing, color output showing or hiding the cursor, and\nchanging the title. Compatible with Windows and those Unixes with ANSI terminals, but only GHC is supported as a compiler.", category = "User Interfaces", exposed = True, exposedModules = [ModuleName ["System","Console","ANSI"]], hiddenModules = [ModuleName ["System","Console","ANSI","Unix"],ModuleName ["System","Console","ANSI","Common"]], importDirs = ["/home/florent/.cabal/lib/ansi-terminal-0.5.5/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/ansi-terminal-0.5.5/ghc-7.0.3"], hsLibraries = ["HSansi-terminal-0.5.5"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/ansi-terminal-0.5.5/html/ansi-terminal.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/ansi-terminal-0.5.5/html"]}])]),(PackageName "ansi-wl-pprint",fromList [(Version {versionBranch = [0,6,3], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "ansi-wl-pprint-0.6.3-e572fb77d5bf7bcb04a7444a9b54f822", sourcePackageId = PackageIdentifier {pkgName = PackageName "ansi-wl-pprint", pkgVersion = Version {versionBranch = [0,6,3], versionTags = []}}, license = BSD3, copyright = "", maintainer = "batterseapower@hotmail.com", author = "Daan Leijen, Max Bolingbroke", stability = "", homepage = "http://github.com/batterseapower/ansi-wl-pprint", pkgUrl = "", description = "This is a pretty printing library based on Wadler's paper \"A Prettier Printer\". It has been enhanced with support for ANSI terminal colored output using the ansi-terminal package.", category = "User Interfaces, Text", exposed = True, exposedModules = [ModuleName ["Text","PrettyPrint","ANSI","Leijen"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/ansi-wl-pprint-0.6.3/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/ansi-wl-pprint-0.6.3/ghc-7.0.3"], hsLibraries = ["HSansi-wl-pprint-0.6.3"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "ansi-terminal-0.5.5-572a1d0154fb2632bb4e9431adf0cdb1",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/ansi-wl-pprint-0.6.3/html/ansi-wl-pprint.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/ansi-wl-pprint-0.6.3/html"]}])]),(PackageName "array",fromList [(Version {versionBranch = [0,3,0,2], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8", sourcePackageId = PackageIdentifier {pkgName = PackageName "array", pkgVersion = Version {versionBranch = [0,3,0,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package defines the classes @IArray@ of immutable arrays and\n@MArray@ of arrays mutable within appropriate monads, as well as\nsome instances of these classes.", category = "Data Structures", exposed = True, exposedModules = [ModuleName ["Data","Array","Base"],ModuleName ["Data","Array","IArray"],ModuleName ["Data","Array","IO"],ModuleName ["Data","Array","IO","Internals"],ModuleName ["Data","Array","MArray"],ModuleName ["Data","Array","ST"],ModuleName ["Data","Array","Storable"],ModuleName ["Data","Array","Unboxed"],ModuleName ["Data","Array"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/array-0.3.0.2"], libraryDirs = ["/usr/lib/ghc-7.0.3/array-0.3.0.2"], hsLibraries = ["HSarray-0.3.0.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/array-0.3.0.2/array.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/array-0.3.0.2"]}])]),(PackageName "base",fromList [(Version {versionBranch = [4,3,1,0], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c", sourcePackageId = PackageIdentifier {pkgName = PackageName "base", pkgVersion = Version {versionBranch = [4,3,1,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package contains the Prelude and its support libraries,\nand a large collection of useful libraries ranging from data\nstructures to parsing combinators and debugging utilities.", category = "", exposed = True, exposedModules = [ModuleName ["Foreign","Concurrent"],ModuleName ["GHC","Arr"],ModuleName ["GHC","Base"],ModuleName ["GHC","Classes"],ModuleName ["GHC","Conc"],ModuleName ["GHC","Conc","IO"],ModuleName ["GHC","Conc","Signal"],ModuleName ["GHC","Conc","Sync"],ModuleName ["GHC","ConsoleHandler"],ModuleName ["GHC","Constants"],ModuleName ["GHC","Desugar"],ModuleName ["GHC","Enum"],ModuleName ["GHC","Environment"],ModuleName ["GHC","Err"],ModuleName ["GHC","Exception"],ModuleName ["GHC","Exts"],ModuleName ["GHC","Float"],ModuleName ["GHC","ForeignPtr"],ModuleName ["GHC","MVar"],ModuleName ["GHC","IO"],ModuleName ["GHC","IO","IOMode"],ModuleName ["GHC","IO","Buffer"],ModuleName ["GHC","IO","Device"],ModuleName ["GHC","IO","BufferedIO"],ModuleName ["GHC","IO","FD"],ModuleName ["GHC","IO","Exception"],ModuleName ["GHC","IO","Encoding"],ModuleName ["GHC","IO","Encoding","Latin1"],ModuleName ["GHC","IO","Encoding","UTF8"],ModuleName ["GHC","IO","Encoding","UTF16"],ModuleName ["GHC","IO","Encoding","UTF32"],ModuleName ["GHC","IO","Encoding","Types"],ModuleName ["GHC","IO","Encoding","Iconv"],ModuleName ["GHC","IO","Encoding","CodePage"],ModuleName ["GHC","IO","Handle"],ModuleName ["GHC","IO","Handle","Types"],ModuleName ["GHC","IO","Handle","Internals"],ModuleName ["GHC","IO","Handle","FD"],ModuleName ["GHC","IO","Handle","Text"],ModuleName ["GHC","IOBase"],ModuleName ["GHC","Handle"],ModuleName ["GHC","IORef"],ModuleName ["GHC","IOArray"],ModuleName ["GHC","Int"],ModuleName ["GHC","List"],ModuleName ["GHC","Num"],ModuleName ["GHC","PArr"],ModuleName ["GHC","Pack"],ModuleName ["GHC","Ptr"],ModuleName ["GHC","Read"],ModuleName ["GHC","Real"],ModuleName ["GHC","ST"],ModuleName ["GHC","STRef"],ModuleName ["GHC","Show"],ModuleName ["GHC","Stable"],ModuleName ["GHC","Storable"],ModuleName ["GHC","TopHandler"],ModuleName ["GHC","Unicode"],ModuleName ["GHC","Weak"],ModuleName ["GHC","Word"],ModuleName ["System","Timeout"],ModuleName ["System","Event"],ModuleName ["Control","Applicative"],ModuleName ["Control","Arrow"],ModuleName ["Control","Category"],ModuleName ["Control","Concurrent"],ModuleName ["Control","Concurrent","Chan"],ModuleName ["Control","Concurrent","MVar"],ModuleName ["Control","Concurrent","QSem"],ModuleName ["Control","Concurrent","QSemN"],ModuleName ["Control","Concurrent","SampleVar"],ModuleName ["Control","Exception"],ModuleName ["Control","Exception","Base"],ModuleName ["Control","OldException"],ModuleName ["Control","Monad"],ModuleName ["Control","Monad","Fix"],ModuleName ["Control","Monad","Instances"],ModuleName ["Control","Monad","ST"],ModuleName ["Control","Monad","ST","Lazy"],ModuleName ["Control","Monad","ST","Strict"],ModuleName ["Data","Bits"],ModuleName ["Data","Bool"],ModuleName ["Data","Char"],ModuleName ["Data","Complex"],ModuleName ["Data","Dynamic"],ModuleName ["Data","Either"],ModuleName ["Data","Eq"],ModuleName ["Data","Data"],ModuleName ["Data","Fixed"],ModuleName ["Data","Foldable"],ModuleName ["Data","Function"],ModuleName ["Data","Functor"],ModuleName ["Data","HashTable"],ModuleName ["Data","IORef"],ModuleName ["Data","Int"],ModuleName ["Data","Ix"],ModuleName ["Data","List"],ModuleName ["Data","Maybe"],ModuleName ["Data","Monoid"],ModuleName ["Data","Ord"],ModuleName ["Data","Ratio"],ModuleName ["Data","STRef"],ModuleName ["Data","STRef","Lazy"],ModuleName ["Data","STRef","Strict"],ModuleName ["Data","String"],ModuleName ["Data","Traversable"],ModuleName ["Data","Tuple"],ModuleName ["Data","Typeable"],ModuleName ["Data","Unique"],ModuleName ["Data","Version"],ModuleName ["Data","Word"],ModuleName ["Debug","Trace"],ModuleName ["Foreign"],ModuleName ["Foreign","C"],ModuleName ["Foreign","C","Error"],ModuleName ["Foreign","C","String"],ModuleName ["Foreign","C","Types"],ModuleName ["Foreign","ForeignPtr"],ModuleName ["Foreign","Marshal"],ModuleName ["Foreign","Marshal","Alloc"],ModuleName ["Foreign","Marshal","Array"],ModuleName ["Foreign","Marshal","Error"],ModuleName ["Foreign","Marshal","Pool"],ModuleName ["Foreign","Marshal","Utils"],ModuleName ["Foreign","Ptr"],ModuleName ["Foreign","StablePtr"],ModuleName ["Foreign","Storable"],ModuleName ["Numeric"],ModuleName ["Prelude"],ModuleName ["System","Console","GetOpt"],ModuleName ["System","CPUTime"],ModuleName ["System","Environment"],ModuleName ["System","Exit"],ModuleName ["System","IO"],ModuleName ["System","IO","Error"],ModuleName ["System","IO","Unsafe"],ModuleName ["System","Info"],ModuleName ["System","Mem"],ModuleName ["System","Mem","StableName"],ModuleName ["System","Mem","Weak"],ModuleName ["System","Posix","Internals"],ModuleName ["System","Posix","Types"],ModuleName ["Text","ParserCombinators","ReadP"],ModuleName ["Text","ParserCombinators","ReadPrec"],ModuleName ["Text","Printf"],ModuleName ["Text","Read"],ModuleName ["Text","Read","Lex"],ModuleName ["Text","Show"],ModuleName ["Text","Show","Functions"],ModuleName ["Unsafe","Coerce"]], hiddenModules = [ModuleName ["System","Event","Array"],ModuleName ["System","Event","Clock"],ModuleName ["System","Event","Control"],ModuleName ["System","Event","EPoll"],ModuleName ["System","Event","IntMap"],ModuleName ["System","Event","Internal"],ModuleName ["System","Event","KQueue"],ModuleName ["System","Event","Manager"],ModuleName ["System","Event","PSQ"],ModuleName ["System","Event","Poll"],ModuleName ["System","Event","Thread"],ModuleName ["System","Event","Unique"]], importDirs = ["/usr/lib/ghc-7.0.3/base-4.3.1.0"], libraryDirs = ["/usr/lib/ghc-7.0.3/base-4.3.1.0"], hsLibraries = ["HSbase-4.3.1.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/ghc-7.0.3/base-4.3.1.0/include"], includes = ["HsBase.h"], depends = [InstalledPackageId "ghc-prim-0.2.0.0-d9df11f804556f362beb0ea4e67261ba",InstalledPackageId "integer-gmp-0.2.0.3-298c59ba68b7aaa7e76ae5b1fe5e876e",InstalledPackageId "builtin_rts"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/base-4.3.1.0/base.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/base-4.3.1.0"]}])]),(PackageName "binary",fromList [(Version {versionBranch = [0,5,0,2], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "binary-0.5.0.2-b471fd4ae9e6a992eed4cf652dba019b", sourcePackageId = PackageIdentifier {pkgName = PackageName "binary", pkgVersion = Version {versionBranch = [0,5,0,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Lennart Kolmodin, Don Stewart <dons@galois.com>", author = "Lennart Kolmodin <kolmodin@dtek.chalmers.se>", stability = "provisional", homepage = "http://code.haskell.org/binary/", pkgUrl = "", description = "Efficient, pure binary serialisation using lazy ByteStrings.\nHaskell values may be encoded to and from binary formats,\nwritten to disk as binary, or sent over the network.\nSerialisation speeds of over 1 G\\/sec have been observed,\nso this library should be suitable for high performance\nscenarios.", category = "Data, Parsing", exposed = True, exposedModules = [ModuleName ["Data","Binary"],ModuleName ["Data","Binary","Put"],ModuleName ["Data","Binary","Get"],ModuleName ["Data","Binary","Builder"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/binary-0.5.0.2/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/binary-0.5.0.2/ghc-7.0.3"], hsLibraries = ["HSbinary-0.5.0.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/binary-0.5.0.2/binary.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-binary-doc/html/"]}])]),(PackageName "bytestring",fromList [(Version {versionBranch = [0,9,1,10], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4", sourcePackageId = PackageIdentifier {pkgName = PackageName "bytestring", pkgVersion = Version {versionBranch = [0,9,1,10], versionTags = []}}, license = BSD3, copyright = "Copyright (c) Don Stewart 2005-2009,\n(c) Duncan Coutts 2006-2009,\n(c) David Roundy 2003-2005.", maintainer = "dons@galois.com, duncan@haskell.org", author = "Don Stewart, Duncan Coutts", stability = "", homepage = "http://www.cse.unsw.edu.au/~dons/fps.html", pkgUrl = "", description = "A time and space-efficient implementation of byte vectors using\npacked Word8 arrays, suitable for high performance use, both in terms\nof large data quantities, or high speed requirements. Byte vectors\nare encoded as strict 'Word8' arrays of bytes, and lazy lists of\nstrict chunks, held in a 'ForeignPtr', and can be passed between C\nand Haskell with little effort.\n\nTest coverage data for this library is available at:\n<http://code.haskell.org/~dons/tests/bytestring/hpc_index.html>", category = "Data", exposed = True, exposedModules = [ModuleName ["Data","ByteString"],ModuleName ["Data","ByteString","Char8"],ModuleName ["Data","ByteString","Unsafe"],ModuleName ["Data","ByteString","Internal"],ModuleName ["Data","ByteString","Lazy"],ModuleName ["Data","ByteString","Lazy","Char8"],ModuleName ["Data","ByteString","Lazy","Internal"],ModuleName ["Data","ByteString","Fusion"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/bytestring-0.9.1.10"], libraryDirs = ["/usr/lib/ghc-7.0.3/bytestring-0.9.1.10"], hsLibraries = ["HSbytestring-0.9.1.10"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/ghc-7.0.3/bytestring-0.9.1.10/include"], includes = ["fpstring.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "ghc-prim-0.2.0.0-d9df11f804556f362beb0ea4e67261ba"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/bytestring-0.9.1.10/bytestring.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/bytestring-0.9.1.10"]}])]),(PackageName "cmdlib",fromList [(Version {versionBranch = [0,3], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "cmdlib-0.3-30b0b48ba7f087d1e853499831429cfa", sourcePackageId = PackageIdentifier {pkgName = PackageName "cmdlib", pkgVersion = Version {versionBranch = [0,3], versionTags = []}}, license = BSD3, copyright = "", maintainer = "me@mornfall.net", author = "Petr Rockai", stability = "", homepage = "", pkgUrl = "", description = "A commandline parsing library, based on getopt. Comes with a\npowerful attribute system. Supports complex interfaces with many\noptions and commands, with option & command grouping, with simple\nand convenient API. Even though quite powerful, it strives to keep\nsimple things simple. The library uses \"System.Console.GetOpt\" as\nits backend.\n\nIn comparison to the other commandline handling libraries:\n\nCompared to cmdargs, cmdlib has a pure attribute system and is\nbased on GetOpt for help formatting & argument parsing. Cmdlib may\nalso be more extendable due to typeclass design, and can use\nuser-supplied types for option arguments.\n\nCmdargs >= 0.4 can optionally use a pure attribute system,\nalthough this is clearly an add-on and the API is a second-class\ncitizen in relation to the impure version.\n\nGetOpt and parseargs both require explicit flag representation, so\nthey live a level below cmdlib. GetOpt is in fact used as a\nbackend by cmdlib.", category = "System", exposed = True, exposedModules = [ModuleName ["System","Console","CmdLib"]], hiddenModules = [ModuleName ["System","Console","CmdLib","Attribute"],ModuleName ["System","Console","CmdLib","Flag"],ModuleName ["System","Console","CmdLib","Command"],ModuleName ["System","Console","CmdLib","ADTs"],ModuleName ["System","Console","CmdLib","Record"]], importDirs = ["/home/florent/.cabal/lib/cmdlib-0.3/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/cmdlib-0.3/ghc-7.0.3"], hsLibraries = ["HScmdlib-0.3"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b",InstalledPackageId "split-0.1.4-25b8dac0b87dfab6d3ad4b8a7e345e45",InstalledPackageId "syb-0.3-00d8c06f799942b01364e795b2a54d70"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/cmdlib-0.3/html/cmdlib.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/cmdlib-0.3/html"]}])]),(PackageName "containers",fromList [(Version {versionBranch = [0,4,0,0], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e", sourcePackageId = PackageIdentifier {pkgName = PackageName "containers", pkgVersion = Version {versionBranch = [0,4,0,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package contains efficient general-purpose implementations\nof various basic immutable container types. The declared cost of\neach operation is either worst-case or amortized, but remains\nvalid even if structures are shared.", category = "Data Structures", exposed = True, exposedModules = [ModuleName ["Data","Graph"],ModuleName ["Data","Sequence"],ModuleName ["Data","Tree"],ModuleName ["Data","IntMap"],ModuleName ["Data","IntSet"],ModuleName ["Data","Map"],ModuleName ["Data","Set"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/containers-0.4.0.0"], libraryDirs = ["/usr/lib/ghc-7.0.3/containers-0.4.0.0"], hsLibraries = ["HScontainers-0.4.0.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/containers-0.4.0.0/containers.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/containers-0.4.0.0"]}])]),(PackageName "dataenc",fromList [(Version {versionBranch = [0,13,0,4], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "dataenc-0.13.0.4-35faf9ef6ab96b77e6a414944a7a49d8", sourcePackageId = PackageIdentifier {pkgName = PackageName "dataenc", pkgVersion = Version {versionBranch = [0,13,0,4], versionTags = []}}, license = BSD3, copyright = "Magnus Therning, 2007-2009", maintainer = "magnus@therning.org", author = "Magnus Therning", stability = "", homepage = "http://www.haskell.org/haskellwiki/Library/Data_encoding", pkgUrl = "", description = "Data encoding library currently providing Base16, Base32,\nBase32Hex, Base64, Base64Url, Base85, Python string escaping,\nQuoted-Printable, URL encoding, uuencode, xxencode, and yEncoding.", category = "Codec", exposed = True, exposedModules = [ModuleName ["Codec","Binary","Base16"],ModuleName ["Codec","Binary","Base32"],ModuleName ["Codec","Binary","Base32Hex"],ModuleName ["Codec","Binary","Base64"],ModuleName ["Codec","Binary","Base64Url"],ModuleName ["Codec","Binary","Base85"],ModuleName ["Codec","Binary","DataEncoding"],ModuleName ["Codec","Binary","PythonString"],ModuleName ["Codec","Binary","QuotedPrintable"],ModuleName ["Codec","Binary","Url"],ModuleName ["Codec","Binary","Uu"],ModuleName ["Codec","Binary","Xx"],ModuleName ["Codec","Binary","Yenc"]], hiddenModules = [ModuleName ["Codec","Binary","Util"]], importDirs = ["/usr/lib/haskell-packages/ghc/lib/dataenc-0.13.0.4/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/dataenc-0.13.0.4/ghc-7.0.3"], hsLibraries = ["HSdataenc-0.13.0.4"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/dataenc-0.13.0.4/dataenc.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-dataenc-doc/html/"]}])]),(PackageName "deepseq",fromList [(Version {versionBranch = [1,1,0,2], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "deepseq-1.1.0.2-0465f803f7d27d264907e7e03e72a71f", sourcePackageId = PackageIdentifier {pkgName = PackageName "deepseq", pkgVersion = Version {versionBranch = [1,1,0,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package provides methods for fully evaluating data structures\n(\\\"deep evaluation\\\"). Deep evaluation is often used for adding\nstrictness to a program, e.g. in order to force pending exceptions,\nremove space leaks, or force lazy I/O to happen. It is also useful\nin parallel programs, to ensure pending work does not migrate to the\nwrong thread.\n\nThe primary use of this package is via the 'deepseq' function, a\n\\\"deep\\\" version of 'seq'. It is implemented on top of an 'NFData'\ntypeclass (\\\"Normal Form Data\\\", data structures with no unevaluated\ncomponents) which defines strategies for fully evaluating different\ndata types.", category = "Control", exposed = True, exposedModules = [ModuleName ["Control","DeepSeq"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/deepseq-1.1.0.2/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/deepseq-1.1.0.2/ghc-7.0.3"], hsLibraries = ["HSdeepseq-1.1.0.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/deepseq-1.1.0.2/deepseq.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-deepseq-doc/html/"]}])]),(PackageName "directory",fromList [(Version {versionBranch = [1,1,0,0], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "directory-1.1.0.0-393d8e95f1c0dd6ee908e122f924ac85", sourcePackageId = PackageIdentifier {pkgName = PackageName "directory", pkgVersion = Version {versionBranch = [1,1,0,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package provides a library for handling directories.", category = "System", exposed = True, exposedModules = [ModuleName ["System","Directory"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/directory-1.1.0.0"], libraryDirs = ["/usr/lib/ghc-7.0.3/directory-1.1.0.0"], hsLibraries = ["HSdirectory-1.1.0.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/ghc-7.0.3/directory-1.1.0.0/include"], includes = ["HsDirectory.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653",InstalledPackageId "old-time-1.0.0.6-7f15fd4b960098b2776b8c05bc17519f",InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/directory-1.1.0.0/directory.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/directory-1.1.0.0"]}])]),(PackageName "extensible-exceptions",fromList [(Version {versionBranch = [0,1,1,2], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831", sourcePackageId = PackageIdentifier {pkgName = PackageName "extensible-exceptions", pkgVersion = Version {versionBranch = [0,1,1,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package provides extensible exceptions for both new and\nold versions of GHC (i.e., < 6.10).", category = "Control", exposed = True, exposedModules = [ModuleName ["Control","Exception","Extensible"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/extensible-exceptions-0.1.1.2"], libraryDirs = ["/usr/lib/ghc-7.0.3/extensible-exceptions-0.1.1.2"], hsLibraries = ["HSextensible-exceptions-0.1.1.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/extensible-exceptions-0.1.1.2/extensible-exceptions.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/extensible-exceptions-0.1.1.2"]}])]),(PackageName "filepath",fromList [(Version {versionBranch = [1,2,0,0], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653", sourcePackageId = PackageIdentifier {pkgName = PackageName "filepath", pkgVersion = Version {versionBranch = [1,2,0,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "", author = "Neil Mitchell", stability = "", homepage = "http://www-users.cs.york.ac.uk/~ndm/filepath/", pkgUrl = "", description = "", category = "System", exposed = True, exposedModules = [ModuleName ["System","FilePath"],ModuleName ["System","FilePath","Posix"],ModuleName ["System","FilePath","Windows"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/filepath-1.2.0.0"], libraryDirs = ["/usr/lib/ghc-7.0.3/filepath-1.2.0.0"], hsLibraries = ["HSfilepath-1.2.0.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/filepath-1.2.0.0/filepath.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/filepath-1.2.0.0"]}])]),(PackageName "ghc-prim",fromList [(Version {versionBranch = [0,2,0,0], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "ghc-prim-0.2.0.0-d9df11f804556f362beb0ea4e67261ba", sourcePackageId = PackageIdentifier {pkgName = PackageName "ghc-prim", pkgVersion = Version {versionBranch = [0,2,0,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "GHC primitives.", category = "", exposed = True, exposedModules = [ModuleName ["GHC","Prim"],ModuleName ["GHC","Bool"],ModuleName ["GHC","Debug"],ModuleName ["GHC","Generics"],ModuleName ["GHC","Magic"],ModuleName ["GHC","Ordering"],ModuleName ["GHC","PrimopWrappers"],ModuleName ["GHC","IntWord32"],ModuleName ["GHC","IntWord64"],ModuleName ["GHC","Tuple"],ModuleName ["GHC","Types"],ModuleName ["GHC","Unit"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/ghc-prim-0.2.0.0"], libraryDirs = ["/usr/lib/ghc-7.0.3/ghc-prim-0.2.0.0"], hsLibraries = ["HSghc-prim-0.2.0.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "builtin_rts"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/ghc-prim-0.2.0.0/ghc-prim.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/ghc-prim-0.2.0.0"]}])]),(PackageName "hashed-storage",fromList [(Version {versionBranch = [0,5,7], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "hashed-storage-0.5.7-f2baae72d60d89cab6d2b5facd274d47", sourcePackageId = PackageIdentifier {pkgName = PackageName "hashed-storage", pkgVersion = Version {versionBranch = [0,5,7], versionTags = []}}, license = BSD3, copyright = "2009 Petr Rockai <me@mornfall.net>", maintainer = "Petr Rockai <me@mornfall.net>", author = "Petr Rockai <me@mornfall.net>", stability = "", homepage = "", pkgUrl = "", description = "Support code for reading and manipulating hashed file storage\n(where each file and directory is associated with a\ncryptographic hash, for corruption-resistant storage and fast\ncomparisons).\n\nThe supported storage formats include darcs hashed pristine, a\nplain filesystem tree and an indexed plain tree (where the index\nmaintains hashes of the plain files and directories).", category = "System", exposed = True, exposedModules = [ModuleName ["Storage","Hashed"],ModuleName ["Storage","Hashed","AnchoredPath"],ModuleName ["Storage","Hashed","Index"],ModuleName ["Storage","Hashed","Monad"],ModuleName ["Storage","Hashed","Tree"],ModuleName ["Storage","Hashed","Hash"],ModuleName ["Storage","Hashed","Packed"],ModuleName ["Storage","Hashed","Plain"],ModuleName ["Storage","Hashed","Darcs"]], hiddenModules = [ModuleName ["Bundled","Posix"],ModuleName ["Bundled","SHA256"],ModuleName ["Storage","Hashed","Utils"]], importDirs = ["/home/florent/.cabal/lib/hashed-storage-0.5.7/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/hashed-storage-0.5.7/ghc-7.0.3"], hsLibraries = ["HShashed-storage-0.5.7"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "binary-0.5.0.2-b471fd4ae9e6a992eed4cf652dba019b",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e",InstalledPackageId "dataenc-0.13.0.4-35faf9ef6ab96b77e6a414944a7a49d8",InstalledPackageId "directory-1.1.0.0-393d8e95f1c0dd6ee908e122f924ac85",InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831",InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653",InstalledPackageId "mmap-0.5.7-127e379f104e2b945de5325ba3158467",InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b",InstalledPackageId "zlib-0.5.3.1-7e19941cbd00147a79723e25160ffc8b"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/hashed-storage-0.5.7/html/hashed-storage.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/hashed-storage-0.5.7/html"]}])]),(PackageName "haskeline",fromList [(Version {versionBranch = [0,6,4,0], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "haskeline-0.6.4.0-ea83f091fcdad61446c62afc5c94a9ed", sourcePackageId = PackageIdentifier {pkgName = PackageName "haskeline", pkgVersion = Version {versionBranch = [0,6,4,0], versionTags = []}}, license = BSD3, copyright = "(c) Judah Jacobson", maintainer = "Judah Jacobson <judah.jacobson@gmail.com>", author = "Judah Jacobson", stability = "Experimental", homepage = "http://trac.haskell.org/haskeline", pkgUrl = "", description = "Haskeline provides a user interface for line input in command-line\nprograms. This library is similar in purpose to readline, but since\nit is written in Haskell it is (hopefully) more easily used in other\nHaskell programs.\n\nHaskeline runs both on POSIX-compatible systems and on Windows.", category = "User Interfaces", exposed = True, exposedModules = [ModuleName ["System","Console","Haskeline"],ModuleName ["System","Console","Haskeline","Completion"],ModuleName ["System","Console","Haskeline","Encoding"],ModuleName ["System","Console","Haskeline","MonadException"],ModuleName ["System","Console","Haskeline","History"],ModuleName ["System","Console","Haskeline","IO"]], hiddenModules = [ModuleName ["System","Console","Haskeline","Backend","Terminfo"],ModuleName ["System","Console","Haskeline","Backend","WCWidth"],ModuleName ["System","Console","Haskeline","Backend","Posix"],ModuleName ["System","Console","Haskeline","Backend","IConv"],ModuleName ["System","Console","Haskeline","Backend","DumbTerm"],ModuleName ["System","Console","Haskeline","Backend"],ModuleName ["System","Console","Haskeline","Command"],ModuleName ["System","Console","Haskeline","Command","Completion"],ModuleName ["System","Console","Haskeline","Command","History"],ModuleName ["System","Console","Haskeline","Command","KillRing"],ModuleName ["System","Console","Haskeline","Directory"],ModuleName ["System","Console","Haskeline","Emacs"],ModuleName ["System","Console","Haskeline","InputT"],ModuleName ["System","Console","Haskeline","Key"],ModuleName ["System","Console","Haskeline","LineState"],ModuleName ["System","Console","Haskeline","Monads"],ModuleName ["System","Console","Haskeline","Prefs"],ModuleName ["System","Console","Haskeline","RunCommand"],ModuleName ["System","Console","Haskeline","Term"],ModuleName ["System","Console","Haskeline","Command","Undo"],ModuleName ["System","Console","Haskeline","Vi"]], importDirs = ["/usr/lib/haskell-packages/ghc/lib/haskeline-0.6.4.0/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/haskeline-0.6.4.0/ghc-7.0.3"], hsLibraries = ["HShaskeline-0.6.4.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/haskell-packages/ghc/lib/haskeline-0.6.4.0/ghc-7.0.3/include"], includes = ["h_iconv.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e",InstalledPackageId "directory-1.1.0.0-393d8e95f1c0dd6ee908e122f924ac85",InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831",InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653",InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b",InstalledPackageId "terminfo-0.3.1.3-d898a3b030f2d808d2a44c5ff0e2a0e1",InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff",InstalledPackageId "utf8-string-0.3.6-48af7e77f29b232f389e99d0a9a1d604"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/haskeline-0.6.4.0/haskeline.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-haskeline-doc/html/"]}])]),(PackageName "hostname",fromList [(Version {versionBranch = [1,0], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "hostname-1.0-75071817127be63d3548cd759f6b627c", sourcePackageId = PackageIdentifier {pkgName = PackageName "hostname", pkgVersion = Version {versionBranch = [1,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Max Bolingbroke <batterseapower@hotmail.com>", author = "Max Bolingbroke <batterseapower@hotmail.com>", stability = "", homepage = "", pkgUrl = "", description = "", category = "Network", exposed = True, exposedModules = [ModuleName ["Network","HostName"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/hostname-1.0/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/hostname-1.0/ghc-7.0.3"], hsLibraries = ["HShostname-1.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/hostname-1.0/html/hostname.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/hostname-1.0/html"]}])]),(PackageName "html",fromList [(Version {versionBranch = [1,0,1,2], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "html-1.0.1.2-0cdd616c514cf10f5323f121a96991b6", sourcePackageId = PackageIdentifier {pkgName = PackageName "html", pkgVersion = Version {versionBranch = [1,0,1,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package contains a combinator library for constructing\nHTML documents.", category = "Web", exposed = True, exposedModules = [ModuleName ["Text","Html"],ModuleName ["Text","Html","BlockTable"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/html-1.0.1.2/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/html-1.0.1.2/ghc-7.0.3"], hsLibraries = ["HShtml-1.0.1.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/html-1.0.1.2/html.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-html-doc/html/"]}])]),(PackageName "integer-gmp",fromList [(Version {versionBranch = [0,2,0,3], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "integer-gmp-0.2.0.3-298c59ba68b7aaa7e76ae5b1fe5e876e", sourcePackageId = PackageIdentifier {pkgName = PackageName "integer-gmp", pkgVersion = Version {versionBranch = [0,2,0,3], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package contains an Integer library based on GMP.", category = "", exposed = True, exposedModules = [ModuleName ["GHC","Integer"],ModuleName ["GHC","Integer","GMP","Internals"]], hiddenModules = [ModuleName ["GHC","Integer","Type"]], importDirs = ["/usr/lib/ghc-7.0.3/integer-gmp-0.2.0.3"], libraryDirs = ["/usr/lib/ghc-7.0.3/integer-gmp-0.2.0.3"], hsLibraries = ["HSinteger-gmp-0.2.0.3"], extraLibraries = ["gmp"], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "ghc-prim-0.2.0.0-d9df11f804556f362beb0ea4e67261ba"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/integer-gmp-0.2.0.3/integer-gmp.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/integer-gmp-0.2.0.3"]}])]),(PackageName "mmap",fromList [(Version {versionBranch = [0,5,7], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "mmap-0.5.7-127e379f104e2b945de5325ba3158467", sourcePackageId = PackageIdentifier {pkgName = PackageName "mmap", pkgVersion = Version {versionBranch = [0,5,7], versionTags = []}}, license = BSD3, copyright = "2008, Gracjan Polak", maintainer = "Gracjan Polak <gracjanpolak@gmail.com>", author = "Gracjan Polak <gracjanpolak@gmail.com>", stability = "alpha", homepage = "", pkgUrl = "", description = "This library provides a wrapper to mmap(2) or MapViewOfFile,\nallowing files or devices to be lazily loaded into memory as\nstrict or lazy ByteStrings, ForeignPtrs or plain Ptrs, using\nthe virtual memory subsystem to do on-demand loading.\nModifications are also supported.", category = "System", exposed = True, exposedModules = [ModuleName ["System","IO","MMap"]], hiddenModules = [], importDirs = ["/usr/local/lib/mmap-0.5.7/ghc-7.0.3"], libraryDirs = ["/usr/local/lib/mmap-0.5.7/ghc-7.0.3"], hsLibraries = ["HSmmap-0.5.7"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/local/share/doc/mmap-0.5.7/html/mmap.haddock"], haddockHTMLs = ["/usr/local/share/doc/mmap-0.5.7/html"]}])]),(PackageName "mtl",fromList [(Version {versionBranch = [2,0,1,0], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b", sourcePackageId = PackageIdentifier {pkgName = PackageName "mtl", pkgVersion = Version {versionBranch = [2,0,1,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "Andy Gill", stability = "", homepage = "", pkgUrl = "", description = "Monad classes using functional dependencies, with instances\nfor various monad transformers, inspired by the paper\n/Functional Programming with Overloading and Higher-Order Polymorphism/,\nby Mark P Jones, in /Advanced School of Functional Programming/, 1995\n(<http://web.cecs.pdx.edu/~mpj/pubs/springschool.html>).", category = "Control", exposed = True, exposedModules = [ModuleName ["Control","Monad","Cont"],ModuleName ["Control","Monad","Cont","Class"],ModuleName ["Control","Monad","Error"],ModuleName ["Control","Monad","Error","Class"],ModuleName ["Control","Monad","Identity"],ModuleName ["Control","Monad","List"],ModuleName ["Control","Monad","RWS"],ModuleName ["Control","Monad","RWS","Class"],ModuleName ["Control","Monad","RWS","Lazy"],ModuleName ["Control","Monad","RWS","Strict"],ModuleName ["Control","Monad","Reader"],ModuleName ["Control","Monad","Reader","Class"],ModuleName ["Control","Monad","State"],ModuleName ["Control","Monad","State","Class"],ModuleName ["Control","Monad","State","Lazy"],ModuleName ["Control","Monad","State","Strict"],ModuleName ["Control","Monad","Trans"],ModuleName ["Control","Monad","Writer"],ModuleName ["Control","Monad","Writer","Class"],ModuleName ["Control","Monad","Writer","Lazy"],ModuleName ["Control","Monad","Writer","Strict"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/mtl-2.0.1.0/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/mtl-2.0.1.0/ghc-7.0.3"], hsLibraries = ["HSmtl-2.0.1.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "transformers-0.2.2.0-4bbbfde1fb5c4eb17cdb1963dda698f3"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/mtl-2.0.1.0/mtl.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-mtl-doc/html/"]}])]),(PackageName "network",fromList [(Version {versionBranch = [2,3,0,2], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "network-2.3.0.2-824dddd7e2ce0e065568730d1c080c4a", sourcePackageId = PackageIdentifier {pkgName = PackageName "network", pkgVersion = Version {versionBranch = [2,3,0,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Johan Tibell <johan.tibell@gmail.com>", author = "", stability = "", homepage = "http://github.com/haskell/network", pkgUrl = "", description = "Low-level networking interface", category = "Network", exposed = True, exposedModules = [ModuleName ["Network"],ModuleName ["Network","BSD"],ModuleName ["Network","Socket"],ModuleName ["Network","Socket","ByteString"],ModuleName ["Network","Socket","ByteString","Lazy"],ModuleName ["Network","Socket","Internal"],ModuleName ["Network","URI"]], hiddenModules = [ModuleName ["Network","Socket","ByteString","IOVec"],ModuleName ["Network","Socket","ByteString","MsgHdr"],ModuleName ["Network","Socket","ByteString","Internal"]], importDirs = ["/usr/lib/haskell-packages/ghc/lib/network-2.3.0.2/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/network-2.3.0.2/ghc-7.0.3"], hsLibraries = ["HSnetwork-2.3.0.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/haskell-packages/ghc/lib/network-2.3.0.2/ghc-7.0.3/include"], includes = ["HsNet.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "parsec-3.1.1-33474162d2bbd21ea1e4f1e3830243d8",InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/network-2.3.0.2/network.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-network-doc/html/"]}])]),(PackageName "old-locale",fromList [(Version {versionBranch = [1,0,0,2], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "old-locale-1.0.0.2-161f79060c89cc16ca11576ceb440486", sourcePackageId = PackageIdentifier {pkgName = PackageName "old-locale", pkgVersion = Version {versionBranch = [1,0,0,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package provides the old locale library.\nFor new code, the new locale library is recommended.", category = "System", exposed = True, exposedModules = [ModuleName ["System","Locale"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/old-locale-1.0.0.2"], libraryDirs = ["/usr/lib/ghc-7.0.3/old-locale-1.0.0.2"], hsLibraries = ["HSold-locale-1.0.0.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/old-locale-1.0.0.2/old-locale.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/old-locale-1.0.0.2"]}])]),(PackageName "old-time",fromList [(Version {versionBranch = [1,0,0,6], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "old-time-1.0.0.6-7f15fd4b960098b2776b8c05bc17519f", sourcePackageId = PackageIdentifier {pkgName = PackageName "old-time", pkgVersion = Version {versionBranch = [1,0,0,6], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package provides the old time library.\nFor new code, the new time library is recommended.", category = "System", exposed = True, exposedModules = [ModuleName ["System","Time"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/old-time-1.0.0.6"], libraryDirs = ["/usr/lib/ghc-7.0.3/old-time-1.0.0.6"], hsLibraries = ["HSold-time-1.0.0.6"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/ghc-7.0.3/old-time-1.0.0.6/include"], includes = ["HsTime.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "old-locale-1.0.0.2-161f79060c89cc16ca11576ceb440486"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/old-time-1.0.0.6/old-time.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/old-time-1.0.0.6"]}])]),(PackageName "parsec",fromList [(Version {versionBranch = [3,1,1], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "parsec-3.1.1-33474162d2bbd21ea1e4f1e3830243d8", sourcePackageId = PackageIdentifier {pkgName = PackageName "parsec", pkgVersion = Version {versionBranch = [3,1,1], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Antoine Latter <aslatter@gmail.com>", author = "Daan Leijen <daan@microsoft.com>, Paolo Martini <paolo@nemail.it>", stability = "", homepage = "http://www.cs.uu.nl/~daan/parsec.html", pkgUrl = "", description = "Parsec is designed from scratch as an industrial-strength parser\nlibrary. It is simple, safe, well documented (on the package\nhomepage), has extensive libraries and good error messages,\nand is also fast. It is defined as a monad transformer that can be\nstacked on arbitrary monads, and it is also parametric in the\ninput stream type.", category = "Parsing", exposed = True, exposedModules = [ModuleName ["Text","Parsec"],ModuleName ["Text","Parsec","String"],ModuleName ["Text","Parsec","ByteString"],ModuleName ["Text","Parsec","ByteString","Lazy"],ModuleName ["Text","Parsec","Pos"],ModuleName ["Text","Parsec","Error"],ModuleName ["Text","Parsec","Prim"],ModuleName ["Text","Parsec","Char"],ModuleName ["Text","Parsec","Combinator"],ModuleName ["Text","Parsec","Token"],ModuleName ["Text","Parsec","Expr"],ModuleName ["Text","Parsec","Language"],ModuleName ["Text","Parsec","Perm"],ModuleName ["Text","ParserCombinators","Parsec"],ModuleName ["Text","ParserCombinators","Parsec","Char"],ModuleName ["Text","ParserCombinators","Parsec","Combinator"],ModuleName ["Text","ParserCombinators","Parsec","Error"],ModuleName ["Text","ParserCombinators","Parsec","Expr"],ModuleName ["Text","ParserCombinators","Parsec","Language"],ModuleName ["Text","ParserCombinators","Parsec","Perm"],ModuleName ["Text","ParserCombinators","Parsec","Pos"],ModuleName ["Text","ParserCombinators","Parsec","Prim"],ModuleName ["Text","ParserCombinators","Parsec","Token"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/parsec-3.1.1/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/parsec-3.1.1/ghc-7.0.3"], hsLibraries = ["HSparsec-3.1.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/parsec3-3.1.1/parsec.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-parsec3-doc/html/"]}])]),(PackageName "pretty",fromList [(Version {versionBranch = [1,0,1,2], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "pretty-1.0.1.2-f8dc299a95cc94a3e513e27c5b80f951", sourcePackageId = PackageIdentifier {pkgName = PackageName "pretty", pkgVersion = Version {versionBranch = [1,0,1,2], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package contains John Hughes's pretty-printing library,\nheavily modified by Simon Peyton Jones.", category = "Text", exposed = True, exposedModules = [ModuleName ["Text","PrettyPrint"],ModuleName ["Text","PrettyPrint","HughesPJ"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/pretty-1.0.1.2"], libraryDirs = ["/usr/lib/ghc-7.0.3/pretty-1.0.1.2"], hsLibraries = ["HSpretty-1.0.1.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/pretty-1.0.1.2/pretty.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/pretty-1.0.1.2"]}])]),(PackageName "primitive",fromList [(Version {versionBranch = [0,3,1], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "primitive-0.3.1-c9e4468cc744c0e030467f8c31383955", sourcePackageId = PackageIdentifier {pkgName = PackageName "primitive", pkgVersion = Version {versionBranch = [0,3,1], versionTags = []}}, license = BSD3, copyright = "(c) Roman Leshchinskiy 2009-2010", maintainer = "Roman Leshchinskiy <rl@cse.unsw.edu.au>", author = "Roman Leshchinskiy <rl@cse.unsw.edu.au>", stability = "", homepage = "http://code.haskell.org/primitive", pkgUrl = "", description = ".\nThis package provides wrappers for primitive array operations from\nGHC.Prim.", category = "Data", exposed = True, exposedModules = [ModuleName ["Control","Monad","Primitive"],ModuleName ["Data","Primitive"],ModuleName ["Data","Primitive","MachDeps"],ModuleName ["Data","Primitive","Types"],ModuleName ["Data","Primitive","Array"],ModuleName ["Data","Primitive","ByteArray"],ModuleName ["Data","Primitive","Addr"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/primitive-0.3.1/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/primitive-0.3.1/ghc-7.0.3"], hsLibraries = ["HSprimitive-0.3.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/haskell-packages/ghc/lib/primitive-0.3.1/ghc-7.0.3/include"], includes = ["primitive-memops.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "ghc-prim-0.2.0.0-d9df11f804556f362beb0ea4e67261ba"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/primitive-0.3.1/primitive.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-primitive-doc/html/"]}])]),(PackageName "process",fromList [(Version {versionBranch = [1,0,1,5], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "process-1.0.1.5-da4848a2eec47420cd09fe9edba7e83c", sourcePackageId = PackageIdentifier {pkgName = PackageName "process", pkgVersion = Version {versionBranch = [1,0,1,5], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package contains libraries for dealing with system processes.", category = "System", exposed = True, exposedModules = [ModuleName ["System","Process","Internals"],ModuleName ["System","Process"],ModuleName ["System","Cmd"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/process-1.0.1.5"], libraryDirs = ["/usr/lib/ghc-7.0.3/process-1.0.1.5"], hsLibraries = ["HSprocess-1.0.1.5"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/ghc-7.0.3/process-1.0.1.5/include"], includes = ["runProcess.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "directory-1.1.0.0-393d8e95f1c0dd6ee908e122f924ac85",InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653",InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/process-1.0.1.5/process.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/process-1.0.1.5"]}])]),(PackageName "random",fromList [(Version {versionBranch = [1,0,0,3], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "random-1.0.0.3-7511feaba03eecc22356464da8976c7e", sourcePackageId = PackageIdentifier {pkgName = PackageName "random", pkgVersion = Version {versionBranch = [1,0,0,3], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package provides a random number library.", category = "System", exposed = True, exposedModules = [ModuleName ["System","Random"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/random-1.0.0.3"], libraryDirs = ["/usr/lib/ghc-7.0.3/random-1.0.0.3"], hsLibraries = ["HSrandom-1.0.0.3"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "time-1.2.0.3-3493203919ef238f1a58223fa55b1ceb"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/random-1.0.0.3/random.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/random-1.0.0.3"]}])]),(PackageName "regex-base",fromList [(Version {versionBranch = [0,93,2], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "regex-base-0.93.2-ea22834f5565d6f16b2cec3e7a63917a", sourcePackageId = PackageIdentifier {pkgName = PackageName "regex-base", pkgVersion = Version {versionBranch = [0,93,2], versionTags = []}}, license = BSD3, copyright = "Copyright (c) 2006, Christopher Kuklewicz", maintainer = "TextRegexLazy@personal.mightyreason.com", author = "Christopher Kuklewicz", stability = "Seems to work, passes a few tests", homepage = "http://sourceforge.net/projects/lazy-regex", pkgUrl = "http://darcs.haskell.org/packages/regex-unstable/regex-base/", description = "Interface API for regex-posix,pcre,parsec,tdfa,dfa", category = "Text", exposed = True, exposedModules = [ModuleName ["Text","Regex","Base"],ModuleName ["Text","Regex","Base","RegexLike"],ModuleName ["Text","Regex","Base","Context"],ModuleName ["Text","Regex","Base","Impl"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/regex-base-0.93.2/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/regex-base-0.93.2/ghc-7.0.3"], hsLibraries = ["HSregex-base-0.93.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e",InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/regex-base-0.93.2/regex-base.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-regex-base-doc/html/"]}])]),(PackageName "regex-compat",fromList [(Version {versionBranch = [0,95,1], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "regex-compat-0.95.1-3e607bc84f3c3925033bb247b8ebab65", sourcePackageId = PackageIdentifier {pkgName = PackageName "regex-compat", pkgVersion = Version {versionBranch = [0,95,1], versionTags = []}}, license = BSD3, copyright = "Copyright (c) 2006, Christopher Kuklewicz", maintainer = "TextRegexLazy@personal.mightyreason.com", author = "Christopher Kuklewicz", stability = "Seems to work, passes a few tests", homepage = "http://sourceforge.net/projects/lazy-regex", pkgUrl = "http://darcs.haskell.org/packages/regex-unstable/regex-compat/", description = "One module layer over regex-posix to replace Text.Regex", category = "Text", exposed = True, exposedModules = [ModuleName ["Text","Regex"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/regex-compat-0.95.1/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/regex-compat-0.95.1/ghc-7.0.3"], hsLibraries = ["HSregex-compat-0.95.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "regex-base-0.93.2-ea22834f5565d6f16b2cec3e7a63917a",InstalledPackageId "regex-posix-0.95.1-a7a63b8d8d2c01aa7eca73b4f7221d81"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/regex-compat-0.95.1/html/regex-compat.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/regex-compat-0.95.1/html"]}])]),(PackageName "regex-posix",fromList [(Version {versionBranch = [0,95,1], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "regex-posix-0.95.1-a7a63b8d8d2c01aa7eca73b4f7221d81", sourcePackageId = PackageIdentifier {pkgName = PackageName "regex-posix", pkgVersion = Version {versionBranch = [0,95,1], versionTags = []}}, license = BSD3, copyright = "Copyright (c) 2007-2010, Christopher Kuklewicz", maintainer = "TextRegexLazy@personal.mightyreason.com", author = "Christopher Kuklewicz", stability = "Seems to work, passes a few tests", homepage = "http://sourceforge.net/projects/lazy-regex", pkgUrl = "http://code.haskell.org/regex-posix/", description = "The posix regex backend for regex-base", category = "Text", exposed = True, exposedModules = [ModuleName ["Text","Regex","Posix"],ModuleName ["Text","Regex","Posix","Wrap"],ModuleName ["Text","Regex","Posix","String"],ModuleName ["Text","Regex","Posix","Sequence"],ModuleName ["Text","Regex","Posix","ByteString"],ModuleName ["Text","Regex","Posix","ByteString","Lazy"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/regex-posix-0.95.1/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/regex-posix-0.95.1/ghc-7.0.3"], hsLibraries = ["HSregex-posix-0.95.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e",InstalledPackageId "regex-base-0.93.2-ea22834f5565d6f16b2cec3e7a63917a"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/regex-posix-0.95.1/html/regex-posix.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/regex-posix-0.95.1/html"]}])]),(PackageName "rts",fromList [(Version {versionBranch = [1,0], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "builtin_rts", sourcePackageId = PackageIdentifier {pkgName = PackageName "rts", pkgVersion = Version {versionBranch = [1,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "glasgow-haskell-users@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "", category = "", exposed = True, exposedModules = [], hiddenModules = [], importDirs = [], libraryDirs = ["/usr/lib/ghc-7.0.3"], hsLibraries = ["HSrts"], extraLibraries = ["ffi","m","rt","dl"], extraGHCiLibraries = [], includeDirs = ["/usr/lib/ghc-7.0.3/include"], includes = ["Stg.h"], depends = [], hugsOptions = [], ccOptions = [], ldOptions = ["-u","ghczmprim_GHCziTypes_Izh_static_info","-u","ghczmprim_GHCziTypes_Czh_static_info","-u","ghczmprim_GHCziTypes_Fzh_static_info","-u","ghczmprim_GHCziTypes_Dzh_static_info","-u","base_GHCziPtr_Ptr_static_info","-u","base_GHCziWord_Wzh_static_info","-u","base_GHCziInt_I8zh_static_info","-u","base_GHCziInt_I16zh_static_info","-u","base_GHCziInt_I32zh_static_info","-u","base_GHCziInt_I64zh_static_info","-u","base_GHCziWord_W8zh_static_info","-u","base_GHCziWord_W16zh_static_info","-u","base_GHCziWord_W32zh_static_info","-u","base_GHCziWord_W64zh_static_info","-u","base_GHCziStable_StablePtr_static_info","-u","ghczmprim_GHCziTypes_Izh_con_info","-u","ghczmprim_GHCziTypes_Czh_con_info","-u","ghczmprim_GHCziTypes_Fzh_con_info","-u","ghczmprim_GHCziTypes_Dzh_con_info","-u","base_GHCziPtr_Ptr_con_info","-u","base_GHCziPtr_FunPtr_con_info","-u","base_GHCziStable_StablePtr_con_info","-u","ghczmprim_GHCziBool_False_closure","-u","ghczmprim_GHCziBool_True_closure","-u","base_GHCziPack_unpackCString_closure","-u","base_GHCziIOziException_stackOverflow_closure","-u","base_GHCziIOziException_heapOverflow_closure","-u","base_ControlziExceptionziBase_nonTermination_closure","-u","base_GHCziIOziException_blockedIndefinitelyOnMVar_closure","-u","base_GHCziIOziException_blockedIndefinitelyOnSTM_closure","-u","base_ControlziExceptionziBase_nestedAtomically_closure","-u","base_GHCziWeak_runFinalizzerBatch_closure","-u","base_GHCziTopHandler_runIO_closure","-u","base_GHCziTopHandler_runNonIO_closure","-u","base_GHCziConcziIO_ensureIOManagerIsRunning_closure","-u","base_GHCziConcziSync_runSparks_closure","-u","base_GHCziConcziSignal_runHandlers_closure"], frameworkDirs = [], frameworks = [], haddockInterfaces = [], haddockHTMLs = []}])]),(PackageName "shellish",fromList [(Version {versionBranch = [0,1,4], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "shellish-0.1.4-5b908e0ef83b4d4990e862a2d582acb1", sourcePackageId = PackageIdentifier {pkgName = PackageName "shellish", pkgVersion = Version {versionBranch = [0,1,4], versionTags = []}}, license = BSD3, copyright = "", maintainer = "me@mornfall.net", author = "Petr Rockai <me@mornfall.net>", stability = "", homepage = "http://repos.mornfall.net/shellish", pkgUrl = "", description = "The shellisg package provides a single module for convenient\n\\\"systems\\\" programming in Haskell, similar in spirit to POSIX\nshells or PERL.\n\n* Elegance and safety is sacrificed for conciseness and\nswiss-army-knife-ness.\n\n* The interface exported by Shellish is thread-safe.\n\nOverall, the module should help you to get a job done quickly,\nwithout getting too dirty.", category = "Development", exposed = True, exposedModules = [ModuleName ["Shellish"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/shellish-0.1.4/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/shellish-0.1.4/ghc-7.0.3"], hsLibraries = ["HSshellish-0.1.4"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "directory-1.1.0.0-393d8e95f1c0dd6ee908e122f924ac85",InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653",InstalledPackageId "mtl-2.0.1.0-5b7a9cce5565d8cc8721ba4f95becf1b",InstalledPackageId "process-1.0.1.5-da4848a2eec47420cd09fe9edba7e83c",InstalledPackageId "strict-0.3.2-0f622b96a8041532e7c92ccfb057496f",InstalledPackageId "time-1.2.0.3-3493203919ef238f1a58223fa55b1ceb",InstalledPackageId "unix-compat-0.2.1.1-dd8ef5a3a99896df43dc15cc23b08467"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/shellish-0.1.4/html/shellish.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/shellish-0.1.4/html"]}])]),(PackageName "split",fromList [(Version {versionBranch = [0,1,4], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "split-0.1.4-25b8dac0b87dfab6d3ad4b8a7e345e45", sourcePackageId = PackageIdentifier {pkgName = PackageName "split", pkgVersion = Version {versionBranch = [0,1,4], versionTags = []}}, license = BSD3, copyright = "", maintainer = "byorgey@cis.upenn.edu", author = "Brent Yorgey", stability = "stable", homepage = "http://code.haskell.org/~byorgey/code/split", pkgUrl = "", description = "Combinator library and utility functions for splitting lists.", category = "List", exposed = True, exposedModules = [ModuleName ["Data","List","Split"],ModuleName ["Data","List","Split","Internals"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/split-0.1.4/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/split-0.1.4/ghc-7.0.3"], hsLibraries = ["HSsplit-0.1.4"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/split-0.1.4/html/split.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/split-0.1.4/html"]}])]),(PackageName "strict",fromList [(Version {versionBranch = [0,3,2], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "strict-0.3.2-0f622b96a8041532e7c92ccfb057496f", sourcePackageId = PackageIdentifier {pkgName = PackageName "strict", pkgVersion = Version {versionBranch = [0,3,2], versionTags = []}}, license = BSD3, copyright = "(c) 2006-2007 by Roman Leshchinskiy", maintainer = "Don Stewart <dons@galois.com>", author = "Roman Leshchinskiy <rl@cse.unsw.edu.au>", stability = "", homepage = "http://www.cse.unsw.edu.au/~rl/code/strict.html", pkgUrl = "", description = "This package provides strict versions of some standard Haskell data\ntypes (pairs, Maybe and Either). It also contains strict IO\noperations.", category = "Data, System", exposed = True, exposedModules = [ModuleName ["Data","Strict","Tuple"],ModuleName ["Data","Strict","Maybe"],ModuleName ["Data","Strict","Either"],ModuleName ["Data","Strict"],ModuleName ["System","IO","Strict"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/strict-0.3.2/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/strict-0.3.2/ghc-7.0.3"], hsLibraries = ["HSstrict-0.3.2"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "array-0.3.0.2-143060371bda4ff52c270d1067551fe8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/strict-0.3.2/html/strict.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/strict-0.3.2/html"]}])]),(PackageName "syb",fromList [(Version {versionBranch = [0,3], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "syb-0.3-00d8c06f799942b01364e795b2a54d70", sourcePackageId = PackageIdentifier {pkgName = PackageName "syb", pkgVersion = Version {versionBranch = [0,3], versionTags = []}}, license = BSD3, copyright = "", maintainer = "generics@haskell.org", author = "Ralf Lammel, Simon Peyton Jones", stability = "provisional", homepage = "http://www.cs.uu.nl/wiki/GenericProgramming/SYB", pkgUrl = "", description = "This package contains the generics system described in the\n/Scrap Your Boilerplate/ papers (see\n<http://www.cs.uu.nl/wiki/GenericProgramming/SYB>).\nIt defines the @Data@ class of types permitting folding and unfolding\nof constructor applications, instances of this class for primitive\ntypes, and a variety of traversals.", category = "Generics", exposed = True, exposedModules = [ModuleName ["Data","Generics"],ModuleName ["Data","Generics","Basics"],ModuleName ["Data","Generics","Instances"],ModuleName ["Data","Generics","Aliases"],ModuleName ["Data","Generics","Schemes"],ModuleName ["Data","Generics","Text"],ModuleName ["Data","Generics","Twins"],ModuleName ["Data","Generics","Builders"],ModuleName ["Generics","SYB"],ModuleName ["Generics","SYB","Basics"],ModuleName ["Generics","SYB","Instances"],ModuleName ["Generics","SYB","Aliases"],ModuleName ["Generics","SYB","Schemes"],ModuleName ["Generics","SYB","Text"],ModuleName ["Generics","SYB","Twins"],ModuleName ["Generics","SYB","Builders"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/syb-0.3/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/syb-0.3/ghc-7.0.3"], hsLibraries = ["HSsyb-0.3"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/syb-0.3/syb.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-syb-doc/html/"]}])]),(PackageName "tar",fromList [(Version {versionBranch = [0,3,1,0], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "tar-0.3.1.0-e78ec4eae84b755f8263c8666140ed0b", sourcePackageId = PackageIdentifier {pkgName = PackageName "tar", pkgVersion = Version {versionBranch = [0,3,1,0], versionTags = []}}, license = BSD3, copyright = "2007 Bjorn Bringert <bjorn@bringert.net>\n2008-2009 Duncan Coutts <duncan@haskell.org>", maintainer = "Duncan Coutts <duncan@haskell.org>", author = "Bjorn Bringert <bjorn@bringert.net>\nDuncan Coutts <duncan@haskell.org>", stability = "", homepage = "", pkgUrl = "", description = "This library is for working with \\\"@.tar@\\\" archive files. It\ncan read and write a range of common variations of archive\nformat including V7, USTAR, POSIX and GNU formats. It provides\nsupport for packing and unpacking portable archives. This\nmakes it suitable for distribution but not backup because\ndetails like file ownership and exact permissions are not\npreserved.", category = "Codec", exposed = True, exposedModules = [ModuleName ["Codec","Archive","Tar"],ModuleName ["Codec","Archive","Tar","Entry"],ModuleName ["Codec","Archive","Tar","Check"]], hiddenModules = [ModuleName ["Codec","Archive","Tar","Types"],ModuleName ["Codec","Archive","Tar","Read"],ModuleName ["Codec","Archive","Tar","Write"],ModuleName ["Codec","Archive","Tar","Pack"],ModuleName ["Codec","Archive","Tar","Unpack"]], importDirs = ["/usr/lib/haskell-packages/ghc/lib/tar-0.3.1.0/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/tar-0.3.1.0/ghc-7.0.3"], hsLibraries = ["HStar-0.3.1.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "directory-1.1.0.0-393d8e95f1c0dd6ee908e122f924ac85",InstalledPackageId "filepath-1.2.0.0-b4f4cf7e95546b00f075372f0ccb0653",InstalledPackageId "old-time-1.0.0.6-7f15fd4b960098b2776b8c05bc17519f"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/tar-0.3.1.0/tar.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-tar-doc/html/"]}])]),(PackageName "template-haskell",fromList [(Version {versionBranch = [2,5,0,0], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "template-haskell-2.5.0.0-957162165c2e6480a35f6d14f7e5220f", sourcePackageId = PackageIdentifier {pkgName = PackageName "template-haskell", pkgVersion = Version {versionBranch = [2,5,0,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "Facilities for manipulating Haskell source code using Template Haskell.", category = "", exposed = True, exposedModules = [ModuleName ["Language","Haskell","TH","Syntax","Internals"],ModuleName ["Language","Haskell","TH","Syntax"],ModuleName ["Language","Haskell","TH","PprLib"],ModuleName ["Language","Haskell","TH","Ppr"],ModuleName ["Language","Haskell","TH","Lib"],ModuleName ["Language","Haskell","TH","Quote"],ModuleName ["Language","Haskell","TH"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/template-haskell-2.5.0.0"], libraryDirs = ["/usr/lib/ghc-7.0.3/template-haskell-2.5.0.0"], hsLibraries = ["HStemplate-haskell-2.5.0.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e",InstalledPackageId "pretty-1.0.1.2-f8dc299a95cc94a3e513e27c5b80f951"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/template-haskell-2.5.0.0/template-haskell.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/template-haskell-2.5.0.0"]}])]),(PackageName "terminfo",fromList [(Version {versionBranch = [0,3,1,3], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "terminfo-0.3.1.3-d898a3b030f2d808d2a44c5ff0e2a0e1", sourcePackageId = PackageIdentifier {pkgName = PackageName "terminfo", pkgVersion = Version {versionBranch = [0,3,1,3], versionTags = []}}, license = BSD3, copyright = "(c) Judah Jacobson", maintainer = "Judah Jacobson <judah.jacobson@gmail.com>", author = "Judah Jacobson", stability = "Experimental", homepage = "http://code.haskell.org/terminfo", pkgUrl = "", description = "This library provides an interface to the terminfo database (via bindings to the\ncurses library). Terminfo allows POSIX systems to interact with a variety of terminals\nusing a standard set of capabilities.", category = "User Interfaces", exposed = True, exposedModules = [ModuleName ["System","Console","Terminfo"],ModuleName ["System","Console","Terminfo","Base"],ModuleName ["System","Console","Terminfo","Cursor"],ModuleName ["System","Console","Terminfo","Color"],ModuleName ["System","Console","Terminfo","Edit"],ModuleName ["System","Console","Terminfo","Effects"],ModuleName ["System","Console","Terminfo","Keys"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/terminfo-0.3.1.3/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/terminfo-0.3.1.3/ghc-7.0.3"], hsLibraries = ["HSterminfo-0.3.1.3"], extraLibraries = ["ncurses"], extraGHCiLibraries = [], includeDirs = [], includes = ["ncurses.h","term.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/terminfo-0.3.1.3/terminfo.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-terminfo-doc/html/"]}])]),(PackageName "test-framework",fromList [(Version {versionBranch = [0,4,0], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "test-framework-0.4.0-3570e5fce12246859c27f7b4577044ed", sourcePackageId = PackageIdentifier {pkgName = PackageName "test-framework", pkgVersion = Version {versionBranch = [0,4,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Max Bolingbroke <batterseapower@hotmail.com>", author = "Max Bolingbroke <batterseapower@hotmail.com>", stability = "", homepage = "http://batterseapower.github.com/test-framework/", pkgUrl = "", description = "Allows tests such as QuickCheck properties and HUnit test cases to be assembled into test groups, run in\nparallel (but reported in deterministic order, to aid diff interpretation) and filtered and controlled by\ncommand line options. All of this comes with colored test output, progress reporting and test statistics output.", category = "Testing", exposed = True, exposedModules = [ModuleName ["Test","Framework"],ModuleName ["Test","Framework","Options"],ModuleName ["Test","Framework","Providers","API"],ModuleName ["Test","Framework","Runners","Console"],ModuleName ["Test","Framework","Runners","Options"],ModuleName ["Test","Framework","Seed"]], hiddenModules = [ModuleName ["Test","Framework","Core"],ModuleName ["Test","Framework","Improving"],ModuleName ["Test","Framework","Runners","Console","Colors"],ModuleName ["Test","Framework","Runners","Console","ProgressBar"],ModuleName ["Test","Framework","Runners","Console","Run"],ModuleName ["Test","Framework","Runners","Console","Statistics"],ModuleName ["Test","Framework","Runners","Console","Table"],ModuleName ["Test","Framework","Runners","Console","Utilities"],ModuleName ["Test","Framework","Runners","Core"],ModuleName ["Test","Framework","Runners","Processors"],ModuleName ["Test","Framework","Runners","Statistics"],ModuleName ["Test","Framework","Runners","TestPattern"],ModuleName ["Test","Framework","Runners","ThreadPool"],ModuleName ["Test","Framework","Runners","TimedConsumption"],ModuleName ["Test","Framework","Runners","XML","JUnitWriter"],ModuleName ["Test","Framework","Runners","XML"],ModuleName ["Test","Framework","Utilities"]], importDirs = ["/home/florent/.cabal/lib/test-framework-0.4.0/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/test-framework-0.4.0/ghc-7.0.3"], hsLibraries = ["HStest-framework-0.4.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "ansi-terminal-0.5.5-572a1d0154fb2632bb4e9431adf0cdb1",InstalledPackageId "ansi-wl-pprint-0.6.3-e572fb77d5bf7bcb04a7444a9b54f822",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "containers-0.4.0.0-b4885363abca642443ccd842502a3b7e",InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831",InstalledPackageId "hostname-1.0-75071817127be63d3548cd759f6b627c",InstalledPackageId "old-locale-1.0.0.2-161f79060c89cc16ca11576ceb440486",InstalledPackageId "random-1.0.0.3-7511feaba03eecc22356464da8976c7e",InstalledPackageId "regex-posix-0.95.1-a7a63b8d8d2c01aa7eca73b4f7221d81",InstalledPackageId "time-1.2.0.3-3493203919ef238f1a58223fa55b1ceb",InstalledPackageId "xml-1.3.8-f68d711e0aeaecb47b69c384ed0ad21a"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/test-framework-0.4.0/html/test-framework.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/test-framework-0.4.0/html"]}])]),(PackageName "test-framework-hunit",fromList [(Version {versionBranch = [0,2,6], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "test-framework-hunit-0.2.6-ca043988073add792f5cddeb80a08ce9", sourcePackageId = PackageIdentifier {pkgName = PackageName "test-framework-hunit", pkgVersion = Version {versionBranch = [0,2,6], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Max Bolingbroke <batterseapower@hotmail.com>", author = "Max Bolingbroke <batterseapower@hotmail.com>", stability = "", homepage = "http://batterseapower.github.com/test-framework/", pkgUrl = "", description = "", category = "Testing", exposed = True, exposedModules = [ModuleName ["Test","Framework","Providers","HUnit"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/test-framework-hunit-0.2.6/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/test-framework-hunit-0.2.6/ghc-7.0.3"], hsLibraries = ["HStest-framework-hunit-0.2.6"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "HUnit-1.2.2.3-8fe95e501b1318ef285c39ed79ca4209",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831",InstalledPackageId "test-framework-0.4.0-3570e5fce12246859c27f7b4577044ed"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/test-framework-hunit-0.2.6/html/test-framework-hunit.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/test-framework-hunit-0.2.6/html"]}])]),(PackageName "test-framework-quickcheck2",fromList [(Version {versionBranch = [0,2,10], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "test-framework-quickcheck2-0.2.10-48c3729ab4f2ea19741d59800542207a", sourcePackageId = PackageIdentifier {pkgName = PackageName "test-framework-quickcheck2", pkgVersion = Version {versionBranch = [0,2,10], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Max Bolingbroke <batterseapower@hotmail.com>", author = "Max Bolingbroke <batterseapower@hotmail.com>", stability = "", homepage = "http://batterseapower.github.com/test-framework/", pkgUrl = "", description = "", category = "Testing", exposed = True, exposedModules = [ModuleName ["Test","Framework","Providers","QuickCheck2"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/test-framework-quickcheck2-0.2.10/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/test-framework-quickcheck2-0.2.10/ghc-7.0.3"], hsLibraries = ["HStest-framework-quickcheck2-0.2.10"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "QuickCheck-2.4.1.1-6b2df10756c9ae534bddffc57c532df8",InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "extensible-exceptions-0.1.1.2-d8c5b906654260efd7249f497d17a831",InstalledPackageId "random-1.0.0.3-7511feaba03eecc22356464da8976c7e",InstalledPackageId "test-framework-0.4.0-3570e5fce12246859c27f7b4577044ed"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/test-framework-quickcheck2-0.2.10/html/test-framework-quickcheck2.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/test-framework-quickcheck2-0.2.10/html"]}])]),(PackageName "text",fromList [(Version {versionBranch = [0,11,0,6], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "text-0.11.0.6-139d7472dd2398472c7d962de013c741", sourcePackageId = PackageIdentifier {pkgName = PackageName "text", pkgVersion = Version {versionBranch = [0,11,0,6], versionTags = []}}, license = BSD3, copyright = "2008-2009 Tom Harper, 2009-2010 Bryan O'Sullivan", maintainer = "Bryan O'Sullivan <bos@serpentine.com>\nTom Harper <rtomharper@googlemail.com>\nDuncan Coutts <duncan@haskell.org>", author = "Bryan O'Sullivan <bos@serpentine.com>", stability = "", homepage = "http://bitbucket.org/bos/text", pkgUrl = "", description = ".\nAn efficient packed, immutable Unicode text type (both strict and\nlazy), with a powerful loop fusion optimization framework.\n\nThe 'Text' type represents Unicode character strings, in a time and\nspace-efficient manner. This package provides text processing\ncapabilities that are optimized for performance critical use, both\nin terms of large data quantities and high speed.\n\nThe 'Text' type provides character-encoding, type-safe case\nconversion via whole-string case conversion functions. It also\nprovides a range of functions for converting 'Text' values to and from\n'ByteStrings', using several standard encodings.\n\nEfficient locale-sensitive support for text IO is also supported.\n\nThese modules are intended to be imported qualified, to avoid name\nclashes with Prelude functions, e.g.\n\n> import qualified Data.Text as T\n\nTo use an extended and very rich family of functions for working\nwith Unicode text (including normalization, regular expressions,\nnon-standard encodings, text breaking, and locales), see\nthe @text-icu@ package:\n<http://hackage.haskell.org/package/text-icu>", category = "Data, Text", exposed = True, exposedModules = [ModuleName ["Data","Text"],ModuleName ["Data","Text","Array"],ModuleName ["Data","Text","Encoding"],ModuleName ["Data","Text","Encoding","Error"],ModuleName ["Data","Text","Foreign"],ModuleName ["Data","Text","IO"],ModuleName ["Data","Text","Internal"],ModuleName ["Data","Text","Lazy"],ModuleName ["Data","Text","Lazy","Builder"],ModuleName ["Data","Text","Lazy","Encoding"],ModuleName ["Data","Text","Lazy","IO"],ModuleName ["Data","Text","Lazy","Internal"],ModuleName ["Data","Text","Lazy","Read"],ModuleName ["Data","Text","Read"]], hiddenModules = [ModuleName ["Data","Text","Encoding","Fusion"],ModuleName ["Data","Text","Encoding","Fusion","Common"],ModuleName ["Data","Text","Encoding","Utf16"],ModuleName ["Data","Text","Encoding","Utf32"],ModuleName ["Data","Text","Encoding","Utf8"],ModuleName ["Data","Text","Fusion"],ModuleName ["Data","Text","Fusion","CaseMapping"],ModuleName ["Data","Text","Fusion","Common"],ModuleName ["Data","Text","Fusion","Internal"],ModuleName ["Data","Text","Fusion","Size"],ModuleName ["Data","Text","IO","Internal"],ModuleName ["Data","Text","Lazy","Encoding","Fusion"],ModuleName ["Data","Text","Lazy","Fusion"],ModuleName ["Data","Text","Lazy","Search"],ModuleName ["Data","Text","Search"],ModuleName ["Data","Text","Unsafe"],ModuleName ["Data","Text","UnsafeChar"],ModuleName ["Data","Text","UnsafeShift"],ModuleName ["Data","Text","Util"]], importDirs = ["/usr/lib/haskell-packages/ghc/lib/text-0.11.0.6/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/text-0.11.0.6/ghc-7.0.3"], hsLibraries = ["HStext-0.11.0.6"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4",InstalledPackageId "deepseq-1.1.0.2-0465f803f7d27d264907e7e03e72a71f",InstalledPackageId "ghc-prim-0.2.0.0-d9df11f804556f362beb0ea4e67261ba"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/text-0.11.0.6/text.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-text-doc/html/"]}])]),(PackageName "time",fromList [(Version {versionBranch = [1,2,0,3], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "time-1.2.0.3-3493203919ef238f1a58223fa55b1ceb", sourcePackageId = PackageIdentifier {pkgName = PackageName "time", pkgVersion = Version {versionBranch = [1,2,0,3], versionTags = []}}, license = BSD3, copyright = "", maintainer = "<ashley@semantic.org>", author = "Ashley Yakeley", stability = "stable", homepage = "http://semantic.org/TimeLib/", pkgUrl = "", description = "A time library", category = "System", exposed = True, exposedModules = [ModuleName ["Data","Time","Calendar"],ModuleName ["Data","Time","Calendar","MonthDay"],ModuleName ["Data","Time","Calendar","OrdinalDate"],ModuleName ["Data","Time","Calendar","WeekDate"],ModuleName ["Data","Time","Calendar","Julian"],ModuleName ["Data","Time","Calendar","Easter"],ModuleName ["Data","Time","Clock"],ModuleName ["Data","Time","Clock","POSIX"],ModuleName ["Data","Time","Clock","TAI"],ModuleName ["Data","Time","LocalTime"],ModuleName ["Data","Time","Format"],ModuleName ["Data","Time"]], hiddenModules = [ModuleName ["Data","Time","Calendar","Private"],ModuleName ["Data","Time","Calendar","Days"],ModuleName ["Data","Time","Calendar","Gregorian"],ModuleName ["Data","Time","Calendar","JulianYearDay"],ModuleName ["Data","Time","Clock","Scale"],ModuleName ["Data","Time","Clock","UTC"],ModuleName ["Data","Time","Clock","CTimeval"],ModuleName ["Data","Time","Clock","UTCDiff"],ModuleName ["Data","Time","LocalTime","TimeZone"],ModuleName ["Data","Time","LocalTime","TimeOfDay"],ModuleName ["Data","Time","LocalTime","LocalTime"],ModuleName ["Data","Time","Format","Parse"]], importDirs = ["/usr/lib/ghc-7.0.3/time-1.2.0.3"], libraryDirs = ["/usr/lib/ghc-7.0.3/time-1.2.0.3"], hsLibraries = ["HStime-1.2.0.3"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/ghc-7.0.3/time-1.2.0.3/include"], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "old-locale-1.0.0.2-161f79060c89cc16ca11576ceb440486"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/time-1.2.0.3/time.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/time-1.2.0.3"]}])]),(PackageName "transformers",fromList [(Version {versionBranch = [0,2,2,0], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "transformers-0.2.2.0-4bbbfde1fb5c4eb17cdb1963dda698f3", sourcePackageId = PackageIdentifier {pkgName = PackageName "transformers", pkgVersion = Version {versionBranch = [0,2,2,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Ross Paterson <ross@soi.city.ac.uk>", author = "Andy Gill, Ross Paterson", stability = "", homepage = "", pkgUrl = "", description = "Haskell 98 part of a monad transformer library, inspired by the paper\n\\\"Functional Programming with Overloading and Higher-Order Polymorphism\\\",\nby Mark P Jones, in /Advanced School of Functional Programming/, 1995\n(<http://web.cecs.pdx.edu/~mpj/pubs/springschool.html>).\n\nThis part contains the monad transformer class, the concrete monad\ntransformers, operations and liftings. It can be used on its own\nin Haskell 98 code, or with the monad classes in the @monads-fd@ or\n@monads-tf@ packages, which automatically lift operations introduced\nby monad transformers through other transformers.", category = "Control", exposed = True, exposedModules = [ModuleName ["Control","Monad","IO","Class"],ModuleName ["Control","Monad","Trans","Class"],ModuleName ["Control","Monad","Trans","Cont"],ModuleName ["Control","Monad","Trans","Error"],ModuleName ["Control","Monad","Trans","Identity"],ModuleName ["Control","Monad","Trans","List"],ModuleName ["Control","Monad","Trans","Maybe"],ModuleName ["Control","Monad","Trans","Reader"],ModuleName ["Control","Monad","Trans","RWS"],ModuleName ["Control","Monad","Trans","RWS","Lazy"],ModuleName ["Control","Monad","Trans","RWS","Strict"],ModuleName ["Control","Monad","Trans","State"],ModuleName ["Control","Monad","Trans","State","Lazy"],ModuleName ["Control","Monad","Trans","State","Strict"],ModuleName ["Control","Monad","Trans","Writer"],ModuleName ["Control","Monad","Trans","Writer","Lazy"],ModuleName ["Control","Monad","Trans","Writer","Strict"],ModuleName ["Data","Functor","Compose"],ModuleName ["Data","Functor","Constant"],ModuleName ["Data","Functor","Identity"],ModuleName ["Data","Functor","Product"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/transformers-0.2.2.0/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/transformers-0.2.2.0/ghc-7.0.3"], hsLibraries = ["HStransformers-0.2.2.0"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/transformers-0.2.2.0/transformers.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-transformers-doc/html/"]}])]),(PackageName "unix",fromList [(Version {versionBranch = [2,4,2,0], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff", sourcePackageId = PackageIdentifier {pkgName = PackageName "unix", pkgVersion = Version {versionBranch = [2,4,2,0], versionTags = []}}, license = BSD3, copyright = "", maintainer = "libraries@haskell.org", author = "", stability = "", homepage = "", pkgUrl = "", description = "This package gives you access to the set of operating system\nservices standardised by POSIX 1003.1b (or the IEEE Portable\nOperating System Interface for Computing Environments -\nIEEE Std. 1003.1).\n\nThe package is not supported under Windows (except under Cygwin).", category = "System", exposed = True, exposedModules = [ModuleName ["System","Posix"],ModuleName ["System","Posix","DynamicLinker","Module"],ModuleName ["System","Posix","DynamicLinker","Prim"],ModuleName ["System","Posix","Directory"],ModuleName ["System","Posix","DynamicLinker"],ModuleName ["System","Posix","Env"],ModuleName ["System","Posix","Error"],ModuleName ["System","Posix","Files"],ModuleName ["System","Posix","IO"],ModuleName ["System","Posix","Process"],ModuleName ["System","Posix","Process","Internals"],ModuleName ["System","Posix","Resource"],ModuleName ["System","Posix","Temp"],ModuleName ["System","Posix","Terminal"],ModuleName ["System","Posix","Time"],ModuleName ["System","Posix","Unistd"],ModuleName ["System","Posix","User"],ModuleName ["System","Posix","Signals"],ModuleName ["System","Posix","Signals","Exts"],ModuleName ["System","Posix","Semaphore"],ModuleName ["System","Posix","SharedMem"]], hiddenModules = [], importDirs = ["/usr/lib/ghc-7.0.3/unix-2.4.2.0"], libraryDirs = ["/usr/lib/ghc-7.0.3/unix-2.4.2.0"], hsLibraries = ["HSunix-2.4.2.0"], extraLibraries = ["rt","util","dl","pthread"], extraGHCiLibraries = [], includeDirs = ["/usr/lib/ghc-7.0.3/unix-2.4.2.0/include"], includes = ["HsUnix.h","execvpe.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/unix-2.4.2.0/unix.haddock"], haddockHTMLs = ["/usr/share/doc/ghc-doc/html/libraries/unix-2.4.2.0"]}])]),(PackageName "unix-compat",fromList [(Version {versionBranch = [0,2,1,1], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "unix-compat-0.2.1.1-dd8ef5a3a99896df43dc15cc23b08467", sourcePackageId = PackageIdentifier {pkgName = PackageName "unix-compat", pkgVersion = Version {versionBranch = [0,2,1,1], versionTags = []}}, license = BSD3, copyright = "", maintainer = "Jacob Stanley <jacob@stanley.io>", author = "Bj\246rn Bringert, Duncan Coutts, Jacob Stanley", stability = "", homepage = "http://github.com/jystic/unix-compat", pkgUrl = "", description = "This package provides portable implementations of parts\nof the unix package. This package re-exports the unix\npackage when available. When it isn't available,\nportable implementations are used.", category = "System", exposed = True, exposedModules = [ModuleName ["System","PosixCompat"],ModuleName ["System","PosixCompat","Extensions"],ModuleName ["System","PosixCompat","Files"],ModuleName ["System","PosixCompat","Time"],ModuleName ["System","PosixCompat","Types"],ModuleName ["System","PosixCompat","User"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/unix-compat-0.2.1.1/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/unix-compat-0.2.1.1/ghc-7.0.3"], hsLibraries = ["HSunix-compat-0.2.1.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/home/florent/.cabal/lib/unix-compat-0.2.1.1/ghc-7.0.3/include"], includes = ["HsUnixCompat.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "unix-2.4.2.0-58b1a2dba5afd4464c2e3918310189ff"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/unix-compat-0.2.1.1/html/unix-compat.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/unix-compat-0.2.1.1/html"]}])]),(PackageName "utf8-string",fromList [(Version {versionBranch = [0,3,6], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "utf8-string-0.3.6-48af7e77f29b232f389e99d0a9a1d604", sourcePackageId = PackageIdentifier {pkgName = PackageName "utf8-string", pkgVersion = Version {versionBranch = [0,3,6], versionTags = []}}, license = BSD3, copyright = "", maintainer = "emertens@galois.com", author = "Eric Mertens", stability = "", homepage = "http://github.com/glguy/utf8-string/", pkgUrl = "", description = "A UTF8 layer for IO and Strings. The utf8-string\npackage provides operations for encoding UTF8\nstrings to Word8 lists and back, and for reading and\nwriting UTF8 without truncation.", category = "Codec", exposed = True, exposedModules = [ModuleName ["Codec","Binary","UTF8","String"],ModuleName ["Codec","Binary","UTF8","Generic"],ModuleName ["System","IO","UTF8"],ModuleName ["System","Environment","UTF8"],ModuleName ["Data","String","UTF8"],ModuleName ["Data","ByteString","UTF8"],ModuleName ["Data","ByteString","Lazy","UTF8"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/utf8-string-0.3.6/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/utf8-string-0.3.6/ghc-7.0.3"], hsLibraries = ["HSutf8-string-0.3.6"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/utf8-string-0.3.6/utf8-string.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-utf8-string-doc/html/"]}])]),(PackageName "vector",fromList [(Version {versionBranch = [0,7,0,1], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "vector-0.7.0.1-f3d66d9edbfc37118398d6cdca0ca5ee", sourcePackageId = PackageIdentifier {pkgName = PackageName "vector", pkgVersion = Version {versionBranch = [0,7,0,1], versionTags = []}}, license = BSD3, copyright = "(c) Roman Leshchinskiy 2008-2010", maintainer = "Roman Leshchinskiy <rl@cse.unsw.edu.au>", author = "Roman Leshchinskiy <rl@cse.unsw.edu.au>", stability = "", homepage = "http://code.haskell.org/vector", pkgUrl = "", description = ".\nAn efficient implementation of Int-indexed arrays (both mutable\nand immutable), with a powerful loop fusion optimization framework .\n\nIt is structured as follows:\n\n[@Data.Vector@] Boxed vectors of arbitrary types.\n\n[@Data.Vector.Unboxed@] Unboxed vectors with an adaptive\nrepresentation based on data type families.\n\n[@Data.Vector.Storable@] Unboxed vectors of 'Storable' types.\n\n[@Data.Vector.Primitive@] Unboxed vectors of primitive types as\ndefined by the @primitive@ package. @Data.Vector.Unboxed@ is more\nflexible at no performance cost.\n\n[@Data.Vector.Generic@] Generic interface to the vector types.\n\nThere is also a (draft) tutorial on common uses of vector.\n\n* <http://haskell.org/haskellwiki/Numeric_Haskell:_A_Vector_Tutorial>\n\nPlease use the project trac to submit bug reports and feature\nrequests.\n\n* <http://trac.haskell.org/vector>\n\nChanges in version 0.7.0.1\n\n* Dependency on package ghc removed\n\nChanges in version 0.7\n\n* New functions for freezing, copying and thawing vectors: @freeze@,\n@thaw@, @unsafeThaw@ and @clone@\n\n* @newWith@ and @newUnsafeWith@ on mutable vectors replaced by\n@replicate@\n\n* New function: @concat@\n\n* New function for safe indexing: @(!?)@\n\n* @Monoid@ instances for all vector types\n\n* Significant recycling and fusion improvements\n\n* Bug fixes\n\n* Support for GHC 7.0", category = "Data, Data Structures", exposed = True, exposedModules = [ModuleName ["Data","Vector","Internal","Check"],ModuleName ["Data","Vector","Fusion","Util"],ModuleName ["Data","Vector","Fusion","Stream","Size"],ModuleName ["Data","Vector","Fusion","Stream","Monadic"],ModuleName ["Data","Vector","Fusion","Stream"],ModuleName ["Data","Vector","Generic","Mutable"],ModuleName ["Data","Vector","Generic","Base"],ModuleName ["Data","Vector","Generic","New"],ModuleName ["Data","Vector","Generic"],ModuleName ["Data","Vector","Primitive","Mutable"],ModuleName ["Data","Vector","Primitive"],ModuleName ["Data","Vector","Storable","Internal"],ModuleName ["Data","Vector","Storable","Mutable"],ModuleName ["Data","Vector","Storable"],ModuleName ["Data","Vector","Unboxed","Base"],ModuleName ["Data","Vector","Unboxed","Mutable"],ModuleName ["Data","Vector","Unboxed"],ModuleName ["Data","Vector","Mutable"],ModuleName ["Data","Vector"]], hiddenModules = [], importDirs = ["/usr/lib/haskell-packages/ghc/lib/vector-0.7.0.1/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/vector-0.7.0.1/ghc-7.0.3"], hsLibraries = ["HSvector-0.7.0.1"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = ["/usr/lib/haskell-packages/ghc/lib/vector-0.7.0.1/ghc-7.0.3/include"], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "primitive-0.3.1-c9e4468cc744c0e030467f8c31383955"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/vector-0.7.0.1/vector.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-vector-doc/html/"]}])]),(PackageName "xml",fromList [(Version {versionBranch = [1,3,8], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "xml-1.3.8-f68d711e0aeaecb47b69c384ed0ad21a", sourcePackageId = PackageIdentifier {pkgName = PackageName "xml", pkgVersion = Version {versionBranch = [1,3,8], versionTags = []}}, license = BSD3, copyright = "(c) 2007-2008 Galois Inc.", maintainer = "diatchki@galois.com", author = "Galois Inc.", stability = "", homepage = "http://code.galois.com", pkgUrl = "", description = "A simple XML library.", category = "Text, XML", exposed = True, exposedModules = [ModuleName ["Text","XML","Light"],ModuleName ["Text","XML","Light","Types"],ModuleName ["Text","XML","Light","Output"],ModuleName ["Text","XML","Light","Input"],ModuleName ["Text","XML","Light","Lexer"],ModuleName ["Text","XML","Light","Proc"],ModuleName ["Text","XML","Light","Cursor"]], hiddenModules = [], importDirs = ["/home/florent/.cabal/lib/xml-1.3.8/ghc-7.0.3"], libraryDirs = ["/home/florent/.cabal/lib/xml-1.3.8/ghc-7.0.3"], hsLibraries = ["HSxml-1.3.8"], extraLibraries = [], extraGHCiLibraries = [], includeDirs = [], includes = [], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/home/florent/.cabal/share/doc/xml-1.3.8/html/xml.haddock"], haddockHTMLs = ["/home/florent/.cabal/share/doc/xml-1.3.8/html"]}])]),(PackageName "zlib",fromList [(Version {versionBranch = [0,5,3,1], versionTags = []},[InstalledPackageInfo {installedPackageId = InstalledPackageId "zlib-0.5.3.1-7e19941cbd00147a79723e25160ffc8b", sourcePackageId = PackageIdentifier {pkgName = PackageName "zlib", pkgVersion = Version {versionBranch = [0,5,3,1], versionTags = []}}, license = BSD3, copyright = "(c) 2006-2008 Duncan Coutts", maintainer = "Duncan Coutts <duncan@community.haskell.org>", author = "Duncan Coutts <duncan@community.haskell.org>", stability = "", homepage = "", pkgUrl = "", description = "This package provides a pure interface for compressing and\ndecompressing streams of data represented as lazy\n'ByteString's. It uses the zlib C library so it has high\nperformance. It supports the \\\"zlib\\\", \\\"gzip\\\" and \\\"raw\\\"\ncompression formats.\n\nIt provides a convenient high level API suitable for most\ntasks and for the few cases where more control is needed it\nprovides access to the full zlib feature set.", category = "Codec", exposed = True, exposedModules = [ModuleName ["Codec","Compression","GZip"],ModuleName ["Codec","Compression","Zlib"],ModuleName ["Codec","Compression","Zlib","Raw"],ModuleName ["Codec","Compression","Zlib","Internal"]], hiddenModules = [ModuleName ["Codec","Compression","Zlib","Stream"]], importDirs = ["/usr/lib/haskell-packages/ghc/lib/zlib-0.5.3.1/ghc-7.0.3"], libraryDirs = ["/usr/lib/haskell-packages/ghc/lib/zlib-0.5.3.1/ghc-7.0.3"], hsLibraries = ["HSzlib-0.5.3.1"], extraLibraries = ["z"], extraGHCiLibraries = [], includeDirs = [], includes = ["zlib.h"], depends = [InstalledPackageId "base-4.3.1.0-91c3839608ff4d3ec95f734c5ae4f31c",InstalledPackageId "bytestring-0.9.1.10-6aa1efbfa95d1689fc03d61e7c4b27c4"], hugsOptions = [], ccOptions = [], ldOptions = [], frameworkDirs = [], frameworks = [], haddockInterfaces = ["/usr/lib/ghc-7.0.3/haddock/zlib-0.5.3.1/zlib.haddock"], haddockHTMLs = ["/usr/share/doc/libghc-zlib-doc/html/"]}])])]), pkgDescrFile = Just "./darcs-beta.cabal", localPkgDescr = PackageDescription {package = PackageIdentifier {pkgName = PackageName "darcs-beta", pkgVersion = Version {versionBranch = [2,7,98,1], versionTags = []}}, license = GPL Nothing, licenseFile = "COPYING", copyright = "", maintainer = "<darcs-users@darcs.net>", author = "David Roundy <droundy@darcs.net>, <darcs-users@darcs.net>", stability = "Experimental", testedWith = [(GHC,ThisVersion (Version {versionBranch = [6,8,2], versionTags = []}))], homepage = "http://darcs.net/", pkgUrl = "", bugReports = "", sourceRepos = [SourceRepo {repoKind = RepoHead, repoType = Just Darcs, repoLocation = Just "http://darcs.net/", repoModule = Nothing, repoBranch = Nothing, repoTag = Nothing, repoSubdir = Nothing}], synopsis = "a distributed, interactive, smart revision control system", description = "Darcs is a free, open source revision control\nsystem. It is:\n\n* Distributed: Every user has access to the full\ncommand set, removing boundaries between server and\nclient or committer and non-committers.\n\n* Interactive: Darcs is easy to learn and efficient to\nuse because it asks you questions in response to\nsimple commands, giving you choices in your work\nflow. You can choose to record one change in a file,\nwhile ignoring another. As you update from upstream,\nyou can review each patch name, even the full \"diff\"\nfor interesting patches.\n\n* Smart: Originally developed by physicist David\nRoundy, darcs is based on a unique algebra of\npatches.\n\nThis smartness lets you respond to changing demands\nin ways that would otherwise not be possible. Learn\nmore about spontaneous branches with darcs.", category = "Development", customFieldsPD = [], buildDepends = [Dependency (PackageName "HTTP") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [3000,0], versionTags = []})) (LaterVersion (Version {versionBranch = [3000,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [4000,2], versionTags = []}))) (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [3000,0], versionTags = []})) (LaterVersion (Version {versionBranch = [3000,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [4000,2], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [3000,0], versionTags = []})) (LaterVersion (Version {versionBranch = [3000,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [4000,2], versionTags = []}))))),Dependency (PackageName "HUnit") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0], versionTags = []}))),Dependency (PackageName "QuickCheck") (UnionVersionRanges (ThisVersion (Version {versionBranch = [2,3], versionTags = []})) (LaterVersion (Version {versionBranch = [2,3], versionTags = []}))),Dependency (PackageName "array") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,4], versionTags = []}))) (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,4], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,4], versionTags = []}))))),Dependency (PackageName "base") (IntersectVersionRanges (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4], versionTags = []})) (LaterVersion (Version {versionBranch = [4], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4], versionTags = []})) (LaterVersion (Version {versionBranch = [4], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []})))) (IntersectVersionRanges (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4], versionTags = []})) (LaterVersion (Version {versionBranch = [4], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))) (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4], versionTags = []})) (LaterVersion (Version {versionBranch = [4], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4], versionTags = []})) (LaterVersion (Version {versionBranch = [4], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []})))))),Dependency (PackageName "bytestring") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,9,0], versionTags = []})) (LaterVersion (Version {versionBranch = [0,9,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,10], versionTags = []}))) (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,9,0], versionTags = []})) (LaterVersion (Version {versionBranch = [0,9,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,10], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,9,0], versionTags = []})) (LaterVersion (Version {versionBranch = [0,9,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,10], versionTags = []}))))),Dependency (PackageName "cmdlib") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,2,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,2,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,4], versionTags = []}))),Dependency (PackageName "containers") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,5], versionTags = []}))) (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,5], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,5], versionTags = []}))))),Dependency (PackageName "directory") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0,0,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0,0,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [1,2,0,0], versionTags = []}))) (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0,0,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0,0,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [1,2,0,0], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0,0,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0,0,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [1,2,0,0], versionTags = []}))))),Dependency (PackageName "extensible-exceptions") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,2], versionTags = []}))) (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,2], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,2], versionTags = []}))))),Dependency (PackageName "filepath") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,1,0,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,1,0,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [1,3,0,0], versionTags = []}))) (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,1,0,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,1,0,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [1,3,0,0], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,1,0,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,1,0,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [1,3,0,0], versionTags = []}))))),Dependency (PackageName "hashed-storage") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5,6], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5,6], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6], versionTags = []}))) (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5,6], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5,6], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5,6], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5,6], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6], versionTags = []}))))),Dependency (PackageName "haskeline") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,6,3], versionTags = []})) (LaterVersion (Version {versionBranch = [0,6,3], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,7], versionTags = []}))) (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,6,3], versionTags = []})) (LaterVersion (Version {versionBranch = [0,6,3], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,7], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,6,3], versionTags = []})) (LaterVersion (Version {versionBranch = [0,6,3], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,7], versionTags = []}))))),Dependency (PackageName "html") (IntersectVersionRanges (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})) (IntersectVersionRanges (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})) (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})))),Dependency (PackageName "mmap") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6], versionTags = []}))) (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6], versionTags = []}))))),Dependency (PackageName "mtl") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,1], versionTags = []}))) (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,1], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,1], versionTags = []}))))),Dependency (PackageName "network") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [2,2], versionTags = []})) (LaterVersion (Version {versionBranch = [2,2], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,4], versionTags = []}))) (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [2,2], versionTags = []})) (LaterVersion (Version {versionBranch = [2,2], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,4], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [2,2], versionTags = []})) (LaterVersion (Version {versionBranch = [2,2], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,4], versionTags = []}))))),Dependency (PackageName "old-time") (IntersectVersionRanges (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})) (IntersectVersionRanges (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})) (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})))),Dependency (PackageName "parsec") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [2,0], versionTags = []})) (LaterVersion (Version {versionBranch = [2,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [3,2], versionTags = []}))) (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [2,0], versionTags = []})) (LaterVersion (Version {versionBranch = [2,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [3,2], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [2,0], versionTags = []})) (LaterVersion (Version {versionBranch = [2,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [3,2], versionTags = []}))))),Dependency (PackageName "process") (IntersectVersionRanges (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})) (IntersectVersionRanges (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})) (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})))),Dependency (PackageName "random") (IntersectVersionRanges (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})) (IntersectVersionRanges (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})) (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})))),Dependency (PackageName "regex-compat") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,95,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,95,1], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,95,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,95,1], versionTags = []}))) (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,95,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,95,1], versionTags = []}))))),Dependency (PackageName "shellish") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1,3], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1,3], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,2], versionTags = []}))),Dependency (PackageName "tar") (IntersectVersionRanges (WildcardVersion (Version {versionBranch = [0,3], versionTags = []})) (IntersectVersionRanges (WildcardVersion (Version {versionBranch = [0,3], versionTags = []})) (WildcardVersion (Version {versionBranch = [0,3], versionTags = []})))),Dependency (PackageName "terminfo") (IntersectVersionRanges (WildcardVersion (Version {versionBranch = [0,3], versionTags = []})) (IntersectVersionRanges (WildcardVersion (Version {versionBranch = [0,3], versionTags = []})) (WildcardVersion (Version {versionBranch = [0,3], versionTags = []})))),Dependency (PackageName "test-framework") (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,2,2], versionTags = []})) (LaterVersion (Version {versionBranch = [0,2,2], versionTags = []}))),Dependency (PackageName "test-framework-hunit") (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,2,2], versionTags = []})) (LaterVersion (Version {versionBranch = [0,2,2], versionTags = []}))),Dependency (PackageName "test-framework-quickcheck2") (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,2,8], versionTags = []})) (LaterVersion (Version {versionBranch = [0,2,8], versionTags = []}))),Dependency (PackageName "text") (IntersectVersionRanges (WildcardVersion (Version {versionBranch = [0,11], versionTags = []})) (IntersectVersionRanges (WildcardVersion (Version {versionBranch = [0,11], versionTags = []})) (WildcardVersion (Version {versionBranch = [0,11], versionTags = []})))),Dependency (PackageName "unix") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,5], versionTags = []}))) (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,5], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,5], versionTags = []}))))),Dependency (PackageName "vector") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,7], versionTags = []})) (LaterVersion (Version {versionBranch = [0,7], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,7], versionTags = []})) (LaterVersion (Version {versionBranch = [0,7], versionTags = []}))) (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,7], versionTags = []})) (LaterVersion (Version {versionBranch = [0,7], versionTags = []}))))),Dependency (PackageName "zlib") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5,1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5,1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6,0,0], versionTags = []}))) (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5,1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5,1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6,0,0], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5,1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5,1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6,0,0], versionTags = []})))))], specVersionRaw = Right (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,8], versionTags = []})) (LaterVersion (Version {versionBranch = [1,8], versionTags = []}))), buildType = Just Custom, library = Just (Library {exposedModules = [ModuleName ["CommandLine"],ModuleName ["Crypt","SHA256"],ModuleName ["Darcs","Annotate"],ModuleName ["Darcs","ArgumentDefaults"],ModuleName ["Darcs","Arguments"],ModuleName ["Darcs","Bug"],ModuleName ["Darcs","ColorPrinter"],ModuleName ["Darcs","Commands"],ModuleName ["Darcs","Commands","Add"],ModuleName ["Darcs","Commands","AmendRecord"],ModuleName ["Darcs","Commands","Annotate"],ModuleName ["Darcs","Commands","Apply"],ModuleName ["Darcs","CommandsAux"],ModuleName ["Darcs","Commands","Changes"],ModuleName ["Darcs","Commands","Check"],ModuleName ["Darcs","Commands","Convert"],ModuleName ["Darcs","Commands","Diff"],ModuleName ["Darcs","Commands","Dist"],ModuleName ["Darcs","Commands","Get"],ModuleName ["Darcs","Commands","GZCRCs"],ModuleName ["Darcs","Commands","Help"],ModuleName ["Darcs","Commands","Init"],ModuleName ["Darcs","Commands","MarkConflicts"],ModuleName ["Darcs","Commands","Move"],ModuleName ["Darcs","Commands","Optimize"],ModuleName ["Darcs","Commands","Pull"],ModuleName ["Darcs","Commands","Push"],ModuleName ["Darcs","Commands","Put"],ModuleName ["Darcs","Commands","Record"],ModuleName ["Darcs","Commands","Remove"],ModuleName ["Darcs","Commands","Replace"],ModuleName ["Darcs","Commands","Revert"],ModuleName ["Darcs","Commands","Rollback"],ModuleName ["Darcs","Commands","Send"],ModuleName ["Darcs","Commands","SetPref"],ModuleName ["Darcs","Commands","Show"],ModuleName ["Darcs","Commands","ShowAuthors"],ModuleName ["Darcs","Commands","ShowBug"],ModuleName ["Darcs","Commands","ShowContents"],ModuleName ["Darcs","Commands","ShowFiles"],ModuleName ["Darcs","Commands","ShowIndex"],ModuleName ["Darcs","Commands","ShowRepo"],ModuleName ["Darcs","Commands","ShowTags"],ModuleName ["Darcs","Commands","Tag"],ModuleName ["Darcs","Commands","TrackDown"],ModuleName ["Darcs","Commands","TransferMode"],ModuleName ["Darcs","Commands","Util"],ModuleName ["Darcs","Commands","Unrecord"],ModuleName ["Darcs","Commands","Unrevert"],ModuleName ["Darcs","Commands","WhatsNew"],ModuleName ["Darcs","Compat"],ModuleName ["Darcs","Diff"],ModuleName ["Darcs","Email"],ModuleName ["Darcs","External"],ModuleName ["Darcs","Flags"],ModuleName ["Darcs","Global"],ModuleName ["Darcs","IO"],ModuleName ["Darcs","Lock"],ModuleName ["Darcs","Match"],ModuleName ["Darcs","MonadProgress"],ModuleName ["Darcs","Patch"],ModuleName ["Darcs","Patch","Apply"],ModuleName ["Darcs","Patch","ApplyMonad"],ModuleName ["Darcs","Patch","Bracketed"],ModuleName ["Darcs","Patch","Bracketed","Instances"],ModuleName ["Darcs","Patch","Bundle"],ModuleName ["Darcs","Patch","Choices"],ModuleName ["Darcs","Patch","Commute"],ModuleName ["Darcs","Patch","Conflict"],ModuleName ["Darcs","Patch","ConflictMarking"],ModuleName ["Darcs","Patch","Depends"],ModuleName ["Darcs","Patch","Dummy"],ModuleName ["Darcs","Patch","Effect"],ModuleName ["Darcs","Patch","FileName"],ModuleName ["Darcs","Patch","FileHunk"],ModuleName ["Darcs","Patch","Format"],ModuleName ["Darcs","Patch","Info"],ModuleName ["Darcs","Patch","Inspect"],ModuleName ["Darcs","Patch","Invert"],ModuleName ["Darcs","Patch","Match"],ModuleName ["Darcs","Patch","MatchData"],ModuleName ["Darcs","Patch","Merge"],ModuleName ["Darcs","Patch","Named"],ModuleName ["Darcs","Patch","OldDate"],ModuleName ["Darcs","Patch","PatchInfoAnd"],ModuleName ["Darcs","Patch","Patchy"],ModuleName ["Darcs","Patch","Patchy","Instances"],ModuleName ["Darcs","Patch","Permutations"],ModuleName ["Darcs","Patch","Prim"],ModuleName ["Darcs","Patch","Prim","Class"],ModuleName ["Darcs","Patch","Prim","V1"],ModuleName ["Darcs","Patch","Prim","V1","Apply"],ModuleName ["Darcs","Patch","Prim","V1","Coalesce"],ModuleName ["Darcs","Patch","Prim","V1","Commute"],ModuleName ["Darcs","Patch","Prim","V1","Core"],ModuleName ["Darcs","Patch","Prim","V1","Details"],ModuleName ["Darcs","Patch","Prim","V1","Read"],ModuleName ["Darcs","Patch","Prim","V1","Show"],ModuleName ["Darcs","Patch","Read"],ModuleName ["Darcs","Patch","ReadMonads"],ModuleName ["Darcs","Patch","RegChars"],ModuleName ["Darcs","Patch","Repair"],ModuleName ["Darcs","Patch","RepoPatch"],ModuleName ["Darcs","Patch","Set"],ModuleName ["Darcs","Patch","Show"],ModuleName ["Darcs","Patch","Split"],ModuleName ["Darcs","Patch","Summary"],ModuleName ["Darcs","Patch","SummaryData"],ModuleName ["Darcs","Patch","TokenReplace"],ModuleName ["Darcs","Patch","TouchesFiles"],ModuleName ["Darcs","Patch","Viewing"],ModuleName ["Darcs","Patch","V1"],ModuleName ["Darcs","Patch","V1","Apply"],ModuleName ["Darcs","Patch","V1","Commute"],ModuleName ["Darcs","Patch","V1","Core"],ModuleName ["Darcs","Patch","V1","Read"],ModuleName ["Darcs","Patch","V1","Show"],ModuleName ["Darcs","Patch","V1","Viewing"],ModuleName ["Darcs","Patch","V2"],ModuleName ["Darcs","Patch","V2","Non"],ModuleName ["Darcs","Patch","V2","Real"],ModuleName ["Darcs","PrintPatch"],ModuleName ["Darcs","ProgressPatches"],ModuleName ["Darcs","RemoteApply"],ModuleName ["Darcs","RepoPath"],ModuleName ["Darcs","Repository"],ModuleName ["Darcs","Repository","ApplyPatches"],ModuleName ["Darcs","Repository","Cache"],ModuleName ["Darcs","Repository","Format"],ModuleName ["Darcs","Repository","HashedIO"],ModuleName ["Darcs","Repository","HashedRepo"],ModuleName ["Darcs","Repository","Internal"],ModuleName ["Darcs","Repository","LowLevel"],ModuleName ["Darcs","Repository","Merge"],ModuleName ["Darcs","Repository","InternalTypes"],ModuleName ["Darcs","Repository","Motd"],ModuleName ["Darcs","Repository","Old"],ModuleName ["Darcs","Repository","Prefs"],ModuleName ["Darcs","Repository","Repair"],ModuleName ["Darcs","Repository","State"],ModuleName ["Darcs","Resolution"],ModuleName ["Darcs","RunCommand"],ModuleName ["Darcs","SelectChanges"],ModuleName ["Darcs","SignalHandler"],ModuleName ["Darcs","Test"],ModuleName ["Darcs","TheCommands"],ModuleName ["Darcs","URL"],ModuleName ["Darcs","Utils"],ModuleName ["Darcs","Witnesses","Eq"],ModuleName ["Darcs","Witnesses","Ordered"],ModuleName ["Darcs","Witnesses","Sealed"],ModuleName ["Darcs","Witnesses","Show"],ModuleName ["Darcs","Witnesses","Unsafe"],ModuleName ["Darcs","Witnesses","WZipper"],ModuleName ["DateMatcher"],ModuleName ["English"],ModuleName ["Exec"],ModuleName ["ByteStringUtils"],ModuleName ["HTTP"],ModuleName ["IsoDate"],ModuleName ["Lcs"],ModuleName ["Printer"],ModuleName ["Progress"],ModuleName ["Ratified"],ModuleName ["SHA1"],ModuleName ["Ssh"],ModuleName ["URL"],ModuleName ["Workaround"]], libExposed = True, libBuildInfo = BuildInfo {buildable = True, buildTools = [], cppOptions = ["-DHAVE_CURL","-DHAVE_HTTP","-DHAVE_MMAP","-DHAVE_TERMINFO","-DGADT_WITNESSES=1"], ccOptions = ["-DHAVE_CURL","-D_REENTRANT"], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = ["src/hscurl.c","src/atomic_create.c","src/fpstring.c","src/maybe_relink.c","src/umask.c","src/Crypt/sha2.c"], hsSourceDirs = ["src"], otherModules = [ModuleName ["Version"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [CPP,BangPatterns,PatternGuards,GADTs,TypeOperators,FlexibleContexts,FlexibleInstances,ScopedTypeVariables,KindSignatures,RankNTypes,TypeFamilies,UnknownExtension "NoMonoLocalBinds"], extraLibs = ["curl"], extraLibDirs = [], includeDirs = ["src"], includes = ["curl/curl.h"], installIncludes = [], options = [(GHC,["-O2"]),(GHC,["-Wall","-funbox-strict-fields","-fwarn-tabs"])], ghcProfOptions = ["-prof","-auto-all"], ghcSharedOptions = [], customFieldsBI = [("x-have-http",""),("x-use-color","")], targetBuildDepends = [Dependency (PackageName "HTTP") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [3000,0], versionTags = []})) (LaterVersion (Version {versionBranch = [3000,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [4000,2], versionTags = []}))),Dependency (PackageName "array") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,4], versionTags = []}))),Dependency (PackageName "base") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4], versionTags = []})) (LaterVersion (Version {versionBranch = [4], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4], versionTags = []})) (LaterVersion (Version {versionBranch = [4], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []})))),Dependency (PackageName "bytestring") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,9,0], versionTags = []})) (LaterVersion (Version {versionBranch = [0,9,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,10], versionTags = []}))),Dependency (PackageName "containers") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,5], versionTags = []}))),Dependency (PackageName "directory") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0,0,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0,0,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [1,2,0,0], versionTags = []}))),Dependency (PackageName "extensible-exceptions") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,2], versionTags = []}))),Dependency (PackageName "filepath") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,1,0,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,1,0,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [1,3,0,0], versionTags = []}))),Dependency (PackageName "hashed-storage") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5,6], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5,6], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6], versionTags = []}))),Dependency (PackageName "haskeline") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,6,3], versionTags = []})) (LaterVersion (Version {versionBranch = [0,6,3], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,7], versionTags = []}))),Dependency (PackageName "html") (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})),Dependency (PackageName "mmap") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6], versionTags = []}))),Dependency (PackageName "mtl") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,1], versionTags = []}))),Dependency (PackageName "network") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [2,2], versionTags = []})) (LaterVersion (Version {versionBranch = [2,2], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,4], versionTags = []}))),Dependency (PackageName "old-time") (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})),Dependency (PackageName "parsec") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [2,0], versionTags = []})) (LaterVersion (Version {versionBranch = [2,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [3,2], versionTags = []}))),Dependency (PackageName "process") (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})),Dependency (PackageName "random") (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})),Dependency (PackageName "regex-compat") (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,95,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,95,1], versionTags = []}))),Dependency (PackageName "tar") (WildcardVersion (Version {versionBranch = [0,3], versionTags = []})),Dependency (PackageName "terminfo") (WildcardVersion (Version {versionBranch = [0,3], versionTags = []})),Dependency (PackageName "text") (WildcardVersion (Version {versionBranch = [0,11], versionTags = []})),Dependency (PackageName "unix") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,5], versionTags = []}))),Dependency (PackageName "vector") (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,7], versionTags = []})) (LaterVersion (Version {versionBranch = [0,7], versionTags = []}))),Dependency (PackageName "zlib") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5,1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5,1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6,0,0], versionTags = []})))]}}), executables = [Executable {exeName = "darcs", modulePath = "darcs.hs", buildInfo = BuildInfo {buildable = True, buildTools = [], cppOptions = ["-DHAVE_CURL","-DHAVE_HTTP","-DHAVE_MMAP","-DHAVE_TERMINFO"], ccOptions = ["-DHAVE_CURL","-D_REENTRANT"], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = ["src/hscurl.c","src/atomic_create.c","src/fpstring.c","src/maybe_relink.c","src/umask.c","src/Crypt/sha2.c"], hsSourceDirs = ["src"], otherModules = [], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [CPP,BangPatterns,PatternGuards,GADTs,TypeOperators,FlexibleContexts,FlexibleInstances,ScopedTypeVariables,KindSignatures,RankNTypes,TypeFamilies,UnknownExtension "NoMonoLocalBinds"], extraLibs = ["curl"], extraLibDirs = [], includeDirs = ["src"], includes = ["curl/curl.h"], installIncludes = [], options = [(GHC,["-O2"]),(GHC,["-Wall","-funbox-strict-fields","-fwarn-tabs"]),(GHC,["-threaded"])], ghcProfOptions = ["-prof","-auto-all"], ghcSharedOptions = [], customFieldsBI = [("x-have-http",""),("x-use-color","")], targetBuildDepends = [Dependency (PackageName "HTTP") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [3000,0], versionTags = []})) (LaterVersion (Version {versionBranch = [3000,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [4000,2], versionTags = []}))),Dependency (PackageName "array") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,4], versionTags = []}))),Dependency (PackageName "base") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4], versionTags = []})) (LaterVersion (Version {versionBranch = [4], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))) (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4], versionTags = []})) (LaterVersion (Version {versionBranch = [4], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []})))),Dependency (PackageName "bytestring") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,9,0], versionTags = []})) (LaterVersion (Version {versionBranch = [0,9,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,10], versionTags = []}))),Dependency (PackageName "containers") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,5], versionTags = []}))),Dependency (PackageName "directory") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0,0,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0,0,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [1,2,0,0], versionTags = []}))),Dependency (PackageName "extensible-exceptions") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,2], versionTags = []}))),Dependency (PackageName "filepath") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,1,0,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,1,0,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [1,3,0,0], versionTags = []}))),Dependency (PackageName "hashed-storage") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5,6], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5,6], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6], versionTags = []}))),Dependency (PackageName "haskeline") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,6,3], versionTags = []})) (LaterVersion (Version {versionBranch = [0,6,3], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,7], versionTags = []}))),Dependency (PackageName "html") (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})),Dependency (PackageName "mmap") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6], versionTags = []}))),Dependency (PackageName "mtl") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,1], versionTags = []}))),Dependency (PackageName "network") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [2,2], versionTags = []})) (LaterVersion (Version {versionBranch = [2,2], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,4], versionTags = []}))),Dependency (PackageName "old-time") (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})),Dependency (PackageName "parsec") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [2,0], versionTags = []})) (LaterVersion (Version {versionBranch = [2,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [3,2], versionTags = []}))),Dependency (PackageName "process") (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})),Dependency (PackageName "random") (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})),Dependency (PackageName "regex-compat") (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,95,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,95,1], versionTags = []}))),Dependency (PackageName "tar") (WildcardVersion (Version {versionBranch = [0,3], versionTags = []})),Dependency (PackageName "terminfo") (WildcardVersion (Version {versionBranch = [0,3], versionTags = []})),Dependency (PackageName "text") (WildcardVersion (Version {versionBranch = [0,11], versionTags = []})),Dependency (PackageName "unix") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,5], versionTags = []}))),Dependency (PackageName "vector") (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,7], versionTags = []})) (LaterVersion (Version {versionBranch = [0,7], versionTags = []}))),Dependency (PackageName "zlib") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5,1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5,1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6,0,0], versionTags = []})))]}},Executable {exeName = "darcs-test", modulePath = "test.hs", buildInfo = BuildInfo {buildable = True, buildTools = [], cppOptions = ["-DHAVE_MMAP","-DHAVE_TERMINFO","-DGADT_WITNESSES=1"], ccOptions = ["-D_REENTRANT"], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = ["src/atomic_create.c","src/fpstring.c","src/maybe_relink.c","src/umask.c","src/Crypt/sha2.c"], hsSourceDirs = ["src"], otherModules = [ModuleName ["Darcs","Test","Email"],ModuleName ["Darcs","Test","Patch","Check"],ModuleName ["Darcs","Test","Patch","Examples"],ModuleName ["Darcs","Test","Patch","Examples2"],ModuleName ["Darcs","Test","Patch","Info"],ModuleName ["Darcs","Test","Patch","Prim","V1"],ModuleName ["Darcs","Test","Patch","Properties"],ModuleName ["Darcs","Test","Patch","Properties2"],ModuleName ["Darcs","Test","Patch","QuickCheck"],ModuleName ["Darcs","Test","Patch","RepoModel"],ModuleName ["Darcs","Test","Patch","Test"],ModuleName ["Darcs","Test","Patch","Unit"],ModuleName ["Darcs","Test","Patch","Unit2"],ModuleName ["Darcs","Test","Patch","Utils"],ModuleName ["Darcs","Test","Patch","WithState"],ModuleName ["Darcs","Test","Patch"],ModuleName ["Darcs","Test","Misc"],ModuleName ["Darcs","Test","Util","TestResult"],ModuleName ["Darcs","Test","Util","QuickCheck"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [CPP,BangPatterns,PatternGuards,GADTs,TypeOperators,FlexibleContexts,FlexibleInstances,ScopedTypeVariables,KindSignatures,RankNTypes,TypeFamilies,UnknownExtension "NoMonoLocalBinds"], extraLibs = [], extraLibDirs = [], includeDirs = ["src"], includes = [], installIncludes = [], options = [(GHC,["-O2"]),(GHC,["-Wall","-funbox-strict-fields","-fwarn-tabs"]),(GHC,["-threaded"])], ghcProfOptions = ["-prof","-auto-all"], ghcSharedOptions = [], customFieldsBI = [("x-use-color","")], targetBuildDepends = [Dependency (PackageName "HTTP") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [3000,0], versionTags = []})) (LaterVersion (Version {versionBranch = [3000,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [4000,2], versionTags = []}))),Dependency (PackageName "HUnit") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0], versionTags = []}))),Dependency (PackageName "QuickCheck") (UnionVersionRanges (ThisVersion (Version {versionBranch = [2,3], versionTags = []})) (LaterVersion (Version {versionBranch = [2,3], versionTags = []}))),Dependency (PackageName "array") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,4], versionTags = []}))),Dependency (PackageName "base") (IntersectVersionRanges (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4], versionTags = []})) (LaterVersion (Version {versionBranch = [4], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))),Dependency (PackageName "bytestring") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,9,0], versionTags = []})) (LaterVersion (Version {versionBranch = [0,9,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,10], versionTags = []}))),Dependency (PackageName "cmdlib") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,2,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,2,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,4], versionTags = []}))),Dependency (PackageName "containers") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,5], versionTags = []}))),Dependency (PackageName "directory") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0,0,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0,0,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [1,2,0,0], versionTags = []}))),Dependency (PackageName "extensible-exceptions") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,2], versionTags = []}))),Dependency (PackageName "filepath") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,1,0,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,1,0,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [1,3,0,0], versionTags = []}))),Dependency (PackageName "hashed-storage") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5,6], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5,6], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6], versionTags = []}))),Dependency (PackageName "haskeline") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,6,3], versionTags = []})) (LaterVersion (Version {versionBranch = [0,6,3], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,7], versionTags = []}))),Dependency (PackageName "html") (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})),Dependency (PackageName "mmap") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6], versionTags = []}))),Dependency (PackageName "mtl") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,1], versionTags = []}))),Dependency (PackageName "network") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [2,2], versionTags = []})) (LaterVersion (Version {versionBranch = [2,2], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,4], versionTags = []}))),Dependency (PackageName "old-time") (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})),Dependency (PackageName "parsec") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [2,0], versionTags = []})) (LaterVersion (Version {versionBranch = [2,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [3,2], versionTags = []}))),Dependency (PackageName "process") (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})),Dependency (PackageName "random") (WildcardVersion (Version {versionBranch = [1,0], versionTags = []})),Dependency (PackageName "regex-compat") (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,95,1], versionTags = []})) (LaterVersion (Version {versionBranch = [0,95,1], versionTags = []}))),Dependency (PackageName "shellish") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,1,3], versionTags = []})) (LaterVersion (Version {versionBranch = [0,1,3], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,2], versionTags = []}))),Dependency (PackageName "tar") (WildcardVersion (Version {versionBranch = [0,3], versionTags = []})),Dependency (PackageName "terminfo") (WildcardVersion (Version {versionBranch = [0,3], versionTags = []})),Dependency (PackageName "test-framework") (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,2,2], versionTags = []})) (LaterVersion (Version {versionBranch = [0,2,2], versionTags = []}))),Dependency (PackageName "test-framework-hunit") (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,2,2], versionTags = []})) (LaterVersion (Version {versionBranch = [0,2,2], versionTags = []}))),Dependency (PackageName "test-framework-quickcheck2") (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,2,8], versionTags = []})) (LaterVersion (Version {versionBranch = [0,2,8], versionTags = []}))),Dependency (PackageName "text") (WildcardVersion (Version {versionBranch = [0,11], versionTags = []})),Dependency (PackageName "unix") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [2,5], versionTags = []}))),Dependency (PackageName "vector") (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,7], versionTags = []})) (LaterVersion (Version {versionBranch = [0,7], versionTags = []}))),Dependency (PackageName "zlib") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [0,5,1,0], versionTags = []})) (LaterVersion (Version {versionBranch = [0,5,1,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [0,6,0,0], versionTags = []})))]}}], testSuites = [], dataFiles = [], dataDir = "", extraSrcFiles = ["src/*.h","src/Crypt/sha2.h","src/win32/send_email.h","src/win32/sys/mman.h","contrib/_darcs.zsh","contrib/darcs_completion","contrib/cygwin-wrapper.bash","contrib/update_roundup.pl","contrib/upload.cgi","contrib/darcs-errors.hlint","doc/src/best_practices.tex","doc/src/building_darcs.tex","doc/src/configuring_darcs.tex","doc/src/features.tex","doc/src/gpl.tex","doc/src/darcs.tex","doc/darcs.css","README","NEWS","release/distributed-version","release/distributed-context","tests/data/*.tgz","tests/data/README","tests/data/*.dpatch","tests/data/convert/darcs1/*.dpatch","tests/data/convert/darcs2/*.dpatch","tests/*.sh","tests/bin/trackdown-bisect-helper.hs","tests/bin/hspwd.hs","tests/network/*.sh","tests/lib","tests/data/example_binary.png","tests/README.test_maintainers.txt","GNUmakefile"], extraTmpFiles = []}, withPrograms = [("ar",ConfiguredProgram {programId = "ar", programVersion = Nothing, programDefaultArgs = [], programOverrideArgs = [], programLocation = FoundOnSystem {locationPath = "/usr/bin/ar"}}),("gcc",ConfiguredProgram {programId = "gcc", programVersion = Just (Version {versionBranch = [4,6,1], versionTags = []}), programDefaultArgs = ["-fno-stack-protector"], programOverrideArgs = [], programLocation = FoundOnSystem {locationPath = "/usr/bin/gcc"}}),("ghc",ConfiguredProgram {programId = "ghc", programVersion = Just (Version {versionBranch = [7,0,3], versionTags = []}), programDefaultArgs = [], programOverrideArgs = [], programLocation = FoundOnSystem {locationPath = "/usr/bin/ghc"}}),("ghc-pkg",ConfiguredProgram {programId = "ghc-pkg", programVersion = Just (Version {versionBranch = [7,0,3], versionTags = []}), programDefaultArgs = [], programOverrideArgs = [], programLocation = FoundOnSystem {locationPath = "/usr/bin/ghc-pkg"}}),("haddock",ConfiguredProgram {programId = "haddock", programVersion = Just (Version {versionBranch = [2,9,2], versionTags = []}), programDefaultArgs = [], programOverrideArgs = [], programLocation = FoundOnSystem {locationPath = "/usr/bin/haddock"}}),("hsc2hs",ConfiguredProgram {programId = "hsc2hs", programVersion = Just (Version {versionBranch = [0,67], versionTags = []}), programDefaultArgs = [], programOverrideArgs = [], programLocation = FoundOnSystem {locationPath = "/usr/bin/hsc2hs"}}),("hscolour",ConfiguredProgram {programId = "hscolour", programVersion = Just (Version {versionBranch = [1,17], versionTags = []}), programDefaultArgs = [], programOverrideArgs = [], programLocation = FoundOnSystem {locationPath = "/usr/bin/HsColour"}}),("ld",ConfiguredProgram {programId = "ld", programVersion = Nothing, programDefaultArgs = ["-x"], programOverrideArgs = [], programLocation = FoundOnSystem {locationPath = "/usr/bin/ld"}}),("pkg-config",ConfiguredProgram {programId = "pkg-config", programVersion = Just (Version {versionBranch = [0,26], versionTags = []}), programDefaultArgs = [], programOverrideArgs = [], programLocation = FoundOnSystem {locationPath = "/usr/bin/pkg-config"}}),("ranlib",ConfiguredProgram {programId = "ranlib", programVersion = Nothing, programDefaultArgs = [], programOverrideArgs = [], programLocation = FoundOnSystem {locationPath = "/usr/bin/ranlib"}}),("strip",ConfiguredProgram {programId = "strip", programVersion = Nothing, programDefaultArgs = [], programOverrideArgs = [], programLocation = FoundOnSystem {locationPath = "/usr/bin/strip"}}),("tar",ConfiguredProgram {programId = "tar", programVersion = Nothing, programDefaultArgs = [], programOverrideArgs = [], programLocation = FoundOnSystem {locationPath = "/bin/tar"}})], withPackageDB = [GlobalPackageDB,UserPackageDB], withVanillaLib = True, withProfLib = False, withSharedLib = False, withProfExe = False, withOptimization = NormalOptimisation, withGHCiLib = True, splitObjs = False, stripExes = True, progPrefix = "", progSuffix = ""}
doc/darcs.css view
@@ -2,9 +2,14 @@ background: white; color: black; font-family: arial,sans-serif;+ font-size: 90%; margin: 0; padding: 1em; }++#col1, #col2 { float: left; width: 50%; }+#col2 { margin-left: -1px; }+.inner { margin: 0 1em; } A:link { background: transparent;
+ doc/src/best_practices.tex view
@@ -0,0 +1,612 @@+% This file (unlike the rest of darcs) is in the public domain.+ ++\chapter{Best practices}++This chapter is intended to review various scenarios and describe in each+case effective ways of using darcs. There is no one ``best practice'', and+darcs is a sufficiently low-level tool that there are many high-level ways+one can use it, which can be confusing to new users.++\section{Creating patches}++This section will lay down the concepts around patch creation.+The aim is to develop a way of thinking+that corresponds well to how darcs is behaving+--- even in complicated situations.++ In a single darcs repository you can think of two ``versions'' of the source tree.+ They are called the \emph{working} and \emph{pristine} trees.+ \emph{Working} is your normal source tree, with or without darcs alongside.+ The only thing that makes it part of a darcs repository+ is the \verb!_darcs! directory in its root.+ \emph{Pristine} is the recorded state of the source tree.+ The pristine tree is constructed from groups of changes,+ called {\em patches\/} (some other version control systems use the+ term {\em changeset\/} instead of {\em patch\/}).\footnote{If+ you look inside \_darcs you will find files or directories named+ {\tt patches} and {\tt inventories}, which store all the patches+ ever recorded. If the repository holds a cached pristine tree, it+ is stored in a directory called {\tt pristine.hashed}.}+ Darcs will create and store these patches+ based on the changes you make in \emph{working}.+++\subsection{Changes}+ If \emph{working} and \emph{pristine} are the same,+ there are ``no changes'' in the working copy.+ Changes can be introduced (or removed) by editing the files in \emph{working}.+ They can also be caused by darcs commands,+ which can modify \emph{both} \emph{working} and \emph{pristine}.+ It is important to understand for each darcs command+ how it modifies \emph{working}, \emph{pristine} or both of them.++ \verb!whatsnew! (as well as \verb!diff!) can show+ the difference between \emph{working} and \emph{pristine} to you.+ It will be shown as a difference in \emph{working}.+ In advanced cases it need \emph{not} be \emph{working} that has changed;+ it can just as well have been \emph{pristine}, or both.+ The important thing is the difference and what darcs can do with it.++\subsection{Keeping or discarding changes}+ If you have a difference in \emph{working}, you do two things+ with it: \verb!record! it to keep it, or \verb!revert! it to lose the changes.%+ \footnote{%+ Revert can undo precious work in a blink.+ To protect you from great grief,+ the discarded changes are saved temporarily+ so the latest revert can be undone with unrevert.}++ If you have a difference between \emph{working} and \emph{pristine}%+ ---for example after editing some files in \emph{working}---%+ \verb!whatsnew! will show some ``unrecorded changes''.+ To save these changes, use \verb!record!.+ It will create a new patch in \emph{pristine} with the same changes,+ so \emph{working} and \emph{pristine} are no longer different.+ To instead undo the changes in \emph{working}, use \verb!revert!.+ It will modify the files in \emph{working} to be the same as in \emph{pristine}+ (where the changes do not exist).+++\subsection{Unrecording changes}+ \verb!unrecord! is a command meant to be run only in private+ repositories. Its intended purpose is to allow developers the flexibility+ to undo patches that haven't been distributed yet.++ If you \verb!unrecord! a patch, that patch will be deleted from \emph{pristine}.+ This will cause \emph{working} to be different from \emph{pristine},+ and \verb!whatsnew! to report unrecorded changes.+ The difference will be the same as just before that patch was \verb!record!ed.+ Think about it.+ \verb!record! examines what's different with \emph{working}+ and constructs a patch with the same changes in \emph{pristine}+ so they are no longer different.+ \verb!unrecord! deletes this patch;+ the changes in \emph{pristine} disappear and the difference is back.++ If the recorded changes included an error,+ the resulting flawed patch can be unrecorded.+ When the changes have been fixed,+ they can be recorded again as a new---hopefully flawless---patch.++ If the whole change was wrong it can be discarded from \emph{working} too,+ with \verb!revert!.+ \verb!revert! will update \emph{working} to the state of \emph{pristine},+ in which the changes do no longer exist after the patch was deleted.++ Keep in mind that the patches are your history,+ so deleting them with \verb!unrecord! makes it impossible to track+ what changes you \emph{really} made.+ Redoing the patches is how you ``cover the tracks''.+ On the other hand,+ it can be a very convenient way to manage and organize changes+ while you try them out in your private repository.+ When all is ready for shipping,+ the changes can be reorganized in what seems as useful and impressive patches.+ Use it with care.++ All patches are global,+ so don't \emph{ever} replace an already ``shipped'' patch in this way!+ If an erroneous patch is deleted and replaced with a better one,+ you have to replace it in \emph{all} repositories that have a copy of it.+ This may not be feasible, unless it's all private repositories.+ If other developers have already made patches or tags in their repositories+ that depend on the old patch, things will get complicated.+++\subsection{Special patches and pending}++The patches described in the previous sections have mostly been hunks.+A \emph{hunk} is one of darcs' primitive patch types,+and it is used to remove old lines and/or insert new lines.+There are other types of primitive patches,+such as \emph{adddir} and \emph{addfile}+which add new directories and files,+and \emph{replace}+which does a search-and-replace on tokens in files.++Hunks are always calculated in place with a diff algorithm+just before \verb!whatsnew! or \verb!record!.+But other types of primitive patches need to be explicitly created+with a darcs command.+They are kept in \emph{pending}, ie, in the file {\tt\_darcs/patches/pending},+until they are either recorded or reverted.++\emph{Pending} can be thought of as a special extension of \emph{working}.+When you issue, e.g., a darcs \verb!replace! command,+the replace is performed on the files in \emph{working}+and at the same time a replace patch is put in \emph{pending}.+Patches in \emph{pending} describe special changes made in \emph{working}.+The diff algorithm will fictively apply these changes to \emph{pristine}+before it compares it to \emph{working},+so all lines in \emph{working} that are changed by a \verb!replace! command+will also be changed in \emph{pending} and \emph{pristine}+when the hunks are calculated.+That's why no hunks with the replaced lines will be shown by \verb!whatsnew!;+it only shows the replace patch in \emph{pending} responsible for the change.++If a special patch is recorded, it will simply be moved to \emph{pristine}.+If it is instead reverted, it will be deleted from \emph{pending}+and the accompanying change will be removed from \emph{working}.++Note that reverting a patch in pending is \emph{not} the same as+simply removing it from pending.+It actually applies the inverse of the change to \emph{working}.+Most notable is that reverting an addfile patch+will delete the file in \emph{working} (the inverse of adding it).+So if you add the wrong file to darcs by mistake,+\emph{don't} \verb!revert! the addfile.+Instead use \verb!remove!, which cancels out the addfile in pending.+++\section{Using patches} % still basics++This section will lay down the concepts around patch distribution and branches.+The aim is to develop a way of thinking+that corresponds well to how darcs is behaving+--- even in complicated situations.++A repository is a collection of patches.+Patches have no defined order,+but patches can have dependencies on other patches.+Patches can be added to a repository in any order+as long as all patches depended upon are there.+Patches can be removed from a repository in any order,+as long as no remaining patches depend on them.++Repositories can be cloned to create branches.+Patches created in different branches may conflict.+A conflict is a valid state of a repository.+A conflict makes the working tree ambiguous until the conflict is resolved.+++\subsection{Dependencies}++There are two kinds of dependencies.++Implicit dependencies is the far most common kind.+These are calculated automatically by darcs.+If a patch removes a file or a line of code,+it will have to depend on the patch that added that file or line of code.+If a patch adds a line of code,+it will usually have to depend on the patch or patches that added the adjacent lines.++Explicit dependencies can be created if you give the \verb|--ask-deps| option to \verb|darcs record|.+This is good for assuring that logical dependencies hold between patches.+It can also be used to group patches---%+a patch with explicit dependencies doesn't need to change anything---%+and pulling the patch also pulls all patches it was made to depend on.+++\subsection{Branches: just normal repositories}++Darcs does not have branches---it doesn't need to.+Any two repositories are ``branches'' in darcs,+but it is not of much use unless they have a large portion of patches in common.+If they are different projects they will have nothing in common,+but darcs may still very well be able to merge them,+although the result probably is nonsense.+Therefore the word ``branch'' isn't a technical term in darcs;+it's just the way we think of one repository in relation to another.++Branches are \emph{very} useful in darcs.+They are in fact \emph{necessary} if you want to do more than only simple work.+When you \verb|get| someone's repository from the Internet,+you are actually creating a branch of it.+But darcs is designed this way, and it has means to make it efficient.+The answer to many questions about how to do a thing with darcs is: ``use a branch''.+It is a simple and elegant solution with great power and flexibility,+which contributes to darcs' uncomplicated user interface.++You create new branches (i.e., clone repositories)+with the \verb|get| and \verb|put| commands.+++\subsection{Moving patches around---no versions}++Patches are global, and a copy of a patch either is or is not present in a branch.+This way you can rig a branch almost any way you like,+as long as dependencies are fulfilled---%+darcs \emph{won't} let you break dependencies.+If you suspect a certain feature from some time ago introduced a bug,+you can remove the patch/patches that adds the feature,+and try without it.\footnote{%+darcs even has a special command, {\tt trackdown}+that automatically removes patches+until a specified test no longer fails.}++Patches are added to a repository with \verb|pull|+and removed from the repositories with \verb|obliterate|.+Don't confuse these two commands with \verb|record| and \verb|unrecord|,+which constructs and deconstructs patches.++It is important not to lose patches when (re)moving them around.+\verb|pull| needs a source repository to copy the patch from,+whereas \verb|obliterate| just erases the patch.+Beware that if you obliterate \emph{all} copies of a patch+it is completely lost---forever.+Therefore you should work with branches when you obliterate patches.+The \verb|obliterate| command can wisely be disabled in a dedicated main repository+by adding \verb|obliterate disable| to the repository's defaults file.++For convenience, there is a \verb|push| command.+It works like \verb|pull| but in the other direction.+It also differs from \verb|pull| in an important way:+it starts a second instance of darcs to apply the patch in the target repository,+even if it's on the same computer.+It can cause surprises if you have a ``wrong'' darcs in your PATH.+++\subsection{Tags---versions}++While \verb|pull| and \verb|obliterate| can be used to+construct different ``versions'' in a repository,+it is often desirable to name specific configurations of patches+so they can be identified and retrieved easily later.+This is how darcs implements what is usually known as versions.+The command for this is \verb|tag|,+and it records a tag in the current repository.++A tag is just a patch, but it only contains explicit dependencies.+It will depend on all the patches in the current repository.\footnote{%+It will omit patches already depended upon by other patches,+since they will be indirectly depended upon anyway.}+Darcs can recognize if a patch is as a tag;+tags are sometimes treated specially by darcs commands.++While traditional revision control systems tag versions in the time line history,+darcs lets you tag any configuration of patches at any time,+and pass the tags around between branches.++With the option \verb|--tag| to \verb|get| you can easily get+a named version in the repository+as a new branch.+++\subsection{Conflicts}++A conflict \emph{happens} when two conflicting patches meet in the same repository.+This is no problem for darcs; it can happily pull together just any patches.+But it is a problem for the files in \emph{working} (and \emph{pristine}).+The conflict can be thought of as+two patches telling darcs different things about what a file should look like.++Darcs escapes this problem+by ignoring those parts of the patches that conflict.+They are ignored in \emph{both} patches.+If patch~A changes the line ``FIXME'' to ``FIXED'',+and patch~B changes the same line to ``DONE'',+the two patches together will produce the line ``FIXME''.+Darcs doesn't care which one you pulled into the repository first,+you still get the same result when the conflicting patches meet.+All other changes made by A and B are performed as normal.++Darcs can mark a conflict for you in \emph{working}.+This is done with \verb|mark-conflicts|.+Conflicts are marked such that both conflicting changes+are inserted with special delimiter lines around them.+Then you can merge the two changes by hand,+and remove the delimiters.++When you pull patches,+darcs automatically performs a \verb|mark-conflicts| for you if a conflict happens.+You can remove the markup with \verb|revert|,+Remember that the result will be the lines from+the previous version common to both conflicting patches.+The conflict marking can be redone again with \verb|mark-conflicts|.++A special case is when a pulled patch conflicts with unrecorded changes in the repository.+The conflict will be automatically marked as usual,+but since the markup is \emph{also} an unrecorded change,+it will get mixed in with your unrecorded changes.+There is no guarantee you can revert \emph{only} the markup after this,+and \verb|mark-conflicts| will not be able to redo this markup later if you remove it.+It is good practice to record important changes before pulling.++\verb|mark-conflicts| can't mark complicated conflicts.+In that case you'll have to use \verb|darcs diff| and other commands+to understand what the conflict is all about.+If for example two conflicting patches create the same file,+\verb|mark-conflicts| will pick just one of them,+and no delimiters are inserted.+So watch out if darcs tells you about a conflict.++\verb|mark-conflicts| can also be used to check for unresolved conflicts.+If there are none, darcs replies ``No conflicts to mark.''.+While \verb|pull| reports when a conflict happens,+\verb|obliterate| and \verb|get| don't.+++\subsection{Resolving conflicts}++A conflict is resolved+(not marked, as with the command \verb|mark-conflicts|)+as soon as some new patch depends on the conflicting patches.+This will usually be the resolve patch you record after manually putting together the pieces+from the conflict markup produced by \verb|mark-conflicts| (or \verb|pull|).+But it can just as well be a tag.+So don't forget to fix conflicts before you accidently ``resolve'' them by recording other patches.++If the conflict is with one of your not-yet-published patches,+you may choose to amend that patch rather than creating a resolve patch.++If you want to back out and wait with the conflict,+you can \verb|obliterate| the conflicting patch you just pulled.+Before you can do that you have to \verb|revert| the conflict markups+that \verb|pull| inserted when the conflict happened.++\section{Global and per-repository caches}++Darcs uses a global cache, as this is one of its biggest performance+enhancing tools. The global+cache acts as a giant patch pool where darcs first looks for a patch when+grabbing new patches. This saves time by not downloading the same patch+twice from a remote server. It also saves space by storing the patch only+once, if you ensure your cache and your repositories are on the same+hardlink-supporting filesystem. ++Darcs now enables a global patch cache under your home directory by default.+Older darcs 2.x versions required this manual step:++\begin{verbatim}+$ mkdir -p $HOME/.darcs/cache+$ echo cache:$HOME/.darcs/cache > $HOME/.darcs/sources+\end{verbatim}++On MS Windows~\ref{ms_win}, using \verb|cmd.exe| (Command Prompt under Accessories):++\begin{verbatim}+> md "%APPDATA%\darcs\cache" (notice double quotes!)+> echo cache:%APPDATA%\darcs\cache > "%APPDATA%\darcs\sources"+\end{verbatim}++Individual repositories also contain cache location information.+Each time a repository is get, its location is added as an+entry in \verb!_darcs/prefs/sources!. If one of these repositories were to+become totally or temporarily unreachable, it can cause darcs to hang+for a long time trying to reach it. Fortunately darcs has a mechanism+which helps us to deal with that problem: if an unreachable entry is+discovered, darcs stops using it for the rest of the session and then+notifies to the user to take further action. It will display a message+like the following:+\begin{verbatim}> I could not reach the following repository:+> http://darcs.net/+> If you're not using it, you should probably delete+> the corresponding entry from _darcs/prefs/sources.+\end{verbatim}++There are some other advanced things you can do in \verb!_darcs/prefs/sources!,+such as create read-only caches and even set a+primary source repository above any used in a \verb|darcs get| or+\verb|darcs pull| command.++\section{Distributed development with one primary developer}+\label{darcs-development-practices}++This is how a project with many contributors, but every contribution is reviewed+and manually applied by the project leader, can be run.+For this sort of a situation, \verb|darcs send| is ideal, since the barrier for+contributions is very low, which helps encourage contributors.++One could simply set the \verb!_darcs/prefs/email! value to the project+mailing list, but you may also want to use darcs send to send your changes to the main+server, so instead the email address could be set to something like+``\verb!Darcs Repo <maintainer@host.com>!''. Then the+\verb-.procmailrc-+file on the server should have the following rule:+\begin{verbatim}+:0+* ^TODarcs Repo+|(umask 022; darcs apply --reply project-mailing-list@host.com \+ --repodir /path/to/repo --verify /path/to/allowed_keys)+\end{verbatim}+This causes darcs apply to be run on any email sent to ``Darcs Repo''.+\verb'apply' actually applies them only if they are signed by an+authorized key.++The central darcs repository contains the following values in its+\verb!_darcs/prefs/defaults!:+\begin{verbatim}+apply test+apply verbose+apply happy-forwarding+\end{verbatim}+The first line tells apply to always run the test suite. The test suite can+be a reason to use send rather than push, since it allows to+easily continue working (or put one's computer to sleep) while the tests are+being run on the main server. The second line is just there to improve the+email response that the maintainer gets when a patch has either been applied or failed+the tests. The third line makes darcs not complain about unsigned patches,+but just to forward them to \verb!darcs-devel!.++On one's development computer, one can have in their \verb!.muttrc! the following+alias, which allows to easily apply patches received via email+directly to one's darcs working directory:+\begin{verbatim}+macro pager A "<pipe-entry>(umask 022; darcs apply --no-test -v \+ --repodir ~/darcs)"+\end{verbatim}++\section{Sending signed patches by email}++Darcs send can be configured to send a cryptographically signed patch by email.+You can then set up your mail system to have darcs verify that patches were+signed by an authorized user and apply them when a patch is received by+email. The results of the apply can be returned to the user by email.+Unsigned patches (or patches signed by unauthorized users) will be+forwarded to the repository owner (or whoever you configure them to be+forwarded to\ldots).++This method is especially nice when combined with the \verb!--test! option+of darcs apply, since it allows you to run the test suite (assuming you+have one) and reject patches that fail---and it's all done on the server,+so you can happily go on working on your development machine without+slowdown while the server runs the tests.++Setting up darcs to run automatically in response to email is by far the+most complicated way to get patches from one repository to another\ldots\ so it'll+take a few sections to explain how to go about it.++\paragraph{Security considerations}++When you set up darcs to run apply on signed patches, you should assume+that a user with write access can write to any file or directory that is+writable by the user under which the apply process runs. Unless you+specify the \verb!--no-test! flag to darcs apply (and this is \emph{not}+the default), you are also allowing anyone with write access to that+repository to run arbitrary code on your machine (since they can run a test+suite---which they can modify however they like). This is quite a+potential security hole.++For these reasons, if you don't implicitly trust your users, it is+recommended that you create a user for each repository to limit the damage+an attacker can do with access to your repository. When considering who to+trust, keep in mind that a security breach on any developer's machine could+give an attacker access to their private key and passphrase, and thus to+your repository.++\paragraph{Installing necessary programs}++You also must install the following programs: gnupg, a mailer configured to+receive mail (e.g.\ exim, sendmail or postfix), and a web server (usually+apache).++\paragraph{Granting access to a repository}++You create your gpg key by running (as your normal user):+\begin{verbatim}+$ gpg --gen-key+\end{verbatim}+You will be prompted for your name and email address, among other options.+%%To add your public key to the allowed keys keyring.+Of course, you can+skip this step if you already have a gpg key you wish to use.++You now need to export the public key so we can tell the patcher about it.+You can do this with the following command (again as your normal user):+\begin{verbatim}+$ gpg --export "email@address" > /tmp/exported_key+\end{verbatim}+And now we can add your key to the \verb!allowed_keys!:+\begin{verbatim}+(as root)> gpg --keyring /var/lib/darcs/repos/myproject/allowed_keys \+ --no-default-keyring --import /tmp/exported_key+\end{verbatim}+You can repeat this process any number of times to authorize multiple users+to send patches to the repository.++You should now be able to send a patch to the repository by running as your+normal user, in a working copy of the repository:+\begin{verbatim}+$ darcs send --sign http://your.computer/repos/myproject+\end{verbatim}+You may want to add ``send sign'' to the file \verb!_darcs/prefs/defaults!+so that you won't need to type \verb!--sign! every time you want to+send\ldots++If your gpg key is protected by a passphrase, then executing \verb!send!+with the \verb!--sign! option might give you the following error:+\begin{verbatim}+darcs failed: Error running external program 'gpg'+\end{verbatim}+The most likely cause of this error is that you have a misconfigured+gpg that tries to automatically use a non-existent gpg-agent+program. GnuPG will still work without gpg-agent when you try to sign+or encrypt your data with a passphrase protected key. However, it will+exit with an error code 2 (\verb!ENOENT!) causing \verb!darcs! to+fail. To fix this, you will need to edit your \verb!~/.gnupg/gpg.conf!+file and comment out or remove the line that says:+\begin{verbatim}+use-agent+\end{verbatim}+If after commenting out or removing the \verb!use-agent! line in your+gpg configuration file you still get the same error, then you probably+have a modified GnuPG with use-agent as a hard-coded option. In that+case, you should change \verb!use-agent! to \verb!no-use-agent! to+disable it explicitly.++\paragraph{Setting up a sendable repository using procmail}+If you don't have root access on your machine, or perhaps simply don't want+to bother creating a separate user, you can set up a darcs repository using+procmail to filter your mail. Let us assume that you already use procmail+to filter your email. If not, you will need to read up on it, or perhaps+should use a different method for routing the email to darcs.++To begin with, you must configure your repository so that a darcs send to+your repository will know where to send the email. Do this by creating a+file in \verb!/path/to/your/repo/_darcs/prefs! called \verb!email!+containing your email address. As a trick (to be explained below), we will+create the email address with ``darcs repo'' as your name, in an email+address of the form ``User Name $<$user@host.com$>$.''+\begin{verbatim}+$ echo 'my darcs repo <user@host.com>' \+ > /path/to/your/repo/_darcs/prefs/email+\end{verbatim}++The next step is to set up a gnupg keyring containing the public keys of+people authorized to send to your repository. Here is a second way of+going about this (see above for the first). This time let us assume you+want to give someone write access to your repository. You can do this by:+\begin{verbatim}+gpg --no-default-keyring \+ --keyring /path/to/the/allowed_keys --recv-keys FFFFFFFF+\end{verbatim}+With ``FFFFFFFF'' being the ID of the gpg key of the person to be+authorised, if this person has uploaded their key to the gpg keyservers.+Actually, this also requires that+you have configured gpg to access a valid keyserver. You can, of course,+repeat this command for all keys you want to allow access to.++Finally, we add a few lines to your \verb!.procmailrc!:+\begin{verbatim}+:0+* ^TOmy darcs repo+|(umask 022; darcs apply --reply user@host.com \+ --repodir /path/to/your/repo --verify /path/to/the/allowed_keys)+\end{verbatim}+The purpose for the ``my darcs repo'' trick is partially to make it easier+to recognize patches sent to the repository, but is even more crucial to+avoid nasty bounce loops by making the \verb!--reply! option have an email+address that won't go back to the repository. This means that unsigned+patches that are sent to your repository will be forwarded to your ordinary+email.++Like most mail-processing programs, Procmail by default sets a tight umask.+However, this will prevent the repository from remaining world-readable;+thus, the ``umask 022'' is required to relax the umask.+(Alternatively, you could set Procmail's global \verb!UMASK! variable+to a more suitable value.)++\paragraph{Checking if your e-mail patch was applied}++After sending a patch with \verb!darcs send!, you may not receive any feedback,+even if the patch is applied. You can confirm whether or not your patch was applied+to the remote repository by pointing \verb!darcs changes! at a remote repository:+\begin{verbatim}+darcs changes --last=10 --repo=http://darcs.net/+\end{verbatim}++That shows you the last 10 changes in the remote repository. You can adjust the options given+to \verb!changes! if a more advanced query is needed.++
+ doc/src/building_darcs.tex view
@@ -0,0 +1,33 @@+\chapter{Building darcs}+If your distribution provides a pre-built binary package of a recent+Darcs release, you are strongly encouraged to use that rather than+building Darcs yourself.++If you have (or can install) the+\htmladdnormallinkfoot{Haskell Platform}{http://haskell.org/platform/}+this is the next best option, as this will resolve build dependencies+automatically. To download, compile and install Darcs and its+dependencies via \texttt{cabal-install}, the build tool provided by the+Haskell Platform, simply run+\begin{verbatim}+cabal update+cabal install darcs+\end{verbatim}++If you cannot install the Haskell Platform or \texttt{cabal-install}, you need to run+\begin{verbatim}+ghc --make Setup+./Setup configure+./Setup build+./Setup install+\end{verbatim}++This will require the following build dependencies:+\begin{itemize}+\item GHC 6.10 or higher; and+\item Cabal 1.6 or higher.+\end{itemize}++Additional build dependencies are declared in the \texttt{darcs.cabal}+file, and \texttt{./Setup configure} will tell you if any required+build dependencies aren't found.
+ doc/src/configuring_darcs.tex view
@@ -0,0 +1,472 @@+% Copyright (C) 2004 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; if not, write to the Free Software Foundation,+% Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.++\chapter{Configuring darcs}\label{configuring}++There are several ways you can adjust darcs' behavior to suit your needs.+The first is to edit files in the \verb!_darcs/prefs/! directory of a+repository. Such configuration only applies when working with that+repository. To configure darcs on a per-user rather than per-repository+basis (but with essentially the same methods), you can edit (or create)+files in the \verb!~/.darcs/! directory.+Finally, the behavior of some darcs commands can be modified by setting+appropriate environment variables.++\paragraph{Microsoft Windows}\label{ms_win}++The global darcs directory is \verb!%APPDATA%\darcs\!. This typically expands to+\texttt{C:\textbackslash{}Documents And Settings\textbackslash{}\emph{user}\textbackslash{}Application Data\textbackslash{}darcs\textbackslash{}}.+This folder contains the cache, as well as all the per-user+settings files: preferences, boring etc... These will became the new defaults+that can be overridden on per-repository basis.++\section{prefs}++The \verb!_darcs! directory contains a \verb!prefs! directory. This+directory exists simply to hold user configuration settings specific to+this repository. The contents of this directory are intended to be+modifiable by the user, although in some cases a mistake in such a+modification may cause darcs to behave strangely.++\paragraph{defaults}\label{defaults}++Default values for darcs commands can be configured on a per-repository+basis by editing (and possibly creating) the \verb!_darcs/prefs/defaults!+file. Each line of this file has the following form:+\begin{verbatim}+COMMAND FLAG VALUE+\end{verbatim}+where \verb!COMMAND! is either the name of the command to which the default+applies, or \verb!ALL! to indicate that the default applies to all commands+accepting that flag. The \verb!FLAG! term is the name of the long argument+option without the ``\verb!--!'', i.e.\ \verb!verbose! rather than+\verb!--verbose!. Finally, the \verb!VALUE! option can be omitted if the+flag is one such as \verb!verbose! that doesn't involve a value.+If the value has spaces in it, use single quotes, not double quotes, to surround it.+Each line only takes one flag. To set multiple defaults for the same+command (or for \verb!ALL! commands), use multiple lines.++Note that the use of \verb|ALL| easily can have unpredicted consequences,+especially if commands in newer versions of darcs accepts flags that they+didn't in previous versions. A command like \verb|obliterate| could be+devastating with the ``wrong'' flags (for example --all). Only use safe+flags with \verb|ALL|.++\begin{tabular}{ll}+{\tt \verb!~/.darcs/defaults!} & provides defaults for this user account+ (for MS Windows, see ~\ref{ms_win}) \\+{\tt \verb!repo/_darcs/prefs/defaults!} & provides defaults for one project,\\+ & overrules changes per user \\+\end{tabular}++For example, if your system clock is bizarre, you could instruct darcs to+always ignore the file modification times by adding the following line to+your \verb!_darcs/prefs/defaults! file. (Note that this would have to be+done for each repository!)+\begin{verbatim}+ALL ignore-times+\end{verbatim}++If you never want to run a test when recording to a particular repository+(but still want to do so when running+\verb'check' on that repository), and like to name+all your patches ``Stupid patch'', you could use the following:+\begin{verbatim}+record no-test+record patch-name Stupid patch+\end{verbatim}++If you would like a command to be run every time patches are recorded+in a particular repository (for example if you have one central+repository, that all developers contribute to), then you can set apply+to always run a command when apply is successful. For example, if you+need to make sure that the files in the repository have the correct+access rights you might use the following. There are two things+to note about using darcs this way:+\begin{itemize}+\item Without the second line you will get errors, because the sub+ process that runs apply cannot prompt interactively.+\item Whatever script is run by the post apply command should not be+ added to the repository with \verb!darcs add!; doing so would+ allow people to modify that file and then run arbitrary scripts on+ your main repository, possibly damaging or violating security.+\end{itemize}+\begin{verbatim}+apply posthook chmod -R a+r *+apply run-posthook+\end{verbatim}++Similarly, if you need a command to run automatically before darcs+performs an action you can use a prehook. Using prehooks it could be+possible to canonicalize line endings before recording patches.++There are some options which are meant specifically for use in+\verb!_darcs/prefs/defaults!. One of them is \verb!--disable!. As the name+suggests, this option will disable every command that got it as argument. So,+if you are afraid that you could damage your repositories by inadvertent use of+a command like amend-record, add the following line to+\verb!_darcs/prefs/defaults!:+\begin{verbatim}+amend-record disable+\end{verbatim}++Also, a global preferences file can be created with the name+\verb!.darcs/defaults! in your home directory, on MS Windows~\ref{ms_win}.+Options present there will be added to the repository-specific preferences.+If they conflict with repository-specific options, the repository-specific+ones will take precedence.++\paragraph{repos}+The \verb!_darcs/prefs/repos! file contains a list of repositories you have+pulled from or pushed to, and is used for autocompletion of pull and push+commands in bash. Feel free to delete any lines from this list that might+get in there, or to delete the file as a whole.++\paragraph{author}\label{author_prefs}+The \verb!_darcs/prefs/author! file contains the email address (or name) to+be used as the author when patches are recorded in this repository,+e.g.\ \verb!David Roundy <droundy@abridgegame.org>!. This+file overrides the contents of the environment variables+\verb!$DARCS_EMAIL! and \verb!$EMAIL!.++\paragraph{boring}\label{boring}+The \verb!_darcs/prefs/boring! file may contain a list of regular+expressions describing files, such as object files, that you do not expect+to add to your project. As an example, you could have:+\begin{verbatim}+\.hi$+\.o$+^\.[^/]+^_+~$+(^|/)CVS($|/)+\end{verbatim}+A newly created repository has a longer boring file that+includes many common source control, backup, temporary, and compiled files.++You may want to have the boring file under version+control. To do this you can use darcs setpref to set the value+``boringfile'' to the name of your desired boring file+(e.g.\ \verb-darcs setpref boringfile .boring-, where \verb-.boring-+is the repository path of a file+that has been+darcs added to your repository). The boringfile preference overrides+\verb!_darcs/prefs/boring!, so be sure to copy that file to the boringfile.++You can also set up a ``boring'' regexps+file in your home directory, named \verb!~/.darcs/boring!,+(see \ref{ms_win} on MS Windows), which will be+used with all of your darcs repositories.++Any file not already managed by darcs and whose repository path (such+as \verb!manual/index.html!) matches any of+the boring regular expressions is considered boring. The boring file is+used to filter the files provided to darcs add, to allow you to use a+simple \verb-darcs add newdir newdir/-\verb-*- % cabal haddock barfs on adjacent / *+without accidentally adding a bunch of+object files. It is also used when the \verb!--look-for-adds! flag is+given to whatsnew or record.+Note that once a file has been added to darcs, it is not considered+boring, even if it matches the boring file filter.+++\paragraph{binaries}+The \verb!_darcs/prefs/binaries! file may contain a list of regular+expressions describing files that should be treated as binary files rather+than text files. Darcs automatically treats files containing+\verb!^Z\! or \verb!'\0'! within the first 4096 bytes as being binary files.+You probably will want to have the binaries file under+version control. To do this you can use darcs setpref to set the value+``binariesfile'' to the name of your desired binaries file+(e.g.\ \verb'darcs setpref binariesfile ./.binaries', where+\verb'.binaries' is a file that has been+darcs added to your repository). As with the boring file, you can also set+up a \verb!~/.darcs/binaries! file if you like+(see \ref{ms_win} on MS Windows).++\paragraph{email}+The \verb!_darcs/prefs/email! file is used to provide the e-mail address for your+repository that others will use when they \verb!darcs send! a patch back to you.+The contents of the file should simply be an e-mail address.+++\paragraph{sources}+The \verb!_darcs/prefs/sources! file is used to indicate alternative+locations from which to download patches when using a ``hashed''+repository. This file contains lines such as:+\begin{verbatim}+cache:/home/droundy/.darcs/cache+readonly:/home/otheruser/.darcs/cache+repo:http://darcs.net+\end{verbatim}+This would indicate that darcs should first look in+\verb!/home/droundy/.darcs/cache! for patches that might be missing, and if+the patch isn't there, it should save a copy there for future use. In that+case, darcs will look in \verb!/home/otheruser/.darcs/cache! to see if that+user might have downloaded a copy, but won't try to save a copy there, of+course. Finally, it will look in \verb!http://darcs.net!. Note that the+\verb!sources! file can also exist in \verb!~/.darcs/!. Also note that the+sources mentioned in your \verb!sources! file will be tried \emph{before}+the repository you are pulling from. This can be useful in avoiding+downloading patches multiple times when you pull from a remote repository+to more than one local repository.++A global cache is enabled by default in your home directory. The cache+allows darcs to avoid re-downloading patches (for example, when doing a+second darcs get of the same repository), and also allows darcs to use hard+links to reduce disk usage.++Note that the cache directory should reside on the same filesystem as your+repositories, so you may need to vary this. You can also use multiple+cache directories on different filesystems, if you have several filesystems+on which you use darcs.++\paragraph{motd}\label{motd}+The \verb!_darcs/prefs/motd! file may contain a ``message of the day''+which will be displayed to users who get or pull from the repository without the+\verb!--quiet! option.++\section{Environment variables}++There are a few environment variables whose contents affect darcs'+behavior. Here is a quick list of all the variables and their+documentation in the rest of the manual:++\begin{tabular}{|l|r|}+\hline+\textbf{Variable} & \textbf{Section} \\+\hline+DARCS\_EDITOR, EDITOR, VISUAL & \ref{env:DARCS_EDITOR} \\+DARCS\_PAGER, PAGER & \ref{env:DARCS_PAGER} \\+HOME & \ref{env:HOME} \\+TERM & \ref{env:TERM} \\+\hline+DARCS\_EMAIL, EMAIL & \ref{env:DARCS_EMAIL} \\+\hline+DARCS\_APPLY\_FOO & \ref{env:DARCS_X_FOO} \\+DARCS\_GET\_FOO & \ref{env:DARCS_X_FOO} \\+DARCS\_MGET\_FOO & \ref{env:DARCS_X_FOO} \\+DARCS\_MGETMAX & \ref{env:DARCS_MGETMAX} \\+DARCS\_PROXYUSERPWD & \ref{env:DARCS_PROXYUSERPWD} \\+DARCS\_CONNECTION\_TIMEOUT & \ref{env:DARCS_CONNECTION_TIMEOUT}\\+DARCS\_SSH & \ref{env:DARCS_SSH} \\+DARCS\_SCP & \ref{env:DARCS_SCP} \\+DARCS\_SFTP & \ref{env:DARCS_SFTP} \\+SSH\_PORT & \ref{env:SSH_PORT} \\+\hline+DARCS\_ALTERNATIVE\_COLOR & \ref{env:DARCS_ALWAYS_COLOR}\\+DARCS\_ALWAYS\_COLOR & \ref{env:DARCS_ALWAYS_COLOR}\\+DARCS\_DO\_COLOR\_LINES & \ref{env:DARCS_DO_COLOR_LINES}\\+DARCS\_DONT\_COLOR & \ref{env:DARCS_ALWAYS_COLOR} \\+DARCS\_DONT\_ESCAPE\_TRAILING\_CR & \ref{env:DARCS_DONT_ESCAPE_white}\\+DARCS\_DONT\_ESCAPE\_TRAILING\_SPACES & \ref{env:DARCS_DONT_ESCAPE_white} \\+DARCS\_DONT\_ESCAPE\_8BIT & \ref{env:DARCS_DONT_ESCAPE_nonascii}\\+DARCS\_DONT\_ESCAPE\_ANYTHING & \ref{env:DARCS_DONT_ESCAPE_nonascii}\\+DARCS\_DONT\_ESCAPE\_ISPRINT & \ref{env:DARCS_DONT_ESCAPE_nonascii}\\+DARCS\_ESCAPE\_EXTRA & \ref{env:DARCS_DONT_ESCAPE_nonascii}\\+DARCS\_DONT\_ESCAPE\_EXTRA & \ref{env:DARCS_DONT_ESCAPE_nonascii}\\+\hline+\end{tabular}++\section{General-purpose variables}++\darcsEnv{DARCS_EDITOR}+\darcsEnv{DARCS_PAGER}+\darcsEnv{DARCS_TMPDIR}+\darcsEnv{DARCS_KEEP_TMPDIR}+\darcsEnv{HOME}++\section{Remote repositories}+\paragraph{DARCS\_CONNECTION\_TIMEOUT}+\label{env:DARCS_CONNECTION_TIMEOUT}+Set the maximum time in seconds that darcs allows and connection to+take. If the variable is not specified the default are 30 seconds. This+option only works with curl.+\darcsEnv{DARCS_SSH}+\darcsEnv{DARCS_SCP}+\darcsEnv{SSH_PORT}+\darcsEnv{HTTP_PROXY}+\darcsEnv{DARCS_PROXYUSERPWD}++\paragraph{DARCS\_GET\_FOO, DARCS\_MGET\_FOO and DARCS\_APPLY\_FOO}+\label{env:DARCS_X_FOO}+When trying to access a repository with a URL beginning foo://,+darcs will invoke the program specified by the DARCS\_GET\_FOO+environment variable (if defined) to download each file, and the+command specified by the DARCS\_APPLY\_FOO environment variable (if+defined) when pushing to a foo:// URL. ++This method overrides all other ways of getting \verb!foo://xxx! URLs.++Note that each command should be constructed so that it sends the downloaded+content to STDOUT, and the next argument to it should be the URL\@. Here are some+examples that should work for DARCS\_GET\_HTTP:++\begin{verbatim}+fetch -q -o - +curl -s -f+lynx -source +wget -q -O -+\end{verbatim}++Apart from such toy examples, it is likely that you will need to+manipulate the argument before passing it to the actual fetcher+program. For example, consider the problem of getting read access to+a repository on a CIFS (SMB) share without mount privileges:++\begin{verbatim}+export DARCS_GET_SMB="smbclient -c get"+darcs get smb://fs/twb/Desktop/hello-world+\end{verbatim}++The above command will not work for several reasons. Firstly, Darcs+will pass it an argument beginning with `smb:', which smbclient does+not understand. Secondly, the host and share `//fs/twb' must be+presented as a separate argument to the path `Desktop/hello-world'.+Thirdly, smbclient requires that `get' and the path be a single+argument (including a space), rather than two separate arguments.+Finally, smbclient's `get' command writes the file to disk, while+Darcs expects it to be printed to standard output.++In principle, we could get around such problems by making the variable+contain a shell script, e.g.++\begin{verbatim}+export DARCS_GET_SMB='sh -c "...; smbclient $x -c \"get $y\""'+\end{verbatim}++Unfortunately, Darcs splits the command on whitespace and does not+understand that quotation or escaping, so there is no way to make+Darcs pass the text after `-c' to sh as a single argument. Therefore,+we instead need to put such one-liners in separate, executable scripts.++Continuing our smbclient example, we create an executable script+\verb|~/.darcs/libexec/get_smb| with the following contents:++\begin{verbatim}+#!/bin/bash -e+IFS=/ read host share file <<<"${1#smb://}"+smbclient //$host/$share -c "get $file -"+\end{verbatim}++And at last we can say++\begin{verbatim}+export DARCS_GET_SMB=~/.darcs/libexec/get_smb+darcs get smb://fs/twb/Desktop/hello-world+\end{verbatim}+++If set, DARCS\_MGET\_FOO+will be used to fetch many files from a single repository simultaneously.+Replace FOO and foo as appropriate to handle other URL schemes.+These commands are \emph{not} interpreted by a shell, so you cannot+use shell metacharacters, and the first word in the command must+be the name of an executable located in your path. The GET command+will be called with a URL for each file. The MGET command will be+invoked with a number of URLs and is expected to download the files+to the current directory, preserving the file name but not the path.+The APPLY command will be called with a darcs patchfile piped into+its standard input. Example:++\begin{verbatim}+wget -q +\end{verbatim}++\paragraph{DARCS\_MGETMAX}+\label{env:DARCS_MGETMAX}+When invoking a DARCS\_MGET\_FOO command, darcs will limit the+number of URLs presented to the command to the value of this variable,+if set, or 200.++These commands are \emph{not} interpreted by a shell, so you cannot use shell+meta-characters.++\section{Highlighted output}+\label{env:DARCS_ALWAYS_COLOR}+\label{env:DARCS_DO_COLOR_LINES}+\label{env:DARCS_DONT_ESCAPE_white}++If the terminal understands ANSI color escape sequences,+darcs will highlight certain keywords and delimiters when printing patches.+This can be turned off by setting the environment variable DARCS\_DONT\_COLOR to 1.+If you use a pager that happens to understand ANSI colors, like \verb!less -R!,+darcs can be forced always to highlight the output+by setting DARCS\_ALWAYS\_COLOR to 1.+If you can't see colors you can set DARCS\_ALTERNATIVE\_COLOR to 1,+and darcs will use ANSI codes for bold and reverse video instead of colors.+In addition, there is an extra-colorful mode, which is not enabled by+default, which can be activated with DARCS\_DO\_COLOR\_LINES.++By default darcs will escape (by highlighting if possible) any kind of spaces at the end of lines+when showing patch contents.+If you don't want this you can turn it off by setting+DARCS\_DONT\_ESCAPE\_TRAILING\_SPACES to 1.+A special case exists for only carriage returns:+DARCS\_DONT\_ESCAPE\_TRAILING\_CR.+++\section{Character escaping and non-ASCII character encodings}+\label{env:DARCS_DONT_ESCAPE_nonascii}++Darcs needs to escape certain characters when printing patch contents to a terminal.+Characters like \emph{backspace} can otherwise hide patch content from the user,+and other character sequences can even in some cases redirect commands to the shell+if the terminal allows it.++By default darcs will only allow printable 7-bit ASCII characters (including space),+and the two control characters \emph{tab} and \emph{newline}.+(See the last paragraph in this section for a way to tailor this behavior.)+All other octets are printed in quoted form (as \verb!^<control letter>! or+\verb!\!\verb!<hex code>!).++Darcs has some limited support for locales.+If the system's locale is a single-byte character encoding,+like the Latin encodings,+you can set the environment variable DARCS\_DONT\_ESCAPE\_ISPRINT to 1+and darcs will display all the printables in the current system locale+instead of just the ASCII ones.+NOTE: This curently does not work on some architectures if darcs is+compiled with GHC~6.4 or later. Some non-ASCII control characters might be printed+and can possibly spoof the terminal.++For multi-byte character encodings things are less smooth.+UTF-8 will work if you set DARCS\_DONT\_ESCAPE\_8BIT to 1,+but non-printables outside the 7-bit ASCII range are no longer escaped.+E.g., the extra control characters from Latin-1+might leave your terminal at the mercy of the patch contents.+Space characters outside the 7-bit ASCII range are no longer recognized+and will not be properly escaped at line endings.++As a last resort you can set DARCS\_DONT\_ESCAPE\_ANYTHING to 1.+Then everything that doesn't flip code sets should work,+and so will all the bells and whistles in your terminal.+This environment variable can also be handy+if you pipe the output to a pager or external filter+that knows better than darcs how to handle your encoding.+Note that \emph{all} escaping,+including the special escaping of any line ending spaces,+will be turned off by this setting.++There are two environment variables you can set+to explicitly tell darcs to not escape or escape octets.+They are+DARCS\_DONT\_ESCAPE\_EXTRA and DARCS\_ESCAPE\_EXTRA.+Their values should be strings consisting of the verbatim octets in question.+The do-escapes take precedence over the dont-escapes.+Space characters are still escaped at line endings though.+The special environment variable DARCS\_DONT\_ESCAPE\_TRAILING\_CR+turns off escaping of carriage return last on the line (DOS style).
+ doc/src/darcs.tex view
@@ -0,0 +1,1548 @@+% Copyright (C) 2002-2003 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.++\documentclass[oneside]{book}+%\usepackage{color}++\usepackage{fullpage}+\usepackage{verbatim}+\usepackage{html}+\usepackage{fancyvrb}+\newenvironment{code}{\comment}{\endcomment}+% \newenvironment{code}{\color{blue}\verbatim}{\endverbatim}++\begin{document}+++% Definition of title page:+\title{Darcs User Manual}+\date{+\darcsVersion+} % icky newline before closing brace is to appease preproc.hs.+\author{David Roundy}++\maketitle++\tableofcontents++\chapter{Introduction}++This manual provides a stable documentation for using darcs.+To find more up-to-date and complementary information, please consult the+\htmladdnormallinkfoot{darcs wiki}{http://wiki.darcs.net}.++Darcs is a revision control system, along the lines of Subversion, Git or+Mercurial. That means that it keeps track of various revisions and branches of your+project, allows for changes to propagate from one branch to another. Darcs has two+particularly distinctive features which differ from other revision control+systems:++\paragraph{Every source tree a branch}+The primary simplifying notion of darcs is that \emph{every} copy of your+source code is a full repository. This is dramatically different from Subversion,+in which the normal usage is for there to be one central repository from+which source code will be checked out.+This has several advantages, since you can harness the full+power of darcs in any scratch copy of your code, without committing your+possibly destabilizing changes to a central repository.++\paragraph{Darcs keeps track of changes rather than versions}++In the world of darcs, the source tree is \emph{not} the fundamental+object, but rather the patch is the fundamental object. Rather than a+patch being defined in terms of the difference between two trees, a tree is+defined as the result of applying a given set of patches to an empty tree.+Moreover, these patches may be reordered without changing the tree.+This makes many operations, like cherry-picking or merging, much more natural.++\input{features.tex}++\chapter{Getting started}++This chapter will lead you through an example use of darcs, which hopefully+will allow you to get started using darcs with your project.++\section{Creating your repository}++Creating your repository in the first place just involves telling darcs to+create the special directory (called {\tt \_darcs}) in your project tree,+which will hold the revision information. This is done by simply calling+from the root directory of your project:+\begin{verbatim}+$ cd my_project/+$ darcs initialize+\end{verbatim}+This creates the \verb|_darcs| directory and populates it with whatever+files and directories are needed to describe an empty project. You now+need to tell darcs what files and directories in your project should be+under revision control. You do this using the command \verb|darcs add|:+\begin{verbatim}+$ darcs add *.c Makefile.am configure.ac+\end{verbatim}+When you have added all your files (or at least, think you have), you will+want to record your changes. ``Recording'' always includes adding a note+as to why the change was made, or what it does. In this case, we'll just+note that this is the initial version.+\begin{verbatim}+$ darcs record --all+What is the patch name? Initial revision.+\end{verbatim}+Note that since we didn't specify a patch name on the command line we were+prompted for one. If the environment variable `EMAIL' isn't set, you will+also be prompted for your email address. Each patch that is recorded is+given a unique identifier consisting of the patch name, its creator's email+address, the date when it was created, and a random hash.++\section{Making changes}++Now that we have created our repository, make a change to one or more of+your files. After making the modification run:+\begin{verbatim}+$ darcs whatsnew+\end{verbatim}+This should show you the modifications that you just made, in the darcs+patch format. If you prefer to see your changes in a different format,+read Section~\ref{whatsnew}, which describes the whatsnew command in+detail.++Let's say you have now made a change to your project. The next thing to do+is to record a patch. Recording a patch consists of grouping together a+set of related changes, and giving them a name. It also tags the patch+with the date it was recorded and your email address.++To record a patch simply type:+\begin{verbatim}+$ darcs record+\end{verbatim}+darcs will then prompt you with all the changes that you have made that+have not yet been recorded, asking you which ones you want to include in+the new patch. Finally, darcs will ask you for a name for the patch.++You can now rerun whatsnew, and see that indeed the changes you have+recorded are no longer marked as new.++\section{Making your repository visible to others}+How do you let the world know about these wonderful changes? Obviously,+they must be able to see your repository. Currently the easiest way to do+this is is to look for+\htmladdnormallinkfoot{hosting services}{http://wiki.darcs.net/Hosting}+for darcs repositories.++You can also self-host your repositories by using any web server.+The recommended way to do+this (using apache in a UNIX environment) is to create a directory called+{\tt /var/www/repos}, and then put a symlink to your repository there:+\begin{verbatim}+$ cd /var/www/repos+$ ln -s /home/username/myproject .+\end{verbatim}++\section{Getting changes made to another repository}+Ok, so your repository is browsable using any web browser\ldots\ so+what? How does one get your changes into \emph{their} repository, where they can+do some good? It couldn't be easier. One just \verb|cd| into their repository,+and there type:+\begin{verbatim}+$ darcs pull http://your.server.org/repos/yourproject+\end{verbatim}+Darcs will check to see if you have recorded any changes that aren't in their+current repository. If so, it'll prompt them for each one, to see which ones+one want to add to their repository. Note that you may see a different series+of prompts depending on your answers, since sometimes one patch depends on+another, so if you answer yes to the first one, you won't be prompted for+the second if the first depends on it.++Of course, maybe people don't even have a copy of your repository. In that case+they'd want to do a+\begin{verbatim}+$ darcs get http://your.server.org/repos/yourproject+\end{verbatim}+which gets the whole repository.++Get, pull and push also work over ssh. Ssh-paths are of the same form+accepted by scp, namely \verb|[username@]host:/path/to/repository|.++\section{Moving patches from one repository to another}++Darcs is flexible as to how you move patches from one repository to another.+This section will introduce all the ways you can get patches from one place+to another, starting with the simplest and moving to the most complicated.++\subsection{Push}++If you use ssh, you can use the push method to transfer changes.+Push can also be used when the target repository is local, in which case+ssh isn't needed.++Note that you can use push to administer a multiple-user repository. You+just need to create a user for the repository (or repositories), and give+everyone with write access ssh access, perhaps using+\verb!.ssh/authorized_keys!. Then they run+\begin{verbatim}+$ darcs push repouser@repo.server:repo/directory+\end{verbatim}++If you like this idea about creating a repository user to own a repository+which is writable by a number of users, you have one other option.++Push \verb!--apply-as! can run on either a local repository or one accessed+with ssh, but uses \verb!sudo! to run a darcs apply command (having created+a patch bundle as in send) as another user. You can add the following line+in your \verb|sudoers| file to allow the users to apply their patches to a+centralized repository:+{\small+\begin{verbatim}+ALL ALL = (repo-user) NOPASSWD: /usr/bin/darcs apply --all --repodir /repo/path*+\end{verbatim}+}+This method is ideal for a centralized repository when all the users have+accounts on the same computer, if you don't want your users to be able to+run arbitrary commands as repo-user.++\subsection{All pulls}++This method involves making each+repository readable (by http, ftp, nfs-mounted disk, or a public web hosting), and you+run \verb|darcs pull| in the repository you want to move the patch to. This is nice,+as it doesn't require you to give write access to anyone else, and is+reasonably simple.++\subsection{Send and apply manually}++Sometimes the push method is impossible because the owner of the main repository+does not want or cannot create a user to write into it, and you cannot use the all-pull+method because you cannot set up a web server on your machine, perhaps because+it's behind a firewall or perhaps for security reasons, or because it is often+turned off. In this case you can use+\verb|darcs send|+from that computer to generate a patch bundle for the remote+repository. You can either let darcs email the patch for you, or save it+as a file and transfer it by hand. Then in the destination repository+the owner of that repository runs \verb|darcs apply| to apply the patches contained+in the bundle. This is also quite a simple method since, like the all-pull+method, it doesn't require that you give anyone write access to your+repository. But it's less convenient, since the owner of the remote repository has+to keep track of the patch bundle (in the email, or whatever).++To use the send and apply method with email, the best is probably to create a+\verb!_darcs/prefs/email! file in the target repository containing the email+address of the maintainer.+This way anyone who sends to this repository will automatically send the+patch bundle to that email address.++If you receive many patches by email, you probably will benefit by running+darcs apply directly from your mail program. You can place in your \verb!.muttrc!+the following:+\begin{verbatim}+auto_view text/x-patch text/x-darcs-patch+macro pager A "<pipe-entry>darcs apply --verbose --mark-conflicts \+ --reply droundy@abridgegame.org --repodir ~/darcs"+\end{verbatim}+which will allow you to view a sent patch, and then apply the patch directly from \verb!mutt!, sending a+confirmation email to the person who sent you the patch. The autoview line relies on on the following+lines, or something like them, being present in one's \verb!.mailcap!:+\begin{verbatim}+text/x-patch; cat; copiousoutput+text/x-darcs-patch; cat; copiousoutput+\end{verbatim}++\input{configuring_darcs.tex}++\input{best_practices.tex}++\chapter{Darcs commands}++The general format of a darcs command is+\begin{verbatim}+% darcs COMMAND OPTIONS ARGUMENTS ...+\end{verbatim}+Here \verb|COMMAND| is a command such as \verb|add| or \verb|record|, which of+course may have one or more arguments. Options have the form+\verb!--option! or \verb!-o!, while arguments vary from command to+command. There are many options which are common to a number of different+commands, which will be summarized here.++If you wish, you may use any unambiguous beginning of a command name as a+shortcut: for \verb!darcs record!, you could type \verb!darcs recor! or+\verb!darcs rec!, but not \verb!darcs re! since that could be confused with+\verb!darcs replace!, \verb!darcs revert! and \verb!darcs remove!.++In some cases, \verb|COMMAND| actually consists of two words, a+super-command and a subcommand. For example, the ``display the+manifest'' command has the form \verb|darcs query manifest|.++\paragraph{Command overview}++Not all commands modify the ``patches'' of your repository (that+is, the named patches which other users can pull); some commands only+affect the copy of the source tree you're working on (your ``working+directory''), and some affect both. This table summarizes what you should+expect from each one and will hopefully serve as guide when you're having+doubts about which command to use.++\begin{center}+\footnotetext[1]{But it affects the repository and working directory targeted+ by the push}+\footnotetext[2]{As for the other end, see apply}+\begin{tabular}{|c|c|c|}+\hline+affects & patches & working directory\\+\hline+record & yes & no\\+\hline+unrecord & yes & no\\+\hline+rollback & yes & yes\\+\hline+revert & no & yes\\+\hline+unrevert & no & yes\\+\hline+pull & yes & yes\\+\hline+obliterate & yes & yes\\+\hline+apply & yes & yes\\+\hline+push\footnote{But it affects the repository and working directory targeted by+the push} & no & no\\+\hline+send\footnote{As for the other end, see apply} & no & no\\+\hline+put\footnote{Creates a new repository} & no & no\\+\hline+\end{tabular}+\end{center}++\section{Common options to darcs commands}++\begin{options}+--help+\end{options}+Every \verb|COMMAND| accepts \verb!--help! as an argument, which tells it to+provide a bit of help. Among other things, this help always provides an+accurate listing of the options available with that command, and is+guaranteed never to be out of sync with the version of darcs you actually+have installed (unlike this manual, which could be for an entirely+different version of darcs).+\begin{verbatim}+% darcs COMMAND --help+\end{verbatim}++\begin{options}+--disable+\end{options}+Every {\tt COMMAND} accepts the \verb!--disable! option, which can be used in+\verb!_darcs/prefs/defaults! to disable some commands in the repository. This+can be helpful if you want to protect the repository from accidental use of+advanced commands like obliterate, unpull, unrecord or amend-record.++\begin{options}+--verbose, --quiet, --normal-verbosity+\end{options}+Most commands also accept the \verb!--verbose! option, which tells darcs to+provide additional output. The amount of verbosity varies from command to+command. Commands that accept \verb!--verbose! also accept \verb!--quiet!,+which surpresses non-error output, and \verb!--normal-verbosity! which can be+used to restore the default verbosity if \verb!--verbose! or \verb!--quiet! is in+the defaults file.++\begin{options}+--debug, --debug-http+\end{options}+Many commands also accept the \verb!--debug! option, which causes darcs to generate+additional output that may be useful for debugging its behavior, but which otherwise+would not be interesting. Option \verb!--debug-http! makes darcs output debugging+info for libcurl.++\begin{options}+--repodir+\end{options}+Another common option is the \verb!--repodir! option, which allows you to+specify the directory of the repository in which to perform the command.+This option is used with commands, such as whatsnew, that ordinarily would+be performed within a repository directory, and allows you to use those+commands without actually being in the repository directory when calling the+command. This is useful when running darcs in a pipe, as might be the case+when running \verb'apply' from a mailer.++\begin{options}+--remote-repo+\end{options}++Some commands, such as \verb'pull' require a remote repository to be specified,+either from the command line or as a default. The \verb!--remote-repo!+provides an alternative way to supply this remote repository path. This flag+can be seen as temporarily ``replacing'' the default repository. Setting it+causes the command to ignore the default repository (it also does not affect,+i.e. overwrite the default repository). On the other hand, if any other+repositories are supplied as command line arguments, this flag will be ignored+(and the default repository may be overwritten).+++\paragraph{Selecting patches}\label{selecting}++Many commands operate on a patch or patches that have already been recorded.+There are a number of options that specify which patches are selected for+these operations: \verb!--patch!, \verb!--match!, \verb!--tag!, and variants+on these, which for \verb!--patch! are \verb!--patches!,+\verb!--from-patch!, and \verb!--to-patch!. The \verb!--patch! and+\verb!--tag! forms simply take (POSIX extended, aka \verb!egrep!) regular+expressions and match them against tag and patch names. \verb!--match!,+described below, allows more powerful patterns.++The plural forms of these options select all matching patches. The singular+forms select the last matching patch. The range (from and to) forms select+patches after or up to (both inclusive) the last matching patch.++These options use the current order of patches in the repository. darcs may+reorder patches, so this is not necessarily the order of creation or the+order in which patches were applied. However, as long as you are just+recording patches in your own repository, they will remain in order.++% NOTE --no-deps is implemented in SelectChanges.lhs, but documented here+% for concistency.+When a patch or a group of patches is selected, all patches they depend on+get silently selected too. For example: \verb!darcs pull --patches bugfix!+means ``pull all the patches with `bugfix' in their name, along with any+patches they require.'' If you really only want patches with `bugfix' in+their name, you should use the \verb!--no-deps! option, which makes darcs+exclude any matched patches from the selection which have dependencies that+are themselves not explicitly matched by the selection.++For \verb!unrecord!, \verb!unpull! and \verb!obliterate!, patches that+depend on the selected patches are silently included, or if+\verb!--no-deps! is used selected patches with dependencies on not selected+patches are excluded from the selection.+++\subsection{Match}++Currently \verb!--match! accepts eight primitive match types, although+there are plans to expand it to match more patterns. Also, note that the+syntax is still preliminary and subject to change.++The first match type accepts a literal string which is checked against+the patch name. The syntax is+\begin{verbatim}+darcs annotate --summary --match 'exact foo+bar'+\end{verbatim}+This is useful for situations where a patch name contains characters that+could be considered special for regular expressions.++In this and the other match types, the argument must be enclosed in double+quotes if it contains spaces. You can escape a quote in the argument with a+backslash; backslash escapes itself, but it is treated literally if followed+by a character other than a double quote or backslash, so it is typically not+necessary to escape a backslash. No such escaping is necessary unless the+argument is enclosed in double quotes.++The second match type accepts a regular expression which is checked against+the patch name. The syntax is+\begin{verbatim}+darcs annotate --summary --match 'name foo'+\end{verbatim}+Note that to match regexp metacharacters, such as \verb|(|, literally, they+must be escaped with backslash along with any embedded double quotes. To+match a literal backslash it must be written quadrupled in general, but often+it need not be escaped, since backslash is only special in regexps when+followed by a metacharacter. In the following example pairs, the first+literal is matched by the second sequence in the match name:+``\verb|"|'':``\verb|\"|'', ``\verb|\|'':``\verb|\\\\|'',+``\verb|\x|'':``\verb|\x|'', ``\verb|(|'':``\verb|\(|''.++The third match type matches the darcs hash for each patch:+\begin{verbatim}+darcs annotate --summary --match \+ 'hash 20040403105958-53a90-c719567e92c3b0ab9eddd5290b705712b8b918ef'+\end{verbatim}+Note you need to provide the full hash string as above.+This is intended to be used, for example, by programs allowing you to view+darcs repositories (e.g.\ CGI scripts like viewCVS).++The fourth match type accepts a regular expression which is checked against+the patch author. The syntax is+\begin{verbatim}+darcs annotate --summary --match 'author foo'+\end{verbatim}++There is also support for matching by date. This is done using commands such as+\begin{verbatim}+darcs annotate --summary --match 'date "last week"'+darcs annotate --summary --match 'date yesterday'+darcs annotate --summary --match 'date "today 14:00"'+darcs annotate --summary --match 'date "tea time yesterday"'+darcs annotate --summary --match 'date "3 days before last year at 17:00"'+darcs changes --from-match 'date "Sat Jun 30 11:31:30 EDT 2004"'+\end{verbatim}++Only English date specifications are supported---specifically you must use+English day and month names. Also, only a limited set of time zones is+supported (compatible with GNU coreutils' date parsing). Unrecognized zones+are treated as UTC, which may result in the timestamps printed in change+entries not being recognized by the date matching. You can avoid this problem+on a POSIX-like system by running darcs in the UTC zone to get the times+initially, e.g.:+\begin{verbatim}+TZ=UTC darcs changes+\end{verbatim}++When matching on the ISO format, a partial date is treated as a range.+English dates can either refer to a specific day (``6 months ago',``day before+yesterday''), or to an interval+from some past date (``last month'') to the present. Putting this all+together, if today is ``2004-07-24'' then the following matches should work:++\begin{tabular}{|ll|}+\hline+\textbf{date} & \textbf{patches selected} \\+\hline+2004 & from 2004-01-01 up to and including 2004-12-31 \\+2004-01 & from 2004-01-01 up to and including 2004-01-31 \\+2004-01-01 & during 2004-01-01 \\+\hline+today & during 2004-07-24 (starting midnight in your timezone) \\+yesterday & during 2004-07-23 \\+6 months ago & during 2004-01-23 \\+\hline+last 6 months & since 2004-01-23 \\+last month & since 2004-06-23 (not 2004-06-01!) \\+last week & since 2004-07-16 \\+\hline+\end{tabular}++For more precise control, you may specify an interval, either+in a small subset of English or+of \htmladdnormallinkfoot{the ISO 8601 format}{http://www.w3.org/TR/NOTE-datetime}.+If you use the ISO format, note that durations, when+specified alone, are interpreted as being relative to the current date and time.+\begin{verbatim}+darcs annotate --summary --match 'date "between 2004-03-12 and last week"'+darcs annotate --summary --match 'date "after 2005"'+darcs annotate --summary --match 'date "in the last 3 weeks"'+darcs annotate --summary --match 'date "P3M/2006-03-17"'+darcs annotate --summary --match 'date "2004-01-02/2006-03-17"'+darcs annotate --summary --match 'date "P2M6D"'+\end{verbatim}++You may also prefer to combine date matching with a more specific pattern.+\begin{verbatim}+darcs annotate --summary --match 'date "last week" && name foo'+\end{verbatim}++The sixth match type accepts a regular expression which is checked against+file paths that the patch touches. The syntax is+\begin{verbatim}+darcs annotate --summary --match 'touch foo/bar.c'+\end{verbatim}++The seventh match type accepts a regular expression which is checked+against every hunk. The syntax is+\begin{verbatim}+darcs annotate --summary --match 'hunk "^instance .* Foo where$"'+\end{verbatim}++The eight match type accepts a regular expression which is checked+against the long comment. The syntax is+\begin{verbatim}+darcs annotate --summary --match 'comment "remote repository"'+\end{verbatim}++The \verb!--match! pattern can include the logical operators \verb!&&!,+\verb!||! and \verb!not!, as well as grouping of patterns with parentheses.+For example+\begin{verbatim}+darcs annotate --summary --match 'name record && not name overrode'+\end{verbatim}++\begin{options}+--ignore-times, --no-ignore-times+\end{options}+Darcs optimizes its operations by keeping track of the modification times+of your files. This dramatically speeds up commands such as+\verb!whatsnew! and \verb!record! which would otherwise require reading+every file in the repository and comparing it with a reference version. However,+there are times when this can cause problems, such as when running a series+of darcs commands from a script, in which case often a file will be+modified twice in the same second, which can lead to the second+modification going unnoticed. The solution to such predicaments is the+\verb!--ignore-times! option, which instructs darcs not to trust the file+modification times, but instead to check each file's contents explicitly.+++\begin{options}+--author+\end{options}+\darcsEnv{DARCS_EMAIL}++\begin{options}+--dont-compress, --compress+\end{options}+By default, darcs commands that write patches to disk will compress the+patch files. If you don't want this, you can choose the+\verb!--dont-compress! option, which causes darcs not to compress the patch+file.++\begin{options}+--dry-run+\end{options}+The \verb!--dry-run! option will cause darcs not to actually take the specified+action, but only print what would have happened. Not all commands accept+\verb!--dry-run!, but those that do should accept the \verb!--summary! option.++\begin{options}+--summary, --no-summary+\end{options}+The \verb!--summary! option shows a summary of the patches that would have been+pulled/pushed/whatever. The format is similar to the output format of+\verb!cvs update! and looks like this:++\begin{verbatim}+A ./added_but_not_recorded.c+A! ./added_but_not_recorded_conflicts.c+a ./would_be_added_if_look_for_adds_option_was_used.h++M ./modified.t -1 +1+M! ./modified_conflicts.t -1 +1++R ./removed_but_not_recorded.c+R! ./removed_but_not_recorded_conflicts.c++\end{verbatim}++You can probably guess what the flags mean from the clever file names.+\begin{description}+\item{\texttt{A}} is for files that have been added but not recorded yet.+\item{\texttt{a}} is for files found using the \verb!--look-for-adds! option available for+\verb!whatsnew! and \verb!record!. They have not been added yet, but would be+added automatically if \verb!--look-for-adds! were used with the next+\verb!record! command.++\item{\texttt{M}} is for files that have been modified in the working directory but not+recorded yet. The number of added and subtracted lines is also shown.++\item{\texttt{R}} is for files that have been removed, but the removal is not+recorded yet.+\end{description}+An exclamation mark appears next to any option that has a conflict.+++\paragraph{Resolution of conflicts}\label{resolution}++To resolve conflicts using an external tool, you need to specify a command+to use, e.g.+\begin{verbatim}+--external-merge 'opendiff %1 %2 -ancestor %a -merge %o'+\end{verbatim}+The \verb!%1! and \verb!%2! are replaced with the two versions to be+merged, \verb!%a! is replaced with the common ancestor of the two versions.+Most importantly, \verb!%o! is replaced with the name of the output file+that darcs will require to be created holding the merged version. The+above example works with the FileMerge.app tool that comes with Apple's+developer tools. To use xxdiff, you would use+\begin{verbatim}+--external-merge 'xxdiff -m -O -M %o %1 %a %2'+\end{verbatim}+To use \verb!kdiff3!, you can use+\begin{verbatim}+--external-merge 'kdiff3 --output %o %a %1 %2'+\end{verbatim}+To use \verb!tortoiseMerge!, you can use+\begin{verbatim}+--external-merge 'tortoiseMerge /base:"%a" /mine:"%1" /theirs:"%2" /merged:"%o"'+\end{verbatim}+(\verb!tortoiseMerge! is a nice merge tool that comes with TortoiseSVN and works well+on Windows.)++% Fixme: Is it actually a shell command on MS Windows?+Note that the command is split into space-separated words and the first one is+\verb!exec!ed with the rest as arguments---it is not a shell command. In particular,+on Windows this means that the first command path should not contain spaces and+you should make sure the command is in your \verb!PATH!.++The substitution of the \verb!%! escapes is done everywhere. If you need to prevent+substitution you can use a double percentage sign, i.e. \verb!%%a! is substituted with+\verb!%a!. Here is an example script to use the Emacs' Ediff package for merging.+% This is indented so that the leading #s don't confuse the preprocessor.+\begin{verbatim}+ #! /bin/sh+ # External merge command for darcs, using Emacs Ediff, via server if possible.+ # It needs args %1 %2 %a %o, i.e. the external merge command is, say,+ # `emerge3 %1 %2 %a %o'.+ test $# -eq 4 || exit 1+ form="(ediff-merge-files-with-ancestor"+ while test $# -gt 0; do+ count=$count.+ if [ $count = .... ]; then+ form=$form\ nil # Lisp STARTUP-HOOKS arg+ fi+ case $1 in # Worry about quoting -- escape " and \+ *[\"\\]* ) form=$form\ \"$(echo $1 | sed -e's/["\\]/\\\0/g')\" ;;+ *) form=$form\ \"$1\" ;;+ esac+ shift+ done+ form=$form')'+ ( emacsclient --eval "$form" || # Emacs 22 server+ gnudoit "$form" || # XEmacs/Emacs 21 server+ emacs --eval "$form" || # Relatively slow to start up+ xemacs -eval "$form" # Horribly slow to start up+ ) 2>/dev/null+\end{verbatim}+It would be invoked like:+\begin{verbatim}+--external-merge 'emerge3 %1 %2 %a %o'+\end{verbatim}++Note that if you do use an external merge tool, most likely you will want+to add to your defaults file+(\verb!_darcs/prefs/defaults! or \verb!~/.darcs/prefs!, see \ref{defaults},+on MS Windows~\ref{ms_win})+a line such as+\begin{verbatim}+ALL external-merge kdiff3 --output %o %a %1 %2+\end{verbatim}+or+\begin{verbatim}+ALL external-merge tortoiseMerge /base:"%a" /mine:"%1" /theirs:"%2" /merged:"%o"+\end{verbatim}++Note that the defaults file does not want quotes around the command.++\begin{options}+--sendmail-command+\end{options}+\darcsEnv{SENDMAIL}++\subsection{Posthooks}++\begin{options}+--posthook=COMMAND, --no-posthook+\end{options}+To provide a command that should be run whenever a darcs command completes+successfully, use \verb!--posthook! to specify the command. This is useful+for people who want to have a command run whenever a patch is applied. Using+\verb!--no-posthook! will disable running the command.+\begin{options}+--run-posthook, --prompt-posthook+\end{options}+These options control prompting before running the posthook. Use+\verb!--prompt-posthook! to have darcs prompt before running the+posthook command. You may use --run-posthook to reenable the default+behavior of running user-specified posthooks.++Some darcs commands export to the posthook command information about the+changes being made. In particular, three environment variables are defined.+\verb!DARCS_PATCHES! contains a human-readable summary of the patches being+acted upon. The format is the same as "darcs changes". \verb!DARCS_PATCHES_XML!+Contains the same details, in the same XML format as "darcs changes". Finally,+\verb!DARCS_FILES! contains a list of the files affected, one file per line.+If your repository has filenames including newlines, you'll just have to+cope. Note, however, that \emph{none} of these environment variables are+defined when running under windows. Note also that we refuse to pass+environment variables greater in size than 10k, in order to avoid triggering+\verb!E2BIG! errors.+++\subsection{Prehooks}++\begin{options}+--prehook=COMMAND, --no-prehook+\end{options}+To provide a command that should be run before a darcs command is executed,+ use \verb!--prehook! to specify the command. An example use is+for people who want to have a command run whenever a patch is to be recorded, such as+translating line endings before recording patches. Using+\verb!--no-prehook! will disable running the command.+\begin{options}+--run-prehook, --prompt-prehook+\end{options}+These options control prompting before running the prehook. See the+posthook documentation above for details.++\begin{options}+--ssh-cm, --no-ssh-cm+\end{options}++For commands which invoke ssh, darcs will normally multiplex ssh+sessions over a single connection as long as your version of ssh has+the ControlMaster feature from OpenSSH versions 3.9 and above. This+option will avoid darcs trying to use this feature even if your ssh+supports it.++\begin{options}+--http-pipelining, --no-http-pipelining+\end{options}++When compiled with libcurl (version 7.18.0 and above), darcs can+use HTTP pipelining. It is enabled by default for libcurl+(version 7.19.1 and above). This option will make darcs enable or+disable HTTP pipelining, overwriting default. Note that if HTTP+pipelining is really used depends on the server.++\begin{options}+--no-cache+\end{options}++Do not use patch caches.++\begin{options}+--umask+\end{options}+By default, Darcs will use your current umask. The option+\verb|--umask| will cause Darcs to switch to a different umask before+writing to the repository.++\begin{options}+--dont-restrict-paths, --restrict-paths+\end{options}+By default darcs is only allowed to manage and modify files and directories+contained inside the current repository and not being part of any darcs+repository's meta data (including the current one). This is mainly for+security, to protect you from spoofed patches modifying arbitrary files+with sensitive data---say, in your home directory---or tampering with any+repository's meta data to switch off this safety guard.++But sometimes you may want to manage a group of ``sub'' repositories'+preference files with a global repository, or use darcs in some other+advanced way. The best way is probably to put+\verb!ALL dont-restrict-paths! in \verb!_darcs/prefs/defaults!. This turns+off all sanity checking for file paths in patches.++Path checking can be temporarily turned on with \verb!--restrict-paths! on+the command line, when pulling or applying unknown patches.++\begin{options}+--allow-unrelated-repos+\end{options}+By default darcs checks and warns user if repositories are unrelated when+doing pull, push and send. This option makes darcs skip this check.+++\section{Options apart from darcs commands}+\begin{options}+--help+\end{options}+Calling darcs with just \verb|--help| as an argument gives a brief+summary of what commands are available.+\begin{options}+--version, --exact-version+\end{options}+Calling darcs with the flag \verb|--version| tells you the version of+darcs you are using. Calling darcs with the flag \verb|--exact-version|+gives the precise version of darcs, even if that version doesn't correspond+to a released version number. This is helpful with bug reports, especially+when running with a ``latest'' version of darcs.+\begin{options}+--commands+\end{options}+Similarly calling darcs with only \verb|--commands| gives a simple list+of available commands. This latter arrangement is primarily intended for+the use of command-line autocompletion facilities, as are available in+bash.++\section{Getting help}++\darcsCommand{help}++\section{Creating repositories}++\darcsCommand{initialize}+\darcsCommand{get}++\section{Modifying the contents of a repository}++\darcsCommand{add}+\darcsCommand{remove}+\darcsCommand{move}+\darcsCommand{replace}++\section{Working with changes}++\darcsCommand{record}++\begin{options}+--ask-deps+\end{options}++Each patch may depend on any number of previous patches. If you choose to+make your patch depend on a previous patch, that patch is required to be+applied before your patch can be applied to a repository. This can be used, for+example, if a piece of code requires a function to be defined, which was+defined in an earlier patch.++If you want to manually define any dependencies for your patch, you can use+the \verb!--ask-deps! flag, and darcs will ask you for the patch's+dependencies.++It is possible to record a patch which has no actual changes but which+has specific dependencies. This type of patch can be thought of as a+``partial tag''. The \verb!darcs tag! command will record a patch+with no actual changes but which depends on the entire current+inventory of the repository. The \verb!darcs record --ask-deps! with+no selected changes will record a patch that depends on only those+patches selected via the \verb!--ask-deps! operation, resulting in a+patch which describes a set of patches; the presence of this primary+patch in a repository implies the presence of (at least) the+depended-upon patches.++\begin{options}+--pipe+\end{options}++If you run record with the \verb!--pipe! option, you will be prompted for+the patch date, author, and the long comment. The long comment will extend+until the end of file or stdin is reached (ctrl-D on Unixy systems, ctrl-Z+on systems running a Microsoft OS).++This interface is intended for scripting darcs, in particular for writing+repository conversion scripts. The prompts are intended mostly as a useful+guide (since scripts won't need them), to help you understand the format in+which to provide the input. Here's an example of what the \verb!--pipe!+prompts look like:++\begin{verbatim}+ What is the date? Mon Nov 15 13:38:01 EST 2004+ Who is the author? David Roundy+ What is the log? One or more comment lines+\end{verbatim}+++\begin{options}+--interactive+\end{options}++By default, \verb!record! works interactively. Probably the only thing you need+to know about using this is that you can press \verb!?! at the prompt to be+shown a list of the rest of the options and what they do. The rest should be+clear from there. Here's a+``screenshot'' to demonstrate:++\begin{verbatim}+hunk ./hello.pl +2++#!/usr/bin/perl++print "Hello World!\n";+Shall I record this patch? (2/2) [ynWsfqadjk], or ? for help: ?+How to use record...+y: record this patch+n: don't record it+w: wait and decide later, defaulting to no++s: don't record the rest of the changes to this file+f: record the rest of the changes to this file++d: record selected patches+a: record all the remaining patches+q: cancel record++j: skip to next patch+k: back up to previous patch+h or ?: show this help++<Space>: accept the current default (which is capitalized)++\end{verbatim}+What you can't see in that ``screenshot'' is that \verb!darcs! will also try to use+color in your terminal to make the output even easier to read.++\darcsCommand{pull}++\begin{options}+--intersection, --union [DEFAULT], --complement+\end{options}++If you provide more than one repository as an argument to pull, darcs'+behavior is determined by the presence of the \verb!--complement!,+\verb!--intersection!, and \verb!--union! flags.++\begin{itemize}++\item The default (\verb!--union!) behavior is to pull any patches+that are in any of the specified repositories.++\item If you instead specify the \verb!--intersection! flag, darcs+will only pull those patches which are present in all source+repositories.++\item If you specify the \verb!--complement! flag, darcs will only+pull elements in the first repository that do not exist in any of the+remaining repositories.+\end{itemize}+++\begin{options}+--external-merge+\end{options}++You can use an external interactive merge tool to resolve conflicts with the+flag \verb!--external-merge!. For more details see+subsection~\ref{resolution}.++\begin{options}+--matches, --patches, --tags, --no-deps+\end{options}++The \verb!--patches!, \verb!--matches!, \verb!--tags!, and \verb!--no-deps!+options can be used to select which patches to pull, as described in+subsection~\ref{selecting}.++\begin{options}+--no-test, --test+\end{options}++If you specify the \verb!--test! option, pull will run the test (if a test+exists) on a scratch copy of the repository contents prior to actually performing+the pull. If the test fails, the pull will be aborted.++\begin{options}+--verbose+\end{options}++Adding the \verb!--verbose! option causes another section to appear in the+output which also displays a summary of patches that you have and the remote+repository lacks. Thus, the following syntax can be used to show you all the patch+differences between two repositories:++\begin{verbatim}+darcs pull --dry-run --verbose+\end{verbatim}++\darcsCommand{push}++For obvious reasons, you can only push to repositories to which you have+write access. In addition, you can only push to repos that you access+either on the local file system or with ssh. In order to apply with ssh,+darcs must also be installed on the remote computer. The command invoked+to run ssh may be configured by the \verb!DARCS_SSH! environment variable+(see subsection~\ref{env:DARCS_SSH}). The command invoked via ssh is always+\verb!darcs!, i.e.\ the darcs executable must be in the default path on+the remote machine.++Push works by creating a patch bundle, and then running darcs apply in the+target repository using that patch bundle. This means that the default+options for \emph{apply} in the \emph{target} repository (such as, for+example, \verb!--test!) will affect the behavior of push. This also means+that push is somewhat less efficient than pull.++When you receive an error message such as+\begin{verbatim}+bash: darcs: command not found+\end{verbatim}+then this means that the darcs on the remote machine could+not be started. Make sure that the darcs executable is called+\verb!darcs! and is found in the default path. The default path can+be different in interactive and in non-interactive shells. Say+\begin{verbatim}+ssh login@remote.machine darcs+\end{verbatim}+to try whether the remote darcs can be found, or+\begin{verbatim}+ssh login@remote.machine 'echo $PATH'+\end{verbatim}+(note the single quotes) to check the default path.++\begin{options}+--apply-as+\end{options}++If you give the \verb!--apply-as! flag, darcs will use sudo to apply the+changes as a different user. This can be useful if you want to set up a+system where several users can modify the same repository, but you don't+want to allow them full write access. This isn't secure against skilled+malicious attackers, but at least can protect your repository from clumsy,+inept or lazy users.++\begin{options}+--matches, --patches, --tags, --no-deps+\end{options}++The \verb!--patches!, \verb!--matches!, \verb!--tags!, and \verb!--no-deps!+options can be used to select which patches to push, as described in+subsection~\ref{selecting}.++When there are conflicts, the behavior of push is determined by the default+flags to \verb!apply! in the \emph{target} repository. Most commonly, for+pushed-to repositories, you'd like to have \verb!--dont-allow-conflicts! as+a default option to apply (by default, it is already the default\ldots). If+this is the case, when there are conflicts on push, darcs will fail with an+error message. You can then resolve by pulling the conflicting patch,+recording a resolution and then pushing the resolution together with the+conflicting patch.++Darcs does not have an explicit way to tell you which patch conflicted, only the+file name. You may want to pull all the patches from the remote repository just+to be sure. If you don't want to do this in your working directory,+you can create another darcs working directory for this purpose.++If you want, you could set the target repository to use \verb!--allow-conflicts!.+In this case conflicting patches will be applied, but the conflicts will+not be marked in the working directory.++If, on the other hand, you have \verb!--mark-conflicts! specified as a+default flag for apply in the target repository, when there is a conflict,+it will be marked in the working directory of the target repository. In+this case, you should resolve the conflict in the target repository itself.++\darcsCommand{send}++Do not confuse the \verb!--author! options with the return address+that \verb!darcs send! will set for your patch bundle.++For example, if you have two email addresses A and B:+\begin{description}+\item If you use+\verb!--author A! but your machine is configured to send mail from+address B by default, then the return address on your message will be B.++\item If you use \verb!--from A! and your mail client supports setting the+From: address arbitrarily (some non-Unix-like mail clients, especially,+may not support this), then the return address will be A; if it does+not support this, then the return address will be B.++\item If you supply neither \verb!--from! nor \verb!--author!, then the return+address will be B.+\end{description}++In addition, unless you specify the sendmail command with+\verb!--sendmail-command!, darcs sends email using the default email+command on your computer. This default command is determined by the+\verb!configure! script. Thus, on some non-Unix-like OSes,+\verb!--from! is likely to not work at all.++\begin{options}+--output, --to, --cc+\end{options}++The \verb!--output!, \verb!--output-auto-name!, and \verb!--to! flags determine+what darcs does with the patch bundle after creating it. If you provide an+\verb!--output! argument, the patch bundle is saved to that file. If you+specify \verb!--output-auto-name!, the patch bundle is saved to a file with an+automatically generated name. If you give one or more \verb!--to! arguments,+the bundle of patches is sent to those locations. The locations may either be email+addresses or urls that the patch should be submitted to via HTTP.++If you don't provide any of these options, darcs will look at the contents of+the \verb!_darcs/prefs/email! file in the target repository (if it exists), and+send the patch by email to that address. In this case, you may use the+\verb!--cc! option to specify additional recipients without overriding the+default repository email address.++If \texttt{\_darcs/prefs/post} exists in the target repository, darcs will+upload to the URL contained in that file, which may either be a+\texttt{mailto:} URL, or an \texttt{http://} URL. In the latter case, the+patch is posted to that URL.++If there is no email address associated with the repository, darcs will+prompt you for an email address.++\begin{options}+--subject+\end{options}++Use the \verb!--subject! flag to set the subject of the e-mail to be sent.+If you don't provide a subject on the command line, darcs will make one up+based on names of the patches in the patch bundle.++\begin{options}+--in-reply-to+\end{options}++Use the \verb!--in-reply-to! flag to set the In-Reply-To and References headers+of the e-mail to be sent. By default no additional headers are included so e-mail+will not be treated as reply by mail readers.++\begin{options}+--matches, --patches, --tags, --no-deps+\end{options}++The \verb!--patches!, \verb!--matches!, \verb!--tags!, and \verb!--no-deps!+options can be used to select which patches to send, as described in+subsection~\ref{selecting}.++\begin{options}+--edit-description+\end{options}++If you want to include a description or explanation along with the bundle+of patches, you need to specify the \verb!--edit-description! flag, which+will cause darcs to open up an editor with which you can compose a message+to go along with your patches.++\begin{options}+--sendmail-command+\end{options}++If you want to use a command different from the default one for sending email,+you need to specify a command line with the \verb!--sendmail-command! option. The+command line can contain some format specifiers which are replaced by the actual+values. Accepted format specifiers are \verb!%s! for subject, \verb!%t! for to,+\verb!%c! for cc, \verb!%b! for the body of the mail, \verb!%f! for from, \verb!%a!+for the patch bundle and the same specifiers in uppercase for the URL-encoded values.+Additionally you can add \verb!%<! to the end of the command line if the command+expects the complete email message on standard input. E.g.\ the command lines for evolution+and msmtp look like this:++\begin{verbatim}+evolution "mailto:%T?subject=%S&attach=%A&cc=%C&body=%B"+msmtp -t %<+\end{verbatim}++\darcsCommand{apply}++Darcs apply accepts a single argument, which is the name of the patch+file to be applied. If you omit this argument, the patch is read from+standard input. Darcs also interprets an argument of `\-' to mean it+should read the file from standard input. This allows you to use apply+with a pipe from your email program, for example.++\begin{options}+--verify+\end{options}++\begin{options}+--external-merge+\end{options}++You can use an external interactive merge tool to resolve conflicts with the+flag \verb!--external-merge!. For more details see+subsection~\ref{resolution}.++\begin{options}+--sendmail-command+\end{options}++If you want to use a command different from the default one for sending mail,+you need to specify a command line with the \verb!--sendmail-command! option.+The command line can contain the format specifier \verb!%t! for to+and you can add \verb!%<! to the end of the command line if the command+expects the complete mail on standard input. For example, the command line for+msmtp looks like this:++\begin{verbatim}+msmtp -t %<+\end{verbatim}+++\section{Seeing what you've done}++\darcsCommand{whatsnew}+\darcsCommand{changes}++\section{More advanced commands}++\darcsCommand{tag}+\darcsCommand{setpref}+\darcsCommand{check}++If you like, you can configure your repository to be able to run a test+suite of some sort. You can do this by using ``setpref'' to set the+``test'' value to be a command to run, e.g.+\begin{verbatim}+% darcs setpref test "sh configure && make && make test"+\end{verbatim}+Or, if you want to define a test specific to one copy of the repository,+you could do this by editing the file \verb!_darcs/prefs/prefs!.++\begin{options}+--leave-test-directory, --remove-test-directory+\end{options}++Normally darcs deletes the directory in which the test was run afterwards.+Sometimes (especially when the test fails) you'd prefer to be able to be+able to examine the test directory after the test is run. You can do this+by specifying the \verb!--leave-test-directory! flag. Alas, there is no+way to make darcs leave the test directory only if the test fails. The+opposite of \verb!--leave-test-directory! is+\verb!--remove-test-directory!, which could come in handy if you choose to+make \verb!--leave-test-directory! the default (see+section~\ref{defaults}).++\darcsCommand{repair}+\darcsCommand{optimize}++\begin{options}+--reorder-patches+\end{options}++The \verb|--reorder-patches| option causes Darcs to create an optimal+ordering of its internal patch inventory. This may help to produce shorter+`context' lists when sending patches, and may improve performance for some+other operations as well. You should not run \verb!--reorder-patches! on a+repository from which someone may be simultaneously pulling or getting, as+this could lead to repository corruption.++The \verb|--upgrade| option for \verb!darcs optimize! performs an inplace+upgrade of your repository to the latest \emph{compatible} format. Right now+means that darcs 1 old-fashioned repositories will be upgraded to darcs-1+hashed repositories (and notably, not to darcs 2 repositories as that would not+be compatible; see \verb!darcs convert!).++\section{Undoing, redoing and running in circles}++\darcsCommand{amend-record}+\darcsCommand{rollback}+\darcsCommand{unrecord}++Unrecord can be thought of as undo-record.+If a record is followed by an unrecord, everything looks like before+the record; all the previously unrecorded changes are back, and can be+recorded again in a new patch. The unrecorded patch however is actually+removed from your repository, so there is no way to record it again to get+it back.\footnote{The patch file itself is not actually deleted, but its+context is lost, so it cannot be reliably read---your only choice would be+to go in by hand and read its contents.}.++If you want to remove+the changes from the working copy too (where they otherwise will show+up as unrecorded changes again), you'll also need to \verb!darcs revert!.+To do unrecord and revert in one go, you can use \verb!darcs obliterate!.++If you don't revert after unrecording, then the changes made by the+unrecorded patches are left in your working tree. If these patches are+actually from another repository, interaction (either pushes or pulls) with+that repository may be massively slowed down, as darcs tries to cope with+the fact that you appear to have made a large number of changes that+conflict with those present in the other repository. So if you really want+to undo the result of a \emph{pull} operation, use obliterate! Unrecord is+primarily intended for when you record a patch, realize it needs just one+more change, but would rather not have a separate patch for just that one+change.++\newcommand{\pullwarning}[1]{+\textbf{WARNING:} #1 should not be run when there is a possibility+that another user may be pulling from the same repository. Attempting to do so+may cause repository corruption.}++\pullwarning{Unrecord}++\begin{options}+--from-match, --from-patch, --from-tag, --last+\end{options}++Usually you only want to unrecord the latest changes,+and almost never would you want to unrecord changes before a tag---you+would have to have unrecorded the tag as well to do that.+Therefore, and for efficiency, darcs only prompts you for the latest patches,+after some optimal tag.++If you do want to unrecord more patches in one go,+there are the \verb!--from! and \verb!--last! options+to set the earliest patch selectable to unrecord.++\begin{options}+--matches, --patches, --tags, --no-deps+\end{options}++The \verb!--patches!, \verb!--matches!, \verb!--tags!, and \verb!--no-deps!+options can be used to select which patches to unrecord, as described in+subsection~\ref{selecting}.++With these options you can specify+what patch or patches to be prompted for by unrecord.+This is especially useful when you want to unrecord patches with dependencies,+since all the dependent patches (but no others) will be included in the choices.+Or if you use \verb!--no-deps! you won't be asked about patches that can't be+unrecorded due to depending patches.++Selecting patches can be slow, so darcs cuts the search at the last+optimized tag. Use the \verb!--from! or \verb!--last! options to search+more or fewer patches.++\darcsCommand{obliterate}++Obliterate deletes a patch from the repository \emph{and} removes those+changes from the working directory. It is therefore a \emph{very+dangerous} command. When there are no local changes, obliterate is+equivalent to an unrecord followed by a revert, except that revert can be+unreverted. In the case of tags, obliterate removes the tag itself, not+any other patches.++Note that unpull was the old name for obliterate. Unpull is still an+hidden alias for obliterate.++\pullwarning{Obliterate}++\begin{options}+--from-match, --from-patch, --from-tag, --last+\end{options}++Usually you only want to obliterate the latest changes, and almost never would+you want to obliterate changes before a tag---you would have to have obliterated+the tag as well to do that. Therefore, and for efficiency, darcs only+prompts you for the latest patches, after some optimal tag.++If you do want to obliterate more patches in one go, there are the+\verb!--from! and \verb!--last! options to set the earliest patch+selectable to obliterate.++\begin{options}+--matches, --patches, --tags, --no-deps+\end{options}++The \verb!--patches!, \verb!--matches!, \verb!--tags!, and \verb!--no-deps!+options can be used to select which patches to obliterate, as described in+subsection~\ref{selecting}.++With these options you can specify what patch or patches to be prompted for+by obliterate. This is especially useful when you want to obliterate patches with+dependencies, since all the dependent patches (but no others) will be+included in the choices. Or if you use \verb!--no-deps! you won't be asked+about patches that can't be obliterated due to depending patches.++Selecting patches can be slow, so darcs cuts the search at the last+optimized tag. Use the \verb!--from! or \verb!--last! options to search+more or fewer patches.+++\darcsCommand{revert}+\darcsCommand{unrevert}++\section{Advanced examination of the repository}++\darcsCommand{diff}+\darcsCommand{annotate}++%% FIXME: AFAICT -u does nothing. Remove it from anno's options?+%% --twb, 2009-09-20+Giving the \verb!--unified! flag implies \verb!--human-readable!, and causes+the output to remain in a darcs-specific format that is similar to that produced+by \verb!diff --unified!.++If a directory name is given, annotate will output details of the last+modifying patch for each file in the directory and the directory itself. The+details look like this:++\begin{verbatim}+ # Created by [bounce handling patch+ # mark**20040526202216] as ./test/m7/bounce_handling.pl+ bounce_handling.pl+\end{verbatim}++If a patch name and a directory are given, these details are output for the time after+that patch was applied. If a directory and a tag name are given, the+details of the patches involved in the specified tagged version will be output.++If a file name is given, the last modifying patch details of that file will be output, along+with markup indicating patch details when each line was last (and perhaps next) modified.++If a patch name and a file name are given, these details are output for the time after+that patch was applied.++\begin{options}+--creator-hash HASH+\end{options}++The \verb!--creator-hash! option should only be used in combination with a+file or directory to be annotated. In this case, the name of that file or+directory is interpreted to be its name \emph{at the time it was created},+and the hash given along with \verb!--creator-hash! indicates the patch+that created the file or directory. This allows you to (relatively) easily+examine a file even if it has been renamed multiple times.++\subsection{darcs show}++The show command provides access to several subcommands which can be+used to investigate the state of a repository.++\darcsCommand{show authors}+\darcsCommand{show contents}+\darcsCommand{show files}+\darcsCommand{show index}+\darcsCommand{show tags}+\darcsCommand{show repo}++\section{Rarely needed and obscure commands}++\darcsCommand{mark-conflicts}+\darcsCommand{trackdown}++Trackdown is helpful for locating when something was broken. It creates+a temporary directory with the latest repository content in it and cd to it.+First, and only once, it runs the initialization command if any,+for example+\begin{verbatim}+'autoconf; ./configure >/dev/null'+\end{verbatim}+Then it runs the test command, for example+\begin{verbatim}+'make && cd tests && sh /tmp/test.sh'+\end{verbatim}+While the test command exits with an error return code, darcs+``unapplies'' one patch from the version controlled files to retrieve+an earlier version, and repeats the test command. If the test command+finally succeeds, the name of the hunted down patch is found in the+output before the last test run.++The \verb!--bisect! variant of trackdown can be useful when the sought after+patch is likely buried deep in the repository history; however, it currently+requires an potentially expensive process of applying or unapplying half the+repository's patches at a time. You may often find the straightforward linear+trackdown to be more efficient in practice.++\subsubsection{Example usage}+If you want to find the last version of darcs that had a FIXME note in the+file Record.lhs, you could run+\begin{verbatim}+% darcs trackdown 'grep FIXME Record.lhs'+\end{verbatim}++To find the latest version that compiles, you can run+\begin{verbatim}+% darcs trackdown 'autoconf' './configure && make'+\end{verbatim}++Trackdown can also be used to see how other features of the code changed+with time. For example+\begin{verbatim}+% darcs trackdown 'autoconf; ./configure' \+ "make darcs > /dev/null && cd ~/darcs && time darcs check && false"+\end{verbatim}+would let you see how long `darcs check' takes to run on each previous+version of darcs that will actually compile. The ``\verb!&& false!''+ensures that trackdown keeps going.++\darcsCommand{dist}+\darcsCommand{put}+\darcsCommand{fetch}+\darcsCommand{convert}++A project cannot mix both patch formats.+By default, repositories created with `darcs initialize' are set+to use the `darcs-2' format (\ref{initialize}).+Cloning an existing repository with `darcs get' or `darcs put'+preserves the patch format used.++The `darcs-2' format improves on the `darcs-1' format in the following+ways:++\begin{itemize}+\item The `exponential merge' problem is \emph{far} less likely to+ occur (it can still be produced in deliberately pathological cases).+\item Identical primitive changes no longer conflict. For example, if+ two patches both attempt to add a directory `tests', these patches+ will not conflict.+\end{itemize}++\appendix++\input{building_darcs.tex}++\input{gpl.tex}++\end{document}++
+ doc/src/features.tex view
@@ -0,0 +1,71 @@+\section{Features}++\paragraph{Record changes locally}+In darcs, the equivalent of a svn ``commit'' is called record, because it+doesn't put the change into any remote or centralized repository. Changes+are always recorded locally, meaning no net access is required in order to+work on your project and record changes as you make them.++\paragraph{Interactive records}+You can choose to perform an interactive record, in which case darcs will+prompt you for each change you have made and ask if you wish to record it.+Of course, you can tell darcs to record all the changes in a given file, or+to skip all the changes in a given file, or go back to a previous change,+or whatever.++\paragraph{Unrecord local changes}+As a corollary to the ``local'' nature of the record operation, if a change+hasn't yet been published to the world---that is, if the local repository+isn't accessible by others---you can safely unrecord a change (even if it+wasn't the most recently recorded change) and then re-record it+differently, for example if you forgot to add a file, introduced a bug or+realized that what you recorded as a single change was really two separate+changes.++\paragraph{Interactive everything else}+Most darcs commands support an interactive interface. The ``revert''+command, for example, which undoes unrecorded changes has the same+interface as record, so you can easily revert just a single change. Pull,+push, send and apply all allow you to view and interactively select which+changes you wish to pull, push, send or apply.++\paragraph{Test suites}+Darcs has support for integrating a test suite with a repository. If you+choose to use this, you can define a test command (e.g.\ ``make check'') and+have darcs run that command on a clean copy of the project either prior to+recording a change or prior to applying changes---and to reject changes+that cause the test to fail.++\paragraph{Any old server}+Darcs does not require a specialized server in order to make a repository+available for read access. You can use http, ftp, or even just a plain old+ssh server to access your darcs repository.++\paragraph{You decide write permissions}+Darcs doesn't try to manage write access. That's your business. Supported+push methods include direct ssh access (if you're willing to \emph{give}+direct ssh access away), using sudo to allow users who already have shell+access to only apply changes to the repository, or verification of+gpg-signed changes sent by email against a list of allowed keys. In+addition, there is support for submission of patches by email that+are not automatically applied, but can easily be applied with a shell escape+from a mail reader.++\paragraph{File and directory moves}+Renames or moves of files and directories, of course are handled properly,+so when you rename a file or move it to a different directory, its history+is unbroken, and merges with repositories that don't have the file renamed+will work as expected.++\paragraph{Token replace}+You can use the ``darcs replace'' command to modify all occurrences of a+particular token (defined by a configurable set of characters that are+allowed in ``tokens'') in a file. This has the advantage that merges with+changes that introduce new copies of the old token will have the effect of+changing it to the new token---which comes in handy when changing a+variable or function name that is used throughout a project.++\paragraph{Configurable defaults}+You can easily configure the default flags passed to any command on either+a per-repository or a per-user basis or a combination thereof.+
+ doc/src/gpl.tex view
@@ -0,0 +1,420 @@+% This is the FSF GPL, reformatted as an appendix by David Roundy++% This file is intended to be included in another file.++\chapter{License}++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.++\label{gpl}+\section*{The GNU General Public License}++\begin{center}+Version 2, June 1991++Copyright \copyright\ 1989, 1991 Free Software Foundation, Inc.++\bigskip++51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA++\bigskip++Everyone is permitted to copy and distribute verbatim copies+of this license document, but changing it is not allowed.++\end{center}++\subsection*{Preamble}+\begin{quote}+The licenses for most software are designed to take away your freedom to+share and change it. By contrast, the GNU General Public License is+intended to guarantee your freedom to share and change free software---to+make sure the software is free for all its users. This General Public+License applies to most of the Free Software Foundation's software and to+any other program whose authors commit to using it. (Some other Free+Software Foundation software is covered by the GNU Library General Public+License instead.) You can apply it to your programs, too.++When we speak of free software, we are referring to freedom, not price.+Our General Public Licenses are designed to make sure that you have the+freedom to distribute copies of free software (and charge for this service+if you wish), that you receive source code or can get it if you want it,+that you can change the software or use pieces of it in new free programs;+and that you know you can do these things.++To protect your rights, we need to make restrictions that forbid anyone to+deny you these rights or to ask you to surrender the rights. These+restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++For example, if you distribute copies of such a program, whether gratis or+for a fee, you must give the recipients all the rights that you have. You+must make sure that they, too, receive or can get the source code. And+you must show them these terms so they know their rights.++We protect your rights with two steps: (1) copyright the software, and (2)+offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++Also, for each author's protection and ours, we want to make certain that+everyone understands that there is no warranty for this free software. If+the software is modified by someone else and passed on, we want its+recipients to know that what they have is not the original, so that any+problems introduced by others will not reflect on the original authors'+reputations.++Finally, any free program is threatened constantly by software patents.+We wish to avoid the danger that redistributors of a free program will+individually obtain patent licenses, in effect making the program+proprietary. To prevent this, we have made it clear that any patent must+be licensed for everyone's free use or not licensed at all.++The precise terms and conditions for copying, distribution and+modification follow.+\end{quote}++\begin{center}+{\Large \sc GNU General Public License+\\\vspace{3mm}Terms and Conditions For Copying, Distribution and Modification}+\end{center}+++\begin{enumerate}++\addtocounter{enumi}{-1}++\item ++This License applies to any program or other work which contains a notice+placed by the copyright holder saying it may be distributed under the+terms of this General Public License. The ``Program'', below, refers to+any such program or work, and a ``work based on the Program'' means either+the Program or any derivative work under copyright law: that is to say, a+work containing the Program or a portion of it, either verbatim or with+modifications and/or translated into another language. (Hereinafter,+translation is included without limitation in the term ``modification''.)+Each licensee is addressed as ``you''.++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++\item You may copy and distribute verbatim copies of the Program's source+ code as you receive it, in any medium, provided that you conspicuously+ and appropriately publish on each copy an appropriate copyright notice+ and disclaimer of warranty; keep intact all the notices that refer to+ this License and to the absence of any warranty; and give any other+ recipients of the Program a copy of this License along with the Program.++You may charge a fee for the physical act of transferring a copy, and you+may at your option offer warranty protection in exchange for a fee.++\item++You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++\begin{enumerate}++\item ++You must cause the modified files to carry prominent notices stating that+you changed the files and the date of any change.++\item++You must cause any work that you distribute or publish, that in+whole or in part contains or is derived from the Program or any+part thereof, to be licensed as a whole at no charge to all third+parties under the terms of this License.++\item+If the modified program normally reads commands interactively+when run, you must cause it, when started running for such+interactive use in the most ordinary way, to print or display an+announcement including an appropriate copyright notice and a+notice that there is no warranty (or else, saying that you provide+a warranty) and that users may redistribute the program under+these conditions, and telling the user how to view a copy of this+License. (Exception: if the Program itself is interactive but+does not normally print such an announcement, your work based on+the Program is not required to print an announcement.)++\end{enumerate}+++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++\item+You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++\begin{enumerate}++\item++Accompany it with the complete corresponding machine-readable+source code, which must be distributed under the terms of Sections+1 and 2 above on a medium customarily used for software interchange; or,++\item++Accompany it with a written offer, valid for at least three+years, to give any third party, for a charge no more than your+cost of physically performing source distribution, a complete+machine-readable copy of the corresponding source code, to be+distributed under the terms of Sections 1 and 2 above on a medium+customarily used for software interchange; or,++\item++Accompany it with the information you received as to the offer+to distribute corresponding source code. (This alternative is+allowed only for noncommercial distribution and only if you+received the program in object code or executable form with such+an offer, in accord with Subsection b above.)++\end{enumerate}+++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++\item+You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++\item+You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++\item+Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++\item+If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++\item+If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++\item+The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and ``any+later version'', you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++\item+If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++\begin{center}+{\Large\sc+No Warranty+}+\end{center}++\item+{\sc Because the program is licensed free of charge, there is no warranty+for the program, to the extent permitted by applicable law. Except when+otherwise stated in writing the copyright holders and/or other parties+provide the program ``as is'' without warranty of any kind, either expressed+or implied, including, but not limited to, the implied warranties of+merchantability and fitness for a particular purpose. The entire risk as+to the quality and performance of the program is with you. Should the+program prove defective, you assume the cost of all necessary servicing,+repair or correction.}++\item+{\sc In no event unless required by applicable law or agreed to in writing+will any copyright holder, or any other party who may modify and/or+redistribute the program as permitted above, be liable to you for damages,+including any general, special, incidental or consequential damages arising+out of the use or inability to use the program (including but not limited+to loss of data or data being rendered inaccurate or losses sustained by+you or third parties or a failure of the program to operate with any other+programs), even if such holder or other party has been advised of the+possibility of such damages.}++\end{enumerate}+++\begin{center}+{\Large\sc End of Terms and Conditions}+\end{center}++\subsection*{Appendix: How to Apply These Terms to Your New Programs}++If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these+terms.++ To do so, attach the following notices to the program. It is safest to+ attach them to the start of each source file to most effectively convey+ the exclusion of warranty; and each file should have at least the+ ``copyright'' line and a pointer to where the full notice is found.++\begin{quote}+$<$one line to give the program's name and a brief idea of what it does.$>$ \\+Copyright (C) $<$year$>$ $<$name of author$>$ \\++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 of the License, 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; if not, write to the Free Software+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+\end{quote}++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++\begin{quote}+Gnomovision version 69, Copyright (C) $<$year$>$ $<$name of author$>$ \\+Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. \\+This is free software, and you are welcome to redistribute it+under certain conditions; type `show c' for details.+\end{quote}+++The hypothetical commands {\tt show w} and {\tt show c} should show the+appropriate parts of the General Public License. Of course, the commands+you use may be called something other than {\tt show w} and {\tt show c};+they could even be mouse-clicks or menu items---whatever suits your+program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a ``copyright disclaimer'' for the program, if+necessary. Here is a sample; alter the names:++\begin{quote}+Yoyodyne, Inc., hereby disclaims all copyright interest in the program \\+`Gnomovision' (which makes passes at compilers) written by James Hacker. \\++$<$signature of Ty Coon$>$, 1 April 1989 \\+Ty Coon, President of Vice+\end{quote}+++This General Public License does not permit incorporating your program+into proprietary programs. If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications+with the library. If this is what you want to do, use the GNU Library+General Public License instead of this License.
release/distributed-context view
@@ -1,1 +1,1 @@-Just "\nContext:\n\n[TAG 2.4.99.1\nReinier Lamers <tux_rocker@reinier.de>**20101015132045\n Ignore-this: 4293f06a5a3344bc710b65253ba0c8c1\n] \n"+Just "\nContext:\n\n[TAG 2.7.98.1\nFlorent Becker <florent.becker@ens-lyon.org>**20110622133304\n Ignore-this: 34d700fca22914533895adec39aaea1e\n] \n"
src/ByteStringUtils.hs view
@@ -34,7 +34,6 @@ gzDecompress, -- list utilities- ifHeadThenTail, dropSpace, breakSpace, linesPS,@@ -55,16 +54,14 @@ -- encoding and unicode utilities decodeLocale, encodeLocale,- encodeLatin1,- decodeString,- utf8ToLocale+ decodeString ) where import Prelude hiding ( catch ) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Internal as BI-import Data.ByteString (intercalate, uncons)+import Data.ByteString (intercalate) import Data.ByteString.Internal (fromForeignPtr) #if defined (HAVE_MMAP)@@ -72,7 +69,7 @@ #endif import System.IO import System.IO.Unsafe ( unsafePerformIO )-import System.Console.Haskeline ( runInputT, defaultSettings )+import System.Console.Haskeline ( InputT, runInputTBehavior, defaultSettings, useFileHandle ) import System.Console.Haskeline.Encoding ( decode, encode ) import Foreign.Storable ( peekElemOff, peek )@@ -140,15 +137,6 @@ packStringToUTF8 :: String -> B.ByteString packStringToUTF8 = encodeUtf8 . T.pack --- -------------------------------------------------------------------------------- List-mimicking functions for PackedStrings--{-# INLINE ifHeadThenTail #-}-ifHeadThenTail :: Word8 -> B.ByteString -> Maybe B.ByteString-ifHeadThenTail c s = case uncons s of- Just (w, t) | w == c -> Just t- _ -> Nothing- ------------------------------------------------------------------------ -- A reimplementation of Data.ByteString.Char8.dropSpace, but -- specialised to darcs' need for a 4 way isspace.@@ -528,12 +516,17 @@ end = the_s + l findit n the_s +-- we use a custom Behavior because otherwise on Windows haskeline tries to+-- do hGetEcho on stdin which fails if stdin is e.g. /dev/null+unsafeRunInput :: InputT IO a -> a+unsafeRunInput = unsafePerformIO . runInputTBehavior (useFileHandle stdin) defaultSettings+ -- | Decode a ByteString to a String according to the current locale -- unsafePerformIO in the locale function is ratified by the fact that GHC 6.12 -- and above also supply locale conversion with functions with a pure type. -- Unrecognized byte sequences in the input are skipped. decodeLocale :: B.ByteString -> String-decodeLocale = unsafePerformIO . runInputT defaultSettings . decode+decodeLocale = unsafeRunInput . decode -- | Encode a String to a ByteString with latin1 (i.e., the values of the -- characters become the values of the bytes; if a character value is greater@@ -543,15 +536,11 @@ -- | Encode a String to a ByteString according to the current locale encodeLocale :: String -> B.ByteString-encodeLocale = unsafePerformIO . runInputT defaultSettings . encode+encodeLocale = unsafeRunInput . encode -- | Take a @String@ that represents byte values and re-decode it acording to -- the current locale. decodeString :: String -> String decodeString = decodeLocale . encodeLatin1 --- | Convert a bytestring representing a text from UTF-8 to the current locale-utf8ToLocale :: B.ByteString -> B.ByteString-utf8ToLocale bs = encodeLocale string- where string = unpackPSFromUTF8 bs
src/CommandLine.hs view
@@ -74,15 +74,15 @@ <|> return "" formatRedir :: Parser Bool-formatRedir = do string "%<"+formatRedir = do _ <- string "%<" return True <|> return False -format ftable = do char '%'+format ftable = do _ <- char '%' c <- oneOf (map fst ftable) return $ expandFormat ftable c -escape = do char '\\'+escape = do _ <- char '\\' c <- anyChar return [c]
+ src/Darcs/Annotate.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances #-}++-- Copyright (C) 2010 Petr Rockai+--+-- Permission is hereby granted, free of charge, to any person+-- obtaining a copy of this software and associated documentation+-- files (the "Software"), to deal in the Software without+-- restriction, including without limitation the rights to use, copy,+-- modify, merge, publish, distribute, sublicense, and/or sell copies+-- of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be+-- included in all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+-- BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+-- ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+-- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+-- SOFTWARE.++module Darcs.Annotate ( annotate, annotateDirectory, format, machineFormat ) where+import Darcs.Patch.ApplyMonad( ApplyMonad(..) )+import Data.Maybe( isJust, catMaybes )+import Data.List( nub, groupBy )+import qualified Data.Vector as V+import Darcs.Patch.FileName( FileName, movedirfilename, fn2ps, ps2fn )+import Darcs.Patch.Patchy ( Apply, apply )+import Darcs.Patch.Info ( PatchInfo(..), humanFriendly, piAuthor, makeFilename )+import Darcs.Patch.PatchInfoAnd( info, PatchInfoAnd )+import Lcs( getChanges )+import Printer( renderString )+import Darcs.Witnesses.Ordered+import ByteStringUtils ( linesPS, unlinesPS )+import Control.Monad.State ( modify, when, gets, State, execState )+import Control.Applicative( (<$>) )+import qualified Data.Map as M+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC++#include "gadts.h"+#include "impossible.h"++data FileOrDirectory = File | Directory deriving (Show, Eq)+data Annotated = Annotated { annotated :: V.Vector (Maybe PatchInfo, B.ByteString)+ , current :: [(Int, B.ByteString)]+ , path :: Maybe FileName+ , what :: FileOrDirectory+ , currentInfo :: PatchInfo }+ deriving Show++type AnnotatedM = State Annotated++instance ApplyMonad AnnotatedM where+ mDoesDirectoryExist _ = return True+ mReadFilePS = fail "mReadFilePS undefined for Annotated"+ mCreateDirectory _ = return ()+ mCreateFile _ = return ()+ mRemoveFile f = do p <- gets path+ when (p == Just f) $ modify (\x -> x { path = Nothing })+ updateDirectory f+ mRemoveDirectory = mRemoveFile+ mRename a b =+ do p <- gets path+ w <- gets what+ when (isJust p) $+ modify $ \st -> st { path = Just $ movedirfilename a b (fromJust p) }+ when (w == Directory) $ do+ let fix (i, x) = (i, fn2ps $ movedirfilename a b (ps2fn x))+ modify $ \st -> st { current = map fix $ current st }+ mModifyFilePS f job = do p <- gets path+ when (p == Just f) $ updateFile (fmap linesPS . job . unlinesPS)+ mModifyFilePSs f job = do p <- gets path+ when (p == Just f) $ updateFile job++updateFile :: ([B.ByteString] -> AnnotatedM [B.ByteString]) -> AnnotatedM ()+updateFile job = (==File) <$> gets what >>= flip when go+ where go = do before <- map snd `fmap` gets current+ after <- job before+ reannotate $ getChanges before after+ reannotate [] = return ()+ reannotate ((off, remove, add):rest) = do+ i <- gets currentInfo+ c <- gets current+ a <- gets annotated+ modify $ \s -> s { current = take off c ++ [ (-1, x) | x <- add ] +++ drop (off + length remove) c+ , annotated = merge i a $ take (length remove) $ drop off c }+ reannotate rest+ merge i a l = a V.// [ (line, (Just i, B.empty))+ | (line, _) <- l, line >= 0 && line < V.length a]++updateDirectory :: FileName -> AnnotatedM ()+updateDirectory p = (==Directory) <$> gets what >>= flip when go+ where go = do let line = fn2ps p+ files <- gets current+ case filter ((==line) . snd) files of+ [match@(ident, _)] -> reannotate ident match line+ _ -> return ()+ reannotate ident match line =+ modify $ \x -> x { annotated = annotated x V.// [ (ident, update line $ currentInfo x) ]+ , current = filter (/= match) $ current x }+ update line inf = (Just inf, BC.concat [ " -- created as: ", line ])++complete :: Annotated -> Bool+complete x = V.all (isJust . fst) $ annotated x++annotate' :: (Apply p) =>+ FL (PatchInfoAnd p) C(x y) -> Annotated -> Annotated+annotate' NilFL ann = ann+annotate' (p :>: ps) ann+ | complete ann = ann+ | otherwise = annotate' ps $ execState (apply p) (ann { currentInfo = info p })++annotate :: (Apply p) => FL (PatchInfoAnd p) C(x y) -> FileName -> B.ByteString -> Annotated+annotate patches inipath inicontent = annotate' patches initial+ where initial = Annotated { path = Just inipath+ , currentInfo = error "There is no currentInfo."+ , current = zip [0..] (linesPS inicontent)+ , what = File+ , annotated = V.replicate (length $ breakLines inicontent)+ (Nothing, B.empty) }++annotateDirectory :: (Apply p) => FL (PatchInfoAnd p) C(x y) -> FileName -> [FileName] -> Annotated+annotateDirectory patches inipath inicontent = annotate' patches initial+ where initial = Annotated { path = Just inipath+ , currentInfo = error "There is no currentInfo."+ , current = zip [0..] (map fn2ps inicontent)+ , what = Directory+ , annotated = V.replicate (length inicontent) (Nothing, B.empty) }++machineFormat :: B.ByteString -> Annotated -> String+machineFormat d a = unlines [ case i of+ Just inf -> makeFilename inf+ Nothing -> -- make unknowns uniform, for easier parsing+ "19700101000000-0000-0000000000000000000000000000000000000000.gz"+ ++ " | " ++ BC.unpack line ++ " " ++ BC.unpack add+ | ((i, add), line) <- zip (V.toList $ annotated a) (breakLines d) ]++format :: B.ByteString -> Annotated -> String+format d a = pi_list ++ "\n" ++ file+ where pis = nub $ catMaybes . map fst $ V.toList (annotated a)+ pi_list = unlines $ [ show n ++ ": " ++ renderString (humanFriendly i)+ | (n :: Int, i) <- zip [1..] pis ]+ pi_map = M.fromList (zip pis [1 :: Int ..])+ file_ann = groupBy (\a b -> fst a == fst b) $ zip (V.toList $ annotated a) (breakLines d)+ file = concat [ annotation (fst $ head chunk) ++ " | " ++ line (head chunk) +++ "\n" ++ unlines [ indent 25 (" | " ++ line l) | l <- tail chunk ]+ | chunk <- file_ann ]+ line ((_, add), l) = BC.unpack $ BC.concat [l, " ", add]+ annotation (Just i, _) | Just n <- M.lookup i pi_map =+ pad 20 (piMail i) ++ " " ++ pad 4 ("#" ++ show n)+ annotation _ = pad 25 "unknown"+ pad n str = replicate (n - length str) ' ' ++ (take n str)+ indent n str = replicate n ' ' ++ str+ piMail pi+ | '<' `elem` piAuthor pi = takeWhile (/= '>') . drop 1 . dropWhile (/= '<') $ piAuthor pi+ | otherwise = piAuthor pi++breakLines s = case BC.split '\n' s of+ [] -> []+ split | BC.null (last split) -> init split+ | otherwise -> split+
+ src/Darcs/ArgumentDefaults.hs view
@@ -0,0 +1,79 @@+-- Copyright (C) 2003 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.++module Darcs.ArgumentDefaults ( getDefaultFlags ) where+import Data.Maybe ( listToMaybe, mapMaybe )++import Darcs.Arguments ( DarcsFlag,+ atomicOptions, DarcsAtomicOption( .. ), DarcsOption ( .. ),+ applyDefaults,+ arein )+import Darcs.Commands ( CommandControl( CommandData ),+ commandAlloptions )+import Darcs.Commands.Help ( commandControlList )+import Darcs.Repository.Prefs ( getGlobal, getPreflist )++getDefaultFlags :: String -> [DarcsOption] -> [DarcsFlag] -> IO [DarcsFlag]+getDefaultFlags com com_opts already = do+ repo_defs <- defaultContent $ getPreflist "defaults"+ global_defs <- defaultContent $ getGlobal "defaults"+ let repo_flags = getFlagsFrom com com_opts already repo_defs+ global_flags = getFlagsFrom com com_opts+ (already++repo_flags) global_defs+ return $ applyDefaults com_opts -- hard-coded defaults (respects user preferences)+ $ repo_flags ++ global_flags -- user preferences++getFlagsFrom :: String -> [DarcsOption] -> [DarcsFlag] -> [(String,String,String)] -> [DarcsFlag]+getFlagsFrom com com_opts already defs =+ options_for com_defs com_opts com_opts +++ options_for all_defs com_opts all_opts+ where com_defs = filter (\ (c,_,_) -> c == com) defs+ all_defs = filter (\ (c,_,_) -> c == "ALL") defs+ options_for d o ao = concatMap (findOption o ao already) d+ all_opts = concatMap get_opts commandControlList+ get_opts (CommandData c) = let (o1, o2) = commandAlloptions c+ in o1 ++ o2+ get_opts _ = []++findOption :: [DarcsOption] -> [DarcsOption] -> [DarcsFlag] -> (String,String,String) -> [DarcsFlag]+findOption opts all_opts already (c, f, d) =+ if null $ mapMaybe choose_option all_opts+ then error $ "Bad default option: command '"++c++"' has no option '"++f++"'."+ else concat $ mapMaybe choose_option opts+ where choose_atomic_option (DarcsNoArgOption _ fls o _)+ | f `elem` fls = if null d+ then Just [o]+ else error $ "Bad default option: '"++f+ ++"' takes no argument, but '"++d+ ++"' argument given."+ choose_atomic_option (DarcsArgOption _ fls o _ _)+ | f `elem` fls = if null d+ then error $ "Bad default option: '"++f+ ++"' requires an argument, but no "+ ++"argument given."+ else Just [o d]+ choose_atomic_option _ = Nothing+ choose_option o+ | o `arein` already = Just []+ | otherwise = listToMaybe $ mapMaybe choose_atomic_option $ atomicOptions o++defaultContent :: IO [String] -> IO [(String,String,String)]+defaultContent = fmap (mapMaybe (doline . words))+ where doline (c:a:r) = Just (c, drop_dashdash a, unwords r)+ doline _ = Nothing+ drop_dashdash ('-':'-':a) = a+ drop_dashdash a = a
− src/Darcs/ArgumentDefaults.lhs
@@ -1,172 +0,0 @@-% Copyright (C) 2003 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.--\begin{code}-module Darcs.ArgumentDefaults ( getDefaultFlags ) where-import Data.Maybe ( catMaybes, listToMaybe, mapMaybe )--import Darcs.Arguments ( DarcsFlag,- atomicOptions, DarcsAtomicOption( .. ), DarcsOption ( .. ),- applyDefaults,- arein, isin )-import Darcs.Commands ( CommandControl( CommandData ),- commandAlloptions )-import Darcs.Commands.Help ( commandControlList )-import Darcs.Repository.Prefs ( getGlobal, getPreflist )-\end{code}--\paragraph{defaults}\label{defaults}--Default values for darcs commands can be configured on a per-repository-basis by editing (and possibly creating) the \verb!_darcs/prefs/defaults!-file. Each line of this file has the following form:-\begin{verbatim}-COMMAND FLAG VALUE-\end{verbatim}-where \verb!COMMAND! is either the name of the command to which the default-applies, or \verb!ALL! to indicate that the default applies to all commands-accepting that flag. The \verb!FLAG! term is the name of the long argument-option without the ``\verb!--!'', i.e.\ \verb!verbose! rather than-\verb!--verbose!. Finally, the \verb!VALUE! option can be omitted if the-flag is one such as \verb!verbose! that doesn't involve a value.-If the value has spaces in it, use single quotes, not double quotes, to surround it.-Each line only takes one flag. To set multiple defaults for the same-command (or for \verb!ALL! commands), use multiple lines.--Note that the use of \verb|ALL| easily can have unpredicted consequences,-especially if commands in newer versions of darcs accepts flags that they-didn't in previous versions. A command like \verb|obliterate| could be-devastating with the ``wrong'' flags (for example --all). Only use safe-flags with \verb|ALL|.--\begin{tabular}{ll}-{\tt \verb!~/.darcs/defaults!} & provides defaults for this user account, on MS Windows~\ref{ms_win} \\-{\tt \verb!repo/_darcs/prefs/defaults!} & provides defaults for one project,\\- & overrules changes per user \\-\end{tabular}--For example, if your system clock is bizarre, you could instruct darcs to-always ignore the file modification times by adding the following line to-your \verb!_darcs/prefs/defaults! file. (Note that this would have to be-done for each repository!)-\begin{verbatim}-ALL ignore-times-\end{verbatim}--If you never want to run a test when recording to a particular repository-(but still want to do so when running-\verb'check' on that repository), and like to name-all your patches ``Stupid patch'', you could use the following:-\begin{verbatim}-record no-test-record patch-name Stupid patch-\end{verbatim}--If you would like a command to be run every time patches are recorded-in a particular repository (for example if you have one central-repository, that all developers contribute to), then you can set apply-to always run a command when apply is successful. For example, if you-need to make sure that the files in the repository have the correct-access rights you might use the following. There are two things-to note about using darcs this way:-\begin{itemize}-\item Without the second line you will get errors, because the sub- process that runs apply cannot prompt interactively.-\item Whatever script is run by the post apply command should not be- added to the repository with \verb!darcs add!; doing so would- allow people to modify that file and then run arbitrary scripts on- your main repository, possibly damaging or violating security.-\end{itemize}-\begin{verbatim}-apply posthook chmod -R a+r *-apply run-posthook-\end{verbatim}--Similarly, if you need a command to run automatically before darcs-performs an action you can use a prehook. Using prehooks it could be-possible to canonicalize line endings before recording patches.--There are some options which are meant specifically for use in-\verb!_darcs/prefs/defaults!. One of them is \verb!--disable!. As the name-suggests, this option will disable every command that got it as argument. So,-if you are afraid that you could damage your repositories by inadvertent use of-a command like amend-record, add the following line to-\verb!_darcs/prefs/defaults!:-\begin{verbatim}-amend-record disable-\end{verbatim}--Also, a global preferences file can be created with the name-\verb!.darcs/defaults! in your home directory, on MS Windows~\ref{ms_win}.-Options present there will be added to the repository-specific preferences.-If they conflict with repository-specific options, the repository-specific-ones will take precedence.--\begin{code}-getDefaultFlags :: String -> [DarcsOption] -> [DarcsFlag] -> IO [DarcsFlag]-getDefaultFlags com com_opts already = do- repo_defs <- defaultContent $ getPreflist "defaults"- global_defs <- defaultContent $ getGlobal "defaults"- let repo_flags = getFlagsFrom com com_opts already repo_defs- global_flags = getFlagsFrom com com_opts- (already++repo_flags) global_defs- return $ applyDefaults com_opts -- hard-coded defaults (respects user preferences)- $ repo_flags ++ global_flags -- user preferences--getFlagsFrom :: String -> [DarcsOption] -> [DarcsFlag] -> [(String,String,String)] -> [DarcsFlag]-getFlagsFrom com com_opts already defs =- options_for com_defs com_opts com_opts ++- options_for all_defs com_opts all_opts- where com_defs = filter (\ (c,_,_) -> c == com) defs- all_defs = filter (\ (c,_,_) -> c == "ALL") defs- options_for d o ao = concatMap (findOption o ao already) d- all_opts = concatMap get_opts commandControlList- get_opts (CommandData c) = let (o1, o2) = commandAlloptions c- in o1 ++ o2- get_opts _ = []--findOption :: [DarcsOption] -> [DarcsOption] -> [DarcsFlag] -> (String,String,String) -> [DarcsFlag]-findOption opts all_opts already (c, f, d) =- if null $ mapMaybe choose_option all_opts- then error $ "Bad default option: command '"++c++"' has no option '"++f++"'."- else concat $ mapMaybe choose_option opts- where choose_atomic_option (DarcsNoArgOption _ fls o _)- | f `elem` fls = if null d- then Just [o]- else error $ "Bad default option: '"++f- ++"' takes no argument, but '"++d- ++"' argument given."- choose_atomic_option ao@(DarcsArgOption _ fls o _ _)- | f `elem` fls = if null d- then error $ "Bad default option: '"++f- ++"' requires an argument, but no "- ++"argument given."- else Just [o d]- choose_atomic_option _ = Nothing- choose_option o- | o `arein` already = Just []- | otherwise = listToMaybe $ mapMaybe choose_atomic_option $ atomicOptions o--defaultContent :: IO [String] -> IO [(String,String,String)]-defaultContent = fmap (catMaybes . map (doline.words))- where doline (c:a:r) = Just (c, drop_dashdash a, unwords r)- doline _ = Nothing- drop_dashdash ('-':'-':a) = a- drop_dashdash a = a--\end{code}-
+ src/Darcs/Arguments.hs view
@@ -0,0 +1,1552 @@+-- Copyright (C) 2002-2004 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.++{-# LANGUAGE CPP, PatternGuards #-}++#include "gadts.h"++module Darcs.Arguments ( DarcsFlag( .. ), flagToString, applyDefaults, nubOptions,+ maxCount,+ isin, arein,+ setEnvDarcsPatches, setEnvDarcsFiles,+ fixFilePathOrStd, fixUrl, fixUrlFlag,+ fixSubPaths, maybeFixSubPaths,+ DarcsAtomicOption( .. ), atomicOptions,+ DarcsOption( .. ), optionFromDarcsOption,+ help, listOptions, listFiles,+ anyVerbosity, disable, restrictPaths,+ notest, test, workingRepoDir,+ remoteRepo,+ leaveTestDir,+ possiblyRemoteRepoDir, getRepourl,+ listRegisteredFiles, listUnregisteredFiles,+ author, getAuthor, getEasyAuthor, getSendmailCmd,+ fileHelpAuthor, environmentHelpEmail,+ patchnameOption, distnameOption,+ logfile, rmlogfile, fromOpt, subject, getSubject,+ inReplyTo, getInReplyTo,+ target, ccSend, ccApply, getCc, output, outputAutoName,+ recursive, patchFormatChoices,+ upgradeFormat,+ askdeps, ignoretimes, lookforadds,+ askLongComment, keepDate, sendmailCmd,+ environmentHelpSendmail,+ sign, verify, editDescription,+ reponame, creatorhash,+ applyConflictOptions, reply,+ pullConflictOptions, useExternalMerge,+ depsSel, nocompress,+ uncompressNocompress, repoCombinator,+ optionsLatex, reorderPatches,+ noskipBoring, allowProblematicFilenames,+ applyas, humanReadable,+ changesReverse, onlyToFiles,+ changesFormat, matchOneContext, matchOneNontag,+ matchMaxcount,+ sendToContext,+ getContext,+ pipeInteractive, allInteractive,+ allPipeInteractive,+ summary, unified, tokens,+ partial,+ diffCmdFlag, diffflags, unidiff, xmloutput,+ forceReplace, dryRun, dryRunNoxml,+ printDryRunMessageAndExit, showFriendly,+ matchOne, matchSeveral, matchRange,+ matchSeveralOrRange, happyForwarding,+ matchSeveralOrLast,+ setDefault,+ setScriptsExecutableOption, bisect,+ sibling, flagsToSiblings, relink,+ files, directories, pending,+ posthookCmd, posthookPrompt,+ getPosthookCmd,+ prehookCmd, prehookPrompt,+ getPrehookCmd, nullFlag,+ umaskOption,+ storeInMemory,+ patchSelectFlag,+ networkOptions, noCache,+ allowUnrelatedRepos,+ checkOrRepair, justThisRepo, optimizePristine,+ optimizeHTTP, getOutput, makeScriptsExecutable,+ usePacks, recordRollback+ ) where+import System.Console.GetOpt+import System.Directory ( doesDirectoryExist )++import Storage.Hashed.AnchoredPath( anchorPath )+import Storage.Hashed.Plain( readPlainTree )+import Storage.Hashed.Tree( list, expand, emptyTree )++import Data.List ( (\\), nub, intercalate )+import Data.Maybe ( fromMaybe, listToMaybe, maybeToList, isNothing, catMaybes,+ mapMaybe )+import System.Exit ( ExitCode(ExitSuccess), exitWith )+import Control.Monad ( when, unless )+import Control.Applicative( (<$>) )+import Data.Char ( isDigit )+#ifndef WIN32+import Printer ( renderString )+import System.Posix.Env ( setEnv )+import Darcs.Patch ( listTouchedFiles )+import Progress ( beginTedious, endTedious, tediousSize, finishedOneIO )+#endif++import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info, hopefullyM )+import Darcs.Patch ( RepoPatch, Patchy, showNicely, description, xmlSummary )+import Darcs.Patch.Info ( toXml )+import Darcs.Witnesses.Ordered ( FL, mapFL )+import qualified Darcs.Patch ( summary )+import Darcs.Utils ( askUser, askUserListItem, maybeGetEnv, firstJustIO,+ catchall,+ withCurrentDirectory )+import Darcs.Repository.Prefs ( getPreflist, getGlobal, globalPrefsDirDoc )+import Darcs.Repository.State ( restrictBoring, applyTreeFilter, readRecordedAndPending )+import Darcs.Repository( setScriptsExecutablePatches )+import Darcs.URL ( isFile )+import Darcs.RepoPath ( AbsolutePath, AbsolutePathOrStd, SubPath, toFilePath,+ makeSubPathOf, ioAbsolute, ioAbsoluteOrStd,+ makeAbsolute, makeAbsoluteOrStd )+import Darcs.Patch.MatchData ( patchMatch )+import Darcs.Flags ( DarcsFlag(..), maxCount, defaultFlag )+import Darcs.Repository ( withRepository, RepoJob(..) )+import Darcs.Global ( darcsdir )+import Darcs.Lock ( writeLocaleFile )+import Printer ( Doc, putDocLn, text, vsep, ($$), vcat, insertBeforeLastline,+ prefix )+import ByteStringUtils ( decodeString )+#include "impossible.h"++data FlagContent = NoContent | AbsoluteContent AbsolutePath | AbsoluteOrStdContent AbsolutePathOrStd | StringContent String+ deriving (Eq, Show, Ord)++-- getContent is very tedious to write, but this is the only way (that+-- I know of) to guarantee that it works for all flags (which then+-- guarantees that isAnAbsolute, isa, flagToString, etc also work+-- properly)++-- | 'getContentString' returns the content of a flag, if any.+-- For instance, the content of @Author \"Louis Aragon\"@ is @StringContent+-- \"Louis Aragon\"@, while the content of @Pipe@ is @NoContent@+getContent :: DarcsFlag -> FlagContent+getContent (PatchName s) = StringContent s+getContent (Output s) = AbsoluteOrStdContent s+getContent Verbose = NoContent+getContent Help = NoContent+getContent ListOptions = NoContent+getContent Test = NoContent+getContent NoTest = NoContent+getContent OnlyChangesToFiles = NoContent+getContent ChangesToAllFiles = NoContent+getContent LeaveTestDir = NoContent+getContent NoLeaveTestDir = NoContent+getContent Timings = NoContent+getContent Debug = NoContent+getContent DebugVerbose = NoContent+getContent DebugHTTP = NoContent+getContent NormalVerbosity = NoContent+getContent Quiet = NoContent+getContent (Target s) = StringContent s+getContent (Cc s) = StringContent s+getContent (Subject s) = StringContent s+getContent (InReplyTo s) = StringContent s+getContent (SendmailCmd s) = StringContent s+getContent (Author s) = StringContent s+getContent (OnePatch s) = StringContent s+getContent (SeveralPatch s) = StringContent s+getContent (AfterPatch s) = StringContent s+getContent (UpToPatch s) = StringContent s+getContent (TagName s) = StringContent s+getContent (LastN s) = StringContent (show s)+getContent (MaxCount s) = StringContent (show s)+getContent (OneTag s) = StringContent s+getContent (AfterTag s) = StringContent s+getContent (UpToTag s) = StringContent s+getContent (Context s) = AbsoluteContent s+getContent GenContext = NoContent+getContent (LogFile s) = AbsoluteContent s+getContent (OutputAutoName s) = AbsoluteContent s+getContent NumberPatches = NoContent+getContent (PatchIndexRange _ _) = NoContent -- FIXME this doesn't fit into a neat category+getContent Count = NoContent+getContent All = NoContent+getContent Recursive = NoContent+getContent NoRecursive = NoContent+getContent Reorder = NoContent+getContent RestrictPaths = NoContent+getContent DontRestrictPaths = NoContent+getContent AskDeps = NoContent+getContent NoAskDeps = NoContent+getContent RmLogFile = NoContent+getContent DontRmLogFile = NoContent+getContent (DistName s) = StringContent s+getContent (CreatorHash s) = StringContent s+getContent (SignAs s) = StringContent s+getContent (SignSSL s) = StringContent s+getContent (Verify s) = AbsoluteContent s+getContent (VerifySSL s) = AbsoluteContent s+getContent IgnoreTimes = NoContent+getContent DontIgnoreTimes = NoContent+getContent LookForAdds = NoContent+getContent NoLookForAdds = NoContent+getContent AnyOrder = NoContent+getContent Intersection = NoContent+getContent Unified = NoContent+getContent NonUnified = NoContent+getContent Union = NoContent+getContent Complement = NoContent+getContent Sign = NoContent+getContent NoSign = NoContent+getContent HappyForwarding = NoContent+getContent NoHappyForwarding = NoContent+getContent SSHControlMaster = NoContent+getContent NoSSHControlMaster = NoContent+getContent (RemoteDarcsOpt s) = StringContent s+getContent (Toks s) = StringContent s+getContent (WorkRepoDir s) = StringContent s+getContent (WorkRepoUrl s) = StringContent s+getContent (RemoteRepo s) = StringContent s+getContent (NewRepo s) = StringContent s+getContent (Reply s) = StringContent s+getContent EditDescription = NoContent+getContent NoEditDescription = NoContent+getContent EditLongComment = NoContent+getContent NoEditLongComment = NoContent+getContent PromptLongComment = NoContent+getContent KeepDate = NoContent+getContent NoKeepDate = NoContent+getContent AllowConflicts = NoContent+getContent MarkConflicts = NoContent+getContent NoAllowConflicts = NoContent+getContent SkipConflicts = NoContent+getContent Boring = NoContent+getContent SkipBoring = NoContent+getContent AllowCaseOnly = NoContent+getContent DontAllowCaseOnly = NoContent+getContent AllowWindowsReserved = NoContent+getContent DontAllowWindowsReserved = NoContent+getContent DontGrabDeps = NoContent+getContent DontPromptForDependencies = NoContent+getContent PromptForDependencies = NoContent+getContent Compress = NoContent+getContent NoCompress = NoContent+getContent UnCompress = NoContent+getContent MachineReadable = NoContent+getContent HumanReadable = NoContent+getContent Pipe = NoContent+getContent Interactive = NoContent+getContent Summary = NoContent+getContent NoSummary = NoContent+getContent (ApplyAs s) = StringContent s+getContent (DiffCmd s) = StringContent s+getContent (ExternalMerge s) = StringContent s+getContent (DiffFlags s) = StringContent s+getContent (OnePattern _) = NoContent -- FIXME!!!+getContent (SeveralPattern _) = NoContent -- FIXME!!!+getContent (UpToPattern _) = NoContent -- FIXME!!!+getContent (AfterPattern _) = NoContent -- FIXME!!!+getContent Reverse = NoContent+getContent Forward = NoContent+getContent Complete = NoContent+getContent Lazy = NoContent+getContent (FixFilePath _ _) = NoContent -- FIXME!!!+getContent XMLOutput = NoContent+getContent ForceReplace = NoContent+getContent NonApply = NoContent+getContent NonVerify = NoContent+getContent NonForce = NoContent+getContent DryRun = NoContent+getContent (SetDefault _) = NoContent+getContent (NoSetDefault _) = NoContent+getContent Disable = NoContent+getContent SetScriptsExecutable = NoContent+getContent DontSetScriptsExecutable = NoContent+getContent Bisect = NoContent+getContent UseHashedInventory = NoContent+getContent UseFormat2 = NoContent+getContent NoUpdateWorking = NoContent+getContent UpgradeFormat = NoContent+getContent Relink = NoContent+getContent Files = NoContent+getContent NoFiles = NoContent+getContent Directories = NoContent+getContent NoDirectories = NoContent+getContent Pending = NoContent+getContent NoPending = NoContent+getContent NoPosthook = NoContent+getContent AskPosthook = NoContent+getContent (Sibling s) = AbsoluteContent s+getContent (PosthookCmd s) = StringContent s+getContent RunPosthook = NoContent+getContent NoPrehook = NoContent+getContent RunPrehook = NoContent+getContent AskPrehook = NoContent+getContent StoreInMemory = NoContent+getContent ApplyOnDisk = NoContent+getContent NoHTTPPipelining = NoContent+getContent Packs = NoContent+getContent NoPacks = NoContent+getContent NoCache = NoContent+getContent NullFlag = NoContent+getContent (PrehookCmd s) = StringContent s+getContent (UMask s) = StringContent s+getContent AllowUnrelatedRepos = NoContent+getContent Check = NoContent+getContent Repair = NoContent+getContent JustThisRepo = NoContent+getContent OptimizePristine = NoContent+getContent OptimizeHTTP = NoContent+getContent RecordRollback = NoContent+getContent NoRecordRollback = NoContent++getContentString :: DarcsFlag -> Maybe String+getContentString f =+ do StringContent s <- Just $ getContent f+ return s++-- | @a `'isa'` b@ tests whether @a@ is flag @b@ with a string argument.+-- @b@ typically is a Flag constructor expecting a string+-- For example, @(Author \"Ted Hughes\") `isa` Author@ returns true.+isa :: DarcsFlag -> (String -> DarcsFlag) -> Bool+a `isa` b = case getContentString a of+ Nothing -> False+ Just s -> a == b s++-- | @a `'isAnAbsolute'` b@ tests whether @a@ is flag @b@ with an absolute path argument.+-- @b@ typically is a Flag constructor expecting an absolute path argument+-- For example, @(Context contextfile) `isAnAbsolute` Context@ returns true.+isAnAbsolute :: DarcsFlag -> (AbsolutePath -> DarcsFlag) -> Bool+isAnAbsolute f x = case getContent f of+ AbsoluteContent s -> f == x s+ _ -> False++-- | @a `'isAnAbsoluteOrStd'` b@ tests whether @a@ is flag @b@ with a path argument.+-- @b@ typically is a Flag constructor expecting a path argument+-- For example, @(Output o) `isAnAbsoluteOrStd` @ returns true.+isAnAbsoluteOrStd :: DarcsFlag -> (AbsolutePathOrStd -> DarcsFlag) -> Bool+isAnAbsoluteOrStd f x = case getContent f of+ AbsoluteOrStdContent s -> f == x s+ _ -> False++isin :: DarcsAtomicOption -> [DarcsFlag] -> Bool+(DarcsInternalOption f) `isin` fs = f `elem` fs+(DarcsNoArgOption _ _ f _) `isin` fs = f `elem` fs+(DarcsArgOption _ _ f _ _) `isin` fs = any (`isa` f) fs+(DarcsAbsPathOption _ _ f _ _) `isin` fs = any (`isAnAbsolute` f) fs+(DarcsAbsPathOrStdOption _ _ f _ _) `isin` fs = any (`isAnAbsoluteOrStd` f) fs+(DarcsOptAbsPathOption _ _ _ f _ _) `isin` fs = any (`isAnAbsolute` f) fs++arein :: DarcsOption -> [DarcsFlag] -> Bool+o `arein` fs = any (`isin` fs) (atomicOptions o)++-- | A type for darcs' options. The value contains the command line+-- switch(es) for the option, a help string, and a function to build a+-- @DarcsFlag@ from the command line arguments. for each constructor,+-- 'shortSwitches' represents the list of short command line switches+-- which invoke the option, longSwitches the list of long command line+-- switches, optDescr the description of the option, and argDescr the description+-- of its argument, if any. mkFlag is a function which makes a @DarcsFlag@ from+-- the arguments of the option.+data DarcsAtomicOption+ = DarcsArgOption [Char] [String] (String->DarcsFlag) String String+ -- ^ @DarcsArgOption shortSwitches longSwitches mkFlag ArgDescr OptDescr@+ -- The constructor for options with a string argument, such as+ -- @--tag@++ | DarcsAbsPathOption [Char] [String] (AbsolutePath -> DarcsFlag) String String+ -- ^ @DarcsAbsPathOption shortSwitches longSwitches mkFlag ArgDescr OptDescr@+ -- The constructor for options with an absolute path argument, such as+ -- @--sibling@++ | DarcsAbsPathOrStdOption [Char] [String] (AbsolutePathOrStd -> DarcsFlag) String String+ -- ^ @DarcsAbsPathOrStdOption shortSwitches longSwitches mkFlag ArgDescr OptDescr@+ -- The constructor for options with a path argument, such as @-o@++ | DarcsOptAbsPathOption [Char] [String] String (AbsolutePath -> DarcsFlag) String String+ -- ^ @DarcsOptAbsPathOrStdOption shortSwitches longSwitches defaultPath+ -- mkFlag ArgDescr OptDescr@ where defaultPath is a default value+ -- for the Path, as a string to be parsed as if it had been given+ -- on the command line.+ -- The constructor for options with an optional path argument, such as @-O@++ | DarcsNoArgOption [Char] [String] DarcsFlag String+ -- ^ @DarcsNoArgOption shortSwitches longSwitches mkFlag optDescr@+ -- The constructon fon options with no arguments.++ | DarcsInternalOption DarcsFlag+ -- ^ @DarcsInternalOption@+ -- An option just for internal use (e.g. defaulting), not directly available to the user.+++data DarcsOption+ = DarcsSingleOption DarcsAtomicOption+ | DarcsMultipleChoiceOption [DarcsAtomicOption]+ -- ^ A constructor for grouping related options together, such as+ -- @--hashed@ and @--darcs-2@.++ | DarcsMutuallyExclusive [DarcsAtomicOption] -- choices+ ([DarcsFlag] -> [DarcsFlag]) -- setter++type NoArgPieces = (DarcsFlag -> String -> DarcsAtomicOption, DarcsFlag , String)++mkMutuallyExclusive :: [NoArgPieces] -- ^ before+ -> NoArgPieces -- ^ default+ -> [NoArgPieces] -- ^ after+ -> DarcsOption+mkMutuallyExclusive os1 od_ os2 =+ DarcsMutuallyExclusive (map option (os1 ++ (od : os2)))+ (defaultFlag (map flag (os1 ++ os2)) (flag od))+ where+ od = third (++ " [DEFAULT]") od_+ flag (_,f,_) = f+ option (x,y,z) = x y z+ third f (x,y,z) = (x,y,f z)++nubOptions :: [DarcsOption] -> [DarcsFlag] -> [DarcsFlag]+nubOptions [] opts = opts+nubOptions (DarcsMutuallyExclusive ch _:options) opts = nubOptions options $ collapse opts+ where collapse (x:xs) | x `elem` flags ch = x : clear xs+ | otherwise = x : collapse xs+ collapse [] = []+ clear (x:xs) | x `elem` flags ch = clear xs+ | otherwise = x : clear xs+ clear [] = []+ flags (DarcsNoArgOption _ _ fl _:xs) = fl : flags xs+ flags (DarcsInternalOption fl:xs) = fl : flags xs+ flags (_:xs) = flags xs+ flags [] = []+nubOptions (_:options) opts = nubOptions options opts++applyDefaults :: [DarcsOption] -> [DarcsFlag] -> [DarcsFlag]+applyDefaults opts = foldr (.) id (mapMaybe getSetter opts)+ where+ getSetter (DarcsMutuallyExclusive _ f) = Just f+ getSetter _ = Nothing++optionFromDarcsAtomicOption :: AbsolutePath -> DarcsAtomicOption -> Maybe (OptDescr DarcsFlag)+optionFromDarcsAtomicOption _ (DarcsInternalOption _) = Nothing+optionFromDarcsAtomicOption _ (DarcsNoArgOption a b c h) = Just $ Option a b (NoArg c) h+optionFromDarcsAtomicOption _ (DarcsArgOption a b c n h) = Just $ Option a b (ReqArg c n) h+optionFromDarcsAtomicOption wd (DarcsAbsPathOrStdOption a b c n h) =+ Just $ Option a b (ReqArg (c . makeAbsoluteOrStd wd) n) h+optionFromDarcsAtomicOption wd (DarcsAbsPathOption a b c n h) =+ Just $ Option a b (ReqArg (c . makeAbsolute wd) n) h+optionFromDarcsAtomicOption wd (DarcsOptAbsPathOption a b d c n h) =+ Just $ Option a b (OptArg (c . makeAbsolute wd . fromMaybe d) n) h++atomicOptions :: DarcsOption -> [DarcsAtomicOption]+atomicOptions (DarcsSingleOption x) = [x]+atomicOptions (DarcsMultipleChoiceOption xs) = xs+atomicOptions (DarcsMutuallyExclusive xs _) = xs++optionFromDarcsOption :: AbsolutePath -> DarcsOption -> [OptDescr DarcsFlag]+optionFromDarcsOption wd = mapMaybe (optionFromDarcsAtomicOption wd) . atomicOptions++-- | 'concat_option' creates a DarcsMultipleChoiceOption from a list of+-- option, flattening any DarcsMultipleChoiceOption in the list.+concatOptions :: [DarcsOption] -> DarcsOption+concatOptions = DarcsMultipleChoiceOption . concatMap atomicOptions++extractFixPath :: [DarcsFlag] -> Maybe (AbsolutePath, AbsolutePath)+extractFixPath [] = Nothing+extractFixPath ((FixFilePath repo orig):_) = Just (repo, orig)+extractFixPath (_:fs) = extractFixPath fs++fixFilePath :: [DarcsFlag] -> FilePath -> IO AbsolutePath+fixFilePath opts f = case extractFixPath opts of+ Nothing -> bug "Can't fix path in fixFilePath"+ Just (_,o) -> withCurrentDirectory o $ ioAbsolute f++fixFilePathOrStd :: [DarcsFlag] -> FilePath -> IO AbsolutePathOrStd+fixFilePathOrStd opts f =+ case extractFixPath opts of+ Nothing -> bug "Can't fix path in fixFilePathOrStd"+ Just (_,o) -> withCurrentDirectory o $ ioAbsoluteOrStd f++fixUrlFlag :: [DarcsFlag] -> DarcsFlag -> IO DarcsFlag+fixUrlFlag opts (RemoteRepo f) = RemoteRepo `fmap` fixUrl opts f+fixUrlFlag _ f = return f++fixUrl :: [DarcsFlag] -> String -> IO String+fixUrl opts f = if isFile f+ then toFilePath `fmap` fixFilePath opts f+ else return f++-- | @maybeFixSubPaths files@ tries to turn the file paths in its argument into+-- @SubPath@s.+--+-- When converting a relative path to an absolute one, this function first tries+-- to interpret the relative path with respect to the current working directory.+-- If that fails, it tries to interpret it with respect to the repository+-- directory. Only when that fails does it put a @Nothing@ in the result at the+-- position of the path that cannot be converted.+--+-- It is intended for validating file arguments to darcs commands.+maybeFixSubPaths :: [DarcsFlag] -> [FilePath] -> IO [Maybe SubPath]+maybeFixSubPaths flags fs = withCurrentDirectory o $ do+ fixedFs <- mapM fixit fs+ let bads = snd . unzip . filter (isNothing . fst) $ zip fixedFs fs+ unless (null bads) . putStrLn $ "Ignoring non-repository paths: " +++ intercalate ", " bads+ return fixedFs+ where+ (r,o) = case extractFixPath flags of+ Just xxx -> xxx+ Nothing -> bug "Can't fix path in fixSubPaths"+ fixit p = do ap <- ioAbsolute p+ case makeSubPathOf r ap of+ Just sp -> return $ Just sp+ Nothing -> withCurrentDirectory r $ do+ absolutePathByRepodir <- ioAbsolute p+ return $ makeSubPathOf r absolutePathByRepodir++-- | @fixSubPaths files@ returns the @SubPath@s for the paths in @files@ that+-- are inside the repository, preserving their order. Paths in @files@ that are+-- outside the repository directory are not in the result.+--+-- When converting a relative path to an absolute one, this function first tries+-- to interpret the relative path with respect to the current working directory.+-- If that fails, it tries to interpret it with respect to the repository+-- directory. Only when that fails does it omit the path from the result.+--+-- It is intended for validating file arguments to darcs commands.+fixSubPaths :: [DarcsFlag] -> [FilePath] -> IO [SubPath]+fixSubPaths flags fs = nub . catMaybes <$> (maybeFixSubPaths flags $+ filter (not . null) fs)++-- | 'list_option' is an option which lists the command's arguments+listOptions :: DarcsOption+listOptions = DarcsSingleOption $ DarcsNoArgOption [] ["list-options"] ListOptions+ "simply list the command's arguments"++flagToString :: [DarcsOption] -> DarcsFlag -> Maybe String+flagToString x f = listToMaybe $ mapMaybe f2o $ concatMap atomicOptions x+ where f2o (DarcsArgOption _ (s:_) c _ _) =+ do arg <- getContentString f+ if c arg == f+ then return $ unwords [('-':'-':s), arg]+ else Nothing+ f2o (DarcsNoArgOption _ (s:_) f' _) | f == f' = Just ('-':'-':s)+ f2o _ = Nothing++pipeInteractive, allPipeInteractive, allInteractive,+ humanReadable, diffflags, allowProblematicFilenames, noskipBoring,+ askLongComment, matchOneNontag, changesReverse, creatorhash,+ changesFormat, matchOneContext, happyForwarding, sendToContext,+ diffCmdFlag, storeInMemory, useExternalMerge,+ pullConflictOptions, target, ccSend, ccApply, applyConflictOptions, reply, xmloutput,+ distnameOption, patchnameOption, editDescription,+ output, outputAutoName, unidiff, repoCombinator,+ unified, summary, uncompressNocompress, subject, inReplyTo,+ nocompress, matchSeveralOrRange, matchSeveralOrLast,+ author, askdeps, lookforadds, ignoretimes, test, notest, help, forceReplace,+ allowUnrelatedRepos,+ matchOne, matchRange, matchSeveral, sendmailCmd,+ logfile, rmlogfile, leaveTestDir, fromOpt, recordRollback+ :: DarcsOption++sign, applyas, verify :: DarcsOption++help = DarcsSingleOption $ DarcsNoArgOption ['h'] ["help"] Help+ "shows brief description of command and its arguments"++disable :: DarcsOption+disable = DarcsSingleOption $ DarcsNoArgOption [] ["disable"] Disable+ "disable this command"++anyVerbosity :: [DarcsOption]+anyVerbosity =[DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["debug"] Debug+ "give only debug output",+ DarcsNoArgOption [] ["debug-verbose"] DebugVerbose+ "give debug and verbose output",+ DarcsNoArgOption [] ["debug-http"] DebugHTTP+ "give debug output for libcurl",+ DarcsNoArgOption ['v'] ["verbose"] Verbose+ "give verbose output",+ DarcsNoArgOption ['q'] ["quiet"] Quiet+ "suppress informational output",+ DarcsNoArgOption [] ["standard-verbosity"] NormalVerbosity+ "neither verbose nor quiet output"],+ DarcsSingleOption+ (DarcsNoArgOption [] ["timings"] Timings "provide debugging timings information")]++workingRepoDir :: DarcsOption+workingRepoDir = DarcsSingleOption $ DarcsArgOption [] ["repodir"] WorkRepoDir "DIRECTORY"+ "specify the repository directory in which to run"++possiblyRemoteRepoDir :: DarcsOption+possiblyRemoteRepoDir = DarcsSingleOption $ DarcsArgOption [] ["repo"] WorkRepoUrl "URL"+ "specify the repository URL"++-- | 'getRepourl' takes a list of flags and returns the url of the+-- repository specified by @Repodir \"directory\"@ in that list of flags, if any.+-- This flag is present if darcs was invoked with @--repodir=DIRECTORY@+getRepourl :: [DarcsFlag] -> Maybe String+getRepourl [] = Nothing+getRepourl (WorkRepoUrl d:_) | not (isFile d) = Just d+getRepourl (_:fs) = getRepourl fs++-- | 'remoteRepo' is the option used to specify the URL of the remote+-- repository to work with+remoteRepo :: DarcsOption+remoteRepo = DarcsSingleOption $ DarcsArgOption [] ["remote-repo"] RemoteRepo "URL"+ "specify the remote repository URL to work with"++patchnameOption = DarcsSingleOption $ DarcsArgOption ['m'] ["name"]+ (PatchName . decodeString) "PATCHNAME" "name of patch"++sendToContext = DarcsSingleOption $ DarcsAbsPathOption [] ["context"] Context "FILENAME"+ "send to context stored in FILENAME"++matchOneContext =+ DarcsMultipleChoiceOption+ [DarcsArgOption [] ["to-match"] mp "PATTERN"+ "select changes up to a patch matching PATTERN",+ DarcsArgOption [] ["to-patch"] OnePatch "REGEXP"+ "select changes up to a patch matching REGEXP",+ __tag,+ DarcsAbsPathOption [] ["context"] Context "FILENAME"+ "version specified by the context in FILENAME"+ ]+ where mp s = OnePattern (patchMatch s)++matchOne = DarcsMultipleChoiceOption [__match, __patch, __tag, __index]+ -- [NOTE --index removed from matchOneNontag because issue1926]+ -- The --index option was removed for 2.5 release because it isn't handled+ -- by amend-record (see issue1926).+ --+ -- At this moment, amend-record is the only command that uses 'matchOneNontag',+ -- so there is no other command affected.+matchOneNontag = DarcsMultipleChoiceOption [__match, __patch {- , __index -} ]+matchSeveral = DarcsMultipleChoiceOption [__matches, __patches, __tags]+matchRange = concatOptions $ [ matchTo, matchFrom+ , DarcsMultipleChoiceOption [__match, __patch, __last, __indexes] ]+matchSeveralOrRange = concatOptions [ matchTo, matchFrom+ , DarcsMultipleChoiceOption [ __last, __indexes, __matches, __patches, __tags] ]+matchSeveralOrLast = concatOptions [ matchFrom+ , DarcsMultipleChoiceOption [ __last, __matches, __patches, __tags] ]++matchTo, matchFrom :: DarcsOption+matchTo = DarcsMultipleChoiceOption+ [DarcsArgOption [] ["to-match"] uptop "PATTERN"+ "select changes up to a patch matching PATTERN",+ DarcsArgOption [] ["to-patch"] UpToPatch "REGEXP"+ "select changes up to a patch matching REGEXP",+ DarcsArgOption [] ["to-tag"] UpToTag "REGEXP"+ "select changes up to a tag matching REGEXP"]+ where uptop s = UpToPattern (patchMatch s)+matchFrom = DarcsMultipleChoiceOption+ [DarcsArgOption [] ["from-match"] fromp "PATTERN"+ "select changes starting with a patch matching PATTERN",+ DarcsArgOption [] ["from-patch"] AfterPatch "REGEXP"+ "select changes starting with a patch matching REGEXP",+ DarcsArgOption [] ["from-tag"] AfterTag "REGEXP"+ "select changes starting with a tag matching REGEXP"]+ where fromp s = AfterPattern (patchMatch s)++__tag, __tags, __patch, __patches, __match, __matches, __last, __index, __indexes :: DarcsAtomicOption++__tag = DarcsArgOption ['t'] ["tag"] OneTag "REGEXP"+ "select tag matching REGEXP"+__tags = DarcsArgOption ['t'] ["tags"] OneTag "REGEXP"+ "select tags matching REGEXP"++__patch = DarcsArgOption ['p'] ["patch"] OnePatch "REGEXP"+ "select a single patch matching REGEXP"+__patches = DarcsArgOption ['p'] ["patches"] SeveralPatch "REGEXP"+ "select patches matching REGEXP"++__match = DarcsArgOption [] ["match"] mp "PATTERN"+ "select a single patch matching PATTERN"+ where mp s = OnePattern (patchMatch s)+__matches = DarcsArgOption [] ["matches"] mp "PATTERN"+ "select patches matching PATTERN"+ where mp s = SeveralPattern (patchMatch s)++__last = DarcsArgOption [] ["last"] lastn "NUMBER"+ "select the last NUMBER patches"+ where lastn = LastN . numberString++__index = DarcsArgOption ['n'] ["index"] indexrange "N" "select one patch"+ where indexrange s = if all isDigit s+ then PatchIndexRange (read s) (read s)+ else PatchIndexRange 0 0++__indexes = DarcsArgOption ['n'] ["index"] indexrange "N-M" "select a range of patches"+ where indexrange s = if all isokay s+ then if '-' `elem` s+ then let x1 = takeWhile (/= '-') s+ x2 = reverse $ takeWhile (/= '-') $ reverse s+ in PatchIndexRange (read x1) (read x2)+ else PatchIndexRange (read s) (read s)+ else PatchIndexRange 0 0+ isokay c = isDigit c || c == '-'++matchMaxcount :: DarcsOption+matchMaxcount = DarcsSingleOption $ DarcsArgOption [] ["max-count"] mc "NUMBER"+ "return only NUMBER results"+ where mc = MaxCount . numberString+++-- | 'getContext' takes a list of flags and returns the context+-- specified by @Context c@ in that list of flags, if any.+-- This flag is present if darcs was invoked with @--context=FILE@+getContext :: [DarcsFlag] -> Maybe AbsolutePath+getContext xs = listToMaybe [ c | Context c <- xs ]++notest = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["no-test"] NoTest "don't run the test script",+ DarcsNoArgOption [] ["test"] Test "run the test script"]+test = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["test"] Test "run the test script",+ DarcsNoArgOption [] ["no-test"] NoTest "don't run the test script"]+leaveTestDir = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["leave-test-directory"]+ LeaveTestDir "don't remove the test directory",+ DarcsNoArgOption [] ["remove-test-directory"]+ NoLeaveTestDir "remove the test directory"]++recordRollback = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["record"]+ RecordRollback "record the rollback patch (default)",+ DarcsNoArgOption [] ["no-record"]+ NoRecordRollback "don't record the rollback patch (only roll back in working dir)"]++ignoretimes =+ DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["ignore-times"] IgnoreTimes+ "don't trust the file modification times"+ ,DarcsNoArgOption [] ["no-ignore-times"] DontIgnoreTimes+ "trust modification times to find modified files [DEFAULT]"+ ]++lookforadds =+ DarcsMultipleChoiceOption+ [DarcsNoArgOption ['l'] ["look-for-adds"] LookForAdds+ "look for (non-boring) files that could be added",+ DarcsNoArgOption [] ["dont-look-for-adds","no-look-for-adds"] NoLookForAdds+ "don't look for any files that could be added [DEFAULT]"]++askdeps =+ DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["ask-deps"] AskDeps+ "ask for extra dependencies",+ DarcsNoArgOption [] ["no-ask-deps"] NoAskDeps+ "don't ask for extra dependencies"]++askLongComment =+ DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["edit-long-comment"] EditLongComment+ "edit the long comment by default",+ DarcsNoArgOption [] ["skip-long-comment"] NoEditLongComment+ "don't give a long comment",+ DarcsNoArgOption [] ["prompt-long-comment"] PromptLongComment+ "prompt for whether to edit the long comment"]++keepDate :: DarcsOption+keepDate =+ DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["keep-date"] KeepDate+ "keep the date of the original patch",+ DarcsNoArgOption [] ["no-keep-date"] NoKeepDate+ "use the current date for the amended patch"+ ]++logfile = DarcsSingleOption $ DarcsAbsPathOption [] ["logfile"] LogFile "FILE"+ "give patch name and comment in file"++rmlogfile = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["delete-logfile"] RmLogFile+ "delete the logfile when done",+ DarcsNoArgOption [] ["no-delete-logfile"] DontRmLogFile+ "keep the logfile when done [DEFAULT]"]++author = DarcsSingleOption $+ DarcsArgOption ['A'] ["author"] (Author . decodeString) "EMAIL" "specify author id"+fromOpt = DarcsSingleOption $+ DarcsArgOption [] ["from"] (Author . decodeString) "EMAIL" "specify email address"++fileHelpAuthor :: [String]+fileHelpAuthor = [+ "Each patch is attributed to its author, usually by email address (for",+ "example, `Fred Bloggs <fred@example.net>'). Darcs looks in several",+ "places for this author string: the --author option, the files",+ "_darcs/prefs/author (in the repository) and " ++ globalPrefsDirDoc ++ "author (in your",+ "home directory), and the environment variables $DARCS_EMAIL and",+ "$EMAIL. If none of those exist, Darcs will prompt you for an author",+ "string and write it to _darcs/prefs/author. Note that if if you have more",+ "than one email address, note that you can put them all in " ++ globalPrefsDirDoc ++ "author,",+ "one author per line. Darcs will still prompt you for an author, but it",+ "allow you to select from the list or type in an alternative."+ ]++environmentHelpEmail :: ([String], [String])+environmentHelpEmail = (["DARCS_EMAIL","EMAIL"], fileHelpAuthor)++-- | 'getAuthor' takes a list of flags and returns the author of the+-- change specified by @Author \"Leo Tolstoy\"@ in that list of flags, if any.+-- Otherwise, if @Pipe@ is present, asks the user who is the author and+-- returns the answer. If neither are present, try to guess the author,+-- from @_darcs/prefs@, and if it's not possible, ask the user.+getAuthor :: [DarcsFlag] -> IO String+getAuthor (Author a:_) = return a+getAuthor (Pipe:_) = do askUser "Who is the author? "+getAuthor (_:flags) = getAuthor flags+getAuthor [] = do+ easy_author <- getEasyAuthor+ case easy_author of+ [a] -> return a+ [] -> askForAuthor shortPrompt longPrompt+ as -> askForAuthor (fancyPrompt as) (fancyPrompt as)+ where+ shortPrompt = askUser "What is your email address? "+ longPrompt = askUser "What is your email address (e.g. Fred Bloggs <fred@example.net>)? "+ fancyPrompt xs =+ do putDocLn $ text "" $$+ text "You have saved the following email addresses to your global settings:"+ str <- askUserListItem "Please select an email address for this repository: " (xs ++ ["Other"])+ if str == "Other"+ then longPrompt+ else return str+ askForAuthor askfn1 askfn2 = do+ aminrepo <- doesDirectoryExist (darcsdir++"/prefs")+ if aminrepo then do+ putDocLn $+ text "Each patch is attributed to its author, usually by email address (for" $$+ text "example, `Fred Bloggs <fred@example.net>'). Darcs could not determine" $$+ text "your email address, so you will be prompted for it." $$+ text "" $$+ text ("Your address will be stored in " ++ darcsdir ++ "/prefs/author.") $$+ text "It will be used for all patches recorded in this repository." $$+ text ("If you move that file to " ++ globalPrefsDirDoc ++ "author, it will be used for patches") $$+ text "you record in ALL repositories."+ add <- askfn1+ writeLocaleFile (darcsdir ++ "/prefs/author") $+ unlines ["# " ++ line | line <- fileHelpAuthor] ++ "\n" ++ add+ return add+ else askfn2++-- | 'getEasyAuthor' tries to get the author name first from the repository preferences,+-- then from global preferences, then from environment variables. Returns @[]@+-- if it could not get it. Note that it may only return multiple possibilities when+-- reading from global preferences+getEasyAuthor :: IO [String]+getEasyAuthor = fmap (map decodeString) $+ firstNotNullIO [ (take 1 . nonblank) `fmap` getPreflist "author"+ , nonblank `fmap` getGlobal "author"+ , maybeToList `fmap` maybeGetEnv "DARCS_EMAIL"+ , maybeToList `fmap` maybeGetEnv "EMAIL"+ ]+ where+ nonblank = filter (not . null)+ -- this could perhaps be simplified with Control.Monad+ -- but note that we do NOT want to concatenate the results+ firstNotNullIO [] = return []+ firstNotNullIO (e:es) = do+ v <- e `catchall` return []+ if null v then firstNotNullIO es else return v++nocompress = DarcsMultipleChoiceOption [__compress, __dontCompress]+uncompressNocompress = DarcsMultipleChoiceOption [__compress, __dontCompress, __uncompress]++__compress, __dontCompress, __uncompress :: DarcsAtomicOption+__compress = DarcsNoArgOption [] ["compress"] Compress+ "create compressed patches"+__dontCompress = DarcsNoArgOption [] ["dont-compress","no-compress"] NoCompress+ "don't create compressed patches"+__uncompress = DarcsNoArgOption [] ["uncompress"] UnCompress+ "uncompress patches"++summary = DarcsMultipleChoiceOption+ [DarcsNoArgOption ['s'] ["summary"] Summary "summarize changes",+ DarcsNoArgOption [] ["no-summary"] NoSummary "don't summarize changes"]+unified = DarcsMultipleChoiceOption+ [DarcsNoArgOption ['u'] ["unified"] Unified+ "output patch in a darcs-specific format similar to diff -u",+ DarcsNoArgOption [] ["no-unified"] NonUnified+ "output patch in darcs' usual format"]++unidiff = DarcsMultipleChoiceOption+ [DarcsNoArgOption ['u'] ["unified"] Unified+ "pass -u option to diff [DEFAULT]",+ DarcsNoArgOption [] ["no-unified"] NonUnified+ "output patch in diff's dumb format"]++diffCmdFlag = DarcsSingleOption $+ DarcsArgOption [] ["diff-command"] DiffCmd "COMMAND" "specify diff command (ignores --diff-opts)"++storeInMemory = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["store-in-memory"] StoreInMemory+ "do patch application in memory rather than on disk",+ DarcsNoArgOption [] ["no-store-in-memory"] ApplyOnDisk+ "do patch application on disk [DEFAULT]"]++target = DarcsSingleOption $+ DarcsArgOption [] ["to"] Target "EMAIL" "specify destination email"+ccSend = DarcsSingleOption $+ DarcsArgOption [] ["cc"] Cc "EMAIL" "mail results to additional EMAIL(s)"+ccApply = DarcsSingleOption $+ DarcsArgOption [] ["cc"] Cc "EMAIL" "mail results to additional EMAIL(s). Requires --reply"++-- |'getCc' takes a list of flags and returns the addresses to send a copy of+-- the patch bundle to when using @darcs send@.+-- looks for a cc address specified by @Cc \"address\"@ in that list of flags.+-- Returns the addresses as a comma separated string.+getCc :: [DarcsFlag] -> String+getCc fs = lt $ mapMaybe whatcc fs+ where whatcc (Cc t) = Just t+ whatcc _ = Nothing+ lt [t] = t+ lt [t,""] = t+ lt (t:ts) = t++" , "++lt ts+ lt [] = ""++subject = DarcsSingleOption $ DarcsArgOption [] ["subject"] Subject "SUBJECT" "specify mail subject"++-- |'getSubject' takes a list of flags and returns the subject of the mail+-- to be sent by @darcs send@. Looks for a subject specified by+-- @Subject \"subject\"@ in that list of flags, if any.+-- This flag is present if darcs was invoked with @--subject=SUBJECT@+getSubject :: [DarcsFlag] -> Maybe String+getSubject (Subject s:_) = Just s+getSubject (_:fs) = getSubject fs+getSubject [] = Nothing++inReplyTo = DarcsSingleOption $ DarcsArgOption [] ["in-reply-to"] InReplyTo "EMAIL" "specify in-reply-to header"+getInReplyTo :: [DarcsFlag] -> Maybe String+getInReplyTo (InReplyTo s:_) = Just s+getInReplyTo (_:fs) = getInReplyTo fs+getInReplyTo [] = Nothing++output = DarcsSingleOption $ DarcsAbsPathOrStdOption ['o'] ["output"] Output "FILE"+ "specify output filename"++outputAutoName = DarcsSingleOption $+ DarcsOptAbsPathOption ['O'] ["output-auto-name"] "." OutputAutoName "DIRECTORY"+ "output to automatically named file in DIRECTORY, default: current directory"++getOutput :: [DarcsFlag] -> FilePath -> Maybe AbsolutePathOrStd+getOutput (Output a:_) _ = return a+getOutput (OutputAutoName a:_) f = return $ makeAbsoluteOrStd a f+getOutput (_:flags) f = getOutput flags f+getOutput [] _ = Nothing++editDescription = mkMutuallyExclusive [] yes [no]+ where+ yes = ( DarcsNoArgOption [] ["edit-description"]+ , EditDescription+ , "edit the patch bundle description" )+ no = ( DarcsNoArgOption [] ["dont-edit-description","no-edit-description"]+ , NoEditDescription+ , "don't edit the patch bundle description" )++distnameOption = DarcsSingleOption $+ DarcsArgOption ['d'] ["dist-name"] DistName "DISTNAME" "name of version"++recursive :: String -> DarcsOption+recursive h+ = DarcsMultipleChoiceOption+ [DarcsNoArgOption ['r'] ["recursive"] Recursive h,+ DarcsNoArgOption [] ["not-recursive","no-recursive"] NoRecursive ("don't "++h)]++patchFormatChoices :: DarcsOption+patchFormatChoices =+ DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["hashed"] UseHashedInventory+ "Some new features. Compatible with older repos",+ DarcsNoArgOption [] ["darcs-2"] UseFormat2+ "All features. Related repos must use same format [DEFAULT]."]++upgradeFormat :: DarcsOption+upgradeFormat = DarcsSingleOption $+ DarcsNoArgOption [] ["upgrade"] UpgradeFormat+ "upgrade repository to latest compatible format"++xmloutput = DarcsSingleOption $+ DarcsNoArgOption [] ["xml-output"] XMLOutput "generate XML formatted output"++creatorhash = DarcsSingleOption $+ DarcsArgOption [] ["creator-hash"] CreatorHash "HASH" "specify hash of creator patch (see docs)"++sign = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["sign"] Sign+ "sign the patch with your gpg key",+ DarcsArgOption [] ["sign-as"] SignAs "KEYID"+ "sign the patch with a given keyid",+ DarcsArgOption [] ["sign-ssl"] SignSSL "IDFILE"+ "sign the patch using openssl with a given private key",+ DarcsNoArgOption [] ["dont-sign","no-sign"] NoSign+ "don't sign the patch"]+applyas = DarcsMultipleChoiceOption+ [DarcsArgOption [] ["apply-as"] ApplyAs "USERNAME"+ "apply patch as another user using sudo",+ DarcsNoArgOption [] ["no-apply-as"] NonApply+ "don't use sudo to apply as another user [DEFAULT]"]++happyForwarding = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["happy-forwarding"] HappyForwarding+ "forward unsigned messages without extra header",+ DarcsNoArgOption [] ["no-happy-forwarding"] NoHappyForwarding+ "don't forward unsigned messages without extra header [DEFAULT]"]++setDefault :: Bool -> DarcsOption+setDefault wantYes+ | wantYes = mkMutuallyExclusive [yes,no] defaultyes []+ | otherwise = mkMutuallyExclusive [yes,no] defaultno []+ where+ yes = ( DarcsNoArgOption [] ["set-default"], SetDefault True+ , "set default repository" ++ defaultText wantYes )+ no = ( DarcsNoArgOption [] ["no-set-default"], NoSetDefault True+ , "don't set default repository" ++ defaultText (not wantYes) )+ defaultyes = ( \f _ -> DarcsInternalOption f, SetDefault False, "" )+ defaultno = ( \f _ -> DarcsInternalOption f, NoSetDefault False, "" )+ defaultText True = " [DEFAULT]"+ defaultText False = ""++verify = DarcsMultipleChoiceOption+ [DarcsAbsPathOption [] ["verify"] Verify "PUBRING"+ "verify that the patch was signed by a key in PUBRING",+ DarcsAbsPathOption [] ["verify-ssl"] VerifySSL "KEYS"+ "verify using openSSL with authorized keys from file KEYS",+ DarcsNoArgOption [] ["no-verify"] NonVerify+ "don't verify patch signature"]++reponame :: DarcsOption+reponame = DarcsSingleOption $+ DarcsArgOption [] ["repo-name","repodir"] NewRepo "DIRECTORY"+ "path of output directory" --repodir is there for compatibility+ --should be removed eventually+depsSel :: DarcsOption+depsSel = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["no-deps"] DontGrabDeps+ "don't automatically fulfill dependencies",+ DarcsNoArgOption [] ["dont-prompt-for-dependencies"] DontPromptForDependencies+ "don't ask about patches that are depended on by matched patches (with --match or --patch)",+ DarcsNoArgOption [] ["prompt-for-dependencies"] PromptForDependencies+ "prompt about patches that are depended on by matched patches [DEFAULT]"]++tokens :: DarcsOption+tokens = DarcsSingleOption $+ DarcsArgOption [] ["token-chars"] Toks "\"[CHARS]\""+ "define token to contain these characters"++partial :: DarcsOption+partial = DarcsMultipleChoiceOption [__lazy, __complete]++__lazy, __complete :: DarcsAtomicOption+__lazy = DarcsNoArgOption [] ["lazy"] Lazy+ "get patch files only as needed"+__complete = DarcsNoArgOption [] ["complete"] Complete+ "get a complete copy of the repository"++forceReplace = DarcsMultipleChoiceOption+ [DarcsNoArgOption ['f'] ["force"] ForceReplace+ "proceed with replace even if 'new' token already exists",+ DarcsNoArgOption [] ["no-force"]+ NonForce "don't force the replace if it looks scary"]++reply = DarcsSingleOption $+ DarcsArgOption [] ["reply"] Reply "FROM" "reply to email-based patch using FROM address"+applyConflictOptions+ = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["mark-conflicts"]+ MarkConflicts "mark conflicts",+ DarcsNoArgOption [] ["allow-conflicts"]+ AllowConflicts "allow conflicts, but don't mark them",+ DarcsNoArgOption [] ["no-resolve-conflicts"] NoAllowConflicts+ "equivalent to --dont-allow-conflicts, for backwards compatibility",+ DarcsNoArgOption [] ["dont-allow-conflicts","no-allow-conflicts"]+ NoAllowConflicts "fail if there are patches that would create conflicts [DEFAULT]",+ DarcsNoArgOption [] ["skip-conflicts"]+ SkipConflicts "filter out any patches that would create conflicts"+ ]+pullConflictOptions+ = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["mark-conflicts"]+ MarkConflicts "mark conflicts [DEFAULT]",+ DarcsNoArgOption [] ["allow-conflicts"]+ AllowConflicts "allow conflicts, but don't mark them",+ DarcsNoArgOption [] ["dont-allow-conflicts","no-allow-conflicts"]+ NoAllowConflicts "fail if there patches that would create conflicts",+ DarcsNoArgOption [] ["skip-conflicts"]+ SkipConflicts "filter out any patches that would create conflicts"+ ]+useExternalMerge = DarcsSingleOption $+ DarcsArgOption [] ["external-merge"] ExternalMerge "COMMAND"+ "use external tool to merge conflicts"++-- NOTE: I'd rather work to have no uses of dryRunNoxml, so that any time+-- --dry-run is a possibility, automated users can examine the results more+-- easily with --xml.+dryRunNoxml :: DarcsOption+dryRunNoxml = DarcsSingleOption $+ DarcsNoArgOption [] ["dry-run"] DryRun "don't actually take the action"++dryRun :: [DarcsOption]+dryRun = [dryRunNoxml, xmloutput]++-- | @'showFriendly' flags patch@ returns a 'Doc' representing the right+-- way to show @patch@ given the list @flags@ of flags darcs was invoked with.+showFriendly :: Patchy p => [DarcsFlag] -> p C(x y) -> Doc+showFriendly opts p | Verbose `elem` opts = showNicely p+ | Summary `elem` opts = Darcs.Patch.summary p+ | otherwise = description p++-- | @'printDryRunMessageAndExit' action opts patches@ prints a string+-- representing the action that would be taken if the @--dry-run@ option+-- had not been passed to darcs. Then darcs exits successfully.+-- @action@ is the name of the action being taken, like @\"push\"@+-- @opts@ is the list of flags which were sent to darcs+-- @patches@ is the sequence of patches which would be touched by @action@.+printDryRunMessageAndExit :: RepoPatch p => String -> [DarcsFlag] -> FL (PatchInfoAnd p) C(x y) -> IO ()+printDryRunMessageAndExit action opts patches =+ do when (DryRun `elem` opts) $ do+ putInfo $ text $ "Would " ++ action ++ " the following changes:"+ putDocLn $ put_mode+ putInfo $ text $ ""+ putInfo $ text $ "Making no changes: this is a dry run."+ exitWith ExitSuccess+ when (All `elem` opts && Summary `elem` opts) $ do+ putInfo $ text $ "Will " ++ action ++ " the following changes:"+ putDocLn $ put_mode+ where put_mode = if XMLOutput `elem` opts+ then (text "<patches>" $$+ vcat (mapFL (indent . xml_info) patches) $$+ text "</patches>")+ else (vsep $ mapFL (showFriendly opts) patches)+ putInfo = if XMLOutput `elem` opts then \_ -> return () else putDocLn+ xml_info pl+ | Summary `elem` opts = xml_with_summary pl+ | otherwise = (toXml . info) pl++ xml_with_summary hp+ | Just p <- hopefullyM hp = insertBeforeLastline+ (toXml $ info hp) (indent $ xmlSummary p)+ xml_with_summary hp = toXml (info hp)+ indent = prefix " "+++noskipBoring = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["boring"]+ Boring "don't skip boring files",+ DarcsNoArgOption [] ["no-boring"]+ SkipBoring "skip boring files [DEFAULT]"]++allowProblematicFilenames = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["case-ok"] AllowCaseOnly+ "don't refuse to add files differing only in case"+ ,DarcsNoArgOption [] ["no-case-ok"] DontAllowCaseOnly+ "refuse to add files whose name differ only in case [DEFAULT]"+ ,DarcsNoArgOption [] ["reserved-ok"] AllowWindowsReserved+ "don't refuse to add files with Windows-reserved names"+ ,DarcsNoArgOption [] ["no-reserved-ok"] DontAllowWindowsReserved+ "refuse to add files with Windows-reserved names [DEFAULT]"]++diffflags = DarcsSingleOption $+ DarcsArgOption [] ["diff-opts"]+ DiffFlags "OPTIONS" "options to pass to diff"++changesFormat = concatOptions $+ [DarcsMultipleChoiceOption [+ DarcsNoArgOption [] ["context"]+ GenContext "give output suitable for get --context" ],+ xmloutput,+ humanReadable,+ DarcsMultipleChoiceOption [+ DarcsNoArgOption [] ["number"] NumberPatches "number the changes",+ DarcsNoArgOption [] ["count"] Count "output count of changes" ]+ ]+changesReverse = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["reverse"] Reverse+ "show changes in reverse order"+ ,DarcsNoArgOption [] ["no-reverse"] Forward+ "show changes in the usual order [DEFAULT]"]++onlyToFiles :: DarcsOption+onlyToFiles = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["only-to-files"] OnlyChangesToFiles+ "show only changes to specified files",+ DarcsNoArgOption [] ["no-only-to-files"] ChangesToAllFiles+ "show changes to all files [DEFAULT]"]+++humanReadable = DarcsSingleOption $+ DarcsNoArgOption [] ["human-readable"] HumanReadable "give human-readable output"++pipe :: DarcsAtomicOption+pipe =+ DarcsNoArgOption [] ["pipe"] Pipe "ask user interactively for the patch metadata"++interactive :: DarcsAtomicOption+interactive =+ DarcsNoArgOption ['i'] ["interactive"] Interactive+ "prompt user interactively"++allPatches :: DarcsAtomicOption+allPatches =+ DarcsNoArgOption ['a'] ["all"] All "answer yes to all patches"++allInteractive = DarcsMultipleChoiceOption [allPatches, interactive]++allPipeInteractive+ = DarcsMultipleChoiceOption [allPatches,pipe,interactive]++pipeInteractive =+ DarcsMultipleChoiceOption [pipe, interactive]++repoCombinator =+ DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["intersection"] Intersection+ "take intersection of all repositories",+ DarcsNoArgOption [] ["union"] Union+ "take union of all repositories [DEFAULT]",+ DarcsNoArgOption [] ["complement"] Complement+ "take complement of repositories (in order listed)"]++-- | Get a list of all non-boring files and directories in the working copy.+listFiles :: IO [String]+listFiles = do nonboring <- restrictBoring emptyTree+ working <- expand =<< applyTreeFilter nonboring <$> readPlainTree "."+ return $ map (anchorPath "" . fst) $ list working++-- | 'listUnregisteredFiles' returns the list of all non-boring unregistered+-- files in the repository.+listUnregisteredFiles :: IO [String]+listUnregisteredFiles =+ do unregd <- listFiles+ regd <- listRegisteredFiles+ return $ unregd \\ regd -- (inefficient)++-- | 'listRegisteredFiles' returns the list of all registered files in the repository.+listRegisteredFiles :: IO [String]+listRegisteredFiles =+ do recorded <- expand =<< withRepository [] (RepoJob readRecordedAndPending)+ return $ map (anchorPath "" . fst) $ list recorded++optionsLatex :: [DarcsOption] -> String+optionsLatex opts = "\\begin{tabular}{lll}\n"+++ unlines (map optionListLatex opts)+++ "\\end{tabular}\n"++latexHelp :: String -> String+latexHelp h+ = "\\begin{minipage}{7cm}\n\\raggedright\n" ++ h ++ "\\end{minipage}\n"++optionListLatex :: DarcsOption -> String+optionListLatex (DarcsSingleOption o) = optionLatex o+optionListLatex (DarcsMultipleChoiceOption os) = unlines (map optionLatex os)+optionListLatex (DarcsMutuallyExclusive os _) = unlines (map optionLatex os)++optionLatex :: DarcsAtomicOption -> String+optionLatex (DarcsInternalOption _) = ""+optionLatex (DarcsNoArgOption a b _ h) =+ showShortOptions a ++ showLongOptions b ++ latexHelp h ++ "\\\\"+optionLatex (DarcsArgOption a b _ arg h) =+ showShortOptions a +++ showLongOptions (map (++(" "++arg)) b) ++ latexHelp h ++ "\\\\"+optionLatex (DarcsAbsPathOrStdOption a b _ arg h) =+ showShortOptions a +++ showLongOptions (map (++(" "++arg)) b) ++ latexHelp h ++ "\\\\"+optionLatex (DarcsAbsPathOption a b _ arg h) =+ showShortOptions a +++ showLongOptions (map (++(" "++arg)) b) ++ latexHelp h ++ "\\\\"+optionLatex (DarcsOptAbsPathOption a b _ _ arg h) =+ showShortOptions a +++ showLongOptions (map (++("[="++arg++"]")) b) ++ latexHelp h ++ "\\\\"++showShortOptions :: [Char] -> String+showShortOptions [] = "&"+showShortOptions [c] = "\\verb!-"++[c]++"! &"+showShortOptions (c:cs) = "\\verb!-"++[c]++"!,"++showShortOptions cs++showLongOptions :: [String] -> String+showLongOptions [] = " &"+showLongOptions [s] = "\\verb!--" ++ s ++ "! &"+showLongOptions (s:ss)+ = "\\verb!--" ++ s ++ "!,"++ showLongOptions ss++setScriptsExecutableOption :: DarcsOption+setScriptsExecutableOption = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["set-scripts-executable"] SetScriptsExecutable+ "make scripts executable",+ DarcsNoArgOption [] ["dont-set-scripts-executable","no-set-scripts-executable"] DontSetScriptsExecutable+ "don't make scripts executable"]++bisect :: DarcsOption+bisect = DarcsSingleOption $ DarcsNoArgOption [] ["bisect"] Bisect+ "binary instead of linear search"++relink, sibling :: DarcsOption+relink = DarcsSingleOption $ DarcsNoArgOption [] ["relink"] Relink+ "relink random internal data to a sibling"++sibling = DarcsSingleOption $+ DarcsAbsPathOption [] ["sibling"] Sibling "URL"+ "specify a sibling directory"++-- | 'flagsToSiblings' collects the contents of all @Sibling@ flags in a list of flags.+flagsToSiblings :: [DarcsFlag] -> [AbsolutePath]+flagsToSiblings ((Sibling s) : l) = s : (flagsToSiblings l)+flagsToSiblings (_ : l) = flagsToSiblings l+flagsToSiblings [] = []++reorderPatches :: DarcsOption+reorderPatches = DarcsSingleOption $ DarcsNoArgOption [] ["reorder-patches"] Reorder+ "reorder the patches in the repository"++sendmailCmd = DarcsSingleOption $+ DarcsArgOption [] ["sendmail-command"] SendmailCmd "COMMAND" "specify sendmail command"++environmentHelpSendmail :: ([String], [String])+environmentHelpSendmail = (["SENDMAIL"], [+ "On Unix, the `darcs send' command relies on sendmail(8). The",+ "`--sendmail-command' or $SENDMAIL environment variable can be used to",+ "provide an explicit path to this program; otherwise the standard",+ "locations /usr/sbin/sendmail and /usr/lib/sendmail will be tried."])+-- FIXME: mention the following also:+-- * sendmail(8) is not sendmail-specific;+-- * nowadays, desktops often have no MTA or an unconfigured MTA --+-- which is awful, because it accepts mail but doesn't relay it;+-- * in this case, can be a sendmail(8)-emulating wrapper on top of an+-- MUA that sends mail directly to a smarthost; and+-- * on a multi-user system without an MTA and on which you haven't+-- got root, can be msmtp.++-- |'getSendmailCmd' takes a list of flags and returns the sendmail command+-- to be used by @darcs send@. Looks for a command specified by+-- @SendmailCmd \"command\"@ in that list of flags, if any.+-- This flag is present if darcs was invoked with @--sendmail-command=COMMAND@+-- Alternatively the user can set @$S@@ENDMAIL@ which will be used as a fallback if present.+getSendmailCmd :: [DarcsFlag] -> IO String+getSendmailCmd (SendmailCmd a:_) = return a+getSendmailCmd (_:flags) = getSendmailCmd flags+getSendmailCmd [] = do easy_sendmail <- firstJustIO [ maybeGetEnv "SENDMAIL" ]+ case easy_sendmail of+ Just a -> return a+ Nothing -> return ""++files :: DarcsOption+files = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["files"] Files+ "include files in output [DEFAULT]",+ DarcsNoArgOption [] ["no-files"] NoFiles+ "don't include files in output"]++directories :: DarcsOption+directories = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["directories"] Directories+ "include directories in output [DEFAULT]",+ DarcsNoArgOption [] ["no-directories"] NoDirectories+ "don't include directories in output"]++pending :: DarcsOption+pending = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["pending"] Pending+ "reflect pending patches in output [DEFAULT]",+ DarcsNoArgOption [] ["no-pending"] NoPending+ "only included recorded patches in output"]++nullFlag :: DarcsOption -- "null" is already taken+nullFlag = DarcsSingleOption $ DarcsNoArgOption ['0'] ["null"] NullFlag+ "separate file names by NUL characters"++-- | Set the DARCS_PATCHES and DARCS_PATCHES_XML environment variables+-- with info about the given patches, for use in post-hooks.+setEnvDarcsPatches :: RepoPatch p => FL (PatchInfoAnd p) C(x y) -> IO ()+#ifndef WIN32+setEnvDarcsPatches ps = do+ let k = "Defining set of chosen patches"+ beginTedious k+ tediousSize k 3+ finishedOneIO k "DARCS_PATCHES"+ setEnvCautiously "DARCS_PATCHES" (renderString $ Darcs.Patch.summary ps)+ finishedOneIO k "DARCS_PATCHES_XML"+ setEnvCautiously "DARCS_PATCHES_XML"+ (renderString $ text "<patches>" $$+ vcat (mapFL (toXml . info) ps) $$+ text "</patches>")+ finishedOneIO k "DARCS_FILES"+ setEnvCautiously "DARCS_FILES" (unlines$ listTouchedFiles ps)+ endTedious k++-- | Set some environment variable to the given value, unless said value+-- is longer than 10K characters, in which case do nothing.+setEnvCautiously :: String -> String -> IO ()+setEnvCautiously e v | toobig (10*1024) v = return ()+ | otherwise = setEnv e v True+ where toobig :: Int -> [a] -> Bool+ toobig 0 _ = True+ toobig _ [] = False+ toobig n (_:xs) = toobig (n-1) xs+#else+setEnvDarcsPatches _ = return ()+#endif++-- | Set the DARCS_FILES environment variable to the files touched by the+-- given patch, one per line, for use in post-hooks.+setEnvDarcsFiles :: Patchy p => p C(x y) -> IO ()+#ifndef WIN32+setEnvDarcsFiles ps = setEnvCautiously "DARCS_FILES" (unlines $ listTouchedFiles ps)+#else+setEnvDarcsFiles _ = return ()+#endif++posthookCmd :: DarcsOption+posthookCmd = DarcsMultipleChoiceOption+ [DarcsArgOption [] ["posthook"] PosthookCmd+ "COMMAND" "specify command to run after this darcs command",+ DarcsNoArgOption [] ["no-posthook"] NoPosthook+ "don't run posthook command"]++posthookPrompt :: DarcsOption+posthookPrompt = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["prompt-posthook"] AskPosthook+ "prompt before running posthook [DEFAULT]",+ DarcsNoArgOption [] ["run-posthook"] RunPosthook+ "run posthook command without prompting"]++-- | 'getPosthookCmd' takes a list of flags and returns the posthook command+-- specified by @PosthookCmd a@ in that list of flags, if any.+getPosthookCmd :: [DarcsFlag] -> Maybe String+getPosthookCmd (PosthookCmd a:_) = Just a+getPosthookCmd (_:flags) = getPosthookCmd flags+getPosthookCmd [] = Nothing++prehookCmd :: DarcsOption+prehookCmd = DarcsMultipleChoiceOption+ [DarcsArgOption [] ["prehook"] PrehookCmd+ "COMMAND" "specify command to run before this darcs command",+ DarcsNoArgOption [] ["no-prehook"] NoPrehook+ "don't run prehook command"]++prehookPrompt :: DarcsOption+prehookPrompt = DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["prompt-prehook"] AskPrehook+ "prompt before running prehook [DEFAULT]",+ DarcsNoArgOption [] ["run-prehook"] RunPrehook+ "run prehook command without prompting"]++-- | 'getPrehookCmd' takes a list of flags and returns the prehook command+-- specified by @PrehookCmd a@ in that list of flags, if any.+getPrehookCmd :: [DarcsFlag] -> Maybe String+getPrehookCmd (PrehookCmd a:_) = Just a+getPrehookCmd (_:flags) = getPrehookCmd flags+getPrehookCmd [] = Nothing++networkOptions :: [DarcsOption]+networkOptions =+ [ DarcsMultipleChoiceOption+ [ DarcsNoArgOption [] ["ssh-cm"] SSHControlMaster+ "use SSH ControlMaster feature"+ , DarcsNoArgOption [] ["no-ssh-cm"] NoSSHControlMaster+ "don't use SSH ControlMaster feature [DEFAULT]"+ ]+ , DarcsMultipleChoiceOption+ [ DarcsNoArgOption [] ["no-http-pipelining"] NoHTTPPipelining+ "disable HTTP pipelining"+ ]+ , remoteDarcs ]++remoteDarcs :: DarcsOption+remoteDarcs = DarcsSingleOption $+ DarcsArgOption [] ["remote-darcs"] RemoteDarcsOpt "COMMAND"+ "name of the darcs executable on the remote server"++noCache :: DarcsOption+noCache = DarcsSingleOption $+ DarcsNoArgOption [] ["no-cache"] NoCache+ "don't use patch caches"++optimizePristine :: DarcsOption+optimizePristine = DarcsSingleOption $+ DarcsNoArgOption [] ["pristine"] OptimizePristine+ "optimize hashed pristine layout"++optimizeHTTP :: DarcsOption+optimizeHTTP = DarcsSingleOption $+ DarcsNoArgOption [] ["http"] OptimizeHTTP+ "optimize repository for getting over network"++usePacks :: DarcsOption+usePacks = DarcsMultipleChoiceOption+ [ DarcsNoArgOption [] ["packs"] Packs "use repository packs [DEFAULT]"+ , DarcsNoArgOption [] ["no-packs"] NoPacks+ "don't use repository packs"+ ]++umaskOption :: DarcsOption+umaskOption = DarcsSingleOption $+ DarcsArgOption [] ["umask"] UMask "UMASK"+ "specify umask to use when writing"++restrictPaths :: DarcsOption+restrictPaths =+ DarcsMultipleChoiceOption+ [DarcsNoArgOption [] ["restrict-paths"] RestrictPaths+ "don't allow darcs to touch external files or repo metadata",+ DarcsNoArgOption [] ["dont-restrict-paths","no-restrict-paths"] DontRestrictPaths+ "allow darcs to modify any file or directory (unsafe)"]++allowUnrelatedRepos = DarcsSingleOption $+ DarcsNoArgOption [] ["ignore-unrelated-repos"] AllowUnrelatedRepos+ "do not check if repositories are unrelated"++justThisRepo :: DarcsOption+justThisRepo = DarcsSingleOption $+ DarcsNoArgOption [] ["just-this-repo"] JustThisRepo+ "Limit the check or repair to the current repo"++check, repair, checkOrRepair :: DarcsOption+check = DarcsSingleOption $+ DarcsNoArgOption [] ["check"] Check+ "Specify checking mode"+repair = DarcsSingleOption $+ DarcsNoArgOption [] ["repair"] Repair+ "Specify repair mode"+checkOrRepair = concatOptions [check, repair]++-- | @'patchSelectFlag' f@ holds whenever @f@ is a way of selecting+-- patches such as @PatchName n@.+patchSelectFlag :: DarcsFlag -> Bool+patchSelectFlag All = True+patchSelectFlag (PatchName _) = True+patchSelectFlag (OnePatch _) = True+patchSelectFlag (SeveralPatch _) = True+patchSelectFlag (AfterPatch _) = True+patchSelectFlag (UpToPatch _) = True+patchSelectFlag (TagName _) = True+patchSelectFlag (LastN _) = True+patchSelectFlag (OneTag _) = True+patchSelectFlag (AfterTag _) = True+patchSelectFlag (UpToTag _) = True+patchSelectFlag (OnePattern _) = True+patchSelectFlag (SeveralPattern _) = True+patchSelectFlag (AfterPattern _) = True+patchSelectFlag (UpToPattern _) = True+patchSelectFlag _ = False++-- | The integer corresponding to a string, if it's only composed of digits.+-- Otherwise, -1.+numberString :: String -> Int+numberString "" = -1+numberString s = if all isDigit s then read s else (-1)++makeScriptsExecutable :: Patchy p => [DarcsFlag] -> p C(x y) -> IO ()+makeScriptsExecutable opts p =+ when (SetScriptsExecutable `elem` opts) $ setScriptsExecutablePatches p
− src/Darcs/Arguments.lhs
@@ -1,1833 +0,0 @@-% Copyright (C) 2002-2004 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.--\begin{code}-{-# OPTIONS_GHC -cpp -XPatternGuards #-}-{-# LANGUAGE CPP, PatternGuards #-}--#include "gadts.h"--module Darcs.Arguments ( DarcsFlag( .. ), flagToString, applyDefaults, nubOptions,- maxCount,- isin, arein,- definePatches, defineChanges,- fixFilePathOrStd, fixUrl, fixUrlFlag,- fixSubPaths, areFileArgs,- DarcsAtomicOption( .. ), atomicOptions,- DarcsOption( .. ), optionFromDarcsOption,- help, listOptions, listFiles,- anyVerbosity, disable, restrictPaths,- notest, test, workingRepoDir,- remoteRepo,- leaveTestDir,- possiblyRemoteRepoDir, getRepourl,- listRegisteredFiles, listUnregisteredFiles,- author, getAuthor, getEasyAuthor, getSendmailCmd,- fileHelpAuthor, environmentHelpEmail,- patchnameOption, distnameOption,- logfile, rmlogfile, fromOpt, subject, getSubject,- inReplyTo, getInReplyTo,- target, ccSend, ccApply, getCc, output, outputAutoName,- recursive, inventoryChoices, getInventoryChoices,- upgradeFormat,- askdeps, ignoretimes, lookforadds,- askLongComment, keepDate, sendmailCmd,- environmentHelpSendmail,- sign, verify, editDescription,- reponame, creatorhash,- applyConflictOptions, reply,- pullConflictOptions, useExternalMerge,- depsSel, nocompress,- uncompressNocompress, repoCombinator,- optionsLatex, reorderPatches,- noskipBoring, allowProblematicFilenames,- applyas, humanReadable,- changesReverse, onlyToFiles,- changesFormat, matchOneContext, matchOneNontag,- matchMaxcount,- sendToContext,- getContext,- pipeInteractive, allInteractive,- allPipeInteractive,- summary, unified, tokens,- partial, partialCheck,- diffCmdFlag, diffflags, unidiff, xmloutput,- forceReplace, dryRun, dryRunNoxml,- printDryRunMessageAndExit, showFriendly,- matchOne, matchSeveral, matchRange,- matchSeveralOrRange, happyForwarding,- matchSeveralOrLast,- setDefault,- fancyMoveAdd,- setScriptsExecutableOption, bisect,- sibling, flagsToSiblings, relink, relinkPristine, nolinks,- files, directories, pending,- posthookCmd, posthookPrompt,- getPosthookCmd,- prehookCmd, prehookPrompt,- getPrehookCmd, nullFlag,- umaskOption,- storeInMemory,- patchSelectFlag,- networkOptions, noCache,- allowUnrelatedRepos,- checkOrRepair, justThisRepo, optimizePristine,- optimizeHTTP, getOutput- ) where-import System.Console.GetOpt-import System.Directory ( doesDirectoryExist )--import Storage.Hashed.AnchoredPath( anchorPath )-import Storage.Hashed.Plain( readPlainTree )-import Storage.Hashed.Tree( list, expand, emptyTree )--import Data.List ( (\\), nub )-import Data.Maybe ( fromMaybe, listToMaybe, mapMaybe )-import System.Exit ( ExitCode(ExitSuccess), exitWith )-import Control.Monad ( when, unless )-import Control.Applicative( (<$>) )-import Data.Char ( isDigit )-#ifndef WIN32-import Printer ( renderString )-import System.Posix.Env ( setEnv )-import Darcs.Patch ( listTouchedFiles )-import Progress ( beginTedious, endTedious, tediousSize, finishedOneIO )-#endif--import Darcs.Hopefully ( PatchInfoAnd, info, hopefullyM )-import Darcs.Patch ( RepoPatch, Patchy, showNicely, description, xmlSummary )-import Darcs.Patch.Info ( toXml )-import Darcs.Witnesses.Ordered ( FL, mapFL )-import qualified Darcs.Patch ( summary )-import Darcs.Utils ( askUser, maybeGetEnv, firstNotBlank, firstJustIO,- withCurrentDirectory )-import Darcs.Repository.Prefs ( getPreflist, getGlobal )-import Darcs.Repository.State ( restrictBoring, applyTreeFilter, readRecordedAndPending )-import Darcs.URL ( isFile )-import Darcs.RepoPath ( AbsolutePath, AbsolutePathOrStd, SubPath, toFilePath,- makeSubPathOf, ioAbsolute, ioAbsoluteOrStd,- makeAbsolute, makeAbsoluteOrStd, rootDirectory )-import Darcs.Patch.MatchData ( patchMatch )-import Darcs.Flags ( DarcsFlag(..), maxCount, defaultFlag )-import Darcs.Repository ( withRepository )-import Darcs.Global ( darcsdir )-import Darcs.Lock ( writeLocaleFile )-import Printer ( Doc, putDocLn, text, vsep, ($$), vcat, insertBeforeLastline,- prefix )-import ByteStringUtils ( decodeString )-#include "impossible.h"--data FlagContent = NoContent | AbsoluteContent AbsolutePath | AbsoluteOrStdContent AbsolutePathOrStd | StringContent String- deriving (Eq, Show, Ord)---- getContent is very tedious to write, but this is the only way (that--- I know of) to guarantee that it works for all flags (which then--- guarantees that isAnAbsolute, isa, flagToString, etc also work--- properly)---- | 'getContentString' returns the content of a flag, if any.--- For instance, the content of @Author \"Louis Aragon\"@ is @StringContent--- \"Louis Aragon\"@, while the content of @Pipe@ is @NoContent@-getContent :: DarcsFlag -> FlagContent-getContent (PatchName s) = StringContent s-getContent (Output s) = AbsoluteOrStdContent s-getContent Verbose = NoContent-getContent Help = NoContent-getContent ListOptions = NoContent-getContent Test = NoContent-getContent NoTest = NoContent-getContent OnlyChangesToFiles = NoContent-getContent ChangesToAllFiles = NoContent-getContent LeaveTestDir = NoContent-getContent NoLeaveTestDir = NoContent-getContent Timings = NoContent-getContent Debug = NoContent-getContent DebugVerbose = NoContent-getContent DebugHTTP = NoContent-getContent NormalVerbosity = NoContent-getContent Quiet = NoContent-getContent (Target s) = StringContent s-getContent (Cc s) = StringContent s-getContent (Subject s) = StringContent s-getContent (InReplyTo s) = StringContent s-getContent (SendmailCmd s) = StringContent s-getContent (Author s) = StringContent s-getContent (OnePatch s) = StringContent s-getContent (SeveralPatch s) = StringContent s-getContent (AfterPatch s) = StringContent s-getContent (UpToPatch s) = StringContent s-getContent (TagName s) = StringContent s-getContent (LastN s) = StringContent (show s)-getContent (MaxCount s) = StringContent (show s)-getContent (OneTag s) = StringContent s-getContent (AfterTag s) = StringContent s-getContent (UpToTag s) = StringContent s-getContent (Context s) = AbsoluteContent s-getContent (LogFile s) = AbsoluteContent s-getContent (OutputAutoName s) = AbsoluteContent s-getContent NumberPatches = NoContent-getContent (PatchIndexRange _ _) = NoContent -- FIXME this doesn't fit into a neat category-getContent Count = NoContent-getContent All = NoContent-getContent Recursive = NoContent-getContent NoRecursive = NoContent-getContent Reorder = NoContent-getContent RestrictPaths = NoContent-getContent DontRestrictPaths = NoContent-getContent AskDeps = NoContent-getContent NoAskDeps = NoContent-getContent RmLogFile = NoContent-getContent DontRmLogFile = NoContent-getContent (DistName s) = StringContent s-getContent (CreatorHash s) = StringContent s-getContent (SignAs s) = StringContent s-getContent (SignSSL s) = StringContent s-getContent (Verify s) = AbsoluteContent s-getContent (VerifySSL s) = AbsoluteContent s-getContent IgnoreTimes = NoContent-getContent DontIgnoreTimes = NoContent-getContent LookForAdds = NoContent-getContent NoLookForAdds = NoContent-getContent AnyOrder = NoContent-getContent Intersection = NoContent-getContent Unified = NoContent-getContent NonUnified = NoContent-getContent Union = NoContent-getContent Complement = NoContent-getContent Sign = NoContent-getContent NoSign = NoContent-getContent HappyForwarding = NoContent-getContent NoHappyForwarding = NoContent-getContent SSHControlMaster = NoContent-getContent NoSSHControlMaster = NoContent-getContent (RemoteDarcs s) = StringContent s-getContent (Toks s) = StringContent s-getContent (WorkRepoDir s) = StringContent s-getContent (WorkRepoUrl s) = StringContent s-getContent (RemoteRepo s) = StringContent s-getContent (NewRepo s) = StringContent s-getContent (Reply s) = StringContent s-getContent EditDescription = NoContent-getContent NoEditDescription = NoContent-getContent EditLongComment = NoContent-getContent NoEditLongComment = NoContent-getContent PromptLongComment = NoContent-getContent KeepDate = NoContent-getContent NoKeepDate = NoContent-getContent AllowConflicts = NoContent-getContent MarkConflicts = NoContent-getContent NoAllowConflicts = NoContent-getContent SkipConflicts = NoContent-getContent Boring = NoContent-getContent SkipBoring = NoContent-getContent AllowCaseOnly = NoContent-getContent DontAllowCaseOnly = NoContent-getContent AllowWindowsReserved = NoContent-getContent DontAllowWindowsReserved = NoContent-getContent DontGrabDeps = NoContent-getContent DontPromptForDependencies = NoContent-getContent PromptForDependencies = NoContent-getContent Compress = NoContent-getContent NoCompress = NoContent-getContent UnCompress = NoContent-getContent MachineReadable = NoContent-getContent HumanReadable = NoContent-getContent Pipe = NoContent-getContent Interactive = NoContent-getContent Summary = NoContent-getContent NoSummary = NoContent-getContent (ApplyAs s) = StringContent s-getContent (DiffCmd s) = StringContent s-getContent (ExternalMerge s) = StringContent s-getContent (DiffFlags s) = StringContent s-getContent (OnePattern _) = NoContent -- FIXME!!!-getContent (SeveralPattern _) = NoContent -- FIXME!!!-getContent (UpToPattern _) = NoContent -- FIXME!!!-getContent (AfterPattern _) = NoContent -- FIXME!!!-getContent Reverse = NoContent-getContent Forward = NoContent-getContent Partial = NoContent-getContent Complete = NoContent-getContent Lazy = NoContent-getContent Ephemeral = NoContent-getContent (FixFilePath _ _) = NoContent -- FIXME!!!-getContent XMLOutput = NoContent-getContent ForceReplace = NoContent-getContent NonApply = NoContent-getContent NonVerify = NoContent-getContent NonForce = NoContent-getContent DryRun = NoContent-getContent SetDefault = NoContent-getContent NoSetDefault = NoContent-getContent FancyMoveAdd = NoContent-getContent NoFancyMoveAdd = NoContent-getContent Disable = NoContent-getContent SetScriptsExecutable = NoContent-getContent DontSetScriptsExecutable = NoContent-getContent Bisect = NoContent-getContent UseHashedInventory = NoContent-getContent UseOldFashionedInventory = NoContent-getContent UseFormat2 = NoContent-getContent PristinePlain = NoContent-getContent PristineNone = NoContent-getContent NoUpdateWorking = NoContent-getContent UpgradeFormat = NoContent-getContent Relink = NoContent-getContent RelinkPristine = NoContent-getContent NoLinks = NoContent-getContent Files = NoContent-getContent NoFiles = NoContent-getContent Directories = NoContent-getContent NoDirectories = NoContent-getContent Pending = NoContent-getContent NoPending = NoContent-getContent NoPosthook = NoContent-getContent AskPosthook = NoContent-getContent (Sibling s) = AbsoluteContent s-getContent (PosthookCmd s) = StringContent s-getContent RunPosthook = NoContent-getContent NoPrehook = NoContent-getContent RunPrehook = NoContent-getContent AskPrehook = NoContent-getContent StoreInMemory = NoContent-getContent ApplyOnDisk = NoContent-getContent NoHTTPPipelining = NoContent-getContent NoCache = NoContent-getContent NullFlag = NoContent-getContent (PrehookCmd s) = StringContent s-getContent (UMask s) = StringContent s-getContent AllowUnrelatedRepos = NoContent-getContent Check = NoContent-getContent Repair = NoContent-getContent JustThisRepo = NoContent-getContent OptimizePristine = NoContent-getContent OptimizeHTTP = NoContent--getContentString :: DarcsFlag -> Maybe String-getContentString f =- do StringContent s <- Just $ getContent f- return s---- | @a `'isa'` b@ tests whether @a@ is flag @b@ with a string argument.--- @b@ typically is a Flag constructor expecting a string--- For example, @(Author \"Ted Hughes\") `isa` Author@ returns true.-isa :: DarcsFlag -> (String -> DarcsFlag) -> Bool-a `isa` b = case getContentString a of- Nothing -> False- Just s -> a == b s---- | @a `'isAnAbsolute'` b@ tests whether @a@ is flag @b@ with an absolute path argument.--- @b@ typically is a Flag constructor expecting an absolute path argument--- For example, @(Context contextfile) `isAnAbsolute` Context@ returns true.-isAnAbsolute :: DarcsFlag -> (AbsolutePath -> DarcsFlag) -> Bool-isAnAbsolute f x = case getContent f of- AbsoluteContent s -> f == x s- _ -> False---- | @a `'isAnAbsoluteOrStd'` b@ tests whether @a@ is flag @b@ with a path argument.--- @b@ typically is a Flag constructor expecting a path argument--- For example, @(Output o) `isAnAbsoluteOrStd` @ returns true.-isAnAbsoluteOrStd :: DarcsFlag -> (AbsolutePathOrStd -> DarcsFlag) -> Bool-isAnAbsoluteOrStd f x = case getContent f of- AbsoluteOrStdContent s -> f == x s- _ -> False--isin :: DarcsAtomicOption -> [DarcsFlag] -> Bool-(DarcsNoArgOption _ _ f _) `isin` fs = f `elem` fs-(DarcsArgOption _ _ f _ _) `isin` fs = any (`isa` f) fs-(DarcsAbsPathOption _ _ f _ _) `isin` fs = any (`isAnAbsolute` f) fs-(DarcsAbsPathOrStdOption _ _ f _ _) `isin` fs = any (`isAnAbsoluteOrStd` f) fs-(DarcsOptAbsPathOption _ _ _ f _ _) `isin` fs = any (`isAnAbsolute` f) fs--arein :: DarcsOption -> [DarcsFlag] -> Bool-o `arein` fs = any (`isin` fs) (atomicOptions o)---- | A type for darcs' options. The value contains the command line--- switch(es) for the option, a help string, and a function to build a--- @DarcsFlag@ from the command line arguments. for each constructor,--- 'shortSwitches' represents the list of short command line switches--- which invoke the option, longSwitches the list of long command line--- switches, optDescr the description of the option, and argDescr the description--- of its argument, if any. mkFlag is a function which makes a @DarcsFlag@ from--- the arguments of the option.-data DarcsAtomicOption- = DarcsArgOption [Char] [String] (String->DarcsFlag) String String- -- ^ @DarcsArgOption shortSwitches longSwitches mkFlag ArgDescr OptDescr@- -- The constructor for options with a string argument, such as- -- @--tag@-- | DarcsAbsPathOption [Char] [String] (AbsolutePath -> DarcsFlag) String String- -- ^ @DarcsAbsPathOption shortSwitches longSwitches mkFlag ArgDescr OptDescr@- -- The constructor for options with an absolute path argument, such as- -- @--sibling@-- | DarcsAbsPathOrStdOption [Char] [String] (AbsolutePathOrStd -> DarcsFlag) String String- -- ^ @DarcsAbsPathOrStdOption shortSwitches longSwitches mkFlag ArgDescr OptDescr@- -- The constructor for options with a path argument, such as @-o@-- | DarcsOptAbsPathOption [Char] [String] String (AbsolutePath -> DarcsFlag) String String- -- ^ @DarcsOptAbsPathOrStdOption shortSwitches longSwitches defaultPath- -- mkFlag ArgDescr OptDescr@ where defaultPath is a default value- -- for the Path, as a string to be parsed as if it had been given- -- on the command line.- -- The constructor for options with an optional path argument, such as @-O@-- | DarcsNoArgOption [Char] [String] DarcsFlag String- -- ^ @DarcsNoArgOption shortSwitches longSwitches mkFlag optDescr@- -- The constructon fon options with no arguments.--data DarcsOption- = DarcsSingleOption DarcsAtomicOption- | DarcsMultipleChoiceOption [DarcsAtomicOption]- -- ^ A constructor for grouping related options together, such as- -- @--hashed@, @--darcs-2@ and @--old-fashioned-inventory@.-- | DarcsMutuallyExclusive [DarcsAtomicOption] -- choices- ([DarcsFlag] -> [DarcsFlag]) -- setter--type NoArgPieces = (DarcsFlag -> String -> DarcsAtomicOption, DarcsFlag , String)--mkMutuallyExclusive :: [NoArgPieces] -- ^ before- -> NoArgPieces -- ^ default- -> [NoArgPieces] -- ^ after- -> DarcsOption-mkMutuallyExclusive os1 od_ os2 =- DarcsMutuallyExclusive (map option (os1 ++ (od : os2)))- (defaultFlag (map flag (os1 ++ os2)) (flag od))- where- od = third (++ " [DEFAULT]") od_- flag (_,f,_) = f- option (x,y,z) = x y z- third f (x,y,z) = (x,y,f z)--nubOptions [] opts = opts-nubOptions (DarcsMutuallyExclusive ch _:options) opts = nubOptions options $ collapse opts- where collapse (x:xs) | x `elem` flags ch = x : clear xs- | otherwise = x : collapse xs- collapse [] = []- clear (x:xs) | x `elem` flags ch = clear xs- | otherwise = x : clear xs- clear [] = []- flags (DarcsNoArgOption _ _ fl _:xs) = fl : flags xs- flags (_:xs) = flags xs- flags [] = []-nubOptions (_:options) opts = nubOptions options opts--applyDefaults :: [DarcsOption] -> [DarcsFlag] -> [DarcsFlag]-applyDefaults opts = foldr (.) id (mapMaybe getSetter opts)- where- getSetter (DarcsMutuallyExclusive _ f) = Just f- getSetter _ = Nothing--optionFromDarcsAtomicOption :: AbsolutePath -> DarcsAtomicOption -> OptDescr DarcsFlag-optionFromDarcsAtomicOption _ (DarcsNoArgOption a b c h) = Option a b (NoArg c) h-optionFromDarcsAtomicOption _ (DarcsArgOption a b c n h) = Option a b (ReqArg c n) h-optionFromDarcsAtomicOption wd (DarcsAbsPathOrStdOption a b c n h) =- Option a b (ReqArg (c . makeAbsoluteOrStd wd) n) h-optionFromDarcsAtomicOption wd (DarcsAbsPathOption a b c n h) =- Option a b (ReqArg (c . makeAbsolute wd) n) h-optionFromDarcsAtomicOption wd (DarcsOptAbsPathOption a b d c n h) =- Option a b (OptArg (c . makeAbsolute wd . fromMaybe d) n) h--atomicOptions :: DarcsOption -> [DarcsAtomicOption]-atomicOptions (DarcsSingleOption x) = [x]-atomicOptions (DarcsMultipleChoiceOption xs) = xs-atomicOptions (DarcsMutuallyExclusive xs _) = xs--optionFromDarcsOption :: AbsolutePath -> DarcsOption -> [OptDescr DarcsFlag]-optionFromDarcsOption wd = map (optionFromDarcsAtomicOption wd) . atomicOptions---- | 'concat_option' creates a DarcsMultipleChoiceOption from a list of--- option, flattening any DarcsMultipleChoiceOption in the list.-concatOptions :: [DarcsOption] -> DarcsOption-concatOptions = DarcsMultipleChoiceOption . concatMap atomicOptions--extractFixPath :: [DarcsFlag] -> Maybe (AbsolutePath, AbsolutePath)-extractFixPath [] = Nothing-extractFixPath ((FixFilePath repo orig):_) = Just (repo, orig)-extractFixPath (_:fs) = extractFixPath fs--fixFilePath :: [DarcsFlag] -> FilePath -> IO AbsolutePath-fixFilePath opts f = case extractFixPath opts of- Nothing -> bug "Can't fix path in fixFilePath"- Just (_,o) -> withCurrentDirectory o $ ioAbsolute f--fixFilePathOrStd :: [DarcsFlag] -> FilePath -> IO AbsolutePathOrStd-fixFilePathOrStd opts f =- case extractFixPath opts of- Nothing -> bug "Can't fix path in fixFilePathOrStd"- Just (_,o) -> withCurrentDirectory o $ ioAbsoluteOrStd f--fixUrlFlag :: [DarcsFlag] -> DarcsFlag -> IO DarcsFlag-fixUrlFlag opts (RemoteRepo f) = RemoteRepo `fmap` fixUrl opts f-fixUrlFlag _ f = return f--fixUrl :: [DarcsFlag] -> String -> IO String-fixUrl opts f = if isFile f- then toFilePath `fmap` fixFilePath opts f- else return f---- | @fixSubPaths files@ returns the @SubPath@s for the paths in @files@ that--- are inside the repository, preserving their order. Paths in @files@ that are--- outside the repository directory are not in the result.------ When converting a relative path to an absolute one, this function first tries--- to interpret the relative path with respect to the current working directory.--- If that fails, it tries to interpret it with respect to the repository--- directory. Only when that fails does it omit the path from the result.------ It is intended for validating file arguments to darcs commands.-fixSubPaths :: [DarcsFlag] -> [FilePath] -> IO [SubPath]-fixSubPaths flags fs =- withCurrentDirectory o $- do fixedfs <- mapM fixit $ filter (not.null) fs- let (good, bad) = partitionEither fixedfs- unless (null bad) $- putStrLn $ "Ignoring non-repository paths: " ++ unwords bad- return $ nub good- where- (r,o) = case extractFixPath flags of- Just xxx -> xxx- Nothing -> bug "Can't fix path in fixSubPaths"- fixit p = do ap <- ioAbsolute p- case makeSubPathOf r ap of- Just sp -> return $ Right sp- Nothing -> withCurrentDirectory r $ do- absolutePathByRepodir <- ioAbsolute p- return $ case makeSubPathOf r absolutePathByRepodir of- Just sp -> Right sp- Nothing -> Left p--partitionEither :: [Either a b] -> ([b],[a])-partitionEither es = ( [b | Right b <- es]- , [a | Left a <- es] )---- as opposed to just '.'-areFileArgs :: [SubPath] -> Bool-areFileArgs rps = concatMap toFilePath rps /= ""---- | 'list_option' is an option which lists the command's arguments-listOptions :: DarcsOption-listOptions = DarcsSingleOption $ DarcsNoArgOption [] ["list-options"] ListOptions- "simply list the command's arguments"--flagToString :: [DarcsOption] -> DarcsFlag -> Maybe String-flagToString x f = listToMaybe $ mapMaybe f2o $ concatMap atomicOptions x- where f2o (DarcsArgOption _ (s:_) c _ _) =- do arg <- getContentString f- if c arg == f- then return $ unwords [('-':'-':s), arg]- else Nothing- f2o (DarcsNoArgOption _ (s:_) f' _) | f == f' = Just ('-':'-':s)- f2o _ = Nothing--pipeInteractive, allPipeInteractive, allInteractive,- humanReadable, diffflags, allowProblematicFilenames, noskipBoring,- askLongComment, matchOneNontag, changesReverse, creatorhash,- changesFormat, matchOneContext, happyForwarding, sendToContext,- diffCmdFlag, storeInMemory, useExternalMerge,- pullConflictOptions, target, ccSend, ccApply, applyConflictOptions, reply, xmloutput,- distnameOption, patchnameOption, editDescription,- output, outputAutoName, unidiff, repoCombinator,- unified, summary, uncompressNocompress, subject, inReplyTo,- nocompress, matchSeveralOrRange, matchSeveralOrLast,- author, askdeps, lookforadds, ignoretimes, test, notest, help, forceReplace,- allowUnrelatedRepos,- matchOne, matchRange, matchSeveral, fancyMoveAdd, sendmailCmd,- logfile, rmlogfile, leaveTestDir, fromOpt-- :: DarcsOption--sign, applyas, verify :: DarcsOption-\end{code}--\section{Common options to darcs commands}--\begin{options}---help-\end{options}-Every \verb|COMMAND| accepts \verb!--help! as an argument, which tells it to-provide a bit of help. Among other things, this help always provides an-accurate listing of the options available with that command, and is-guaranteed never to be out of sync with the version of darcs you actually-have installed (unlike this manual, which could be for an entirely-different version of darcs).-\begin{verbatim}-% darcs COMMAND --help-\end{verbatim}-\begin{code}-help = DarcsSingleOption $ DarcsNoArgOption ['h'] ["help"] Help- "shows brief description of command and its arguments"-\end{code}--\begin{options}---disable-\end{options}-Every {\tt COMMAND} accepts the \verb!--disable! option, which can be used in-\verb!_darcs/prefs/defaults! to disable some commands in the repository. This-can be helpful if you want to protect the repository from accidental use of-advanced commands like obliterate, unpull, unrecord or amend-record.-\begin{code}-disable :: DarcsOption-disable = DarcsSingleOption $ DarcsNoArgOption [] ["disable"] Disable- "disable this command"-\end{code}--\begin{options}---verbose, --quiet, --normal-verbosity-\end{options}-Most commands also accept the \verb!--verbose! option, which tells darcs to-provide additional output. The amount of verbosity varies from command to-command. Commands that accept \verb!--verbose! also accept \verb!--quiet!,-which surpresses non-error output, and \verb!--normal-verbosity! which can be-used to restore the default verbosity if \verb!--verbose! or \verb!--quiet! is in-the defaults file.--\begin{options}---debug, --debug-http-\end{options}-Many commands also accept the \verb!--debug! option, which causes darcs to generate-additional output that may be useful for debugging its behavior, but which otherwise-would not be interesting. Option \verb!--debug-http! makes darcs output debugging-info for libcurl.-\begin{code}-anyVerbosity :: [DarcsOption]-anyVerbosity =[DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["debug"] Debug- "give only debug output",- DarcsNoArgOption [] ["debug-verbose"] DebugVerbose- "give debug and verbose output",- DarcsNoArgOption [] ["debug-http"] DebugHTTP- "give debug output for libcurl",- DarcsNoArgOption ['v'] ["verbose"] Verbose- "give verbose output",- DarcsNoArgOption ['q'] ["quiet"] Quiet- "suppress informational output",- DarcsNoArgOption [] ["standard-verbosity"] NormalVerbosity- "neither verbose nor quiet output"],- DarcsSingleOption- (DarcsNoArgOption [] ["timings"] Timings "provide debugging timings information")]-\end{code}--\begin{options}---repodir-\end{options}-Another common option is the \verb!--repodir! option, which allows you to-specify the directory of the repository in which to perform the command.-This option is used with commands, such as whatsnew, that ordinarily would-be performed within a repository directory, and allows you to use those-commands without actually being in the repository directory when calling the-command. This is useful when running darcs in a pipe, as might be the case-when running \verb'apply' from a mailer.--\begin{code}-workingRepoDir :: DarcsOption-workingRepoDir = DarcsSingleOption $ DarcsArgOption [] ["repodir"] WorkRepoDir "DIRECTORY"- "specify the repository directory in which to run"--possiblyRemoteRepoDir :: DarcsOption-possiblyRemoteRepoDir = DarcsSingleOption $ DarcsArgOption [] ["repo"] WorkRepoUrl "URL"- "specify the repository URL"---- | 'getRepourl' takes a list of flags and returns the url of the--- repository specified by @Repodir \"directory\"@ in that list of flags, if any.--- This flag is present if darcs was invoked with @--repodir=DIRECTORY@-getRepourl :: [DarcsFlag] -> Maybe String-getRepourl [] = Nothing-getRepourl (WorkRepoUrl d:_) | not (isFile d) = Just d-getRepourl (_:fs) = getRepourl fs-\end{code}--\begin{options}---remote-repo-\end{options}--Some commands, such as \verb'pull' require a remote repository to be specified,-either from the command line or as a default. The \verb!--remote-repo!-provides an alternative way to supply this remote repository path. This flag-can be seen as temporarily ``replacing'' the default repository. Setting it-causes the command to ignore the default repository (it also does not affect,-i.e. overwrite the default repository). On the other hand, if any other-repositories are supplied as command line arguments, this flag will be ignored-(and the default repository may be overwritten).--\begin{code}--- | 'remoteRepo' is the option used to specify the URL of the remote--- repository to work with-remoteRepo :: DarcsOption-remoteRepo = DarcsSingleOption $ DarcsArgOption [] ["remote-repo"] RemoteRepo "URL"- "specify the remote repository URL to work with"-\end{code}--\input{Darcs/Match.lhs}-\input{Darcs/Patch/Match.lhs}--\begin{code}-patchnameOption = DarcsSingleOption $ DarcsArgOption ['m'] ["patch-name"]- (PatchName . decodeString) "PATCHNAME" "name of patch"--sendToContext = DarcsSingleOption $ DarcsAbsPathOption [] ["context"] Context "FILENAME"- "send to context stored in FILENAME"--matchOneContext =- DarcsMultipleChoiceOption- [DarcsArgOption [] ["to-match"] mp "PATTERN"- "select changes up to a patch matching PATTERN",- DarcsArgOption [] ["to-patch"] OnePatch "REGEXP"- "select changes up to a patch matching REGEXP",- __tag,- DarcsAbsPathOption [] ["context"] Context "FILENAME"- "version specified by the context in FILENAME"- ]- where mp s = OnePattern (patchMatch s)--matchOne = DarcsMultipleChoiceOption [__match, __patch, __tag, __index]- -- [NOTE --index removed from matchOneNontag because issue1926]- -- The --index option was removed for 2.5 release because it isn't handled- -- by amend-record (see issue1926).- --- -- At this moment, amend-record is the only command that uses 'matchOneNontag',- -- so there is no other command affected.-matchOneNontag = DarcsMultipleChoiceOption [__match, __patch {- , __index -} ]-matchSeveral = DarcsMultipleChoiceOption [__matches, __patches, __tags]-matchRange = concatOptions $ [ matchTo, matchFrom- , DarcsMultipleChoiceOption [__match, __patch, __last, __indexes] ]-matchSeveralOrRange = concatOptions [ matchTo, matchFrom- , DarcsMultipleChoiceOption [ __last, __indexes, __matches, __patches, __tags] ]-matchSeveralOrLast = concatOptions [ matchFrom- , DarcsMultipleChoiceOption [ __last, __matches, __patches, __tags] ]--matchTo, matchFrom :: DarcsOption-matchTo = DarcsMultipleChoiceOption- [DarcsArgOption [] ["to-match"] uptop "PATTERN"- "select changes up to a patch matching PATTERN",- DarcsArgOption [] ["to-patch"] UpToPatch "REGEXP"- "select changes up to a patch matching REGEXP",- DarcsArgOption [] ["to-tag"] UpToTag "REGEXP"- "select changes up to a tag matching REGEXP"]- where uptop s = UpToPattern (patchMatch s)-matchFrom = DarcsMultipleChoiceOption- [DarcsArgOption [] ["from-match"] fromp "PATTERN"- "select changes starting with a patch matching PATTERN",- DarcsArgOption [] ["from-patch"] AfterPatch "REGEXP"- "select changes starting with a patch matching REGEXP",- DarcsArgOption [] ["from-tag"] AfterTag "REGEXP"- "select changes starting with a tag matching REGEXP"]- where fromp s = AfterPattern (patchMatch s)--__tag, __tags, __patch, __patches, __match, __matches, __last, __index, __indexes :: DarcsAtomicOption--__tag = DarcsArgOption ['t'] ["tag"] OneTag "REGEXP"- "select tag matching REGEXP"-__tags = DarcsArgOption ['t'] ["tags"] OneTag "REGEXP"- "select tags matching REGEXP"--__patch = DarcsArgOption ['p'] ["patch"] OnePatch "REGEXP"- "select a single patch matching REGEXP"-__patches = DarcsArgOption ['p'] ["patches"] SeveralPatch "REGEXP"- "select patches matching REGEXP"--__match = DarcsArgOption [] ["match"] mp "PATTERN"- "select a single patch matching PATTERN"- where mp s = OnePattern (patchMatch s)-__matches = DarcsArgOption [] ["matches"] mp "PATTERN"- "select patches matching PATTERN"- where mp s = SeveralPattern (patchMatch s)--__last = DarcsArgOption [] ["last"] lastn "NUMBER"- "select the last NUMBER patches"- where lastn = LastN . numberString--__index = DarcsArgOption ['n'] ["index"] indexrange "N" "select one patch"- where indexrange s = if all isDigit s- then PatchIndexRange (read s) (read s)- else PatchIndexRange 0 0--__indexes = DarcsArgOption ['n'] ["index"] indexrange "N-M" "select a range of patches"- where indexrange s = if all isokay s- then if '-' `elem` s- then let x1 = takeWhile (/= '-') s- x2 = reverse $ takeWhile (/= '-') $ reverse s- in PatchIndexRange (read x1) (read x2)- else PatchIndexRange (read s) (read s)- else PatchIndexRange 0 0- isokay c = isDigit c || c == '-'--matchMaxcount :: DarcsOption-matchMaxcount = DarcsSingleOption $ DarcsArgOption [] ["max-count"] mc "NUMBER"- "return only NUMBER results"- where mc = MaxCount . numberString----- | 'getContext' takes a list of flags and returns the context--- specified by @Context c@ in that list of flags, if any.--- This flag is present if darcs was invoked with @--context=FILE@-getContext :: [DarcsFlag] -> Maybe AbsolutePath-getContext xs = listToMaybe [ c | Context c <- xs ]--notest = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["no-test"] NoTest "don't run the test script",- DarcsNoArgOption [] ["test"] Test "run the test script"]-test = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["test"] Test "run the test script",- DarcsNoArgOption [] ["no-test"] NoTest "don't run the test script"]-leaveTestDir = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["leave-test-directory"]- LeaveTestDir "don't remove the test directory",- DarcsNoArgOption [] ["remove-test-directory"]- NoLeaveTestDir "remove the test directory"]-\end{code}--\begin{options}---ignore-times, --no-ignore-times-\end{options}-Darcs optimizes its operations by keeping track of the modification times-of your files. This dramatically speeds up commands such as-\verb!whatsnew! and \verb!record! which would otherwise require reading-every file in the repository and comparing it with a reference version. However,-there are times when this can cause problems, such as when running a series-of darcs commands from a script, in which case often a file will be-modified twice in the same second, which can lead to the second-modification going unnoticed. The solution to such predicaments is the-\verb!--ignore-times! option, which instructs darcs not to trust the file-modification times, but instead to check each file's contents explicitly.-\begin{code}-ignoretimes =- DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["ignore-times"] IgnoreTimes- "don't trust the file modification times"- ,DarcsNoArgOption [] ["no-ignore-times"] DontIgnoreTimes- "trust modification times to find modified files [DEFAULT]"- ]--lookforadds =- DarcsMultipleChoiceOption- [DarcsNoArgOption ['l'] ["look-for-adds"] LookForAdds- "look for (non-boring) files that could be added",- DarcsNoArgOption [] ["dont-look-for-adds","no-look-for-adds"] NoLookForAdds- "don't look for any files that could be added [DEFAULT]"]--fancyMoveAdd =- DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["date-trick"] FancyMoveAdd- "add files with date appended to avoid conflict [EXPERIMENTAL] ",- DarcsNoArgOption [] ["no-date-trick"] NoFancyMoveAdd- "don't use experimental date appending trick [DEFAULT]"]--askdeps =- DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["ask-deps"] AskDeps- "ask for extra dependencies",- DarcsNoArgOption [] ["no-ask-deps"] NoAskDeps- "don't ask for extra dependencies"]--askLongComment =- DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["edit-long-comment"] EditLongComment- "edit the long comment by default",- DarcsNoArgOption [] ["skip-long-comment"] NoEditLongComment- "don't give a long comment",- DarcsNoArgOption [] ["prompt-long-comment"] PromptLongComment- "prompt for whether to edit the long comment"]--keepDate :: DarcsOption-keepDate =- DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["keep-date"] KeepDate- "keep the date of the original patch",- DarcsNoArgOption [] ["no-keep-date"] NoKeepDate- "use the current date for the amended patch"- ]--\end{code}--\begin{options}---author-\end{options}-\darcsEnv{DARCS_EMAIL}--\begin{code}-logfile = DarcsSingleOption $ DarcsAbsPathOption [] ["logfile"] LogFile "FILE"- "give patch name and comment in file"--rmlogfile = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["delete-logfile"] RmLogFile- "delete the logfile when done",- DarcsNoArgOption [] ["no-delete-logfile"] DontRmLogFile- "keep the logfile when done [DEFAULT]"]--author = DarcsSingleOption $- DarcsArgOption ['A'] ["author"] (Author . decodeString) "EMAIL" "specify author id"-fromOpt = DarcsSingleOption $- DarcsArgOption [] ["from"] (Author . decodeString) "EMAIL" "specify email address"--fileHelpAuthor :: [String]-fileHelpAuthor = [- "Each patch is attributed to its author, usually by email address (for",- "example, `Fred Bloggs <fred@example.net>'). Darcs looks in several",- "places for this author string: the --author option, the files",- "_darcs/prefs/author (in the repository) and ~/.darcs/author (in your",- "home directory), and the environment variables $DARCS_EMAIL and",- "$EMAIL. If none of those exist, Darcs will prompt you for an author",- "string and write it to _darcs/prefs/author."]--environmentHelpEmail :: ([String], [String])-environmentHelpEmail = (["DARCS_EMAIL","EMAIL"], fileHelpAuthor)---- | 'getAuthor' takes a list of flags and returns the author of the--- change specified by @Author \"Leo Tolstoy\"@ in that list of flags, if any.--- Otherwise, if @Pipe@ is present, asks the user who is the author and--- returns the answer. If neither are present, try to guess the author,--- from @_darcs/prefs@, and if it's not possible, ask the user.-getAuthor :: [DarcsFlag] -> IO String-getAuthor (Author a:_) = return a-getAuthor (Pipe:_) = do askUser "Who is the author? "-getAuthor (_:flags) = getAuthor flags-getAuthor [] = do- easy_author <- getEasyAuthor- case easy_author of- Just a -> return a- Nothing -> do- aminrepo <- doesDirectoryExist (darcsdir++"/prefs")- if aminrepo then do- putDocLn $- text "Each patch is attributed to its author, usually by email address (for" $$- text "example, `Fred Bloggs <fred@example.net>'). Darcs could not determine" $$- text "your email address, so you will be prompted for it." $$- text "" $$- text ("Your address will be stored in " ++ darcsdir ++ "/prefs/author.") $$- text "It will be used for all patches recorded in this repository." $$- text "If you move that file to ~/.darcs/author, it will be used for patches" $$- text "you record in ALL repositories."- add <- askUser "What is your email address? "- writeLocaleFile (darcsdir ++ "/prefs/author") $- unlines ["# " ++ line | line <- fileHelpAuthor] ++ "\n" ++ add- return add- else askUser "What is your email address (e.g. Fred Bloggs <fred@example.net>)? "---- | 'getEasyAuthor' tries to get the author name first from the repository preferences,--- then from global preferences, then from environment variables. Returns 'Nothing' if it--- could not get it.-getEasyAuthor :: IO (Maybe String)-getEasyAuthor = do- undecodedAuthor <-- firstJustIO [ firstNotBlank `fmap` getPreflist "author",- firstNotBlank `fmap` getGlobal "author",- maybeGetEnv "DARCS_EMAIL",- maybeGetEnv "EMAIL" ]- case undecodedAuthor of- Just a -> return (Just (decodeString a))- Nothing -> return Nothing-\end{code}--\begin{options}---dont-compress, --compress-\end{options}-By default, darcs commands that write patches to disk will compress the-patch files. If you don't want this, you can choose the-\verb!--dont-compress! option, which causes darcs not to compress the patch-file.--\begin{code}-nocompress = DarcsMultipleChoiceOption [__compress, __dontCompress]-uncompressNocompress = DarcsMultipleChoiceOption [__compress, __dontCompress, __uncompress]--__compress, __dontCompress, __uncompress :: DarcsAtomicOption-__compress = DarcsNoArgOption [] ["compress"] Compress- "create compressed patches"-__dontCompress = DarcsNoArgOption [] ["dont-compress","no-compress"] NoCompress- "don't create compressed patches"-__uncompress = DarcsNoArgOption [] ["uncompress"] UnCompress- "uncompress patches"--summary = DarcsMultipleChoiceOption- [DarcsNoArgOption ['s'] ["summary"] Summary "summarize changes",- DarcsNoArgOption [] ["no-summary"] NoSummary "don't summarize changes"]-unified = DarcsMultipleChoiceOption- [DarcsNoArgOption ['u'] ["unified"] Unified- "output patch in a darcs-specific format similar to diff -u",- DarcsNoArgOption [] ["no-unified"] NonUnified- "output patch in darcs' usual format"]--unidiff = DarcsMultipleChoiceOption- [DarcsNoArgOption ['u'] ["unified"] Unified- "pass -u option to diff",- DarcsNoArgOption [] ["no-unified"] NonUnified- "output patch in diff's dumb format"]--diffCmdFlag = DarcsSingleOption $- DarcsArgOption [] ["diff-command"] DiffCmd "COMMAND" "specify diff command (ignores --diff-opts)"--storeInMemory = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["store-in-memory"] StoreInMemory- "do patch application in memory rather than on disk",- DarcsNoArgOption [] ["no-store-in-memory"] ApplyOnDisk- "do patch application on disk [DEFAULT]"]--target = DarcsSingleOption $- DarcsArgOption [] ["to"] Target "EMAIL" "specify destination email"-ccSend = DarcsSingleOption $- DarcsArgOption [] ["cc"] Cc "EMAIL" "mail results to additional EMAIL(s)"-ccApply = DarcsSingleOption $- DarcsArgOption [] ["cc"] Cc "EMAIL" "mail results to additional EMAIL(s). Requires --reply"---- |'getCc' takes a list of flags and returns the addresses to send a copy of--- the patch bundle to when using @darcs send@.--- looks for a cc address specified by @Cc \"address\"@ in that list of flags.--- Returns the addresses as a comma separated string.-getCc :: [DarcsFlag] -> String-getCc fs = lt $ mapMaybe whatcc fs- where whatcc (Cc t) = Just t- whatcc _ = Nothing- lt [t] = t- lt [t,""] = t- lt (t:ts) = t++" , "++lt ts- lt [] = ""--subject = DarcsSingleOption $ DarcsArgOption [] ["subject"] Subject "SUBJECT" "specify mail subject"---- |'getSubject' takes a list of flags and returns the subject of the mail--- to be sent by @darcs send@. Looks for a subject specified by--- @Subject \"subject\"@ in that list of flags, if any.--- This flag is present if darcs was invoked with @--subject=SUBJECT@-getSubject :: [DarcsFlag] -> Maybe String-getSubject (Subject s:_) = Just s-getSubject (_:fs) = getSubject fs-getSubject [] = Nothing--inReplyTo = DarcsSingleOption $ DarcsArgOption [] ["in-reply-to"] InReplyTo "EMAIL" "specify in-reply-to header"-getInReplyTo :: [DarcsFlag] -> Maybe String-getInReplyTo (InReplyTo s:_) = Just s-getInReplyTo (_:fs) = getInReplyTo fs-getInReplyTo [] = Nothing--output = DarcsSingleOption $ DarcsAbsPathOrStdOption ['o'] ["output"] Output "FILE"- "specify output filename"--outputAutoName = DarcsSingleOption $- DarcsOptAbsPathOption ['O'] ["output-auto-name"] "." OutputAutoName "DIRECTORY"- "output to automatically named file in DIRECTORY, default: current directory"--getOutput :: [DarcsFlag] -> FilePath -> Maybe AbsolutePathOrStd-getOutput (Output a:_) _ = return a-getOutput (OutputAutoName a:_) f = return $ makeAbsoluteOrStd a f-getOutput (_:flags) f = getOutput flags f-getOutput [] _ = Nothing--editDescription = mkMutuallyExclusive [] yes [no]- where- yes = ( DarcsNoArgOption [] ["edit-description"]- , EditDescription- , "edit the patch bundle description" )- no = ( DarcsNoArgOption [] ["dont-edit-description","no-edit-description"]- , NoEditDescription- , "don't edit the patch bundle description" )--distnameOption = DarcsSingleOption $- DarcsArgOption ['d'] ["dist-name"] DistName "DISTNAME" "name of version"--recursive :: String -> DarcsOption-recursive h- = DarcsMultipleChoiceOption- [DarcsNoArgOption ['r'] ["recursive"] Recursive h,- DarcsNoArgOption [] ["not-recursive","no-recursive"] NoRecursive ("don't "++h)]--inventoryChoices :: DarcsOption-inventoryChoices =- DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["hashed"] UseHashedInventory- "Some new features. Compatible with older repos",- DarcsNoArgOption [] ["darcs-2"] UseFormat2- "All features. Related repos must use same format [DEFAULT]",- DarcsNoArgOption [] ["old-fashioned-inventory"] UseOldFashionedInventory- "Minimal features. What older repos use."]--getInventoryChoices :: DarcsOption-getInventoryChoices =- DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["hashed"] UseHashedInventory- "Convert darcs-1 format to hashed format",- DarcsNoArgOption [] ["old-fashioned-inventory"] UseOldFashionedInventory- "Convert from hashed to darcs-1 format"]--upgradeFormat :: DarcsOption-upgradeFormat = DarcsSingleOption $- DarcsNoArgOption [] ["upgrade"] UpgradeFormat- "upgrade repository to latest compatible format"--xmloutput = DarcsSingleOption $- DarcsNoArgOption [] ["xml-output"] XMLOutput "generate XML formatted output"--creatorhash = DarcsSingleOption $- DarcsArgOption [] ["creator-hash"] CreatorHash "HASH" "specify hash of creator patch (see docs)"--sign = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["sign"] Sign- "sign the patch with your gpg key",- DarcsArgOption [] ["sign-as"] SignAs "KEYID"- "sign the patch with a given keyid",- DarcsArgOption [] ["sign-ssl"] SignSSL "IDFILE"- "sign the patch using openssl with a given private key",- DarcsNoArgOption [] ["dont-sign","no-sign"] NoSign- "don't sign the patch"]-applyas = DarcsMultipleChoiceOption- [DarcsArgOption [] ["apply-as"] ApplyAs "USERNAME"- "apply patch as another user using sudo",- DarcsNoArgOption [] ["no-apply-as"] NonApply- "don't use sudo to apply as another user [DEFAULT]"]--happyForwarding = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["happy-forwarding"] HappyForwarding- "forward unsigned messages without extra header",- DarcsNoArgOption [] ["no-happy-forwarding"] NoHappyForwarding- "don't forward unsigned messages without extra header [DEFAULT]"]--setDefault :: Bool -> DarcsOption-setDefault wantYes- | wantYes = mkMutuallyExclusive [] yes [no]- | otherwise = mkMutuallyExclusive [yes] no []- where- yes = ( DarcsNoArgOption [] ["set-default"], SetDefault- , "set default repository" )- no = ( DarcsNoArgOption [] ["no-set-default"], NoSetDefault- , "don't set default repository" )--verify = DarcsMultipleChoiceOption- [DarcsAbsPathOption [] ["verify"] Verify "PUBRING"- "verify that the patch was signed by a key in PUBRING",- DarcsAbsPathOption [] ["verify-ssl"] VerifySSL "KEYS"- "verify using openSSL with authorized keys from file KEYS",- DarcsNoArgOption [] ["no-verify"] NonVerify- "don't verify patch signature"]--reponame :: DarcsOption-reponame = DarcsSingleOption $- DarcsArgOption [] ["repo-name","repodir"] NewRepo "DIRECTORY"- "path of output directory" --repodir is there for compatibility- --should be removed eventually-depsSel :: DarcsOption-depsSel = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["no-deps"] DontGrabDeps- "don't automatically fulfill dependencies",- DarcsNoArgOption [] ["dont-prompt-for-dependencies"] DontPromptForDependencies- "don't ask about patches that are depended on by matched patches (with --match or --patch)",- DarcsNoArgOption [] ["prompt-for-dependencies"] PromptForDependencies- "prompt about patches that are depended on by matched patches [DEFAULT]"]--tokens :: DarcsOption-tokens = DarcsSingleOption $- DarcsArgOption [] ["token-chars"] Toks "\"[CHARS]\""- "define token to contain these characters"--partial :: DarcsOption-partial = DarcsMultipleChoiceOption [__partial, __lazy, __ephemeral, __complete]-partialCheck :: DarcsOption-partialCheck = DarcsMultipleChoiceOption [__complete, __partial]--__partial, __lazy, __ephemeral, __complete :: DarcsAtomicOption-__partial = DarcsNoArgOption [] ["partial"] Partial- "get partial repository using checkpoint (old-fashioned format only)"-__lazy = DarcsNoArgOption [] ["lazy"] Lazy- "get patch files only as needed"-__ephemeral = DarcsNoArgOption [] ["ephemeral"] Ephemeral- "don't save patch files in the repository"-__complete = DarcsNoArgOption [] ["complete"] Complete- "get a complete copy of the repository"--forceReplace = DarcsMultipleChoiceOption- [DarcsNoArgOption ['f'] ["force"] ForceReplace- "proceed with replace even if 'new' token already exists",- DarcsNoArgOption [] ["no-force"]- NonForce "don't force the replace if it looks scary"]--reply = DarcsSingleOption $- DarcsArgOption [] ["reply"] Reply "FROM" "reply to email-based patch using FROM address"-applyConflictOptions- = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["mark-conflicts"]- MarkConflicts "mark conflicts",- DarcsNoArgOption [] ["allow-conflicts"]- AllowConflicts "allow conflicts, but don't mark them",- DarcsNoArgOption [] ["no-resolve-conflicts"] NoAllowConflicts- "equivalent to --dont-allow-conflicts, for backwards compatibility",- DarcsNoArgOption [] ["dont-allow-conflicts","no-allow-conflicts"]- NoAllowConflicts "fail if there are patches that would create conflicts [DEFAULT]",- DarcsNoArgOption [] ["skip-conflicts"]- SkipConflicts "filter out any patches that would create conflicts"- ]-pullConflictOptions- = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["mark-conflicts"]- MarkConflicts "mark conflicts [DEFAULT]",- DarcsNoArgOption [] ["allow-conflicts"]- AllowConflicts "allow conflicts, but don't mark them",- DarcsNoArgOption [] ["dont-allow-conflicts","no-allow-conflicts"]- NoAllowConflicts "fail if there patches that would create conflicts",- DarcsNoArgOption [] ["skip-conflicts"]- SkipConflicts "filter out any patches that would create conflicts"- ]-useExternalMerge = DarcsSingleOption $- DarcsArgOption [] ["external-merge"] ExternalMerge "COMMAND"- "use external tool to merge conflicts"-\end{code}--\begin{options}---dry-run-\end{options}-The \verb!--dry-run! option will cause darcs not to actually take the specified-action, but only print what would have happened. Not all commands accept-\verb!--dry-run!, but those that do should accept the \verb!--summary! option.--\begin{options}---summary, --no-summary-\end{options}-The \verb!--summary! option shows a summary of the patches that would have been-pulled/pushed/whatever. The format is similar to the output format of-\verb!cvs update! and looks like this:--\begin{verbatim}-A ./added_but_not_recorded.c-A! ./added_but_not_recorded_conflicts.c-a ./would_be_added_if_look_for_adds_option_was_used.h--M ./modified.t -1 +1-M! ./modified_conflicts.t -1 +1--R ./removed_but_not_recorded.c-R! ./removed_but_not_recorded_conflicts.c--\end{verbatim}--You can probably guess what the flags mean from the clever file names.-\begin{description}-\item{\texttt{A}} is for files that have been added but not recorded yet.-\item{\texttt{a}} is for files found using the \verb!--look-for-adds! option available for-\verb!whatsnew! and \verb!record!. They have not been added yet, but would be-added automatically if \verb!--look-for-adds! were used with the next-\verb!record! command.--\item{\texttt{M}} is for files that have been modified in the working directory but not-recorded yet. The number of added and subtracted lines is also shown.--\item{\texttt{R}} is for files that have been removed, but the removal is not-recorded yet.-\end{description}-An exclamation mark appears next to any option that has a conflict.--\begin{code}--- NOTE: I'd rather work to have no uses of dryRunNoxml, so that any time--- --dry-run is a possibility, automated users can examine the results more--- easily with --xml.-dryRunNoxml :: DarcsOption-dryRunNoxml = DarcsSingleOption $- DarcsNoArgOption [] ["dry-run"] DryRun "don't actually take the action"--dryRun :: [DarcsOption]-dryRun = [dryRunNoxml, xmloutput]---- | @'showFriendly' flags patch@ returns a 'Doc' representing the right--- way to show @patch@ given the list @flags@ of flags darcs was invoked with.-showFriendly :: Patchy p => [DarcsFlag] -> p C(x y) -> Doc-showFriendly opts p | Verbose `elem` opts = showNicely p- | Summary `elem` opts = Darcs.Patch.summary p- | otherwise = description p---- | @'printDryRunMessageAndExit' action opts patches@ prints a string--- representing the action that would be taken if the @--dry-run@ option--- had not been passed to darcs. Then darcs exits successfully.--- @action@ is the name of the action being taken, like @\"push\"@--- @opts@ is the list of flags which were sent to darcs--- @patches@ is the sequence of patches which would be touched by @action@.-printDryRunMessageAndExit :: RepoPatch p => String -> [DarcsFlag] -> FL (PatchInfoAnd p) C(x y) -> IO ()-printDryRunMessageAndExit action opts patches =- do when (DryRun `elem` opts) $ do- putInfo $ text $ "Would " ++ action ++ " the following changes:"- putDocLn $ put_mode- putInfo $ text $ ""- putInfo $ text $ "Making no changes: this is a dry run."- exitWith ExitSuccess- when (All `elem` opts && Summary `elem` opts) $ do- putInfo $ text $ "Will " ++ action ++ " the following changes:"- putDocLn $ put_mode- where put_mode = if XMLOutput `elem` opts- then (text "<patches>" $$- vcat (mapFL (indent . xml_info) patches) $$- text "</patches>")- else (vsep $ mapFL (showFriendly opts) patches)- putInfo = if XMLOutput `elem` opts then \_ -> return () else putDocLn- xml_info pl- | Summary `elem` opts = xml_with_summary pl- | otherwise = (toXml . info) pl-- xml_with_summary hp- | Just p <- hopefullyM hp = insertBeforeLastline- (toXml $ info hp) (indent $ xmlSummary p)- xml_with_summary hp = toXml (info hp)- indent = prefix " "---\end{code}--\input{Darcs/Resolution.lhs}--\begin{code}-noskipBoring = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["boring"]- Boring "don't skip boring files",- DarcsNoArgOption [] ["no-boring"]- SkipBoring "skip boring files [DEFAULT]"]--allowProblematicFilenames = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["case-ok"] AllowCaseOnly- "don't refuse to add files differing only in case"- ,DarcsNoArgOption [] ["no-case-ok"] DontAllowCaseOnly- "refuse to add files whose name differ only in case [DEFAULT]"- ,DarcsNoArgOption [] ["reserved-ok"] AllowWindowsReserved- "don't refuse to add files with Windows-reserved names"- ,DarcsNoArgOption [] ["no-reserved-ok"] DontAllowWindowsReserved- "refuse to add files with Windows-reserved names [DEFAULT]"]--diffflags = DarcsSingleOption $- DarcsArgOption [] ["diff-opts"]- DiffFlags "OPTIONS" "options to pass to diff"--changesFormat = concatOptions $- [DarcsMultipleChoiceOption [- DarcsNoArgOption [] ["context"]- (Context rootDirectory) "give output suitable for get --context" ],- xmloutput,- humanReadable,- DarcsMultipleChoiceOption [- DarcsNoArgOption [] ["number"] NumberPatches "number the changes",- DarcsNoArgOption [] ["count"] Count "output count of changes" ]- ]-changesReverse = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["reverse"] Reverse- "show changes in reverse order"- ,DarcsNoArgOption [] ["no-reverse"] Forward- "show changes in the usual order [DEFAULT]"]--onlyToFiles :: DarcsOption-onlyToFiles = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["only-to-files"] OnlyChangesToFiles- "show only changes to specified files",- DarcsNoArgOption [] ["no-only-to-files"] ChangesToAllFiles- "show changes to all files [DEFAULT]"]---humanReadable = DarcsSingleOption $- DarcsNoArgOption [] ["human-readable"] HumanReadable "give human-readable output"--pipe :: DarcsAtomicOption-pipe =- DarcsNoArgOption [] ["pipe"] Pipe "ask user interactively for the patch metadata"--interactive :: DarcsAtomicOption-interactive =- DarcsNoArgOption ['i'] ["interactive"] Interactive- "prompt user interactively"--allPatches :: DarcsAtomicOption-allPatches =- DarcsNoArgOption ['a'] ["all"] All "answer yes to all patches"--allInteractive = DarcsMultipleChoiceOption [allPatches, interactive]--allPipeInteractive- = DarcsMultipleChoiceOption [allPatches,pipe,interactive]--pipeInteractive =- DarcsMultipleChoiceOption [pipe, interactive]--repoCombinator =- DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["intersection"] Intersection- "take intersection of all repositories",- DarcsNoArgOption [] ["union"] Union- "take union of all repositories [DEFAULT]",- DarcsNoArgOption [] ["complement"] Complement- "take complement of repositories (in order listed)"]---- | Get a list of all non-boring files and directories in the working copy.-listFiles :: IO [String]-listFiles = do nonboring <- restrictBoring emptyTree- working <- expand =<< applyTreeFilter nonboring <$> readPlainTree "."- return $ map (anchorPath "" . fst) $ list working---- | 'listUnregisteredFiles' returns the list of all non-boring unregistered--- files in the repository.-listUnregisteredFiles :: IO [String]-listUnregisteredFiles =- do unregd <- listFiles- regd <- listRegisteredFiles- return $ unregd \\ regd -- (inefficient)---- | 'listRegisteredFiles' returns the list of all registered files in the repository.-listRegisteredFiles :: IO [String]-listRegisteredFiles =- do recorded <- expand =<< withRepository [] readRecordedAndPending- return $ map (anchorPath "" . fst) $ list recorded--optionsLatex :: [DarcsOption] -> String-optionsLatex opts = "\\begin{tabular}{lll}\n"++- unlines (map optionListLatex opts)++- "\\end{tabular}\n"--latexHelp :: String -> String-latexHelp h- = "\\begin{minipage}{7cm}\n\\raggedright\n" ++ h ++ "\\end{minipage}\n"--optionListLatex :: DarcsOption -> String-optionListLatex (DarcsSingleOption o) = optionLatex o-optionListLatex (DarcsMultipleChoiceOption os) = unlines (map optionLatex os)-optionListLatex (DarcsMutuallyExclusive os _) = unlines (map optionLatex os)--optionLatex :: DarcsAtomicOption -> String-optionLatex (DarcsNoArgOption a b _ h) =- showShortOptions a ++ showLongOptions b ++ latexHelp h ++ "\\\\"-optionLatex (DarcsArgOption a b _ arg h) =- showShortOptions a ++- showLongOptions (map (++(" "++arg)) b) ++ latexHelp h ++ "\\\\"-optionLatex (DarcsAbsPathOrStdOption a b _ arg h) =- showShortOptions a ++- showLongOptions (map (++(" "++arg)) b) ++ latexHelp h ++ "\\\\"-optionLatex (DarcsAbsPathOption a b _ arg h) =- showShortOptions a ++- showLongOptions (map (++(" "++arg)) b) ++ latexHelp h ++ "\\\\"-optionLatex (DarcsOptAbsPathOption a b _ _ arg h) =- showShortOptions a ++- showLongOptions (map (++("[="++arg++"]")) b) ++ latexHelp h ++ "\\\\"--showShortOptions :: [Char] -> String-showShortOptions [] = "&"-showShortOptions [c] = "\\verb!-"++[c]++"! &"-showShortOptions (c:cs) = "\\verb!-"++[c]++"!,"++showShortOptions cs--showLongOptions :: [String] -> String-showLongOptions [] = " &"-showLongOptions [s] = "\\verb!--" ++ s ++ "! &"-showLongOptions (s:ss)- = "\\verb!--" ++ s ++ "!,"++ showLongOptions ss--setScriptsExecutableOption :: DarcsOption-setScriptsExecutableOption = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["set-scripts-executable"] SetScriptsExecutable- "make scripts executable",- DarcsNoArgOption [] ["dont-set-scripts-executable","no-set-scripts-executable"] DontSetScriptsExecutable- "don't make scripts executable"]--bisect :: DarcsOption-bisect = DarcsSingleOption $ DarcsNoArgOption [] ["bisect"] Bisect- "binary instead of linear search"--relink, relinkPristine, sibling :: DarcsOption-relink = DarcsSingleOption $ DarcsNoArgOption [] ["relink"] Relink- "relink random internal data to a sibling"--relinkPristine = DarcsSingleOption $- DarcsNoArgOption [] ["relink-pristine"] RelinkPristine- "relink pristine tree (not recommended)"--sibling = DarcsSingleOption $- DarcsAbsPathOption [] ["sibling"] Sibling "URL"- "specify a sibling directory"---- | 'flagsToSiblings' collects the contents of all @Sibling@ flags in a list of flags.-flagsToSiblings :: [DarcsFlag] -> [AbsolutePath]-flagsToSiblings ((Sibling s) : l) = s : (flagsToSiblings l)-flagsToSiblings (_ : l) = flagsToSiblings l-flagsToSiblings [] = []--nolinks :: DarcsOption-nolinks = DarcsSingleOption $ DarcsNoArgOption [] ["nolinks"] NoLinks- "do not link repository or pristine to sibling"--reorderPatches :: DarcsOption-reorderPatches = DarcsSingleOption $ DarcsNoArgOption [] ["reorder-patches"] Reorder- "reorder the patches in the repository"-\end{code}-\begin{options}---sendmail-command-\end{options}-\darcsEnv{SENDMAIL}--\begin{code}-sendmailCmd = DarcsSingleOption $- DarcsArgOption [] ["sendmail-command"] SendmailCmd "COMMAND" "specify sendmail command"--environmentHelpSendmail :: ([String], [String])-environmentHelpSendmail = (["SENDMAIL"], [- "On Unix, the `darcs send' command relies on sendmail(8). The",- "`--sendmail-command' or $SENDMAIL environment variable can be used to",- "provide an explicit path to this program; otherwise the standard",- "locations /usr/sbin/sendmail and /usr/lib/sendmail will be tried."])--- FIXME: mention the following also:--- * sendmail(8) is not sendmail-specific;--- * nowadays, desktops often have no MTA or an unconfigured MTA ----- which is awful, because it accepts mail but doesn't relay it;--- * in this case, can be a sendmail(8)-emulating wrapper on top of an--- MUA that sends mail directly to a smarthost; and--- * on a multi-user system without an MTA and on which you haven't--- got root, can be msmtp.---- |'getSendmailCmd' takes a list of flags and returns the sendmail command--- to be used by @darcs send@. Looks for a command specified by--- @SendmailCmd \"command\"@ in that list of flags, if any.--- This flag is present if darcs was invoked with @--sendmail-command=COMMAND@--- Alternatively the user can set @$S@@ENDMAIL@ which will be used as a fallback if present.-getSendmailCmd :: [DarcsFlag] -> IO String-getSendmailCmd (SendmailCmd a:_) = return a-getSendmailCmd (_:flags) = getSendmailCmd flags-getSendmailCmd [] = do easy_sendmail <- firstJustIO [ maybeGetEnv "SENDMAIL" ]- case easy_sendmail of- Just a -> return a- Nothing -> return ""--files :: DarcsOption-files = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["files"] Files- "include files in output [DEFAULT]",- DarcsNoArgOption [] ["no-files"] NoFiles- "don't include files in output"]--directories :: DarcsOption-directories = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["directories"] Directories- "include directories in output [DEFAULT]",- DarcsNoArgOption [] ["no-directories"] NoDirectories- "don't include directories in output"]--pending :: DarcsOption-pending = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["pending"] Pending- "reflect pending patches in output [DEFAULT]",- DarcsNoArgOption [] ["no-pending"] NoPending- "only included recorded patches in output"]--nullFlag :: DarcsOption -- "null" is already taken-nullFlag = DarcsSingleOption $ DarcsNoArgOption ['0'] ["null"] NullFlag- "separate file names by NUL characters"-\end{code}--\subsection{Posthooks}--\begin{options}---posthook=COMMAND, --no-posthook-\end{options}-To provide a command that should be run whenever a darcs command completes-successfully, use \verb!--posthook! to specify the command. This is useful-for people who want to have a command run whenever a patch is applied. Using-\verb!--no-posthook! will disable running the command.-\begin{options}---run-posthook, --prompt-posthook-\end{options}-These options control prompting before running the posthook. Use-\verb!--prompt-posthook! to have darcs prompt before running the-posthook command. You may use --run-posthook to reenable the default-behavior of running user-specified posthooks.--Some darcs commands export to the posthook command information about the-changes being made. In particular, three environment variables are defined.-\verb!DARCS_PATCHES! contains a human-readable summary of the patches being-acted upon. The format is the same as "darcs changes". \verb!DARCS_PATCHES_XML!-Contains the same details, in the same XML format as "darcs changes". Finally,-\verb!DARCS_FILES! contains a list of the files affected, one file per line.-If your repository has filenames including newlines, you'll just have to-cope. Note, however, that \emph{none} of these environment variables are-defined when running under windows. Note also that we refuse to pass-environment variables greater in size than 10k, in order to avoid triggering-\verb!E2BIG! errors.--\begin{code}-definePatches :: RepoPatch p => FL (PatchInfoAnd p) C(x y) -> IO ()-#ifndef WIN32-definePatches ps = do let k = "Defining environment variables"- beginTedious k- tediousSize k 3- finishedOneIO k "DARCS_PATCHES"- setEnvCautiously "DARCS_PATCHES" (renderString $ Darcs.Patch.summary ps)- finishedOneIO k "DARCS_PATCHES_XML"- setEnvCautiously "DARCS_PATCHES_XML"- (renderString $ text "<patches>" $$- vcat (mapFL (toXml . info) ps) $$- text "</patches>")- finishedOneIO k "DARCS_FILES"- setEnvCautiously "DARCS_FILES" (unlines$ listTouchedFiles ps)- endTedious k--setEnvCautiously :: String -> String -> IO ()-setEnvCautiously e v | toobig (10*1024) v = return ()- | otherwise = setEnv e v True- where toobig :: Int -> [a] -> Bool- toobig 0 _ = True- toobig _ [] = False- toobig n (_:xs) = toobig (n-1) xs-#else-definePatches _ = return ()-#endif--defineChanges :: Patchy p => p C(x y) -> IO ()-#ifndef WIN32-defineChanges ps = setEnvCautiously "DARCS_FILES" (unlines $ listTouchedFiles ps)-#else-defineChanges _ = return ()-#endif--posthookCmd :: DarcsOption-posthookCmd = DarcsMultipleChoiceOption- [DarcsArgOption [] ["posthook"] PosthookCmd- "COMMAND" "specify command to run after this darcs command",- DarcsNoArgOption [] ["no-posthook"] NoPosthook- "don't run posthook command"]--posthookPrompt :: DarcsOption-posthookPrompt = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["prompt-posthook"] AskPosthook- "prompt before running posthook [DEFAULT]",- DarcsNoArgOption [] ["run-posthook"] RunPosthook- "run posthook command without prompting"]---- | 'getPosthookCmd' takes a list of flags and returns the posthook command--- specified by @PosthookCmd a@ in that list of flags, if any.-getPosthookCmd :: [DarcsFlag] -> Maybe String-getPosthookCmd (PosthookCmd a:_) = Just a-getPosthookCmd (_:flags) = getPosthookCmd flags-getPosthookCmd [] = Nothing-\end{code}--\subsection{Prehooks}--\begin{options}---prehook=COMMAND, --no-prehook-\end{options}-To provide a command that should be run before a darcs command is executed,- use \verb!--prehook! to specify the command. An example use is-for people who want to have a command run whenever a patch is to be recorded, such as-translating line endings before recording patches. Using-\verb!--no-prehook! will disable running the command.-\begin{options}---run-prehook, --prompt-prehook-\end{options}-These options control prompting before running the prehook. See the-posthook documentation above for details.-\begin{code}-prehookCmd :: DarcsOption-prehookCmd = DarcsMultipleChoiceOption- [DarcsArgOption [] ["prehook"] PrehookCmd- "COMMAND" "specify command to run before this darcs command",- DarcsNoArgOption [] ["no-prehook"] NoPrehook- "don't run prehook command"]--prehookPrompt :: DarcsOption-prehookPrompt = DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["prompt-prehook"] AskPrehook- "prompt before running prehook [DEFAULT]",- DarcsNoArgOption [] ["run-prehook"] RunPrehook- "run prehook command without prompting"]---- | 'getPrehookCmd' takes a list of flags and returns the prehook command--- specified by @PrehookCmd a@ in that list of flags, if any.-getPrehookCmd :: [DarcsFlag] -> Maybe String-getPrehookCmd (PrehookCmd a:_) = Just a-getPrehookCmd (_:flags) = getPrehookCmd flags-getPrehookCmd [] = Nothing-\end{code}--\begin{options}---ssh-cm, --no-ssh-cm-\end{options}--For commands which invoke ssh, darcs will normally multiplex ssh-sessions over a single connection as long as your version of ssh has-the ControlMaster feature from OpenSSH versions 3.9 and above. This-option will avoid darcs trying to use this feature even if your ssh-supports it.--\begin{options}---http-pipelining, --no-http-pipelining-\end{options}--When compiled with libcurl (version 7.18.0 and above), darcs can-use HTTP pipelining. It is enabled by default for libcurl-(version 7.19.1 and above). This option will make darcs enable or-disable HTTP pipelining, overwriting default. Note that if HTTP-pipelining is really used depends on the server.--\begin{options}---no-cache-\end{options}--Do not use patch caches.-\begin{code}-networkOptions :: [DarcsOption]-networkOptions =- [ DarcsMultipleChoiceOption- [ DarcsNoArgOption [] ["ssh-cm"] SSHControlMaster- "use SSH ControlMaster feature"- , DarcsNoArgOption [] ["no-ssh-cm"] NoSSHControlMaster- "don't use SSH ControlMaster feature [DEFAULT]"- ]- , DarcsMultipleChoiceOption- [ DarcsNoArgOption [] ["no-http-pipelining"] NoHTTPPipelining- "disable HTTP pipelining"- ]- , remoteDarcs ]--remoteDarcs :: DarcsOption-remoteDarcs = DarcsSingleOption $- DarcsArgOption [] ["remote-darcs"] RemoteDarcs "COMMAND"- "name of the darcs executable on the remote server"--noCache :: DarcsOption-noCache = DarcsSingleOption $- DarcsNoArgOption [] ["no-cache"] NoCache- "don't use patch caches"--optimizePristine :: DarcsOption-optimizePristine = DarcsSingleOption $- DarcsNoArgOption [] ["pristine"] OptimizePristine- "optimize hashed pristine layout"--optimizeHTTP :: DarcsOption-optimizeHTTP = DarcsSingleOption $- DarcsNoArgOption [] ["http"] OptimizeHTTP- "optimize repository for getting over network"-\end{code}-\begin{options}---umask-\end{options}-By default, Darcs will use your current umask. The option-\verb|--umask| will cause Darcs to switch to a different umask before-writing to the repository.--\begin{code}-umaskOption :: DarcsOption-umaskOption = DarcsSingleOption $- DarcsArgOption [] ["umask"] UMask "UMASK"- "specify umask to use when writing"-\end{code}--\begin{options}---dont-restrict-paths, --restrict-paths-\end{options}-By default darcs is only allowed to manage and modify files and directories-contained inside the current repository and not being part of any darcs-repository's meta data (including the current one). This is mainly for-security, to protect you from spoofed patches modifying arbitrary files-with sensitive data---say, in your home directory---or tampering with any-repository's meta data to switch off this safety guard.--But sometimes you may want to manage a group of ``sub'' repositories'-preference files with a global repository, or use darcs in some other-advanced way. The best way is probably to put-\verb!ALL dont-restrict-paths! in \verb!_darcs/prefs/defaults!. This turns-off all sanity checking for file paths in patches.--Path checking can be temporarily turned on with \verb!--restrict-paths! on-the command line, when pulling or applying unknown patches.--\begin{code}-restrictPaths :: DarcsOption-restrictPaths =- DarcsMultipleChoiceOption- [DarcsNoArgOption [] ["restrict-paths"] RestrictPaths- "don't allow darcs to touch external files or repo metadata",- DarcsNoArgOption [] ["dont-restrict-paths","no-restrict-paths"] DontRestrictPaths- "allow darcs to modify any file or directory (unsafe)"]-\end{code}--\begin{options}---allow-unrelated-repos-\end{options}-By default darcs checks and warns user if repositories are unrelated when-doing pull, push and send. This option makes darcs skip this check.--\begin{code}-allowUnrelatedRepos = DarcsSingleOption $- DarcsNoArgOption [] ["ignore-unrelated-repos"] AllowUnrelatedRepos- "do not check if repositories are unrelated"-\end{code}--\begin{code}-justThisRepo :: DarcsOption-\end{code}--\begin{options}---just-this-repo-\end{options}-This option limits the check or repair to the current repo and-omits any caches or other repos listed as a source of patches.--\begin{code}-justThisRepo = DarcsSingleOption $- DarcsNoArgOption [] ["just-this-repo"] JustThisRepo- "Limit the check or repair to the current repo"-\end{code}--\begin{code}-check, repair, checkOrRepair :: DarcsOption-\end{code}--\begin{options}---check-\end{options}-This option specifies checking mode.--\begin{code}-check = DarcsSingleOption $- DarcsNoArgOption [] ["check"] Check- "Specify checking mode"-\end{code}--\begin{options}---repair-\end{options}-This option specifies repair mode.--\begin{code}-repair = DarcsSingleOption $- DarcsNoArgOption [] ["repair"] Repair- "Specify repair mode"--checkOrRepair = concatOptions [check, repair]---- | @'patchSelectFlag' f@ holds whenever @f@ is a way of selecting--- patches such as @PatchName n@.-patchSelectFlag :: DarcsFlag -> Bool-patchSelectFlag All = True-patchSelectFlag (PatchName _) = True-patchSelectFlag (OnePatch _) = True-patchSelectFlag (SeveralPatch _) = True-patchSelectFlag (AfterPatch _) = True-patchSelectFlag (UpToPatch _) = True-patchSelectFlag (TagName _) = True-patchSelectFlag (LastN _) = True-patchSelectFlag (OneTag _) = True-patchSelectFlag (AfterTag _) = True-patchSelectFlag (UpToTag _) = True-patchSelectFlag (OnePattern _) = True-patchSelectFlag (SeveralPattern _) = True-patchSelectFlag (AfterPattern _) = True-patchSelectFlag (UpToPattern _) = True-patchSelectFlag _ = False---- | The integer corresponding to a string, if it's only composed of digits.--- Otherwise, -1.-numberString :: String -> Int-numberString "" = -1-numberString s = if all isDigit s then read s else (-1)-\end{code}
+ src/Darcs/Commands.hs view
@@ -0,0 +1,242 @@+-- Copyright (C) 2002,2003,2005 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.++module Darcs.Commands ( CommandControl( CommandData, HiddenCommand, GroupName ),+ DarcsCommand( DarcsCommand, commandProgramName, commandName,+ commandHelp, commandDescription,+ commandBasicOptions, commandAdvancedOptions,+ commandCommand,+ commandPrereq,+ commandExtraArgHelp,+ commandExtraArgs,+ commandArgdefaults,+ commandGetArgPossibilities,+ SuperCommand,+ commandSubCommands ),+ commandAlias, commandStub,+ commandOptions, commandAlloptions,+ disambiguateCommands, CommandArgs(..),+ getCommandHelp, getCommandMiniHelp,+ getSubcommands,+ usage, usageHelper, subusage, chompNewline,+ extractCommands,+ superName,+ nodefaults,+ putInfo, putVerbose, putWarning, abortRun+ ) where++import System.Console.GetOpt( OptDescr, usageInfo )+import Control.Monad (when, unless)++import Data.List ( sort, isPrefixOf )+import Darcs.Arguments ( DarcsFlag(Quiet,Verbose, DryRun), DarcsOption, disable, help,+ anyVerbosity, noCache, posthookCmd, posthookPrompt,+ prehookCmd, prehookPrompt, optionFromDarcsOption )+import Darcs.RepoPath ( AbsolutePath, rootDirectory )+import Printer ( Doc, putDocLn, hPutDocLn, text, (<+>), errorDoc )+import System.IO ( stderr )++extractCommands, extractHiddenCommands :: [CommandControl] -> [DarcsCommand]+extractCommands cs = concatMap (\x -> case x of { CommandData cmd_d -> [cmd_d]; _ -> []}) cs+extractHiddenCommands cs = concatMap (\x -> case x of { HiddenCommand cmd_d -> [cmd_d]; _ -> []}) cs++data CommandControl = CommandData DarcsCommand+ | HiddenCommand DarcsCommand+ | GroupName String++data DarcsCommand =+ DarcsCommand {commandProgramName, commandName, commandHelp, commandDescription :: String,+ commandExtraArgs :: Int,+ commandExtraArgHelp :: [String],+ commandCommand :: [DarcsFlag] -> [String] -> IO (),+ commandPrereq :: [DarcsFlag] -> IO (Either String ()),+ commandGetArgPossibilities :: IO [String],+ commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String],+ commandBasicOptions :: [DarcsOption],+ commandAdvancedOptions :: [DarcsOption]}+ | SuperCommand {commandProgramName, commandName, commandHelp, commandDescription :: String,+ commandPrereq :: [DarcsFlag] -> IO (Either String ()),+ commandSubCommands :: [CommandControl]}++commandAlloptions :: DarcsCommand -> ([DarcsOption], [DarcsOption])+commandAlloptions DarcsCommand { commandBasicOptions = opts1+ , commandAdvancedOptions = opts2 }+ = (opts1 ++ [disable, help],+ anyVerbosity ++ opts2 +++ [noCache+ ,posthookCmd, posthookPrompt+ ,prehookCmd, prehookPrompt])++-- Supercommands cannot be disabled.+commandAlloptions SuperCommand { } = ([help],[])++-- Obtain options suitable as input to+-- System.Console.Getopt, including the --disable option (which is+-- not listed explicitly in the DarcsCommand definitions).+commandOptions :: AbsolutePath -> DarcsCommand -> ([OptDescr DarcsFlag], [OptDescr DarcsFlag])+commandOptions cwd c = (convert basic, convert advanced)+ where (basic, advanced) = commandAlloptions c+ convert = concatMap (optionFromDarcsOption cwd)++nodefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]+nodefaults _ _ xs = return xs++getSubcommands :: DarcsCommand -> [CommandControl]+getSubcommands c@(SuperCommand {}) = commandSubCommands c+getSubcommands _ = []++commandAlias :: String -> Maybe DarcsCommand -> DarcsCommand -> DarcsCommand+commandAlias n msuper c =+ c { commandName = n+ , commandDescription = "Alias for `" ++ commandProgramName c ++ " " ++ cmdName ++ "'."+ , commandHelp = "The `" ++ commandProgramName c ++ " " ++ n ++ "' command is an alias for " +++ "`" ++ commandProgramName c ++ " " ++ cmdName ++ "'.\n" +++ commandHelp c+ }+ where+ cmdName = unwords . map commandName . maybe id (:) msuper $ [ c ]++commandStub :: String -> String -> String -> DarcsCommand -> DarcsCommand+commandStub n h d c =+ c { commandName = n+ , commandHelp = h+ , commandDescription = d+ , commandCommand = \_ _ -> putStr h+ }++usage :: [CommandControl] -> String+usage cs = "Usage: darcs COMMAND ...\n\nCommands:\n" +++ usageHelper cs ++ "\n" +++ "Use 'darcs COMMAND --help' for help on a single command.\n" +++ "Use 'darcs --version' to see the darcs version number.\n" +++ "Use 'darcs --exact-version' to get the exact version of this darcs instance.\n" +++ "Use 'darcs help patterns' for help on patch matching.\n" +++ "Use 'darcs help environment' for help on environment variables.\n" +++ "\n" +++ "Check bug reports at http://bugs.darcs.net/\n"++subusage :: DarcsCommand -> String+subusage super =+ (usageInfo+ ("Usage: " ++ commandProgramName super ++ " "++commandName super++" SUBCOMMAND ... " +++ "\n\n"++ commandDescription super+++ "\n\nSubcommands:\n" ++ usageHelper (getSubcommands super) ++ "\nOptions:")+ (optionFromDarcsOption rootDirectory help))+ ++ "\n" ++ commandHelp super++usageHelper :: [CommandControl] -> String+usageHelper [] = ""+usageHelper (HiddenCommand _:cs) = usageHelper cs+usageHelper ((CommandData c):cs) = " "++padSpaces (commandName c) 15 +++ chompNewline (commandDescription c)++"\n"++usageHelper cs+usageHelper ((GroupName n):cs) = "\n" ++ n ++ "\n" ++ usageHelper cs++chompNewline :: String -> String+chompNewline "" = ""+chompNewline s = if last s == '\n' then init s else s++padSpaces :: String -> Int -> String+padSpaces s n = s ++ replicate (n - length s) ' '++superName :: Maybe DarcsCommand -> String+superName Nothing = ""+superName (Just x) = commandName x ++ " "++getCommandMiniHelp :: Maybe DarcsCommand -> DarcsCommand -> String+getCommandMiniHelp msuper cmd =+ getCommandHelpCore msuper cmd +++ "\n\nSee " ++ commandProgramName cmd ++ " help "+ ++ (maybe "" (\c -> commandName c ++ " ") msuper)+ ++ commandName cmd ++ " for details."++getCommandHelp :: Maybe DarcsCommand -> DarcsCommand -> String+getCommandHelp msuper cmd =+ unlines (reverse basicR)+ ++ (if null advanced then ""+ else "\nAdvanced options:\n" ++ unlines (reverse advancedR))+ ++ "\n" ++ commandHelp cmd+ where -- we could just call usageInfo twice, but then the advanced+ -- options might not line up with the basic ones (no short flags)+ (advancedR, basicR) =+ splitAt (length advanced) $ reverse $ lines combinedUsage+ combinedUsage = usageInfo+ (getCommandHelpCore msuper cmd ++ subcommands ++ "\n\nOptions:")+ (basic ++ advanced)+ (basic, advanced) = commandOptions rootDirectory cmd+ subcommands =+ case msuper of+ Nothing -> case getSubcommands cmd of+ [] -> []+ s -> "\n\nSubcommands:\n" ++ (usageHelper s)+ -- we don't want to list subcommands if we're already specifying them+ Just _ -> ""++getCommandHelpCore :: Maybe DarcsCommand -> DarcsCommand -> String+getCommandHelpCore msuper cmd =+ "Usage: " ++ commandProgramName cmd ++ " "++superName msuper++commandName cmd+++ " [OPTION]... " ++ unwords args_help +++ "\n"++ commandDescription cmd+ where args_help = case cmd of+ (DarcsCommand {}) ->+ commandExtraArgHelp cmd+ _ -> []++data CommandArgs = CommandOnly DarcsCommand+ | SuperCommandOnly DarcsCommand+ | SuperCommandSub DarcsCommand DarcsCommand++-- Parses a darcs command line with potentially abbreviated commands+disambiguateCommands :: [CommandControl] -> String -> [String]+ -> Either String (CommandArgs, [String])+disambiguateCommands allcs cmd args =+ do c <- extract cmd allcs+ case (getSubcommands c, args) of+ ([], _) -> return (CommandOnly c, args)+ (_ ,[]) -> return (SuperCommandOnly c, args)+ (subcs, (a:as)) -> case extract a subcs of+ Left _ -> return (SuperCommandOnly c, args)+ Right sc -> return (SuperCommandSub c sc, as)++extract :: String -> [CommandControl] -> Either String DarcsCommand+extract cmd cs =+ case [ c | c <- extractCommands cs, cmd `isPrefixOf` commandName c ] +++ [ h | h <- extractHiddenCommands cs, cmd == commandName h ] of+ [] -> Left $ "No such command '" ++ cmd ++ "'\n"+ [c] -> Right c+ cs' -> Left $ "Ambiguous command...\n\n" +++ "The command '"++cmd++"' could mean one of:\n" +++ unwords (sort $ map commandName cs')++amVerbose :: [DarcsFlag] -> Bool+amVerbose = elem Verbose++amQuiet :: [DarcsFlag] -> Bool+amQuiet = elem Quiet++putVerbose :: [DarcsFlag] -> Doc -> IO ()+putVerbose opts = when (amVerbose opts) . putDocLn++putInfo :: [DarcsFlag] -> Doc -> IO ()+putInfo opts = unless (amQuiet opts) . putDocLn++putWarning :: [DarcsFlag] -> Doc -> IO ()+putWarning opts = unless (amQuiet opts) . hPutDocLn stderr++abortRun :: [DarcsFlag] -> Doc -> IO ()+abortRun opts msg = if DryRun `elem` opts+ then putInfo opts $ text "NOTE:" <+> msg+ else errorDoc msg
− src/Darcs/Commands.lhs
@@ -1,312 +0,0 @@-% Copyright (C) 2002,2003,2005 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.--\begin{code}-module Darcs.Commands ( CommandControl( CommandData, HiddenCommand, GroupName ),- DarcsCommand( DarcsCommand, commandName,- commandHelp, commandDescription,- commandBasicOptions, commandAdvancedOptions,- commandCommand,- commandPrereq,- commandExtraArgHelp,- commandExtraArgs,- commandArgdefaults,- commandGetArgPossibilities,- SuperCommand,- commandSubCommands ),- commandAlias, commandStub,- commandOptions, commandAlloptions,- disambiguateCommands, CommandArgs(..),- getCommandHelp, getCommandMiniHelp,- getSubcommands,- usage, usageHelper, subusage, chompNewline,- extractCommands,- superName,- nodefaults,- putInfo, putVerbose, putWarning, abortRun- ) where--import System.Console.GetOpt( OptDescr, usageInfo )-import Control.Monad (when, unless)--import Data.List ( sort, isPrefixOf )-import Darcs.Arguments ( DarcsFlag(Quiet,Verbose, DryRun), DarcsOption, disable, help,- anyVerbosity, noCache, posthookCmd, posthookPrompt,- prehookCmd, prehookPrompt, optionFromDarcsOption )-import Darcs.RepoPath ( AbsolutePath, rootDirectory )-import Printer ( Doc, putDocLn, hPutDocLn, text, (<+>), errorDoc )-import System.IO ( stderr )-\end{code}--The general format of a darcs command is-\begin{verbatim}-% darcs COMMAND OPTIONS ARGUMENTS ...-\end{verbatim}-Here \verb|COMMAND| is a command such as \verb|add| or \verb|record|, which of-course may have one or more arguments. Options have the form-\verb!--option! or \verb!-o!, while arguments vary from command to-command. There are many options which are common to a number of different-commands, which will be summarized here.--If you wish, you may use any unambiguous beginning of a command name as a-shortcut: for \verb!darcs record!, you could type \verb!darcs recor! or-\verb!darcs rec!, but not \verb!darcs re! since that could be confused with-\verb!darcs replace!, \verb!darcs revert! and \verb!darcs remove!.--In some cases, \verb|COMMAND| actually consists of two words, a-super-command and a subcommand. For example, the ``display the-manifest'' command has the form \verb|darcs query manifest|.--\paragraph{Command overview}--Not all commands modify the ``patches'' of your repository (that-is, the named patches which other users can pull); some commands only-affect the copy of the source tree you're working on (your ``working-directory''), and some affect both. This table summarizes what you should-expect from each one and will hopefully serve as guide when you're having-doubts about which command to use.--\begin{center}-\footnotetext[1]{But it affects the repository and working directory targeted- by the push}-\footnotetext[2]{As for the other end, see apply}-\begin{tabular}{|c|c|c|}-\hline-affects & patches & working directory\\-\hline-record & yes & no\\-\hline-unrecord & yes & no\\-\hline-rollback & yes & yes\\-\hline-revert & no & yes\\-\hline-unrevert & no & yes\\-\hline-pull & yes & yes\\-\hline-obliterate & yes & yes\\-\hline-apply & yes & yes\\-\hline-push\footnote{But it affects the repository and working directory targeted by-the push} & no & no\\-\hline-send\footnote{As for the other end, see apply} & no & no\\-\hline-put\footnote{Creates a new repository} & no & no\\-\hline-\end{tabular}-\end{center}--\begin{code}-extractCommands, extractHiddenCommands :: [CommandControl] -> [DarcsCommand]-extractCommands cs = concatMap (\x -> case x of { CommandData cmd_d -> [cmd_d]; _ -> []}) cs-extractHiddenCommands cs = concatMap (\x -> case x of { HiddenCommand cmd_d -> [cmd_d]; _ -> []}) cs-\end{code}--\input{Darcs/Arguments.lhs}--\begin{code}-data CommandControl = CommandData DarcsCommand- | HiddenCommand DarcsCommand- | GroupName String--data DarcsCommand =- DarcsCommand {commandName, commandHelp, commandDescription :: String,- commandExtraArgs :: Int,- commandExtraArgHelp :: [String],- commandCommand :: [DarcsFlag] -> [String] -> IO (),- commandPrereq :: [DarcsFlag] -> IO (Either String ()),- commandGetArgPossibilities :: IO [String],- commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String],- commandBasicOptions :: [DarcsOption],- commandAdvancedOptions :: [DarcsOption]}- | SuperCommand {commandName, commandHelp, commandDescription :: String,- commandPrereq :: [DarcsFlag] -> IO (Either String ()),- commandSubCommands :: [CommandControl]}--commandAlloptions :: DarcsCommand -> ([DarcsOption], [DarcsOption])-commandAlloptions DarcsCommand { commandBasicOptions = opts1- , commandAdvancedOptions = opts2 }- = (opts1 ++ [disable, help],- anyVerbosity ++ opts2 ++- [noCache- ,posthookCmd, posthookPrompt- ,prehookCmd, prehookPrompt])---- Supercommands cannot be disabled.-commandAlloptions SuperCommand { } = ([help],[])---- Obtain options suitable as input to--- System.Console.Getopt, including the --disable option (which is--- not listed explicitly in the DarcsCommand definitions).-commandOptions :: AbsolutePath -> DarcsCommand -> ([OptDescr DarcsFlag], [OptDescr DarcsFlag])-commandOptions cwd c = (convert basic, convert advanced)- where (basic, advanced) = commandAlloptions c- convert = concatMap (optionFromDarcsOption cwd)--nodefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]-nodefaults _ _ xs = return xs--getSubcommands :: DarcsCommand -> [CommandControl]-getSubcommands c@(SuperCommand {}) = commandSubCommands c-getSubcommands _ = []--commandAlias :: String -> Maybe DarcsCommand -> DarcsCommand -> DarcsCommand-commandAlias n msuper c =- c { commandName = n- , commandDescription = "Alias for `darcs " ++ cmdName ++ "'."- , commandHelp = "The `darcs " ++ n ++ "' command is an alias for " ++- "`darcs " ++ cmdName ++ "'.\n" ++- commandHelp c- }- where- cmdName = unwords . map commandName . maybe id (:) msuper $ [ c ]--commandStub :: String -> String -> String -> DarcsCommand -> DarcsCommand-commandStub n h d c =- c { commandName = n- , commandHelp = h- , commandDescription = d- , commandCommand = \_ _ -> putStr h- }--usage :: [CommandControl] -> String-usage cs = "Usage: darcs COMMAND ...\n\nCommands:\n" ++- usageHelper cs ++ "\n" ++- "Use 'darcs COMMAND --help' for help on a single command.\n" ++- "Use 'darcs --version' to see the darcs version number.\n" ++- "Use 'darcs --exact-version' to get the exact version of this darcs instance.\n" ++- "Use 'darcs help patterns' for help on patch matching.\n" ++- "Use 'darcs help environment' for help on environment variables.\n" ++- "\n" ++- "Check bug reports at http://bugs.darcs.net/\n"--subusage :: DarcsCommand -> String-subusage super =- (usageInfo- ("Usage: darcs "++commandName super++" SUBCOMMAND ... " ++- "\n\n"++ commandDescription super++- "\n\nSubcommands:\n" ++ usageHelper (getSubcommands super) ++ "\nOptions:")- (optionFromDarcsOption rootDirectory help))- ++ "\n" ++ commandHelp super--usageHelper :: [CommandControl] -> String-usageHelper [] = ""-usageHelper (HiddenCommand _:cs) = usageHelper cs-usageHelper ((CommandData c):cs) = " "++padSpaces (commandName c) 15 ++- chompNewline (commandDescription c)++"\n"++usageHelper cs-usageHelper ((GroupName n):cs) = "\n" ++ n ++ "\n" ++ usageHelper cs--chompNewline :: String -> String-chompNewline "" = ""-chompNewline s = if last s == '\n' then init s else s--padSpaces :: String -> Int -> String-padSpaces s n = s ++ replicate (n - length s) ' '--superName :: Maybe DarcsCommand -> String-superName Nothing = ""-superName (Just x) = commandName x ++ " "--getCommandMiniHelp :: Maybe DarcsCommand -> DarcsCommand -> String-getCommandMiniHelp msuper cmd =- getCommandHelpCore msuper cmd ++- "\n\nSee darcs help "- ++ (maybe "" (\c -> commandName c ++ " ") msuper)- ++ commandName cmd ++ " for details."--getCommandHelp :: Maybe DarcsCommand -> DarcsCommand -> String-getCommandHelp msuper cmd =- unlines (reverse basicR)- ++ (if null advanced then ""- else "\nAdvanced options:\n" ++ unlines (reverse advancedR))- ++ "\n" ++ commandHelp cmd- where -- we could just call usageInfo twice, but then the advanced- -- options might not line up with the basic ones (no short flags)- (advancedR, basicR) =- splitAt (length advanced) $ reverse $ lines combinedUsage- combinedUsage = usageInfo- (getCommandHelpCore msuper cmd ++ subcommands ++ "\n\nOptions:")- (basic ++ advanced)- (basic, advanced) = commandOptions rootDirectory cmd- subcommands =- case msuper of- Nothing -> case getSubcommands cmd of- [] -> []- s -> "\n\nSubcommands:\n" ++ (usageHelper s)- -- we don't want to list subcommands if we're already specifying them- Just _ -> ""--getCommandHelpCore :: Maybe DarcsCommand -> DarcsCommand -> String-getCommandHelpCore msuper cmd =- "Usage: darcs "++superName msuper++commandName cmd++- " [OPTION]... " ++ unwords args_help ++- "\n"++ commandDescription cmd- where args_help = case cmd of- (DarcsCommand _ _ _ _ _ _ _ _ _ _ _) ->- commandExtraArgHelp cmd- _ -> []--data CommandArgs = CommandOnly DarcsCommand- | SuperCommandOnly DarcsCommand- | SuperCommandSub DarcsCommand DarcsCommand---- Parses a darcs command line with potentially abbreviated commands-disambiguateCommands :: [CommandControl] -> String -> [String]- -> Either String (CommandArgs, [String])-disambiguateCommands allcs cmd args =- do c <- extract cmd allcs- case (getSubcommands c, args) of- ([], _) -> return (CommandOnly c, args)- (_ ,[]) -> return (SuperCommandOnly c, args)- (subcs, (a:as)) -> case extract a subcs of- Left _ -> return (SuperCommandOnly c, args)- Right sc -> return (SuperCommandSub c sc, as)--extract :: String -> [CommandControl] -> Either String DarcsCommand-extract cmd cs =- case [ c | c <- extractCommands cs, cmd `isPrefixOf` commandName c ] ++- [ h | h <- extractHiddenCommands cs, cmd == commandName h ] of- [] -> Left $ "No such command '" ++ cmd ++ "'\n"- [c] -> Right c- cs' -> Left $ "Ambiguous command...\n\n" ++- "The command '"++cmd++"' could mean one of:\n" ++- unwords (sort $ map commandName cs')--amVerbose :: [DarcsFlag] -> Bool-amVerbose = elem Verbose--amQuiet :: [DarcsFlag] -> Bool-amQuiet = elem Quiet--putVerbose :: [DarcsFlag] -> Doc -> IO ()-putVerbose opts = when (amVerbose opts) . putDocLn--putInfo :: [DarcsFlag] -> Doc -> IO ()-putInfo opts = unless (amQuiet opts) . putDocLn--putWarning :: [DarcsFlag] -> Doc -> IO ()-putWarning opts = unless (amQuiet opts) . hPutDocLn stderr--abortRun :: [DarcsFlag] -> Doc -> IO ()-abortRun opts msg = if DryRun `elem` opts- then putInfo opts $ text "NOTE:" <+> msg- else errorDoc msg-\end{code}
+ src/Darcs/Commands/Add.hs view
@@ -0,0 +1,253 @@+-- Copyright (C) 2002-2004 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.++module Darcs.Commands.Add ( add, expandDirs ) where++import Data.List ( (\\), nub)+import Data.Maybe( isNothing )+import Control.Monad ( when, unless, liftM )+import Storage.Hashed.Tree( Tree, findTree, expand )+import Storage.Hashed.AnchoredPath( floatPath, anchorPath, parents )++import Darcs.Commands(DarcsCommand(..), putVerbose, putWarning, nodefaults)+import Darcs.Arguments (noskipBoring, allowProblematicFilenames,+ recursive, workingRepoDir, dryRunNoxml, umaskOption,+ listFiles, listUnregisteredFiles,+ DarcsFlag ( Recursive, DryRun, Verbose, Quiet),+ fixSubPaths,+ )+import Darcs.Flags( includeBoring, doAllowCaseOnly, doAllowWindowsReserved,)+import Darcs.Utils ( withCurrentDirectory, nubsort )+import Darcs.Repository.State( readRecordedAndPending )+import Darcs.Repository ( amInHashedRepository, withRepoLock, RepoJob(..), addToPending )+import Darcs.Patch ( Patchy, PrimPatch, applyToTree, addfile, adddir )+import Darcs.Witnesses.Ordered ( FL(..), (+>+), nullFL )+import Darcs.Witnesses.Sealed ( Sealed(..), Gap(..), FreeLeft, unFreeLeft )+import Darcs.Utils ( isFileReallySymlink, doesDirectoryReallyExist+ , doesFileReallyExist, treeHas, treeHasDir, treeHasAnycase )+import Darcs.RepoPath ( SubPath, toFilePath, simpleSubPath, toPath )+import Darcs.Repository.Prefs ( darcsdirFilter, boringFileFilter )+import Data.Maybe ( maybeToList )+import System.FilePath.Posix ( takeDirectory, (</>) )+import qualified System.FilePath.Windows as WindowsFilePath+import Printer( text )++#include "gadts.h"+#include "impossible.h"++addDescription :: String+addDescription = "Add one or more new files or directories."++addHelp :: String+addHelp =+ "Generally a repository contains both files that should be version\n" +++ "controlled (such as source code) and files that Darcs should ignore\n" +++ "(such as executables compiled from the source code). The `darcs add'\n" +++ "command is used to tell Darcs which files to version control.\n" +++ "\n" +++ "When an existing project is first imported into a Darcs repository, it\n" +++ "is common to run `darcs add -r *' or `darcs record -l' to add all\n" +++ "initial source files into darcs.\n"+++ "\n" +++ "Adding symbolic links (symlinks) is not supported.\n\n"++add :: DarcsCommand+add = DarcsCommand {commandProgramName = "darcs",+ commandName = "add",+ commandHelp = addHelp ++ addHelp',+ commandDescription = addDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["<FILE or DIRECTORY> ..."],+ commandCommand = addCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = listUnregisteredFiles,+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [umaskOption],+ commandBasicOptions =+ [noskipBoring, allowProblematicFilenames,+ recursive "add contents of subdirectories",+ workingRepoDir, dryRunNoxml]}++addHelp' :: String+addHelp' =+ "Darcs will ignore all files and folders that look `boring'. The\n" +++ "--boring option overrides this behaviour.\n" +++ "\n" +++ "Darcs will not add file if another file in the same folder has the\n" +++ "same name, except for case. The --case-ok option overrides this\n" +++ "behaviour. Windows and OS X usually use filesystems that do not allow\n" +++ "files a folder to have the same name except for case (for example,\n" +++ "`ReadMe' and `README'). If --case-ok is used, the repository might be\n" +++ "unusable on those systems!\n\n"++addCmd :: [DarcsFlag] -> [String] -> IO ()+addCmd opts args+ | null args = putStrLn $ "Nothing specified, nothing added." +++ "Maybe you wanted to say `darcs add --recursive .'?"+ | otherwise = do+ fs <- fixSubPaths opts args+ case fs of+ [] -> fail "No valid arguments were given"+ _ -> addFiles opts fs++addFiles :: [DarcsFlag] -> [SubPath] -> IO ()+addFiles opts origfiles = withRepoLock opts $ RepoJob $ \repository ->+ do -- TODO do not expand here, and use findM/findIO or such later+ -- (needs adding to hashed-storage first though)+ cur <- expand =<< readRecordedAndPending repository+ let parlist = getParents cur (map toFilePath origfiles)+ flist' <- if Recursive `elem` opts+ then expandDirs origfiles+ else return origfiles+ let flist = nubsort (parlist ++ toFilePath `map` flist')+ -- refuse to add boring files recursively:+ nboring <- if includeBoring opts+ then return darcsdirFilter+ else boringFileFilter+ let fixedOpts = if DryRun `elem` opts then Verbose:opts else opts+ mapM_ (putWarning fixedOpts . text . ((msgSkipping msgs ++ " boring file ")++)) $+ flist \\ nboring flist+ Sealed ps <- fmap unFreeLeft $ addp msgs fixedOpts cur $ nboring flist+ when (nullFL ps && not (null origfiles) && not (Quiet `elem` opts)) $+ fail "No files were added"+ unless gotDryRun $ addToPending repository ps+ where+ gotDryRun = DryRun `elem` opts+ msgs | gotDryRun = dryRunMessages+ | otherwise = normalMessages++addp :: forall prim . (Patchy prim, PrimPatch prim) => AddMessages -> [DarcsFlag] -> Tree IO -> [FilePath] -> IO (FreeLeft (FL prim))+addp msgs opts cur0 files = do+ (ps, dups) <-+ foldr+ (\f rest cur accPS accDups -> do+ (cur', mp, mdup) <- addp' cur f+ rest cur' (maybeToList mp ++ accPS) (maybeToList mdup ++ accDups))+ (\_ ps dups -> return (reverse ps, dups))+ files+ cur0 [] []+ let uniq_dups = nub dups+ caseMsg =+ if gotAllowCaseOnly then ":"+ else ";\nnote that to ensure portability we don't allow\n" +++ "files that differ only in case. Use --case-ok to override this:"+ unless (null dups) $ do+ dupMsg <-+ case uniq_dups of+ [f] ->+ do+ isDir <- doesDirectoryReallyExist f+ if isDir+ then return $+ "The following directory "++msgIs msgs++" already in the repository"+ else return $+ "The following file "++msgIs msgs++" already in the repository"+ fs ->+ do+ areDirs <- mapM doesDirectoryReallyExist fs+ if and areDirs+ then return $+ "The following directories "++msgAre msgs++" already in the repository"+ else+ (if or areDirs+ then return $+ "The following files and directories " +++ msgAre msgs ++ " already in the repository"+ else return $+ "The following files " ++ msgAre msgs ++ " already in the repository")+ putWarning opts . text $ dupMsg ++ caseMsg+ mapM_ (putWarning opts . text) uniq_dups+ return $ foldr (joinGap (+>+)) (emptyGap NilFL) ps+ where+ addp' :: Tree IO -> FilePath -> IO (Tree IO, Maybe (FreeLeft (FL prim)), Maybe FilePath)+ addp' cur f = do+ already_has <- (if gotAllowCaseOnly then treeHas else treeHasAnycase) cur f+ isdir <- doesDirectoryReallyExist f+ isfile <- doesFileReallyExist f+ islink <- isFileReallySymlink f+ case (already_has, is_badfilename, isdir, isfile, islink) of+ (True, _, _, _, _) -> return (cur, Nothing, Just f)+ (_, True, _, _, _) ->+ do putWarning opts . text $+ "The filename " ++ f ++ " is invalid under Windows.\nUse --reserved-ok to allow it."+ return add_failure+ (_, _, True, _, _) -> trypatch $ freeGap (adddir f :>: NilFL)+ (_, _, _, True, _) -> trypatch $ freeGap (addfile f :>: NilFL)+ (_, _, _, _, True) -> do putWarning opts . text $ "Sorry, file " ++ f +++ " is a symbolic link, which is unsupported by darcs."+ return add_failure+ _ -> do putWarning opts . text $ "File "++ f ++" does not exist!"+ return add_failure+ where is_badfilename = not (gotAllowWindowsReserved || WindowsFilePath.isValid f)+ add_failure = (cur, Nothing, Nothing)+ trypatch :: FreeLeft (FL prim) -> IO (Tree IO, Maybe (FreeLeft (FL prim)), Maybe FilePath)+ trypatch p = do Sealed p' <- return $ unFreeLeft p+ ok <- treeHasDir cur parentdir+ if ok+ then do+ tree <- applyToTree p' cur+ putVerbose opts . text $ msgAdding msgs++" '"++f++"'"+ return (tree, Just p, Nothing)+ else do+ putWarning opts . text $ msgSkipping msgs ++ " '" ++ f ++ "' ... couldn't add parent directory '" ++ parentdir ++ "' to repository"+ return (cur, Nothing, Nothing)+ `catch` \e -> do+ putWarning opts . text $ msgSkipping msgs ++ " '" ++ f ++ "' ... " ++ show e+ return (cur, Nothing, Nothing)+ parentdir = takeDirectory f+ gotAllowCaseOnly = doAllowCaseOnly opts+ gotAllowWindowsReserved = doAllowWindowsReserved opts++data AddMessages =+ AddMessages+ { msgSkipping :: String+ , msgAdding :: String+ , msgIs :: String+ , msgAre :: String+ }++normalMessages, dryRunMessages :: AddMessages+normalMessages =+ AddMessages+ { msgSkipping = "Skipping"+ , msgAdding = "Adding"+ , msgIs = "is"+ , msgAre = "are"+ }+dryRunMessages =+ AddMessages+ { msgSkipping = "Would skip"+ , msgAdding = "Would add"+ , msgIs = "would be"+ , msgAre = "would be"+ }++expandDirs :: [SubPath] -> IO [SubPath]+expandDirs fs = liftM (map (fromJust . simpleSubPath)) (concat `fmap` mapM (expandOne . toPath) fs)++expandOne :: FilePath -> IO [FilePath]+expandOne "" = listFiles+expandOne f = do+ isdir <- doesDirectoryReallyExist f+ if not isdir then return [f]+ else do fs <- withCurrentDirectory f listFiles+ return $ f: map (f </>) fs++getParents :: Tree IO -> [FilePath] -> [FilePath]+getParents cur = map (anchorPath "") . go . map floatPath+ where go fs = filter (isNothing . findTree cur) $ concatMap parents fs+
− src/Darcs/Commands/Add.lhs
@@ -1,269 +0,0 @@-% Copyright (C) 2002-2004 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.--\darcsCommand{add}-\begin{code}-module Darcs.Commands.Add ( add, expandDirs ) where--import Data.List ( (\\), nub)-import Data.Maybe( isNothing )-import Control.Monad ( when, unless, liftM )-import Storage.Hashed.Tree( Tree, findTree, expand )-import Storage.Hashed.AnchoredPath( floatPath, anchorPath, parents )--import Darcs.Commands(DarcsCommand(..), putVerbose, putWarning, nodefaults)-import Darcs.Arguments (noskipBoring, allowProblematicFilenames,- fancyMoveAdd,- recursive, workingRepoDir, dryRunNoxml, umaskOption,- listFiles, listUnregisteredFiles,- DarcsFlag ( Recursive, FancyMoveAdd, DryRun, Verbose),- fixSubPaths,- )-import Darcs.Flags( includeBoring, doAllowCaseOnly, doAllowWindowsReserved,)-import Darcs.Utils ( withCurrentDirectory, nubsort )-import IsoDate ( getIsoDateTime )-import Darcs.Repository.State( readRecordedAndPending )-import Darcs.Repository ( amInRepository, withRepoLock, ($-), addToPending )-import Darcs.Patch ( Prim, applyToTree, addfile, adddir, move )-import Darcs.Witnesses.Ordered ( FL(..), (+>+), nullFL )-import Darcs.Witnesses.Sealed ( Sealed(..), Gap(..), FreeLeft, unFreeLeft )-import Darcs.Utils ( isFileReallySymlink, doesDirectoryReallyExist- , doesFileReallyExist, treeHas, treeHasDir, treeHasAnycase )-import Darcs.RepoPath ( SubPath, toFilePath, simpleSubPath, toPath )-import Darcs.Repository.Prefs ( darcsdirFilter, boringFileFilter )-import Data.Maybe ( maybeToList, fromJust )-import System.FilePath.Posix ( takeDirectory, (</>) )-import qualified System.FilePath.Windows as WindowsFilePath-import Printer( text )--#include "gadts.h"--addDescription :: String-addDescription = "Add one or more new files or directories."--addHelp :: String-addHelp =- "Generally a repository contains both files that should be version\n" ++- "controlled (such as source code) and files that Darcs should ignore\n" ++- "(such as executables compiled from the source code). The `darcs add'\n" ++- "command is used to tell Darcs which files to version control.\n" ++- "\n" ++- "When an existing project is first imported into a Darcs repository, it\n" ++- "is common to run `darcs add -r *' or `darcs record -l' to add all\n" ++- "initial source files into darcs.\n"++- "\n" ++- "Adding symbolic links (symlinks) is not supported.\n\n"--add :: DarcsCommand-add = DarcsCommand {commandName = "add",- commandHelp = addHelp ++ addHelp' ++ addHelp'',- commandDescription = addDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["<FILE or DIRECTORY> ..."],- commandCommand = addCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = listUnregisteredFiles,- commandArgdefaults = nodefaults,- commandAdvancedOptions = [umaskOption],- commandBasicOptions =- [noskipBoring, allowProblematicFilenames,- recursive "add contents of subdirectories",- fancyMoveAdd,- workingRepoDir, dryRunNoxml]}--addHelp' :: String-addHelp' =- "Darcs will ignore all files and folders that look `boring'. The\n" ++- "--boring option overrides this behaviour.\n" ++- "\n" ++- "Darcs will not add file if another file in the same folder has the\n" ++- "same name, except for case. The --case-ok option overrides this\n" ++- "behaviour. Windows and OS X usually use filesystems that do not allow\n" ++- "files a folder to have the same name except for case (for example,\n" ++- "`ReadMe' and `README'). If --case-ok is used, the repository might be\n" ++- "unusable on those systems!\n\n"--addCmd :: [DarcsFlag] -> [String] -> IO ()-addCmd opts args = withRepoLock opts $- \repository ->- do -- TODO do not expand here, and use findM/findIO or such later- -- (needs adding to hashed-storage first though)- cur <- expand =<< readRecordedAndPending repository- when (null args) $- putStrLn "Nothing specified, nothing added." >>- putStrLn "Maybe you wanted to say `darcs add --recursive .'?"- origfiles <- fixSubPaths opts args- let parlist = getParents cur (map toFilePath origfiles)- flist' <- if Recursive `elem` opts- then expandDirs origfiles- else return origfiles- let flist = nubsort (parlist ++ toFilePath `map` flist')- -- refuse to add boring files recursively:- nboring <- if includeBoring opts- then return darcsdirFilter- else boringFileFilter- let fixedOpts = if DryRun `elem` opts then Verbose:opts else opts- mapM_ (putWarning fixedOpts . text . ((msgSkipping msgs ++ " boring file ")++)) $- flist \\ nboring flist- date <- getIsoDateTime- Sealed ps <- fmap unFreeLeft $ addp msgs fixedOpts date cur $ nboring flist- when (nullFL ps && not (null args)) $- fail "No files were added"- unless gotDryRun $ addToPending repository ps- where- gotDryRun = DryRun `elem` opts- msgs | gotDryRun = dryRunMessages- | otherwise = normalMessages--addp :: AddMessages -> [DarcsFlag] -> String -> Tree IO -> [FilePath] -> IO (FreeLeft (FL Prim))-addp msgs opts date cur0 files = do- (ps, dups) <-- foldr- (\f rest cur accPS accDups -> do- (cur', mp, mdup) <- addp' cur f- rest cur' (maybeToList mp ++ accPS) (maybeToList mdup ++ accDups))- (\_ ps dups -> return (reverse ps, dups))- files- cur0 [] []- let uniq_dups = nub dups- caseMsg =- if gotAllowCaseOnly then ":"- else ";\nnote that to ensure portability we don't allow\n" ++- "files that differ only in case. Use --case-ok to override this:"- unless (null dups) $ do- dupMsg <-- case uniq_dups of- [f] ->- do- isDir <- doesDirectoryReallyExist f- if isDir- then return $- "The following directory "++msgIs msgs++" already in the repository"- else return $- "The following file "++msgIs msgs++" already in the repository"- fs ->- do- areDirs <- mapM doesDirectoryReallyExist fs- if and areDirs- then return $- "The following directories "++msgAre msgs++" already in the repository"- else- (if or areDirs- then return $- "The following files and directories " ++- msgAre msgs ++ " already in the repository"- else return $- "The following files " ++ msgAre msgs ++ " already in the repository")- putWarning opts . text $ dupMsg ++ caseMsg- mapM_ (putWarning opts . text) uniq_dups- return $ foldr (joinGap (+>+)) (emptyGap NilFL) ps- where- addp' :: Tree IO -> FilePath -> IO (Tree IO, Maybe (FreeLeft (FL Prim)), Maybe FilePath)- addp' cur f = do- already_has <- (if gotAllowCaseOnly then treeHas else treeHasAnycase) cur f- isdir <- doesDirectoryReallyExist f- isfile <- doesFileReallyExist f- islink <- isFileReallySymlink f- case (already_has, is_badfilename, isdir, isfile, islink) of- (True, _, _, _, _) -> return (cur, Nothing, Just f)- (_, True, _, _, _) ->- do putWarning opts . text $- "The filename " ++ f ++ " is invalid under Windows.\nUse --reserved-ok to allow it."- return add_failure- (_, _, True, _, _) -> trypatch $ myadddir f- (_, _, _, True, _) -> trypatch $ myaddfile f- (_, _, _, _, True) -> do putWarning opts . text $ "Sorry, file " ++ f ++- " is a symbolic link, which is unsupported by darcs."- return add_failure- _ -> do putWarning opts . text $ "File "++ f ++" does not exist!"- return add_failure- where is_badfilename = not (gotAllowWindowsReserved || WindowsFilePath.isValid f)- add_failure = (cur, Nothing, Nothing)- trypatch :: FreeLeft (FL Prim) -> IO (Tree IO, Maybe (FreeLeft (FL Prim)), Maybe FilePath)- trypatch p = do Sealed p' <- return $ unFreeLeft p- tree <- applyToTree p' cur- putVerbose opts . text $ msgAdding msgs++" '"++f++"'"- return (tree, Just p, Nothing)- `catch` \_ -> do- err <- parent_error- putWarning opts . text $ msgSkipping msgs ++ " '" ++ f ++ "' ... " ++ err- return (cur, Nothing, Nothing)- parentdir = takeDirectory f- have_parentdir = treeHasDir cur parentdir- parent_error = have_parentdir >>= \x -> return $- if x then ""- else "couldn't add parent directory '"++parentdir++"' to repository."- myadddir d = if gotFancyMoveAdd- then freeGap (adddir (d++"-"++date) :>:- move (d++"-"++date) d :>: NilFL)- else freeGap (adddir d :>: NilFL)- myaddfile d = if gotFancyMoveAdd- then freeGap (addfile (d++"-"++date) :>:- move (d++"-"++date) d :>: NilFL)- else freeGap (addfile d :>: NilFL)- gotFancyMoveAdd = FancyMoveAdd `elem` opts- gotAllowCaseOnly = doAllowCaseOnly opts- gotAllowWindowsReserved = doAllowWindowsReserved opts--data AddMessages =- AddMessages- { msgSkipping :: String- , msgAdding :: String- , msgIs :: String- , msgAre :: String- }--normalMessages, dryRunMessages :: AddMessages-normalMessages =- AddMessages- { msgSkipping = "Skipping"- , msgAdding = "Adding"- , msgIs = "is"- , msgAre = "are"- }-dryRunMessages =- AddMessages- { msgSkipping = "Would skip"- , msgAdding = "Would add"- , msgIs = "would be"- , msgAre = "would be"- }---- |FIXME: this documentation makes *no* sense to me, and the--- ramifications of using this option are not clear. --twb, 2008-addHelp'' :: String-addHelp'' =- "The --date-trick option allows you to enable an experimental trick to\n" ++- "make add conflicts, in which two users each add a file or directory\n" ++- "with the same name, less problematic. While this trick is completely\n" ++- "safe, it is not clear to what extent it is beneficial.\n"--expandDirs :: [SubPath] -> IO [SubPath]-expandDirs fs = liftM (map (fromJust . simpleSubPath)) (concat `fmap` mapM (expandOne . toPath) fs)--expandOne :: FilePath -> IO [FilePath]-expandOne "" = listFiles-expandOne f = do- isdir <- doesDirectoryReallyExist f- if not isdir then return [f]- else do fs <- withCurrentDirectory f listFiles- return $ f: map (f </>) fs--getParents :: Tree IO -> [FilePath] -> [FilePath]-getParents cur = map (anchorPath "") . go . map floatPath- where go fs = filter (isNothing . findTree cur) $ concatMap parents fs--\end{code}
+ src/Darcs/Commands/AmendRecord.hs view
@@ -0,0 +1,255 @@+-- Copyright (C) 2004,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.++module Darcs.Commands.AmendRecord ( amendrecord ) where+import Data.Maybe ( isJust, isNothing )+import System.Directory ( removeFile )+import System.Exit ( ExitCode(..), exitWith )+import Control.Applicative ( (<$>) )+import Control.Monad ( when, unless )++import Darcs.Flags ( DarcsFlag(Author, LogFile, PatchName, AskDeps,+ EditLongComment, PromptLongComment, KeepDate)+ , isInteractive+ , diffingOpts, compression )+import Darcs.Lock ( worldReadableTemp )+import Darcs.RepoPath ( toFilePath )+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, n2pia, hopefully, info, patchDesc )+import Darcs.Repository ( Repository, withRepoLock, RepoJob(..), withGutsOf,+ tentativelyRemovePatches, tentativelyAddPatch, finalizeRepositoryChanges,+ amInHashedRepository+ , invalidateIndex, unrecordedChanges+ , testTentative+ )+import Darcs.Repository.Prefs ( globalPrefsDirDoc )+import Darcs.Patch ( RepoPatch, description, PrimOf, fromPrims,+ infopatch, getdeps, adddeps, effect,+ )+import Darcs.Patch.Prim ( canonizeFL )+import Darcs.Patch.Info ( piAuthor, piName, piLog, piDateString,+ PatchInfo, patchinfo, isInverted, isTag, invertName,+ )+import Darcs.Patch.Split ( primSplitter )+import Darcs.Witnesses.Ordered ( FL(..), (:>)(..), (+>+), nullFL )+import Darcs.SelectChanges ( selectChanges, WhichChanges(..),+ selectionContextPrim,+ runSelection,+ withSelectedPatchFromRepo )+import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Commands.Record ( getDate, getLog, askAboutDepends )+import Darcs.Commands.Util ( announceFiles )+import Darcs.Arguments ( DarcsFlag ( All ),+ fixSubPaths, setEnvDarcsFiles,+ allInteractive, ignoretimes,+ askLongComment, askdeps, keepDate, author, patchnameOption,+ leaveTestDir, nocompress, lookforadds,+ workingRepoDir,+ matchOneNontag, umaskOption,+ test, listRegisteredFiles,+ getEasyAuthor, setScriptsExecutableOption+ )+import Darcs.Utils ( askUser, clarifyErrors, PromptConfig(..), promptChar )+import Darcs.RepoPath ( SubPath() )+import Printer ( putDocLn )+#include "gadts.h"++amendrecordDescription :: String+amendrecordDescription =+ "Improve a patch before it leaves your repository."+++amendrecordHelp :: String+amendrecordHelp =+ "Amend-record updates a `draft' patch with additions or improvements,\n" +++ "resulting in a single `finished' patch. This is better than recording\n" +++ "the additions and improvements as separate patches, because then\n" +++ "whenever the `draft' patch is copied between repositories, you would\n" +++ "need to make sure all the extra patches are copied, too.\n" +++ "\n" +++ "Do not copy draft patches between repositories, because a finished\n" +++ "patch cannot be copied into a repository that contains a draft of the\n" +++ "same patch. If this has already happened, `darcs obliterate' can be\n" +++ "used to remove the draft patch.\n" +++ "\n" +++ -- FIXME: is the following still true in Darcs 2.1? --twb+ "Do not run amend-record in repository that other developers can pull\n" +++ "from, because if they pull while an amend-record is in progress, their\n" +++ "repository may be corrupted.\n" +++ "\n" +++ "When recording a draft patch, it is a good idea to start the name with\n" +++ "`DRAFT:' so that other developers know it is not finished. When\n" +++ "finished, remove it with `darcs amend-record --edit-long-comment'.\n" +++ "To change the patch name without starting an editor, use --patch-name.\n" +++ "\n" +++ "Like `darcs record', if you call amend-record with files as arguments,\n" +++ "you will only be asked about changes to those files. So to amend a\n" +++ "patch to foo.c with improvements in bar.c, you would run:\n" +++ "\n" +++ " darcs amend-record --match 'touch foo.c' bar.c\n" +++ "\n" +++ "It is usually a bad idea to amend another developer's patch. To make\n" +++ "amend-record only ask about your own patches by default, you can add\n" +++ "something like `amend-record match David Roundy' to " ++ globalPrefsDirDoc ++ "defaults, \n" +++ "where `David Roundy' is your name.\n" ++amendrecord :: DarcsCommand+amendrecord = DarcsCommand {commandProgramName = "darcs",+ commandName = "amend-record",+ commandHelp = amendrecordHelp,+ commandDescription = amendrecordDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["[FILE or DIRECTORY]..."],+ commandCommand = amendrecordCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = listRegisteredFiles,+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [nocompress, ignoretimes, umaskOption,+ setScriptsExecutableOption],+ commandBasicOptions = [matchOneNontag,+ test,+ leaveTestDir,+ allInteractive,+ author, patchnameOption, askdeps, askLongComment, keepDate,+ lookforadds,+ workingRepoDir]}++amendrecordCmd :: [DarcsFlag] -> [String] -> IO ()+amendrecordCmd opts args = if null args+ then doAmendRecord opts Nothing+ else do+ files <- fixSubPaths opts args+ if null files+ then fail "No valid arguments were given, nothing to do."+ else doAmendRecord opts $ Just files++doAmendRecord :: [DarcsFlag] -> Maybe [SubPath] -> IO ()+doAmendRecord opts files =+ withRepoLock opts $ RepoJob $ \(repository :: Repository p C(r u r)) -> do+ withSelectedPatchFromRepo "amend" repository opts $ \ (_ :> oldp) -> do+ announceFiles files "Amending changes in"+ -- auxiliary function needed because the witness types differ for the isTag case+ let go :: FORALL(u1) FL (PrimOf p) C(r u1) -> IO ()+ go NilFL | not (hasEditMetadata opts) = putStrLn "No changes!"+ go ch =+ do let context = selectionContextPrim "add"+ (filter (==All) opts)+ (Just primSplitter)+ (map toFilePath <$> files)+ chosenPatches <- runSelection (selectChanges First ch) context+ addChangesToPatch opts repository oldp chosenPatches+ if not (isTag (info oldp))+ -- amending a normal patch+ then go =<< unrecordedChanges (diffingOpts opts) repository files+ -- amending a tag+ else if hasEditMetadata opts && isNothing files+ -- the user is not trying to add new changes to the tag so there is+ -- no reason to warn.+ then go NilFL+ -- the user is trying to add new changes to a tag.+ else do if hasEditMetadata opts+ -- the user already knows that it is possible to edit tag metadata,+ -- note that s/he is providing editing options!+ then putStrLn "You cannot add new changes to a tag."+ -- the user may not be aware that s/he can edit tag metadata.+ else putStrLn "You cannot add new changes to a tag, but you are allowed to edit tag's metadata (see darcs help amend-record)."+ go NilFL++addChangesToPatch :: forall p C(r u t x y) . (RepoPatch p)+ => [DarcsFlag] -> Repository p C(r u t) -> PatchInfoAnd p C(x t)+ -> (FL (PrimOf p) :> FL (PrimOf p)) C(t y) -> IO ()+addChangesToPatch opts repository oldp (chs:>_) =+ if (nullFL chs && not (hasEditMetadata opts))+ then putStrLn "You don't want to record anything!"+ else do+ invalidateIndex repository+ withGutsOf repository $ do+ repository' <- tentativelyRemovePatches repository (compression opts)+ (oldp :>: NilFL)+ (mlogf, newp) <- updatePatchHeader opts repository' oldp chs+ setEnvDarcsFiles newp+ repository'' <- tentativelyAddPatch repository' (compression opts) newp+ let failmsg = maybe "" (\lf -> "\nLogfile left in "++lf++".") mlogf+ rc <- testTentative repository+ when (rc /= ExitSuccess) $ do+ when (not $ isInteractive opts) $ exitWith rc `clarifyErrors` failmsg+ putStrLn $ "Looks like you have a bad patch: '" ++ patchDesc newp ++ "'"+ let prompt = "Shall I amend it anyway?"+ yn <- promptChar (PromptConfig prompt "yn" [] (Just 'n') [])+ case yn of+ 'y' -> return ()+ _ -> exitWith rc `clarifyErrors` failmsg+ finalizeRepositoryChanges repository'' `clarifyErrors` failmsg+ maybe (return ()) removeFile mlogf+ putStrLn "Finished amending patch:"+ putDocLn $ description newp++updatePatchHeader :: forall p C(x y r u t) . (RepoPatch p)+ => [DarcsFlag] -> Repository p C(r u t)+ -> PatchInfoAnd p C(t x) -> FL (PrimOf p) C(x y)+ -> IO (Maybe String, PatchInfoAnd p C(t y))+updatePatchHeader opts repository oldp chs = do++ let newchs = canonizeFL (effect oldp +>+ chs)++ let old_pdeps = getdeps $ hopefully oldp+ newdeps <- if AskDeps `elem` opts+ then askAboutDepends repository newchs opts old_pdeps+ else return old_pdeps++ let old_pinf = info oldp+ prior = (piName old_pinf, piLog old_pinf)+ make_log = worldReadableTemp "darcs-amend-record"+ old_author = piAuthor old_pinf+ date <- if KeepDate `elem` opts then return (piDateString old_pinf) else getDate opts+ warnIfHijacking opts old_author+ (new_name, new_log, mlogf) <- getLog opts (Just prior) make_log chs+ let new_author = case getAuthor opts of+ Just a -> a+ Nothing -> piAuthor old_pinf+ maybe_invert = if isInverted old_pinf then invertName else id+ new_pinf <- maybe_invert `fmap` patchinfo date new_name+ new_author new_log++ let newp = n2pia (adddeps (infopatch new_pinf (fromPrims newchs)) newdeps)++ return (mlogf, newp)++warnIfHijacking :: [DarcsFlag] -> String -> IO ()+warnIfHijacking opts old_author = do+ authors_here <- getEasyAuthor+ let edit_author = isJust (getAuthor opts)+ unless (edit_author || any (== old_author) authors_here) $+ do yorn <- askUser $+ "You're not "++old_author ++"! Amend anyway? "+ case yorn of ('y':_) -> return ()+ _ -> exitWith ExitSuccess++hasEditMetadata :: [DarcsFlag] -> Bool+hasEditMetadata (Author _:_) = True+hasEditMetadata (LogFile _:_) = True+hasEditMetadata (PatchName _:_) = True+hasEditMetadata (EditLongComment:_) = True+hasEditMetadata (PromptLongComment:_) = True+hasEditMetadata (AskDeps:_) = True+hasEditMetadata (_:fs) = hasEditMetadata fs+hasEditMetadata [] = False++getAuthor :: [DarcsFlag] -> Maybe String+getAuthor (Author a:_) = Just a+getAuthor (_:as) = getAuthor as+getAuthor [] = Nothing+
− src/Darcs/Commands/AmendRecord.lhs
@@ -1,219 +0,0 @@-% Copyright (C) 2004,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.--\darcsCommand{amend-record}-\begin{code}-module Darcs.Commands.AmendRecord ( amendrecord ) where-import Data.List ( sort )-import Data.Maybe ( isJust )-import System.Directory ( removeFile )-import System.Exit ( ExitCode(..), exitWith )-import Control.Monad ( when )--import Darcs.Flags ( DarcsFlag(Author, LogFile, PatchName, AskDeps,- EditLongComment, PromptLongComment, KeepDate) )-import Darcs.Lock ( worldReadableTemp )-import Darcs.RepoPath ( toFilePath )-import Darcs.Hopefully ( PatchInfoAnd, n2pia, hopefully, info )-import Darcs.Repository ( Repository, withRepoLock, ($-), withGutsOf,- tentativelyRemovePatches, tentativelyAddPatch, finalizeRepositoryChanges,- amInRepository- , invalidateIndex, unrecordedChanges- )-import Darcs.Patch ( RepoPatch, description, Prim, fromPrims,- infopatch, getdeps, adddeps, effect,- )-import Darcs.Patch.Prim ( canonizeFL )-import Darcs.Patch.Info ( piAuthor, piName, piLog, piDateString,- PatchInfo, patchinfo, isInverted, invertName,- )-import Darcs.Patch.Split ( primSplitter )-import Darcs.Witnesses.Ordered ( FL(..), (:>)(..), (+>+), nullFL )-import Darcs.SelectChanges ( selectChanges, WhichChanges(..),- selectionContextPrim,- runSelection,- withSelectedPatchFromRepo )-import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Commands.Record ( getDate, getLog, askAboutDepends )-import Darcs.Arguments ( DarcsFlag ( All ),- areFileArgs, fixSubPaths, defineChanges,- allInteractive, ignoretimes,- askLongComment, askdeps, keepDate, author, patchnameOption,- leaveTestDir, nocompress, lookforadds,- workingRepoDir,- matchOneNontag, umaskOption,- test, listRegisteredFiles,- getEasyAuthor, setScriptsExecutableOption- )-import Darcs.Utils ( askUser, clarifyErrors )-import Printer ( putDocLn )-#include "gadts.h"--amendrecordDescription :: String-amendrecordDescription =- "Improve a patch before it leaves your repository."--amendrecordHelp :: String-amendrecordHelp =- "Amend-record updates a `draft' patch with additions or improvements,\n" ++- "resulting in a single `finished' patch. This is better than recording\n" ++- "the additions and improvements as separate patches, because then\n" ++- "whenever the `draft' patch is copied between repositories, you would\n" ++- "need to make sure all the extra patches are copied, too.\n" ++- "\n" ++- "Do not copy draft patches between repositories, because a finished\n" ++- "patch cannot be copied into a repository that contains a draft of the\n" ++- "same patch. If this has already happened, `darcs obliterate' can be\n" ++- "used to remove the draft patch.\n" ++- "\n" ++- -- FIXME: is the following still true in Darcs 2.1? --twb- "Do not run amend-record in repository that other developers can pull\n" ++- "from, because if they pull while an amend-record is in progress, their\n" ++- "repository may be corrupted.\n" ++- "\n" ++- "When recording a draft patch, it is a good idea to start the name with\n" ++- "`DRAFT:' so that other developers know it is not finished. When\n" ++- "finished, remove it with `darcs amend-record --edit-long-comment'.\n" ++- "To change the patch name without starting an editor, use --patch-name.\n" ++- "\n" ++- "Like `darcs record', if you call amend-record with files as arguments,\n" ++- "you will only be asked about changes to those files. So to amend a\n" ++- "patch to foo.c with improvements in bar.c, you would run:\n" ++- "\n" ++- " darcs amend-record --match 'touch foo.c' bar.c\n" ++- "\n" ++- "It is usually a bad idea to amend another developer's patch. To make\n" ++- "amend-record only ask about your own patches by default, you can add\n" ++- "something like `amend-record match David Roundy' to ~/.darcs/defaults, \n" ++- "where `David Roundy' is your name. " ++- "On Windows use C:/Documents And Settings/user/Application Data/darcs/defaults\n"--amendrecord :: DarcsCommand-amendrecord = DarcsCommand {commandName = "amend-record",- commandHelp = amendrecordHelp,- commandDescription = amendrecordDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["[FILE or DIRECTORY]..."],- commandCommand = amendrecordCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = listRegisteredFiles,- commandArgdefaults = nodefaults,- commandAdvancedOptions = [nocompress, ignoretimes, umaskOption,- setScriptsExecutableOption],- commandBasicOptions = [matchOneNontag,- test,- leaveTestDir,- allInteractive,- author, patchnameOption, askdeps, askLongComment, keepDate,- lookforadds,- workingRepoDir]}--amendrecordCmd :: [DarcsFlag] -> [String] -> IO ()-amendrecordCmd opts args =- withRepoLock opts $- \(repository :: Repository p C(r u r)) -> do- files <- sort `fmap` fixSubPaths opts args- when (areFileArgs files) $- putStrLn $ "Amending changes in "++unwords (map show files)++":\n"- withSelectedPatchFromRepo "amend" repository opts $ \ (_ :> oldp) -> do- ch <- unrecordedChanges opts repository files- case ch of- NilFL | not (hasEditMetadata opts) -> putStrLn "No changes!"- _ -> do- let context = selectionContextPrim "add" (filter (==All) opts) (Just primSplitter)- (map toFilePath files)- chosenPatches <- runSelection (selectChanges First ch) context- addChangesToPatch opts repository oldp chosenPatches--addChangesToPatch :: forall p C(r u t x y) . (RepoPatch p)- => [DarcsFlag] -> Repository p C(r u t) -> PatchInfoAnd p C(x t)- -> (FL Prim :> FL Prim) C(t y) -> IO ()-addChangesToPatch opts repository oldp (chs:>_) =- if (nullFL chs && not (hasEditMetadata opts))- then putStrLn "You don't want to record anything!"- else do- invalidateIndex repository- withGutsOf repository $ do- repository' <- tentativelyRemovePatches repository opts (oldp :>: NilFL)- (mlogf, newp) <- updatePatchHeader opts repository' oldp chs- defineChanges newp- repository'' <- tentativelyAddPatch repository' opts newp- let failmsg = maybe "" (\lf -> "\nLogfile left in "++lf++".") mlogf- finalizeRepositoryChanges repository'' `clarifyErrors` failmsg- maybe (return ()) removeFile mlogf- putStrLn "Finished amending patch:"- putDocLn $ description newp--updatePatchHeader :: forall p C(x y r u t) . (RepoPatch p)- => [DarcsFlag] -> Repository p C(r u t)- -> PatchInfoAnd p C(t x) -> FL Prim C(x y)- -> IO (Maybe String, PatchInfoAnd p C(t y))-updatePatchHeader opts repository oldp chs = do-- let newchs = canonizeFL (effect oldp +>+ chs)-- let old_pdeps = getdeps $ hopefully oldp- newdeps <- if AskDeps `elem` opts- then askAboutDepends repository newchs opts old_pdeps- else return old_pdeps-- let old_pinf = info oldp- prior = (piName old_pinf, piLog old_pinf)- make_log = worldReadableTemp "darcs-amend-record"- old_author = piAuthor old_pinf- date <- if KeepDate `elem` opts then return (piDateString old_pinf) else getDate opts- warnIfHijacking opts old_author- (new_name, new_log, mlogf) <- getLog opts (Just prior) make_log chs- let new_author = case getAuthor opts of- Just a -> a- Nothing -> piAuthor old_pinf- maybe_invert = if isInverted old_pinf then invertName else id- new_pinf <- maybe_invert `fmap` patchinfo date new_name- new_author new_log-- let newp = n2pia (adddeps (infopatch new_pinf (fromPrims newchs)) newdeps)-- return (mlogf, newp)--warnIfHijacking :: [DarcsFlag] -> String -> IO ()-warnIfHijacking opts old_author = do- author_here <- getEasyAuthor- case author_here of- Nothing -> return ()- Just ah -> let edit_author = isJust (getAuthor opts)- in if (edit_author || ah == old_author)- then return ()- else do yorn <- askUser $- "You're not "++old_author ++"! Amend anyway? "- case yorn of ('y':_) -> return ()- _ -> exitWith $ ExitSuccess--hasEditMetadata :: [DarcsFlag] -> Bool-hasEditMetadata (Author _:_) = True-hasEditMetadata (LogFile _:_) = True-hasEditMetadata (PatchName _:_) = True-hasEditMetadata (EditLongComment:_) = True-hasEditMetadata (PromptLongComment:_) = True-hasEditMetadata (AskDeps:_) = True-hasEditMetadata (_:fs) = hasEditMetadata fs-hasEditMetadata [] = False--getAuthor :: [DarcsFlag] -> Maybe String-getAuthor (Author a:_) = Just a-getAuthor (_:as) = getAuthor as-getAuthor [] = Nothing--\end{code}
+ src/Darcs/Commands/Annotate.hs view
@@ -0,0 +1,152 @@+-- Copyright (C) 2003 David Roundy, 2010-2011 Petr Rockai+--+-- 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 CPP, OverloadedStrings #-}+{-# OPTIONS_GHC -cpp #-}++module Darcs.Commands.Annotate ( annotate ) where++import Control.Monad ( when )++import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Arguments ( DarcsFlag(..), workingRepoDir,+ summary, unified, -- machineReadable,+ xmloutput, creatorhash,+ fixSubPaths,+ listRegisteredFiles,+ matchOne,+ )+import Darcs.Flags ( isUnified )+import Storage.Hashed.Plain( readPlainTree )+import Darcs.Repository.State ( readRecorded )+import Darcs.Repository ( Repository, amInHashedRepository, withRepository, RepoJob(..), readRepo )+import Darcs.Patch.Set ( newset2RL )+import Darcs.Patch ( RepoPatch, Named, patch2patchinfo, xmlSummary, invertRL )+import qualified Darcs.Patch ( summary )+import qualified Data.ByteString.Char8 as BC ( pack, concat, intercalate )+import Data.ByteString.Lazy ( toChunks )+import Darcs.PrintPatch ( printPatch, contextualPrintPatch )+import Darcs.Patch.ApplyMonad( withFilePaths )+import Darcs.Patch.FileName( fp2fn )+import System.FilePath( (</>) )+import Darcs.RepoPath( toFilePath )+import Darcs.Patch.Info ( humanFriendly, toXml, showPatchInfo )+import Darcs.Match ( matchPatch, haveNonrangeMatch, getFirstMatch, getOnePatchset, getNonrangeMatchS )+import Darcs.Lock ( withTempDir )+import Darcs.Witnesses.Sealed ( Sealed2(..), Sealed(..), seal )+import qualified Darcs.Annotate as A+import Printer ( putDocLn, Doc )++import Storage.Hashed.Tree( TreeItem(..), readBlob, list, expand )+import Storage.Hashed.Monad( findM, virtualTreeIO )+import Storage.Hashed.AnchoredPath( floatPath, anchorPath )+#include "gadts.h"+#include "impossible.h"++annotateDescription :: String+annotateDescription = "Display which patch last modified something."++annotateHelp :: String+annotateHelp =+ "The `darcs annotate' command provides two unrelated operations. When\n" +++ "called on a file, it will find the patch that last modified each line\n" +++ "in that file. When called on a patch (e.g. using --patch), it will\n" +++ "print the internal representation of that patch.\n" +++ "\n" +++ "The --summary option will result in a summarized patch annotation,\n" +++ "similar to `darcs whatsnew'. It has no effect on file annotations.\n" +++ "\n" +++ "By default, output is in a human-readable format. The --xml-output\n" +++ "option can be used to generate output for machine postprocessing.\n"++annotate :: DarcsCommand+annotate = DarcsCommand {commandProgramName = "darcs",+ commandName = "annotate",+ commandHelp = annotateHelp,+ commandDescription = annotateDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["[FILE or DIRECTORY]..."],+ commandCommand = annotateCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = listRegisteredFiles,+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [],+ commandBasicOptions = [summary,unified,+ -- machineReadable,+ xmloutput,+ matchOne, creatorhash,+ workingRepoDir]}++annotateCmd :: [DarcsFlag] -> [String] -> IO ()+annotateCmd opts files = withRepository opts (RepoJob (annotate' opts files))++annotate' ::+ (RepoPatch p) => [DarcsFlag] -> [String] -> Repository p C(r u r) -> IO ()+annotate' opts [] repository = do+ when (not $ haveNonrangeMatch opts) $+ fail $ "Annotate requires either a patch pattern or a " +++ "file or directory argument."+ Sealed2 p <- matchPatch opts `fmap` readRepo repository+ if Summary `elem` opts+ then do putDocLn $ showpi $ patch2patchinfo p+ putDocLn $ show_summary p+ else if isUnified opts+ then withTempDir "context" $ \_ ->+ do getFirstMatch repository opts+ c <- readPlainTree "."+ contextualPrintPatch c p+ else printPatch p+ where showpi | MachineReadable `elem` opts = showPatchInfo+ | XMLOutput `elem` opts = toXml+ | otherwise = humanFriendly+ show_summary :: RepoPatch p => Named p C(x y) -> Doc+ show_summary = if XMLOutput `elem` opts+ then xmlSummary+ else Darcs.Patch.summary++annotate' opts [""] repository = annotate' opts [] repository+annotate' opts args@[_] repository = do+ r <- readRepo repository+ (origpath:_) <- fixSubPaths opts args+ recorded <- readRecorded repository++ (Sealed patches, initial, path) <-+ if haveNonrangeMatch opts+ then do Sealed x <- getOnePatchset repository opts+ [path] <- return $ withFilePaths [fp2fn $ toFilePath origpath]+ (getNonrangeMatchS opts r)+ initial <- snd `fmap` virtualTreeIO (getNonrangeMatchS opts r) recorded+ return $ (seal $ newset2RL x, initial, toFilePath path)+ else return $ (seal $ newset2RL r, recorded, toFilePath origpath)++ found <- findM initial (floatPath $ toFilePath path)+ -- TODO need to decide about the --machine flag+ let fmt = {- if MachineReadable `elem` opts then A.machineFormat else -} A.format+ case found of+ Nothing -> fail $ "No such file or directory: " ++ toFilePath path+ Just (SubTree s) -> do+ s' <- expand s+ let subs = map (fp2fn . (path </>) . anchorPath "" . fst) $ list s'+ showPath (n, File _) = BC.pack (path </> n)+ showPath (n, _) = BC.concat [BC.pack (path </> n), "/"]+ putStrLn $ fmt (BC.intercalate "\n" $ map showPath $+ map (\(x,y) -> (anchorPath "" x, y)) $ list s') $+ A.annotateDirectory (invertRL patches) (fp2fn $ "./" ++ path) subs+ Just (File b) -> do con <- BC.concat `fmap` toChunks `fmap` readBlob b+ putStrLn $ fmt con $ A.annotate (invertRL patches) (fp2fn $ "./" ++ path) con+ Just (Stub _ _) -> impossible++annotate' _ _ _ = fail "annotate accepts at most one argument"
− src/Darcs/Commands/Annotate.lhs
@@ -1,416 +0,0 @@-% Copyright (C) 2003 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.--\darcsCommand{annotate}-\begin{code}-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -cpp #-}--#include "gadts.h"--module Darcs.Commands.Annotate ( annotate, createdAsXml ) where--import Control.Monad ( when )-import Data.List ( sort )--import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Arguments ( DarcsFlag(..), workingRepoDir,- summary, unified, humanReadable,- xmloutput, creatorhash,- fixSubPaths,- listRegisteredFiles,- matchOne,- )-import Darcs.Flags ( isUnified )-import Storage.Hashed.Plain( readPlainTree )-import Darcs.Repository ( Repository, amInRepository, withRepository, ($-), readRepo,- getMarkedupFile )-import Darcs.Patch.Set ( PatchSet, newset2RL )-#ifdef GADT_WITNESSES-import Darcs.Patch.Set ( Origin )-#endif-import Darcs.Patch ( RepoPatch, Named, LineMark(..), patch2patchinfo, xmlSummary )-import qualified Darcs.Patch ( summary )-import Darcs.Witnesses.Ordered ( mapRL, concatRL )-import qualified Data.ByteString.Char8 as BC ( unpack, ByteString )-import Darcs.PrintPatch ( printPatch, contextualPrintPatch )-import Darcs.Patch.Info ( PatchInfo, humanFriendly, toXml, makeFilename,- showPatchInfo )-import Darcs.PopulationData ( Population(..), PopTree(..), DirMark(..),- nameI, modifiedByI, modifiedHowI,- createdByI, creationNameI,- )-import Darcs.Population ( getRepoPopVersion, lookupPop, lookupCreationPop,- modifiedToXml,- )-import Darcs.Hopefully ( info )-import Darcs.RepoPath ( SubPath, toFilePath )-import Darcs.Match ( matchPatch, haveNonrangeMatch, getFirstMatch )-import Darcs.Lock ( withTempDir )-import Darcs.Witnesses.Sealed ( Sealed2(..), unseal2 )-import Printer ( putDocLn, text, errorDoc, ($$), prefix, (<+>),- Doc, empty, vcat, (<>), renderString, packedString )-#include "impossible.h"--annotateDescription :: String-annotateDescription = "Display which patch last modified something."--annotateHelp :: String-annotateHelp =- "The `darcs annotate' command provides two unrelated operations. When\n" ++- "called on a file, it will find the patch that last modified each line\n" ++- "in that file. When called on a patch (e.g. using --patch), it will\n" ++- "print the internal representation of that patch.\n" ++- "\n" ++- "The --summary option will result in a summarized patch annotation,\n" ++- "similar to `darcs whatsnew'. It has no effect on file annotations.\n" ++- "\n" ++- "By default, output is in a human-readable format. The --xml-output\n" ++- "option can be used to generate output for machine postprocessing.\n"--annotate :: DarcsCommand-annotate = DarcsCommand {commandName = "annotate",- commandHelp = annotateHelp,- commandDescription = annotateDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["[FILE or DIRECTORY]..."],- commandCommand = annotateCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = listRegisteredFiles,- commandArgdefaults = nodefaults,- commandAdvancedOptions = [],- commandBasicOptions = [summary,unified,- humanReadable,- xmloutput,- matchOne, creatorhash,- workingRepoDir]}--\end{code}-%% FIXME: AFAICT -u does nothing. Remove it from anno's options?-%% --twb, 2009-09-20-Giving the \verb!--unified! flag implies \verb!--human-readable!, and causes-the output to remain in a darcs-specific format that is similar to that produced-by \verb!diff --unified!.-\begin{code}-annotateCmd :: [DarcsFlag] -> [String] -> IO ()-annotateCmd opts [] = withRepository opts $- \repository -> do- when (not $ haveNonrangeMatch opts) $- fail $ "Annotate requires either a patch pattern or a " ++- "file or directory argument."- Sealed2 p <- matchPatch opts `fmap` readRepo repository- if Summary `elem` opts- then do putDocLn $ showpi $ patch2patchinfo p- putDocLn $ show_summary p- else if isUnified opts- then withTempDir "context" $ \_ ->- do getFirstMatch repository opts- c <- readPlainTree "."- contextualPrintPatch c p- else printPatch p- where showpi | MachineReadable `elem` opts = showPatchInfo- | XMLOutput `elem` opts = toXml- | otherwise = humanFriendly- show_summary :: RepoPatch p => Named p C(x y) -> Doc- show_summary = if XMLOutput `elem` opts- then xmlSummary- else Darcs.Patch.summary--annotateCmd opts [""] = annotateCmd opts []-\end{code}--If a directory name is given, annotate will output details of the last-modifying patch for each file in the directory and the directory itself. The-details look like this:--\begin{verbatim}- # Created by [bounce handling patch- # mark**20040526202216] as ./test/m7/bounce_handling.pl- bounce_handling.pl-\end{verbatim}--If a patch name and a directory are given, these details are output for the time after-that patch was applied. If a directory and a tag name are given, the-details of the patches involved in the specified tagged version will be output.-\begin{code}-annotateCmd opts [file] = withRepository opts $- \repository -> do- r <- readRepo repository- fixed_args <- fixSubPaths opts [file]- (rel_file_or_directory:_) <- case fixed_args of- [] -> fail ("The supplied path " ++ file ++ " is not usable")- fs -> return fs- let file_or_directory = rel_file_or_directory- pinfo <- if haveNonrangeMatch opts- then return $ patch2patchinfo `unseal2` (matchPatch opts r)- else case mapRL info $ newset2RL r of- [] -> fail "Annotate does not currently work correctly on empty repositories."- (x:_) -> return x- pop <- getRepoPopVersion "." pinfo-- -- deal with --creator-hash option- let maybe_creation_pi = findCreationPatchinfo opts r- lookup_thing = case maybe_creation_pi of- Nothing -> lookupPop- Just cp -> lookupCreationPop cp- if toFilePath file_or_directory == "." || toFilePath file_or_directory == ""- then case pop of (Pop _ pt) -> annotatePop opts pinfo pt- else case lookup_thing (toFilePath file_or_directory) pop of- Nothing -> fail $ "There is no file or directory named '"++- toFilePath file_or_directory++"'"- Just (Pop _ pt@(PopDir i _))- | modifiedHowI i == RemovedDir && modifiedByI i /= pinfo ->- errorDoc $ text ("The directory '" ++ toFilePath rel_file_or_directory ++- "' was removed by")- $$ humanFriendly (modifiedByI i)- | otherwise -> annotatePop opts pinfo pt- Just (Pop _ pt@(PopFile i))- | modifiedHowI i == RemovedFile && modifiedByI i /= pinfo ->- errorDoc $ text ("The file '" ++ toFilePath rel_file_or_directory ++- "' was removed by")- $$ humanFriendly (modifiedByI i)- | otherwise -> annotateFile repository opts pinfo file_or_directory pt--annotateCmd _ _ = fail "annotate accepts at most one argument"--annotatePop :: [DarcsFlag] -> PatchInfo -> PopTree -> IO ()-annotatePop opts pinfo pt = putDocLn $ p2format pinfo pt- where p2format = if XMLOutput `elem` opts- then p2xml- else p2s--indent :: Doc -> [Doc]--- This is a bit nasty:-indent = map (text . i) . lines . renderString- where i "" = ""- i ('#':s) = ('#':s)- i s = " "++s---- Annotate a directory listing-p2s :: PatchInfo -> PopTree -> Doc-p2s pinfo (PopFile inf) =- created_str- $$ f <+> file_change- where f = packedString $ nameI inf- file_created = text "Created by"- <+> showPatchInfo (fromJust $ createdByI inf)- <+> text "as"- <+> packedString (fromJust $ creationNameI inf)- created_str = prefix "# " file_created- file_change = if modifiedByI inf == pinfo- then text $ show (modifiedHowI inf)- else empty-p2s pinfo (PopDir inf pops) =- created_str- $$ dir <+> dir_change- $$ vcat (map (vcat . indent . p2s pinfo) $ sort pops)- where dir = packedString (nameI inf) <> text "/"- dir_created =- if createdByI inf /= Nothing- then text "Created by "- <+> showPatchInfo (fromJust $ createdByI inf)- <+> text "as"- <+> packedString (fromJust $ creationNameI inf) <> text "/"- else text "Root directory"- created_str = prefix "# " dir_created- dir_change = if modifiedByI inf == pinfo- then text $ show (modifiedHowI inf)- else empty--escapeXML :: String -> Doc-escapeXML = text . strReplace '\'' "'" . strReplace '"' """ .- strReplace '>' ">" . strReplace '<' "<" . strReplace '&' "&"--strReplace :: Char -> String -> String -> String-strReplace _ _ [] = []-strReplace x y (z:zs)- | x == z = y ++ (strReplace x y zs)- | otherwise = z : (strReplace x y zs)--createdAsXml :: PatchInfo -> String -> Doc-createdAsXml pinfo as = text "<created_as original_name='"- <> escapeXML as- <> text "'>"- $$ toXml pinfo- $$ text "</created_as>"---removed_by_xml :: PatchInfo -> String---removed_by_xml pinfo = "<removed_by>\n"++toXml pinfo++"</removed_by>\n"--p2xmlOpen :: PatchInfo -> PopTree -> Doc-p2xmlOpen _ (PopFile inf) =- text "<file name='" <> escapeXML f <> text "'>"- $$ created- $$ modified- where f = BC.unpack $ nameI inf- created = case createdByI inf of- Nothing -> empty- Just ci -> createdAsXml ci- (BC.unpack $ fromJust $ creationNameI inf)- modified = modifiedToXml inf-p2xmlOpen _ (PopDir inf _) =- text "<directory name='" <> escapeXML f <> text "'>"- $$ created- $$ modified- where f = BC.unpack $ nameI inf- created = case createdByI inf of- Nothing -> empty- Just ci -> createdAsXml ci- (BC.unpack $ fromJust $ creationNameI inf)- modified = modifiedToXml inf--p2xmlClose :: PatchInfo -> PopTree -> Doc-p2xmlClose _(PopFile _) = text "</file>"-p2xmlClose _ (PopDir _ _) = text "</directory>"--p2xml :: PatchInfo -> PopTree -> Doc-p2xml pinf p@(PopFile _) = p2xmlOpen pinf p $$ p2xmlClose pinf p-p2xml pinf p@(PopDir _ pops) = p2xmlOpen pinf p- $$ vcat (map (p2xml pinf) $ sort pops)- $$ p2xmlClose pinf p-\end{code}--If a file name is given, the last modifying patch details of that file will be output, along-with markup indicating patch details when each line was last (and perhaps next) modified.--If a patch name and a file name are given, these details are output for the time after-that patch was applied.--\begin{code}-annotateFile :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> PatchInfo -> SubPath -> PopTree -> IO ()-annotateFile repository opts pinfo f (PopFile inf) = do- if XMLOutput `elem` opts- then putDocLn $ p2xmlOpen pinfo (PopFile inf)- else if createdByI inf /= Nothing- then putAnn $ text ("File "++toFilePath f++" created by ")- <> showPatchInfo ci <> text (" as " ++ createdname)- else putAnn $ text $ "File "++toFilePath f- mk <- getMarkedupFile repository ci createdname- old_pis <- (dropWhile (/= pinfo).mapRL info.newset2RL) `fmap` readRepo repository- mapM_ (annotateMarkedup opts pinfo old_pis) mk- when (XMLOutput `elem` opts) $ putDocLn $ p2xmlClose pinfo (PopFile inf)- where ci = fromJust $ createdByI inf- createdname = BC.unpack $ fromJust $ creationNameI inf-annotateFile _ _ _ _ _ = impossible--annotateMarkedup :: [DarcsFlag] -> PatchInfo -> [PatchInfo]- -> (BC.ByteString, LineMark) -> IO ()-annotateMarkedup opts | XMLOutput `elem` opts = xmlMarkedup- | otherwise = textMarkedup--textMarkedup :: PatchInfo -> [PatchInfo] -> (BC.ByteString, LineMark) -> IO ()-textMarkedup _ _ (l,None) = putLine ' ' l-textMarkedup pinfo old_pis (l,RemovedLine wheni)- | wheni == pinfo = putLine '-' l- | wheni `elem` old_pis = return ()- | otherwise = putLine ' ' l-textMarkedup pinfo old_pis (l,AddedLine wheni)- | wheni == pinfo = putLine '+' l- | wheni `elem` old_pis = do putAnn $ text "Following line added by "- <> showPatchInfo wheni- putLine ' ' l- | otherwise = return ()-textMarkedup pinfo old_pis (l,AddedRemovedLine whenadd whenrem)- | whenadd == pinfo = do putAnn $ text "Following line removed by "- <> showPatchInfo whenrem- putLine '+' l- | whenrem == pinfo = do putAnn $ text "Following line added by "- <> showPatchInfo whenadd- putLine '-' l- | whenadd `elem` old_pis && not (whenrem `elem` old_pis) =- do putAnn $ text "Following line removed by " <> showPatchInfo whenrem- putAnn $ text "Following line added by " <> showPatchInfo whenadd- putLine ' ' l- | otherwise = return ()--putLine :: Char -> BC.ByteString -> IO ()-putLine c s = putStrLn $ c : BC.unpack s-putAnn :: Doc -> IO ()-putAnn s = putDocLn $ prefix "# " s--xmlMarkedup :: PatchInfo -> [PatchInfo] -> (BC.ByteString, LineMark) -> IO ()-xmlMarkedup _ _ (l,None) = putLine ' ' l-xmlMarkedup pinfo old_pis (l,RemovedLine wheni)- | wheni == pinfo = putDocLn $ text "<removed_line>"- $$ escapeXML (BC.unpack l)- $$ text "</removed_line>"- | wheni `elem` old_pis = return ()- | otherwise = putDocLn $ text "<normal_line>"- $$ text "<removed_by>"- $$ toXml wheni- $$ text "</removed_by>"- $$ escapeXML (BC.unpack l)- $$ text "</normal_line>"-xmlMarkedup pinfo old_pis (l,AddedLine wheni)- | wheni == pinfo = putDocLn $ text "<added_line>"- $$ escapeXML (BC.unpack l)- $$ text "</added_line>"- | wheni `elem` old_pis = putDocLn $ text "<normal_line>"- $$ text "<added_by>"- $$ toXml wheni- $$ text "</added_by>"- $$ escapeXML (BC.unpack l)- $$ text "</normal_line>"- | otherwise = return ()-xmlMarkedup pinfo old_pis (l,AddedRemovedLine whenadd whenrem)- | whenadd == pinfo =- putDocLn $ text "<added_line>"- $$ text "<removed_by>"- $$ toXml whenrem- $$ text "</removed_by>"- $$ escapeXML (BC.unpack l)- $$ text "</added_line>"- | whenrem == pinfo =- putDocLn $ text "<removed_line>"- $$ text "<added_by>"- $$ toXml whenadd- $$ text "</added_by>"- $$ escapeXML (BC.unpack l)- $$ text "</removed_line>"- | whenadd `elem` old_pis && not (whenrem `elem` old_pis) =- putDocLn $ text "<normal_line>"- $$ text "<removed_by>"- $$ toXml whenrem- $$ text "</removed_by>"- $$ text "<added_by>"- $$ toXml whenadd- $$ text "</added_by>"- $$ escapeXML (BC.unpack l)- $$ text "</normal_line>"- | otherwise = return ()-\end{code}--\begin{options}---creator-hash HASH-\end{options}--The \verb!--creator-hash! option should only be used in combination with a-file or directory to be annotated. In this case, the name of that file or-directory is interpreted to be its name \emph{at the time it was created},-and the hash given along with \verb!--creator-hash! indicates the patch-that created the file or directory. This allows you to (relatively) easily-examine a file even if it has been renamed multiple times.--\begin{code}-findCreationPatchinfo :: [DarcsFlag] -> PatchSet p C(Origin x) -> Maybe PatchInfo-findCreationPatchinfo [] _ = Nothing-findCreationPatchinfo (CreatorHash h:_) r = findHash h $ mapRL info $ newset2RL r-findCreationPatchinfo (_:fs) r = findCreationPatchinfo fs r--findHash :: String -> [PatchInfo] -> Maybe PatchInfo-findHash _ [] = Nothing-findHash h (pinf:pinfs)- | take (length h) (makeFilename pinf) == h = Just pinf- | otherwise = findHash h pinfs-\end{code}
+ src/Darcs/Commands/Apply.hs view
@@ -0,0 +1,365 @@+-- Copyright (C) 2003-2005 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.++{-# LANGUAGE CPP, PatternGuards #-}++module Darcs.Commands.Apply ( apply ) where+import System.Exit ( ExitCode(..), exitWith )+import Prelude hiding ( catch )+import System.IO ( hClose, stdout, stderr )+import Control.Exception.Extensible+ ( catch, fromException, SomeException, throwIO )+import Control.Monad ( when )++import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, hopefullyM, info )+import Darcs.SignalHandler ( withSignalsBlocked )+import Darcs.Commands ( DarcsCommand(..), putVerbose )+import Darcs.CommandsAux ( checkPaths )+import Darcs.Arguments ( DarcsFlag( Reply, Interactive, All),+ matchSeveral,+ setEnvDarcsPatches,+ getCc, workingRepoDir,+ notest, nocompress, applyConflictOptions,+ useExternalMerge,+ ignoretimes, getSendmailCmd,+ reply, verify, listFiles,+ fixFilePathOrStd, umaskOption,+ allInteractive, sendmailCmd,+ leaveTestDir, happyForwarding,+ dryRun, printDryRunMessageAndExit,+ setScriptsExecutableOption, restrictPaths,+ changesReverse, makeScriptsExecutable+ )+import Darcs.Flags(doHappyForwarding, doReverse, isInteractive)++import qualified Darcs.Arguments as DarcsArguments ( ccApply )+import Darcs.RepoPath ( toFilePath, useAbsoluteOrStd )+import Darcs.Repository ( Repository, SealedPatchSet, withRepoLock, RepoJob(..), amInHashedRepository,+ tentativelyMergePatches,+ readRepo,+ finalizeRepositoryChanges,+ testTentative,+ applyToWorking, invalidateIndex+ )+#ifdef GADT_WITNESSES+import Darcs.Patch.Set ( Origin )+#endif+import Darcs.Patch.Set ( newset2RL )+import Darcs.Patch ( RepoPatch, description )+import Darcs.Patch.Info ( PatchInfo, humanFriendly )+import Darcs.Utils ( PromptConfig(..), promptChar )+import Darcs.Witnesses.Ordered ( FL, RL(..), (:\/:)(..), (:>)(..),+ mapFL, mapRL, nullFL, reverseFL )+import ByteStringUtils ( linesPS, unlinesPS, gzReadFilePS, gzReadStdin )+import Data.List( (\\) )+import qualified Data.ByteString as B (ByteString, null, init, take, drop)+import qualified Data.ByteString.Char8 as BC (unpack, last, pack)++import Darcs.External ( sendEmail, sendEmailDoc, resendEmail,+ verifyPS )+import Darcs.Email ( readEmail )+import Darcs.Lock ( withStdoutTemp, readBinFile )+import Darcs.Patch.Depends ( findUncommon, findCommonWithThem )+import Darcs.SelectChanges ( selectChanges, WhichChanges(..),+ runSelection, selectionContext,+ filterOutConflicts )+import Darcs.Patch.Bundle ( scanBundle )+import Darcs.Witnesses.Sealed ( Sealed(Sealed) )+import Printer ( packedString, vcat, text, empty, renderString )++#include "impossible.h"++#include "gadts.h"++applyDescription :: String+applyDescription = "Apply a patch bundle created by `darcs send'."++applyHelp :: String+applyHelp =+ "The `darcs apply' command takes a patch bundle and attempts to insert\n" +++ "it into the current repository. In addition to invoking it directly\n" +++ "on bundles created by `darcs send', it is used internally by `darcs\n" +++ "push' and `darcs put' on the remote end of an SSH connection.\n" +++ "\n" +++ "If no file is supplied, the bundle is read from standard input.\n" +++ "\n" +++ "If given an email instead of a patch bundle, Darcs will look for the\n" +++ "bundle as a MIME attachment to that email. Currently this will fail\n" +++ "if the MIME boundary is rewritten, such as in Courier and Mail.app.\n" +++ "\n" +++ "If the `--reply noreply@example.net' option is used, and the bundle is\n" +++ "attached to an email, Darcs will send a report (indicating success or\n" +++ "failure) to the sender of the bundle (the To field). The argument to\n" +++ "noreply is the address the report will appear to originate FROM.\n" +++ "\n" +++ "The --cc option will cause the report to be CC'd to another address,\n" +++ "for example `--cc reports@lists.example.net,admin@lists.example.net'.\n" +++ "Using --cc without --reply is undefined.\n" +++ "\n" +++ "If gpg(1) is installed, you can use `--verify pubring.gpg' to reject\n" +++ "bundles that aren't signed by a key in pubring.gpg.\n" +++ "\n" +++ "If --test is supplied and a test is defined (see `darcs setpref'), the\n" +++ "bundle will be rejected if the test fails after applying it. In that\n" +++ "case, the rejection email from --reply will include the test output.\n"++stdindefault :: a -> [String] -> IO [String]+stdindefault _ [] = return ["-"]+stdindefault _ x = return x+apply :: DarcsCommand+apply = DarcsCommand {commandProgramName = "darcs",+ commandName = "apply",+ commandHelp = applyHelp ++ "\n" ++ applyHelp',+ commandDescription = applyDescription,+ commandExtraArgs = 1,+ commandExtraArgHelp = ["<PATCHFILE>"],+ commandCommand = applyCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = listFiles,+ commandArgdefaults = const stdindefault,+ commandAdvancedOptions = [reply, DarcsArguments.ccApply,+ happyForwarding,+ sendmailCmd,+ ignoretimes, nocompress,+ setScriptsExecutableOption, umaskOption,+ restrictPaths, changesReverse],+ commandBasicOptions = [verify,+ allInteractive]++dryRun+++ [matchSeveral,+ applyConflictOptions,+ useExternalMerge,+ notest,+ leaveTestDir,+ workingRepoDir]}++applyCmd :: [DarcsFlag] -> [String] -> IO ()+applyCmd _ [""] = fail "Empty filename argument given to apply!"+applyCmd opts [unfixed_patchesfile] = withRepoLock opts $ RepoJob $ \repository -> do+ when (unfixed_patchesfile == "-") $ do + -- for darcs users who try out 'darcs apply' without any arguments+ putVerbose opts $ text "reading patch bundle from stdin..."+ patchesfile <- fixFilePathOrStd opts unfixed_patchesfile+ ps <- useAbsoluteOrStd (gzReadFilePS . toFilePath) gzReadStdin patchesfile+ let from_whom = getFrom ps+ us <- readRepo repository+ either_them <- getPatchBundle opts ps+ Sealed them+ <- case either_them of+ Right t -> return t+ Left er -> do forwarded <- considerForwarding opts ps+ if forwarded+ then exitWith ExitSuccess+ else fail er+ common :> _ <- return $ findCommonWithThem us them++ -- all patches that are in "them" and not in "common" need to be available; check that+ let common_i = mapRL info $ newset2RL common+ them_i = mapRL info $ newset2RL them+ required = them_i \\ common_i -- FIXME quadratic?+ check :: RL (PatchInfoAnd p) C(x y) -> [PatchInfo] -> IO ()+ check (p :<: ps') bad = case hopefullyM p of+ Nothing | info p `elem` required -> check ps' (info p : bad)+ _ -> check ps' bad+ check NilRL [] = return ()+ check NilRL bad = fail . renderString $ vcat $ map humanFriendly bad +++ [ text "\nFATAL: Cannot apply this bundle. We are missing the above patches." ]++ check (newset2RL them) []++ (us':\/:them') <- return $ findUncommon us them+ (hadConflicts, Sealed their_ps) <- filterOutConflicts opts (reverseFL us') repository them'+ when hadConflicts $ putStrLn "Skipping some patches which would cause conflicts."+ when (nullFL their_ps) $+ do putStr $ "All these patches have already been applied. " +++ "Nothing to do.\n"+ exitWith ExitSuccess+ let context = selectionContext "apply" fixed_opts Nothing Nothing+ selector = selectChanges $ if doReverse opts+ then FirstReversed+ else First+ (to_be_applied :> _) <- runSelection (selector their_ps) context+ applyItNow opts from_whom repository us' to_be_applied+ where fixed_opts = if Interactive `elem` opts+ then opts+ else All : opts+applyCmd _ _ = impossible++applyItNow :: FORALL(p r u t x z) RepoPatch p =>+ [DarcsFlag] -> String -> Repository p C(r u t)+ -> FL (PatchInfoAnd p) C(x t) -> FL (PatchInfoAnd p) C(x z) -> IO ()+applyItNow opts from_whom repository us' to_be_applied = do+ printDryRunMessageAndExit "apply" opts to_be_applied+ when (nullFL to_be_applied) $+ do putStrLn "You don't want to apply any patches, so I'm exiting!"+ exitWith ExitSuccess+ checkPaths opts to_be_applied+ redirectOutput opts from_whom $ do+ putVerbose opts $ text "Will apply the following patches:"+ putVerbose opts . vcat $ mapFL description to_be_applied+ setEnvDarcsPatches to_be_applied+ Sealed pw <- tentativelyMergePatches repository "apply" opts us' to_be_applied+ invalidateIndex repository+ rc <- testTentative repository+ when (rc /= ExitSuccess) $ do+ when (not $ isInteractive opts) $ exitWith rc+ putStrLn $ "Looks like those patches do not pass the tests."+ let prompt = "Shall I apply them anyway?"+ yn <- promptChar (PromptConfig prompt "yn" [] (Just 'n') [])+ case yn of+ 'y' -> return ()+ _ -> exitWith rc+ withSignalsBlocked $ do finalizeRepositoryChanges repository+ _ <- applyToWorking repository opts pw `catch` \(e :: SomeException) ->+ fail ("Error applying patch to working dir:\n" ++ show e)+ makeScriptsExecutable opts pw+ return ()+ putStrLn "Finished applying..."++getPatchBundle :: RepoPatch p => [DarcsFlag] -> B.ByteString+ -> IO (Either String (SealedPatchSet p C(Origin)))+getPatchBundle opts fps = do+ mps <- verifyPS opts $ readEmail fps+ mops <- verifyPS opts fps+ case (mps, mops) of+ (Nothing, Nothing) ->+ return $ Left "Patch bundle not properly signed, or gpg failed."+ (Just ps, Nothing) -> return $ scanBundle ps+ (Nothing, Just ps) -> return $ scanBundle ps+ -- We use careful_scan_bundle only below because in either of the two+ -- above case we know the patch was signed, so it really shouldn't+ -- need stripping of CRs.+ (Just ps1, Just ps2) -> case careful_scan_bundle ps1 of+ Left _ -> return $ careful_scan_bundle ps2+ Right x -> return $ Right x+ where careful_scan_bundle ps =+ case scanBundle ps of+ Left e -> case scanBundle $ stripCrPS ps of+ Right x -> Right x+ _ -> Left e+ x -> x+ stripCrPS :: B.ByteString -> B.ByteString+ stripCrPS ps = unlinesPS $ map stripline $ linesPS ps+ stripline p | B.null p = p+ | BC.last p == '\r' = B.init p+ | otherwise = p++applyHelp' :: String+applyHelp' =+ "A patch bundle may introduce unresolved conflicts with existing\n" +++ "patches or with the working tree. By default, Darcs will add conflict\n" +++ "markers (see `darcs mark-conflicts').\n" +++ "\n" +++ "The --allow-conflicts option will skip conflict marking; this is\n" +++ "useful when you want to treat a repository as just a bunch of patches,\n" +++ "such as using `darcs pull --union' to download of your co-workers\n" +++ "patches before going offline.\n" +++ "\n" +++ "This can mess up unrecorded changes in the working tree, forcing you\n" +++ "to resolve the conflict immediately. To simply reject bundles that\n" +++ "introduce unresolved conflicts, using the --dont-allow-conflicts\n" +++ "option. Making this the default in push-based workflows is strongly\n" +++ "recommended.\n" +++ "\n" +++ "Unlike most Darcs commands, `darcs apply' defaults to --all. Use the\n" +++ "--interactive option to pick which patches to apply from a bundle.\n"++getFrom :: B.ByteString -> String+getFrom ps = readFrom $ linesPS ps+ where readFrom [] = ""+ readFrom (x:xs)+ | B.take 5 x == fromStart = BC.unpack $ B.drop 5 x+ | otherwise = readFrom xs++redirectOutput :: forall a . [DarcsFlag] -> String -> IO a -> IO a+redirectOutput opts to doit = ro opts+ where+ cc = getCc opts+ ro [] = doit+ ro (Reply f:_) =+ withStdoutTemp $ \tempf-> do {a <- doit;+ hClose stdout;+ hClose stderr;+ return a;+ } `catch` (sendit tempf)+ where sendit :: FilePath -> SomeException -> IO a+ sendit tempf e | Just ExitSuccess <- fromException e =+ do sendSanitizedEmail opts f to "Patch applied" cc tempf+ throwIO e+ sendit tempf e | Just (_ :: ExitCode) <- fromException e =+ do sendSanitizedEmail opts f to "Patch failed!" cc tempf+ throwIO ExitSuccess+ sendit tempf e =+ do sendSanitizedEmail opts f to "Darcs error applying patch!" cc $+ tempf ++ "\n\nCaught exception:\n"+++ show e++"\n"+ throwIO ExitSuccess+ ro (_:fs) = ro fs++-- |sendSanitizedEmail sends a sanitized email using the given sendmailcmd+-- It takes @DacrsFlag@ options a file with the mail contents,+-- To:, Subject:, CC:, and mail body+sendSanitizedEmail :: [DarcsFlag] -> String -> String -> String -> String -> String -> IO ()+sendSanitizedEmail opts file to subject cc mailtext =+ do scmd <- getSendmailCmd opts+ body <- sanitizeFile mailtext+ sendEmail file to subject cc scmd body++-- sanitizeFile is used to clean up the stdout/stderr before sticking it in+-- an email.++sanitizeFile :: FilePath -> IO String+sanitizeFile f = sanitize `fmap` readBinFile f+ where sanitize s = wash $ remove_backspaces "" s+ wash ('\000':s) = "\\NUL" ++ wash s+ wash ('\026':s) = "\\EOF" ++ wash s+ wash (c:cs) = c : wash cs+ wash [] = []+ remove_backspaces rev_sofar "" = reverse rev_sofar+ remove_backspaces (_:rs) ('\008':s) = remove_backspaces rs s+ remove_backspaces "" ('\008':s) = remove_backspaces "" s+ remove_backspaces rs (s:ss) = remove_backspaces (s:rs) ss++forwardingMessage :: B.ByteString+forwardingMessage = BC.pack $+ "The following patch was either unsigned, or signed by a non-allowed\n"+++ "key, or there was a GPG failure.\n"++considerForwarding :: [DarcsFlag] -> B.ByteString -> IO Bool+considerForwarding opts m = cf opts (getCc opts)+ where cf [] _ = return False+ cf (Reply t:_) cc =+ case break is_from (linesPS m) of+ (m1, f:m2) ->+ let m_lines = forwardingMessage:m1 ++ m2+ m' = unlinesPS m_lines+ f' = BC.unpack (B.drop 5 f) in+ if t == f' || t == init f'+ then return False -- Refuse possible email loop.+ else do+ scmd <- getSendmailCmd opts+ if doHappyForwarding opts+ then resendEmail t scmd m+ else sendEmailDoc f' t "A forwarded darcs patch" cc+ scmd (Just (empty,empty))+ (packedString m')+ return True+ _ -> return False -- Don't forward emails lacking headers!+ cf (_:fs) cc = cf fs cc+ is_from l = B.take 5 l == fromStart++fromStart :: B.ByteString+fromStart = BC.pack "From:"
− src/Darcs/Commands/Apply.lhs
@@ -1,392 +0,0 @@-% Copyright (C) 2003-2005 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.--\darcsCommand{apply}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP, PatternGuards #-}--module Darcs.Commands.Apply ( apply ) where-import System.Exit ( ExitCode(..), exitWith )-import Prelude hiding ( catch )-import System.IO ( hClose, stdout, stderr )-import Control.Exception.Extensible- ( catch, fromException, SomeException, throwIO )-import Control.Monad ( when )--import Darcs.Hopefully ( PatchInfoAnd, n2pia, conscientiously, hopefullyM, info )-import Darcs.SignalHandler ( withSignalsBlocked )-import Darcs.Commands ( DarcsCommand(..), putVerbose )-import Darcs.CommandsAux ( checkPaths )-import Darcs.Arguments ( DarcsFlag( Reply, Interactive, All),- matchSeveral,- definePatches,- getCc, workingRepoDir,- notest, nocompress, applyConflictOptions,- useExternalMerge,- ignoretimes, getSendmailCmd,- reply, verify, listFiles,- fixFilePathOrStd, umaskOption,- allInteractive, sendmailCmd,- leaveTestDir, happyForwarding,- dryRun, printDryRunMessageAndExit,- setScriptsExecutableOption, restrictPaths,- changesReverse- )-import Darcs.Flags(doHappyForwarding, doReverse)--import qualified Darcs.Arguments as DarcsArguments ( ccApply )-import Darcs.RepoPath ( toFilePath, useAbsoluteOrStd )-import Darcs.Repository ( Repository, SealedPatchSet, withRepoLock, ($-), amInRepository,- tentativelyMergePatches,- readRepo,- finalizeRepositoryChanges,- applyToWorking, invalidateIndex- )-#ifdef GADT_WITNESSES-import Darcs.Patch.Set ( Origin )-#endif-import Darcs.Patch.Set ( newset2RL )-import Darcs.Patch ( RepoPatch, description )-import Darcs.Patch.Info ( PatchInfo, humanFriendly )-import Darcs.Witnesses.Ordered ( FL, RL(..), (:\/:)(..), (:>)(..), (:>>)(..),- mapFL, mapRL, nullFL, mapFL_FL, reverseFL )-import ByteStringUtils ( linesPS, unlinesPS, gzReadFilePS, gzReadStdin )-import Data.List( (\\) )-import qualified Data.ByteString as B (ByteString, null, init, take, drop)-import qualified Data.ByteString.Char8 as BC (unpack, last, pack)--import Darcs.External ( sendEmail, sendEmailDoc, resendEmail,- verifyPS )-import Darcs.Email ( readEmail )-import Darcs.Lock ( withStdoutTemp, readBinFile )-import Darcs.Patch.Depends ( findUncommon, findCommonWithThem )-import Darcs.SelectChanges ( selectChanges, WhichChanges(..),- runSelection, selectionContext,- filterOutConflicts )-import Darcs.Patch.Bundle ( scanBundle )-import Darcs.Witnesses.Sealed ( Sealed(Sealed) )-import Printer ( packedString, vcat, text, ($$), empty, renderString )--#include "impossible.h"--#include "gadts.h"--applyDescription :: String-applyDescription = "Apply a patch bundle created by `darcs send'."--applyHelp :: String-applyHelp =- "The `darcs apply' command takes a patch bundle and attempts to insert\n" ++- "it into the current repository. In addition to invoking it directly\n" ++- "on bundles created by `darcs send', it is used internally by `darcs\n" ++- "push' and `darcs put' on the remote end of an SSH connection.\n" ++- "\n" ++- "If no file is supplied, the bundle is read from standard input.\n" ++- "\n" ++- "If given an email instead of a patch bundle, Darcs will look for the\n" ++- "bundle as a MIME attachment to that email. Currently this will fail\n" ++- "if the MIME boundary is rewritten, such as in Courier and Mail.app.\n" ++- "\n" ++- "If the `--reply noreply@example.net' option is used, and the bundle is\n" ++- "attached to an email, Darcs will send a report (indicating success or\n" ++- "failure) to the sender of the bundle (the To field). The argument to\n" ++- "noreply is the address the report will appear to originate FROM.\n" ++- "\n" ++- "The --cc option will cause the report to be CC'd to another address,\n" ++- "for example `--cc reports@lists.example.net,admin@lists.example.net'.\n" ++- "Using --cc without --reply is undefined.\n" ++- "\n" ++- "If gpg(1) is installed, you can use `--verify pubring.gpg' to reject\n" ++- "bundles that aren't signed by a key in pubring.gpg.\n" ++- "\n" ++- "If --test is supplied and a test is defined (see `darcs setpref'), the\n" ++- "bundle will be rejected if the test fails after applying it. In that\n" ++- "case, the rejection email from --reply will include the test output.\n"--stdindefault :: a -> [String] -> IO [String]-stdindefault _ [] = return ["-"]-stdindefault _ x = return x-apply :: DarcsCommand-apply = DarcsCommand {commandName = "apply",- commandHelp = applyHelp ++ "\n" ++ applyHelp',- commandDescription = applyDescription,- commandExtraArgs = 1,- commandExtraArgHelp = ["<PATCHFILE>"],- commandCommand = applyCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = listFiles,- commandArgdefaults = const stdindefault,- commandAdvancedOptions = [reply, DarcsArguments.ccApply,- happyForwarding,- sendmailCmd,- ignoretimes, nocompress,- setScriptsExecutableOption, umaskOption,- restrictPaths, changesReverse],- commandBasicOptions = [verify,- allInteractive]++dryRun++- [matchSeveral,- applyConflictOptions,- useExternalMerge,- notest,- leaveTestDir,- workingRepoDir]}--applyCmd :: [DarcsFlag] -> [String] -> IO ()-applyCmd _ [""] = fail "Empty filename argument given to apply!"-applyCmd opts [unfixed_patchesfile] = withRepoLock opts $- \repository -> do- patchesfile <- fixFilePathOrStd opts unfixed_patchesfile- ps <- useAbsoluteOrStd (gzReadFilePS . toFilePath) gzReadStdin patchesfile- let from_whom = getFrom ps- us <- readRepo repository- either_them <- getPatchBundle opts ps- Sealed them- <- case either_them of- Right t -> return t- Left er -> do forwarded <- considerForwarding opts ps- if forwarded- then exitWith ExitSuccess- else fail er- common :>> ours <- return $ findCommonWithThem us them-- -- all patches that are in "them" and not in "common" need to be available; check that- let common_i = mapRL info $ newset2RL common- them_i = mapRL info $ newset2RL them- required = them_i \\ common_i -- FIXME quadratic?- check :: RL (PatchInfoAnd p) C(x y) -> [PatchInfo] -> IO ()- check (p :<: ps) bad = case hopefullyM p of- Nothing | info p `elem` required -> check ps (info p : bad)- _ -> check ps bad- check NilRL [] = return ()- check NilRL bad = fail . renderString $ vcat $ map humanFriendly bad ++- [ text "\nFATAL: Cannot apply this bundle. We are missing the above patches." ]-- check (newset2RL them) []-- (us':\/:them') <- return $ findUncommon us them- (hadConflicts, Sealed their_ps) <- filterOutConflicts opts (reverseFL us') repository them'- when hadConflicts $ putStrLn "Skipping some patches which would cause conflicts."- when (nullFL their_ps) $- do putStr $ "All these patches have already been applied. " ++- "Nothing to do.\n"- exitWith ExitSuccess- let context = selectionContext "apply" fixed_opts Nothing []- selector = if doReverse opts- then selectChanges FirstReversed- else selectChanges First- (to_be_applied :> _) <- runSelection (selector their_ps) context- applyItNow opts from_whom repository us' to_be_applied- where fixed_opts = if Interactive `elem` opts- then opts- else All : opts-applyCmd _ _ = impossible--applyItNow :: FORALL(p r u t x y z) RepoPatch p =>- [DarcsFlag] -> String -> Repository p C(r u t)- -> FL (PatchInfoAnd p) C(x t) -> FL (PatchInfoAnd p) C(x z) -> IO ()-applyItNow opts from_whom repository us' to_be_applied = do- printDryRunMessageAndExit "apply" opts to_be_applied- when (nullFL to_be_applied) $- do putStrLn "You don't want to apply any patches, so I'm exiting!"- exitWith ExitSuccess- checkPaths opts to_be_applied- redirectOutput opts from_whom $ do- putVerbose opts $ text "Will apply the following patches:"- putVerbose opts . vcat $ mapFL description to_be_applied- definePatches to_be_applied- Sealed pw <- tentativelyMergePatches repository "apply" opts us' to_be_applied- invalidateIndex repository- withSignalsBlocked $ do finalizeRepositoryChanges repository- applyToWorking repository opts pw `catch` \(e :: SomeException) ->- fail ("Error applying patch to working dir:\n" ++ show e)- return ()- putStrLn "Finished applying..."-\end{code}--Darcs apply accepts a single argument, which is the name of the patch-file to be applied. If you omit this argument, the patch is read from-standard input. Darcs also interprets an argument of `\-' to mean it-should read the file from standard input. This allows you to use apply-with a pipe from your email program, for example.--\begin{options}---verify-\end{options}--\begin{code}--getPatchBundle :: RepoPatch p => [DarcsFlag] -> B.ByteString- -> IO (Either String (SealedPatchSet p C(Origin)))-getPatchBundle opts fps = do- mps <- verifyPS opts $ readEmail fps- mops <- verifyPS opts fps- case (mps, mops) of- (Nothing, Nothing) ->- return $ Left "Patch bundle not properly signed, or gpg failed."- (Just ps, Nothing) -> return $ scanBundle ps- (Nothing, Just ps) -> return $ scanBundle ps- -- We use careful_scan_bundle only below because in either of the two- -- above case we know the patch was signed, so it really shouldn't- -- need stripping of CRs.- (Just ps1, Just ps2) -> case careful_scan_bundle ps1 of- Left _ -> return $ careful_scan_bundle ps2- Right x -> return $ Right x- where careful_scan_bundle ps =- case scanBundle ps of- Left e -> case scanBundle $ stripCrPS ps of- Right x -> Right x- _ -> Left e- x -> x- stripCrPS :: B.ByteString -> B.ByteString- stripCrPS ps = unlinesPS $ map stripline $ linesPS ps- stripline p | B.null p = p- | BC.last p == '\r' = B.init p- | otherwise = p--applyHelp' :: String-applyHelp' =- "A patch bundle may introduce unresolved conflicts with existing\n" ++- "patches or with the working tree. By default, Darcs will add conflict\n" ++- "markers (see `darcs mark-conflicts').\n" ++- "\n" ++- "The --allow-conflicts option will skip conflict marking; this is\n" ++- "useful when you want to treat a repository as just a bunch of patches,\n" ++- "such as using `darcs pull --union' to download of your co-workers\n" ++- "patches before going offline.\n" ++- "\n" ++- "This can mess up unrecorded changes in the working tree, forcing you\n" ++- "to resolve the conflict immediately. To simply reject bundles that\n" ++- "introduce unresolved conflicts, using the --dont-allow-conflicts\n" ++- "option. Making this the default in push-based workflows is strongly\n" ++- "recommended.\n" ++- "\n" ++- "Unlike most Darcs commands, `darcs apply' defaults to --all. Use the\n" ++- "--interactive option to pick which patches to apply from a bundle.\n"--\end{code}-\begin{options}---external-merge-\end{options}--You can use an external interactive merge tool to resolve conflicts with the-flag \verb!--external-merge!. For more details see-subsection~\ref{resolution}.--\begin{options}---sendmail-command-\end{options}--If you want to use a command different from the default one for sending mail,-you need to specify a command line with the \verb!--sendmail-command! option.-The command line can contain the format specifier \verb!%t! for to-and you can add \verb!%<! to the end of the command line if the command-expects the complete mail on standard input. For example, the command line for-msmtp looks like this:--\begin{verbatim}-msmtp -t %<-\end{verbatim}---\begin{code}-getFrom :: B.ByteString -> String-getFrom ps = readFrom $ linesPS ps- where readFrom [] = ""- readFrom (x:xs)- | B.take 5 x == fromStart = BC.unpack $ B.drop 5 x- | otherwise = readFrom xs--redirectOutput :: forall a . [DarcsFlag] -> String -> IO a -> IO a-redirectOutput opts to doit = ro opts- where- cc = getCc opts- ro [] = doit- ro (Reply f:_) =- withStdoutTemp $ \tempf-> do {a <- doit;- hClose stdout;- hClose stderr;- return a;- } `catch` (sendit tempf)- where sendit :: FilePath -> SomeException -> IO a- sendit tempf e | Just ExitSuccess <- fromException e =- do sendSanitizedEmail opts f to "Patch applied" cc tempf- throwIO e- sendit tempf e | Just (_ :: ExitCode) <- fromException e =- do sendSanitizedEmail opts f to "Patch failed!" cc tempf- throwIO ExitSuccess- sendit tempf e =- do sendSanitizedEmail opts f to "Darcs error applying patch!" cc $- tempf ++ "\n\nCaught exception:\n"++- show e++"\n"- throwIO ExitSuccess- ro (_:fs) = ro fs---- |sendSanitizedEmail sends a sanitized email using the given sendmailcmd--- It takes @DacrsFlag@ options a file with the mail contents,--- To:, Subject:, CC:, and mail body-sendSanitizedEmail :: [DarcsFlag] -> String -> String -> String -> String -> String -> IO ()-sendSanitizedEmail opts file to subject cc mailtext =- do scmd <- getSendmailCmd opts- body <- sanitizeFile mailtext- sendEmail file to subject cc scmd body---- sanitizeFile is used to clean up the stdout/stderr before sticking it in--- an email.--sanitizeFile :: FilePath -> IO String-sanitizeFile f = sanitize `fmap` readBinFile f- where sanitize s = wash $ remove_backspaces "" s- wash ('\000':s) = "\\NUL" ++ wash s- wash ('\026':s) = "\\EOF" ++ wash s- wash (c:cs) = c : wash cs- wash [] = []- remove_backspaces rev_sofar "" = reverse rev_sofar- remove_backspaces (_:rs) ('\008':s) = remove_backspaces rs s- remove_backspaces "" ('\008':s) = remove_backspaces "" s- remove_backspaces rs (s:ss) = remove_backspaces (s:rs) ss--forwardingMessage :: B.ByteString-forwardingMessage = BC.pack $- "The following patch was either unsigned, or signed by a non-allowed\n"++- "key, or there was a GPG failure.\n"--considerForwarding :: [DarcsFlag] -> B.ByteString -> IO Bool-considerForwarding opts m = cf opts (getCc opts)- where cf [] _ = return False- cf (Reply t:_) cc =- case break is_from (linesPS m) of- (m1, f:m2) ->- let m_lines = forwardingMessage:m1 ++ m2- m' = unlinesPS m_lines- f' = BC.unpack (B.drop 5 f) in- if t == f' || t == init f'- then return False -- Refuse possible email loop.- else do- scmd <- getSendmailCmd opts- if doHappyForwarding opts- then resendEmail t scmd m- else sendEmailDoc f' t "A forwarded darcs patch" cc- scmd (Just (empty,empty))- (packedString m')- return True- _ -> return False -- Don't forward emails lacking headers!- cf (_:fs) cc = cf fs cc- is_from l = B.take 5 l == fromStart--fromStart :: B.ByteString-fromStart = BC.pack "From:"-\end{code}
+ src/Darcs/Commands/Changes.hs view
@@ -0,0 +1,326 @@+-- Copyright (C) 2003-2004 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.++{-# LANGUAGE CPP, PatternGuards #-}++#include "gadts.h"++module Darcs.Commands.Changes ( changes, log ) where+import Prelude hiding ( log )+import Unsafe.Coerce (unsafeCoerce)++import Data.List ( intersect, sort, nub )+import Data.Maybe ( fromMaybe, fromJust, isJust )+import Control.Monad ( when, unless )+import Control.Applicative ((<$>))++import Darcs.Patch.PatchInfoAnd ( hopefullyM, info )+import Darcs.Commands ( DarcsCommand(..), nodefaults, commandAlias )+import Darcs.Arguments ( DarcsFlag(GenContext, HumanReadable, MachineReadable,+ Interactive, Count,+ NumberPatches, XMLOutput, Summary,+ Verbose, Debug),+ fixSubPaths, changesFormat,+ possiblyRemoteRepoDir, getRepourl,+ workingRepoDir, onlyToFiles,+ summary, changesReverse,+ matchSeveralOrRange,+ matchMaxcount, maxCount,+ allInteractive, showFriendly,+ networkOptions+ )+import Darcs.Flags ( doReverse, showChangesOnlyToFiles, UseIndex(..), ScanKnown(..) )+import Darcs.RepoPath ( SubPath(), toFilePath )+import Darcs.Patch.FileName ( fp2fn, fn2fp, normPath )+import Darcs.Repository ( PatchSet, PatchInfoAnd,+ withRepositoryDirectory, RepoJob(..), findRepository,+ readRepo, unrecordedChanges )+import Darcs.Patch.Set ( PatchSet(..), newset2RL )+import Darcs.Patch.Info ( toXml, showPatchInfo, escapeXML, PatchInfo )+import Darcs.Patch.Depends ( findCommonWithThem )+import Darcs.Patch.Bundle( contextPatches )+import Darcs.Patch.TouchesFiles ( lookTouch )+import Darcs.Patch ( RepoPatch, invert, xmlSummary, description, applyToFilepaths,+ listTouchedFiles, effect )+import Darcs.Witnesses.Eq ( EqCheck(..) )+import Darcs.Witnesses.Ordered ( FL(NilFL), RL(..), filterFLFL, filterRL,+ reverseFL, (:>)(..), mapRL )+import Darcs.Match ( firstMatch, secondMatch,+ matchAPatchread, haveNonrangeMatch,+ matchFirstPatchset, matchSecondPatchset,+ )+import Printer ( Doc, putDocLnWith, simplePrinters, (<+>),+ renderString, prefix, text, vcat, vsep, (<>),+ ($$), empty, errorDoc, insertBeforeLastline )+import Darcs.ColorPrinter ( fancyPrinters )+import Progress ( setProgressMode, debugMessage )+import Darcs.SelectChanges ( viewChanges )+import Darcs.Witnesses.Sealed ( Sealed2(..), unseal2, Sealed(..), seal2 )++changesDescription :: String+changesDescription = "List patches in the repository."++changesHelp :: String+changesHelp =+ "The `darcs changes' command lists the patches that constitute the\n" +++ "current repository or, with --repo, a remote repository. Without\n" +++ "options or arguments, ALL patches will be listed.\n" +++ "\n" ++ changesHelp' +++ "\n" ++ changesHelp''++changes :: DarcsCommand+changes = DarcsCommand {commandProgramName = "darcs",+ commandName = "changes",+ commandHelp = changesHelp,+ commandDescription = changesDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["[FILE or DIRECTORY]..."],+ commandGetArgPossibilities = return [],+ commandCommand = changesCmd,+ commandPrereq = findRepository,+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = networkOptions,+ commandBasicOptions = [matchSeveralOrRange,+ matchMaxcount,+ onlyToFiles,+ changesFormat,+ summary,+ changesReverse,+ possiblyRemoteRepoDir,+ workingRepoDir,+ allInteractive]}++changesCmd :: [DarcsFlag] -> [String] -> IO ()+changesCmd opts args+ | GenContext `elem` opts = if not . null $ args+ then fail "changes --context cannot accept other arguments"+ else changesContext opts+ | null args = showChanges opts Nothing+ | otherwise = do+ fs <- fixSubPaths opts args+ case fs of+ [] -> putStrLn "No valid arguments were given, nothing to do."+ _ -> showChanges opts . Just . nub $ sort fs++showChanges :: [DarcsFlag] -> Maybe [SubPath] -> IO ()+showChanges opts files =+ let repodir = fromMaybe "." (getRepourl opts) in+ withRepositoryDirectory opts repodir $ RepoJob $ \repository -> do+ unless (Debug `elem` opts) $ setProgressMode False+ Sealed unrec <- case files of+ Nothing -> return $ Sealed NilFL+ Just _ -> Sealed `fmap` unrecordedChanges (UseIndex, ScanKnown) repository files+ `catch` \_ -> return (Sealed NilFL) -- 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+ then do let (fp_and_fs, _, _) = filtered_changes patches+ fp = map fst fp_and_fs+ viewChanges opts fp+ else do when (isJust files && not (XMLOutput `elem` opts)) $+ putStrLn $ "Changes to "++unwords (fromJust filez)++":\n"+ 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+changesHelp' :: String+changesHelp' =+ "When given one or more files or directories as arguments, only\n" +++ "patches which affect those files or directories are listed. This\n" +++ "includes changes that happened to files before they were moved or\n" +++ "renamed.\n" +++ "\n" +++ "When given a --from-tag, --from-patch or --from-match, only changes\n" +++ "since that tag or patch are listed. Similarly, the --to-tag,\n" +++ "--to-patch and --to-match options restrict the list to older patches.\n" +++ "\n" +++ "The --last and --max-count options both limit the number of patches\n" +++ "listed. The former applies BEFORE other filters, whereas the latter\n" +++ "applies AFTER other filters. For example `darcs changes foo.c\n" +++ "--max-count 3' will print the last three patches that affect foo.c,\n" +++ "whereas `darcs changes --last 3 foo.c' will, of the last three\n" +++ "patches, print only those that affect foo.c.\n"++getChangesInfo :: RepoPatch p => [DarcsFlag] -> Maybe [FilePath]+ -> PatchSet p C(x y)+ -> ([(Sealed2 (PatchInfoAnd p), [FilePath])], [FilePath], Doc)+getChangesInfo opts plain_fs ps =+ case (sp1s, sp2s) of+ (Sealed p1s, Sealed p2s) ->+ case findCommonWithThem p2s p1s of+ _ :> us ->+ let ps' = filterRL pf (reverseFL us) in+ case plain_fs of+ Nothing -> foldr (\x xs -> (x, []) -:- xs) ([], [], empty) $+ maybe id take (maxCount opts) ps'+ Just fs -> let fs' = map (\x -> "./" ++ x) fs in+ filterPatchesByNames (maxCount opts) fs' ps'+ where sp1s = if firstMatch opts+ then matchFirstPatchset opts ps+ else Sealed $ PatchSet NilRL NilRL+ sp2s = if secondMatch opts+ then matchSecondPatchset opts ps+ else Sealed $ ps+ pf = if haveNonrangeMatch opts+ then matchAPatchread opts+ else \_ -> True++-- | Take a list of filenames and patches and produce a list of+-- patches that actually touch the given files with list of touched+-- file names, a new file list that represents the same set of files+-- as in input, before the returned patches would have been applied,+-- and possibly an error. Additionaly, the function takes a "depth+-- limit" -- maxcount, that could be Nothing (return everything) or+-- "Just n" -- returns at most n patches touching the file (starting+-- from the beginning of the patch list).+filterPatchesByNames :: RepoPatch p =>+ Maybe Int -- ^ maxcount+ -> [FilePath] -- ^ filenames+ -> [Sealed2 (PatchInfoAnd p)] -- ^ patchlist+ -> ([(Sealed2 (PatchInfoAnd p),[FilePath])], [FilePath], Doc)+filterPatchesByNames (Just 0) _ _ = ([], [], empty)+filterPatchesByNames _ [] _ = ([], [], empty)+filterPatchesByNames _ _ [] = ([], [], empty)+filterPatchesByNames maxcount fs ((Sealed2 hp):ps)+ | Just p <- hopefullyM hp =+ case lookTouch fs (invert p) of+ (True, []) -> ([(Sealed2 hp, fs)], fs, empty)+ (True, fs') -> (Sealed2 hp, fs) -:- filterPatchesByNames+ (subtract 1 `fmap` maxcount) fs' ps+ (False, fs') -> filterPatchesByNames maxcount fs' ps+filterPatchesByNames _ _ ((Sealed2 hp):_) =+ ([], [], text "Can't find changes prior to:" $$ description hp)++-- | Note, lazy pattern matching is required to make functions like+-- filterPatchesByNames lazy in case you are only not interested in+-- the first element. E.g.:+--+-- let (fs, _, _) = filterPatchesByNames ...+(-:-) :: a -> ([a],b,c) -> ([a],b,c)+x -:- ~(xs,y,z) = (x:xs,y,z)++changelog :: forall p C(start x)+ . RepoPatch p+ => [DarcsFlag] -> PatchSet p C(start x)+ -> ([(Sealed2 (PatchInfoAnd p), [FilePath])], [FilePath], Doc)+ -> Doc+changelog opts patchset (pis_and_fs, orig_fs, errstring)+ | Count `elem` opts = text $ show $ length pis_and_fs+ | MachineReadable `elem` opts =+ if renderString errstring == ""+ then vsep $ map (unseal2 (showPatchInfo.info)) pis+ else errorDoc errstring+ | XMLOutput `elem` opts =+ text "<changelog>"+ $$ vcat xml_file_names+ $$ vcat actual_xml_changes+ $$ text "</changelog>"+ | Summary `elem` opts || Verbose `elem` opts =+ vsep (map (number_patch change_with_summary) pis_and_fs)+ $$ errstring+ | otherwise = vsep (map (number_patch description') pis_and_fs)+ $$ errstring+ where change_with_summary :: (Sealed2 (PatchInfoAnd p), [FilePath]) -> Doc+ change_with_summary (Sealed2 hp, fs)+ | Just p <- hopefullyM hp = if showChangesOnlyToFiles opts+ then description hp $$ text "" $$+ indent (showFriendly opts (filterFLFL xx $ effect p))+ else showFriendly opts p+ | otherwise = description hp+ $$ indent (text "[this patch is unavailable]")+ where xx x = case listTouchedFiles x of+ ys | null $ ys `intersect` fs -> unsafeCoerce IsEq+ -- in that case, the change does not affect the patches we are+ -- looking at, so we ignore the difference between the two states.+ -- It's all read-only anyway.+ _ -> NotEq+ xml_with_summary (Sealed2 hp)+ | Just p <- hopefullyM hp = insertBeforeLastline+ (toXml $ info hp) (indent $ xmlSummary p)+ xml_with_summary (Sealed2 hp) = toXml (info hp)+ indent = prefix " "+ actual_xml_changes = if Summary `elem` opts+ then map xml_with_summary pis+ else map (toXml . (unseal2 info)) pis+ xml_file_names = map (createdAsXml first_change) orig_fs+ first_change = if doReverse opts+ then unseal2 info $ head pis+ else unseal2 info $ last pis+ number_patch f x = if NumberPatches `elem` opts+ then case get_number (fst x) of+ Just n -> text (show n++":") <+> f x+ Nothing -> f x+ else f x+ get_number :: Sealed2 (PatchInfoAnd p) -> Maybe Int+ get_number (Sealed2 y) = gn 1 (newset2RL patchset)+ where iy = info y+ gn :: Int -> RL (PatchInfoAnd p) C(start y) -> Maybe Int+ gn n (b:<:bs) | seq n (info b) == iy = Just n+ | otherwise = gn (n+1) bs+ gn _ NilRL = Nothing+ pis = map fst pis_and_fs+ description' = unseal2 description . fst++-- FIXME: this prose is unreadable. --twb, 2009-08+changesHelp'' :: String+changesHelp'' =+ "Three output formats exist. The default is --human-readable. You can\n" +++ "also select --context, which is the internal format (as seen in patch\n" +++ "bundles) that can be re-read by Darcs (e.g. `darcs get --context').\n" +++ "\n" +++ "Finally, there is --xml-output, which emits valid XML... unless a the\n" +++ "patch metadata (author, name or description) contains a non-ASCII\n" +++ "character and was recorded in a non-UTF8 locale.\n" +++ "\n" +++ -- FIXME: can't we just disallow the following usage?+ "Note that while the --context flag may be used in conjunction with\n" +++ "--xml-output or --human-readable, in neither case will darcs get be\n" +++ "able to read the output. On the other hand, sufficient information\n" +++ "WILL be output for a knowledgeable human to recreate the current state\n" +++ "of the repository.\n"++changesContext :: [DarcsFlag] -> IO ()+changesContext opts = do+ let repodir = fromMaybe "." $ getRepourl opts+ withRepositoryDirectory opts repodir $ RepoJob $ \repository -> do+ (_ :> ps') <- contextPatches `fmap` readRepo repository+ let ps = mapRL (\p -> (seal2 p, [])) ps'+ unless fancy $ putStrLn "\nContext:\n"+ putDocLnWith simplePrinters $ changelog opts' emptyset (ps, [], empty)+ where opts' = if fancy then opts else MachineReadable : opts+ fancy = HumanReadable `elem` opts || XMLOutput `elem` opts+ emptyset = PatchSet NilRL NilRL++log :: DarcsCommand+log = commandAlias "log" Nothing changes++createdAsXml :: PatchInfo -> String -> Doc+createdAsXml pinfo as = text "<created_as original_name='"+ <> escapeXML as+ <> text "'>"+ $$ toXml pinfo+ $$ text "</created_as>"
− src/Darcs/Commands/Changes.lhs
@@ -1,306 +0,0 @@-% Copyright (C) 2003-2004 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.--\darcsCommand{changes}-\begin{code}-{-# OPTIONS_GHC -cpp -fglasgow-exts #-}-{-# LANGUAGE CPP, PatternGuards #-}--#include "gadts.h"--module Darcs.Commands.Changes ( changes, log ) where-import Prelude hiding ( log )-import Unsafe.Coerce (unsafeCoerce)--import Data.List ( intersect, sort )-import Data.Maybe ( fromMaybe )-import Control.Monad ( when, unless )--import Darcs.Hopefully ( hopefullyM, info )-import Darcs.Commands ( DarcsCommand(..), nodefaults, commandAlias )-import Darcs.Arguments ( DarcsFlag(Context, HumanReadable, MachineReadable,- Interactive, Count,- NumberPatches, XMLOutput, Summary,- Verbose, Debug),- fixSubPaths, changesFormat,- possiblyRemoteRepoDir, getRepourl,- workingRepoDir, onlyToFiles,- summary, changesReverse,- matchSeveralOrRange,- matchMaxcount, maxCount,- allInteractive, showFriendly,- networkOptions- )-import Darcs.Flags ( doReverse, showChangesOnlyToFiles )-import Darcs.RepoPath ( toFilePath, rootDirectory )-import Darcs.Patch.FileName ( fp2fn, fn2fp, normPath )-import Darcs.Repository ( Repository, PatchInfoAnd,- withRepositoryDirectory, ($-), findRepository,- readRepo, unrecordedChanges )-import Darcs.Patch.Set ( PatchSet(..), newset2RL )-import Darcs.Patch.Info ( toXml, showPatchInfo )-import Darcs.Patch.Depends ( findCommonWithThem )-import Darcs.Patch.Bundle( contextPatches )-import Darcs.Patch.TouchesFiles ( lookTouch )-import Darcs.Patch ( RepoPatch, invert, xmlSummary, description, applyToFilepaths,- listTouchedFiles, effect, identity )-import Darcs.Witnesses.Ordered ( RL(..), EqCheck(..), filterFLFL, filterRL,- reverseFL, (:>>)(..), mapRL )-import Darcs.Match ( firstMatch, secondMatch,- matchAPatchread, haveNonrangeMatch,- matchFirstPatchset, matchSecondPatchset,- )-import Darcs.Commands.Annotate ( createdAsXml )-import Printer ( Doc, putDocLnWith, simplePrinters, (<+>),- renderString, prefix, text, vcat, vsep,- ($$), empty, errorDoc, insertBeforeLastline )-import Darcs.ColorPrinter ( fancyPrinters )-import Progress ( setProgressMode, debugMessage )-import Darcs.SelectChanges ( viewChanges )-import Darcs.Witnesses.Sealed ( Sealed2(..), unseal2, Sealed(..), FlippedSeal(..), seal2 )--changesDescription :: String-changesDescription = "List patches in the repository."--changesHelp :: String-changesHelp =- "The `darcs changes' command lists the patches that constitute the\n" ++- "current repository or, with --repo, a remote repository. Without\n" ++- "options or arguments, ALL patches will be listed.\n" ++- "\n" ++ changesHelp' ++- "\n" ++ changesHelp''--changes :: DarcsCommand-changes = DarcsCommand {commandName = "changes",- commandHelp = changesHelp,- commandDescription = changesDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["[FILE or DIRECTORY]..."],- commandGetArgPossibilities = return [],- commandCommand = changesCmd,- commandPrereq = findRepository,- commandArgdefaults = nodefaults,- commandAdvancedOptions = networkOptions,- commandBasicOptions = [matchSeveralOrRange,- matchMaxcount,- onlyToFiles,- changesFormat,- summary,- changesReverse,- possiblyRemoteRepoDir,- workingRepoDir,- allInteractive]}--changesCmd :: [DarcsFlag] -> [String] -> IO ()-changesCmd [Context _] [] = return ()-changesCmd opts args | Context rootDirectory `elem` opts =- let repodir = fromMaybe "." (getRepourl opts) in- withRepositoryDirectory opts repodir $- \repository -> do- when (args /= []) $ fail "changes --context cannot accept other arguments"- changesContext repository opts-changesCmd opts args =- let repodir = fromMaybe "." (getRepourl opts) in- withRepositoryDirectory opts repodir $- \repository -> do- 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- then do let (fp_and_fs, _, _) = filtered_changes patches- fp = map fst fp_and_fs- viewChanges opts fp- else do when (not (null files) && not (XMLOutput `elem` opts)) $- putStrLn $ "Changes to "++unwords filez++":\n"- 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-changesHelp' :: String-changesHelp' =- "When given one or more files or directories as arguments, only\n" ++- "patches which affect those files or directories are listed. This\n" ++- "includes changes that happened to files before they were moved or\n" ++- "renamed.\n" ++- "\n" ++- "When given a --from-tag, --from-patch or --from-match, only changes\n" ++- "since that tag or patch are listed. Similarly, the --to-tag,\n" ++- "--to-patch and --to-match options restrict the list to older patches.\n" ++- "\n" ++- "The --last and --max-count options both limit the number of patches\n" ++- "listed. The former applies BEFORE other filters, whereas the latter\n" ++- "applies AFTER other filters. For example `darcs changes foo.c\n" ++- "--max-count 3' will print the last three patches that affect foo.c,\n" ++- "whereas `darcs changes --last 3 foo.c' will, of the last three\n" ++- "patches, print only those that affect foo.c.\n"--getChangesInfo :: RepoPatch p => [DarcsFlag] -> [FilePath]- -> PatchSet p C(x y)- -> ([(Sealed2 (PatchInfoAnd p), [FilePath])], [FilePath], Doc)-getChangesInfo opts plain_fs ps =- case (sp1s, sp2s) of- (Sealed p1s, Sealed p2s) ->- case findCommonWithThem p2s p1s of- _ :>> us -> filterPatchesByNames (maxCount opts) fs $ filterRL pf $ reverseFL us- where fs = map (\x -> "./" ++ x) $ plain_fs- sp1s = if firstMatch opts- then matchFirstPatchset opts ps- else Sealed $ PatchSet NilRL NilRL- sp2s = if secondMatch opts- then matchSecondPatchset opts ps- else Sealed $ ps- pf = if haveNonrangeMatch opts- then matchAPatchread opts- else \_ -> True---- | Take a list of filenames and patches and produce a list of--- patches that actually touch the given files with list of touched--- file names, a new file list that represents the same set of files--- as in input, before the returned patches would have been applied,--- and possibly an error. Additionaly, the function takes a "depth--- limit" -- maxcount, that could be Nothing (return everything) or--- "Just n" -- returns at most n patches touching the file (starting--- from the beginning of the patch list).-filterPatchesByNames :: RepoPatch p =>- Maybe Int -- ^ maxcount- -> [FilePath] -- ^ filenames- -> [Sealed2 (PatchInfoAnd p)] -- ^ patchlist- -> ([(Sealed2 (PatchInfoAnd p),[FilePath])], [FilePath], Doc)-filterPatchesByNames (Just 0) _ _ = ([], [], empty)-filterPatchesByNames _ _ [] = ([], [], empty)-filterPatchesByNames maxcount [] (hp:ps) =- (hp, []) -:- filterPatchesByNames (subtract 1 `fmap` maxcount) [] ps-filterPatchesByNames maxcount fs ((Sealed2 hp):ps)- | Just p <- hopefullyM hp =- case lookTouch fs (invert p) of- (True, []) -> ([(Sealed2 hp, fs)], fs, empty)- (True, fs') -> (Sealed2 hp, fs) -:- filterPatchesByNames- (subtract 1 `fmap` maxcount) fs' ps- (False, fs') -> filterPatchesByNames maxcount fs' ps-filterPatchesByNames _ _ ((Sealed2 hp):_) =- ([], [], text "Can't find changes prior to:" $$ description hp)---- | Note, lazy pattern matching is required to make functions like--- filterPatchesByNames lazy in case you are only not interested in--- the first element. E.g.:------ let (fs, _, _) = filterPatchesByNames ...-(-:-) :: a -> ([a],b,c) -> ([a],b,c)-x -:- ~(xs,y,z) = (x:xs,y,z)--changelog :: RepoPatch p => [DarcsFlag] -> PatchSet p C(start x) ->- ([(Sealed2 (PatchInfoAnd p), [FilePath])], [FilePath], Doc)- -> Doc-changelog opts patchset (pis_and_fs, orig_fs, errstring)- | Count `elem` opts = text $ show $ length pis_and_fs- | MachineReadable `elem` opts =- if renderString errstring == ""- then vsep $ map (unseal2 (showPatchInfo.info)) pis- else errorDoc errstring- | XMLOutput `elem` opts =- text "<changelog>"- $$ vcat xml_file_names- $$ vcat actual_xml_changes- $$ text "</changelog>"- | Summary `elem` opts || Verbose `elem` opts =- vsep (map (number_patch change_with_summary) pis_and_fs)- $$ errstring- | otherwise = vsep (map (number_patch description') pis_and_fs)- $$ errstring- where change_with_summary (Sealed2 hp, fs)- | Just p <- hopefullyM hp = if showChangesOnlyToFiles opts- then description hp $$ text "" $$- indent (showFriendly opts (filterFLFL xx $ effect p))- else showFriendly opts p- | otherwise = description hp- $$ indent (text "[this patch is unavailable]")- where xx x = case listTouchedFiles x of- ys | null $ ys `intersect` fs -> unsafeCoerce IsEq- -- in that case, the change does not affect the patches we are- -- looking at, so we ignore the difference between the two states.- -- It's all read-only anyway.- _ -> NotEq- xml_with_summary (Sealed2 hp)- | Just p <- hopefullyM hp = insertBeforeLastline- (toXml $ info hp) (indent $ xmlSummary p)- xml_with_summary (Sealed2 hp) = toXml (info hp)- indent = prefix " "- actual_xml_changes = if Summary `elem` opts- then map xml_with_summary pis- else map (toXml . (unseal2 info)) pis- xml_file_names = map (createdAsXml first_change) orig_fs- first_change = if doReverse opts- then unseal2 info $ head pis- else unseal2 info $ last pis- number_patch f x = if NumberPatches `elem` opts- then case get_number (fst x) of- Just n -> text (show n++":") <+> f x- Nothing -> f x- else f x- get_number :: Sealed2 (PatchInfoAnd p) -> Maybe Int- get_number (Sealed2 y) = gn 1 (newset2RL patchset)- where iy = info y- gn :: Int -> RL (PatchInfoAnd p) C(start x) -> Maybe Int- gn n (b:<:bs) | seq n (info b) == iy = Just n- | otherwise = gn (n+1) bs- gn _ NilRL = Nothing- pis = map fst pis_and_fs- description' = unseal2 description . fst---- FIXME: this prose is unreadable. --twb, 2009-08-changesHelp'' :: String-changesHelp'' =- "Three output formats exist. The default is --human-readable. You can\n" ++- "also select --context, which is the internal format (as seen in patch\n" ++- "bundles) that can be re-read by Darcs (e.g. `darcs get --context').\n" ++- "\n" ++- "Finally, there is --xml-output, which emits valid XML... unless a the\n" ++- "patch metadata (author, name or description) contains a non-ASCII\n" ++- "character and was recorded in a non-UTF8 locale.\n" ++- "\n" ++- -- FIXME: can't we just disallow the following usage?- "Note that while the --context flag may be used in conjunction with\n" ++- "--xml-output or --human-readable, in neither case will darcs get be\n" ++- "able to read the output. On the other hand, sufficient information\n" ++- "WILL be output for a knowledgeable human to recreate the current state\n" ++- "of the repository.\n"--changesContext :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> IO ()-changesContext repository opts = do- FlippedSeal ps' <- contextPatches `fmap` readRepo repository- let ps = mapRL (\p -> (seal2 p, [])) ps'- unless fancy $ putStrLn "\nContext:\n"- putDocLnWith simplePrinters $ changelog opts' emptyset (ps, [], empty)- where opts' = if fancy then opts else MachineReadable : opts- fancy = HumanReadable `elem` opts || XMLOutput `elem` opts- emptyset = PatchSet NilRL NilRL--log :: DarcsCommand-log = commandAlias "log" Nothing changes-\end{code}
+ src/Darcs/Commands/Check.hs view
@@ -0,0 +1,153 @@+-- Copyright (C) 2002-2005 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.++module Darcs.Commands.Check ( check, repair ) where+import Control.Monad ( when, unless )+import Control.Applicative( (<$>) )+import System.Exit ( ExitCode(..), exitWith )+import System.Directory( renameFile )++import Darcs.Commands ( DarcsCommand(..), nodefaults, putInfo )+import Darcs.Arguments ( DarcsFlag(Quiet),+ test, umaskOption,+ leaveTestDir, workingRepoDir, ignoretimes+ )+import Darcs.Flags(willIgnoreTimes)+import Darcs.Repository.Repair( replayRepository, checkIndex+ , RepositoryConsistency(..) )+import Darcs.Repository ( Repository, amInHashedRepository, withRepository,+ testRecorded, readRecorded, RepoJob(..),+ withRepoLock, replacePristine, writePatchSet )+import Darcs.Patch ( RepoPatch, showPatch, PrimOf )+import Darcs.Witnesses.Ordered ( FL(..) )+import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )+import Darcs.Repository.Prefs ( filetypeFunction )+import Darcs.Diff( treeDiff )+import Printer ( text, ($$), (<+>) )++#include "gadts.h"++checkDescription :: String+checkDescription = "Check the repository for consistency."++checkHelp :: String+checkHelp =+ "This command verifies that the patches in the repository, when applied\n" +++ "successively to an empty tree, result in the pristine tree. If not,\n" +++ "the differences are printed and Darcs exits unsucessfully (with a\n" +++ "non-zero exit status).\n" +++ "\n" +++ "If a regression test is defined (see `darcs setpref') it will be run\n" +++ "by `darcs check'. Use the --no-test option to disable this.\n"++check :: DarcsCommand+check = DarcsCommand {commandProgramName = "darcs",+ commandName = "check",+ commandHelp = checkHelp,+ commandDescription = checkDescription,+ commandExtraArgs = 0,+ commandExtraArgHelp = [],+ commandCommand = checkCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [],+ commandBasicOptions = [ test,+ leaveTestDir,+ workingRepoDir,+ ignoretimes+ ]}++checkCmd :: [DarcsFlag] -> [String] -> IO ()+checkCmd opts _ = withRepository opts (RepoJob (check' opts))++check'+ :: forall p C(r u t) . (RepoPatch p) => [DarcsFlag] -> Repository p C(r u t) -> IO ()+check' opts repository = do+ failed <- replayRepository repository opts $ \ state -> do+ case state of+ RepositoryConsistent -> do+ putInfo opts $ text "The repository is consistent!"+ rc <- testRecorded repository+ when (rc /= ExitSuccess) $ exitWith rc+ return False+ BrokenPristine newpris -> do+ brokenPristine newpris+ return True+ BrokenPatches newpris _ -> do+ brokenPristine newpris+ putInfo opts $ text "Found broken patches."+ return True+ bad_index <- case willIgnoreTimes opts of+ False -> not <$> checkIndex repository (Quiet `elem` opts)+ True -> return False+ when bad_index $ putInfo opts $ text "Bad index."+ exitWith $ if failed || bad_index then ExitFailure 1 else ExitSuccess+ where+ brokenPristine newpris = do+ putInfo opts $ text "Looks like we have a difference..."+ mc <- readRecorded repository+ ftf <- filetypeFunction+ Sealed (diff :: FL (PrimOf p) C(r r2)) <- unFreeLeft `fmap` treeDiff ftf newpris mc :: IO (Sealed (FL (PrimOf p) C(r)))+ putInfo opts $ case diff of+ NilFL -> text "Nothing"+ patch -> text "Difference: " <+> showPatch patch+ putInfo opts $ text ""+ $$ text "Inconsistent repository!"+++repairDescription :: String+repairDescription = "Repair a corrupted repository."++repairHelp :: String+repairHelp =+ "The `darcs repair' command attempts to fix corruption in the current\n" +++ "repository. Currently it can only repair damage to the pristine tree,\n" +++ "which is where most corruption occurs.\n"++repair :: DarcsCommand+repair = DarcsCommand {commandProgramName = "darcs",+ commandName = "repair",+ commandHelp = repairHelp,+ commandDescription = repairDescription,+ commandExtraArgs = 0,+ commandExtraArgHelp = [],+ commandCommand = repairCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [umaskOption],+ commandBasicOptions = [workingRepoDir]}++repairCmd :: [DarcsFlag] -> [String] -> IO ()+repairCmd opts _ = withRepoLock opts $ RepoJob $ \repository -> do+ replayRepository repository opts $ \state ->+ case state of+ RepositoryConsistent ->+ putStrLn "The repository is already consistent, no changes made."+ BrokenPristine tree -> do+ putStrLn "Fixing pristine tree..."+ replacePristine repository tree+ BrokenPatches tree newps -> do+ putStrLn "Writing out repaired patches..."+ _ <- writePatchSet newps opts+ putStrLn "Fixing pristine tree..."+ replacePristine repository tree+ index_ok <- checkIndex repository (Quiet `elem` opts)+ unless index_ok $ do renameFile "_darcs/index" "_darcs/index.bad"+ putStrLn "Bad index discarded."+
− src/Darcs/Commands/Check.lhs
@@ -1,121 +0,0 @@-% Copyright (C) 2002-2005 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.--\darcsCommand{check}-\begin{code}-module Darcs.Commands.Check ( check ) where-import Control.Monad ( when )-import Control.Applicative( (<$>) )-import System.Exit ( ExitCode(..), exitWith )----import Darcs.Commands ( DarcsCommand(..), nodefaults, putInfo )-import Darcs.Arguments ( DarcsFlag(Quiet),- partialCheck, test,- leaveTestDir, workingRepoDir, ignoretimes- )-import Darcs.Flags(willIgnoreTimes)-import Darcs.Repository.Repair( replayRepository, checkIndex- , RepositoryConsistency(..) )-import Darcs.Repository ( Repository, amInRepository, withRepository,- testRecorded, readRecorded )-import Darcs.Patch ( RepoPatch, showPatch, Prim )-import Darcs.Witnesses.Ordered ( FL(..) )-import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )-import Darcs.Repository.Prefs ( filetypeFunction )-import Darcs.Diff( treeDiff )-import Printer ( text, ($$), (<+>) )--#include "gadts.h"--checkDescription :: String-checkDescription = "Check the repository for consistency."--checkHelp :: String-checkHelp =- "This command verifies that the patches in the repository, when applied\n" ++- "successively to an empty tree, result in the pristine tree. If not,\n" ++- "the differences are printed and Darcs exits unsucessfully (with a\n" ++- "non-zero exit status).\n" ++- "\n" ++- "If the repository is in darcs-1 format and has a checkpoint, you can\n" ++- "use the --partial option to start checking from the latest checkpoint.\n" ++- "This is the default for partial darcs-1 repositories; the --complete\n" ++- "option to forces a full check.\n" ++- "\n" ++- "If a regression test is defined (see `darcs setpref') it will be run\n" ++- "by `darcs check'. Use the --no-test option to disable this.\n"--check :: DarcsCommand-check = DarcsCommand {commandName = "check",- commandHelp = checkHelp,- commandDescription = checkDescription,- commandExtraArgs = 0,- commandExtraArgHelp = [],- commandCommand = checkCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [],- commandBasicOptions = [partialCheck,- test,- leaveTestDir,- workingRepoDir,- ignoretimes- ]}--checkCmd :: [DarcsFlag] -> [String] -> IO ()-checkCmd opts _ = withRepository opts (check' opts)--check'- :: forall p C(r u t) . (RepoPatch p) => [DarcsFlag] -> Repository p C(r u t) -> IO ()-check' opts repository = do- failed <- replayRepository repository opts $ \ state -> do- case state of- RepositoryConsistent -> do- putInfo opts $ text "The repository is consistent!"- testRecorded repository- return False- BrokenPristine newpris -> do- brokenPristine newpris- return True- BrokenPatches newpris _ -> do- brokenPristine newpris- putInfo opts $ text "Found broken patches."- return True- bad_index <- case willIgnoreTimes opts of- False -> not <$> checkIndex repository (Quiet `elem` opts)- True -> return False- when bad_index $ putInfo opts $ text "Bad index."- exitWith $ if failed || bad_index then ExitFailure 1 else ExitSuccess- where- brokenPristine newpris = do- putInfo opts $ text "Looks like we have a difference..."- mc <- readRecorded repository- ftf <- filetypeFunction- Sealed (diff :: FL Prim C(r r2)) <- unFreeLeft `fmap` treeDiff ftf newpris mc :: IO (Sealed (FL Prim C(r)))- putInfo opts $ case diff of- NilFL -> text "Nothing"- patch -> text "Difference: " <+> showPatch patch- putInfo opts $ text ""- $$ text "Inconsistent repository!"--\end{code}-%% FIXME: this should go in "common options" or something, since-%% commands like record and amend-record also run the test command.-\input{Darcs/Test.lhs}
+ src/Darcs/Commands/Convert.hs view
@@ -0,0 +1,261 @@+-- 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.++{-# 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 qualified Data.ByteString as B++import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, n2pia, info, hopefully )+import Darcs.Commands ( DarcsCommand(..), nodefaults, putInfo )+import Darcs.Arguments+ ( DarcsFlag+ ( AllowConflicts, NewRepo, SetScriptsExecutable, UseFormat2+ , NoUpdateWorking+ )+ , reponame+ , setScriptsExecutableOption+ , networkOptions+ )+import Darcs.Repository ( Repository, withRepoLock, RepoJob(..), withRepositoryDirectory, readRepo,+ createRepository, invalidateIndex,+ optimizeInventory,+ tentativelyMergePatches, patchSetToPatches,+ createPristineDirectoryTree,+ revertRepositoryChanges, finalizeRepositoryChanges,+ applyToWorking, setScriptsExecutable )+import Darcs.Global ( darcsdir )+import Darcs.Patch ( Named, showPatch, patch2patchinfo, fromPrim, fromPrims,+ infopatch, adddeps, getdeps, effect, patchcontents )+import Darcs.Witnesses.Eq ( EqCheck(..), (=/\=) )+import Darcs.Witnesses.Ordered ( FL(..), RL(..), bunchFL, mapFL, mapFL_FL,+ concatFL, mapRL )+import Darcs.Patch.Info ( piRename, piTag, isTag, PatchInfo )+import Darcs.Patch.V1 ( Patch )+import Darcs.Patch.V2 ( RealPatch )+import Darcs.Patch.V1.Commute ( publicUnravel )+import Darcs.Patch.V1.Core ( Patch(PP), isMerger )+import Darcs.Patch.V2.Real ( mergeUnravelled )+import Darcs.Patch.Prim.V1 ( Prim )+import Darcs.Patch.Set ( PatchSet(..), Tagged(..), newset2RL )+import Darcs.RepoPath ( ioAbsoluteOrRemote, toPath )+import Darcs.Repository.Format(identifyRepoFormat, formatHas, RepoProperty(Darcs2))+import Darcs.Repository.Motd ( showMotd )+import Darcs.Utils ( clarifyErrors, askUser, catchall )+import Darcs.ProgressPatches ( progressFL )+import Darcs.Witnesses.Sealed ( FlippedSeal(..), Sealed(..) )+import Printer ( text, ($$) )+import Darcs.ColorPrinter ( traceDoc )+import Darcs.Lock ( writeBinFile )+import Darcs.External ( fetchFilePS, Cachable(Uncachable) )+import System.FilePath.Posix++#include "gadts.h"+#include "impossible.h"++convertDescription :: String+convertDescription = "Convert a repository from a legacy format."++convertHelp :: String+convertHelp =+ "The current repository format is called `darcs-2'. It was introduced\n" +++ "in Darcs 2.0 and became the default for new projects in Darcs 2.2.\n" +++ "The `darcs convert' command allows existing projects to migrate to\n" +++ "this format from the older `darcs-1' format.\n" +++ "\n" +++ "This command DOES NOT modify the source repository; a new destination\n" +++ "repository is created. It is safe to run this command more than once\n" +++ "on a repository (e.g. for testing), before the final conversion.\n" +++ "\n" +++ convertHelp' +++ "\n" +++ "Due to this limitation, migrating a multi-branch project is a little\n" +++ "awkward. Sorry! Here is the recommended process:\n" +++ "\n" +++ " 1. for each branch `foo', tag that branch with `foo-final';\n" +++ " 2. merge all branches together (--allow-conflicts may help);\n" +++ " 3. run `darcs optimize --reorder' on the result;\n" +++ " 4. run `darcs convert' to create a merged darcs-2 repository;\n" +++ " 5. re-create each branch by calling `darcs get --tag foo-final' on\n" +++ " the darcs-2 repository; and finally\n" +++ " 6. use `darcs obliterate' to delete the foo-final tags.\n"++-- | This part of the help is split out because it is used twice: in+-- the help string, and in the prompt for confirmation.+convertHelp' :: String+convertHelp' =+ "WARNING: the repository produced by this command is not understood by\n" +++ "Darcs 1.x, and patches cannot be exchanged between repositories in\n" +++ "darcs-1 and darcs-2 formats.\n" +++ "\n" +++ "Furthermore, darcs 2 repositories created by different invocations of\n" +++ "this command SHOULD NOT exchange patches, unless those repositories\n" +++ "had no patches in common when they were converted. (That is, within a\n" +++ "set of repos that exchange patches, no patch should be converted more\n" +++ "than once.)\n"++convert :: DarcsCommand+convert = DarcsCommand {commandProgramName = "darcs",+ commandName = "convert",+ commandHelp = convertHelp,+ commandDescription = convertDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["<SOURCE>", "[<DESTINATION>]"],+ commandCommand = convertCmd,+ commandPrereq = \_ -> return $ Right (),+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = networkOptions,+ commandBasicOptions = [reponame,setScriptsExecutableOption]}++convertCmd :: [DarcsFlag] -> [String] -> IO ()+convertCmd opts [inrepodir, outname] = convertCmd (NewRepo outname:opts) [inrepodir]+convertCmd orig_opts [inrepodir] = do++ typed_repodir <- ioAbsoluteOrRemote inrepodir+ let repodir = toPath typed_repodir++ --test for converting darcs-2 repository+ format <- identifyRepoFormat repodir+ when (formatHas Darcs2 format) $ fail "Repository is already in darcs 2 format."++ putStrLn convertHelp'+ let vow = "I understand the consequences of my action"+ putStrLn "Please confirm that you have read and understood the above"+ vow' <- askUser ("by typing `" ++ vow ++ "': ")+ when (vow' /= vow) $ fail "User didn't understand the consequences."++ let opts = UseFormat2:orig_opts+ showMotd opts repodir+ mysimplename <- makeRepoName opts repodir+ createDirectory mysimplename+ setCurrentDirectory mysimplename+ createRepository opts+ writeBinFile (darcsdir++"/hashed_inventory") ""+ withRepoLock (NoUpdateWorking:opts) $ V2Job $ \repository ->+ withRepositoryDirectory opts repodir $ V1Job $ \themrepo -> do+ theirstuff <- readRepo themrepo+ let patches = mapFL_FL convertNamed $ patchSetToPatches theirstuff+ inOrderTags = iot theirstuff+ where iot :: PatchSet p C(s x) -> [PatchInfo]+ iot (PatchSet _ ts) = iot_ ts+ iot_ :: RL(Tagged t1) C(t y) -> [PatchInfo]+ iot_ (Tagged t _ _ :<: ts) = info t : iot_ ts+ iot_ NilRL = []+ outOfOrderTags = catMaybes $ mapRL oot $ newset2RL theirstuff+ where oot t = if isTag (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 Prim C(x y) -> FL (RealPatch Prim) C(x y)+ convertOne x | isMerger x = case mergeUnravelled $ publicUnravel 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)+ convertOne (PP x) = fromPrim x :>: NilFL+ convertOne _ = impossible+ convertFL :: FL (Patch Prim) C(x y) -> FL (RealPatch Prim) C(x y)+ convertFL = concatFL . mapFL_FL convertOne+ convertNamed :: Named (Patch Prim) C(x y) -> PatchInfoAnd (RealPatch Prim) C(x y)+ convertNamed n = n2pia $+ adddeps (infopatch (convertInfo $ patch2patchinfo n) $+ convertFL $ patchcontents n)+ (map convertInfo $ concatMap fixDep $ getdeps n)+ convertInfo n | n `elem` inOrderTags = n+ | otherwise = maybe n (\t -> piRename n ("old tag: "++t)) $ piTag n+ applySome xs = do -- TODO this unsafeCoerce hack is because we don't keep track of the repository state properly+ -- Really sequence_ $ mapFL applySome below should instead be a repeated add operation -+ -- there doesn't seem to be any reason we need to do a merge here.+ let repository2 = unsafeCoerce# repository :: Repository (RealPatch Prim) C(a b a)+ Sealed pw <- tentativelyMergePatches repository2 "convert" (AllowConflicts:opts) NilFL xs+ finalizeRepositoryChanges repository2 -- this is to clean out pristine.hashed+ revertRepositoryChanges repository2+ _ <- revertable $ applyToWorking repository2 opts pw+ invalidateIndex repository2+ sequence_ $ mapFL applySome $ bunchFL 100 $ progressFL "Converting patch" patches+ invalidateIndex repository+ revertable $ createPristineDirectoryTree repository "."+ when (SetScriptsExecutable `elem` opts) $ setScriptsExecutable++ -- Copy over the prefs file+ let prefsRelPath = darcsdir </> "prefs" </> "prefs"+ (fetchFilePS (repodir </> prefsRelPath) Uncachable >>= B.writeFile prefsRelPath)+ `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."++makeRepoName :: [DarcsFlag] -> FilePath -> IO String+makeRepoName (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+makeRepoName (_:as) d = makeRepoName as d+makeRepoName [] d =+ case dropWhile (=='.') $ reverse $+ takeWhile (\c -> c /= '/' && c /= ':') $+ dropWhile (=='/') $ reverse d of+ "" -> modifyRepoName "anonymous_repo"+ base -> modifyRepoName base++modifyRepoName :: String -> IO String+modifyRepoName 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+
− src/Darcs/Commands/Convert.lhs
@@ -1,268 +0,0 @@-% 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.--\darcsCommand{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, putInfo, putVerbose )-import Darcs.Arguments- ( DarcsFlag- ( AllowConflicts, NewRepo, SetScriptsExecutable, UseFormat2- , NoUpdateWorking, NoLinks- )- , reponame- , setScriptsExecutableOption- , networkOptions- )-import Darcs.Repository ( Repository, withRepoLock, ($-), withRepositoryDirectory, readRepo,- createRepository, invalidateIndex,- optimizeInventory,- tentativelyMergePatches, patchSetToPatches,- createPristineDirectoryTree,- revertRepositoryChanges, finalizeRepositoryChanges,- applyToWorking, setScriptsExecutable )-import Darcs.Global ( darcsdir )-import Darcs.Patch ( RealPatch, Patch, Named, showPatch, patch2patchinfo, fromPrims, infopatch,- modernizePatch,- adddeps, getdeps, effect, flattenFL, isMerger, patchcontents )-import Darcs.Witnesses.Ordered ( FL(..), RL(..), EqCheck(..), (=/\=), bunchFL, mapFL, mapFL_FL,- concatFL, mapRL )-import Darcs.Patch.Info ( piRename, piTag, isTag, PatchInfo )-import Darcs.Patch.Commute ( publicUnravel )-import Darcs.Patch.Real ( mergeUnravelled )-import Darcs.Patch.Set ( PatchSet(..), Tagged(..), newset2RL )-import Darcs.RepoPath ( ioAbsoluteOrRemote, toPath )-import Darcs.Repository.Format(identifyRepoFormat, formatHas, RepoProperty(Darcs2))-import Darcs.Repository.Motd ( showMotd )-import Darcs.Utils ( clarifyErrors, askUser, catchall )-import Darcs.ProgressPatches ( progressFL )-import Darcs.Witnesses.Sealed ( FlippedSeal(..), Sealed(..) )-import Printer ( text, ($$) )-import Darcs.ColorPrinter ( traceDoc )-import Darcs.Lock ( writeBinFile )-import Darcs.External-import System.FilePath.Posix--#include "gadts.h"--convertDescription :: String-convertDescription = "Convert a repository from a legacy format."--convertHelp :: String-convertHelp =- "The current repository format is called `darcs-2'. It was introduced\n" ++- "in Darcs 2.0 and became the default for new projects in Darcs 2.2.\n" ++- "The `darcs convert' command allows existing projects to migrate to\n" ++- "this format from the older `darcs-1' format.\n" ++- "\n" ++- "This command DOES NOT modify the source repository; a new destination\n" ++- "repository is created. It is safe to run this command more than once\n" ++- "on a repository (e.g. for testing), before the final conversion.\n" ++- "\n" ++- convertHelp' ++- "\n" ++- "Due to this limitation, migrating a multi-branch project is a little\n" ++- "awkward. Sorry! Here is the recommended process:\n" ++- "\n" ++- " 1. for each branch `foo', tag that branch with `foo-final';\n" ++- " 2. merge all branches together (--allow-conflicts may help);\n" ++- " 3. run `darcs optimize --reorder' on the result;\n" ++- " 4. run `darcs convert' to create a merged darcs-2 repository;\n" ++- " 5. re-create each branch by calling `darcs get --tag foo-final' on\n" ++- " the darcs-2 repository; and finally\n" ++- " 6. use `darcs obliterate' to delete the foo-final tags.\n"---- | This part of the help is split out because it is used twice: in--- the help string, and in the prompt for confirmation.-convertHelp' :: String-convertHelp' =- "WARNING: the repository produced by this command is not understood by\n" ++- "Darcs 1.x, and patches cannot be exchanged between repositories in\n" ++- "darcs-1 and darcs-2 formats.\n" ++- "\n" ++- "Furthermore, darcs 2 repositories created by different invocations of\n" ++- "this command SHOULD NOT exchange patches, unless those repositories\n" ++- "had no patches in common when they were converted. (That is, within a\n" ++- "set of repos that exchange patches, no patch should be converted more\n" ++- "than once.)\n"--convert :: DarcsCommand-convert = DarcsCommand {commandName = "convert",- commandHelp = convertHelp,- commandDescription = convertDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["<SOURCE>", "[<DESTINATION>]"],- commandCommand = convertCmd,- commandPrereq = \_ -> return $ Right (),- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = networkOptions,- commandBasicOptions = [reponame,setScriptsExecutableOption]}--convertCmd :: [DarcsFlag] -> [String] -> IO ()-convertCmd opts [inrepodir, outname] = convertCmd (NewRepo outname:opts) [inrepodir]-convertCmd orig_opts [inrepodir] = do-- typed_repodir <- ioAbsoluteOrRemote inrepodir- let repodir = toPath typed_repodir-- --test for converting darcs-2 repository- Right format <- identifyRepoFormat repodir -- just fail in case of error- when (formatHas Darcs2 format) $ fail "Repository is already in darcs 2 format."-- putStrLn convertHelp'- let vow = "I understand the consequences of my action"- putStrLn "Please confirm that you have read and understood the above"- vow' <- askUser ("by typing `" ++ vow ++ "': ")- when (vow' /= vow) $ fail "User didn't understand the consequences."-- let opts = UseFormat2:orig_opts- showMotd opts repodir- mysimplename <- makeRepoName 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) C(r u t)- themrepo = unsafeCoerce# themrepobar :: Repository Patch C(r u t)- theirstuff <- readRepo themrepo- let patches = mapFL_FL convertNamed $ patchSetToPatches theirstuff- inOrderTags = iot theirstuff- where iot :: PatchSet p C(s x) -> [PatchInfo]- iot (PatchSet _ ts) = iot_ ts- iot_ :: RL(Tagged t1) C(t y) -> [PatchInfo]- iot_ (Tagged t _ _ :<: ts) = info t : iot_ ts- iot_ NilRL = []- outOfOrderTags = catMaybes $ mapRL oot $ newset2RL theirstuff- where oot t = if isTag (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 C(x y) -> FL RealPatch C(x y)- convertOne x | isMerger x = case mergeUnravelled $ publicUnravel $ modernizePatch 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 C(x y) -> PatchInfoAnd (FL RealPatch) C(x y)- 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 -> piRename n ("old tag: "++t)) $ piTag n- applySome xs = do Sealed pw <- tentativelyMergePatches repository "convert" (AllowConflicts:opts) NilFL xs- finalizeRepositoryChanges repository -- this is to clean out pristine.hashed- revertRepositoryChanges repository- revertable $ applyToWorking repository opts pw- invalidateIndex repository- sequence_ $ mapFL applySome $ bunchFL 100 $ progressFL "Converting patch" patches- invalidateIndex repository- revertable $ createPristineDirectoryTree repository "."- when (SetScriptsExecutable `elem` opts) $ setScriptsExecutable-- -- Copy over the prefs file- let prefsRelPath = darcsdir </> "prefs" </> "prefs"- 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."--makeRepoName :: [DarcsFlag] -> FilePath -> IO String-makeRepoName (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-makeRepoName (_:as) d = makeRepoName as d-makeRepoName [] d =- case dropWhile (=='.') $ reverse $- takeWhile (\c -> c /= '/' && c /= ':') $- dropWhile (=='/') $ reverse d of- "" -> modifyRepoName "anonymous_repo"- base -> modifyRepoName base--modifyRepoName :: String -> IO String-modifyRepoName 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}
+ src/Darcs/Commands/Diff.hs view
@@ -0,0 +1,208 @@+-- Copyright (C) 2003-2004 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.++{-# LANGUAGE CPP #-}++module Darcs.Commands.Diff ( diffCommand ) where++import System.FilePath.Posix ( takeFileName )+import Workaround ( getCurrentDirectory )+import Darcs.Utils ( askUser, withCurrentDirectory )+import Control.Monad ( when )+import Data.List ( (\\) )++import Storage.Hashed.Plain( writePlainTree )++import Darcs.External( diffProgram )+import CommandLine ( parseCmd )+import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Arguments ( DarcsFlag(DiffFlags, DiffCmd,+ LastN, AfterPatch),+ matchRange, storeInMemory,+ diffCmdFlag, diffflags, unidiff,+ workingRepoDir, fixSubPaths,+ )+import Darcs.Flags ( isNotUnified )+import Darcs.Patch.PatchInfoAnd ( info )+import Darcs.RepoPath ( AbsolutePath, SubPath, toFilePath, sp2fn )+import Darcs.Match ( getPartialFirstMatch, getPartialSecondMatch,+ firstMatch, secondMatch,+ matchFirstPatchset, matchSecondPatchset )+import Darcs.Repository ( withRepository, RepoJob(..), readRepo,+ amInHashedRepository,+ createPristineDirectoryTree,+ createPartialsPristineDirectoryTree )+import Darcs.Patch.Set ( PatchSet, newset2RL )+import Darcs.Repository.State ( readUnrecorded )+import Darcs.Patch ( RepoPatch )+import Darcs.Witnesses.Ordered ( mapRL )+import Darcs.Patch.Info ( PatchInfo, humanFriendly )+import Darcs.External ( execPipeIgnoreError )+import Darcs.Lock ( withTempDir )+import Darcs.Witnesses.Sealed ( unseal )+import Printer ( Doc, putDoc, vcat, empty, ($$) )+#include "impossible.h"++#include "gadts.h"++diffDescription :: String+diffDescription = "Create a diff between two versions of the repository."++diffHelp :: String+diffHelp =+ "The `darcs diff' command compares two versions of the working tree of\n" +++ "the current repository. Without options, the pristine (recorded) and\n" +++ "unrecorded working trees are compared. This is lower-level than\n" +++ "the `darcs whatsnew' command, since it outputs a line-by-line diff,\n" +++ "and it is also slower. As with `darcs whatsnew', if you specify\n" +++ "files or directories, changes to other files are not listed.\n" +++ "\n" +++ "With the --patch option, the comparison will be made between working\n" +++ "trees with and without that patch. Patches `after' the selected patch\n" +++ "are not present in either of the compared working trees. The\n" +++ "--from-patch and --to-patch options allow the set of patches in the\n" +++ "`old' and `new' working trees to be specified separately.\n" +++ "\n" +++ "The associated tag and match options are also understood, e.g. `darcs\n" +++ "diff --from-tag 1.0 --to-tag 1.1'. All these options assume an\n" +++ "ordering of the patch set, so results may be affected by operations\n" +++ "such as `darcs optimize --reorder'.\n" +++ "\n" +++ "diff(1) is called with the arguments -rN. The --unified option causes\n" +++ "-u to be passed to diff(1). An additional argument can be passed\n" +++ "using --diff-opts, such as --diff-opts=-ud or --diff-opts=-wU9.\n" +++ "\n" +++ "The --diff-command option can be used to specify an alternative\n" +++ "utility, such as meld (GNOME) or opendiff (OS X). Arguments may be\n" +++ "included, separated by whitespace. The value is not interpreted by a\n" +++ "shell, so shell constructs cannot be used. The arguments %1 and %2\n" +++ "MUST be included, these are substituted for the two working trees\n" +++ "being compared. If this option is used, --diff-opts is ignored.\n"++diffCommand :: DarcsCommand+diffCommand = DarcsCommand {commandProgramName = "darcs",+ commandName = "diff",+ commandHelp = diffHelp,+ commandDescription = diffDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp+ = ["[FILE or DIRECTORY]..."],+ commandCommand = diffCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [],+ commandBasicOptions = [matchRange,+ diffCmdFlag,+ diffflags, unidiff,+ workingRepoDir, storeInMemory]}++getDiffOpts :: [DarcsFlag] -> [String]+getDiffOpts opts | isNotUnified opts = get_nonU_diff_opts opts+ | otherwise = "-u" : get_nonU_diff_opts opts+ where get_nonU_diff_opts (DiffFlags f:fs) = f : get_nonU_diff_opts fs+ get_nonU_diff_opts (_:fs) = get_nonU_diff_opts fs+ get_nonU_diff_opts [] = []++hasDiffCmdFlag :: [DarcsFlag] -> Bool+hasDiffCmdFlag (DiffCmd _:_) = True+hasDiffCmdFlag (_:t) = hasDiffCmdFlag t+hasDiffCmdFlag [] = False++-- | Returns the command we should use for diff as a tuple (command, arguments).+-- This will either be whatever the user specified via --diff-command or the+-- default 'diffProgram'. Note that this potentially involves parsing the+-- user's diff-command, hence the possibility for failure with an exception.+getDiffCmdAndArgs :: String -> [DarcsFlag] -> String -> String+ -> Either String (String, [String])+getDiffCmdAndArgs cmd opts f1 f2 = helper opts where+ helper (DiffCmd c:_) =+ case parseCmd [ ('1', f1) , ('2', f2) ] c of+ Left err -> Left $ show err+ Right ([],_) -> bug $ "parseCmd should never return empty list"+ Right ((h:t),_) -> Right (h,t)+ helper [] = -- if no command specified, use 'diff'+ Right (cmd, ("-rN":getDiffOpts opts++[f1,f2]))+ helper (_:t) = helper t++diffCmd :: [DarcsFlag] -> [String] -> IO ()+diffCmd opts args+ | not (null [i | LastN i <- opts]) &&+ not (null [p | AfterPatch p <- opts]) =+ fail $ "using --patch and --last at the same time with the 'diff'" +++ " command doesn't make sense. Use --from-patch to create a diff" +++ " from this patch to the present, or use just '--patch' to view" +++ " this specific patch."+ | null args = doDiff opts Nothing+ | otherwise = doDiff opts . Just =<< fixSubPaths opts args++doDiff :: [DarcsFlag] -> Maybe [SubPath] -> IO ()+doDiff opts sps = withRepository opts $ RepoJob $ \repository -> do+ let pathList = map sp2fn `fmap` sps+ formerdir <- getCurrentDirectory+ withTempDirs (takeFileName formerdir) $ \odir ndir -> do+ if firstMatch opts+ then withCurrentDirectory odir $ getPartialFirstMatch repository opts pathList+ else case pathList of+ Nothing -> createPristineDirectoryTree repository $ toFilePath odir+ Just pl -> createPartialsPristineDirectoryTree repository pl $ toFilePath odir+ if secondMatch opts+ then withCurrentDirectory ndir $ getPartialSecondMatch repository opts pathList+ else withCurrentDirectory formerdir $+ readUnrecorded repository sps >>= (flip writePlainTree (toFilePath ndir))+ thediff <- withCurrentDirectory (toFilePath odir ++ "/..") $+ case pathList of+ Nothing -> rundiff (takeFileName $ toFilePath odir) (takeFileName $ toFilePath ndir)+ Just fs -> vcat `fmap`+ mapM (\f -> rundiff+ (takeFileName (toFilePath odir) ++ "/" ++ toFilePath f)+ (takeFileName (toFilePath ndir) ++ "/" ++ toFilePath f)) fs+ morepatches <- readRepo repository+ putDoc $ changelog (getDiffInfo opts morepatches)+ $$ thediff+ where rundiff :: String -> String -> IO Doc+ rundiff f1 f2 = do+ cmd <- diffProgram+ case getDiffCmdAndArgs cmd opts f1 f2 of+ Left err -> fail err+ Right (d_cmd, d_args) ->+ let other_diff = hasDiffCmdFlag opts in+ do when other_diff $ putStrLn $+ "Running command '" ++ unwords (d_cmd:d_args) ++ "'"+ output <- execPipeIgnoreError d_cmd d_args empty+ when other_diff $ do+-- Warning: A do-notation statement discarded a result of type String.+ _ <- askUser "Hit return to move on..."+ return ()+ return output++ withTempDirs :: String -> (AbsolutePath -> AbsolutePath -> IO a) -> IO a+ withTempDirs x f = withTempDir ("old-" ++ x) $ \odir ->+ withTempDir ("new-" ++ x) $ \ndir -> f odir ndir++getDiffInfo :: RepoPatch p => [DarcsFlag] -> PatchSet p C(start x) -> [PatchInfo]+getDiffInfo opts ps =+ let infos = mapRL info . newset2RL+ handle (match_cond, do_match)+ | match_cond opts = unseal infos (do_match opts ps)+ | otherwise = infos ps+ in handle (secondMatch, matchSecondPatchset)+ \\ handle (firstMatch, matchFirstPatchset)++changelog :: [PatchInfo] -> Doc+changelog pis = vcat $ map humanFriendly pis+
− src/Darcs/Commands/Diff.lhs
@@ -1,248 +0,0 @@-% Copyright (C) 2003-2004 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.--\darcsCommand{diff}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--module Darcs.Commands.Diff ( diffCommand ) where--import System.FilePath.Posix ( takeFileName )-import System.Directory ( setCurrentDirectory )-import Workaround ( getCurrentDirectory )-import Darcs.Utils ( askUser, withCurrentDirectory )-import Control.Monad ( when )-import Data.List ( (\\) )--import Storage.Hashed.Plain( writePlainTree )--import Darcs.External( diffProgram )-import CommandLine ( parseCmd )-import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Arguments ( DarcsFlag(DiffFlags, DiffCmd,- LastN, AfterPatch),- matchRange, storeInMemory,- diffCmdFlag, diffflags, unidiff,- workingRepoDir, fixSubPaths,- )-import Darcs.Flags ( isUnified )-import Darcs.Hopefully ( info )-import Darcs.RepoPath ( toFilePath, sp2fn )-import Darcs.Match ( getPartialFirstMatch, getPartialSecondMatch,- firstMatch, secondMatch,- matchFirstPatchset, matchSecondPatchset )-import Darcs.Repository ( withRepository, ($-), readRepo,- amInRepository,- createPristineDirectoryTree,- createPartialsPristineDirectoryTree )-import Darcs.Patch.Set ( PatchSet, newset2RL )-import Darcs.Repository.State ( readUnrecorded, restrictSubpaths )-import Darcs.Patch ( RepoPatch )-import Darcs.Witnesses.Ordered ( mapRL )-import Darcs.Patch.Info ( PatchInfo, humanFriendly )-import Darcs.External ( execPipeIgnoreError )-import Darcs.Lock ( withTempDir )-import Darcs.Witnesses.Sealed ( unseal )-import Printer ( Doc, putDoc, vcat, empty, ($$) )-#include "impossible.h"--#include "gadts.h"--diffDescription :: String-diffDescription = "Create a diff between two versions of the repository."--diffHelp :: String-diffHelp =- "Diff can be used to create a diff between two versions which are in your\n"++- "repository. Specifying just --from-patch will get you a diff against\n"++- "your working copy. If you give diff no version arguments, it gives\n"++- "you the same information as whatsnew except that the patch is\n"++- "formatted as the output of a diff command\n"--diffCommand :: DarcsCommand-diffCommand = DarcsCommand {commandName = "diff",- commandHelp = diffHelp,- commandDescription = diffDescription,- commandExtraArgs = -1,- commandExtraArgHelp- = ["[FILE or DIRECTORY]..."],- commandCommand = diffCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [],- commandBasicOptions = [matchRange,- diffCmdFlag,- diffflags, unidiff,- workingRepoDir, storeInMemory]}-\end{code}--\begin{options}---diff-opts-\end{options}--Diff calls an external ``diff'' command to do the actual work, and passes-any unrecognized flags to this diff command. Thus you can call-\begin{verbatim}-% darcs diff -t 0.9.8 -t 0.9.10 -- -u-\end{verbatim}-to get a diff in the unified format. Actually, thanks to the wonders of-getopt you need the ``\verb!--!'' shown above before any arguments to diff.-You can also specify additional arguments to diff using the-\verb!--diff-opts! flag. The above command would look like this:-\begin{verbatim}-% darcs diff --diff-opts -u -t 0.9.8 -t 0.9.10-\end{verbatim}-This may not seem like an improvement, but it really pays off when you want-to always give diff the same options. You can do this by adding-\begin{verbatim}-% diff diff-opts -udp-\end{verbatim}-to your \verb!_darcs/prefs/defaults! file.--\begin{code}-getDiffOpts :: [DarcsFlag] -> [String]-getDiffOpts opts | isUnified opts = "-u" : get_nonU_diff_opts opts- | otherwise = get_nonU_diff_opts opts- where get_nonU_diff_opts (DiffFlags f:fs) = f : get_nonU_diff_opts fs- get_nonU_diff_opts (_:fs) = get_nonU_diff_opts fs- get_nonU_diff_opts [] = []--hasDiffCmdFlag :: [DarcsFlag] -> Bool-hasDiffCmdFlag (DiffCmd _:_) = True-hasDiffCmdFlag (_:t) = hasDiffCmdFlag t-hasDiffCmdFlag [] = False---- | Returns the command we should use for diff as a tuple (command, arguments).--- This will either be whatever the user specified via --diff-command or the--- default 'diffProgram'. Note that this potentially involves parsing the--- user's diff-command, hence the possibility for failure with an exception.-getDiffCmdAndArgs :: String -> [DarcsFlag] -> String -> String- -> Either String (String, [String])-getDiffCmdAndArgs cmd opts f1 f2 = helper opts where- helper (DiffCmd c:_) =- case parseCmd [ ('1', f1) , ('2', f2) ] c of- Left err -> Left $ show err- Right ([],_) -> bug $ "parseCmd should never return empty list"- Right ((h:t),_) -> Right (h,t)- helper [] = -- if no command specified, use 'diff'- Right (cmd, ("-rN":getDiffOpts opts++[f1,f2]))- helper (_:t) = helper t-\end{code}--If you want to view only the differences to one or more files, you can do-so with a command such as-\begin{verbatim}-% darcs diff foo.c bar.c baz/-\end{verbatim}--\begin{options}---diff-command-\end{options}--You can use a different program to view differences by including-the flag \verb!--diff-command!, e.g.-\begin{verbatim}---diff-command 'opendiff %1 %2'.-\end{verbatim}-The \verb!%1! and \verb!%2! are replaced with the two versions to be-merged. The above example works with the FileMerge.app tool that comes with-Apple's developer tools. To use xxdiff, you would use-\begin{verbatim}---diff-command 'xxdiff %1 %2'-\end{verbatim}-To use \verb!kdiff3!, you can use-\begin{verbatim}---diff-command 'kdiff3 %1 %2'-\end{verbatim}--Note that the command is split into space-separated words and the first one is-\verb!exec!ed with the rest as arguments---it is not a shell command. Also-the substitution of the \verb!%! escapes is only done on complete words.-See \ref{resolution} for how you might work around this fact, for example,-with Emacs' Ediff package.--Note also that the \verb!--diff-opts! flag is ignored if you use this option.--\begin{code}-diffCmd :: [DarcsFlag] -> [String] -> IO ()-diffCmd opts args = withRepository opts $- \repository -> do- when (not (null [i | LastN i <- opts])- && not (null [p | AfterPatch p <- opts])- ) $- fail ("using --patch and --last at the same time with the 'diff' command"- ++ " doesn't make sense. Use --from-patch to create a diff from this"- ++ " patch to the present, or use just '--patch' to view this specific"- ++ " patch.")- formerdir <- getCurrentDirectory- subpaths <- if null args then return []- else fixSubPaths opts args- let path_list = map sp2fn subpaths- thename <- return $ takeFileName formerdir- withTempDir ("old-"++thename) $ \odir -> do- setCurrentDirectory formerdir- withTempDir ("new-"++thename) $ \ndir -> do- if firstMatch opts- then withCurrentDirectory odir $- getPartialFirstMatch repository opts path_list- else if null path_list- then createPristineDirectoryTree repository (toFilePath odir)- else createPartialsPristineDirectoryTree repository path_list (toFilePath odir)- if secondMatch opts- then withCurrentDirectory ndir $- getPartialSecondMatch repository opts path_list- else withCurrentDirectory formerdir $ do- readUnrecorded repository subpaths >>= (flip writePlainTree (toFilePath ndir))- thediff <- withCurrentDirectory (toFilePath odir ++ "/..") $- case path_list of- [] -> rundiff (takeFileName $ toFilePath odir) (takeFileName $ toFilePath ndir)- fs -> vcat `fmap`- mapM (\f -> rundiff- (takeFileName (toFilePath odir) ++ "/" ++ toFilePath f)- (takeFileName (toFilePath ndir) ++ "/" ++ toFilePath f)) fs- morepatches <- readRepo repository- putDoc $ changelog (getDiffInfo opts morepatches)- $$ thediff- where rundiff :: String -> String -> IO Doc- rundiff f1 f2 = do- cmd <- diffProgram- case getDiffCmdAndArgs cmd opts f1 f2 of- Left err -> fail err- Right (d_cmd, d_args) ->- let other_diff = hasDiffCmdFlag opts in- do when other_diff $ putStrLn $- "Running command '" ++ unwords (d_cmd:d_args) ++ "'"- output <- execPipeIgnoreError d_cmd d_args empty- when other_diff $ do- askUser "Hit return to move on..."- return ()- return output--getDiffInfo :: RepoPatch p => [DarcsFlag] -> PatchSet p C(start x) -> [PatchInfo]-getDiffInfo opts ps =- let infos = mapRL info . newset2RL- handle (match_cond, do_match)- | match_cond opts = unseal infos (do_match opts ps)- | otherwise = infos ps- in handle (secondMatch, matchSecondPatchset)- \\ handle (firstMatch, matchFirstPatchset)--changelog :: [PatchInfo] -> Doc-changelog pis = vcat $ map humanFriendly pis-\end{code}-
+ src/Darcs/Commands/Dist.hs view
@@ -0,0 +1,151 @@+-- Copyright (C) 2003 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.++module Darcs.Commands.Dist ( dist ) where+import System.Directory ( setCurrentDirectory )+import Workaround ( getCurrentDirectory )+import System.Exit ( ExitCode(..), exitWith )+import System.Cmd ( system )+import System.FilePath.Posix ( takeFileName, (</>) )+import Data.Char ( isAlphaNum )+import Control.Monad ( when )+import Codec.Archive.Tar ( pack, write )+import Codec.Archive.Tar.Entry ( entryPath )+import Codec.Compression.GZip ( compress )+import Prelude hiding ( writeFile )+import Data.ByteString.Lazy ( writeFile )++import Darcs.Commands ( DarcsCommand(..),+ nodefaults )+import Darcs.Arguments ( DarcsFlag(Verbose, DistName, SetScriptsExecutable), distnameOption,+ workingRepoDir, matchOne, storeInMemory,+ setScriptsExecutableOption )+import Darcs.Match ( getNonrangeMatch, haveNonrangeMatch )+import Darcs.Repository ( amInHashedRepository, withRepoReadLock, RepoJob(..), --withRecorded,+ setScriptsExecutable,+ createPartialsPristineDirectoryTree )+import Darcs.Repository.Prefs ( getPrefval )+import Darcs.Lock ( withTempDir )+import Darcs.RepoPath ( AbsolutePath, toFilePath )+import Darcs.Utils ( withCurrentDirectory )++distDescription :: String+distDescription = "Create a distribution tarball."++distHelp :: String+distHelp =+ "The `darcs dist' command creates a compressed archive (a `tarball') in\n" +++ "the repository's root directory, containing the recorded state of the\n" +++ "working tree (unrecorded changes and the _darcs directory are\n" +++ "excluded).\n" +++ "\n" +++ "If a predist command is set (see `darcs setpref'), that command will\n" +++ "be run on the tarball contents prior to archiving. For example,\n" +++ "autotools projects would set it to `autoconf && automake'.\n" +++ "\n" +++ "By default, the tarball (and the top-level directory within the\n" +++ "tarball) has the same name as the repository, but this can be\n" +++ "overridden with the --dist-name option.\n"++ -- FIXME: this is tedious and ugly.+ {-+ ++ "\n" +++ "Suppose you use a version numbering scheme `major.minor.patch', and\n" +++ "you tag each release `major.minor'. You can then calculate the\n" +++ "version number by taking the newest tag and appending a dot and the\n" +++ "number of patches since that tag. If you use the directory name as\n" +++ "the project name, you can make tarballs of the form name-version.tgz\n" +++ "using the following shell script:\n" +++ "\n" +++ " major_minor=$(darcs show tags | head -1) &&\n" +++ " patch_level=$(($(darcs changes --count --from-tag .) - 1)) &&\n" +++ " version=$major_minor.$patch_level &&\n" +++ " project=${PWD##*/} &&\n" +++ " darcs dist --dist-name \"$project\"-\"$version\".tar.gz\n"+ -}++dist :: DarcsCommand+dist = DarcsCommand {commandProgramName = "darcs",+ commandName = "dist",+ commandHelp = distHelp,+ commandDescription = distDescription,+ commandExtraArgs = 0,+ commandExtraArgHelp = [],+ commandCommand = distCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [],+ commandBasicOptions = [distnameOption,+ workingRepoDir,+ matchOne,+ setScriptsExecutableOption,+ storeInMemory]}++distCmd :: [DarcsFlag] -> [String] -> IO ()+distCmd opts _ = withRepoReadLock opts $ RepoJob $ \repository -> do+ distname <- getDistName opts+ verb <- return $ Verbose `elem` opts+ predist <- getPrefval "predist"+ formerdir <- getCurrentDirectory+ resultfile <- return (formerdir</>distname++".tar.gz")+ withTempDir "darcsdist" $ \tempdir -> do+ setCurrentDirectory (formerdir)+ withTempDir (toFilePath tempdir </> takeFileName distname) $ \ddir -> do+ if haveNonrangeMatch opts+ then withCurrentDirectory ddir $ getNonrangeMatch repository opts+ else createPartialsPristineDirectoryTree repository [""] (toFilePath ddir)+ ec <- case predist of Nothing -> return ExitSuccess+ Just pd -> system pd+ if (ec == ExitSuccess)+ then+ do+ withCurrentDirectory ddir $+ when (SetScriptsExecutable `elem` opts) setScriptsExecutable+ doDist verb tempdir ddir resultfile+ else+ do+ putStrLn "Dist aborted due to predist failure"+ exitWith ec++-- | This function performs the actual distribution action itself.+-- NB - it does /not/ perform the pre-dist, that should already+-- have completed successfully before this is invoked.+doDist :: Bool -> AbsolutePath -> AbsolutePath -> FilePath -> IO ()+doDist verb tempdir ddir resultfile = do+ setCurrentDirectory (toFilePath tempdir)+ let safeddir = safename $ takeFileName $ toFilePath ddir+ entries <- pack "." [safeddir]+ when verb $ putStr $ unlines $ map entryPath entries+ writeFile resultfile $ compress $ write entries+ putStrLn $ "Created dist as "++resultfile+ where+ safename n@(c:_) | isAlphaNum c = n+ safename n = "./" ++ n++guessRepoName :: IO String+guessRepoName = do+ pwd <- getCurrentDirectory+ if '/' `elem` pwd+ then return $ reverse $ takeWhile (/='/') $ reverse pwd+ else return "cantguessreponame"++getDistName :: [DarcsFlag] -> IO String+getDistName (DistName dn:_) = return dn+getDistName (_:fs) = getDistName fs+getDistName _ = guessRepoName+
− src/Darcs/Commands/Dist.lhs
@@ -1,154 +0,0 @@-% Copyright (C) 2003 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.--\darcsCommand{dist}-\begin{code}-module Darcs.Commands.Dist ( dist ) where-import System.Directory ( setCurrentDirectory )-import Workaround ( getCurrentDirectory )-import System.Exit ( ExitCode(..), exitWith )-import System.Cmd ( system )-import System.FilePath.Posix ( takeFileName, (</>) )-import Data.Char ( isAlphaNum )-import Control.Monad ( when )-import Codec.Archive.Tar ( pack, write )-import Codec.Archive.Tar.Entry ( entryPath )-import Codec.Compression.GZip ( compress )-import Prelude hiding ( writeFile )-import Data.ByteString.Lazy ( writeFile )--import Darcs.Commands ( DarcsCommand(DarcsCommand, commandName, commandHelp,- commandDescription, commandExtraArgs,- commandExtraArgHelp, commandCommand,- commandPrereq, commandGetArgPossibilities,- commandArgdefaults,- commandAdvancedOptions, commandBasicOptions),- nodefaults )-import Darcs.Arguments ( DarcsFlag(Verbose, DistName), distnameOption,- workingRepoDir, matchOne, storeInMemory,- fixSubPaths )-import Darcs.Match ( getNonrangeMatch, haveNonrangeMatch )-import Darcs.Repository ( amInRepository, withRepoReadLock, ($-), --withRecorded,- createPartialsPristineDirectoryTree )-import Darcs.Repository.Prefs ( getPrefval )-import Darcs.Lock ( withTempDir )-import Darcs.RepoPath ( AbsolutePath, toFilePath )-import Darcs.Utils ( withCurrentDirectory )--distDescription :: String-distDescription = "Create a distribution tarball."--distHelp :: String-distHelp =- "The `darcs dist' command creates a compressed archive (a `tarball') in\n" ++- "the repository's root directory, containing the recorded state of the\n" ++- "working tree (unrecorded changes and the _darcs directory are\n" ++- "excluded).\n" ++- "\n" ++- "If a predist command is set (see `darcs setpref'), that command will\n" ++- "be run on the tarball contents prior to archiving. For example,\n" ++- "autotools projects would set it to `autoconf && automake'.\n" ++- "\n" ++- "By default, the tarball (and the top-level directory within the\n" ++- "tarball) has the same name as the repository, but this can be\n" ++- "overridden with the --dist-name option.\n"-- -- FIXME: this is tedious and ugly.- {-- ++ "\n" ++- "Suppose you use a version numbering scheme `major.minor.patch', and\n" ++- "you tag each release `major.minor'. You can then calculate the\n" ++- "version number by taking the newest tag and appending a dot and the\n" ++- "number of patches since that tag. If you use the directory name as\n" ++- "the project name, you can make tarballs of the form name-version.tgz\n" ++- "using the following shell script:\n" ++- "\n" ++- " major_minor=$(darcs show tags | head -1) &&\n" ++- " patch_level=$(($(darcs changes --count --from-tag .) - 1)) &&\n" ++- " version=$major_minor.$patch_level &&\n" ++- " project=${PWD##*/} &&\n" ++- " darcs dist --dist-name \"$project\"-\"$version\".tar.gz\n"- -}--dist :: DarcsCommand-dist = DarcsCommand {commandName = "dist",- commandHelp = distHelp,- commandDescription = distDescription,- commandExtraArgs = 0,- commandExtraArgHelp = [],- commandCommand = distCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [],- commandBasicOptions = [distnameOption,- workingRepoDir,- matchOne,- storeInMemory]}--distCmd :: [DarcsFlag] -> [String] -> IO ()-distCmd opts args = withRepoReadLock opts $- \repository -> do- distname <- getDistName opts- verb <- return $ Verbose `elem` opts- predist <- getPrefval "predist"- formerdir <- getCurrentDirectory- path_list <- if null args- then return [""]- else map toFilePath `fmap` fixSubPaths opts args- resultfile <- return (formerdir</>distname++".tar.gz")- withTempDir "darcsdist" $ \tempdir -> do- setCurrentDirectory (formerdir)- withTempDir (toFilePath tempdir </> takeFileName distname) $ \ddir -> do- if haveNonrangeMatch opts- then withCurrentDirectory ddir $ getNonrangeMatch repository opts- else createPartialsPristineDirectoryTree repository path_list (toFilePath ddir)- ec <- case predist of Nothing -> return ExitSuccess- Just pd -> system pd- if (ec == ExitSuccess) then doDist verb tempdir ddir resultfile- else- do- putStrLn "Dist aborted due to predist failure"- exitWith ec---- | This function performs the actual distribution action itself.--- NB - it does /not/ perform the pre-dist, that should already--- have completed successfully before this is invoked.-doDist :: Bool -> AbsolutePath -> AbsolutePath -> FilePath -> IO ()-doDist verb tempdir ddir resultfile = do- setCurrentDirectory (toFilePath tempdir)- let safeddir = safename $ takeFileName $ toFilePath ddir- entries <- pack "." [safeddir]- when verb $ putStr $ unlines $ map entryPath entries- writeFile resultfile $ compress $ write entries- putStrLn $ "Created dist as "++resultfile- where- safename n@(c:_) | isAlphaNum c = n- safename n = "./" ++ n--guessRepoName :: IO String-guessRepoName = do- pwd <- getCurrentDirectory- if '/' `elem` pwd- then return $ reverse $ takeWhile (/='/') $ reverse pwd- else return "cantguessreponame"--getDistName :: [DarcsFlag] -> IO String-getDistName (DistName dn:_) = return dn-getDistName (_:fs) = getDistName fs-getDistName _ = guessRepoName-\end{code}-
+ src/Darcs/Commands/GZCRCs.hs view
@@ -0,0 +1,185 @@+-- Copyright (C) 2009 Ganesh Sittampalam+--+-- Permission is hereby granted, free of charge, to any person+-- obtaining a copy of this software and associated documentation+-- files (the "Software"), to deal in the Software without+-- restriction, including without limitation the rights to use, copy,+-- modify, merge, publish, distribute, sublicense, and/or sell copies+-- of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be+-- included in all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+-- BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+-- ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+-- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+-- SOFTWARE.++{-# LANGUAGE CPP #-}+module Darcs.Commands.GZCRCs ( gzcrcs, doCRCWarnings ) where++import Control.Arrow ( first )+import Control.Monad ( when, unless )+import Control.Monad.Trans ( liftIO )+import Control.Monad.Writer ( runWriterT, tell )+import Data.List ( intersperse )+import Data.Monoid ( Any(..), Sum(..) )++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL++import System.Directory ( getDirectoryContents, doesFileExist, doesDirectoryExist )+import System.Exit ( ExitCode(..), exitWith )+import System.IO ( hPutStr, hPutStrLn, stderr )+import Data.IORef ( newIORef, readIORef, writeIORef )++import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Arguments ( DarcsFlag( Quiet, Verbose, Check, Repair, JustThisRepo ),+ checkOrRepair, workingRepoDir, justThisRepo+ )+import Darcs.Repository ( Repository, amInRepository, withRepository, RepoJob(..) )+import Darcs.Patch ( RepoPatch )+import Printer ( putDocLn, text )+import ByteStringUtils ( isGZFile )+import Darcs.Lock ( gzWriteAtomicFilePSs )++-- This command needs access beyond the normal repository APIs (to+-- get at the caches and inspect them directly)+-- Could move the relevant code into Darcs.Repository modules+-- but it doesn't really seem worth it.+import Darcs.Repository.InternalTypes ( extractCache )+import Darcs.Repository.Cache ( Cache(..), writable, isthisrepo, hashedFilePath, allHashedDirs )+++import Darcs.Global ( getCRCWarnings, resetCRCWarnings )+import ByteStringUtils ( gzDecompress )++#include "gadts.h"++gzcrcsDescription :: String+gzcrcsDescription = "Check or repair the CRCs of compressed files in the repository."++gzcrcsHelp :: String+gzcrcsHelp = formatText+ [+ "Versions of darcs >=1.0.4 and <2.2.0 had a bug that caused compressed files " +++ "with bad CRCs (but valid data) to be written out. CRCs were not checked on " +++ "reading, so this bug wasn't noticed.",+ "This command inspects your repository for this corruption and optionally repairs it.",+ "By default it also does this for any caches you have configured and any other " +++ "local repositories listed as sources of patches for this one, perhaps because of a " +++ "lazy get. You can limit the scope to just the current repo with the --just-this-repo " +++ "flag.",+ "Note that readonly caches, or other repositories listed as sources, " +++ "will be checked but not repaired. Also, this command will abort if it encounters " +++ "any non-CRC corruption in compressed files.",+ "You may wish to also run 'darcs check --complete' before repairing the corruption. " +++ "This is not done automatically because it might result in needing to fetch extra " +++ "patches if the repository is lazy.",+ "If there are any other problems with your repository, you can still repair the CRCs, " +++ "but you are advised to first make a backup copy in case the CRC errors are actually " +++ "caused by bad data and the old CRCs might be useful in recovering that data.",+ "If you were warned about CRC errors during an operation involving another repository, " +++ "then it is possible that the other repository contains the corrupt CRCs, so you " +++ "should arrange for that repository to also be checked/repaired."+ ]++formatText :: [String] -> String+formatText = unlines . concat . intersperse [""] . map (map unwords . para 80 . words)++-- |Take a list of words and split it up so that each chunk fits into the specified width+-- when spaces are included. Any words longer than the specified width end up in a chunk+-- of their own.+para :: Int -> [[a]] -> [[[a]]]+para w = para'+ where para' [] = []+ para' xs = uncurry (:) $ para'' w xs+ para'' r (x:xs) | w == r || length x < r = first (x:) $ para'' (r - length x - 1) xs+ para'' _ xs = ([], para' xs)++-- |This is designed for use in an atexit handler, e.g. in Darcs.RunCommand+doCRCWarnings :: Bool -> IO ()+doCRCWarnings verbose = do+ files <- getCRCWarnings+ resetCRCWarnings+ when (not . null $ files) $ do+ hPutStr stderr . formatText $+ ["",+ "Warning: CRC errors found. These are probably harmless but should " +++ "be repaired. See 'darcs gzcrcs --help' for more information.",+ ""]+ when verbose $ hPutStrLn stderr $ unlines ("The following corrupt files were found:":files)++gzcrcs :: DarcsCommand+gzcrcs = DarcsCommand {commandProgramName = "darcs",+ commandName = "gzcrcs",+ commandHelp = gzcrcsHelp,+ commandDescription = gzcrcsDescription,+ commandExtraArgs = 0,+ commandExtraArgHelp = [],+ commandCommand = gzcrcsCmd,+ commandPrereq = amInRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [],+ commandBasicOptions = [checkOrRepair,+ justThisRepo,+ workingRepoDir+ ]}++gzcrcsCmd :: [DarcsFlag] -> [String] -> IO ()+gzcrcsCmd opts _ | Check `elem` opts || Repair `elem` opts = withRepository opts (RepoJob (gzcrcs' opts))+gzcrcsCmd _ _ = error "You must specify --check or --repair for gzcrcs"++gzcrcs'+ :: (RepoPatch p) => [DarcsFlag] -> Repository p C(r u t) -> IO ()+gzcrcs' opts repo = do+ let Ca locs = extractCache repo+ -- Somewhat ugly IORef use here because it's convenient, would be nicer+ -- to pre-filter the list of locs to check and then decide whether to+ -- print the message up front.+ warnRelatedRepos <- newIORef (JustThisRepo `notElem` opts)+ ((), Any checkFailed) <- runWriterT $ flip mapM_ locs $ \loc -> do+ unless (JustThisRepo `elem` opts && not (isthisrepo loc)) $ do+ let w = writable loc+ flip mapM_ allHashedDirs $ \hdir -> do+ let dir = hashedFilePath loc hdir ""+ exists <- liftIO $ doesDirectoryExist dir+ when exists $ do+ liftIO $ do+ warn <- readIORef warnRelatedRepos+ when (warn && not (isthisrepo loc)) $ do+ writeIORef warnRelatedRepos False+ putInfo $ text "Also checking related repos and caches; use --just-this-repo to disable."+ liftIO $ putInfo $ text $ "Checking " ++ dir ++ (if w then "" else " (readonly)")+ files <- liftIO $ getDirectoryContents dir+ ((), Sum count) <- runWriterT $ flip mapM_ files $ \file -> do+ let fn = dir ++ file+ isfile <- liftIO $ doesFileExist fn+ when isfile $ do+ gz <- liftIO $ isGZFile fn+ case gz of+ Nothing -> return ()+ Just len -> do+ contents <- liftIO $ B.readFile fn+ let (uncompressed, isCorrupt) = gzDecompress (Just len) . BL.fromChunks $ [contents]+ when isCorrupt $ do+ tell (Sum 1) -- count of files in current directory+ liftIO $ putVerbose $ text $ "Corrupt: " ++ fn+ when (w && Repair `elem` opts) $ liftIO $ gzWriteAtomicFilePSs fn uncompressed+ when (count > (0 :: Int)) $ do+ liftIO $ putInfo $ text $+ "Found " ++ show count ++ " corrupt file" ++ (if count > 1 then "s" else "") +++ (if Repair `elem` opts then (if w then " (repaired)" else " (not repaired") else "")+ tell (Any True) -- something corrupt somewhere+ when (Check `elem` opts && checkFailed) $ exitWith $ ExitFailure 1++ where+ putInfo s = when (not $ Quiet `elem` opts) $ putDocLn s+ putVerbose s = when (Verbose `elem` opts) $ putDocLn s+
− src/Darcs/Commands/GZCRCs.lhs
@@ -1,188 +0,0 @@-% Copyright (C) 2009 Ganesh Sittampalam-%-% Permission is hereby granted, free of charge, to any person-% obtaining a copy of this software and associated documentation-% files (the "Software"), to deal in the Software without-% restriction, including without limitation the rights to use, copy,-% modify, merge, publish, distribute, sublicense, and/or sell copies-% of the Software, and to permit persons to whom the Software is-% furnished to do so, subject to the following conditions:-%-% The above copyright notice and this permission notice shall be-% included in all copies or substantial portions of the Software.-%-% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,-% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF-% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND-% NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS-% BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN-% ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN-% CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE-% SOFTWARE.--\subsection{darcs gzcrcs}-\darcsCommand{gzcrcs}-\begin{code}-{-# LANGUAGE CPP #-}-module Darcs.Commands.GZCRCs ( gzcrcs, doCRCWarnings ) where--import Control.Arrow ( first )-import Control.Monad ( when, unless )-import Control.Monad.Trans ( liftIO )-import Control.Monad.Writer ( runWriterT, tell )-import Data.List ( intersperse )-import Data.Monoid ( Any(..), Sum(..) )--import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL--import System.Directory ( getDirectoryContents, doesFileExist, doesDirectoryExist )-import System.Exit ( ExitCode(..), exitWith )-import System.IO ( hPutStr, hPutStrLn, stderr )-import Data.IORef ( newIORef, readIORef, writeIORef )--import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Arguments ( DarcsFlag( Quiet, Verbose, Check, Repair, JustThisRepo ),- checkOrRepair, workingRepoDir, justThisRepo- )-import Darcs.Repository ( Repository, amInRepository, withRepository )-import Darcs.Patch ( RepoPatch )-import Printer ( putDocLn, text )-import ByteStringUtils ( isGZFile )-import Darcs.Lock ( gzWriteAtomicFilePSs )---- This command needs access beyond the normal repository APIs (to--- get at the caches and inspect them directly)--- Could move the relevant code into Darcs.Repository modules--- but it doesn't really seem worth it.-import Darcs.Repository.InternalTypes ( extractCache )-import Darcs.Repository.Cache ( Cache(..), writable, isthisrepo, hashedFilePath, allHashedDirs )---import Darcs.Global ( getCRCWarnings, resetCRCWarnings )-import ByteStringUtils ( gzDecompress )--#include "gadts.h"--gzcrcsDescription :: String-gzcrcsDescription = "Check or repair the CRCs of compressed files in the repository."--gzcrcsHelp :: String-gzcrcsHelp = formatText- [- "Versions of darcs >=1.0.4 and <2.2.0 had a bug that caused compressed files " ++- "with bad CRCs (but valid data) to be written out. CRCs were not checked on " ++- "reading, so this bug wasn't noticed.",- "This command inspects your repository for this corruption and optionally repairs it.",- "By default it also does this for any caches you have configured and any other " ++- "local repositories listed as sources of patches for this one, perhaps because of a " ++- "lazy get. You can limit the scope to just the current repo with the --just-this-repo " ++- "flag.",- "Note that readonly caches, or other repositories listed as sources, " ++- "will be checked but not repaired. Also, this command will abort if it encounters " ++- "any non-CRC corruption in compressed files.",- "You may wish to also run 'darcs check --complete' before repairing the corruption. " ++- "This is not done automatically because it might result in needing to fetch extra " ++- "patches if the repository is lazy.",- "If there are any other problems with your repository, you can still repair the CRCs, " ++- "but you are advised to first make a backup copy in case the CRC errors are actually " ++- "caused by bad data and the old CRCs might be useful in recovering that data.",- "If you were warned about CRC errors during an operation involving another repository, " ++- "then it is possible that the other repository contains the corrupt CRCs, so you " ++- "should arrange for that repository to also be checked/repaired."- ]--formatText :: [String] -> String-formatText = unlines . concat . intersperse [""] . map (map unwords . para 80 . words)---- |Take a list of words and split it up so that each chunk fits into the specified width--- when spaces are included. Any words longer than the specified width end up in a chunk--- of their own.-para :: Int -> [[a]] -> [[[a]]]-para w = para'- where para' [] = []- para' xs = uncurry (:) $ para'' w xs- para'' r (x:xs) | w == r || length x < r = first (x:) $ para'' (r - length x - 1) xs- para'' _ xs = ([], para' xs)---- |This is designed for use in an atexit handler, e.g. in Darcs.RunCommand-doCRCWarnings :: Bool -> IO ()-doCRCWarnings verbose = do- files <- getCRCWarnings- resetCRCWarnings- when (not . null $ files) $ do- hPutStr stderr . formatText $- ["",- "Warning: CRC errors found. These are probably harmless but should " ++- "be repaired. See 'darcs gzcrcs --help' for more information.",- ""]- when verbose $ hPutStrLn stderr $ unlines ("The following corrupt files were found:":files)--gzcrcs :: DarcsCommand-gzcrcs = DarcsCommand {commandName = "gzcrcs",- commandHelp = gzcrcsHelp,- commandDescription = gzcrcsDescription,- commandExtraArgs = 0,- commandExtraArgHelp = [],- commandCommand = gzcrcsCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [],- commandBasicOptions = [checkOrRepair,- justThisRepo,- workingRepoDir- ]}--gzcrcsCmd :: [DarcsFlag] -> [String] -> IO ()-gzcrcsCmd opts _ | Check `elem` opts || Repair `elem` opts = withRepository opts (gzcrcs' opts)-gzcrcsCmd _ _ = error "You must specify --check or --repair for gzcrcs"--gzcrcs'- :: (RepoPatch p) => [DarcsFlag] -> Repository p C(r u t) -> IO ()-gzcrcs' opts repo = do- let Ca locs = extractCache repo- -- Somewhat ugly IORef use here because it's convenient, would be nicer- -- to pre-filter the list of locs to check and then decide whether to- -- print the message up front.- warnRelatedRepos <- newIORef (JustThisRepo `notElem` opts)- ((), Any checkFailed) <- runWriterT $ flip mapM_ locs $ \loc -> do- unless (JustThisRepo `elem` opts && not (isthisrepo loc)) $ do- let w = writable loc- flip mapM_ allHashedDirs $ \hdir -> do- let dir = hashedFilePath loc hdir ""- exists <- liftIO $ doesDirectoryExist dir- when exists $ do- liftIO $ do- warn <- readIORef warnRelatedRepos- when (warn && not (isthisrepo loc)) $ do- writeIORef warnRelatedRepos False- putInfo $ text "Also checking related repos and caches; use --just-this-repo to disable."- liftIO $ putInfo $ text $ "Checking " ++ dir ++ (if w then "" else " (readonly)")- files <- liftIO $ getDirectoryContents dir- ((), Sum count) <- runWriterT $ flip mapM_ files $ \file -> do- let fn = dir ++ file- isfile <- liftIO $ doesFileExist fn- when isfile $ do- gz <- liftIO $ isGZFile fn- case gz of- Nothing -> return ()- Just len -> do- contents <- liftIO $ B.readFile fn- let (uncompressed, isCorrupt) = gzDecompress (Just len) . BL.fromChunks $ [contents]- when isCorrupt $ do- tell (Sum 1) -- count of files in current directory- liftIO $ putVerbose $ text $ "Corrupt: " ++ fn- when (w && Repair `elem` opts) $ liftIO $ gzWriteAtomicFilePSs fn uncompressed- when (count > (0 :: Int)) $ do- liftIO $ putInfo $ text $- "Found " ++ show count ++ " corrupt file" ++ (if count > 1 then "s" else "") ++- (if Repair `elem` opts then (if w then " (repaired)" else " (not repaired") else "")- tell (Any True) -- something corrupt somewhere- when (Check `elem` opts && checkFailed) $ exitWith $ ExitFailure 1-- where- putInfo s = when (not $ Quiet `elem` opts) $ putDocLn s- putVerbose s = when (Verbose `elem` opts) $ putDocLn s--\end{code}
+ src/Darcs/Commands/Get.hs view
@@ -0,0 +1,260 @@+-- Copyright (C) 2002-2005 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.++{-# LANGUAGE CPP #-}++module Darcs.Commands.Get ( get, clone ) where++import System.Directory ( setCurrentDirectory, doesDirectoryExist, doesFileExist,+ createDirectory )+import Workaround ( getCurrentDirectory )+import Control.Monad ( when )++import Darcs.Commands ( DarcsCommand(..), nodefaults, commandAlias, putInfo )+import Darcs.Flags( compression )+import Darcs.Arguments ( DarcsFlag( NewRepo, Lazy,+ UseFormat2, UseHashedInventory,+ SetScriptsExecutable, OnePattern ),+ getContext,+ partial, reponame,+ matchOneContext, setDefault, setScriptsExecutableOption,+ networkOptions, makeScriptsExecutable, usePacks )+import Darcs.Repository ( Repository, withRepository, RepoJob(..), withRepoLock, identifyRepositoryFor, readRepo,+ tentativelyRemovePatches, patchSetToRepository,+ copyRepository, tentativelyAddToPending,+ finalizeRepositoryChanges, setScriptsExecutable+ , invalidateIndex )+import Darcs.Repository.Format ( identifyRepoFormat, RepoFormat,+ RepoProperty ( Darcs2, HashedInventory ), formatHas )+import Darcs.Repository (createRepository)+import Darcs.Patch ( RepoPatch, apply, invert, effect )+import Darcs.Witnesses.Ordered ( lengthFL, mapFL_FL, (:>)(..) )+import Darcs.Patch.PatchInfoAnd ( hopefully )+import Darcs.Patch.Depends ( findCommonWithThem, countUsThem )+import Darcs.Repository.Prefs ( setDefaultrepo )+import Darcs.Repository.Motd ( showMotd )+import Darcs.Match ( havePatchsetMatch, getOnePatchset )+import Progress ( debugMessage )+import Printer ( text, errorDoc, ($$) )+import Darcs.Lock ( writeBinFile )+import Darcs.RepoPath ( toFilePath, toPath, ioAbsoluteOrRemote)+import Darcs.Witnesses.Sealed ( Sealed(..) )+import Darcs.Global ( darcsdir )+import English ( englishNum, Noun(..) )+#include "gadts.h"++getDescription :: String+getDescription = "Create a local copy of a repository."++getHelp :: String+getHelp =+ "Get creates a local copy of a repository. The optional second\n" +++ "argument specifies a destination directory for the new copy; if\n" +++ "omitted, it is inferred from the source location.\n" +++ "\n" +++ "By default Darcs will copy every patch from the original repository.\n" +++ "This means the copy is completely independent of the original; you can\n" +++ "operate on the new repository even when the original is inaccessible.\n" +++ "If you expect the original repository to remain accessible, you can\n" +++ "use --lazy to avoid copying patches until they are needed (`copy on\n" +++ "demand'). This is particularly useful when copying a remote\n" +++ "repository with a long history that you don't care about.\n" +++ "\n" +++ "The --lazy option isn't as useful for local copies, because Darcs will\n" +++ "automatically use `hard linking' where possible. As well as saving\n" +++ "time and space, you can move or delete the original repository without\n" +++ "affecting a complete, hard-linked copy. Hard linking requires that\n" +++ "the copy be on the same filesystem and the original repository, and\n" +++ "that the filesystem support hard linking. This includes NTFS, HFS+\n" +++ "and all general-purpose Unix filesystems (such as ext3, UFS and ZFS).\n" +++ "FAT does not support hard links.\n" +++ "\n" +++ "Darcs get will not copy unrecorded changes to the source repository's\n" +++ "working tree.\n" +++ "\n" +++ getHelpTag++get :: DarcsCommand+get = DarcsCommand {commandProgramName = "darcs",+ commandName = "get",+ commandHelp = getHelp,+ commandDescription = getDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["<REPOSITORY>", "[<DIRECTORY>]"],+ commandCommand = getCmd,+ commandPrereq = contextExists,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = usePacks:networkOptions,+ commandBasicOptions = [reponame,+ partial,+ matchOneContext,+ setDefault True,+ setScriptsExecutableOption]}++clone :: DarcsCommand+clone = commandAlias "clone" Nothing get++getCmd :: [DarcsFlag] -> [String] -> IO ()+getCmd opts [inrepodir, outname] = getCmd (NewRepo outname:opts) [inrepodir]+getCmd opts [inrepodir] = do+ debugMessage "Starting work on get..."+ typed_repodir <- ioAbsoluteOrRemote inrepodir+ let repodir = toPath typed_repodir+ showMotd opts repodir+ rfsource <- identifyRepoFormat repodir+ debugMessage $ "Found the format of "++repodir++"..."+ mysimplename <- makeRepoName opts repodir+ createDirectory mysimplename+ setCurrentDirectory mysimplename+ let opts' = if formatHas Darcs2 rfsource+ then UseFormat2:opts+ else UseHashedInventory:filter (/= UseFormat2) opts+ createRepository opts'+ debugMessage "Finished initializing new directory."+ setDefaultrepo repodir opts++ writeBinFile (darcsdir++"/hashed_inventory") ""++ if not (null [p | OnePattern p <- opts]) -- --to-match given+ && not (Lazy `elem` opts)+ then withRepository opts $ RepoJob $ \repository -> do+ debugMessage "Using economical get --to-match handling"+ fromrepo <- identifyRepositoryFor repository repodir+ Sealed patches_to_get <- getOnePatchset fromrepo opts+-- Warning: A do-notation statement discarded a result of type Repository p ghc-prim+ _ <- patchSetToRepository fromrepo patches_to_get opts+ debugMessage "Finished converting selected patch set to new repository"+ else copyRepoAndGoToChosenVersion opts repodir rfsource+getCmd _ _ = fail "You must provide 'get' with either one or two arguments."++-- | called by getCmd+-- assumes that the target repo of the get is the current directory, and that an inventory in the+-- right format has already been created.+copyRepoAndGoToChosenVersion :: [DarcsFlag] -> String -> RepoFormat -> IO ()+copyRepoAndGoToChosenVersion opts repodir rfsource = do+ copyRepo+ withRepository opts $ RepoJob $ \repository -> goToChosenVersion repository opts+ putInfo opts $ text "Finished getting."+ where copyRepo =+ withRepository opts $ RepoJob $ \repository -> do+ if formatHas HashedInventory rfsource+ then do+ debugMessage "Identifying and copying repository..."+ copyRepoHashed repository+ else do+ putInfo opts $ text "***********************************************************************"+ $$ text " _______ Sorry for the wait! The repository you are fetching is"+ $$ text " | | using the DEPRECATED 'old-fashioned' format. I'm getting a"+ $$ text " | O O | hashed copy instead, but this may take a while."+ $$ text " | ___ |"+ $$ text " | / \\ | We recommend that the maintainer upgrade the remote copy"+ $$ text " |_______| as well. See http://wiki.darcs.net/OF for more information."+ $$ text ""+ $$ text "***********************************************************************"+ copyRepoHashed repository+ copyRepoHashed repository =+ do identifyRepositoryFor repository repodir >>= copyRepository+ when (SetScriptsExecutable `elem` opts) setScriptsExecutable++makeRepoName :: [DarcsFlag] -> FilePath -> IO String+makeRepoName (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+makeRepoName (_:as) d = makeRepoName as d+makeRepoName [] d =+ case dropWhile (=='.') $ reverse $+ takeWhile (\c -> c /= '/' && c /= ':') $+ dropWhile (=='/') $ reverse d of+ "" -> modifyRepoName "anonymous_repo"+ base -> modifyRepoName base++modifyRepoName :: String -> IO String+modifyRepoName 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++getHelpTag :: String+getHelpTag =+ "It is often desirable to make a copy of a repository that excludes\n" +++ "some patches. For example, if releases are tagged then `darcs get\n" +++ "--tag .' would make a copy of the repository as at the latest release.\n" +++ "\n" +++ "An untagged repository state can still be identified unambiguously by\n" +++ "a context file, as generated by `darcs changes --context'. Given the\n" +++ "name of such a file, the --context option will create a repository\n" +++ "that includes only the patches from that context. When a user reports\n" +++ "a bug in an unreleased version of your project, the recommended way to\n" +++ "find out exactly what version they were running is to have them\n" +++ "include a context file in the bug report.\n" +++ "\n" +++ "You can also make a copy of an untagged state using the --to-patch or\n" +++ "--to-match options, which exclude patches `after' the first matching\n" +++ "patch. Because these options treat the set of patches as an ordered\n" +++ "sequence, you may get different results after reordering with `darcs\n" +++ "optimize', so tagging is preferred.\n"++contextExists :: [DarcsFlag] -> IO (Either String ())+contextExists opts =+ case getContext opts of+ Nothing -> return $ Right ()+ Just f -> do exists <- doesFileExist $ toFilePath f+ return $ if exists+ then Right ()+ else Left $ "Context file "++toFilePath f++" does not exist"++goToChosenVersion :: RepoPatch p => Repository p C(r u r)+ -> [DarcsFlag] -> IO ()+goToChosenVersion repository opts =+ when (havePatchsetMatch opts) $ do+ debugMessage "Going to specified version..."+ patches <- readRepo repository+ Sealed context <- getOnePatchset repository opts+ when (snd (countUsThem patches context) > 0) $+ errorDoc $ text "Missing patches from context!" -- FIXME : - (+ _ :> us' <- return $ findCommonWithThem patches context+ let ps = mapFL_FL hopefully us'+ putInfo opts $ text $ "Unapplying " ++ (show $ lengthFL ps) ++ " " +++ (englishNum (lengthFL ps) (Noun "patch") "")+ invalidateIndex repository+ withRepoLock opts $ RepoJob $ \_ ->+-- Warning: A do-notation statement discarded a result of type Repository p r u z.+ do _ <- tentativelyRemovePatches repository (compression opts) us'+ tentativelyAddToPending repository opts $ invert $ effect us'+ finalizeRepositoryChanges repository+ apply (invert $ effect ps) `catch` \e ->+ fail ("Couldn't undo patch in working dir.\n" ++ show e)+ makeScriptsExecutable opts (invert $ effect ps)+
− src/Darcs/Commands/Get.lhs
@@ -1,357 +0,0 @@-% Copyright (C) 2002-2005 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.--\darcsCommand{get}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--module Darcs.Commands.Get ( get, clone ) where--import System.Directory ( setCurrentDirectory, doesDirectoryExist, doesFileExist,- createDirectory )-import Workaround ( getCurrentDirectory )-import Data.Maybe ( isJust )-import Control.Monad ( when )--import Darcs.Commands ( DarcsCommand(..), nodefaults, commandAlias, putInfo )-import Darcs.Arguments ( DarcsFlag( NewRepo, Partial, Lazy,- UseFormat2, UseOldFashionedInventory, UseHashedInventory,- SetScriptsExecutable, OnePattern ),- getContext, getInventoryChoices,- partial, reponame,- matchOneContext, setDefault, setScriptsExecutableOption, nolinks,- networkOptions )-import Darcs.Repository ( Repository, withRepository, ($-), withRepoLock, identifyRepositoryFor, readRepo,- createPristineDirectoryTree,- tentativelyRemovePatches, patchSetToRepository,- copyRepository, tentativelyAddToPending,- finalizeRepositoryChanges, setScriptsExecutable- , invalidateIndex )-import Darcs.Repository.Format ( identifyRepoFormat, RepoFormat,- RepoProperty ( Darcs2, HashedInventory ), formatHas )-import Darcs.Repository.DarcsRepo ( writeInventory )-import qualified Darcs.Repository.DarcsRepo as DR ( readRepo )-import Darcs.Repository ( SealedPatchSet, copyOldrepoPatches,- createRepository)-import Darcs.Patch.Set ( PatchSet(..), newset2RL )-#ifdef GADT_WITNESSES-import Darcs.Patch.Set ( Origin )-#endif-import Darcs.Repository.ApplyPatches ( applyPatches )-import Darcs.Repository.Checkpoint ( writeCheckpointPatch, getCheckpoint )-import Darcs.Patch ( RepoPatch, Patch, apply, patch2patchinfo, invert, effect )-import Darcs.Witnesses.Ordered ( RL(..), reverseRL, lengthFL, mapFL_FL, (:>>)(..) )-import Darcs.External ( copyFileOrUrl, Cachable(..) )-import Darcs.Hopefully ( hopefully )-import Darcs.Patch.Depends ( findCommonWithThem, countUsThem, getPatchesBeyondTag )-import Darcs.Repository.Prefs ( setDefaultrepo )-import Darcs.Repository.Motd ( showMotd )-import Darcs.Repository.Pristine ( identifyPristine, createPristineFromWorking, )-import Darcs.SignalHandler ( catchInterrupt )-import Darcs.Commands.Init ( initialize )-import Darcs.Match ( havePatchsetMatch, getOnePatchset )-import Darcs.Utils ( catchall, formatPath, withCurrentDirectory, prettyError )-import Progress ( debugMessage )-import Printer ( text, vcat, errorDoc, ($$) )-import Darcs.Lock ( writeBinFile )-import Darcs.RepoPath ( toFilePath, toPath, ioAbsoluteOrRemote)-import Darcs.Witnesses.Sealed ( Sealed(..), FlippedSeal(..) )-import Darcs.Global ( darcsdir )-import English ( englishNum, Noun(..) )-#include "impossible.h"-#include "gadts.h"--getDescription :: String-getDescription = "Create a local copy of a repository."--getHelp :: String-getHelp =- "Get creates a local copy of a repository. The optional second\n" ++- "argument specifies a destination directory for the new copy; if\n" ++- "omitted, it is inferred from the source location.\n" ++- "\n" ++- "By default Darcs will copy every patch from the original repository.\n" ++- "This means the copy is completely independent of the original; you can\n" ++- "operate on the new repository even when the original is inaccessible.\n" ++- "If you expect the original repository to remain accessible, you can\n" ++- "use --lazy to avoid copying patches until they are needed (`copy on\n" ++- "demand'). This is particularly useful when copying a remote\n" ++- "repository with a long history that you don't care about.\n" ++- "\n" ++- "The --lazy option isn't as useful for local copies, because Darcs will\n" ++- "automatically use `hard linking' where possible. As well as saving\n" ++- "time and space, you can move or delete the original repository without\n" ++- "affecting a complete, hard-linked copy. Hard linking requires that\n" ++- "the copy be on the same filesystem and the original repository, and\n" ++- "that the filesystem support hard linking. This includes NTFS, HFS+\n" ++- "and all general-purpose Unix filesystems (such as ext3, UFS and ZFS).\n" ++- "FAT does not support hard links.\n" ++- "\n" ++- "Darcs get will not copy unrecorded changes to the source repository's\n" ++- "working tree.\n" ++- "\n" ++- getHelpTag ++- "\n" ++- -- The remaining help text covers backwards-compatibility options.- getHelpPartial ++- "\n" ++- "A repository created by `darcs get' will be in the best available\n" ++- "format: it will be able to exchange patches with the source\n" ++- "repository, but will not be directly readable by Darcs binaries older\n" ++- "than 2.0.0. Use the `--old-fashioned-inventory' option if the latter\n" ++- "is required.\n"--get :: DarcsCommand-get = DarcsCommand {commandName = "get",- commandHelp = getHelp,- commandDescription = getDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["<REPOSITORY>", "[<DIRECTORY>]"],- commandCommand = getCmd,- commandPrereq = contextExists,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = networkOptions ++- commandAdvancedOptions initialize,- commandBasicOptions = [reponame,- partial,- matchOneContext,- setDefault True,- setScriptsExecutableOption,- nolinks,- getInventoryChoices]}--clone :: DarcsCommand-clone = commandAlias "clone" Nothing get--getCmd :: [DarcsFlag] -> [String] -> IO ()-getCmd opts [inrepodir, outname] = getCmd (NewRepo outname:opts) [inrepodir]-getCmd opts [inrepodir] = do- debugMessage "Starting work on get..."- typed_repodir <- ioAbsoluteOrRemote inrepodir- let repodir = toPath typed_repodir- showMotd opts repodir- when (Partial `elem` opts) $ debugMessage "Reading checkpoint..."- rfsource_or_e <- identifyRepoFormat repodir- rfsource <- case rfsource_or_e of Left e -> fail e- Right x -> return x- debugMessage $ "Found the format of "++repodir++"..."- mysimplename <- makeRepoName opts repodir- createDirectory mysimplename- setCurrentDirectory mysimplename- when (formatHas Darcs2 rfsource && UseOldFashionedInventory `elem` opts) $- putInfo opts $ text "Warning: 'old-fashioned-inventory' is ignored with a darcs-2 repository\n"- let opts' = if formatHas Darcs2 rfsource- then UseFormat2:opts- else if not (UseOldFashionedInventory `elem` opts)- then UseHashedInventory:filter (/= UseFormat2) opts- else UseOldFashionedInventory:filter (/= UseFormat2) opts- createRepository opts'- debugMessage "Finished initializing new directory."- setDefaultrepo repodir opts-- rf_or_e <- identifyRepoFormat "."- rf <- case rf_or_e of Left e -> fail e- Right x -> return x- if formatHas HashedInventory rf -- refactor this into repository- then writeBinFile (darcsdir++"/hashed_inventory") ""- else writeInventory "." (PatchSet NilRL NilRL :: PatchSet Patch C(Origin Origin))-- if not (null [p | OnePattern p <- opts]) -- --to-match given- && not (Partial `elem` opts) && not (Lazy `elem` opts)- then withRepository opts $- \repository -> do- debugMessage "Using economical get --to-match handling"- fromrepo <- identifyRepositoryFor repository repodir- Sealed patches_to_get <- getOnePatchset fromrepo opts- patchSetToRepository fromrepo patches_to_get opts- debugMessage "Finished converting selected patch set to new repository"- else copyRepoAndGoToChosenVersion opts repodir rfsource rf-getCmd _ _ = fail "You must provide 'get' with either one or two arguments."---- | called by getCmd--- assumes that the target repo of the get is the current directory, and that an inventory in the--- right format has already been created.-copyRepoAndGoToChosenVersion :: [DarcsFlag] -> String -> RepoFormat -> RepoFormat -> IO ()-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- putInfo opts $ text "Converting old-fashioned repository to hashed format..."- $$ text "*******************************************************************************"- $$ text "Fetching a hashed repository would be faster. Perhaps you could persuade"- $$ text "the maintainer to run darcs optimize --upgrade with darcs 2.4.0 or higher?"- $$ text "*******************************************************************************"- copyRepoHashed repository- | hashThem -> do- putInfo opts $ text "Fetching a hashed repository as an old-fashioned one..."- copyRepoHashed repository- | otherwise -> copyRepoOldFashioned repository opts repodir- copyRepoHashed repository =- do identifyRepositoryFor repository repodir >>= copyRepository- when (SetScriptsExecutable `elem` opts) setScriptsExecutable--makeRepoName :: [DarcsFlag] -> FilePath -> IO String-makeRepoName (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-makeRepoName (_:as) d = makeRepoName as d-makeRepoName [] d =- case dropWhile (=='.') $ reverse $- takeWhile (\c -> c /= '/' && c /= ':') $- dropWhile (=='/') $ reverse d of- "" -> modifyRepoName "anonymous_repo"- base -> modifyRepoName base--modifyRepoName :: String -> IO String-modifyRepoName 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--getHelpTag :: String-getHelpTag =- "It is often desirable to make a copy of a repository that excludes\n" ++- "some patches. For example, if releases are tagged then `darcs get\n" ++- "--tag .' would make a copy of the repository as at the latest release.\n" ++- "\n" ++- "An untagged repository state can still be identified unambiguously by\n" ++- "a context file, as generated by `darcs changes --context'. Given the\n" ++- "name of such a file, the --context option will create a repository\n" ++- "that includes only the patches from that context. When a user reports\n" ++- "a bug in an unreleased version of your project, the recommended way to\n" ++- "find out exactly what version they were running is to have them\n" ++- "include a context file in the bug report.\n" ++- "\n" ++- "You can also make a copy of an untagged state using the --to-patch or\n" ++- "--to-match options, which exclude patches `after' the first matching\n" ++- "patch. Because these options treat the set of patches as an ordered\n" ++- "sequence, you may get different results after reordering with `darcs\n" ++- "optimize', so tagging is preferred.\n"--contextExists :: [DarcsFlag] -> IO (Either String ())-contextExists opts =- case getContext opts of- Nothing -> return $ Right ()- Just f -> do exists <- doesFileExist $ toFilePath f- if exists- then return $ Right ()- else return . Left $ "Context file "++toFilePath f++" does not exist"--goToChosenVersion :: RepoPatch p => Repository p C(r u r)- -> [DarcsFlag] -> IO ()-goToChosenVersion repository opts =- when (havePatchsetMatch opts) $ do- debugMessage "Going to specified version..."- patches <- readRepo repository- Sealed context <- getOnePatchset repository opts- when (snd (countUsThem patches context) > 0) $- errorDoc $ text "Missing patches from context!" -- FIXME : - (- _ :>> us' <- return $ findCommonWithThem patches context- let ps = mapFL_FL hopefully us'- putInfo opts $ text $ "Unapplying " ++ (show $ lengthFL ps) ++ " " ++- (englishNum (lengthFL ps) (Noun "patch") "")- invalidateIndex repository- withRepoLock opts $- \_ ->- do tentativelyRemovePatches repository opts us'- tentativelyAddToPending repository opts $ invert $ effect us'- finalizeRepositoryChanges repository- apply opts (invert $ effect ps) `catch` \e ->- fail ("Couldn't undo patch in working dir.\n" ++ show e)---getHelpPartial :: String-getHelpPartial =- "If the source repository is in a legacy darcs-1 format and contains at\n" ++- "least one checkpoint (see `darcs optimize'), the --partial option will\n" ++- "create a partial repository. A partial repository discards history\n" ++- "from before the checkpoint in order to reduce resource requirements.\n" ++- "For modern darcs-2 repositories, --partial is a deprecated alias for\n" ++- "the --lazy option.\n"--copyRepoOldFashioned :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> String -> IO ()-copyRepoOldFashioned repository opts repodir = do- myname <- getCurrentDirectory- fromrepo <- identifyRepositoryFor repository repodir- mch <- getCheckpoint fromrepo- patches <- readRepo fromrepo- debugMessage "Getting the inventory..."- writeInventory "." patches- debugMessage "Copying patches..."- copyOldrepoPatches opts fromrepo "."- debugMessage "Patches copied"- Sealed local_patches <- DR.readRepo opts "." :: IO (SealedPatchSet Patch C(Origin))- debugMessage "Repo read"- repo_is_local <- doesDirectoryExist repodir- debugMessage $ "Repo local: " ++ formatPath (show repo_is_local)- if repo_is_local && not (Partial `elem` opts)- then do- debugMessage "Copying prefs"- copyFileOrUrl opts- (repodir++"/"++darcsdir++"/prefs/prefs") (darcsdir++"/prefs/prefs") (MaxAge 600)- `catchall` return ()- debugMessage "Writing working directory"- createPristineDirectoryTree fromrepo myname- withCurrentDirectory myname $ do- -- note: SetScriptsExecutable is normally checked in PatchApply- -- but darcs get on local repositories does not apply patches- if SetScriptsExecutable `elem` opts- then setScriptsExecutable- else return ()- else do- setCurrentDirectory myname- if Partial `elem` opts && isJust mch- then do Sealed p_ch <- return (fromJust mch)- let pi_ch = patch2patchinfo p_ch- FlippedSeal needed_patches <- return (getPatchesBeyondTag pi_ch local_patches)- writeCheckpointPatch p_ch- apply opts p_ch `catch`- \e -> fail ("Bad checkpoint!!!\n" ++ prettyError e)- applyPatches opts (reverseRL needed_patches)- else applyPatches opts $ reverseRL $ newset2RL local_patches- debugMessage "Writing the pristine"- pristine <- identifyPristine- createPristineFromWorking pristine- setCurrentDirectory myname--\end{code}
+ src/Darcs/Commands/Help.hs view
@@ -0,0 +1,289 @@+-- Copyright (C) 2002-2004 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.++module Darcs.Commands.Help (+ helpCmd,+ commandControlList, environmentHelp, -- these are for preproc.hs+ printVersion,+ listAvailableCommands ) where++import Darcs.Arguments ( DarcsFlag(..), environmentHelpEmail, environmentHelpSendmail )+import Darcs.Commands (+ CommandArgs(..), CommandControl(..), DarcsCommand(..),+ disambiguateCommands, extractCommands, getCommandHelp, nodefaults, usage )+import Darcs.External ( viewDoc )+import Darcs.Lock ( environmentHelpTmpdir, environmentHelpKeepTmpdir )+import Darcs.Patch.Match ( helpOnMatchers )+import Darcs.Repository.Prefs ( boringFileHelp, binariesFileHelp, environmentHelpHome )+import Darcs.Utils ( withCurrentDirectory, environmentHelpEditor, environmentHelpPager )+import Data.Char ( isAlphaNum, toLower )+import Data.List ( groupBy, isPrefixOf )+import English ( andClauses )+import Printer ( text )+import Ssh ( environmentHelpSsh, environmentHelpScp, environmentHelpSshPort )+import System.Exit ( ExitCode(..), exitWith )+import Version ( version )+import URL (environmentHelpProxy, environmentHelpProxyPassword)+import Workaround ( getCurrentDirectory )+import qualified Darcs.TheCommands as TheCommands++helpDescription :: String+helpDescription = "Display help about darcs and darcs commands."++helpHelp :: String+helpHelp =+ "Without arguments, `darcs help' prints a categorized list of darcs\n" +++ "commands and a short description of each one. With an extra argument,\n" +++ "`darcs help foo' prints detailed help about the darcs command foo.\n"++help :: DarcsCommand+help = DarcsCommand {commandProgramName = "darcs",+ commandName = "help",+ commandHelp = helpHelp,+ commandDescription = helpDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["[<DARCS_COMMAND> [DARCS_SUBCOMMAND]] "],+ commandCommand = \ x y -> helpCmd x y >> exitWith ExitSuccess,+ commandPrereq = \_ -> return $ Right (),+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [],+ commandBasicOptions = []}++helpCmd :: [DarcsFlag] -> [String] -> IO ()+helpCmd _ ["manpage"] = putStr $ unlines manpageLines+helpCmd _ ["patterns"] = viewDoc $ text $ helpOnMatchers+helpCmd _ ["environment"] = viewDoc $ text $ helpOnEnvironment+helpCmd _ [] = viewDoc $ text $ usage commandControlList++helpCmd _ (cmd:args) =+ let disambiguated = disambiguateCommands commandControlList cmd args+ in case disambiguated of+ Left err -> fail err+ Right (cmds,_) ->+ let msg = case cmds of+ CommandOnly c -> getCommandHelp Nothing c+ SuperCommandOnly c -> getCommandHelp Nothing c+ SuperCommandSub c s -> getCommandHelp (Just c) s+ in viewDoc $ text msg++listAvailableCommands :: IO ()+listAvailableCommands =+ do here <- getCurrentDirectory+ is_valid <- mapM+ (\c-> withCurrentDirectory here $ (commandPrereq c) [])+ (extractCommands commandControlList)+ putStr $ unlines $ map (commandName . fst) $+ filter (isRight.snd) $+ zip (extractCommands commandControlList) is_valid+ putStrLn "--help"+ putStrLn "--version"+ putStrLn "--exact-version"+ putStrLn "--overview"+ where isRight (Right _) = True+ isRight _ = False++printVersion :: IO ()+printVersion = putStrLn $ "darcs version " ++ version++-- avoiding a module import cycle between Help and TheCommands+commandControlList :: [CommandControl]+commandControlList =+ CommandData help : TheCommands.commandControlList++-- FIXME: the "grouping" comments below should made subsections in the+-- manpage, as we already do for DarcsCommand groups. --twb, 2009++-- | Help on each environment variable in which Darcs is interested.+environmentHelp :: [([String], [String])]+environmentHelp = [+ -- General-purpose+ environmentHelpHome,+ environmentHelpEditor,+ environmentHelpPager,+ environmentHelpTmpdir,+ environmentHelpKeepTmpdir,+ environmentHelpEmail,+ environmentHelpSendmail,+ -- Remote Repositories+ environmentHelpSsh,+ environmentHelpScp,+ environmentHelpSshPort,+ environmentHelpProxy,+ environmentHelpProxyPassword]++-- | The rendered form of the data in 'environment_help'.+helpOnEnvironment :: String+helpOnEnvironment =+ "Environment Variables\n" +++ "=====================\n\n" +++ unlines [andClauses ks ++ ":\n" +++ (unlines $ map (" " ++) ds)+ | (ks, ds) <- environmentHelp]++-- | This module is responsible for emitting a darcs "man-page", a+-- reference document used widely on Unix-like systems. Manpages are+-- primarily used as a quick reference, or "memory jogger", so the+-- output should be terser than the user manual.+--+-- Before modifying the output, please be sure to read the man(7) and+-- man-pages(7) manpages, as these respectively describe the relevant+-- syntax and conventions.++-- | The lines of the manpage to be printed.+manpageLines :: [String]+manpageLines = [+ ".TH DARCS 1 \"" ++ version ++ "\"",+ ".SH NAME",+ "darcs \\- an advanced revision control system",+ ".SH SYNOPSIS",+ ".B darcs", ".I command", ".RI < arguments |[ options ]>...",+ "",+ "Where the", ".I commands", "and their respective", ".I arguments", "are",+ "",+ unlines synopsis,+ ".SH DESCRIPTION",+ -- FIXME: this is copy-and-pasted from darcs.cabal, so+ -- it'll get out of date as people forget to maintain+ -- both in sync.+ "Darcs is a free, open source revision control",+ "system. It is:",+ ".TP 3", "\\(bu",+ "Distributed: Every user has access to the full",+ "command set, removing boundaries between server and",+ "client or committer and non\\(hycommitters.",+ ".TP", "\\(bu",+ "Interactive: Darcs is easy to learn and efficient to",+ "use because it asks you questions in response to",+ "simple commands, giving you choices in your work",+ "flow. You can choose to record one change in a file,",+ "while ignoring another. As you update from upstream,",+ "you can review each patch name, even the full `diff'",+ "for interesting patches.",+ ".TP", "\\(bu",+ "Smart: Originally developed by physicist David",+ "Roundy, darcs is based on a unique algebra of",+ "patches.",+ "This smartness lets you respond to changing demands",+ "in ways that would otherwise not be possible. Learn",+ "more about spontaneous branches with darcs.",+ ".SH OPTIONS",+ "Different options are accepted by different Darcs commands.",+ "Each command's most important options are listed in the",+ ".B COMMANDS",+ "section. For a full list of all options accepted by",+ "a particular command, run `darcs", ".I command", "\\-\\-help'.",+ ".SS " ++ escape helpOnMatchers, -- FIXME: this is a kludge.+ ".SH COMMANDS",+ unlines commands,+ unlines environment,+ ".SH FILES",+ ".SS \"_darcs/prefs/binaries\"",+ escape $ unlines binariesFileHelp,+ ".SS \"_darcs/prefs/boring\"",+ escape $ unlines boringFileHelp,+ ".SH BUGS",+ "At http://bugs.darcs.net/ you can find a list of known",+ "bugs in Darcs. Unknown bugs can be reported at that",+ "site (after creating an account) or by emailing the",+ "report to bugs@darcs.net.",+ -- ".SH EXAMPLE",+ -- FIXME:+ -- new project: init, rec -la;+ -- track upstream project: get, pull -a;+ -- contribute to project: add, rec, push/send.+ ".SH SEE ALSO",+ "A user manual is included with Darcs, in PDF and HTML",+ "form. It can also be found at http://darcs.net/manual/.",+ ".SH LICENSE",+ "Darcs 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." ]+ where+ -- | A synopsis line for each command. Uses 'foldl' because it is+ -- necessary to avoid blank lines from Hidden_commands, as groff+ -- translates them into annoying vertical padding (unlike TeX).+ synopsis :: [String]+ synopsis = foldl iter [] commandControlList+ where iter :: [String] -> CommandControl -> [String]+ iter acc (GroupName _) = acc+ iter acc (HiddenCommand _) = acc+ iter acc (CommandData c@SuperCommand {}) =+ acc ++ concatMap+ (render (commandName c ++ " "))+ (extractCommands (commandSubCommands c))+ iter acc (CommandData c) = acc ++ render "" c+ render :: String -> DarcsCommand -> [String]+ render prefix c =+ [".B darcs " ++ prefix ++ commandName c] +++ (map mangle_args $ commandExtraArgHelp c) +++ -- In the output, we want each command to be on its own+ -- line, but we don't want blank lines between them.+ -- AFAICT this can only be achieved with the .br+ -- directive, which is probably a GNUism.+ [".br"]++ -- | As 'synopsis', but make each group a subsection (.SS), and+ -- include the help text for each command.+ commands :: [String]+ commands = foldl iter [] commandControlList+ where iter :: [String] -> CommandControl -> [String]+ iter acc (GroupName x) = acc ++ [".SS \"" ++ x ++ "\""]+ iter acc (HiddenCommand _) = acc+ iter acc (CommandData c@SuperCommand {}) =+ acc ++ concatMap+ (render (commandName c ++ " "))+ (extractCommands (commandSubCommands c))+ iter acc (CommandData c) = acc ++ render "" c+ render :: String -> DarcsCommand -> [String]+ render prefix c =+ [".B darcs " ++ prefix ++ commandName c] +++ (map mangle_args $ commandExtraArgHelp c) +++ [".RS 4", escape $ commandHelp c, ".RE"]++ -- | Now I'm showing off: mangle the extra arguments of Darcs commands+ -- so as to use the ideal format for manpages, italic words and roman+ -- punctuation.+ mangle_args :: String -> String+ mangle_args s =+ ".RI " ++ (unwords $ map show (groupBy cmp $ map toLower $ gank s))+ where cmp x y = not $ xor (isAlphaNum x) (isAlphaNum y)+ xor x y = (x && not y) || (y && not x)+ gank (' ':'o':'r':' ':xs) = '|' : gank xs+ gank (x:xs) = x : gank xs+ gank [] = []++ environment :: [String]+ environment = ".SH ENVIRONMENT" : concat+ [(".SS \"" ++ andClauses ks ++ "\"") : map escape ds+ | (ks, ds) <- environmentHelp]++ -- | Copied from Preproc.escape_latex_specials.+ escape :: String -> String+ escape = minus . bs -- Order is important+ where+ minus = replace "-" "\\-"+ bs = replace "\\" "\\\\"++ replace :: Eq a => [a] -> [a] -> [a] -> [a]+ replace _ _ [] = []+ replace find repl s =+ if find `isPrefixOf` s+ then repl ++ (replace find repl (drop (length find) s))+ else [head s] ++ replace find repl (tail s)+
− src/Darcs/Commands/Help.lhs
@@ -1,284 +0,0 @@-% Copyright (C) 2002-2004 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.--\darcsCommand{help}-\begin{code}-module Darcs.Commands.Help (- helpCmd,- commandControlList, environmentHelp, -- these are for preproc.hs- printVersion,- listAvailableCommands ) where--import Darcs.Arguments ( DarcsFlag(..), environmentHelpEmail, environmentHelpSendmail )-import Darcs.Commands (- CommandArgs(..), CommandControl(..), DarcsCommand(..),- disambiguateCommands, extractCommands, getCommandHelp, nodefaults, usage )-import Darcs.External ( viewDoc )-import Darcs.Lock ( environmentHelpTmpdir, environmentHelpKeepTmpdir )-import Darcs.Patch.Match ( helpOnMatchers )-import Darcs.Repository.Prefs ( binariesFileHelp, environmentHelpHome )-import Darcs.Utils ( withCurrentDirectory, environmentHelpEditor, environmentHelpPager )-import Data.Char ( isAlphaNum, toLower )-import Data.List ( groupBy )-import English ( andClauses )-import Printer ( text )-import Ssh ( environmentHelpSsh, environmentHelpScp, environmentHelpSshPort )-import System.Exit ( ExitCode(..), exitWith )-import Version ( version )-import URL (environmentHelpProxy, environmentHelpProxyPassword)-import Workaround ( getCurrentDirectory )-import qualified Darcs.TheCommands as TheCommands--helpDescription :: String-helpDescription = "Display help about darcs and darcs commands."--helpHelp :: String-helpHelp =- "Without arguments, `darcs help' prints a categorized list of darcs\n" ++- "commands and a short description of each one. With an extra argument,\n" ++- "`darcs help foo' prints detailed help about the darcs command foo.\n"--help :: DarcsCommand-help = DarcsCommand {commandName = "help",- commandHelp = helpHelp,- commandDescription = helpDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["[<DARCS_COMMAND> [DARCS_SUBCOMMAND]] "],- commandCommand = \ x y -> helpCmd x y >> exitWith ExitSuccess,- commandPrereq = \_ -> return $ Right (),- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [],- commandBasicOptions = []}--helpCmd :: [DarcsFlag] -> [String] -> IO ()-helpCmd _ ["manpage"] = putStr $ unlines manpageLines-helpCmd _ ["patterns"] = viewDoc $ text $ helpOnMatchers-helpCmd _ ["environment"] = viewDoc $ text $ helpOnEnvironment-helpCmd _ [] = viewDoc $ text $ usage commandControlList--helpCmd _ (cmd:args) =- let disambiguated = disambiguateCommands commandControlList cmd args- in case disambiguated of- Left err -> fail err- Right (cmds,_) ->- let msg = case cmds of- CommandOnly c -> getCommandHelp Nothing c- SuperCommandOnly c -> getCommandHelp Nothing c- SuperCommandSub c s -> getCommandHelp (Just c) s- in viewDoc $ text msg--listAvailableCommands :: IO ()-listAvailableCommands =- do here <- getCurrentDirectory- is_valid <- mapM- (\c-> withCurrentDirectory here $ (commandPrereq c) [])- (extractCommands commandControlList)- putStr $ unlines $ map (commandName . fst) $- filter (isRight.snd) $- zip (extractCommands commandControlList) is_valid- putStrLn "--help"- putStrLn "--version"- putStrLn "--exact-version"- putStrLn "--overview"- where isRight (Right _) = True- isRight _ = False--printVersion :: IO ()-printVersion = putStrLn $ "darcs version " ++ version---- avoiding a module import cycle between Help and TheCommands-commandControlList :: [CommandControl]-commandControlList =- CommandData help : TheCommands.commandControlList---- FIXME: the "grouping" comments below should made subsections in the--- manpage, as we already do for DarcsCommand groups. --twb, 2009---- | Help on each environment variable in which Darcs is interested.-environmentHelp :: [([String], [String])]-environmentHelp = [- -- General-purpose- environmentHelpHome,- environmentHelpEditor,- environmentHelpPager,- environmentHelpTmpdir,- environmentHelpKeepTmpdir,- environmentHelpEmail,- environmentHelpSendmail,- -- Remote Repositories- environmentHelpSsh,- environmentHelpScp,- environmentHelpSshPort,- environmentHelpProxy,- environmentHelpProxyPassword]---- | The rendered form of the data in 'environment_help'.-helpOnEnvironment :: String-helpOnEnvironment =- "Environment Variables\n" ++- "=====================\n\n" ++- unlines [andClauses ks ++ ":\n" ++- (unlines $ map (" " ++) ds)- | (ks, ds) <- environmentHelp]---- | This module is responsible for emitting a darcs "man-page", a--- reference document used widely on Unix-like systems. Manpages are--- primarily used as a quick reference, or "memory jogger", so the--- output should be terser than the user manual.------ Before modifying the output, please be sure to read the man(7) and--- man-pages(7) manpages, as these respectively describe the relevant--- syntax and conventions.---- | The lines of the manpage to be printed.-manpageLines :: [String]-manpageLines = [- ".TH DARCS 1 \"" ++ version ++ "\"",- ".SH NAME",- "darcs \\- an advanced revision control system",- ".SH SYNOPSIS",- ".B darcs", ".I command", ".RI < arguments |[ options ]>...",- "",- "Where the", ".I commands", "and their respective", ".I arguments", "are",- "",- unlines synopsis,- ".SH DESCRIPTION",- -- FIXME: this is copy-and-pasted from darcs.cabal, so- -- it'll get out of date as people forget to maintain- -- both in sync.- "Darcs is a free, open source revision control",- "system. It is:",- ".TP 3", "\\(bu",- "Distributed: Every user has access to the full",- "command set, removing boundaries between server and",- "client or committer and non\\(hycommitters.",- ".TP", "\\(bu",- "Interactive: Darcs is easy to learn and efficient to",- "use because it asks you questions in response to",- "simple commands, giving you choices in your work",- "flow. You can choose to record one change in a file,",- "while ignoring another. As you update from upstream,",- "you can review each patch name, even the full `diff'",- "for interesting patches.",- ".TP", "\\(bu",- "Smart: Originally developed by physicist David",- "Roundy, darcs is based on a unique algebra of",- "patches.",- "This smartness lets you respond to changing demands",- "in ways that would otherwise not be possible. Learn",- "more about spontaneous branches with darcs.",- ".SH OPTIONS",- "Different options are accepted by different Darcs commands.",- "Each command's most important options are listed in the",- ".B COMMANDS",- "section. For a full list of all options accepted by",- "a particular command, run `darcs", ".I command", "\\-\\-help'.",- ".SS " ++ escape helpOnMatchers, -- FIXME: this is a kludge.- ".SH COMMANDS",- unlines commands,- unlines environment,- ".SH FILES",- ".SS \"_darcs/prefs/binaries\"",- escape $ unlines binariesFileHelp,- ".SH BUGS",- "At http://bugs.darcs.net/ you can find a list of known",- "bugs in Darcs. Unknown bugs can be reported at that",- "site (after creating an account) or by emailing the",- "report to bugs@darcs.net.",- -- ".SH EXAMPLE",- -- FIXME:- -- new project: init, rec -la;- -- track upstream project: get, pull -a;- -- contribute to project: add, rec, push/send.- ".SH SEE ALSO",- "A user manual is included with Darcs, in PDF and HTML",- "form. It can also be found at http://darcs.net/manual/."]- where- -- | A synopsis line for each command. Uses 'foldl' because it is- -- necessary to avoid blank lines from Hidden_commands, as groff- -- translates them into annoying vertical padding (unlike TeX).- synopsis :: [String]- synopsis = foldl iter [] commandControlList- where iter :: [String] -> CommandControl -> [String]- iter acc (GroupName _) = acc- iter acc (HiddenCommand _) = acc- iter acc (CommandData c@SuperCommand {}) =- acc ++ concatMap- (render (commandName c ++ " "))- (extractCommands (commandSubCommands c))- iter acc (CommandData c) = acc ++ render "" c- render :: String -> DarcsCommand -> [String]- render prefix c =- [".B darcs " ++ prefix ++ commandName c] ++- (map mangle_args $ commandExtraArgHelp c) ++- -- In the output, we want each command to be on its own- -- line, but we don't want blank lines between them.- -- AFAICT this can only be achieved with the .br- -- directive, which is probably a GNUism.- [".br"]-- -- | As 'synopsis', but make each group a subsection (.SS), and- -- include the help text for each command.- commands :: [String]- commands = foldl iter [] commandControlList- where iter :: [String] -> CommandControl -> [String]- iter acc (GroupName x) = acc ++ [".SS \"" ++ x ++ "\""]- iter acc (HiddenCommand _) = acc- iter acc (CommandData c@SuperCommand {}) =- acc ++ concatMap- (render (commandName c ++ " "))- (extractCommands (commandSubCommands c))- iter acc (CommandData c) = acc ++ render "" c- render :: String -> DarcsCommand -> [String]- render prefix c =- [".B darcs " ++ prefix ++ commandName c] ++- (map mangle_args $ commandExtraArgHelp c) ++- [".RS 4", escape $ commandHelp c, ".RE"]-- -- | Now I'm showing off: mangle the extra arguments of Darcs commands- -- so as to use the ideal format for manpages, italic words and roman- -- punctuation.- mangle_args :: String -> String- mangle_args s =- ".RI " ++ (unwords $ map show (groupBy cmp $ map toLower $ gank s))- where cmp x y = not $ xor (isAlphaNum x) (isAlphaNum y)- xor x y = (x && not y) || (y && not x)- gank (' ':'o':'r':' ':xs) = '|' : gank xs- gank (x:xs) = x : gank xs- gank [] = []-- environment :: [String]- environment = ".SH ENVIRONMENT" : concat- [(".SS \"" ++ andClauses ks ++ "\"") : map escape ds- | (ks, ds) <- environmentHelp]-- -- | Copied from Preproc.escape_latex_specials.- escape :: String -> String- escape = minus . bs -- Order is important- where- minus = replace "-" "\\-"- bs = replace "\\" "\\\\"-- replace :: Eq a => [a] -> [a] -> [a] -> [a]- replace _ _ [] = []- replace find repl s =- if take (length find) s == find- then repl ++ (replace find repl (drop (length find) s))- else [head s] ++ replace find repl (tail s)--\end{code}
+ src/Darcs/Commands/Init.hs view
@@ -0,0 +1,61 @@+-- Copyright (C) 2002-2003 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.++module Darcs.Commands.Init ( initialize, initializeCmd ) where+import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Arguments ( DarcsFlag, workingRepoDir,+ patchFormatChoices )+import Darcs.Repository ( amNotInRepository, createRepository )++initializeDescription :: String+initializeDescription = "Make the current directory a repository."++initializeHelp :: String+initializeHelp =+ "The `darcs initialize' command turns the current directory into a\n" +++ "Darcs repository. Any existing files and subdirectories become\n" +++ "UNSAVED changes: record them with `darcs record --look-for-adds'.\n" +++ "\n" +++ "This command creates the `_darcs' directory, which stores version\n" +++ "control metadata. It also contains per-repository settings in\n" +++ "_darcs/prefs/, which you can read about in the user manual.\n" +++ "\n" +++ "By default, patches of the new repository are in the darcs-2 semantics.\n" +++ "However it is possible to create a repository in darcs-1 semantics with\n" +++ "the flag `--hashed', althought this is not recommended except for sharing\n" +++ "patches with a project that uses patches in the darcs-1 semantics.\n" +++ "\n" +++ "Initialize is commonly abbreviated to `init'.\n"++initialize :: DarcsCommand+initialize = DarcsCommand {commandProgramName = "darcs",+ commandName = "initialize",+ commandHelp = initializeHelp,+ commandDescription = initializeDescription,+ commandExtraArgs = 0,+ commandExtraArgHelp = [],+ commandPrereq = amNotInRepository,+ commandCommand = initializeCmd,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [],+ commandBasicOptions = [patchFormatChoices,+ workingRepoDir]}++initializeCmd :: [DarcsFlag] -> [String] -> IO ()+initializeCmd opts _ = createRepository opts+
− src/Darcs/Commands/Init.lhs
@@ -1,89 +0,0 @@-% Copyright (C) 2002-2003 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.--\darcsCommand{initialize}-\begin{code}-module Darcs.Commands.Init ( initialize, initializeCmd ) where-import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Arguments ( DarcsFlag, workingRepoDir,- inventoryChoices )-import Darcs.Repository ( amNotInRepository, createRepository )--initializeDescription :: String-initializeDescription = "Make the current directory a repository."--initializeHelp :: String-initializeHelp =- "The `darcs initialize' command turns the current directory into a\n" ++- "Darcs repository. Any existing files and subdirectories become\n" ++- "UNSAVED changes in the working tree: record them with `darcs add -r'\n" ++- "and `darcs record'.\n" ++- "\n" ++- -- FIXME: confirm my assertion re conversion is true. --twb, 2008-12-14- "When converting a project to Darcs from some other VCS, translating\n" ++- "the full revision history to native Darcs patches is recommended.\n" ++- "(The Darcs wiki lists utilities for this.) Because Darcs is optimized\n" ++- "for small patches, simply importing the latest revision as a single\n" ++- "large patch can PERMANENTLY degrade Darcs performance in your\n" ++- "repository by an order of magnitude.\n" ++- "\n" ++- "This command creates the `_darcs' directory, which stores version\n" ++- "control metadata. It also contains per-repository settings in\n" ++- "_darcs/prefs/, which you can read about in the user manual.\n" ++- "\n" ++- "In addition to the default `darcs-2' format, there are two backward\n" ++- "compatibility formats for the _darcs directory. These formats are\n" ++- "only useful if some of your contributors do not have access to Darcs\n" ++- "2.0 or higher. In that case, you need to use the original format\n" ++- "(called `old-fashioned inventory' or `darcs-1') for any repositories\n" ++- "those contributors access.\n" ++- "\n" ++- "As patches cannot be shared between darcs-2 and darcs-1 repositories,\n" ++- "you cannot use the darcs-2 format for private branches of such a\n" ++- "project. Instead, you should use the `hashed' format, which provides\n" ++- "most of the features of the darcs-2 format, while retaining the\n" ++- "ability to share patches with darcs-1 repositories. The `darcs get'\n" ++- "command will do this by default.\n" ++- "\n" ++- "Once all contributors have access to Darcs 2.0 or higher, a darcs-1\n" ++- "project can be migrated to darcs-2 using the `darcs convert' command.\n" ++- "\n" ++- "Darcs will create a hashed repository by default when you `darcs get'\n" ++- "a repository in old-fashioned inventory format. Once all contributors\n" ++- "have upgraded to Darcs 2.0 or later, use `darcs convert' to convert\n" ++- "the project to the darcs-2 format.\n" ++- "\n" ++- "Initialize is commonly abbreviated to `init'.\n"--initialize :: DarcsCommand-initialize = DarcsCommand {commandName = "initialize",- commandHelp = initializeHelp,- commandDescription = initializeDescription,- commandExtraArgs = 0,- commandExtraArgHelp = [],- commandPrereq = amNotInRepository,- commandCommand = initializeCmd,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [],- commandBasicOptions = [inventoryChoices,- workingRepoDir]}--initializeCmd :: [DarcsFlag] -> [String] -> IO ()-initializeCmd opts _ = createRepository opts-\end{code}-
+ src/Darcs/Commands/MarkConflicts.hs view
@@ -0,0 +1,109 @@+-- Copyright (C) 2002-2003,2005 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.++{-# LANGUAGE CPP #-}++module Darcs.Commands.MarkConflicts ( markconflicts ) where+import System.Exit ( ExitCode(..), exitWith )+import Darcs.SignalHandler ( withSignalsBlocked )+import Control.Monad ( unless )++import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Arguments ( DarcsFlag, ignoretimes, workingRepoDir, umaskOption )+import Darcs.Flags ( diffingOpts )+import Darcs.Repository ( withRepoLock, RepoJob(..), amInHashedRepository, addToPending,+ applyToWorking,+ readRepo, unrecordedChanges, Repository+ )+import Darcs.Patch ( invert, PrimOf )+import Darcs.Witnesses.Ordered ( FL(..) )+import Darcs.Witnesses.Sealed ( Sealed(Sealed) )+import Darcs.Resolution ( patchsetConflictResolutions )+import Darcs.Utils ( promptYorn )+#include "impossible.h"+#include "gadts.h"++markconflictsDescription :: String+markconflictsDescription =+ "Mark unresolved conflicts in working tree, for manual resolution."++markconflictsHelp :: String+markconflictsHelp =+ "Darcs requires human guidance to unify changes to the same part of a\n" +++ "source file. When a conflict first occurs, darcs will add the\n" +++ "initial state and both choices to the working tree, delimited by the\n" +++ "markers `v v v', `=====', `* * *' and `^ ^ ^', as follows:\n" +++ "\n" +++ "v v v v v v v\n" +++ "Initial state.\n" +++ "=============\n" +++ "First choice.\n" +++ "*************\n" +++ "Second choice.\n" +++ "^ ^ ^ ^ ^ ^ ^\n" +++ "\n" +++ "However, you might revert or manually delete these markers without\n" +++ "actually resolving the conflict. In this case, `darcs mark-conflicts'\n" +++ "is useful to show where any unresolved conflicts. It is also useful\n" +++ "if `darcs apply' is called with --apply-conflicts, where conflicts\n" +++ "aren't marked initially.\n" +++ "\n" +++ "Any unrecorded changes to the working tree WILL be lost forever when\n" +++ "you run this command! You will be prompted for confirmation before\n" +++ "this takes place.\n"++markconflicts :: DarcsCommand+markconflicts = DarcsCommand {commandProgramName = "darcs",+ commandName = "mark-conflicts",+ commandHelp = markconflictsHelp,+ commandDescription = markconflictsDescription,+ commandExtraArgs = 0,+ commandExtraArgHelp = [],+ commandCommand = markconflictsCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [umaskOption],+ commandBasicOptions = [ignoretimes,+ workingRepoDir]}++markconflictsCmd :: [DarcsFlag] -> [String] -> IO ()+markconflictsCmd opts [] = withRepoLock opts $ RepoJob $ \(repository :: Repository p C(r u r)) -> do+ pend <- unrecordedChanges (diffingOpts opts) repository Nothing+ r <- readRepo repository+ Sealed res <- return $ patchsetConflictResolutions r+ (case res of NilFL -> do putStrLn "No conflicts to mark."+ exitWith ExitSuccess+ _ -> return ()) :: IO ()+ let undoUnrec :: FL (PrimOf p) C(r u) -> IO (Repository p C(r r r))+ undoUnrec NilFL = return repository+ undoUnrec pend' =+ do putStrLn ("This will trash any unrecorded changes"+++ " in the working directory.")+ confirmed <- promptYorn "Are you sure? "+ unless confirmed $ exitWith ExitSuccess+ applyToWorking repository opts (invert pend') `catch` \e ->+ bug ("Can't undo pending changes!" ++ show e)+ repository' <- undoUnrec pend+ withSignalsBlocked $+ do addToPending repository' res+ _ <- applyToWorking repository' opts res `catch` \e ->+ bug ("Problem marking conflicts in mark-conflicts!" ++ show e)+ return ()+ putStrLn "Finished marking conflicts."+markconflictsCmd _ _ = impossible+
− src/Darcs/Commands/MarkConflicts.lhs
@@ -1,109 +0,0 @@-% Copyright (C) 2002-2003,2005 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.--\darcsCommand{mark-conflicts}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--module Darcs.Commands.MarkConflicts ( markconflicts, resolve ) where-import System.Exit ( ExitCode(..), exitWith )-import Darcs.SignalHandler ( withSignalsBlocked )-import Control.Monad ( when )--import Darcs.Commands ( DarcsCommand(..), nodefaults, commandAlias )-import Darcs.Arguments ( DarcsFlag, ignoretimes, workingRepoDir, umaskOption )-import Darcs.Repository ( withRepoLock, ($-), amInRepository, addToPending,- applyToWorking,- readRepo, unrecordedChanges, Repository- )-import Darcs.Patch ( invert, Prim )-import Darcs.Witnesses.Ordered ( FL(..) )-import Darcs.Witnesses.Sealed ( Sealed(Sealed) )-import Darcs.Resolution ( patchsetConflictResolutions )-import Darcs.Utils ( promptYorn )-#include "impossible.h"-#include "gadts.h"--markconflictsDescription :: String-markconflictsDescription =- "Mark unresolved conflicts in working tree, for manual resolution."--markconflictsHelp :: String-markconflictsHelp =- "Darcs requires human guidance to unify changes to the same part of a\n" ++- "source file. When a conflict first occurs, darcs will add both\n" ++- "choices to the working tree, delimited by the markers `v v v',\n" ++- "`* * *' and `^ ^ ^'.\n" ++- "\n" ++- "However, you might revert or manually delete these markers without\n" ++- "actually resolving the conflict. In this case, `darcs mark-conflicts'\n" ++- "is useful to show where any unresolved conflicts. It is also useful\n" ++- "if `darcs apply' is called with --apply-conflicts, where conflicts\n" ++- "aren't marked initially.\n" ++- "\n" ++- "Any unrecorded changes to the working tree WILL be lost forever when\n" ++- "you run this command! You will be prompted for confirmation before\n" ++- "this takes place.\n" ++- "\n" ++- "This command was historically called `resolve', and this deprecated\n" ++- "alias still exists for backwards-compatibility.\n"--markconflicts :: DarcsCommand-markconflicts = DarcsCommand {commandName = "mark-conflicts",- commandHelp = markconflictsHelp,- commandDescription = markconflictsDescription,- commandExtraArgs = 0,- commandExtraArgHelp = [],- commandCommand = markconflictsCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [umaskOption],- commandBasicOptions = [ignoretimes,- workingRepoDir]}--markconflictsCmd :: [DarcsFlag] -> [String] -> IO ()-markconflictsCmd opts [] = withRepoLock opts $- \(repository :: Repository p C(r u r)) -> do- pend <- unrecordedChanges opts repository []- r <- readRepo repository- Sealed res <- return $ patchsetConflictResolutions r- (case res of NilFL -> do putStrLn "No conflicts to mark."- exitWith ExitSuccess- _ -> return ()) :: IO ()- let undoUnrec :: FL Prim C(r u) -> IO (Repository p C(r r r))- undoUnrec NilFL = return repository- undoUnrec pend =- do putStrLn ("This will trash any unrecorded changes"++- " in the working directory.")- yorn <- promptYorn "Are you sure? "- when (yorn /= 'y') $ exitWith ExitSuccess- applyToWorking repository opts (invert pend) `catch` \e ->- bug ("Can't undo pending changes!" ++ show e)- repository' <- undoUnrec pend- withSignalsBlocked $- do addToPending repository' res- applyToWorking repository' opts res `catch` \e ->- bug ("Problem marking conflicts in mark-conflicts!" ++ show e)- return ()- putStrLn "Finished marking conflicts."-markconflictsCmd _ _ = impossible---- |resolve is an alias for mark-conflicts.-resolve :: DarcsCommand-resolve = commandAlias "resolve" Nothing markconflicts-\end{code}
+ src/Darcs/Commands/Move.hs view
@@ -0,0 +1,201 @@+-- Copyright (C) 2002-2003 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.++{-# LANGUAGE CPP #-}++module Darcs.Commands.Move ( move, mv ) where+import Control.Applicative ( (<$>) )+import Control.Monad ( when, unless, zipWithM_ )+import Data.Maybe ( catMaybes )+import Darcs.SignalHandler ( withSignalsBlocked )++import Darcs.Commands ( DarcsCommand(..), nodefaults, commandAlias )+import Darcs.Arguments ( DarcsFlag(), maybeFixSubPaths,+ fixSubPaths, workingRepoDir,+ listFiles, allowProblematicFilenames, umaskOption,+ )+import Darcs.Flags ( doAllowCaseOnly, doAllowWindowsReserved )+import Darcs.RepoPath ( SubPath(), toFilePath )+import System.FilePath.Posix ( (</>), takeFileName )+import System.Directory ( renameDirectory )+import Workaround ( renameFile )+import Darcs.Repository.State ( readRecordedAndPending )+import Darcs.Repository ( Repository, withRepoLock, RepoJob(..), amInHashedRepository, addToPending )+import Darcs.Witnesses.Ordered ( FL(..), toFL )+import Darcs.Witnesses.Sealed ( Sealed(..), unseal, freeGap, FreeLeft, unFreeLeft )+import Darcs.Global ( debugMessage )+import qualified Darcs.Patch+import Darcs.Patch ( RepoPatch, PrimPatch )+import Darcs.Patch.FileName ( fp2fn, fn2fp, superName )+import Data.List ( nub, sort )+import qualified System.FilePath.Windows as WindowsFilePath++import Darcs.Utils( treeHas, treeHasDir, treeHasAnycase, treeHasFile )+import Storage.Hashed.Tree( Tree, modifyTree )+import Storage.Hashed.Plain( readPlainTree )+import Storage.Hashed.AnchoredPath( floatPath )++#include "gadts.h"++moveDescription :: String+moveDescription = "Move or rename files."++moveHelp :: String+moveHelp =+ "Darcs cannot reliably distinguish between a file being deleted and a\n" +++ "new one added, and a file being moved. Therefore Darcs always assumes\n" +++ "the former, and provides the `darcs mv' command to let Darcs know when\n" +++ "you want the latter. This command will also move the file in the\n" +++ "working tree (unlike `darcs remove'), unless it has already been moved.\n" +++ "\n" +++ -- Note that this paragraph is very similar to one in ./Add.lhs.+ "Darcs will not rename a file if another file in the same folder has\n" +++ "the same name, except for case. The --case-ok option overrides this\n" +++ "behaviour. Windows and OS X usually use filesystems that do not allow\n" +++ "files a folder to have the same name except for case (for example,\n" +++ "`ReadMe' and `README'). If --case-ok is used, the repository might be\n" +++ "unusable on those systems!\n"++move :: DarcsCommand+move = DarcsCommand {commandProgramName = "darcs",+ commandName = "move",+ commandHelp = moveHelp,+ commandDescription = moveDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["<SOURCE> ... <DESTINATION>"],+ commandCommand = moveCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = listFiles,+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [umaskOption],+ commandBasicOptions = [allowProblematicFilenames, workingRepoDir]}++moveCmd :: [DarcsFlag] -> [String] -> IO ()+moveCmd opts args+ | length args < 2 = fail $ "The `darcs move' command requires at least" +++ "two arguments."+ | length args == 2 = do+ xs <- maybeFixSubPaths opts args+ case xs of+ [Just from, Just to]+ | from == to -> fail "Cannot rename a file or directory onto itself!"+ | otherwise -> moveFile opts from to+ _ -> fail "Both source and destination must be valid."+ | otherwise = let (froms, to) = (init args, last args) in do+ x <- head <$> maybeFixSubPaths opts [to]+ case x of+ Nothing -> fail "Invalid destination directory."+ Just to' -> do+ xs <- nub . sort <$> fixSubPaths opts froms+ if to' `elem` xs+ then fail "Cannot rename a file or directory onto itself!"+ else case xs of+ [] -> fail "Nothing to move."+ froms' -> moveFilesToDir opts froms' to'++moveFile :: [DarcsFlag] -> SubPath -> SubPath -> IO ()+moveFile opts old new = withRepoLock opts $ RepoJob $ \repository -> do+ work <- readPlainTree "."+ let old_fp = toFilePath old+ new_fp = toFilePath new+ has_new <- treeHasDir work new_fp+ has_old <- treeHas work old_fp+ if has_new && has_old+ then moveToDir repository opts [old_fp] new_fp+ else do+ cur <- readRecordedAndPending repository+ addpatch <- checkNewAndOldFilenames opts cur work (old_fp,new_fp)+ withSignalsBlocked $ do+ case unFreeLeft <$> addpatch of+ Nothing -> addToPending repository (Darcs.Patch.move old_fp new_fp :>: NilFL)+ Just (Sealed p) -> addToPending repository (p :>: Darcs.Patch.move old_fp new_fp :>: NilFL)+ moveFileOrDir work old_fp new_fp++moveFilesToDir :: [DarcsFlag] -> [SubPath] -> SubPath -> IO ()+moveFilesToDir opts froms to = withRepoLock opts $ RepoJob $ \repo ->+ moveToDir repo opts (map toFilePath froms) $ toFilePath to++moveToDir :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> [FilePath] -> FilePath -> IO ()+moveToDir repository opts moved finaldir =+ let movefns = map takeFileName moved+ movetargets = map (finaldir </>) movefns+ movepatches = zipWith (\a b -> freeGap (Darcs.Patch.move a b)) moved movetargets+ in do+ cur <- readRecordedAndPending repository+ work <- readPlainTree "."+ addpatches <- mapM (checkNewAndOldFilenames opts cur work) $ zip moved movetargets+ withSignalsBlocked $ do+ unseal (addToPending repository) $ toFL $ catMaybes addpatches ++ movepatches+ zipWithM_ (moveFileOrDir work) moved movetargets++checkNewAndOldFilenames+ :: PrimPatch prim => [DarcsFlag] -> Tree IO -> Tree IO -> (FilePath, FilePath) -> IO (Maybe (FreeLeft prim))+checkNewAndOldFilenames opts cur work (old,new) = do+ unless (doAllowWindowsReserved opts || WindowsFilePath.isValid new) $+ fail $ "The filename " ++ new ++ " is not valid under Windows.\n" +++ "Use --reserved-ok to allow such filenames."+ has_work <- treeHas work old+ has_cur <- treeHas cur old+ maybe_add_file_thats_been_moved <-+ if has_work -- We need to move the object+ then do has_target <- treeHasDir work (fn2fp $ superName $ fp2fn new)+ unless has_target $+ fail $ "The target directory " +++ (fn2fp $ superName $ fp2fn new)+++ " isn't known in working directory, did you forget to add it?"+ has_new <- it_has work+ when has_new $ fail $ already_exists "working directory"+ return Nothing+ else do has_new <- treeHas work new+ unless has_new $ fail $ doesnt_exist "working directory"+ return (Just (freeGap (Darcs.Patch.addfile old)))+ if has_cur+ then do has_target <- treeHasDir cur (fn2fp $ superName $ fp2fn new)+ unless has_target $+ fail $ "The target directory " +++ (fn2fp $ superName $ fp2fn new)+++ " isn't known in working directory, did you forget to add it?"+ has_new <- it_has cur+ when has_new $ fail $ already_exists "repository"+ else fail $ doesnt_exist "repository"+ return maybe_add_file_thats_been_moved+ where it_has s = treeHas_case (modifyTree s (floatPath old) Nothing) new+ treeHas_case = if doAllowCaseOnly opts then treeHas else treeHasAnycase+ already_exists what_slurpy =+ if doAllowCaseOnly opts+ then "A file or dir named "++new++" already exists in "+ ++ what_slurpy ++ "."+ else "A file or dir named "++new++" (or perhaps differing"+++ " only in case)\nalready exists in "+++ what_slurpy ++ ".\n"+++ "Use --case-ok to allow files differing only in case."+ doesnt_exist what_slurpy =+ "There is no file or dir named " ++ old +++ " in the "++ what_slurpy ++ "."++moveFileOrDir :: Tree IO -> FilePath -> FilePath -> IO ()+moveFileOrDir work old new = do+ has_file <- treeHasFile work old+ has_dir <- treeHasDir work old+ when has_file $ do debugMessage $ unwords ["renameFile",old,new]+ renameFile old new+ when has_dir $ do debugMessage $ unwords ["renameDirectory",old,new]+ renameDirectory old new++mv :: DarcsCommand+mv = commandAlias "mv" Nothing move+
− src/Darcs/Commands/Move.lhs
@@ -1,192 +0,0 @@-% Copyright (C) 2002-2003 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.--\darcsCommand{move}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--module Darcs.Commands.Move ( move, mv ) where-import Control.Applicative ( (<$>) )-import Control.Monad ( when, unless, zipWithM_ )-import Data.Maybe ( catMaybes )-import Darcs.SignalHandler ( withSignalsBlocked )--import Darcs.Commands ( DarcsCommand(..), nodefaults, commandAlias )-import Darcs.Arguments ( DarcsFlag(),- fixSubPaths, workingRepoDir,- listFiles, allowProblematicFilenames, umaskOption,- )-import Darcs.Flags ( doAllowCaseOnly, doAllowWindowsReserved )-import Darcs.RepoPath ( toFilePath )-import System.FilePath.Posix ( (</>), takeFileName )-import System.Directory ( renameDirectory )-import Workaround ( renameFile )-import Darcs.Repository.State ( readRecordedAndPending )-import Darcs.Repository ( Repository, withRepoLock, ($-), amInRepository, addToPending )-import Darcs.Witnesses.Ordered ( FL(..), toFL )-import Darcs.Witnesses.Sealed ( Sealed(..), unseal, freeGap, FreeLeft, unFreeLeft )-import Darcs.Global ( debugMessage )-import qualified Darcs.Patch-import Darcs.Patch ( RepoPatch, Prim )-import Darcs.Patch.FileName ( fp2fn, fn2fp, superName )-import qualified System.FilePath.Windows as WindowsFilePath--import Darcs.Utils( treeHas, treeHasDir, treeHasAnycase, treeHasFile )-import Storage.Hashed.Tree( Tree, modifyTree )-import Storage.Hashed.Plain( readPlainTree )-import Storage.Hashed.AnchoredPath( floatPath )--#include "impossible.h"-#include "gadts.h"--moveDescription :: String-moveDescription = "Move or rename files."--moveHelp :: String-moveHelp =- "Darcs cannot reliably distinguish between a file being deleted and a\n" ++- "new one added, and a file being moved. Therefore Darcs always assumes\n" ++- "the former, and provides the `darcs mv' command to let Darcs know when\n" ++- "you want the latter. This command will also move the file in the\n" ++- "working tree (unlike `darcs remove'), unless it has already been moved.\n" ++- "\n" ++- -- Note that this paragraph is very similar to one in ./Add.lhs.- "Darcs will not rename a file if another file in the same folder has\n" ++- "the same name, except for case. The --case-ok option overrides this\n" ++- "behaviour. Windows and OS X usually use filesystems that do not allow\n" ++- "files a folder to have the same name except for case (for example,\n" ++- "`ReadMe' and `README'). If --case-ok is used, the repository might be\n" ++- "unusable on those systems!\n"--move :: DarcsCommand-move = DarcsCommand {commandName = "move",- commandHelp = moveHelp,- commandDescription = moveDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["<SOURCE> ... <DESTINATION>"],- commandCommand = moveCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = listFiles,- commandArgdefaults = nodefaults,- commandAdvancedOptions = [umaskOption],- commandBasicOptions = [allowProblematicFilenames, workingRepoDir]}-moveCmd :: [DarcsFlag] -> [String] -> IO ()-moveCmd _ [] = fail "The `darcs move' command requires at least two arguments."-moveCmd _ [_] = fail "The `darcs move' command requires at least two arguments."--moveCmd opts args@[_,_] = withRepoLock opts $- \repository -> do- two_files <- fixSubPaths opts args- [old,new] <- return $ case two_files of- [_,_] -> two_files- [_] -> error "Cannot rename a file or directory onto itself!"- xs -> bug $ "Problem in moveCmd: " ++ show xs- work <- readPlainTree "."- let old_fp = toFilePath old- new_fp = toFilePath new- has_new <- treeHasDir work new_fp- has_old <- treeHas work old_fp- if has_new && has_old- then moveToDir repository opts [old_fp] new_fp- else do- cur <- readRecordedAndPending repository- addpatch <- checkNewAndOldFilenames opts cur work (old_fp,new_fp)- withSignalsBlocked $ do- case unFreeLeft <$> addpatch of- Nothing -> addToPending repository (Darcs.Patch.move old_fp new_fp :>: NilFL)- Just (Sealed p) -> addToPending repository (p :>: Darcs.Patch.move old_fp new_fp :>: NilFL)- moveFileOrDir work old_fp new_fp--moveCmd opts args =- withRepoLock opts $- \repository -> do- relpaths <- map toFilePath `fmap` fixSubPaths opts args- let moved = init relpaths- finaldir = last relpaths- moveToDir repository opts moved finaldir--moveToDir :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> [FilePath] -> FilePath -> IO ()-moveToDir repository opts moved finaldir =- let movefns = map takeFileName moved- movetargets = map (finaldir </>) movefns- movepatches = zipWith (\a b -> freeGap (Darcs.Patch.move a b)) moved movetargets- in do- cur <- readRecordedAndPending repository- work <- readPlainTree "."- addpatches <- mapM (checkNewAndOldFilenames opts cur work) $ zip moved movetargets- withSignalsBlocked $ do- unseal (addToPending repository) $ toFL $ catMaybes addpatches ++ movepatches- zipWithM_ (moveFileOrDir work) moved movetargets--checkNewAndOldFilenames- :: [DarcsFlag] -> Tree IO -> Tree IO -> (FilePath, FilePath) -> IO (Maybe (FreeLeft Prim))-checkNewAndOldFilenames opts cur work (old,new) = do- unless (doAllowWindowsReserved opts || WindowsFilePath.isValid new) $- fail $ "The filename " ++ new ++ " is not valid under Windows.\n" ++- "Use --reserved-ok to allow such filenames."- has_work <- treeHas work old- has_cur <- treeHas cur old- maybe_add_file_thats_been_moved <-- if has_work -- We need to move the object- then do has_target <- treeHasDir work (fn2fp $ superName $ fp2fn new)- unless has_target $- fail $ "The target directory " ++- (fn2fp $ superName $ fp2fn new)++- " isn't known in working directory, did you forget to add it?"- has_new <- it_has work- when has_new $ fail $ already_exists "working directory"- return Nothing- else do has_new <- treeHas work new- unless has_new $ fail $ doesnt_exist "working directory"- return (Just (freeGap (Darcs.Patch.addfile old)))- if has_cur- then do has_target <- treeHasDir cur (fn2fp $ superName $ fp2fn new)- unless has_target $- fail $ "The target directory " ++- (fn2fp $ superName $ fp2fn new)++- " isn't known in working directory, did you forget to add it?"- has_new <- it_has cur- when has_new $ fail $ already_exists "repository"- else fail $ doesnt_exist "repository"- return maybe_add_file_thats_been_moved- where it_has s = treeHas_case (modifyTree s (floatPath old) Nothing) new- treeHas_case = if doAllowCaseOnly opts then treeHas else treeHasAnycase- already_exists what_slurpy =- if doAllowCaseOnly opts- then "A file or dir named "++new++" already exists in "- ++ what_slurpy ++ "."- else "A file or dir named "++new++" (or perhaps differing"++- " only in case)\nalready exists in "++- what_slurpy ++ ".\n"++- "Use --case-ok to allow files differing only in case."- doesnt_exist what_slurpy =- "There is no file or dir named " ++ old ++- " in the "++ what_slurpy ++ "."--moveFileOrDir :: Tree IO -> FilePath -> FilePath -> IO ()-moveFileOrDir work old new = do- has_file <- treeHasFile work old- has_dir <- treeHasDir work old- when has_file $ do debugMessage $ unwords ["renameFile",old,new]- renameFile old new- when has_dir $ do debugMessage $ unwords ["renameDirectory",old,new]- renameDirectory old new--mv :: DarcsCommand-mv = commandAlias "mv" Nothing move-\end{code}--
+ src/Darcs/Commands/Optimize.hs view
@@ -0,0 +1,371 @@+-- Copyright (C) 2003-2005 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.++{-# LANGUAGE CPP #-}++module Darcs.Commands.Optimize ( optimize ) where+import Control.Applicative ( (<$>) )+import Control.Exception ( finally )+import Control.Monad ( when, unless )+import Data.Maybe ( isJust )+import Data.List ( sort )+import System.Directory ( getDirectoryContents, doesDirectoryExist,+ doesFileExist, renameFile, getModificationTime )+import System.IO.Unsafe ( unsafeInterleaveIO )+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as BL++import Storage.Hashed.Darcs( decodeDarcsSize )++import Darcs.Patch.PatchInfoAnd ( info, extractHash )+import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Arguments ( DarcsFlag( UpgradeFormat, UseHashedInventory,+ Compress, UnCompress,+ NoCompress, Reorder,+ Relink, OptimizePristine,+ OptimizeHTTP ),+ reorderPatches,+ uncompressNocompress,+ relink, sibling,+ flagsToSiblings,+ upgradeFormat,+ workingRepoDir, umaskOption, optimizePristine,+ optimizeHTTP+ )+import Darcs.Repository.Prefs ( getPreflist )+import Darcs.Repository ( Repository,+ withRepoLock, RepoJob(..), withGutsOf,+ readRepo, optimizeInventory,+ tentativelyReplacePatches, cleanRepository,+ amInRepository, finalizeRepositoryChanges, replacePristine )+import Darcs.Repository.Old ( oldRepoFailMsg )+import Darcs.Witnesses.Ordered ( (+<+), reverseRL, mapRL, (:>)(..)+ , mapFL, bunchFL, lengthRL )+import Darcs.Patch.Info ( isTag )+import Darcs.Patch ( RepoPatch )+import Darcs.Patch.Set ( PatchSet(..), newset2RL, newset2FL, progressPatchSet )+import ByteStringUtils ( gzReadFilePS )+import Darcs.Patch.Depends ( splitOnTag )+import Darcs.Lock ( maybeRelink, gzWriteAtomicFilePS, writeAtomicFilePS )+import Darcs.RepoPath ( toFilePath )+import Darcs.Utils ( withCurrentDirectory )+import Progress ( debugMessage )+import Darcs.Global ( darcsdir )++-- imports for optimize --upgrade; to be tidied+import System.Directory ( createDirectoryIfMissing, removeFile )+import System.FilePath.Posix ( takeExtension, (</>), (<.>), takeFileName )++import Progress ( beginTedious, endTedious, tediousSize )+import Darcs.Flags ( compression )+import Darcs.Lock ( rmRecursive )+import Darcs.ProgressPatches ( progressFL )+import Darcs.Repository.Cache ( hashedDir, HashedDir(HashedPristineDir) )+import Darcs.Repository.Format ( identifyRepoFormat,+ createRepoFormat, writeRepoFormat, formatHas,+ RepoProperty ( HashedInventory ) )+import qualified Darcs.Repository.HashedRepo as HashedRepo+import Darcs.Repository.Prefs ( getCaches )+import Darcs.Repository.State ( readRecorded )+import Darcs.Utils ( catchall )++import Storage.Hashed.Tree( TreeItem(..), list, expand, emptyTree )+import Storage.Hashed.AnchoredPath( anchorPath )+import Storage.Hashed.Plain( readPlainTree )+import Storage.Hashed.Darcs( writeDarcsHashed )++import Codec.Archive.Tar ( write )+import Codec.Archive.Tar.Entry ( fileEntry, toTarPath )+import Codec.Compression.GZip ( compress )++#include "gadts.h"++optimizeDescription :: String+optimizeDescription = "Optimize the repository."++optimizeHelp :: String+optimizeHelp =+ "The `darcs optimize' command modifies the current repository in an\n" +++ "attempt to reduce its resource requirements. By default a single\n" +++ "fast, safe optimization is performed; additional optimization\n" +++ "techniques can be enabled by passing options to `darcs optimize'.\n" +++ "\n" ++ optimizeHelpInventory +++ -- "\n" ++ optimize_help_reorder +++ "\n" ++ optimizeHelpRelink +++ -- uncompression is least useful, so it is last.+ "\n" ++ optimizeHelpCompression +++ "\n" +++ "There is one more optimization which CAN NOT be performed by this\n" +++ "command. Every time your record a patch, a new inventory file is\n" +++ "written to _darcs/inventories/, and old inventories are never reaped.\n" +++ "\n" +++ "If _darcs/inventories/ is consuming a relatively large amount of\n" +++ "space, you can safely reclaim it by using `darcs get' to make a\n" +++ "complete copy of the repo. When doing so, don't forget to copy over\n" +++ "any unsaved changes you have made to the working tree or to\n" +++ "unversioned files in _darcs/prefs/ (such as _darcs/prefs/author).\n"++optimize :: DarcsCommand+optimize = DarcsCommand {commandProgramName = "darcs",+ commandName = "optimize",+ commandHelp = optimizeHelp,+ commandDescription = optimizeDescription,+ commandExtraArgs = 0,+ commandExtraArgHelp = [],+ commandCommand = optimizeCmd,+ commandPrereq = amInRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [uncompressNocompress, umaskOption],+ commandBasicOptions = [workingRepoDir,+ reorderPatches,+ sibling, relink,+ upgradeFormat,+ optimizePristine,+ optimizeHTTP]}++optimizeCmd :: [DarcsFlag] -> [String] -> IO ()+optimizeCmd origopts _ = do+ when (UpgradeFormat `elem` origopts) optimizeUpgradeFormat+ withRepoLock opts $ RepoJob $ \repository -> do+ cleanRepository repository -- garbage collect pristine.hashed directory+ when (OptimizeHTTP `elem` origopts) $ doOptimizeHTTP repository+ if (OptimizePristine `elem` opts)+ then doOptimizePristine repository+ else do when (Reorder `elem` opts) $ doReorder opts repository+ doOptimizeInventory repository+ when (Compress `elem` opts || UnCompress `elem` opts) $+ optimizeCompression opts+ when (Relink `elem` opts) $+ doRelink opts+ putStrLn "Done optimizing!"+ where opts = if UnCompress `elem` origopts then NoCompress:origopts else origopts++optimizeHelpInventory :: String+optimizeHelpInventory =+ "The default optimization moves recent patches (those not included in\n" +++ "the latest tag) to the `front', reducing the amount that a typical\n" +++ "remote command needs to download. It should also reduce the CPU time\n" +++ "needed for some operations.\n"++doOptimizeInventory :: RepoPatch p => Repository p C(r u t) -> IO ()+doOptimizeInventory repository = do+ debugMessage "Writing out a nice copy of the inventory."+ optimizeInventory repository+ debugMessage "Done writing out a nice copy of the inventory."++optimizeHelpCompression :: String+optimizeHelpCompression =+ "By default patches are compressed with zlib (RFC 1951) to reduce\n" +++ "storage (and download) size. In exceptional circumstances, it may be\n" +++ "preferable to avoid compression. In this case the `--dont-compress'\n" +++ "option can be used (e.g. with `darcs record') to avoid compression.\n" +++ "\n" +++ "The `darcs optimize --uncompress' and `darcs optimize --compress'\n" +++ "commands can be used to ensure existing patches in the current\n" +++ "repository are respectively uncompressed or compressed. Note that\n" +++ "repositories in the legacy `old-fashioned-inventory' format have a .gz\n" +++ "extension on patch files even when uncompressed.\n"++optimizeCompression :: [DarcsFlag] -> IO ()+optimizeCompression opts = do+ putStrLn "Optimizing (un)compression of patches..."+ do_compress (darcsdir++"/patches")+ putStrLn "Optimizing (un)compression of inventories..."+ do_compress (darcsdir++"/inventories")+ where do_compress f =+ do isd <- doesDirectoryExist f+ if isd then withCurrentDirectory f $+ do fs <- filter notdot `fmap` getDirectoryContents "."+ mapM_ do_compress fs+ else if Compress `elem` opts+ then gzReadFilePS f >>= gzWriteAtomicFilePS f+ else gzReadFilePS f >>= writeAtomicFilePS f+ notdot ('.':_) = False+ notdot _ = True++optimizeHelpRelink :: String+optimizeHelpRelink =+ "The `darcs optimize --relink' command hard-links patches that the\n" +++ "current repository has in common with its peers. Peers are those\n" +++ "repositories listed in _darcs/prefs/sources, or defined with the\n" +++ "`--sibling' option (which can be used multiple times).\n" +++ "\n" +++ "Darcs uses hard-links automatically, so this command is rarely needed.\n" +++ "It is most useful if you used `cp -r' instead of `darcs get' to copy a\n" +++ "repository, or if you pulled the same patch from a remote repository\n" +++ "into multiple local repositories.\n"++doOptimizePristine :: RepoPatch p => Repository p C(r u t) -> IO ()+doOptimizePristine repo = do+ hashed <- doesFileExist $ darcsdir </> "hashed_inventory"+ when hashed $ do+ inv <- BS.readFile (darcsdir </> "hashed_inventory")+ let linesInv = BS.split '\n' inv+ case linesInv of+ [] -> return ()+ (pris_line:_) ->+ let size = decodeDarcsSize $ BS.drop 9 pris_line+ in when (isJust size) $ do putStrLn "Optimizing hashed pristine..."+ readRecorded repo >>= replacePristine repo+ cleanRepository repo++doRelink :: [DarcsFlag] -> IO ()+doRelink opts =+ do some_siblings <- return (flagsToSiblings opts)+ defrepolist <- getPreflist "defaultrepo"+ siblings <- return (map toFilePath some_siblings ++ defrepolist)+ if null siblings+ then putStrLn "No siblings -- no relinking done."+ else do debugMessage "Relinking patches..."+ patch_tree <- expand =<< readPlainTree "_darcs/patches"+ let patches = [ anchorPath "" p | (p, File _) <- list patch_tree ]+ maybeRelinkFiles siblings patches "_darcs/patches"+ debugMessage "Done relinking."++maybeRelinkFiles :: [String] -> [String] -> String -> IO ()+maybeRelinkFiles src dst dir =+ mapM_ (maybeRelinkFile src) (map ((dir ++ "/") ++) dst)++maybeRelinkFile :: [String] -> String -> IO ()+maybeRelinkFile [] _ = return ()+maybeRelinkFile (h:t) f =+ do done <- maybeRelink (h ++ "/" ++ f) f+ unless done $+ maybeRelinkFile t f++-- FIXME: someone needs to grovel through the source and determine+-- just how optimizeInventory differs from doReorder. The following+-- is purely speculation. --twb, 2009-04+-- optimize_help_reorder :: String+-- optimize_help_reorder =+-- "The `darcs optimize --reorder' command is a more comprehensive version\n" +++-- "of the default optimization. It reorders patches with respect to ALL\n" +++-- "tags, rather than just the latest tag.\n"++doReorder :: RepoPatch p => [DarcsFlag] -> Repository p C(r u r) -> IO ()+doReorder opts repository = do+ debugMessage "Reordering the inventory."+ PatchSet ps _ <- chooseOrder `fmap` readRepo repository+-- Warning: A do-notation statement discarded a result of type Repository p r u r.+ withGutsOf repository $ do _ <- tentativelyReplacePatches repository (compression opts) $ reverseRL ps+ finalizeRepositoryChanges repository+ debugMessage "Done reordering the inventory."++chooseOrder :: forall p C(s x) . RepoPatch p => PatchSet p C(s x) -> PatchSet p C(s x)+chooseOrder ps = case filter isTag $ mapRL info $ newset2RL ps of+ [] -> ps+ (lt:_) -> case splitOnTag lt ps of+ PatchSet xs ts :> r -> PatchSet (r+<+xs) ts++optimizeUpgradeFormat :: IO ()+optimizeUpgradeFormat = do+ debugMessage $ "Upgrading to hashed..."+ rf <- identifyRepoFormat "."+ debugMessage $ "Found our format"+ if formatHas HashedInventory rf+ then putStrLn "No action taken because this repository already is hashed."+ else do putStrLn "Checking repository in case of corruption..."+ withRepoLock [] $ RepoJob $ \repository -> do+ actuallyUpgradeFormat repository++actuallyUpgradeFormat :: RepoPatch p => Repository p C(r u t) -> IO ()+actuallyUpgradeFormat repository = do+ -- convert patches/inventory+ patches <- readRepo repository+ let k = "Hashing patch"+ beginTedious k+ tediousSize k (lengthRL $ newset2RL patches)+ let patches' = progressPatchSet k patches+ cache <- getCaches [] "."+ let compr = compression [] -- default compression+ HashedRepo.writeTentativeInventory cache compr patches'+ endTedious k+ -- convert pristine by applying patches+ -- the faster alternative would be to copy pristine, but the apply method is more reliable+ let patchesToApply = progressFL "Applying patch" $ newset2FL $ patches'+ createDirectoryIfMissing False $ darcsdir </> hashedDir HashedPristineDir+-- Warning: A do-notation statement discarded a result of type Storage.Hashed.Hash.Hash.+ _ <- writeDarcsHashed emptyTree "_darcs/pristine.hashed"+ sequence_ $ mapFL HashedRepo.applyToTentativePristine $ bunchFL 100 patchesToApply+ -- now make it official+ HashedRepo.finalizeTentativeChanges repository compr+ writeRepoFormat (createRepoFormat [UseHashedInventory]) (darcsdir </> "format")+ -- clean out old-fashioned junk+ debugMessage "Cleaning out old-fashioned repository files..."+ removeFile $ darcsdir </> "inventory"+ removeFile $ darcsdir </> "tentative_inventory"+ rmRecursive (darcsdir </> "pristine") `catchall` rmRecursive (darcsdir </> "current")+ rmGzsIn (darcsdir </> "patches")+ rmGzsIn (darcsdir </> "inventories")+ let checkpointDir = darcsdir </> "checkpoints"+ hasCheckPoints <- doesDirectoryExist checkpointDir+ when hasCheckPoints $ rmRecursive checkpointDir+ putStrLn "Done upgrading!"+ where+ rmGzsIn dir =+ withCurrentDirectory dir $ do+ gzs <- filter ((== ".gz") . takeExtension) `fmap` getDirectoryContents "."+ mapM_ removeFile gzs++doOptimizeHTTP :: RepoPatch p => Repository p C(r u t) -> IO ()+doOptimizeHTTP repo = flip finally (mapM_ (removeFileIfExists)+ [ darcsdir </> "meta-filelist-inventories"+ , darcsdir </> "meta-filelist-pristine"+ , basicTar <.> "part"+ , patchesTar <.> "part"+ ]) $ do+ rf <- identifyRepoFormat "."+ unless (formatHas HashedInventory rf) $ fail oldRepoFailMsg+ createDirectoryIfMissing False packsDir+ -- pack patchesTar+ ps <- mapRL hashedPatchFileName . newset2RL <$> readRepo repo+ is <- map ((darcsdir </> "inventories") </>) <$> HashedRepo.listInventories+ writeFile (darcsdir </> "meta-filelist-inventories") . unlines $+ map takeFileName is+ BL.writeFile (patchesTar <.> "part") . compress . write =<<+ mapM fileEntry' ((darcsdir </> "meta-filelist-inventories") : ps +++ reverse is)+ renameFile (patchesTar <.> "part") patchesTar+ -- pack basicTar+ pr <- sortByMTime =<< dirContents "pristine.hashed"+ writeFile (darcsdir </> "meta-filelist-pristine") . unlines $+ map takeFileName pr+ BL.writeFile (basicTar <.> "part") . compress . write =<< mapM fileEntry' (+ [ darcsdir </> "meta-filelist-pristine"+ , darcsdir </> "hashed_inventory"+ ] ++ reverse pr)+ renameFile (basicTar <.> "part") basicTar+ where+ packsDir = darcsdir </> "packs"+ basicTar = packsDir </> "basic.tar.gz"+ patchesTar = packsDir </> "patches.tar.gz"+ fileEntry' x = unsafeInterleaveIO $ do+ content <- BL.fromChunks . return <$> gzReadFilePS x+ tp <- either fail return $ toTarPath False x+ return $ fileEntry tp content+ dirContents d = dirContents' d $ const True+ dirContents' d f = map ((darcsdir </> d) </>) . filter (\x ->+ head x /= '.' && f x) <$> getDirectoryContents (darcsdir </> d)+ hashedPatchFileName x = case extractHash x of+ Left _ -> fail "unexpected unhashed patch"+ Right h -> darcsdir </> "patches" </> h+ sortByMTime xs = map snd . sort <$> mapM (\x -> (\t -> (t, x)) <$>+ getModificationTime x) xs+ removeFileIfExists x = do+ ex <- doesFileExist x+ when ex $ removeFile x
− src/Darcs/Commands/Optimize.lhs
@@ -1,400 +0,0 @@-% Copyright (C) 2003-2005 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.--\darcsCommand{optimize}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--module Darcs.Commands.Optimize ( optimize ) where-import Control.Applicative ( (<$>) )-import Control.Monad ( when, unless )-import Data.Maybe ( isJust )-import System.Directory ( getDirectoryContents, doesDirectoryExist,- doesFileExist, renameFile )-import System.IO.Unsafe ( unsafeInterleaveIO )-import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy as BL--import Storage.Hashed.Darcs( decodeDarcsSize )--import Darcs.Hopefully ( info )-import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Arguments ( DarcsFlag( UpgradeFormat, UseHashedInventory,- Compress, UnCompress,- NoCompress, Reorder,- Relink, RelinkPristine, OptimizePristine,- OptimizeHTTP ),- reorderPatches,- uncompressNocompress,- relink, relinkPristine, sibling,- flagsToSiblings,- upgradeFormat,- workingRepoDir, umaskOption, optimizePristine,- -- optimizeHTTP -- disabled for darcs-2.5- )-import Darcs.Repository.Prefs ( getPreflist )-import Darcs.Repository ( Repository,- withRepoLock, ($-), withGutsOf,- readRepo, optimizeInventory,- tentativelyReplacePatches, cleanRepository,- amInRepository, finalizeRepositoryChanges, replacePristine )-import Darcs.Witnesses.Ordered ( (+<+), reverseRL, mapRL, (:>>)(..)- , mapFL, bunchFL, lengthRL )-import Darcs.Patch.Info ( isTag )-import Darcs.Patch ( RepoPatch )-import Darcs.Patch.Set ( PatchSet(..), newset2RL, newset2FL, progressPatchSet )-import ByteStringUtils ( gzReadFilePS )-import Darcs.Patch.Depends ( splitOnTag )-import Darcs.Lock ( maybeRelink, gzWriteAtomicFilePS, writeAtomicFilePS )-import Darcs.RepoPath ( toFilePath )-import Darcs.Utils ( withCurrentDirectory )-import Progress ( debugMessage )-import Darcs.Repository.Pristine ( identifyPristine, pristineDirectory )-import Darcs.Global ( darcsdir )---- imports for optimize --upgrade; to be tidied-import System.Directory ( createDirectoryIfMissing, removeFile )-import System.FilePath.Posix ( takeExtension, (</>), (<.>) )--import Progress ( beginTedious, endTedious, tediousSize )-import Darcs.Flags ( compression )-import Darcs.Lock ( rmRecursive )-import Darcs.ProgressPatches ( progressFL )-import Darcs.Repository.Cache ( hashedDir, HashedDir(HashedPristineDir) )-import Darcs.Repository.Format ( identifyRepoFormat,- createRepoFormat, writeRepoFormat, formatHas,- RepoProperty ( HashedInventory ) )-import qualified Darcs.Repository.HashedRepo as HashedRepo-import Darcs.Repository.Prefs ( getCaches )-import Darcs.Repository.Repair ( replayRepository, RepositoryConsistency(..) )-import Darcs.Repository.State ( readRecorded )-import Darcs.Utils ( catchall )--import Storage.Hashed.Tree( TreeItem(..), list, expand, emptyTree )-import Storage.Hashed.AnchoredPath( anchorPath )-import Storage.Hashed.Plain( readPlainTree )-import Storage.Hashed.Darcs( writeDarcsHashed )--import Codec.Archive.Tar ( write )-import Codec.Archive.Tar.Entry ( fileEntry, toTarPath )-import Codec.Compression.GZip ( compress )--#include "gadts.h"--optimizeDescription :: String-optimizeDescription = "Optimize the repository."--optimizeHelp :: String-optimizeHelp =- "The `darcs optimize' command modifies the current repository in an\n" ++- "attempt to reduce its resource requirements. By default a single\n" ++- "fast, safe optimization is performed; additional optimization\n" ++- "techniques can be enabled by passing options to `darcs optimize'.\n" ++- "\n" ++ optimizeHelpInventory ++- -- "\n" ++ optimize_help_reorder ++- "\n" ++ optimizeHelpRelink ++- -- uncompression is least useful, so it is last.- "\n" ++ optimizeHelpCompression ++- "\n" ++- "There is one more optimization which CAN NOT be performed by this\n" ++- "command. Every time your record a patch, a new inventory file is\n" ++- "written to _darcs/inventories/, and old inventories are never reaped.\n" ++- "\n" ++- "If _darcs/inventories/ is consuming a relatively large amount of\n" ++- "space, you can safely reclaim it by using `darcs get' to make a\n" ++- "complete copy of the repo. When doing so, don't forget to copy over\n" ++- "any unsaved changes you have made to the working tree or to\n" ++- "unversioned files in _darcs/prefs/ (such as _darcs/prefs/author).\n"--optimize :: DarcsCommand-optimize = DarcsCommand {commandName = "optimize",- commandHelp = optimizeHelp,- commandDescription = optimizeDescription,- commandExtraArgs = 0,- commandExtraArgHelp = [],- commandCommand = optimizeCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [uncompressNocompress, umaskOption],- commandBasicOptions = [workingRepoDir,- reorderPatches,- sibling, relink,- relinkPristine,- upgradeFormat,- optimizePristine- ]} --optimizeHTTP]} -- disabled for 2.5--optimizeCmd :: [DarcsFlag] -> [String] -> IO ()-optimizeCmd origopts _ = do- when (UpgradeFormat `elem` origopts) optimizeUpgradeFormat- withRepoLock opts $- \repository -> do- when (OptimizeHTTP `elem` origopts) doOptimizeHTTP- if (OptimizePristine `elem` opts)- then doOptimizePristine repository- else do cleanRepository repository- doReorder opts repository- doOptimizeInventory repository- when (Compress `elem` opts || UnCompress `elem` opts) $- optimizeCompression opts- when (Relink `elem` opts || (RelinkPristine `elem` opts)) $- doRelink opts repository- putStrLn "Done optimizing!"- where opts = if UnCompress `elem` origopts then NoCompress:origopts else origopts--optimizeHelpInventory :: String-optimizeHelpInventory =- "The default optimization moves recent patches (those not included in\n" ++- "the latest tag) to the `front', reducing the amount that a typical\n" ++- "remote command needs to download. It should also reduce the CPU time\n" ++- "needed for some operations.\n"--doOptimizeInventory :: RepoPatch p => Repository p C(r u t) -> IO ()-doOptimizeInventory repository = do- debugMessage "Writing out a nice copy of the inventory."- optimizeInventory repository- debugMessage "Done writing out a nice copy of the inventory."--optimizeHelpCompression :: String-optimizeHelpCompression =- "By default patches are compressed with zlib (RFC 1951) to reduce\n" ++- "storage (and download) size. In exceptional circumstances, it may be\n" ++- "preferable to avoid compression. In this case the `--dont-compress'\n" ++- "option can be used (e.g. with `darcs record') to avoid compression.\n" ++- "\n" ++- "The `darcs optimize --uncompress' and `darcs optimize --compress'\n" ++- "commands can be used to ensure existing patches in the current\n" ++- "repository are respectively uncompressed or compressed. Note that\n" ++- "repositories in the legacy `old-fashioned-inventory' format have a .gz\n" ++- "extension on patch files even when uncompressed.\n"--optimizeCompression :: [DarcsFlag] -> IO ()-optimizeCompression opts = do- putStrLn "Optimizing (un)compression of patches..."- do_compress (darcsdir++"/patches")- putStrLn "Optimizing (un)compression of inventories..."- do_compress (darcsdir++"/inventories")- where do_compress f =- do isd <- doesDirectoryExist f- if isd then withCurrentDirectory f $- do fs <- filter notdot `fmap` getDirectoryContents "."- mapM_ do_compress fs- else if Compress `elem` opts- then gzReadFilePS f >>= gzWriteAtomicFilePS f- else gzReadFilePS f >>= writeAtomicFilePS f- notdot ('.':_) = False- notdot _ = True--optimizeHelpRelink :: String-optimizeHelpRelink =- "The `darcs optimize --relink' command hard-links patches that the\n" ++- "current repository has in common with its peers. Peers are those\n" ++- "repositories listed in _darcs/prefs/sources, or defined with the\n" ++- "`--sibling' option (which can be used multiple times).\n" ++- "\n" ++- "Darcs uses hard-links automatically, so this command is rarely needed.\n" ++- "It is most useful if you used `cp -r' instead of `darcs get' to copy a\n" ++- "repository, or if you pulled the same patch from a remote repository\n" ++- "into multiple local repositories.\n" ++- "\n" ++- "A `darcs optimize --relink-pristine' command is also available, but\n" ++- "generally SHOULD NOT be used. It results in a relatively small space\n" ++- "saving at the cost of making many Darcs commands MUCH slower.\n"--doOptimizePristine :: RepoPatch p => Repository p C(r u t) -> IO ()-doOptimizePristine repo = do- hashed <- doesFileExist $ darcsdir </> "hashed_inventory"- when hashed $ do- inv <- BS.readFile (darcsdir </> "hashed_inventory")- let linesInv = BS.split '\n' inv- case linesInv of- [] -> return ()- (pris_line:_) ->- let size = decodeDarcsSize $ BS.drop 9 pris_line- in when (isJust size) $ do putStrLn "Optimizing hashed pristine..."- readRecorded repo >>= replacePristine repo- cleanRepository repo--doRelink :: RepoPatch p => [DarcsFlag] -> Repository p C(r u t) -> IO ()-doRelink opts repository =- do some_siblings <- return (flagsToSiblings opts)- defrepolist <- getPreflist "defaultrepo"- siblings <- return (map toFilePath some_siblings ++ defrepolist)- if (siblings == [])- then putStrLn "No siblings -- no relinking done."- else do when (Relink `elem` opts) $- do debugMessage "Relinking patches..."- patch_tree <- expand =<< readPlainTree "_darcs/patches"- let patches = [ anchorPath "" p | (p, File _) <- list patch_tree ]- maybeRelinkFiles siblings patches "_darcs/patches"- when (RelinkPristine `elem` opts) $- do pristine <- identifyPristine- case (pristineDirectory pristine) of- (Just d) -> do- debugMessage "Relinking pristine tree..."- c <- readRecorded repository- maybeRelinkFiles- siblings [ anchorPath "" p | (p, File _) <- list c ] d- Nothing -> return ()- debugMessage "Done relinking."- return ()- return ()--maybeRelinkFiles :: [String] -> [String] -> String -> IO ()-maybeRelinkFiles src dst dir =- mapM_ (maybeRelinkFile src) (map ((dir ++ "/") ++) dst)--maybeRelinkFile :: [String] -> String -> IO ()-maybeRelinkFile [] _ = return ()-maybeRelinkFile (h:t) f =- do done <- maybeRelink (h ++ "/" ++ f) f- unless done $- maybeRelinkFile t f- return ()---\end{code}-\begin{options}---reorder-patches-\end{options}--The \verb|--reorder-patches| option causes Darcs to create an optimal-ordering of its internal patch inventory. This may help to produce shorter-`context' lists when sending patches, and may improve performance for some-other operations as well. You should not run \verb!--reorder-patches! on a-repository from which someone may be simultaneously pulling or getting, as-this could lead to repository corruption.-\begin{code}---- FIXME: someone needs to grovel through the source and determine--- just how optimizeInventory differs from doReorder. The following--- is purely speculation. --twb, 2009-04--- optimize_help_reorder :: String--- optimize_help_reorder =--- "The `darcs optimize --reorder' command is a more comprehensive version\n" ++--- "of the default optimization. It reorders patches with respect to ALL\n" ++--- "tags, rather than just the latest tag.\n"--doReorder :: RepoPatch p => [DarcsFlag] -> Repository p C(r u r) -> IO ()-doReorder opts _ | not (Reorder `elem` opts) = return ()-doReorder opts repository = do- debugMessage "Reordering the inventory."- PatchSet ps _ <- chooseOrder `fmap` readRepo repository- withGutsOf repository $ do tentativelyReplacePatches repository opts $ reverseRL ps- finalizeRepositoryChanges repository- debugMessage "Done reordering the inventory."--chooseOrder :: forall p C(s x) . RepoPatch p => PatchSet p C(s x) -> PatchSet p C(s x)-chooseOrder ps = case filter isTag $ mapRL info $ newset2RL ps of- [] -> ps- (lt:_) -> case splitOnTag lt ps of- PatchSet xs ts :>> r -> PatchSet (r+<+xs) ts-\end{code}--The \verb|--upgrade| option for \verb!darcs optimize! performs an inplace-upgrade of your repository to the latest \emph{compatible} format. Right now-means that darcs 1 old-fashioned repositories will be upgraded to darcs-1-hashed repositories (and notably, not to darcs 2 repositories as that would not-be compatible; see \verb!darcs convert!).--\begin{code}-optimizeUpgradeFormat :: IO ()-optimizeUpgradeFormat = do- debugMessage $ "Upgrading to hashed..."- rf <- either fail return =<< identifyRepoFormat "."- debugMessage $ "Found our format"- if formatHas HashedInventory rf- then putStrLn "No action taken because this repository already is hashed."- else do putStrLn "Checking repository in case of corruption..."- withRepoLock [] $- \repository -> do- state <- replayRepository repository [] return- case state of- RepositoryConsistent -> do- putStrLn "The repository is consistent."- actuallyUpgradeFormat repository- _repoIsBroken ->- putStrLn "Corruption detected! Please run darcs repair first."--actuallyUpgradeFormat :: RepoPatch p => Repository p C(r u t) -> IO ()-actuallyUpgradeFormat repository = do- -- convert patches/inventory- patches <- readRepo repository- let k = "Hashing patch"- beginTedious k- tediousSize k (lengthRL $ newset2RL patches)- let patches' = progressPatchSet k patches- cache <- getCaches [] "."- let compr = compression [] -- default compression- HashedRepo.writeTentativeInventory cache compr patches'- endTedious k- -- convert pristine by applying patches- -- the faster alternative would be to copy pristine, but the apply method is more reliable- let patchesToApply = progressFL "Applying patch" $ newset2FL $ patches'- createDirectoryIfMissing False $ darcsdir </> hashedDir HashedPristineDir- writeDarcsHashed emptyTree "_darcs/pristine.hashed"- sequence_ $ mapFL (HashedRepo.applyToTentativePristine []) $ bunchFL 100 patchesToApply- -- now make it official- HashedRepo.finalizeTentativeChanges repository compr- writeRepoFormat (createRepoFormat [UseHashedInventory]) (darcsdir </> "format")- -- clean out old-fashioned junk- debugMessage "Cleaning out old-fashioned repository files..."- removeFile $ darcsdir </> "inventory"- removeFile $ darcsdir </> "tentative_inventory"- rmRecursive (darcsdir </> "pristine") `catchall` rmRecursive (darcsdir </> "current")- rmGzsIn (darcsdir </> "patches")- rmGzsIn (darcsdir </> "inventories")- let checkpointDir = darcsdir </> "checkpoints"- hasCheckPoints <- doesDirectoryExist checkpointDir- when hasCheckPoints $ rmRecursive checkpointDir- putStrLn "Done upgrading!"- where- rmGzsIn dir =- withCurrentDirectory dir $ do- gzs <- filter ((== ".gz") . takeExtension) `fmap` getDirectoryContents "."- mapM_ removeFile gzs--doOptimizeHTTP :: IO ()-doOptimizeHTTP = do- rf <- either fail return =<< identifyRepoFormat "."- unless (formatHas HashedInventory rf) . fail $- "Unsupported repository format:\n" ++- " only hashed repositories can be optimized for HTTP"- createDirectoryIfMissing False packsDir- ps <- dirContents' "patches" $ \x -> all (x /=) ["unrevert", "pending",- "pending.tentative"]- BL.writeFile (patchesTar <.> "part") . compress . write =<<- mapM fileEntry' ps- renameFile (patchesTar <.> "part") patchesTar- let i = darcsdir </> "hashed_inventory"- is <- dirContents "inventories"- pr <- dirContents "pristine.hashed"- BL.writeFile (basicTar <.> "part") . compress . write =<<- mapM fileEntry' (i : (is ++ pr))- renameFile (basicTar <.> "part") basicTar- where- packsDir = darcsdir </> "packs"- basicTar = packsDir </> "basic.tar.gz"- patchesTar = packsDir </> "patches.tar.gz"- fileEntry' x = unsafeInterleaveIO $ do- content <- BL.fromChunks . return <$> gzReadFilePS x- tp <- either fail return $ toTarPath False x- return $ fileEntry tp content- dirContents d = dirContents' d $ const True- dirContents' d f = map ((darcsdir </> d) </>) . filter (\x ->- head x /= '.' && f x) <$> getDirectoryContents (darcsdir </> d)-\end{code}
+ src/Darcs/Commands/Pull.hs view
@@ -0,0 +1,325 @@+-- Copyright (C) 2002-2005 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.++{-# LANGUAGE CPP #-}++module Darcs.Commands.Pull ( pull, fetch ) where+import System.Exit ( ExitCode(..), exitWith )+import Workaround ( getCurrentDirectory )+import Control.Monad ( when )+import Data.List ( nub )+import Data.Maybe ( fromMaybe )++import Darcs.Commands ( DarcsCommand(..), putVerbose, putInfo )+import Darcs.CommandsAux ( checkPaths )+import Darcs.Arguments ( DarcsFlag( Verbose, DryRun, MarkConflicts,+ Intersection, Complement, AllowConflicts,+ NoAllowConflicts, XMLOutput ),+ nocompress, ignoretimes, setEnvDarcsPatches,+ depsSel, pullConflictOptions, useExternalMerge,+ matchSeveral, fixUrl,+ allInteractive, repoCombinator,+ printDryRunMessageAndExit,+ test, dryRun,+ setDefault, summary, workingRepoDir, remoteRepo,+ setScriptsExecutableOption,+ networkOptions, umaskOption, allowUnrelatedRepos, restrictPaths, changesReverse,+ getOutput, output, makeScriptsExecutable+ )+import Darcs.Flags( doReverse, isInteractive )+import Darcs.Repository ( Repository, identifyRepositoryFor, withGutsOf,+ amInHashedRepository, withRepoLock, RepoJob(..),+ finalizeRepositoryChanges, applyToWorking,+ testTentative,+ readRepo, checkUnrelatedRepos, invalidateIndex, modifyCache, modifyCache, Cache(..), CacheLoc(..), WritableOrNot(..))+import qualified Darcs.Repository.Cache as DarcsCache+import Darcs.Repository.Merge ( tentativelyMergePatches )+import Darcs.Patch.PatchInfoAnd ( info, hopefully, patchDesc )+import Darcs.Patch ( RepoPatch, description )+import Darcs.Patch.Bundle( makeBundleN, patchFilename )+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd )+#ifdef GADT_WITNESSES+import Darcs.Patch.Set ( Origin )+#endif+import Darcs.Patch.Set ( PatchSet(..), SealedPatchSet )+import Darcs.Witnesses.Unsafe ( unsafeCoercePEnd )+import Darcs.Witnesses.Ordered ( (:>)(..), (:\/:)(..), FL(..), RL(..)+ , mapFL, nullFL, reverseFL, mapFL_FL )+import Darcs.Patch.Permutations ( partitionFL )+import Darcs.Repository.Prefs ( addToPreflist, defaultrepo, setDefaultrepo, getPreflist )+import Darcs.Repository.Motd (showMotd )+import Darcs.Patch.Depends ( findUncommon, findCommonWithThem,+ newsetIntersection, newsetUnion )+import Darcs.SelectChanges ( selectChanges,+ WhichChanges(..),+ filterOutConflicts,+ runSelection, selectionContext)+import Darcs.Utils ( clarifyErrors, formatPath,+ PromptConfig(..), promptChar )+import Darcs.Witnesses.Sealed ( Sealed(..), seal )+import Printer ( putDocLn, vcat, ($$), text, putDoc )+import Darcs.Lock ( writeDocBinFile )+import Darcs.RepoPath ( useAbsoluteOrStd, stdOut )+#include "impossible.h"++#include "gadts.h"++pullDescription :: String+pullDescription =+ "Copy and apply patches from another repository to this one."++fetchDescription :: String+fetchDescription =+ "Fetch patches from another repository, but don't apply them."++pullHelp :: String+pullHelp =+ "Pull is used to bring changes made in another repository into the current\n"+++ "repository (that is, either the one in the current directory, or the one\n"+++ "specified with the --repodir option). Pull allows you to bring over all or\n"+++ "some of the patches that are in that repository but not in this one. Pull\n"+++ "accepts arguments, which are URLs from which to pull, and when called\n"+++ "without an argument, pull will use the repository from which you have most\n"+++ "recently either pushed or pulled.\n"++fetchHelp :: String+fetchHelp =+ "fetch is used to bring changes made in another repository\n" +++ "into the current repository without actually applying\n"+++ "them. Fetch allows you to bring over all or\n"+++ "some of the patches that are in that repository but not in this one. Fetch\n"+++ "accepts arguments, which are URLs from which to fetch, and when called\n"+++ "without an argument, fetch will use the repository from which you have most\n"+++ "recently either pushed or pulled.\n"+++ "The fetched patches are stored into a patch bundle, to be later\n" +++ "applied using \"darcs apply\"."+++fetch :: DarcsCommand+fetch = DarcsCommand {+ commandProgramName = "darcs",+ commandName = "fetch",+ commandHelp = fetchHelp,+ commandDescription = fetchDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["[REPOSITORY]..."],+ commandCommand = fetchCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = getPreflist "repos",+ commandArgdefaults = defaultrepo,+ commandAdvancedOptions = [repoCombinator,+ remoteRepo] +++ networkOptions,+ commandBasicOptions = [matchSeveral,+ allInteractive]+ ++dryRun+++ [summary,+ depsSel,+ setDefault False,+ workingRepoDir,+ output,+ allowUnrelatedRepos]}++pull :: DarcsCommand+pull = DarcsCommand {commandProgramName = "darcs",+ commandName = "pull",+ commandHelp = pullHelp,+ commandDescription = pullDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["[REPOSITORY]..."],+ commandCommand = pullCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = getPreflist "repos",+ commandArgdefaults = defaultrepo,+ commandAdvancedOptions = [repoCombinator,+ nocompress,+ ignoretimes,+ remoteRepo,+ setScriptsExecutableOption,+ umaskOption,+ restrictPaths,+ changesReverse+ ] +++ networkOptions,+ commandBasicOptions = [matchSeveral,+ allInteractive,+ pullConflictOptions,+ useExternalMerge,+ test]++dryRun++[summary,+ depsSel,+ setDefault False,+ workingRepoDir,+ allowUnrelatedRepos]}++mergeOpts :: [DarcsFlag] -> [DarcsFlag]+mergeOpts opts | NoAllowConflicts `elem` opts = opts+ | AllowConflicts `elem` opts = opts+ | otherwise = MarkConflicts : opts++pullCmd :: [DarcsFlag] -> [String] -> IO ()+pullCmd opts repos =+ do+ pullingFrom <- mapM (fixUrl opts) repos+ withRepoLock opts $ RepoJob $ \ initRepo -> do+ let repository = modifyCache initRepo $ addReposToCache pullingFrom+ r <- fetchPatches opts' repos "pull" repository+ applyPatches opts' repository r+ where+ opts' = mergeOpts opts+ addReposToCache repos' (Ca cache) = Ca $ [ toReadOnlyCache r | r <- repos' ] ++ cache+ toReadOnlyCache = Cache DarcsCache.Repo NotWritable+++fetchCmd :: [DarcsFlag] -> [String] -> IO ()+fetchCmd opts repos =+ withRepoLock opts $ RepoJob $ \ repository ->+ fetchPatches opts repos "fetch" repository+ >>= makeBundle opts++fetchPatches :: FORALL(p r u) (RepoPatch p) => [DarcsFlag] -> [String] -> String ->+ Repository p C(r u r) ->+ IO ( SealedPatchSet p C(Origin), Sealed ((FL (PatchInfoAnd p) :\/: FL (PatchInfoAnd p)) C(r)))+fetchPatches opts unfixedrepodirs@(_:_) jobname repository = do+ here <- getCurrentDirectory+ repodirs <- (nub . filter (/= here)) `fmap` mapM (fixUrl opts) unfixedrepodirs+ -- Test to make sure we aren't trying to pull from the current repo+ when (null repodirs) $+ fail "Can't pull from current repository!"+ old_default <- getPreflist "defaultrepo"+ when (old_default == repodirs && not (XMLOutput `elem` opts)) $+ let pulling = if DryRun `elem` opts then "Would pull" else "Pulling"+ in putInfo opts $ text $ pulling++" from "++concatMap formatPath repodirs++"..."+ (Sealed them, Sealed compl) <- readRepos repository opts repodirs+ setDefaultrepo (head repodirs) opts+ mapM_ (addToPreflist "repos") repodirs+ mapM_ (showMotd opts) repodirs+ us <- readRepo repository+ checkUnrelatedRepos opts us them++ common :> _ <- return $ findCommonWithThem us them+ us' :\/: them' <- return $ findUncommon us them+ _ :\/: compl' <- return $ findUncommon us compl++ let avoided = mapFL info compl'+ ps :> _ <- return $ partitionFL (not . (`elem` avoided) . info) them'+ when (Verbose `elem` opts) $+ do case us' of+ (x@(_:>:_)) -> putDocLn $ text "We have the following new (to them) patches:"+ $$ (vcat $ mapFL description x)+ _ -> return ()+ when (not $ nullFL ps) $ putDocLn $ text "They have the following patches to pull:"+ $$ (vcat $ mapFL description ps)+ (hadConflicts, Sealed psFiltered) <- filterOutConflicts opts (reverseFL us') repository ps+ when hadConflicts $ putStrLn "Skipping some patches which would cause conflicts."+ when (nullFL psFiltered) $ do putInfo opts $ text "No remote changes to pull in!"+ setEnvDarcsPatches psFiltered+ exitWith ExitSuccess+ let context = selectionContext jobname opts Nothing Nothing+ selector = if doReverse opts+ then selectChanges FirstReversed+ else selectChanges First+ (to_be_pulled :> _) <- runSelection (selector psFiltered) $ context+ return (seal common, seal $ us' :\/: to_be_pulled)++fetchPatches _ [] jobname _ = fail $ "No default repository to " ++ jobname +++ " from, please specify one"++applyPatches ::+ forall p C(r u). (RepoPatch p) => [DarcsFlag] -> Repository p C(r u r) ->+ (SealedPatchSet p C(Origin), Sealed ((FL (PatchInfoAnd p) :\/: FL (PatchInfoAnd p)) C(r)))+ -> IO ()+applyPatches opts repository (_, Sealed (us' :\/: to_be_pulled)) =+ do+ printDryRunMessageAndExit "pull" opts to_be_pulled+ setEnvDarcsPatches to_be_pulled+ when (nullFL to_be_pulled) $ do+ putStrLn "You don't want to pull any patches, and that's fine with me!"+ exitWith ExitSuccess+ checkPaths opts to_be_pulled+ putVerbose opts $ text "Getting and merging the following patches:"+ putVerbose opts $ vcat $ mapFL description to_be_pulled+ Sealed pw <- tentativelyMergePatches repository "pull" opts us' to_be_pulled+ invalidateIndex repository+ rc <- testTentative repository+ when (rc /= ExitSuccess) $ do+ when (not $ isInteractive opts) $ exitWith rc+ putStrLn $ "Looks like those patches do not pass the tests."+ let prompt = "Shall I apply them anyway?"+ yn <- promptChar (PromptConfig prompt "yn" [] (Just 'n') [])+ case yn of+ 'y' -> return ()+ _ -> exitWith rc+ withGutsOf repository $ do finalizeRepositoryChanges repository+ _ <- revertable $ applyToWorking repository opts pw+ makeScriptsExecutable opts pw+ return ()+ putInfo opts $ text "Finished pulling and applying."++makeBundle ::+ forall p C(r) . (RepoPatch p) => [DarcsFlag] ->+ (SealedPatchSet p C(Origin), Sealed ((FL (PatchInfoAnd p) :\/: FL (PatchInfoAnd p)) C(r)))+ -> IO ()+makeBundle opts (Sealed common, Sealed (_ :\/: to_be_fetched)) =+ do+ bundle <- makeBundleN Nothing (unsafeCoercePEnd common) $+ mapFL_FL hopefully to_be_fetched+ let fname = case to_be_fetched of+ (x:>:_)-> patchFilename $ patchDesc x+ _ -> impossible+ o = fromMaybe stdOut (getOutput opts fname)+ useAbsoluteOrStd writeDocBinFile putDoc o $ bundle++revertable :: IO a -> IO a+revertable x =+ x `clarifyErrors` unlines+ ["Error applying patch to the working directory.","",+ "This may have left your working directory an inconsistent",+ "but recoverable state. If you had no un-recorded changes",+ "by using 'darcs revert' you should be able to make your",+ "working directory consistent again."]++{- Read in the specified pull-from repositories. Perform+Intersection, Union, or Complement read. In patch-theory terms+(stated in set algebra, where + is union and & is intersection+and \ is complement):++ Union = ((R1 + R2 + ... + Rn) \ Rc)+ Intersection = ((R1 & R2 & ... & Rn) \ Rc)+ Complement = (R1 \ Rc) \ ((R2 + R3 + ... + Rn) \ Rc)++ where Rc = local repo+ R1 = 1st specified pull repo+ R2, R3, Rn = other specified pull repo++Since Rc is not provided here yet, the result of readRepos is a+tuple: the first patchset(s) to be complemented against Rc and then+the second patchset(s) to be complemented against Rc.+-}++readRepos :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> [String]+ -> IO (SealedPatchSet p C(Origin),SealedPatchSet p C(Origin))+readRepos _ _ [] = impossible+readRepos to_repo opts us =+ do rs <- mapM (\u -> do r <- identifyRepositoryFor to_repo u+ ps <- readRepo r+ return $ seal ps) us+ return $ if Intersection `elem` opts+ then (newsetIntersection rs, seal (PatchSet NilRL NilRL))+ else if Complement `elem` opts+ then (head rs, newsetUnion $ tail rs)+ else (newsetUnion rs, seal (PatchSet NilRL NilRL))+
− src/Darcs/Commands/Pull.lhs
@@ -1,385 +0,0 @@-% Copyright (C) 2002-2005 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.--\darcsCommand{pull}-\begin{code}-{-# OPTIONS_GHC -cpp #-}--module Darcs.Commands.Pull ( pull, fetch ) where-import System.Exit ( ExitCode(..), exitWith )-import Workaround ( getCurrentDirectory )-import Control.Monad ( when )-import Data.List ( nub )-import Data.Maybe ( fromMaybe )--import Darcs.Commands ( DarcsCommand(..), putVerbose, putInfo )-import Darcs.CommandsAux ( checkPaths )-import Darcs.Arguments ( DarcsFlag( Verbose, DryRun, MarkConflicts,- Intersection, Complement, AllowConflicts,- NoAllowConflicts, XMLOutput ),- nocompress, ignoretimes, definePatches,- depsSel, pullConflictOptions, useExternalMerge,- matchSeveral, fixUrl,- allInteractive, repoCombinator,- printDryRunMessageAndExit,- test, dryRun,- setDefault, summary, workingRepoDir, remoteRepo,- setScriptsExecutableOption, nolinks,- networkOptions, umaskOption, allowUnrelatedRepos, restrictPaths, changesReverse,- getOutput, output- )-import Darcs.Flags( doReverse )-import Darcs.Repository ( Repository, identifyRepositoryFor, withGutsOf,- amInRepository, withRepoLock, ($-), tentativelyMergePatches,- finalizeRepositoryChanges, applyToWorking,- readRepo, checkUnrelatedRepos, invalidateIndex, modifyCache, modifyCache, HashedDir(..), Cache(..), CacheLoc(..), WritableOrNot(..))-import qualified Darcs.Repository.Cache as DarcsCache-import Darcs.Repository.Merge-import Darcs.Hopefully ( info, hopefully, patchDesc )-import Darcs.Patch ( RepoPatch, description )-import Darcs.Patch.Info ( PatchInfo )-import Darcs.Patch.Bundle( makeBundleN, patchFilename )-import Darcs.Hopefully ( PatchInfoAnd )-#ifdef GADT_WITNESSES-import Darcs.Patch.Set ( Origin )-#endif-import Darcs.Patch.Set ( PatchSet(..), SealedPatchSet, newset2FL )-import Darcs.Witnesses.Ordered ( (:>)(..), (:\/:)(..), FL(..), RL(..), (:>>)(..)- , mapFL, nullFL, reverseFL, mapFL_FL, unsafeCoercePEnd )-import Darcs.Patch.Permutations ( partitionFL )-import Darcs.Repository.Prefs ( addToPreflist, defaultrepo, setDefaultrepo, getPreflist )-import Darcs.Repository.Motd (showMotd )-import Darcs.Patch.Depends ( findUncommon, findCommonWithThem,- newsetIntersection, newsetUnion )-import Darcs.SelectChanges ( selectChanges,- WhichChanges(..),- filterOutConflicts,- runSelection, selectionContext)-import Darcs.Utils ( clarifyErrors, formatPath )-import Darcs.Witnesses.Sealed ( Sealed(..), seal )-import Printer ( putDocLn, vcat, ($$), text, putDoc )-import Darcs.Lock ( writeDocBinFile )-import Darcs.RepoPath ( useAbsoluteOrStd, stdOut )-#include "impossible.h"--#include "gadts.h"--pullDescription :: String-pullDescription =- "Copy and apply patches from another repository to this one."--fetchDescription :: String-fetchDescription =- "Fetch patches from another repository, but don't apply them."--pullHelp :: String-pullHelp =- "Pull is used to bring changes made in another repository into the current\n"++- "repository (that is, either the one in the current directory, or the one\n"++- "specified with the --repodir option). Pull allows you to bring over all or\n"++- "some of the patches that are in that repository but not in this one. Pull\n"++- "accepts arguments, which are URLs from which to pull, and when called\n"++- "without an argument, pull will use the repository from which you have most\n"++- "recently either pushed or pulled.\n"--fetchHelp :: String-fetchHelp =- "fetch is used to bring changes made in another repository\n" ++- "into the current repository without actually applying\n"++- "them. Fetch allows you to bring over all or\n"++- "some of the patches that are in that repository but not in this one. Fetch\n"++- "accepts arguments, which are URLs from which to fetch, and when called\n"++- "without an argument, fetch will use the repository from which you have most\n"++- "recently either pushed or pulled.\n"++- "The fetched patches are stored into a patch bundle, to be later\n" ++- "applied using \"darcs apply\"."---fetch :: DarcsCommand-fetch = DarcsCommand {- commandName = "fetch",- commandHelp = fetchHelp,- commandDescription = fetchDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["[REPOSITORY]..."],- commandCommand = fetchCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = getPreflist "repos",- commandArgdefaults = defaultrepo,- commandAdvancedOptions = [repoCombinator,- remoteRepo] ++- networkOptions,- commandBasicOptions = [matchSeveral,- allInteractive]- ++dryRun++- [summary,- depsSel,- setDefault False,- workingRepoDir,- output,- allowUnrelatedRepos]}--pull :: DarcsCommand-pull = DarcsCommand {commandName = "pull",- commandHelp = pullHelp,- commandDescription = pullDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["[REPOSITORY]..."],- commandCommand = pullCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = getPreflist "repos",- commandArgdefaults = defaultrepo,- commandAdvancedOptions = [repoCombinator,- nocompress, nolinks,- ignoretimes,- remoteRepo,- setScriptsExecutableOption,- umaskOption,- restrictPaths,- changesReverse- ] ++- networkOptions,- commandBasicOptions = [matchSeveral,- allInteractive,- pullConflictOptions,- useExternalMerge,- test]++dryRun++[summary,- depsSel,- setDefault False,- workingRepoDir,- allowUnrelatedRepos]}--mergeOpts :: [DarcsFlag] -> [DarcsFlag]-mergeOpts opts | NoAllowConflicts `elem` opts = opts- | AllowConflicts `elem` opts = opts- | otherwise = MarkConflicts : opts--pullCmd :: [DarcsFlag] -> [String] -> IO ()-pullCmd opts repos =- do- pullingFrom <- mapM (fixUrl opts) repos- withRepoLock opts $- \ initRepo -> do- let repository = modifyCache initRepo $ addReposToCache pullingFrom- r <- fetchPatches opts' repos "pull" repository- applyPatches opts' repository r- where- opts' = mergeOpts opts- addReposToCache repos (Ca cache) = Ca $ [ toReadOnlyCache r | r <- repos ] ++ cache- toReadOnlyCache = Cache DarcsCache.Repo NotWritable---fetchCmd :: [DarcsFlag] -> [String] -> IO ()-fetchCmd opts repos =- withRepoLock opts $- \ repository ->- fetchPatches opts repos "fetch" repository- >>= makeBundle opts--fetchPatches :: FORALL(p r u t) (RepoPatch p) => [DarcsFlag] -> [String] -> String ->- Repository p C(r u r) ->- IO ( SealedPatchSet p C(Origin), Sealed ((FL (PatchInfoAnd p) :\/: FL (PatchInfoAnd p)) C(r)))-fetchPatches opts unfixedrepodirs@(_:_) jobname repository = do- here <- getCurrentDirectory- repodirs <- (nub . filter (/= here)) `fmap` mapM (fixUrl opts) unfixedrepodirs- -- Test to make sure we aren't trying to pull from the current repo- when (null repodirs) $- fail "Can't pull from current repository!"- old_default <- getPreflist "defaultrepo"- when (old_default == repodirs && not (XMLOutput `elem` opts)) $- let pulling = if DryRun `elem` opts then "Would pull" else "Pulling"- in putInfo opts $ text $ pulling++" from "++concatMap formatPath repodirs++"..."- (Sealed them, Sealed compl) <- readRepos repository opts repodirs- setDefaultrepo (head repodirs) opts- mapM_ (addToPreflist "repos") repodirs- mapM_ (showMotd opts) repodirs- us <- readRepo repository- checkUnrelatedRepos opts us them-- common :>> _ <- return $ findCommonWithThem us them- us' :\/: them' <- return $ findUncommon us them- _ :\/: compl' <- return $ findUncommon us compl-- let avoided = mapFL info compl'- ps :> _ <- return $ partitionFL (not . (`elem` avoided) . info) them'- when (Verbose `elem` opts) $- do case us' of- (x@(_:>:_)) -> putDocLn $ text "We have the following new (to them) patches:"- $$ (vcat $ mapFL description x)- _ -> return ()- when (not $ nullFL ps) $ putDocLn $ text "They have the following patches to pull:"- $$ (vcat $ mapFL description ps)- (hadConflicts, Sealed psFiltered) <- filterOutConflicts opts (reverseFL us') repository ps- when hadConflicts $ putStrLn "Skipping some patches which would cause conflicts."- when (nullFL psFiltered) $ do putInfo opts $ text "No remote changes to pull in!"- definePatches psFiltered- exitWith ExitSuccess- let context = selectionContext jobname opts Nothing []- selector = if doReverse opts- then selectChanges FirstReversed- else selectChanges First- (to_be_pulled :> _) <- runSelection (selector psFiltered) $ context- return (seal common, seal $ us' :\/: to_be_pulled)--fetchPatches _ [] jobname _ = fail $ "No default repository to " ++ jobname ++- " from, please specify one"--applyPatches ::- forall p C(r u t a). (RepoPatch p) => [DarcsFlag] -> Repository p C(r u r) ->- (SealedPatchSet p C(Origin), Sealed ((FL (PatchInfoAnd p) :\/: FL (PatchInfoAnd p)) C(r)))- -> IO ()-applyPatches opts repository (_, Sealed (us' :\/: to_be_pulled)) =- do- printDryRunMessageAndExit "pull" opts to_be_pulled- definePatches to_be_pulled- when (nullFL to_be_pulled) $ do- putStrLn "You don't want to pull any patches, and that's fine with me!"- exitWith ExitSuccess- checkPaths opts to_be_pulled- putVerbose opts $ text "Getting and merging the following patches:"- putVerbose opts $ vcat $ mapFL description to_be_pulled- Sealed pw <- tentativelyMergePatches repository "pull" opts us' to_be_pulled- invalidateIndex repository- withGutsOf repository $ do finalizeRepositoryChanges repository- revertable $ applyToWorking repository opts pw- return ()- putInfo opts $ text "Finished pulling and applying."--makeBundle ::- forall p C(r u t x) . (RepoPatch p) => [DarcsFlag] ->- (SealedPatchSet p C(Origin), Sealed ((FL (PatchInfoAnd p) :\/: FL (PatchInfoAnd p)) C(r)))- -> IO ()-makeBundle opts (Sealed common, Sealed (_ :\/: to_be_fetched)) =- do- bundle <- makeBundleN Nothing (unsafeCoercePEnd common) $- mapFL_FL hopefully to_be_fetched- let fname = case to_be_fetched of- (x:>:_)-> patchFilename $ patchDesc x- o = fromMaybe stdOut (getOutput opts fname)- useAbsoluteOrStd writeDocBinFile putDoc o $ bundle--revertable :: IO a -> IO a-revertable x =- x `clarifyErrors` unlines- ["Error applying patch to the working directory.","",- "This may have left your working directory an inconsistent",- "but recoverable state. If you had no un-recorded changes",- "by using 'darcs revert' you should be able to make your",- "working directory consistent again."]--{- Read in the specified pull-from repositories. Perform-Intersection, Union, or Complement read. In patch-theory terms-(stated in set algebra, where + is union and & is intersection-and \ is complement):-- Union = ((R1 + R2 + ... + Rn) \ Rc)- Intersection = ((R1 & R2 & ... & Rn) \ Rc)- Complement = (R1 \ Rc) \ ((R2 + R3 + ... + Rn) \ Rc)-- where Rc = local repo- R1 = 1st specified pull repo- R2, R3, Rn = other specified pull repo--Since Rc is not provided here yet, the result of readRepos is a-tuple: the first patchset(s) to be complemented against Rc and then-the second patchset(s) to be complemented against Rc.--}--readRepos :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> [String]- -> IO (SealedPatchSet p C(Origin),SealedPatchSet p C(Origin))-readRepos _ _ [] = impossible-readRepos to_repo opts us =- do rs <- mapM (\u -> do r <- identifyRepositoryFor to_repo u- ps <- readRepo r- return $ seal ps) us- return $ if Intersection `elem` opts- then (newsetIntersection rs, seal (PatchSet NilRL NilRL))- else if Complement `elem` opts- then (head rs, newsetUnion $ tail rs)- else (newsetUnion rs, seal (PatchSet NilRL NilRL))--\end{code}--\begin{options}---intersection, --union [DEFAULT], --complement-\end{options}--If you provide more than one repository as an argument to pull, darcs'-behavior is determined by the presence of the \verb!--complement!,-\verb!--intersection!, and \verb!--union! flags.--\begin{itemize}--\item The default (\verb!--union!) behavior is to pull any patches-that are in any of the specified repositories ($ R_1 \bigcup R_2-\bigcup R_3 \ldots$).--\item If you instead specify the \verb!--intersection! flag, darcs-will only pull those patches which are present in all source-repositories ($ R_1 \bigcap R_2 \bigcap R_3 \ldots$).--\item If you specify the \verb!--complement! flag, darcs will only-pull elements in the first repository that do not exist in any of the-remaining repositories\footnote{The first thing darcs will do is-remove duplicates, keeping only the first specification. This is-noticeable for the complement operation, since mathematically $ S-\backslash S \rightarrow \emptyset $, one would expect that-``\texttt{darcs pull --complement repo1 repo1}'' would result in no-pulls, but the duplicate elimination removes the second-\texttt{repo1}, reducing the above to effectively ``\texttt{darcs pull-repo1}''. The expected functionality could be seen via-``\texttt{darcs get -a repo1 repo2; darcs pull --complement repo1-repo2}'', but there are easier ways of doing nothing!} ($ R_1-\backslash (R_2 \bigcup R_3 \bigcup \ldots$)).--\end{itemize}---\begin{options}---external-merge-\end{options}--You can use an external interactive merge tool to resolve conflicts with the-flag \verb!--external-merge!. For more details see-subsection~\ref{resolution}.--\begin{options}---matches, --patches, --tags, --no-deps-\end{options}--The \verb!--patches!, \verb!--matches!, \verb!--tags!, and \verb!--no-deps!-options can be used to select which patches to pull, as described in-subsection~\ref{selecting}.--\begin{options}---no-test, --test-\end{options}--If you specify the \verb!--test! option, pull will run the test (if a test-exists) on a scratch copy of the repository contents prior to actually performing-the pull. If the test fails, the pull will be aborted.--\begin{options}---verbose-\end{options}--Adding the \verb!--verbose! option causes another section to appear in the-output which also displays a summary of patches that you have and the remote-repository lacks. Thus, the following syntax can be used to show you all the patch-differences between two repositories:--\begin{verbatim}-darcs pull --dry-run --verbose-\end{verbatim}
+ src/Darcs/Commands/Push.hs view
@@ -0,0 +1,194 @@+-- Copyright (C) 2002-2004 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.++{-# LANGUAGE CPP, TypeOperators #-}++module Darcs.Commands.Push ( push ) where+import System.Exit ( exitWith, ExitCode( ExitSuccess, ExitFailure ) )+import Control.Monad ( when )+import Data.Char ( toUpper )+import Workaround ( getCurrentDirectory )+import Darcs.Commands ( DarcsCommand(..), putVerbose, putInfo, abortRun )+import Darcs.Arguments ( DarcsFlag( DryRun, Sign, SignAs, NoSign, SignSSL ),+ setEnvDarcsPatches,+ workingRepoDir, summary,+ printDryRunMessageAndExit,+ applyas, matchSeveral, fixUrl, depsSel,+ allInteractive, dryRun,+ remoteRepo, networkOptions,+ setDefault, sign, allowUnrelatedRepos,+ changesReverse+ )++import Darcs.Flags(doReverse)+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, hopefully )+import Darcs.Repository ( Repository, withRepoReadLock, RepoJob(..), identifyRepositoryFor,+ readRepo, amInHashedRepository, checkUnrelatedRepos )+import Darcs.Patch ( RepoPatch, description )+import Darcs.Witnesses.Ordered ( (:>)(..), RL, FL, nullRL,+ nullFL, reverseFL, mapFL_FL, mapRL )+import Darcs.Repository.Prefs ( defaultrepo, setDefaultrepo, getPreflist )+import Darcs.External ( maybeURLCmd, signString )+import Darcs.URL ( isHttpUrl, isFile )+import Darcs.SelectChanges ( selectChanges, WhichChanges(..),+ selectionContext, runSelection )+import Darcs.Utils ( formatPath )+import Darcs.Patch.Depends ( findCommonWithThem, countUsThem )+import Darcs.Patch.Bundle ( makeBundleN )+import Darcs.Patch.Patchy( ShowPatch )+import Darcs.Patch.Set ( PatchSet )+#ifdef GADT_WITNESSES+import Darcs.Patch.Set ( Origin )+#endif+import Printer ( Doc, vcat, empty, text, ($$) )+import Darcs.RemoteApply ( remoteApply, applyAs )+import Darcs.Email ( makeEmail )+import English (englishNum, Noun(..))+#include "impossible.h"++#include "gadts.h"++pushDescription :: String+pushDescription =+ "Copy and apply patches from this repository to another one."++pushHelp :: String+pushHelp =+ "Push is the opposite of pull. Push allows you to copy changes from the\n"+++ "current repository into another repository.\n"++push :: DarcsCommand+push = DarcsCommand {commandProgramName = "darcs",+ commandName = "push",+ commandHelp = pushHelp,+ commandDescription = pushDescription,+ commandExtraArgs = 1,+ commandExtraArgHelp = ["[REPOSITORY]"],+ commandCommand = pushCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = getPreflist "repos",+ commandArgdefaults = defaultrepo,+ commandAdvancedOptions = [applyas,+ remoteRepo,+ changesReverse] +++ networkOptions,+ commandBasicOptions = [matchSeveral, depsSel,+ allInteractive,+ sign]++dryRun++[summary,+ workingRepoDir,+ setDefault False,+ allowUnrelatedRepos]}++pushCmd :: [DarcsFlag] -> [String] -> IO ()+pushCmd _ [""] = impossible+pushCmd opts [unfixedrepodir] =+ do+ repodir <- fixUrl opts unfixedrepodir+ -- Test to make sure we aren't trying to push to the current repo+ here <- getCurrentDirectory+ checkOptionsSanity opts repodir+ when (repodir == here) $+ fail "Cannot push from repository to itself."+ -- absolute '.' also taken into account by fix_filepath+ (bundle) <- withRepoReadLock opts $ RepoJob $+ prepareBundle opts repodir+ sbundle <- signString opts bundle+ let body = if isFile repodir+ then sbundle+ else makeEmail repodir [] Nothing sbundle Nothing+ rval <- remoteApply opts repodir body+ case rval of ExitFailure ec -> do putStrLn $ "Apply failed!"+ exitWith (ExitFailure ec)+ ExitSuccess -> putInfo opts $ text "Push successful."+pushCmd _ _ = impossible++prepareBundle :: forall p C(r u t) . (RepoPatch p) => [DarcsFlag] -> String -> Repository p C(r u t) ->+ IO (Doc)+prepareBundle opts repodir repository = do+ old_default <- getPreflist "defaultrepo"+ when (old_default == [repodir]) $+ let pushing = if DryRun `elem` opts then "Would push" else "Pushing"+ in putInfo opts $ text $ pushing++" to "++formatPath repodir++"..."+ them <- identifyRepositoryFor repository repodir >>= readRepo+ setDefaultrepo repodir opts+ us <- readRepo repository+ common :> us' <- return $ findCommonWithThem us them+ prePushChatter opts us (reverseFL us') them+ let context = selectionContext "push" opts Nothing Nothing+ selector = if doReverse opts+ then selectChanges FirstReversed+ else selectChanges First+ runSelection (selector us') context+ >>= bundlePatches opts common++prePushChatter :: forall p a C(x y t) . (RepoPatch p, ShowPatch a) =>+ [DarcsFlag] -> PatchSet p C(Origin x) ->+ RL a C(t x) -> PatchSet p C(Origin y) -> IO ()+prePushChatter opts us us' them = do+ checkUnrelatedRepos opts us them+ let num_to_pull = snd $ countUsThem us them+ pull_reminder = if num_to_pull > 0+ then text $ "The remote repository has " ++ show num_to_pull+ ++ " " ++ englishNum num_to_pull (Noun "patch") " to pull."+ else empty+ putVerbose opts $ text "We have the following patches to push:" $$ (vcat $ mapRL description us')+ when (not $ nullRL us') $ do putInfo opts $ pull_reminder+ when (nullRL us') $ do putInfo opts $ text "No recorded local changes to push!"+ exitWith ExitSuccess++bundlePatches :: forall t p C(z w a). RepoPatch p => [DarcsFlag] -> PatchSet p C(a z)+ -> (FL (PatchInfoAnd p) :> t) C(z w)+ -> IO (Doc)+bundlePatches opts common (to_be_pushed :> _) =+ do+ setEnvDarcsPatches to_be_pushed+ printDryRunMessageAndExit "push" opts to_be_pushed+ when (nullFL to_be_pushed) $ do+ putInfo opts $+ text "You don't want to push any patches, and that's fine with me!"+ exitWith ExitSuccess+ bundle <- makeBundleN Nothing+ common (mapFL_FL hopefully to_be_pushed)+ return (bundle)++wantSign :: [DarcsFlag] -> Bool+wantSign opts = case opts of+ [] -> False+ Sign:_ -> True+ (SignAs _):_ -> True+ (SignSSL _):_ -> True+ NoSign:_ -> False+ _:opts' -> wantSign opts'+++checkOptionsSanity :: [DarcsFlag] -> String -> IO ()+checkOptionsSanity opts repodir =+ if isHttpUrl repodir then do+ when (applyAs opts /= Nothing) $+ abortRun opts $ text "Cannot --apply-as when pushing to URLs"+ maybeapply <- maybeURLCmd "APPLY" repodir+ when (maybeapply == Nothing) $+ let lprot = takeWhile (/= ':') repodir+ prot = map toUpper lprot+ msg = text ("Pushing to "++lprot++" URLs is not supported.\n"+++ "You may be able to hack this to work"+++ " using DARCS_APPLY_"++prot) in+ abortRun opts msg+ else do+ when (wantSign opts) $+ abortRun opts $ text "Signing doesn't make sense for local repositories or when pushing over ssh."+
− src/Darcs/Commands/Push.lhs
@@ -1,272 +0,0 @@-% Copyright (C) 2002-2004 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.--\darcsCommand{push}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP, TypeOperators #-}--module Darcs.Commands.Push ( push ) where-import System.Exit ( exitWith, ExitCode( ExitSuccess, ExitFailure ) )-import Control.Monad ( when )-import Data.Char ( toUpper )-import Workaround ( getCurrentDirectory )-import Darcs.Commands ( DarcsCommand(..), putVerbose, putInfo, abortRun )-import Darcs.Arguments ( DarcsFlag( DryRun, Sign, SignAs, NoSign, SignSSL ),- definePatches,- workingRepoDir, summary,- printDryRunMessageAndExit,- applyas, matchSeveral, fixUrl, depsSel,- allInteractive, dryRun, nolinks,- remoteRepo, networkOptions,- setDefault, sign, allowUnrelatedRepos,- changesReverse- )--import Darcs.Flags(doReverse)-import Darcs.Hopefully ( PatchInfoAnd, hopefully )-import Darcs.Repository ( Repository, withRepoReadLock, ($-), identifyRepositoryFor,- readRepo, amInRepository, checkUnrelatedRepos )-import Darcs.Patch ( RepoPatch, description )-import Darcs.Witnesses.Ordered ( (:>)(..), RL, FL, nullRL,- nullFL, reverseFL, mapFL_FL, mapRL, (:>>)(..) )-import Darcs.Repository.Prefs ( defaultrepo, setDefaultrepo, getPreflist )-import Darcs.External ( maybeURLCmd, signString )-import Darcs.URL ( isUrl, isFile )-import Darcs.SelectChanges ( selectChanges, WhichChanges(..),- selectionContext, runSelection )-import Darcs.Utils ( formatPath )-import Darcs.Patch.Depends ( findCommonWithThem, countUsThem )-import Darcs.Patch.Bundle ( makeBundleN )-import Darcs.Patch.Patchy( ShowPatch )-import Darcs.Patch.Set ( PatchSet )-#ifdef GADT_WITNESSES-import Darcs.Patch.Set ( Origin )-#endif-import Printer ( Doc, vcat, empty, text, ($$) )-import Darcs.RemoteApply ( remoteApply, applyAs )-import Darcs.Email ( makeEmail )-import English (englishNum, Noun(..))-#include "impossible.h"--#include "gadts.h"--pushDescription :: String-pushDescription =- "Copy and apply patches from this repository to another one."--pushHelp :: String-pushHelp =- "Push is the opposite of pull. Push allows you to copy changes from the\n"++- "current repository into another repository.\n"--push :: DarcsCommand-push = DarcsCommand {commandName = "push",- commandHelp = pushHelp,- commandDescription = pushDescription,- commandExtraArgs = 1,- commandExtraArgHelp = ["[REPOSITORY]"],- commandCommand = pushCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = getPreflist "repos",- commandArgdefaults = defaultrepo,- commandAdvancedOptions = [applyas,- nolinks,- remoteRepo,- changesReverse] ++- networkOptions,- commandBasicOptions = [matchSeveral, depsSel,- allInteractive,- sign]++dryRun++[summary,- workingRepoDir,- setDefault False,- allowUnrelatedRepos]}--pushCmd :: [DarcsFlag] -> [String] -> IO ()-pushCmd _ [""] = impossible-pushCmd opts [unfixedrepodir] =- do- repodir <- fixUrl opts unfixedrepodir- -- Test to make sure we aren't trying to push to the current repo- here <- getCurrentDirectory- checkOptionsSanity opts repodir- when (repodir == here) $- fail "Cannot push from repository to itself."- -- absolute '.' also taken into account by fix_filepath- (bundle) <- withRepoReadLock opts $-- prepareBundle opts repodir- sbundle <- signString opts bundle- let body = if isFile repodir- then sbundle- else makeEmail repodir [] Nothing sbundle Nothing- rval <- remoteApply opts repodir body- case rval of ExitFailure ec -> do putStrLn $ "Apply failed!"- exitWith (ExitFailure ec)- ExitSuccess -> putInfo opts $ text "Push successful."-pushCmd _ _ = impossible--prepareBundle :: forall p C(r u t) . (RepoPatch p) => [DarcsFlag] -> String -> Repository p C(r u t) ->- IO (Doc)-prepareBundle opts repodir repository = do- old_default <- getPreflist "defaultrepo"- when (old_default == [repodir]) $- let pushing = if DryRun `elem` opts then "Would push" else "Pushing"- in putInfo opts $ text $ pushing++" to "++formatPath repodir++"..."- them <- identifyRepositoryFor repository repodir >>= readRepo- setDefaultrepo repodir opts- us <- readRepo repository- common :>> us' <- return $ findCommonWithThem us them- prePushChatter opts us (reverseFL us') them- let context = selectionContext "push" opts Nothing []- selector = if doReverse opts- then selectChanges FirstReversed- else selectChanges First- runSelection (selector us') context- >>= bundlePatches opts common--prePushChatter :: forall p a C(x y t) . (RepoPatch p, ShowPatch a) =>- [DarcsFlag] -> PatchSet p C(Origin x) ->- RL a C(t x) -> PatchSet p C(Origin y) -> IO ()-prePushChatter opts us us' them = do- checkUnrelatedRepos opts us them- let num_to_pull = snd $ countUsThem us them- pull_reminder = if num_to_pull > 0- then text $ "The remote repository has " ++ show num_to_pull- ++ " " ++ englishNum num_to_pull (Noun "patch") " to pull."- else empty- putVerbose opts $ text "We have the following patches to push:" $$ (vcat $ mapRL description us')- when (not $ nullRL us') $ do putInfo opts $ pull_reminder- when (nullRL us') $ do putInfo opts $ text "No recorded local changes to push!"- exitWith ExitSuccess--bundlePatches :: forall t p C(x y z w a). RepoPatch p => [DarcsFlag] -> PatchSet p C(a z)- -> (FL (PatchInfoAnd p) :> t) C(z w)- -> IO (Doc)-bundlePatches opts common (to_be_pushed :> _) =- do- definePatches to_be_pushed- printDryRunMessageAndExit "push" opts to_be_pushed- when (nullFL to_be_pushed) $ do- putInfo opts $- text "You don't want to push any patches, and that's fine with me!"- exitWith ExitSuccess- bundle <- makeBundleN Nothing- common (mapFL_FL hopefully to_be_pushed)- return (bundle)--wantSign :: [DarcsFlag] -> Bool-wantSign opts = case opts of- [] -> False- Sign:_ -> True- (SignAs _):_ -> True- (SignSSL _):_ -> True- NoSign:_ -> False- _:opts' -> wantSign opts'---checkOptionsSanity :: [DarcsFlag] -> String -> IO ()-checkOptionsSanity opts repodir =- if isUrl repodir then do- when (applyAs opts /= Nothing) $- abortRun opts $ text "Cannot --apply-as when pushing to URLs"- maybeapply <- maybeURLCmd "APPLY" repodir- when (maybeapply == Nothing) $- let lprot = takeWhile (/= ':') repodir- prot = map toUpper lprot- msg = text ("Pushing to "++lprot++" URLs is not supported.\n"++- "You may be able to hack this to work"++- " using DARCS_APPLY_"++prot) in- abortRun opts msg- else do- when (wantSign opts) $- abortRun opts $ text "Signing doesn't make sense for local repositories or when pushing over ssh."--\end{code}--For obvious reasons, you can only push to repositories to which you have-write access. In addition, you can only push to repos that you access-either on the local file system or with ssh. In order to apply with ssh,-darcs must also be installed on the remote computer. The command invoked-to run ssh may be configured by the \verb!DARCS_SSH! environment variable-(see subsection~\ref{env:DARCS_SSH}). The command invoked via ssh is always-\verb!darcs!, i.e.\ the darcs executable must be in the default path on-the remote machine.--Push works by creating a patch bundle, and then running darcs apply in the-target repository using that patch bundle. This means that the default-options for \emph{apply} in the \emph{target} repository (such as, for-example, \verb!--test!) will affect the behavior of push. This also means-that push is somewhat less efficient than pull.--When you receive an error message such as-\begin{verbatim}-bash: darcs: command not found-\end{verbatim}-then this means that the darcs on the remote machine could-not be started. Make sure that the darcs executable is called-\verb!darcs! and is found in the default path. The default path can-be different in interactive and in non-interactive shells. Say-\begin{verbatim}-ssh login@remote.machine darcs-\end{verbatim}-to try whether the remote darcs can be found, or-\begin{verbatim}-ssh login@remote.machine 'echo $PATH'-\end{verbatim}-(note the single quotes) to check the default path.--\begin{options}---apply-as-\end{options}--If you give the \verb!--apply-as! flag, darcs will use sudo to apply the-changes as a different user. This can be useful if you want to set up a-system where several users can modify the same repository, but you don't-want to allow them full write access. This isn't secure against skilled-malicious attackers, but at least can protect your repository from clumsy,-inept or lazy users.--\begin{options}---matches, --patches, --tags, --no-deps-\end{options}--The \verb!--patches!, \verb!--matches!, \verb!--tags!, and \verb!--no-deps!-options can be used to select which patches to push, as described in-subsection~\ref{selecting}.--When there are conflicts, the behavior of push is determined by the default-flags to \verb!apply! in the \emph{target} repository. Most commonly, for-pushed-to repositories, you'd like to have \verb!--dont-allow-conflicts! as-a default option to apply (by default, it is already the default\ldots). If-this is the case, when there are conflicts on push, darcs will fail with an-error message. You can then resolve by pulling the conflicting patch,-recording a resolution and then pushing the resolution together with the-conflicting patch.--Darcs does not have an explicit way to tell you which patch conflicted, only the-file name. You may want to pull all the patches from the remote repository just-to be sure. If you don't want to do this in your working directory,-you can create another darcs working directory for this purpose.--If you want, you could set the target repository to use \verb!--allow-conflicts!.-In this case conflicting patches will be applied, but the conflicts will-not be marked in the working directory.--If, on the other hand, you have \verb!--mark-conflicts! specified as a-default flag for apply in the target repository, when there is a conflict,-it will be marked in the working directory of the target repository. In-this case, you should resolve the conflict in the target repository itself.
+ src/Darcs/Commands/Put.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE CPP #-}++module Darcs.Commands.Put ( put ) where+import System.Exit ( ExitCode( ExitSuccess, ExitFailure ), exitWith )+import Control.Monad ( when )+import Data.Maybe ( mapMaybe )+import System.Directory ( createDirectory )+import Darcs.Commands ( DarcsCommand(..), nodefaults, putVerbose, putInfo )+import Darcs.Arguments ( DarcsFlag( UseFormat2, UseHashedInventory ),+ applyas, matchOneContext, fixUrl,+ networkOptions, flagToString,+ setScriptsExecutableOption, workingRepoDir, setDefault+ )+import Darcs.Repository ( withRepoReadLock, RepoJob(..), patchSetToPatches, readRepo, amInHashedRepository )+import Darcs.Repository.Format ( identifyRepoFormat,+ RepoProperty ( Darcs2 ), formatHas )+import Darcs.Patch.Bundle ( makeBundle2 )+import Darcs.Patch.Set ( PatchSet )+#ifdef GADT_WITNESSES+import Darcs.Patch.Set ( Origin )+#endif+import Darcs.Witnesses.Eq ( EqCheck(..) )+import Darcs.Witnesses.Unsafe ( unsafeCoerceP )+import Darcs.Witnesses.Ordered ( RL(..), nullFL )+import Darcs.Match ( havePatchsetMatch, getOnePatchset )+import Darcs.Repository.Prefs ( getPreflist, setDefaultrepo )+import Darcs.URL ( isHttpUrl, isFile, splitSshUrl, SshFilePath(..) )+import Darcs.Utils ( withCurrentDirectory )+import Progress ( debugMessage )+import Darcs.RepoPath ( ioAbsoluteOrRemote, toPath )+import Darcs.External ( execSSH )+import Darcs.RemoteApply ( remoteApply )+import Darcs.Commands.Init ( initialize )+import Darcs.Email ( makeEmail )+import Darcs.Witnesses.Sealed ( Sealed(..), seal )+import Printer ( text )+#include "impossible.h"+#include "gadts.h"++putDescription :: String+putDescription =+ "Makes a copy of the repository"++putHelp :: String+putHelp =+ "The `darcs put' command creates a copy of the current repository. It\n" +++ "is currently very inefficient, so when creating local copies you\n" +++ "should use `darcs get . x' instead of `darcs put x'.\n" +++ "\n" +++ "Currently this command just uses `darcs init' to create the target\n" +++ "repository, then `darcs push --all' to copy patches to it. Options\n" +++ "passed to `darcs put' are passed to the init and/or push commands as\n" +++ "appropriate. See those commands for an explanation of each option.\n"++put ::DarcsCommand+put = DarcsCommand {commandProgramName = "darcs",+ commandName = "put",+ commandHelp = putHelp,+ commandDescription = putDescription,+ commandExtraArgs = 1,+ commandExtraArgHelp = ["<NEW REPOSITORY>"],+ commandCommand = putCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = getPreflist "repos",+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [applyas] ++ networkOptions,+ commandBasicOptions = [matchOneContext, setScriptsExecutableOption,+ setDefault True, workingRepoDir]}++putCmd :: [DarcsFlag] -> [String] -> IO ()+putCmd _ [""] = fail "Empty repository argument given to put."+putCmd opts [unfixedrepodir] =+ do+ repodir <- fixUrl opts unfixedrepodir+ -- Test to make sure we aren't trying to push to the current repo+ t_cur_absolute_repo_dir <- ioAbsoluteOrRemote "."+ t_req_absolute_repo_dir <- ioAbsoluteOrRemote repodir+ let cur_absolute_repo_dir = toPath t_cur_absolute_repo_dir+ req_absolute_repo_dir = toPath t_req_absolute_repo_dir+ when (cur_absolute_repo_dir == req_absolute_repo_dir) $+ fail "Can't put to current repository!"+ when (isHttpUrl req_absolute_repo_dir) $ error "Can't put to a URL!"++ debugMessage "Creating repository"+ putVerbose opts $ text "Creating repository"+ rf <- identifyRepoFormat "."+ let initopts = if formatHas Darcs2 rf+ then UseFormat2:opts+ else UseHashedInventory:filter (/= UseFormat2) opts+ if isFile req_absolute_repo_dir+ then do createDirectory req_absolute_repo_dir+ withCurrentDirectory req_absolute_repo_dir $ (commandCommand initialize) initopts []+ else do -- isSshUrl req_absolute_repo_dir+ remoteInit (splitSshUrl req_absolute_repo_dir) initopts++ withCurrentDirectory cur_absolute_repo_dir $+ withRepoReadLock opts $ RepoJob $ \repository -> (do+ setDefaultrepo req_absolute_repo_dir opts+ let doRead = if havePatchsetMatch opts+ then getOnePatchset repository opts -- todo: make sure getOnePatchset has the right type+ else readRepo repository >>= (return . seal)+ Sealed (patchset :: PatchSet p C(Origin x1)) <- doRead+ Sealed (patchset2 :: PatchSet p C(Origin x2)) <- doRead+ IsEq <- return (unsafeCoerceP IsEq) :: IO (EqCheck C(x1 x2))+ let patches = patchSetToPatches patchset+ patches2 = patchSetToPatches patchset2+ when (nullFL patches) $ do+ putInfo opts $ text "No patches were selected to put. Nothing to be done."+ exitWith ExitSuccess+ bundle <- makeBundle2 Nothing NilRL patches patches2+ let message = if isFile req_absolute_repo_dir+ then bundle+ else makeEmail req_absolute_repo_dir [] Nothing bundle Nothing+ putVerbose opts $ text "Applying patches in new repository..."+ rval <- remoteApply opts req_absolute_repo_dir message+ case rval of ExitFailure ec -> do putStrLn $ "Apply failed!"+ exitWith (ExitFailure ec)+ ExitSuccess -> putInfo opts $ text "Put successful.") :: IO ()+putCmd _ _ = impossible++remoteInit :: SshFilePath -> [DarcsFlag] -> IO ()+remoteInit repo opts = do+ let args = mapMaybe (flagToString $ commandBasicOptions initialize) opts+ command = "darcs initialize --repodir='" ++ (sshRepo repo) ++ "' " ++ unwords args+ exitCode <- execSSH repo command+ when (exitCode /= ExitSuccess) $+ fail "Couldn't initialize remote repository."
− src/Darcs/Commands/Put.lhs
@@ -1,136 +0,0 @@-\darcsCommand{put}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--module Darcs.Commands.Put ( put ) where-import System.Exit ( ExitCode( ExitSuccess, ExitFailure ), exitWith )-import Control.Monad ( when )-import Data.Maybe ( catMaybes )-import System.Directory ( createDirectory )-import Storage.Hashed.Tree( emptyTree )-import Darcs.Commands ( DarcsCommand(..), nodefaults, putVerbose, putInfo )-import Darcs.Arguments ( DarcsFlag( UseFormat2, UseHashedInventory, UseOldFashionedInventory ),- applyas, matchOneContext, fixUrl,- networkOptions, flagToString, getInventoryChoices,- setScriptsExecutableOption, workingRepoDir, setDefault- )-import Darcs.Repository ( withRepoReadLock, ($-), patchSetToPatches, readRepo, amInRepository )-import Darcs.Repository.Format ( identifyRepoFormat,- RepoProperty ( Darcs2, HashedInventory ), formatHas )-import Darcs.Patch.Bundle ( makeBundle2 )-import Darcs.Patch.Set ( PatchSet )-#ifdef GADT_WITNESSES-import Darcs.Patch.Set ( Origin )-#endif-import Darcs.Witnesses.Ordered ( FL(..), RL(..), nullFL, EqCheck(..), unsafeCoerceP )-import Darcs.Match ( havePatchsetMatch, getOnePatchset )-import Darcs.Repository.Prefs ( getPreflist, setDefaultrepo )-import Darcs.URL ( isUrl, isFile )-import Darcs.Utils ( withCurrentDirectory )-import Progress ( debugMessage )-import Darcs.RepoPath ( ioAbsoluteOrRemote, toPath )-import Darcs.External ( execSSH )-import Darcs.RemoteApply ( remoteApply )-import Darcs.Commands.Init ( initialize )-import Darcs.Email ( makeEmail )-import Darcs.Witnesses.Sealed ( Sealed(..), seal )-import Printer ( text )-#include "impossible.h"-#include "gadts.h"--putDescription :: String-putDescription =- "Makes a copy of the repository"--putHelp :: String-putHelp =- "The `darcs put' command creates a copy of the current repository. It\n" ++- "is currently very inefficient, so when creating local copies you\n" ++- "should use `darcs get . x' instead of `darcs put x'.\n" ++- "\n" ++- "Currently this command just uses `darcs init' to create the target\n" ++- "repository, then `darcs push --all' to copy patches to it. Options\n" ++- "passed to `darcs put' are passed to the init and/or push commands as\n" ++- "appropriate. See those commands for an explanation of each option.\n"--put ::DarcsCommand-put = DarcsCommand {commandName = "put",- commandHelp = putHelp,- commandDescription = putDescription,- commandExtraArgs = 1,- commandExtraArgHelp = ["<NEW REPOSITORY>"],- commandCommand = putCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = getPreflist "repos",- commandArgdefaults = nodefaults,- commandAdvancedOptions = [applyas] ++ networkOptions,- commandBasicOptions = [matchOneContext, setScriptsExecutableOption,- getInventoryChoices,- setDefault True, workingRepoDir]}--putCmd :: [DarcsFlag] -> [String] -> IO ()-putCmd _ [""] = fail "Empty repository argument given to put."-putCmd opts [unfixedrepodir] =- do- repodir <- fixUrl opts unfixedrepodir- -- Test to make sure we aren't trying to push to the current repo- t_cur_absolute_repo_dir <- ioAbsoluteOrRemote "."- t_req_absolute_repo_dir <- ioAbsoluteOrRemote repodir- let cur_absolute_repo_dir = toPath t_cur_absolute_repo_dir- req_absolute_repo_dir = toPath t_req_absolute_repo_dir- when (cur_absolute_repo_dir == req_absolute_repo_dir) $- fail "Can't put to current repository!"- when (isUrl req_absolute_repo_dir) $ error "Can't put to a URL!"-- debugMessage "Creating repository"- putVerbose opts $ text "Creating repository"- rf_or_e <- identifyRepoFormat "."- rf <- case rf_or_e of Left e -> fail e- Right x -> return x- let initopts = if formatHas Darcs2 rf- then UseFormat2:filter (/= UseOldFashionedInventory) opts- else if formatHas HashedInventory rf &&- not (UseOldFashionedInventory `elem` opts)- then UseHashedInventory:filter (/= UseFormat2) opts- else UseOldFashionedInventory:filter (/= UseFormat2) opts- if isFile req_absolute_repo_dir- then do createDirectory req_absolute_repo_dir- withCurrentDirectory req_absolute_repo_dir $ (commandCommand initialize) initopts []- else do -- isSsh req_absolute_repo_dir- remoteInit req_absolute_repo_dir initopts-- withCurrentDirectory cur_absolute_repo_dir $- withRepoReadLock opts $- \repository -> (do- setDefaultrepo req_absolute_repo_dir opts- let doRead = if havePatchsetMatch opts- then getOnePatchset repository opts -- todo: make sure getOnePatchset has the right type- else readRepo repository >>= (return . seal)- Sealed (patchset :: PatchSet p C(Origin x1)) <- doRead- Sealed (patchset2 :: PatchSet p C(Origin x2)) <- doRead- IsEq <- return (unsafeCoerceP IsEq) :: IO (EqCheck C(x1 x2))- let patches = patchSetToPatches patchset- patches2 = patchSetToPatches patchset2- when (nullFL patches) $ do- putInfo opts $ text "No patches were selected to put. Nothing to be done."- exitWith ExitSuccess- bundle <- makeBundle2 Nothing NilRL patches patches2- let message = if isFile req_absolute_repo_dir- then bundle- else makeEmail req_absolute_repo_dir [] Nothing bundle Nothing- putVerbose opts $ text "Applying patches in new repository..."- rval <- remoteApply opts req_absolute_repo_dir message- case rval of ExitFailure ec -> do putStrLn $ "Apply failed!"- exitWith (ExitFailure ec)- ExitSuccess -> putInfo opts $ text "Put successful.") :: IO ()-putCmd _ _ = impossible--remoteInit :: FilePath -> [DarcsFlag] -> IO ()-remoteInit repo opts = do- let args = catMaybes $ map (flagToString $ commandBasicOptions initialize) opts- command = "darcs initialize --repodir='" ++ path ++ "' " ++ unwords args- exitCode <- execSSH addr command- when (exitCode /= ExitSuccess) $- fail "Couldn't initialize remote repository."- where (addr,':':path) = break (==':') repo-\end{code}
+ src/Darcs/Commands/Record.hs view
@@ -0,0 +1,412 @@+-- Copyright (C) 2002-2003 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.++{-# LANGUAGE CPP, PatternGuards #-}++module Darcs.Commands.Record ( record, commit, getDate, getLog,+ askAboutDepends+ ) where+import qualified Ratified( hGetContents )+import Control.Applicative ( (<$>) )+import Control.Exception.Extensible ( handleJust )+import Control.Monad ( when, unless )+import System.IO ( stdin )+import Data.List ( sort, isPrefixOf, union )+import Data.Char ( ord )+import System.Exit ( exitWith, exitFailure, ExitCode(..) )+import System.Directory ( removeFile )+import Data.Maybe ( isJust, catMaybes )+import qualified Data.ByteString as B ( hPut )++import Darcs.Lock ( readLocaleFile, writeLocaleFile, worldReadableTemp, appendToFile )+import Darcs.Patch.PatchInfoAnd ( info, n2pia, PatchInfoAnd )+import Darcs.Repository ( Repository, amInHashedRepository, withRepoLock, RepoJob(..),+ withGutsOf,+ readTentativeRepo,+ tentativelyAddPatch, finalizeRepositoryChanges+ , testTentative+ , invalidateIndex, unrecordedChanges )+import Darcs.Patch ( RepoPatch, Patchy, PrimOf, PrimPatch, namepatch, summaryFL, anonymous,+ adddeps, fromPrims )+import Darcs.Patch.Set ( PatchSet(..) )+import Darcs.Witnesses.Eq ( unsafeCompare )+import Darcs.Witnesses.Ordered ( FL(..), (:>)(..), (+>+),+ reverseRL, mapFL, mapFL_FL, nullFL )+import Darcs.Witnesses.Sealed+import Darcs.Patch.Info ( PatchInfo )+import Darcs.Patch.Split ( primSplitter )+import Darcs.Patch.Choices ( patchChoicesTps, tpPatch,+ forceFirsts, getChoices, tag )+import Darcs.SelectChanges ( selectChanges, WhichChanges(..),+ selectionContext, selectionContextPrim,+ runSelection+ )+import Darcs.RepoPath ( FilePathLike, SubPath, toFilePath )+import Darcs.Commands ( DarcsCommand(..), nodefaults, commandStub )+import Darcs.Commands.Util ( announceFiles, filterExistingFiles )+import Darcs.Arguments ( DarcsFlag( PromptLongComment, NoEditLongComment,+ EditLongComment, LogFile, Pipe,+ PatchName, AskDeps, All ),+ fileHelpAuthor,+ getAuthor, workingRepoDir, lookforadds,+ fixSubPaths, setEnvDarcsFiles,+ askLongComment, askdeps, patchSelectFlag,+ allPipeInteractive, leaveTestDir, test,+ author, patchnameOption, umaskOption, ignoretimes,+ nocompress, rmlogfile, logfile, listRegisteredFiles,+ setScriptsExecutableOption )+import Darcs.Flags (willRemoveLogFile, diffingOpts, compression, isInteractive)+import Darcs.Utils ( askUser, promptYorn, PromptConfig(..), promptChar, editFile, clarifyErrors )+import Progress ( debugMessage)+import Darcs.ProgressPatches( progressFL)+import IsoDate ( getIsoDateTime, cleanLocalDate )+import Printer ( hPutDocLn, text, wrapText, ($$) )+import ByteStringUtils ( encodeLocale )+#include "impossible.h"+#include "gadts.h"++recordDescription :: String+recordDescription = "Create a patch from unrecorded changes."++recordHelp :: String+recordHelp =+ "The `darcs record' command is used to create a patch from changes in\n" +++ "the working tree. If you specify a set of files and directories,\n" +++ "changes to other files will be skipped.\n" +++ "\n" ++ recordHelp' +++ "\n" ++ recordHelp''++record :: DarcsCommand+record = DarcsCommand {commandProgramName = "darcs",+ commandName = "record",+ commandHelp = recordHelp,+ commandDescription = recordDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["[FILE or DIRECTORY]..."],+ commandCommand = recordCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = listRegisteredFiles,+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [logfile, rmlogfile,+ nocompress, ignoretimes,+ umaskOption,+ setScriptsExecutableOption],+ commandBasicOptions = [patchnameOption, author,+ test,+ leaveTestDir,+ allPipeInteractive,+ askdeps,+ askLongComment,+ lookforadds,+ workingRepoDir]}++commitDescription :: String+commitDescription = "Redirect the user to record, push or send."++commitHelp :: String+commitHelp =+ "This command does not do anything.\n"+++ "If you want to save changes locally, use the `darcs record' command.\n"+++ "If you want to save a recorded patch to another repository, use the\n"+++ "`darcs push' or `darcs send' commands instead.\n"++commit :: DarcsCommand+commit = commandStub "commit" commitHelp commitDescription record++recordCmd :: [DarcsFlag] -> [String] -> IO ()+recordCmd opts args = do+ checkNameIsNotOption opts+ withRepoLock opts $ RepoJob $ \repository -> do+ files <- if null args then return Nothing+ else Just . sort <$> fixSubPaths opts args+ when (files == Just []) $ fail "No valid arguments were given."+ announceFiles files "Recording changes in"+ existing_files <- maybe (return Nothing)+ (fmap Just . filterExistingFiles repository) files+ when (existing_files == Just []) $+ fail "None of the files you specified exist!"+ debugMessage "About to get the unrecorded changes."+ changes <- unrecordedChanges (diffingOpts opts) repository files+ debugMessage "I've gotten unrecorded."+ case allow_empty_with_askdeps changes of+-- Warning: A do-notation statement discarded a result of type String.+ Nothing -> do when (Pipe `elem` opts) $ do _ <- getDate opts+ return ()+ putStrLn "No changes!"+ Just ch -> doRecord repository opts existing_files ch+ where allow_empty_with_askdeps :: FL p C(x y) -> Maybe (FL p C(x y))+ allow_empty_with_askdeps NilFL+ | AskDeps `elem` opts = Just NilFL+ | otherwise = Nothing+ allow_empty_with_askdeps p = Just p++ -- check that what we treat as the patch name is not accidentally a command+ -- line flag+checkNameIsNotOption :: [DarcsFlag] -> IO ()+checkNameIsNotOption opts = do+ let patchNames = [n | PatchName n <- opts]+ when (length patchNames == 1) $ do+ let n = head patchNames+ oneLetterName = length n == 1 || (length n == 2 && head n == '-')+ if (oneLetterName && (All `notElem` opts))+ then do confirmed <- promptYorn $ "You specified " ++ show n ++ " as the patch name. Is that really what you want?"+ unless confirmed $ do putStrLn "Okay, aborting the record."+ exitFailure+ else return ()+++doRecord :: RepoPatch p => Repository p C(r u r) -> [DarcsFlag] -> Maybe [SubPath] -> FL (PrimOf p) C(r x) -> IO ()+doRecord repository opts files ps = do+ let make_log = worldReadableTemp "darcs-record"+ date <- getDate opts+ my_author <- getAuthor opts+ debugMessage "I'm slurping the repository."+ debugMessage "About to select changes..."+ (chs :> _ ) <- runSelection (selectChanges First ps) $+ selectionContextPrim "record" opts (Just primSplitter)+ (map toFilePath <$> files)+ when (is_empty_but_not_askdeps chs) $+ do putStrLn "Ok, if you don't want to record anything, that's fine!"+ exitWith ExitSuccess+ handleJust onlySuccessfulExits (\_ -> return ()) $+ do deps <- if AskDeps `elem` opts+ then askAboutDepends repository chs opts []+ else return []+ when (AskDeps `elem` opts) $ debugMessage "I've asked about dependencies."+ if nullFL chs && null deps+ then putStrLn "Ok, if you don't want to record anything, that's fine!"+ else do setEnvDarcsFiles chs+ (name, my_log, logf) <- getLog opts Nothing make_log chs+ debugMessage ("Patch name as received from getLog: " ++ show (map ord name))+ doActualRecord repository opts name date+ my_author my_log logf deps chs+ where is_empty_but_not_askdeps l+ | AskDeps `elem` opts = False+ -- a "partial tag" patch; see below.+ | otherwise = nullFL l++doActualRecord :: RepoPatch p => Repository p C(r u r) -> [DarcsFlag] -> String -> String -> String+ -> [String] -> Maybe String+ -> [PatchInfo] -> FL (PrimOf p) C(r x) -> IO ()+doActualRecord repository opts name date my_author my_log logf deps chs =+ do debugMessage "Writing the patch file..."+ mypatch <- namepatch date name my_author my_log $+ fromPrims $ progressFL "Writing changes:" chs+-- Warning: A do-notation statement discarded a result of type Repository p r u x.+ _ <- tentativelyAddPatch repository (compression opts) $ n2pia $ adddeps mypatch deps+ invalidateIndex repository+ debugMessage "Applying to pristine..."+ rc <- testTentative repository+ when (rc /= ExitSuccess) $ do+ when (not $ isInteractive opts) $ exitWith rc `clarifyErrors` failuremessage+ putStrLn $ "Looks like you have a bad patch: '"++name++"'"+ let prompt = "Shall I record it anyway?"+ yn <- promptChar (PromptConfig prompt "yn" [] (Just 'n') [])+ case yn of+ 'y' -> return ()+ _ -> exitWith rc `clarifyErrors` failuremessage+ withGutsOf repository (finalizeRepositoryChanges repository)+ `clarifyErrors` failuremessage+ debugMessage "Syncing timestamps..."+ when (isJust logf) $ removeFile (fromJust logf)+ putStrLn $ "Finished recording patch '"++name++"'"+ where failuremessage = "Failed to record patch '"++name++"'" +++ case logf of Just lf -> "\nLogfile left in "++lf++"."+ Nothing -> ""++recordHelp' :: String+recordHelp' =+ "Every patch has a name, an optional description, an author and a date.\n" +++ "\n" +++ "The patch name should be a short sentence that concisely describes the\n" +++ "patch, such as `Add error handling to main event loop.' You can\n" +++ "supply it in advance with the -m option, or provide it when prompted.\n" +++ "\n" +++ "The patch description is an optional block of free-form text. It is\n" +++ "used to supply additional information that doesn't fit in the patch\n" +++ "name. For example, it might include a rationale of WHY the change was\n" +++ "necessary. By default Darcs asks if you want to add a description;\n" +++ "the --edit-long-comment and --skip-long-comment can be used to answer\n" +++ "`yes' or `no' (respectively) to this prompt. Finally, the --logfile\n" +++ "option allows you to supply a file that already contains the patch\n" +++ "name (first line) and patch description (subsequent lines). This is\n" +++ "useful if a previous record failed and left a darcs-record-0 file.\n" +++ "\n" +++ unlines fileHelpAuthor +++ "\n" +++ "The patch date is generated automatically. It can only be spoofed by\n" +++ "using the --pipe option.\n"++getDate :: [DarcsFlag] -> IO String+getDate opts+ | Pipe `elem` opts = do cleanLocalDate `fmap` askUser "What is the date? "+getDate _ = getIsoDateTime++data PName = FlagPatchName String | PriorPatchName String | NoPatchName++getLog :: forall prim C(x y) . (Patchy prim, PrimPatch prim) => [DarcsFlag] -> Maybe (String, [String]) -> IO String -> FL prim C(x y) ->+ IO (String, [String], Maybe String)+getLog opts m_old make_log chs = gl opts+ where patchname_specified = patchname_helper opts+ patchname_helper (PatchName n:_) | "TAG " `isPrefixOf` n = FlagPatchName $ '.':n+ | otherwise = FlagPatchName n+ patchname_helper (_:fs) = patchname_helper fs+ patchname_helper [] = case m_old of Just (p,_) -> PriorPatchName p+ Nothing -> NoPatchName+ default_log = case m_old of+ Nothing -> []+ Just (_,l) -> l+ gl (Pipe:_) = do p <- case patchname_specified of+ FlagPatchName p -> return p+ PriorPatchName p -> return p+ NoPatchName -> prompt_patchname False+ putStrLn "What is the log?"+ thelog <- lines `fmap` Ratified.hGetContents stdin+ return (p, thelog, Nothing)+ gl (LogFile f:fs) =+ do -- round 1 (patchname)+ mlp <- lines `fmap` readLocaleFile f `catch` (\_ -> return [])+ firstname <- case (patchname_specified, mlp) of+ (FlagPatchName p, []) -> return p+ (_, p:_) -> return p -- logfile trumps prior!+ (PriorPatchName p, []) -> return p+ (NoPatchName, []) -> prompt_patchname True+ -- round 2+ append_info f firstname+-- Warning: A do-notation statement discarded a result of type ExitCode.+ when (EditLongComment `elem` fs) $ do _ <- editFile f+ return ()+ (name, thelog, _) <- read_long_comment f firstname+ let toRemove = if willRemoveLogFile opts+ then Just $ toFilePath f+ else Nothing+ return (name, thelog, toRemove)+ gl (EditLongComment:_) =+ case patchname_specified of+ FlagPatchName p -> actually_get_log p+ PriorPatchName p -> actually_get_log p+ NoPatchName -> prompt_patchname True >>= actually_get_log+ gl (NoEditLongComment:_) =+ case patchname_specified of+ FlagPatchName p+ | Just ("",_) <- m_old ->+ return (p, default_log, Nothing) -- rollback -m+ FlagPatchName p -> return (p, default_log, Nothing) -- record (or amend) -m+ PriorPatchName p -> return (p, default_log, Nothing) -- amend+ NoPatchName -> do p <- prompt_patchname True -- record+ return (p, [], Nothing)+ gl (PromptLongComment:fs) =+ case patchname_specified of+ FlagPatchName p -> prompt_long_comment p -- record (or amend) -m+ _ -> gl fs+ gl (_:fs) = gl fs+ gl [] = case patchname_specified of+ FlagPatchName p -> return (p, default_log, Nothing) -- record (or amend) -m+ PriorPatchName "" -> prompt_patchname True >>= prompt_long_comment+ PriorPatchName p -> return (p, default_log, Nothing)+ NoPatchName -> prompt_patchname True >>= prompt_long_comment+ prompt_patchname retry =+ do n <- askUser "What is the patch name? "+ if n == "" || "TAG " `isPrefixOf` n+ then if retry then prompt_patchname retry+ else fail "Bad patch name!"+ else return n+ prompt_long_comment oldname =+ do y <- promptYorn "Do you want to add a long comment?"+ if y then actually_get_log oldname+ else return (oldname, [], Nothing)+ actually_get_log p = do logf <- make_log+ -- TODO: make sure encoding used for logf is the same everywhere+ -- probably should be locale because the editor will assume it+ writeLocaleFile logf $ unlines $ p : default_log+ append_info logf p+-- Warning: A do-notation statement discarded a result of type ExitCode.+ _ <- editFile logf+ read_long_comment logf p+ read_long_comment :: FilePathLike p => p -> String -> IO (String, [String], Maybe p)+ read_long_comment f oldname =+ 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 f oldname =+ do fc <- readLocaleFile f+ appendToFile f $ \h ->+ do case fc of+ _ | null (lines fc) -> B.hPut h (encodeLocale (oldname ++ "\n"))+ | last fc /= '\n' -> B.hPut h (encodeLocale "\n")+ | otherwise -> return ()+ hPutDocLn h $ text eod+ $$ text ""+ $$ wrapText 75+ ("Place the long patch description above the "+++ eod+++ " marker. The first line of this file "+++ "will be the patch name.")+ $$ text ""+ $$ text "This patch contains the following changes:"+ $$ text ""+ $$ summaryFL chs++eod :: String+eod = "***END OF DESCRIPTION***"++askAboutDepends :: forall p C(r u t y) . RepoPatch p => Repository p C(r u t) -> FL (PrimOf p) C(t y) -> [DarcsFlag] -> [PatchInfo] -> IO [PatchInfo]+askAboutDepends repository pa' opts olddeps = do+ -- ideally we'd just default the olddeps to yes but still ask about them.+ -- SelectChanges doesn't currently (17/12/09) offer a way to do this so would+ -- have to have this support added first.+ pps <- readTentativeRepo repository+ pa <- n2pia `fmap` anonymous (fromPrims pa')+ FlippedSeal ps <- return+ ((case pps of+ PatchSet x _ -> FlippedSeal ((reverseRL x)+>+(pa:>:NilFL)))+ :: FlippedSeal (FL (PatchInfoAnd p)) C(y))+ let (pc, tps) = patchChoicesTps ps+ tas = case catMaybes (mapFL (\tp -> if pa `unsafeCompare` (tpPatch tp) || info (tpPatch tp) `elem` olddeps+ then Just (tag tp) else Nothing) tps) of++ [] -> error "askAboutDepends: []"+ tgs -> tgs+ Sealed2 ps' <- return $ case getChoices (forceFirsts tas pc) of _ :> mc :> _ -> Sealed2 $ mapFL_FL tpPatch mc+ (deps:>_) <- runSelection (selectChanges FirstReversed ps') $+ selectionContext "depend on" (filter askdep_allowed opts) Nothing Nothing+ return $ olddeps `union` mapFL info deps+ where+ askdep_allowed = not . patchSelectFlag+++onlySuccessfulExits :: ExitCode -> Maybe ()+onlySuccessfulExits ExitSuccess = Just ()+onlySuccessfulExits _ = Nothing++recordHelp'' :: String+recordHelp'' =+ "If a test command has been defined with `darcs setpref', attempting to\n" +++ "record a patch will cause the test command to be run in a clean copy\n" +++ "of the working tree (that is, including only recorded changes). If\n" +++ "the test fails, you will be offered to abort the record operation.\n" +++ "\n" +++ "The --set-scripts-executable option causes scripts to be made\n" +++ "executable in the clean copy of the working tree, prior to running the\n" +++ "test. See `darcs get' for an explanation of the script heuristic.\n" +++ "\n" +++ "If your test command is tediously slow (e.g. `make all') and you are\n" +++ "recording several patches in a row, you may wish to use --no-test to\n" +++ "skip all but the final test.\n"+
− src/Darcs/Commands/Record.lhs
@@ -1,487 +0,0 @@-% Copyright (C) 2002-2003 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.--\darcsCommand{record}-\begin{code}-{-# LANGUAGE CPP, PatternGuards #-}--module Darcs.Commands.Record ( record, commit, getDate, getLog,- askAboutDepends- ) where-import qualified Ratified( hGetContents )-import Control.Exception.Extensible ( handleJust )-import Control.Monad ( when )-import System.IO ( stdin )-import Data.List ( sort, isPrefixOf, union )-import Data.Char ( ord )-import System.Exit ( exitWith, exitFailure, ExitCode(..) )-import System.Directory ( removeFile )-import Data.Maybe ( isJust, catMaybes )-import qualified Data.ByteString as B ( hPut )--import Darcs.Lock ( readLocaleFile, writeLocaleFile, worldReadableTemp, appendToFile )-import Darcs.Hopefully ( info, n2pia, PatchInfoAnd )-import Darcs.Repository ( Repository, amInRepository, withRepoLock, ($-),- withGutsOf,- readTentativeRepo,- tentativelyAddPatch, finalizeRepositoryChanges- , invalidateIndex, unrecordedChanges )-import Darcs.Patch ( RepoPatch, Patch, Prim, namepatch, summary, anonymous,- adddeps, fromPrims )-import Darcs.Patch.Set ( PatchSet(..) )-import Darcs.Witnesses.Ordered ( FL(..), RL(..), (:>)(..), (+>+),- unsafeCompare,- reverseRL, mapFL, mapFL_FL, nullFL )-import Darcs.Witnesses.Sealed-import Darcs.Patch.Info ( PatchInfo )-import Darcs.Patch.Split ( primSplitter )-import Darcs.Patch.Choices ( patchChoicesTps, tpPatch,- forceFirsts, getChoices, tag )-import Darcs.SelectChanges ( selectChanges, WhichChanges(..),- selectionContext, selectionContextPrim,- runSelection- )-import Darcs.RepoPath ( FilePathLike, SubPath, toFilePath )-import Darcs.Commands ( DarcsCommand(..), nodefaults, commandStub )-import Darcs.Commands.WhatsNew ( announceFiles )-import Darcs.Arguments ( DarcsFlag( PromptLongComment, NoEditLongComment,- EditLongComment, LogFile, Pipe,- PatchName, AskDeps, All ),- fileHelpAuthor,- getAuthor, workingRepoDir, lookforadds,- fixSubPaths, defineChanges,- askLongComment, askdeps, patchSelectFlag,- allPipeInteractive, leaveTestDir, test,- author, patchnameOption, umaskOption, ignoretimes,- nocompress, rmlogfile, logfile, listRegisteredFiles,- setScriptsExecutableOption )-import Darcs.Flags (willRemoveLogFile)-import Darcs.Utils ( askUser, promptYorn, editFile, clarifyErrors )-import Progress ( debugMessage)-import Darcs.ProgressPatches( progressFL)-import IsoDate ( getIsoDateTime, cleanLocalDate )-import Printer ( hPutDocLn, text, wrapText, ($$) )-import ByteStringUtils ( encodeLocale )-#include "impossible.h"-#include "gadts.h"--recordDescription :: String-recordDescription = "Create a patch from unrecorded changes."--recordHelp :: String-recordHelp =- "The `darcs record' command is used to create a patch from changes in\n" ++- "the working tree. If you specify a set of files and directories,\n" ++- "changes to other files will be skipped.\n" ++- "\n" ++ recordHelp' ++- "\n" ++ recordHelp''--record :: DarcsCommand-record = DarcsCommand {commandName = "record",- commandHelp = recordHelp,- commandDescription = recordDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["[FILE or DIRECTORY]..."],- commandCommand = recordCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = listRegisteredFiles,- commandArgdefaults = nodefaults,- commandAdvancedOptions = [logfile, rmlogfile,- nocompress, ignoretimes,- umaskOption,- setScriptsExecutableOption],- commandBasicOptions = [patchnameOption, author,- test,- leaveTestDir,- allPipeInteractive,- askdeps,- askLongComment,- lookforadds,- workingRepoDir]}--commitDescription :: String-commitDescription = "Redirect the user to record, push or send."--commitHelp :: String-commitHelp =- "This command does not do anything.\n"++- "If you want to save changes locally, use the `darcs record' command.\n"++- "If you want to save a recorded patch to another repository, use the\n"++- "`darcs push' or `darcs send' commands instead.\n"--commit :: DarcsCommand-commit = commandStub "commit" commitHelp commitDescription record--recordCmd :: [DarcsFlag] -> [String] -> IO ()-recordCmd opts args = do- checkNameIsNotOption opts- withRepoLock opts $- \repository -> do- files <- sort `fmap` fixSubPaths opts args- existing_files <- announceFiles repository files "Recording changes in"- when (null existing_files && (not $ null files)) $- fail "None of the files you specified exist!"- debugMessage "About to get the unrecorded changes."- changes <- unrecordedChanges opts repository files- debugMessage "I've gotten unrecorded."- case allow_empty_with_askdeps changes of- Nothing -> do when (Pipe `elem` opts) $ do getDate opts- return ()- putStrLn "No changes!"- Just ch -> doRecord repository opts existing_files ch- where allow_empty_with_askdeps :: FL p C(x y) -> Maybe (FL p C(x y))- allow_empty_with_askdeps NilFL- | AskDeps `elem` opts = Just NilFL- | otherwise = Nothing- allow_empty_with_askdeps p = Just p-- -- check that what we treat as the patch name is not accidentally a command- -- line flag-checkNameIsNotOption :: [DarcsFlag] -> IO ()-checkNameIsNotOption opts = do- let patchNames = [n | PatchName n <- opts]- when (length patchNames == 1) $ do- let n = head patchNames- oneLetterName = length n == 1 || (length n == 2 && head n == '-')- if (oneLetterName && not (elem All opts))- then do- let keepAsking = do- yorn <- promptYorn ("You specified " ++ show n ++ " as the patch name. Is that really what you want?")- case yorn of- 'y' -> return ()- 'n' -> do- putStrLn "Okay, aborting the record."- exitFailure- _ -> keepAsking- keepAsking- else return ()---doRecord :: RepoPatch p => Repository p C(r u r) -> [DarcsFlag] -> [SubPath] -> FL Prim C(r x) -> IO ()-doRecord repository opts files ps = do- let make_log = worldReadableTemp "darcs-record"- date <- getDate opts- my_author <- getAuthor opts- debugMessage "I'm slurping the repository."- debugMessage "About to select changes..."- (chs :> _ ) <- runSelection (selectChanges First ps) $- selectionContextPrim "record" opts (Just primSplitter)- (map toFilePath files)- when (is_empty_but_not_askdeps chs) $- do putStrLn "Ok, if you don't want to record anything, that's fine!"- exitWith ExitSuccess- handleJust onlySuccessfulExits (\_ -> return ()) $- do deps <- if AskDeps `elem` opts- then askAboutDepends repository chs opts []- else return []- when (AskDeps `elem` opts) $ debugMessage "I've asked about dependencies."- if nullFL chs && null deps- then putStrLn "Ok, if you don't want to record anything, that's fine!"- else do defineChanges chs- (name, my_log, logf) <- getLog opts Nothing make_log chs- debugMessage ("Patch name as received from getLog: " ++ show (map ord name))- doActualRecord repository opts name date- my_author my_log logf deps chs- where is_empty_but_not_askdeps l- | AskDeps `elem` opts = False- -- a "partial tag" patch; see below.- | otherwise = nullFL l--doActualRecord :: RepoPatch p => Repository p C(r u r) -> [DarcsFlag] -> String -> String -> String- -> [String] -> Maybe String- -> [PatchInfo] -> FL Prim C(r x) -> IO ()-doActualRecord repository opts name date my_author my_log logf deps chs =- do debugMessage "Writing the patch file..."- mypatch <- namepatch date name my_author my_log $- fromPrims $ progressFL "Writing changes:" chs- tentativelyAddPatch repository opts $ n2pia $ adddeps mypatch deps- invalidateIndex repository- debugMessage "Applying to pristine..."- withGutsOf repository (finalizeRepositoryChanges repository)- `clarifyErrors` failuremessage- debugMessage "Syncing timestamps..."- when (isJust logf) $ removeFile (fromJust logf)- putStrLn $ "Finished recording patch '"++name++"'"- where failuremessage = "Failed to record patch '"++name++"'" ++- case logf of Just lf -> "\nLogfile left in "++lf++"."- Nothing -> ""--recordHelp' :: String-recordHelp' =- "Every patch has a name, an optional description, an author and a date.\n" ++- "\n" ++- "The patch name should be a short sentence that concisely describes the\n" ++- "patch, such as `Add error handling to main event loop.' You can\n" ++- "supply it in advance with the -m option, or provide it when prompted.\n" ++- "\n" ++- "The patch description is an optional block of free-form text. It is\n" ++- "used to supply additional information that doesn't fit in the patch\n" ++- "name. For example, it might include a rationale of WHY the change was\n" ++- "necessary. By default Darcs asks if you want to add a description;\n" ++- "the --edit-long-comment and --skip-long-comment can be used to answer\n" ++- "`yes' or `no' (respectively) to this prompt. Finally, the --logfile\n" ++- "option allows you to supply a file that already contains the patch\n" ++- "name (first line) and patch description (subsequent lines). This is\n" ++- "useful if a previous record failed and left a darcs-record-0 file.\n" ++- "\n" ++- unlines fileHelpAuthor ++- "\n" ++- "The patch date is generated automatically. It can only be spoofed by\n" ++- "using the --pipe option.\n"--getDate :: [DarcsFlag] -> IO String-getDate opts- | Pipe `elem` opts = do cleanLocalDate `fmap` askUser "What is the date? "-getDate _ = getIsoDateTime--data PName = FlagPatchName String | PriorPatchName String | NoPatchName--getLog :: FORALL(x y) [DarcsFlag] -> Maybe (String, [String]) -> IO String -> FL Prim C(x y) ->- IO (String, [String], Maybe String)-getLog opts m_old make_log chs = gl opts- where patchname_specified = patchname_helper opts- patchname_helper (PatchName n:_) | "TAG " `isPrefixOf` n = FlagPatchName $ '.':n- | otherwise = FlagPatchName n- patchname_helper (_:fs) = patchname_helper fs- patchname_helper [] = case m_old of Just (p,_) -> PriorPatchName p- Nothing -> NoPatchName- default_log = case m_old of- Nothing -> []- Just (_,l) -> l- gl (Pipe:_) = do p <- case patchname_specified of- FlagPatchName p -> return p- PriorPatchName p -> return p- NoPatchName -> prompt_patchname False- putStrLn "What is the log?"- thelog <- lines `fmap` Ratified.hGetContents stdin- return (p, thelog, Nothing)- gl (LogFile f:fs) =- do -- round 1 (patchname)- mlp <- lines `fmap` readLocaleFile f `catch` (\_ -> return [])- firstname <- case (patchname_specified, mlp) of- (FlagPatchName p, []) -> return p- (_, p:_) -> return p -- logfile trumps prior!- (PriorPatchName p, []) -> return p- (NoPatchName, []) -> prompt_patchname True- -- round 2- append_info f firstname- when (EditLongComment `elem` fs) $ do editFile f- return ()- (name, thelog, _) <- read_long_comment f firstname- let toRemove = if willRemoveLogFile opts- then Just $ toFilePath f- else Nothing- return (name, thelog, toRemove)- gl (EditLongComment:_) =- case patchname_specified of- FlagPatchName p -> actually_get_log p- PriorPatchName p -> actually_get_log p- NoPatchName -> prompt_patchname True >>= actually_get_log- gl (NoEditLongComment:_) =- case patchname_specified of- FlagPatchName p- | Just ("",_) <- m_old ->- return (p, default_log, Nothing) -- rollback -m- FlagPatchName p -> return (p, default_log, Nothing) -- record (or amend) -m- PriorPatchName p -> return (p, default_log, Nothing) -- amend- NoPatchName -> do p <- prompt_patchname True -- record- return (p, [], Nothing)- gl (PromptLongComment:fs) =- case patchname_specified of- FlagPatchName p -> prompt_long_comment p -- record (or amend) -m- _ -> gl fs- gl (_:fs) = gl fs- gl [] = case patchname_specified of- FlagPatchName p -> return (p, default_log, Nothing) -- record (or amend) -m- PriorPatchName "" -> prompt_patchname True >>= prompt_long_comment- PriorPatchName p -> return (p, default_log, Nothing)- NoPatchName -> prompt_patchname True >>= prompt_long_comment- prompt_patchname retry =- do n <- askUser "What is the patch name? "- if n == "" || "TAG " `isPrefixOf` n- then if retry then prompt_patchname retry- else fail "Bad patch name!"- else return n- prompt_long_comment oldname =- do yorn <- promptYorn "Do you want to add a long comment?"- if yorn == 'y' then actually_get_log oldname- else return (oldname, [], Nothing)- actually_get_log p = do logf <- make_log- -- TODO: make sure encoding used for logf is the same everywhere- -- probably should be locale because the editor will assume it- writeLocaleFile logf $ unlines $ p : default_log- append_info logf p- editFile logf- read_long_comment logf p- read_long_comment :: FilePathLike p => p -> String -> IO (String, [String], Maybe p)- read_long_comment f oldname =- 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 f oldname =- do fc <- readLocaleFile f- appendToFile f $ \h ->- do case fc of- _ | null (lines fc) -> B.hPut h (encodeLocale (oldname ++ "\n"))- | last fc /= '\n' -> B.hPut h (encodeLocale "\n")- | otherwise -> return ()- hPutDocLn h $ text eod- $$ text ""- $$ wrapText 75- ("Place the long patch description above the "++- eod++- " marker. The first line of this file "++- "will be the patch name.")- $$ text ""- $$ text "This patch contains the following changes:"- $$ text ""- $$ summary (fromPrims chs :: Patch C(x y))--eod :: String-eod = "***END OF DESCRIPTION***"-\end{code}--\begin{options}---ask-deps-\end{options}--Each patch may depend on any number of previous patches. If you choose to-make your patch depend on a previous patch, that patch is required to be-applied before your patch can be applied to a repository. This can be used, for-example, if a piece of code requires a function to be defined, which was-defined in an earlier patch.--If you want to manually define any dependencies for your patch, you can use-the \verb!--ask-deps! flag, and darcs will ask you for the patch's-dependencies.--It is possible to record a patch which has no actual changes but which-has specific dependencies. This type of patch can be thought of as a-``partial tag''. The \verb!darcs tag! command will record a patch-with no actual changes but which depends on the entire current-inventory of the repository. The \verb!darcs record --ask-deps! with-no selected changes will record a patch that depends on only those-patches selected via the \verb!--ask-deps! operation, resulting in a-patch which describes a set of patches; the presence of this primary-patch in a repository implies the presence of (at least) the-depended-upon patches.--\begin{code}-askAboutDepends :: forall p C(r u t x y) . RepoPatch p => Repository p C(r u t) -> FL Prim C(t y) -> [DarcsFlag] -> [PatchInfo] -> IO [PatchInfo]-askAboutDepends repository pa' opts olddeps = do- -- ideally we'd just default the olddeps to yes but still ask about them.- -- SelectChanges doesn't currently (17/12/09) offer a way to do this so would- -- have to have this support added first.- pps <- readTentativeRepo repository- pa <- n2pia `fmap` anonymous (fromPrims pa')- FlippedSeal ps <- return- ((case pps of- PatchSet x _ -> FlippedSeal ((reverseRL x)+>+(pa:>:NilFL))- PatchSet NilRL NilRL -> impossible) :: FlippedSeal (FL (PatchInfoAnd p)) C(y))- let (pc, tps) = patchChoicesTps ps- tas = case catMaybes (mapFL (\tp -> if pa `unsafeCompare` (tpPatch tp) || info (tpPatch tp) `elem` olddeps- then Just (tag tp) else Nothing) tps) of-- [] -> error "askAboutDepends: []"- tgs -> tgs- Sealed2 ps' <- return $ case getChoices (forceFirsts tas pc) of _ :> mc :> _ -> Sealed2 $ mapFL_FL tpPatch mc- (deps:>_) <- runSelection (selectChanges FirstReversed ps') $- selectionContext "depend on" (filter askdep_allowed opts) Nothing []- return $ olddeps `union` mapFL info deps- where- askdep_allowed = not . patchSelectFlag---onlySuccessfulExits :: ExitCode -> Maybe ()-onlySuccessfulExits ExitSuccess = Just ()-onlySuccessfulExits _ = Nothing--recordHelp'' :: String-recordHelp'' =- "If a test command has been defined with `darcs setpref', attempting to\n" ++- "record a patch will cause the test command to be run in a clean copy\n" ++- "of the working tree (that is, including only recorded changes). If\n" ++- "the test fails, the record operation will be aborted.\n" ++- "\n" ++- "The --set-scripts-executable option causes scripts to be made\n" ++- "executable in the clean copy of the working tree, prior to running the\n" ++- "test. See `darcs get' for an explanation of the script heuristic.\n" ++- "\n" ++- "If your test command is tediously slow (e.g. `make all') and you are\n" ++- "recording several patches in a row, you may wish to use --no-test to\n" ++- "skip all but the final test.\n"--\end{code}-\begin{options}---pipe-\end{options}--If you run record with the \verb!--pipe! option, you will be prompted for-the patch date, author, and the long comment. The long comment will extend-until the end of file or stdin is reached (ctrl-D on Unixy systems, ctrl-Z-on systems running a Microsoft OS).--This interface is intended for scripting darcs, in particular for writing-repository conversion scripts. The prompts are intended mostly as a useful-guide (since scripts won't need them), to help you understand the format in-which to provide the input. Here's an example of what the \verb!--pipe!-prompts look like:--\begin{verbatim}- What is the date? Mon Nov 15 13:38:01 EST 2004- Who is the author? David Roundy- What is the log? One or more comment lines-\end{verbatim}---\begin{options}---interactive-\end{options}--By default, \verb!record! works interactively. Probably the only thing you need-to know about using this is that you can press \verb!?! at the prompt to be-shown a list of the rest of the options and what they do. The rest should be-clear from there. Here's a-``screenshot'' to demonstrate:--\begin{verbatim}-hunk ./hello.pl +2-+#!/usr/bin/perl-+print "Hello World!\n";-Shall I record this patch? (2/2) [ynWsfqadjk], or ? for help: ?-How to use record...-y: record this patch-n: don't record it-w: wait and decide later, defaulting to no--s: don't record the rest of the changes to this file-f: record the rest of the changes to this file--d: record selected patches-a: record all the remaining patches-q: cancel record--j: skip to next patch-k: back up to previous patch-h or ?: show this help--<Space>: accept the current default (which is capitalized)--\end{verbatim}-What you can't see in that ``screenshot'' is that \verb!darcs! will also try to use-color in your terminal to make the output even easier to read.
+ src/Darcs/Commands/Remove.hs view
@@ -0,0 +1,164 @@+-- Copyright (C) 2002-2004 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.++{-# LANGUAGE CPP #-}++module Darcs.Commands.Remove ( remove, rm, unadd ) where++import Control.Monad ( when, foldM )+import Darcs.Commands ( DarcsCommand(..), nodefaults,+ commandAlias, commandStub,+ putWarning+ )+import Darcs.Arguments ( DarcsFlag (Recursive), fixSubPaths,+ listRegisteredFiles,+ workingRepoDir, umaskOption,+ recursive+ )+import Darcs.RepoPath ( SubPath, sp2fn )+import Darcs.Repository ( Repository, withRepoLock, RepoJob(..), amInHashedRepository,+ addToPending, readRecordedAndPending, readUnrecorded )+import Darcs.Diff( treeDiff )+import Darcs.Patch ( RepoPatch, PrimOf, PrimPatch, adddir, rmdir, addfile, rmfile )+import Darcs.Patch.FileName( fn2fp )+import Darcs.Witnesses.Ordered ( FL(..), (+>+) )+import Darcs.Witnesses.Sealed ( Sealed(..), Gap(..), FreeLeft, unFreeLeft )+import Darcs.Repository.Prefs ( filetypeFunction, FileType )+import Storage.Hashed.Tree( Tree, TreeItem(..), find, modifyTree, expand, list )+import Storage.Hashed.AnchoredPath( anchorPath, AnchoredPath )+import Storage.Hashed( floatPath )++import Darcs.Commands.Add( expandDirs )+import Printer ( text )++#include "gadts.h"++removeDescription :: String+removeDescription = "Remove files from version control."++removeHelp :: String+removeHelp =+ "The `darcs remove' command exists primarily for symmetry with `darcs\n" +++ "add', as the normal way to remove a file from version control is\n" +++ "simply to delete it from the working tree. This command is only\n" +++ "useful in the unusual case where one wants to record a removal patch\n" +++ "WITHOUT deleting the copy in the working tree (which can be re-added).\n" +++ "\n" +++ "Note that applying a removal patch to a repository (e.g. by pulling\n" +++ "the patch) will ALWAYS affect the working tree of that repository.\n"++remove :: DarcsCommand+remove = DarcsCommand {commandProgramName = "darcs",+ commandName = "remove",+ commandHelp = removeHelp,+ commandDescription = removeDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["<FILE or DIRECTORY> ..."],+ commandCommand = removeCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = listRegisteredFiles,+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [umaskOption],+ commandBasicOptions =+ [workingRepoDir, recursive "recurse into subdirectories"]}++removeCmd :: [DarcsFlag] -> [String] -> IO ()+removeCmd opts relargs = do+ when (null relargs) $+ fail "Nothing specified, nothing removed."+ origfiles <- fixSubPaths opts relargs+ when (null origfiles) $+ fail "No valid arguments were given."+ withRepoLock opts $ RepoJob $ \repository -> do+ args <- if Recursive `elem` opts+ then reverse `fmap` expandDirs origfiles+ else return origfiles+ Sealed p <- makeRemovePatch opts repository args+ addToPending repository p++-- | makeRemovePatch builds a list of patches to remove the given filepaths.+-- This function does not recursively process directories. The 'Recursive'+-- flag should be handled by the caller by adding all offspring of a directory+-- to the files list.+makeRemovePatch :: RepoPatch p => [DarcsFlag] -> Repository p C(r u t)+ -> [SubPath] -> IO (Sealed (FL (PrimOf p) C(u)))+makeRemovePatch opts repository files =+ do recorded <- expand =<< readRecordedAndPending repository+ unrecorded <- readUnrecorded repository $ Just files+ ftf <- filetypeFunction+ result <- foldM removeOnePath (ftf,recorded,unrecorded, []) $ map (floatPath . fn2fp . sp2fn) files+ case result of+ (_, _, _, patches) -> return $+ unFreeLeft $ foldr (joinGap (+>+)) (emptyGap NilFL) $ reverse patches+ where removeOnePath (ftf, recorded, unrecorded, patches) f = do+ let recorded' = modifyTree recorded f Nothing+ unrecorded' = modifyTree unrecorded f Nothing+ local <- makeRemoveGap opts ftf recorded unrecorded unrecorded' f+ -- we can tell if the remove succeeded by looking if local is+ -- empty. If the remove succeeded, we should pass on updated+ -- recorded and unrecorded that reflect the removal+ return $ case local of+ Just gap -> (ftf, recorded', unrecorded', gap : patches)+ _ -> (ftf, recorded, unrecorded, patches)++-- | Takes a file path and returns the FL of patches to remove that, wrapped in+-- a 'Gap'.+-- Returns 'Nothing' in case the path cannot be removed (if it is not tracked,+-- or if it's a directory and it's not tracked).+-- The three 'Tree' arguments are the recorded state, the unrecorded state+-- excluding the removal of this file, and the unrecorded state including the+-- removal of this file.+makeRemoveGap :: PrimPatch prim => [DarcsFlag] -> (FilePath -> FileType)+ -> Tree IO -> Tree IO -> Tree IO -> AnchoredPath+ -> IO (Maybe (FreeLeft (FL prim)))+makeRemoveGap opts ftf recorded unrecorded unrecorded' f =+ case (find recorded f, find unrecorded f) of+ (Just (SubTree _), Just (SubTree unrecordedChildren)) -> do+ if not $ null (list unrecordedChildren)+ then skipAndWarn "it is not empty"+ else return $ Just $ freeGap (rmdir f_fp :>: NilFL)+ (Just (File _), Just (File _)) ->+ Just `fmap` treeDiff ftf unrecorded unrecorded'+ (Just (File _), _) ->+ return $ Just $ freeGap (addfile f_fp :>: rmfile f_fp :>: NilFL)+ (Just (SubTree _), _) ->+ return $ Just $ freeGap (adddir f_fp :>: rmdir f_fp :>: NilFL)+ (_, _) -> skipAndWarn "it is not tracked by darcs"+ where f_fp = anchorPath "" f+ skipAndWarn reason =+ do putWarning opts . text $ "Can't remove " ++ f_fp+ ++ " (" ++ reason ++ ")"+ return $ Nothing+++rmDescription :: String+rmDescription = "Help newbies find `darcs remove'."++rmHelp :: String+rmHelp =+ "The `darcs rm' command does nothing.\n" +++ "\n" +++ "The normal way to remove a file from version control is simply to\n" +++ "delete it from the working tree. To remove a file from version\n" +++ "control WITHOUT affecting the working tree, see `darcs remove'.\n"++rm :: DarcsCommand+rm = commandStub "rm" rmHelp rmDescription remove++unadd :: DarcsCommand+unadd = commandAlias "unadd" Nothing remove+
− src/Darcs/Commands/Remove.lhs
@@ -1,166 +0,0 @@-% Copyright (C) 2002-2004 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.--\darcsCommand{remove}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--module Darcs.Commands.Remove ( remove, rm, unadd ) where--import Control.Monad ( when, foldM )-import Darcs.Commands ( DarcsCommand(..), nodefaults,- commandAlias, commandStub,- putWarning- )-import Darcs.Arguments ( DarcsFlag (Recursive), fixSubPaths,- listRegisteredFiles,- workingRepoDir, umaskOption,- recursive- )-import Darcs.RepoPath ( SubPath, sp2fn )-import Darcs.Repository ( Repository, withRepoLock, ($-), amInRepository,- addToPending, readRecordedAndPending, readUnrecorded )-import Darcs.Diff( treeDiff )-import Darcs.Patch ( RepoPatch, Prim, adddir, rmdir, addfile, rmfile )-import Darcs.Patch.FileName( fn2fp )-import Darcs.Witnesses.Ordered ( FL(..), (+>+) )-import Darcs.Witnesses.Sealed ( Sealed(..), Gap(..), FreeLeft, unFreeLeft )-import Darcs.Repository.Prefs ( filetypeFunction, FileType )-import Storage.Hashed.Tree( Tree, TreeItem(..), find, modifyTree, expand, list )-import Storage.Hashed.AnchoredPath( anchorPath, AnchoredPath )-import Storage.Hashed( floatPath )--import Darcs.Commands.Add( expandDirs )-import Printer ( text )--#include "gadts.h"--removeDescription :: String-removeDescription = "Remove files from version control."--removeHelp :: String-removeHelp =- "The `darcs remove' command exists primarily for symmetry with `darcs\n" ++- "add', as the normal way to remove a file from version control is\n" ++- "simply to delete it from the working tree. This command is only\n" ++- "useful in the unusual case where one wants to record a removal patch\n" ++- "WITHOUT deleting the copy in the working tree (which can be re-added).\n" ++- "\n" ++- "Note that applying a removal patch to a repository (e.g. by pulling\n" ++- "the patch) will ALWAYS affect the working tree of that repository.\n"--remove :: DarcsCommand-remove = DarcsCommand {commandName = "remove",- commandHelp = removeHelp,- commandDescription = removeDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["<FILE or DIRECTORY> ..."],- commandCommand = removeCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = listRegisteredFiles,- commandArgdefaults = nodefaults,- commandAdvancedOptions = [umaskOption],- commandBasicOptions =- [workingRepoDir, recursive "recurse into subdirectories"]}--removeCmd :: [DarcsFlag] -> [String] -> IO ()-removeCmd opts relargs =- withRepoLock opts $- \repository -> do- origfiles <- fixSubPaths opts relargs- args <- if Recursive `elem` opts- then reverse `fmap` expandDirs origfiles- else return origfiles- when (null args) $- putStrLn "Nothing specified, nothing removed."- Sealed p <- makeRemovePatch opts repository args- addToPending repository p---- | makeRemovePatch builds a list of patches to remove the given filepaths.--- This function does not recursively process directories. The 'Recursive'--- flag should be handled by the caller by adding all offspring of a directory--- to the files list.-makeRemovePatch :: RepoPatch p => [DarcsFlag] -> Repository p C(r u t)- -> [SubPath] -> IO (Sealed (FL Prim C(u)))-makeRemovePatch opts repository files =- do recorded <- expand =<< readRecordedAndPending repository- unrecorded <- readUnrecorded repository files- ftf <- filetypeFunction- result <- foldM removeOnePath (ftf,recorded,unrecorded, []) $ map (floatPath . fn2fp . sp2fn) files- case result of- (_, _, _, patches) -> return $- unFreeLeft $ foldr (joinGap (+>+)) (emptyGap NilFL) $ reverse patches- where removeOnePath (ftf, recorded, unrecorded, patches) f = do- let recorded' = modifyTree recorded f Nothing- unrecorded' = modifyTree unrecorded f Nothing- local <- makeRemoveGap opts ftf recorded unrecorded unrecorded' f- -- we can tell if the remove succeeded by looking if local is- -- empty. If the remove succeeded, we should pass on updated- -- recorded and unrecorded that reflect the removal- return $ case local of- Just gap -> (ftf, recorded', unrecorded', gap : patches)- _ -> (ftf, recorded, unrecorded, patches)---- | Takes a file path and returns the FL of patches to remove that, wrapped in--- a 'Gap'.--- Returns 'Nothing' in case the path cannot be removed (if it is not tracked,--- or if it's a directory and it's not tracked).--- The three 'Tree' arguments are the recorded state, the unrecorded state--- excluding the removal of this file, and the unrecorded state including the--- removal of this file.-makeRemoveGap :: [DarcsFlag] -> (FilePath -> FileType)- -> Tree IO -> Tree IO -> Tree IO -> AnchoredPath- -> IO (Maybe (FreeLeft (FL Prim)))-makeRemoveGap opts ftf recorded unrecorded unrecorded' f =- case (find recorded f, find unrecorded f) of- (Just (SubTree _), Just (SubTree unrecordedChildren)) -> do- if not $ null (list unrecordedChildren)- then skipAndWarn "it is not empty"- else return $ Just $ freeGap (rmdir f_fp :>: NilFL)- (Just (File _), Just (File _)) ->- Just `fmap` treeDiff ftf unrecorded unrecorded'- (Just (File _), _) ->- return $ Just $ freeGap (addfile f_fp :>: rmfile f_fp :>: NilFL)- (Just (SubTree _), _) ->- return $ Just $ freeGap (adddir f_fp :>: rmdir f_fp :>: NilFL)- (_, _) -> skipAndWarn "it is not tracked by darcs"- where f_fp = anchorPath "" f- skipAndWarn reason =- do putWarning opts . text $ "Can't remove " ++ f_fp- ++ " (" ++ reason ++ ")"- return $ Nothing---rmDescription :: String-rmDescription = "Help newbies find `darcs remove'."--rmHelp :: String-rmHelp =- "The `darcs rm' command does nothing.\n" ++- "\n" ++- "The normal way to remove a file from version control is simply to\n" ++- "delete it from the working tree. To remove a file from version\n" ++- "control WITHOUT affecting the working tree, see `darcs remove'.\n"--rm :: DarcsCommand-rm = commandStub "rm" rmHelp rmDescription remove--unadd :: DarcsCommand-unadd = commandAlias "unadd" Nothing remove-\end{code}--
− src/Darcs/Commands/Repair.lhs
@@ -1,74 +0,0 @@-% Copyright (C) 2003,2005 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.--\darcsCommand{repair}-\begin{code}-module Darcs.Commands.Repair ( repair, repairCmd ) where-import Control.Monad( unless )-import System.Directory( renameFile )--import Darcs.Commands-import Darcs.Arguments ( DarcsFlag( Quiet ),- workingRepoDir, umaskOption,- )-import Darcs.Repository ( withRepoLock, ($-), amInRepository,- replacePristine, writePatchSet )-import Darcs.Repository.Repair( replayRepository, checkIndex- , RepositoryConsistency(..) )--repairDescription :: String-repairDescription = "Repair a corrupted repository."--repairHelp :: String-repairHelp =- "The `darcs repair' command attempts to fix corruption in the current\n" ++- "repository. Currently it can only repair damage to the pristine tree,\n" ++- "which is where most corruption occurs.\n"--repair :: DarcsCommand-repair = DarcsCommand {commandName = "repair",- commandHelp = repairHelp,- commandDescription = repairDescription,- commandExtraArgs = 0,- commandExtraArgHelp = [],- commandCommand = repairCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [umaskOption],- commandBasicOptions = [workingRepoDir]}--repairCmd :: [DarcsFlag] -> [String] -> IO ()-repairCmd opts _ = withRepoLock opts $- \repository -> do- replayRepository repository opts $ \state ->- case state of- RepositoryConsistent ->- putStrLn "The repository is already consistent, no changes made."- BrokenPristine tree -> do- putStrLn "Fixing pristine tree..."- replacePristine repository tree- BrokenPatches tree newps -> do- putStrLn "Writing out repaired patches..."- writePatchSet newps opts- putStrLn "Fixing pristine tree..."- replacePristine repository tree- return ()- index_ok <- checkIndex repository (Quiet `elem` opts)- unless index_ok $ do renameFile "_darcs/index" "_darcs/index.bad"- putStrLn "Bad index discarded."--\end{code}
+ src/Darcs/Commands/Replace.hs view
@@ -0,0 +1,233 @@+-- Copyright (C) 2002-2005 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.++{-# LANGUAGE CPP #-}++module Darcs.Commands.Replace ( replace, defaultToks ) where++import Data.Maybe ( isJust )+import Control.Monad ( unless, filterM )+import Control.Applicative( (<$>) )++import Darcs.Commands ( DarcsCommand(..),+ nodefaults )+import Darcs.Arguments ( DarcsFlag(ForceReplace, Toks), listRegisteredFiles,+ ignoretimes, umaskOption, tokens, forceReplace,+ workingRepoDir, fixSubPaths )+import Darcs.Repository ( withRepoLock, RepoJob(..),+ addToPending,+ amInHashedRepository,+ applyToWorking,+ readUnrecorded, readRecordedAndPending+ )+import Darcs.Patch ( Patchy, PrimPatch, tokreplace, forceTokReplace, applyToTree )+import Darcs.Patch.FileName( fn2fp )+import Darcs.Patch.Patchy ( Apply )+import Darcs.Witnesses.Ordered ( FL(..), (+>+), concatFL, toFL )+import Darcs.Witnesses.Sealed ( Sealed(..), mapSeal, FreeLeft, Gap(..) )+import Darcs.Patch.RegChars ( regChars )+import Data.Char ( isSpace )+import Darcs.RepoPath ( SubPath, toFilePath, sp2fn )+import Darcs.Repository.Prefs ( FileType(TextFile) )+import Darcs.Diff( treeDiff )+import Storage.Hashed.Tree( readBlob, modifyTree , findFile, TreeItem(..), Tree, makeBlobBS )+import Storage.Hashed.AnchoredPath( AnchoredPath, floatPath )++import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString as BS+#include "impossible.h"+#include "gadts.h"++replaceDescription :: String+replaceDescription = "Substitute one word for another."++replaceHelp :: String+replaceHelp =+ "In addition to line-based patches, Darcs supports a limited form of\n" +++ "lexical substitution. Files are treated as sequences of words, and\n" +++ "each occurrence of the old word is replaced by the new word.\n" +++ "This is intended to provide a clean way to rename a function or\n" +++ "variable. Such renamings typically affect lines all through the\n" +++ "source code, so a traditional line-based patch would be very likely to\n" +++ "conflict with other branches, requiring manual merging.\n" +++ "\n" +++ "Files are tokenized according to one simple rule: words are strings of\n" +++ "valid token characters, and everything between them (punctuation and\n" +++ -- FIXME: this heuristic is ham-fisted and silly. Can we drop it?+ "whitespace) is discarded. By default, valid token characters are\n" +++ "letters, numbers and the underscore (i.e. [A-Za-z0-9_]). However if\n" +++ "the old and/or new token contains either a hyphen or period, BOTH\n" +++ "hyphen and period are treated as valid (i.e. [A-Za-z0-9_.-]).\n" +++ "\n" +++ "The set of valid characters can be customized using the --token-chars\n" +++ "option. The argument must be surrounded by square brackets. If a\n" +++ "hyphen occurs between two characters in the set, it is treated as a\n" +++ "set range. For example, in most locales [A-Z] denotes all uppercase\n" +++ "letters. If the first character is a caret, valid tokens are taken to\n" +++ "be the complement of the remaining characters. For example, [^:\\n]\n" +++ "could be used to match fields in the passwd(5), where records and\n" +++ "fields are separated by newlines and colons respectively.\n" +++ "\n" +++ "If you choose to use --token-chars, you are STRONGLY encouraged to do\n" +++ "so consistently. The consequences of using multiple replace patches\n" +++ "with different --token-chars arguments on the same file are not well\n" +++ "tested nor well understood.\n" +++ "\n" +++ "By default Darcs will refuse to perform a replacement if the new token\n" +++ "is already in use, because the replacements would be not be\n" +++ "distinguishable from the existing tokens. This behaviour can be\n" +++ "overridden by supplying the --force option, but an attempt to `darcs\n" +++ "rollback' the resulting patch will affect these existing tokens.\n" +++ "\n" +++ "Limitations:\n" +++ "\n" +++ "The tokenizer treats files as byte strings, so it is not possible for\n" +++ "--token-chars to include multi-byte characters, such as the non-ASCII\n" +++ "parts of UTF-8. Similarly, trying to replace a `high-bit' character\n" +++ "from a unibyte encoding will also result in replacement of the same\n" +++ "byte in files with different encodings. For example, an acute a from\n" +++ "ISO 8859-1 will also match an alpha from ISO 8859-7.\n" +++ "\n" +++ "Due to limitations in the patch file format, --token-chars arguments\n" +++ "cannot contain literal whitespace. For example, [^ \\n\\t] cannot be\n" +++ "used to declare all characters except the space, tab and newline as\n" +++ "valid within a word, because it contains a literal space.\n" +++ "\n" +++ "Unlike POSIX regex(7) bracket expressions, character classes (such as\n" +++ "[[:alnum:]]) are NOT supported by --token-chars, and will be silently\n" +++ "treated as a simple set of characters.\n"++replace :: DarcsCommand+replace = DarcsCommand {commandProgramName = "darcs",+ commandName = "replace",+ commandHelp = replaceHelp,+ commandDescription = replaceDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["<OLD>","<NEW>",+ "<FILE> ..."],+ commandCommand = replaceCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = listRegisteredFiles,+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [ignoretimes, umaskOption],+ commandBasicOptions =+ [tokens, forceReplace, workingRepoDir]}++replaceCmd :: [DarcsFlag] -> [String] -> IO ()+replaceCmd opts (old:new:relfs) = withRepoLock opts $ RepoJob $ \repository -> do+ fs <- fixSubPaths opts relfs+ toks <- chooseToks opts old new+ let checkToken tok =+ unless (isTok toks tok) $ fail $ "'"++tok++"' is not a valid token!"+ checkToken old+ checkToken new+ work <- readUnrecorded repository Nothing+ cur <- readRecordedAndPending repository+ files <- filterM (exists work) fs+ Sealed pswork <- mapSeal concatFL . toFL <$> mapM (repl toks cur work) files+ addToPending repository pswork+ _ <- applyToWorking repository opts pswork `catch` \e ->+ fail $ "Can't do replace on working!\n"+ ++ "Perhaps one of the files already contains '"++ new++"'?\n"+ ++ show e+ return ()+ where ftf _ = TextFile+ skipmsg f = "Skipping file '" ++ toFilePath f ++ "' which isn't in the repository."+ exists tree file = if isJust $ findFile tree (floatSubPath file)+ then return True+ else do putStrLn $ skipmsg file+ return False+ repl :: forall prim . (Patchy prim, PrimPatch prim) => String -> Tree IO -> Tree IO -> SubPath -> IO (FreeLeft (FL prim))+ repl toks cur work f =+ do work_replaced <- maybeApplyToTree replace_patch work+ cur_replaced <- maybeApplyToTree replace_patch cur+ if ForceReplace `elem` opts || isJust work_replaced || isJust cur_replaced+ then get_force_replace f toks work+ else do putStrLn $ "Skipping file '"++f_fp++"'"+ putStrLn $ "Perhaps the recorded version of this " +++ "file already contains '" ++new++"'?"+ putStrLn $ "Use the --force option to override."+ return (emptyGap NilFL)+ where f_fp = toFilePath f+ replace_patch :: prim C(x y)+ replace_patch = tokreplace f_fp toks old new++ get_force_replace :: PrimPatch prim => SubPath -> String -> Tree IO -> IO (FreeLeft (FL prim))+ get_force_replace f toks tree = do+ let path = floatSubPath f+ content <- readBlob $ fromJust $ findFile tree path+ let newcontent = forceTokReplace toks new old (BS.concat $ BL.toChunks content)+ tree' = modifyTree tree path (File . makeBlobBS <$> newcontent)+ case newcontent of+ Nothing -> bug "weird forcing bug in replace."+ Just _ -> do pfix <- treeDiff ftf tree tree'+ return $ joinGap (+>+) pfix (freeGap (tokreplace f_fp toks old new :>: NilFL))+ where f_fp = toFilePath f++replaceCmd _ _ = fail "Usage: darcs replace OLD NEW [FILES]"++floatSubPath :: SubPath -> AnchoredPath+floatSubPath = floatPath . fn2fp . sp2fn++maybeApplyToTree :: Apply p => p C(x y) -> Tree IO -> IO (Maybe (Tree IO))+maybeApplyToTree patch tree = catch (Just `fmap` applyToTree patch tree)+ (\_ -> return Nothing)++defaultToks :: String+defaultToks = "A-Za-z_0-9"+filenameToks :: String+filenameToks = "A-Za-z_0-9\\-\\."++-- | Given a set of characters and a string, returns true iff the+-- string contains only characters from the set. A set beginning with+-- a caret (@^@) is treated as a complementary set.+isTok :: String -> String -> Bool+isTok _ "" = False+isTok toks s = and $ map (regChars toks) s++-- | This function checks for @--token-chars@ on the command-line. If+-- found, it validates the argument and returns it, without the+-- surrounding square brackets. Otherwise, it returns either+-- 'defaultToks' or 'filenameToks' as explained in 'replaceHelp'.+--+-- Note: Limitations in the current replace patch file format prevents+-- tokens and token-char specifiers from containing any whitespace.+chooseToks :: [DarcsFlag] -> String -> String -> IO String+chooseToks (Toks t:_) a b+ | length t <= 2 =+ bad_token_spec $ "It must contain more than 2 characters, because " +++ "it should be enclosed in square brackets"+ | head t /= '[' || last t /= ']' =+ bad_token_spec "It should be enclosed in square brackets"+ | '^' == head tok && length tok == 1 =+ bad_token_spec "Must be at least one character in the complementary set"+ | any isSpace t =+ bad_token_spec "Space is not allowed in the spec"+ | any isSpace a = bad_token_spec $ spacey_token a+ | any isSpace b = bad_token_spec $ spacey_token b+ | not (isTok tok a) = bad_token_spec $ not_a_token a+ | not (isTok tok b) = bad_token_spec $ not_a_token b+ | otherwise = return tok+ where tok = init $ tail t :: String+ bad_token_spec msg = fail $ "Bad token spec: '"++ t ++"' ("++ msg ++")"+ spacey_token x = x ++ " must not contain any space"+ not_a_token x = x ++ " is not a token, according to your spec"+chooseToks (_:fs) a b = chooseToks fs a b+chooseToks [] a b = if isTok defaultToks a && isTok defaultToks b+ then return defaultToks+ else return filenameToks+
− src/Darcs/Commands/Replace.lhs
@@ -1,266 +0,0 @@-% Copyright (C) 2002-2005 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.--\darcsCommand{replace}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--module Darcs.Commands.Replace ( replace ) where--import Data.Maybe ( isJust )-import Control.Monad ( unless, filterM )-import Control.Applicative( (<$>) )--import Darcs.Commands ( DarcsCommand(DarcsCommand, commandName, commandHelp,- commandDescription, commandExtraArgs,- commandExtraArgHelp, commandCommand, commandPrereq,- commandGetArgPossibilities, commandArgdefaults,- commandAdvancedOptions, commandBasicOptions),- nodefaults )-import Darcs.Arguments ( DarcsFlag(ForceReplace, Toks), listRegisteredFiles,- ignoretimes, umaskOption, tokens, forceReplace,- workingRepoDir, fixSubPaths )-import Darcs.Repository ( withRepoLock, ($-),- addToPending,- amInRepository,- applyToWorking,- readUnrecorded, readRecordedAndPending- )-import Darcs.Patch ( Prim, tokreplace, applyToTree )-import Darcs.Patch.Apply ( forceTokReplace )-import Darcs.Patch.FileName( fn2fp )-import Darcs.Patch.Patchy ( Apply )-import Darcs.Witnesses.Ordered ( FL(..), (+>+), concatFL, toFL )-import Darcs.Witnesses.Sealed ( Sealed(..), mapSeal, FreeLeft, Gap(..) )-import Darcs.Patch.RegChars ( regChars )-import Data.Char ( isSpace )-import Darcs.RepoPath ( SubPath, toFilePath, sp2fn )-import Darcs.Repository.Prefs ( FileType(TextFile) )-import Darcs.Diff( treeDiff )-import Storage.Hashed.Tree( readBlob, modifyTree , findFile, TreeItem(..), Tree, makeBlobBS )-import Storage.Hashed.AnchoredPath( AnchoredPath, floatPath )--import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString as BS-#include "impossible.h"-#include "gadts.h"--replaceDescription :: String-replaceDescription = "Substitute one word for another."--replaceHelp :: String-replaceHelp =- "In addition to line-based patches, Darcs supports a limited form of\n" ++- "lexical substitution. Files are treated as sequences of words, and\n" ++- "each occurrence of the old word is replaced by the new word.\n" ++- "This is intended to provide a clean way to rename a function or\n" ++- "variable. Such renamings typically affect lines all through the\n" ++- "source code, so a traditional line-based patch would be very likely to\n" ++- "conflict with other branches, requiring manual merging.\n" ++- "\n" ++- "Files are tokenized according to one simple rule: words are strings of\n" ++- "valid token characters, and everything between them (punctuation and\n" ++- -- FIXME: this heuristic is ham-fisted and silly. Can we drop it?- "whitespace) is discarded. By default, valid token characters are\n" ++- "letters, numbers and the underscore (i.e. [A-Za-z0-9_]). However if\n" ++- "the old and/or new token contains either a hyphen or period, BOTH\n" ++- "hyphen and period are treated as valid (i.e. [A-Za-z0-9_.-]).\n" ++- "\n" ++- "The set of valid characters can be customized using the --token-chars\n" ++- "option. The argument must be surrounded by square brackets. If a\n" ++- "hyphen occurs between two characters in the set, it is treated as a\n" ++- "set range. For example, in most locales [A-Z] denotes all uppercase\n" ++- "letters. If the first character is a caret, valid tokens are taken to\n" ++- "be the complement of the remaining characters. For example, [^:\\n]\n" ++- "could be used to match fields in the passwd(5), where records and\n" ++- "fields are separated by newlines and colons respectively.\n" ++- "\n" ++- "If you choose to use --token-chars, you are STRONGLY encouraged to do\n" ++- "so consistently. The consequences of using multiple replace patches\n" ++- "with different --token-chars arguments on the same file are not well\n" ++- "tested nor well understood.\n" ++- "\n" ++- "By default Darcs will refuse to perform a replacement if the new token\n" ++- "is already in use, because the replacements would be not be\n" ++- "distinguishable from the existing tokens. This behaviour can be\n" ++- "overridden by supplying the --force option, but an attempt to `darcs\n" ++- "rollback' the resulting patch will affect these existing tokens.\n" ++- "\n" ++- "Limitations:\n" ++- "\n" ++- "The tokenizer treats files as byte strings, so it is not possible for\n" ++- "--token-chars to include multi-byte characters, such as the non-ASCII\n" ++- "parts of UTF-8. Similarly, trying to replace a `high-bit' character\n" ++- "from a unibyte encoding will also result in replacement of the same\n" ++- "byte in files with different encodings. For example, an acute a from\n" ++- "ISO 8859-1 will also match an alpha from ISO 8859-7.\n" ++- "\n" ++- "Due to limitations in the patch file format, --token-chars arguments\n" ++- "cannot contain literal whitespace. For example, [^ \\n\\t] cannot be\n" ++- "used to declare all characters except the space, tab and newline as\n" ++- "valid within a word, because it contains a literal space.\n" ++- "\n" ++- "Unlike POSIX regex(7) bracket expressions, character classes (such as\n" ++- "[[:alnum:]]) are NOT supported by --token-chars, and will be silently\n" ++- "treated as a simple set of characters.\n"---- FIXME: can we just delete the remaining text? It seems more an--- instance of "look how clever I am; I made commutation work" rather--- than information that is actually useful to users.-\end{code}-There is a potentially confusing difference, however, when a replace is-used to make another replace possible:-\begin{verbatim}-$ darcs replace newtoken aaack ./foo.c-$ darcs replace oldtoken newtoken ./foo.c-$ darcs record-\end{verbatim}-will be valid, even if \verb!newtoken! and \verb!oldtoken! are both present-in the recorded version of foo.c, while the sequence-\begin{verbatim}-$ [manually edit foo.c replacing newtoken with aaack]-$ darcs replace oldtoken newtoken ./foo.c-\end{verbatim}-will fail because ``newtoken'' still exists in the recorded version of-\verb!foo.c!. The reason for the difference is that when recording, a-``replace'' patch always is recorded \emph{before} any manual changes,-which is usually what you want, since often you will introduce new-occurrences of the ``newtoken'' in your manual changes. In contrast,-multiple ``replace'' changes are recorded in the order in which-they were made.-\begin{code}--replace :: DarcsCommand-replace = DarcsCommand {commandName = "replace",- commandHelp = replaceHelp,- commandDescription = replaceDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["<OLD>","<NEW>",- "<FILE> ..."],- commandCommand = replaceCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = listRegisteredFiles,- commandArgdefaults = nodefaults,- commandAdvancedOptions = [ignoretimes, umaskOption],- commandBasicOptions =- [tokens, forceReplace, workingRepoDir]}--replaceCmd :: [DarcsFlag] -> [String] -> IO ()-replaceCmd opts (old:new:relfs) = withRepoLock opts $- \repository -> do- fs <- fixSubPaths opts relfs- toks <- chooseToks opts old new- let checkToken tok =- unless (isTok toks tok) $ fail $ "'"++tok++"' is not a valid token!"- checkToken old- checkToken new- work <- readUnrecorded repository []- cur <- readRecordedAndPending repository- files <- filterM (exists work) fs- Sealed pswork <- mapSeal concatFL . toFL <$> mapM (repl toks cur work) files- addToPending repository pswork- applyToWorking repository opts pswork `catch` \e ->- fail $ "Can't do replace on working!\n"- ++ "Perhaps one of the files already contains '"++ new++"'?\n"- ++ show e- return ()- where ftf _ = TextFile- skipmsg f = "Skipping file '" ++ toFilePath f ++ "' which isn't in the repository."- exists tree file = if isJust $ findFile tree (floatSubPath file)- then return True- else do putStrLn $ skipmsg file- return False- repl :: String -> Tree IO -> Tree IO -> SubPath -> IO (FreeLeft (FL Prim))- repl toks cur work f =- do work_replaced <- maybeApplyToTree replace_patch work- cur_replaced <- maybeApplyToTree replace_patch cur- if ForceReplace `elem` opts || isJust work_replaced || isJust cur_replaced- then get_force_replace f toks work- else do putStrLn $ "Skipping file '"++f_fp++"'"- putStrLn $ "Perhaps the recorded version of this " ++- "file already contains '" ++new++"'?"- putStrLn $ "Use the --force option to override."- return (emptyGap NilFL)- where f_fp = toFilePath f- replace_patch = tokreplace f_fp toks old new-- get_force_replace :: SubPath -> String -> Tree IO -> IO (FreeLeft (FL Prim))- get_force_replace f toks tree = do- let path = floatSubPath f- content <- readBlob $ fromJust $ findFile tree path- let newcontent = forceTokReplace toks new old (BS.concat $ BL.toChunks content)- tree' = modifyTree tree path (File . makeBlobBS <$> newcontent)- case newcontent of- Nothing -> bug "weird forcing bug in replace."- Just _ -> do pfix <- treeDiff ftf tree tree'- return $ joinGap (+>+) pfix (freeGap (tokreplace f_fp toks old new :>: NilFL))- where f_fp = toFilePath f--replaceCmd _ _ = fail "Usage: darcs replace OLD NEW [FILES]"--floatSubPath :: SubPath -> AnchoredPath-floatSubPath = floatPath . fn2fp . sp2fn--maybeApplyToTree :: Apply p => p C(x y) -> Tree IO -> IO (Maybe (Tree IO))-maybeApplyToTree patch tree = catch (Just `fmap` applyToTree patch tree)- (\_ -> return Nothing)--defaultToks :: String-defaultToks = "A-Za-z_0-9"-filenameToks :: String-filenameToks = "A-Za-z_0-9\\-\\."---- | Given a set of characters and a string, returns true iff the--- string contains only characters from the set. A set beginning with--- a caret (@^@) is treated as a complementary set.-isTok :: String -> String -> Bool-isTok _ "" = False-isTok toks s = and $ map (regChars toks) s---- | This function checks for @--token-chars@ on the command-line. If--- found, it validates the argument and returns it, without the--- surrounding square brackets. Otherwise, it returns either--- 'defaultToks' or 'filenameToks' as explained in 'replaceHelp'.------ Note: Limitations in the current replace patch file format prevents--- tokens and token-char specifiers from containing any whitespace.-chooseToks :: [DarcsFlag] -> String -> String -> IO String-chooseToks (Toks t:_) a b- | length t <= 2 =- bad_token_spec $ "It must contain more than 2 characters, because " ++- "it should be enclosed in square brackets"- | head t /= '[' || last t /= ']' =- bad_token_spec "It should be enclosed in square brackets"- | '^' == head tok && length tok == 1 =- bad_token_spec "Must be at least one character in the complementary set"- | any isSpace t =- bad_token_spec "Space is not allowed in the spec"- | any isSpace a = bad_token_spec $ spacey_token a- | any isSpace b = bad_token_spec $ spacey_token b- | not (isTok tok a) = bad_token_spec $ not_a_token a- | not (isTok tok b) = bad_token_spec $ not_a_token b- | otherwise = return tok- where tok = init $ tail t :: String- bad_token_spec msg = fail $ "Bad token spec: '"++ t ++"' ("++ msg ++")"- spacey_token x = x ++ " must not contain any space"- not_a_token x = x ++ " is not a token, according to your spec"-chooseToks (_:fs) a b = chooseToks fs a b-chooseToks [] a b = if isTok defaultToks a && isTok defaultToks b- then return defaultToks- else return filenameToks-\end{code}-
+ src/Darcs/Commands/Revert.hs view
@@ -0,0 +1,119 @@+-- Copyright (C) 2002-2005 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.++module Darcs.Commands.Revert ( revert ) where+import System.Exit ( ExitCode(..), exitWith )+import Control.Applicative ( (<$>) )+import Control.Monad ( when )+import Data.List ( sort )++import English (englishNum, This(..), Noun(..))+import Darcs.Flags( diffingOpts )+import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Commands.Util ( announceFiles )+import Darcs.Arguments ( DarcsFlag( All, Debug ),+ ignoretimes, workingRepoDir,+ allInteractive,+ fixSubPaths,+ listRegisteredFiles, umaskOption,+ )+import Darcs.Utils ( askUser )+import Darcs.RepoPath ( toFilePath )+import Darcs.Repository ( withRepoLock, RepoJob(..), withGutsOf,+ addToPending,+ applyToWorking,+ amInHashedRepository, readRecorded,+ unrecordedChanges+ )+import Darcs.Patch ( invert, applyToFilepaths, commute )+import Darcs.Patch.Split ( reversePrimSplitter )+import Darcs.Witnesses.Ordered ( FL(..), (:>)(..), lengthFL, nullFL, (+>+) )+import Darcs.SelectChanges ( selectChanges, WhichChanges(Last), selectionContextPrim, runSelection )+import Darcs.Patch.TouchesFiles ( chooseTouching )+import Darcs.Commands.Unrevert ( writeUnrevert )+import Darcs.Witnesses.Sealed ( Sealed(..) )++#include "gadts.h"++revertDescription :: String+revertDescription = "Discard unrecorded changes."++revertHelp :: String+revertHelp =+ "The `darcs revert' command discards unrecorded changes the working\n" +++ "tree. As with `darcs record', you will be asked which hunks (changes)\n" +++ "to revert. The --all switch can be used to avoid such prompting. If\n" +++ "files or directories are specified, other parts of the working tree\n" +++ "are not reverted.\n" +++ "\n" +++ "In you accidentally reverted something you wanted to keep (for\n" +++ "example, typing `darcs rev -a' instead of `darcs rec -a'), you can\n" +++ "immediately run `darcs unrevert' to restore it. This is only\n" +++ "guaranteed to work if the repository has not changed since `darcs\n" +++ "revert' ran.\n"++revert :: DarcsCommand+revert = DarcsCommand {commandProgramName = "darcs",+ commandName = "revert",+ commandHelp = revertHelp,+ commandDescription = revertDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["[FILE or DIRECTORY]..."],+ commandCommand = revertCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = listRegisteredFiles,+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [ignoretimes, umaskOption],+ commandBasicOptions = [allInteractive,+ workingRepoDir]}++revertCmd :: [DarcsFlag] -> [String] -> IO ()+revertCmd opts args = withRepoLock opts $ RepoJob $ \repository -> do+ files <- if null args then return Nothing+ else Just . sort <$> fixSubPaths opts args+ announceFiles files "Reverting changes in"+ changes <- unrecordedChanges (diffingOpts opts {- always ScanKnown here -}) repository files+ let pre_changed_files = applyToFilepaths (invert changes) . map toFilePath <$> files+ rec <- readRecorded repository+ Sealed touching_changes <- return (chooseTouching pre_changed_files changes)+ (case touching_changes of+ NilFL -> putStrLn "There are no changes to revert!"+ _ -> do+ let context = selectionContextPrim "revert" opts (Just reversePrimSplitter) pre_changed_files+ (norevert:>p) <- runSelection (selectChanges Last changes) context+ if nullFL p+ then putStrLn $ "If you don't want to revert after all," +++ " that's fine with me!"+ else do+ let theseChanges = englishNum (lengthFL p) . This . Noun $ "change"+ yorn <- if All `elem` opts+ then return "y"+ else askUser $ "Do you really want to revert " ++ theseChanges "? "+ case yorn of ('y':_) -> return ()+ _ -> exitWith $ ExitSuccess+ withGutsOf repository $ do+ addToPending repository $ invert p+ when (Debug `elem` opts) $ putStrLn "About to write the unrevert file."+ case commute (norevert:>p) of+ Just (p':>_) -> writeUnrevert repository p' rec NilFL+ Nothing -> writeUnrevert repository (norevert+>+p) rec NilFL+ when (Debug `elem` opts) $ putStrLn "About to apply to the working directory."+ _ <- applyToWorking repository opts (invert p) `catch` \e ->+ fail ("Unable to apply inverse patch!" ++ show e)+ return ()) :: IO ()+ putStrLn "Finished reverting."+
− src/Darcs/Commands/Revert.lhs
@@ -1,117 +0,0 @@-% Copyright (C) 2002-2005 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.--\darcsCommand{revert}-\begin{code}-module Darcs.Commands.Revert ( revert ) where-import System.Exit ( ExitCode(..), exitWith )-import Control.Monad ( when )-import Data.List ( sort )--import English (englishNum, This(..), Noun(..))-import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Arguments ( DarcsFlag( All, Debug ),- ignoretimes, workingRepoDir,- allInteractive,- fixSubPaths, areFileArgs,- listRegisteredFiles, umaskOption,- )-import Darcs.Utils ( askUser )-import Darcs.RepoPath ( toFilePath )-import Darcs.Repository ( withRepoLock, ($-), withGutsOf,- addToPending,- applyToWorking,- amInRepository, readRecorded,- unrecordedChanges- )-import Darcs.Patch ( invert, applyToFilepaths, commute )-import Darcs.Witnesses.Ordered ( FL(..), (:>)(..), lengthFL, nullFL, (+>+) )-import Darcs.SelectChanges ( selectChanges, WhichChanges(Last), selectionContextPrim, runSelection )-import Darcs.Patch.TouchesFiles ( chooseTouching )-import Darcs.Commands.Unrevert ( writeUnrevert )-import Darcs.Witnesses.Sealed ( Sealed(..) )--#include "gadts.h"--revertDescription :: String-revertDescription = "Discard unrecorded changes."--revertHelp :: String-revertHelp =- "The `darcs revert' command discards unrecorded changes the working\n" ++- "tree. As with `darcs record', you will be asked which hunks (changes)\n" ++- "to revert. The --all switch can be used to avoid such prompting. If\n" ++- "files or directories are specified, other parts of the working tree\n" ++- "are not reverted.\n" ++- "\n" ++- "In you accidentally reverted something you wanted to keep (for\n" ++- "example, typing `darcs rev -a' instead of `darcs rec -a'), you can\n" ++- "immediately run `darcs unrevert' to restore it. This is only\n" ++- "guaranteed to work if the repository has not changed since `darcs\n" ++- "revert' ran.\n"--revert :: DarcsCommand-revert = DarcsCommand {commandName = "revert",- commandHelp = revertHelp,- commandDescription = revertDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["[FILE or DIRECTORY]..."],- commandCommand = revertCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = listRegisteredFiles,- commandArgdefaults = nodefaults,- commandAdvancedOptions = [ignoretimes, umaskOption],- commandBasicOptions = [allInteractive,- workingRepoDir]}--revertCmd :: [DarcsFlag] -> [String] -> IO ()-revertCmd opts args = withRepoLock opts $- \repository -> do- files <- sort `fmap` fixSubPaths opts args- when (areFileArgs files) $- putStrLn $ "Reverting changes in "++unwords (map show files)++"..\n"- changes <- unrecordedChanges opts repository files- let pre_changed_files = applyToFilepaths (invert changes) (map toFilePath files)- rec <- readRecorded repository- Sealed touching_changes <- return (chooseTouching pre_changed_files changes)- (case touching_changes of- NilFL -> putStrLn "There are no changes to revert!"- _ -> do- let context = selectionContextPrim "revert" opts Nothing pre_changed_files- (norevert:>p) <- runSelection (selectChanges Last changes) context- if nullFL p- then putStrLn $ "If you don't want to revert after all," ++- " that's fine with me!"- else do- let theseChanges = englishNum (lengthFL p) . This . Noun $ "change"- yorn <- if All `elem` opts- then return "y"- else askUser $ "Do you really want to revert " ++ theseChanges "? "- case yorn of ('y':_) -> return ()- _ -> exitWith $ ExitSuccess- withGutsOf repository $ do- addToPending repository $ invert p- when (Debug `elem` opts) $ putStrLn "About to write the unrevert file."- case commute (norevert:>p) of- Just (p':>_) -> writeUnrevert repository p' rec NilFL- Nothing -> writeUnrevert repository (norevert+>+p) rec NilFL- when (Debug `elem` opts) $ putStrLn "About to apply to the working directory."- applyToWorking repository opts (invert p) `catch` \e ->- fail ("Unable to apply inverse patch!" ++ show e)- return ()) :: IO ()- putStrLn "Finished reverting."-\end{code}-
+ src/Darcs/Commands/Rollback.hs view
@@ -0,0 +1,187 @@+-- Copyright (C) 2002-2004,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.++{-# LANGUAGE CPP #-}++module Darcs.Commands.Rollback ( rollback ) where++import Control.Applicative ( (<$>) )+import Control.Monad ( when )+import System.Exit ( exitWith, ExitCode(..) )+import Data.List ( sort )+import Data.Maybe ( isJust )+import System.Directory ( removeFile )++import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Arguments ( DarcsFlag(MarkConflicts), fixSubPaths, getAuthor,+ setEnvDarcsPatches,+ workingRepoDir, nocompress,+ author, patchnameOption, askLongComment,+ leaveTestDir, notest, listRegisteredFiles,+ matchSeveralOrLast, allInteractive, umaskOption,+ recordRollback+ )+import Darcs.RepoPath ( toFilePath )+import Darcs.Repository ( Repository, amInHashedRepository, withRepoLock, RepoJob(..),+ applyToWorking,+ readRepo,+ tentativelyMergePatches, withGutsOf,+ testTentative,+ finalizeRepositoryChanges, invalidateIndex,+ tentativelyAddToPending, considerMergeToWorking+ )+import Darcs.Patch ( RepoPatch, summary, invert, namepatch, effect, fromPrims,+ sortCoalesceFL, canonize, anonymous, PrimOf )+import Darcs.Flags ( isInteractive, rollbackInWorkingDir )+import Darcs.Patch.Set ( PatchSet(..), newset2FL )+import Darcs.Patch.Split ( reversePrimSplitter )+import Darcs.Witnesses.Ordered+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, n2pia )+import Darcs.Lock ( worldReadableTemp )+import Darcs.Match ( firstMatch )+import Darcs.SelectChanges ( selectChanges,+ WhichChanges(..),+ selectionContext, selectionContextPrim,+ runSelection+ )+import Darcs.Commands.Record ( getLog )+import Darcs.Commands.Unrecord ( getLastPatches )+import Darcs.Commands.Util ( announceFiles, filterExistingFiles )+import Darcs.Utils ( clarifyErrors, PromptConfig(..), promptChar )+import Printer ( renderString )+import Progress ( debugMessage )+import Darcs.Witnesses.Sealed ( Sealed(..) )+import IsoDate ( getIsoDateTime )+#include "impossible.h"+#include "gadts.h"++rollbackDescription :: String+rollbackDescription =+ "Record a new patch reversing some recorded changes."++rollbackHelp :: String+rollbackHelp =+ "Rollback is used to undo the effects of one or more patches without actually\n"+++ "deleting them. Instead, it creates a new patch reversing selected portions.\n"+++ "of those changes. Unlike obliterate and unrecord (which accomplish a similar\n"+++ "goal) rollback is perfectly safe, since it leaves in the repository a record\n"+++ "of its changes.\n"++rollback :: DarcsCommand+rollback = DarcsCommand {commandProgramName = "darcs",+ commandName = "rollback",+ commandHelp = rollbackHelp,+ commandDescription = rollbackDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["[FILE or DIRECTORY]..."],+ commandCommand = rollbackCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = listRegisteredFiles,+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [nocompress,umaskOption],+ commandBasicOptions = [matchSeveralOrLast,+ allInteractive,+ author, patchnameOption, askLongComment,+ notest, leaveTestDir,+ workingRepoDir, recordRollback]}++rollbackCmd :: [DarcsFlag] -> [String] -> IO ()+rollbackCmd opts args = withRepoLock opts $ RepoJob $ \repository -> do+ files <- if null args then return Nothing+ else Just . sort <$> fixSubPaths opts args+ when (files == Just []) $ fail "No valid arguments were given."+ let files_fp = map toFilePath <$> files+ announceFiles files "Recording changes in"+ existing_files <- maybe (return Nothing)+ (fmap Just . filterExistingFiles repository) files+ when (existing_files == Just []) $+ fail "None of the files you specified exist!"+ allpatches <- readRepo repository+ (_ :> patches) <- return $ if firstMatch opts+ then getLastPatches opts allpatches+ else (PatchSet NilRL NilRL):> (newset2FL allpatches)+ let patches_context = selectionContext "rollback" opts Nothing files_fp+ (_ :> ps) <- runSelection (selectChanges LastReversed patches) patches_context+ when (nullFL ps) $ do putStrLn "No patches selected!"+ exitWith ExitSuccess+ setEnvDarcsPatches ps+ let hunks_context = selectionContextPrim "rollback" opts (Just reversePrimSplitter) files_fp+ hunks = (concatFL $ mapFL_FL canonize $ sortCoalesceFL $ effect ps)+ runSelection (selectChanges Last hunks) hunks_context >>=+ if (rollbackInWorkingDir opts)+ then (undoItNow opts repository)+ else (rollItBackNow opts repository ps)++rollItBackNow :: (RepoPatch p) =>+ [DarcsFlag] -> Repository p C(r u t) -> FL (PatchInfoAnd p) C(x y)+ -> (q :> FL (PrimOf p)) C(a t) -> IO ()+rollItBackNow opts repository ps (_ :> ps'') =+ do when (nullFL ps'') $ do putStrLn "No changes selected!"+ exitWith ExitSuccess+ let make_log = worldReadableTemp "darcs-rollback"+ newlog = Just ("", "":"rolling back:":"":lines (renderString $ summary ps ))+ --tentativelyRemovePatches repository opts (mapFL_FL hopefully ps)+ (name, my_log, logf) <- getLog opts newlog make_log $ invert ps''+ date <- getIsoDateTime+ my_author <- getAuthor opts+ rbp <- n2pia `fmap` namepatch date name my_author my_log+ (fromPrims $ invert ps'')+ debugMessage "Adding rollback patch to repository."+ Sealed pw <-+ tentativelyMergePatches repository "rollback"+ (MarkConflicts : opts) NilFL+ (rbp :>: NilFL)+ debugMessage "Finalizing rollback changes..."+ invalidateIndex repository+ rc <- testTentative repository+ when (rc /= ExitSuccess) $ do+ when (not $ isInteractive opts) $ exitWith rc+ putStrLn $ "Looks like you have a bad patch: '"++name++"'"+ let prompt = "Shall I rollback anyway?"+ yn <- promptChar (PromptConfig prompt "yn" [] (Just 'n') [])+ case yn of+ 'y' -> return ()+ _ -> exitWith rc+ withGutsOf repository $ do+ finalizeRepositoryChanges repository+ debugMessage "About to apply rolled-back changes to working directory."+ _ <- revertable $ applyToWorking repository opts pw+ return ()+ when (isJust logf) $ removeFile (fromJust logf)+ putStrLn "Finished rolling back."+ where revertable x = x `clarifyErrors` unlines+ ["Error applying patch to the working directory.","",+ "This may have left your working directory an inconsistent",+ "but recoverable state. If you had no un-recorded changes",+ "by using 'darcs revert' you should be able to make your",+ "working directory consistent again."]++undoItNow :: (RepoPatch p) => [DarcsFlag] -> Repository p C(r u t)+ -> (q :> FL (PrimOf p)) C(a t) -> IO ()+undoItNow opts repo (_ :> prims) =+ do+ rbp <- n2pia `fmap` anonymous (fromPrims $ invert prims)+ Sealed pw <- considerMergeToWorking repo "rollback" (MarkConflicts: opts)+ NilFL (rbp :>: NilFL)+ tentativelyAddToPending repo opts pw+ withGutsOf repo $ do+ finalizeRepositoryChanges repo+ _ <- applyToWorking repo opts pw `catch` \e ->+ fail ("error applying rolled back patch to working directory\n"+ ++ show e)+ debugMessage "Finished applying unrocorded rollback patch"+
− src/Darcs/Commands/Rollback.lhs
@@ -1,152 +0,0 @@-% Copyright (C) 2002-2004,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.--\darcsCommand{rollback}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--module Darcs.Commands.Rollback ( rollback ) where--import Control.Monad ( when )-import System.Exit ( exitWith, ExitCode(..) )-import Data.List ( sort )-import Data.Maybe ( isJust )-import System.Directory ( removeFile )--import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Arguments ( DarcsFlag(MarkConflicts), fixSubPaths, getAuthor,- definePatches,- workingRepoDir, nocompress,- author, patchnameOption, askLongComment,- leaveTestDir, notest, listRegisteredFiles,- matchSeveralOrLast, allInteractive, umaskOption- )-import Darcs.RepoPath ( toFilePath )-import Darcs.Repository ( Repository, amInRepository, withRepoLock, ($-),- applyToWorking,- readRepo,- tentativelyMergePatches, withGutsOf,- finalizeRepositoryChanges, invalidateIndex )-import Darcs.Patch ( RepoPatch, summary, invert, namepatch, effect, fromPrims,- sortCoalesceFL, canonize )-import Darcs.Patch.Set ( newset2RL )-import Darcs.Patch.Prim ( Prim )-import Darcs.Witnesses.Ordered-import Darcs.Hopefully ( PatchInfoAnd, n2pia )-import Darcs.Lock ( worldReadableTemp )-import Darcs.Match ( firstMatch )-import Darcs.SelectChanges ( selectChanges,- WhichChanges(..),- selectionContext, selectionContextPrim,- runSelection- )-import Darcs.Commands.Record ( getLog )-import Darcs.Commands.Unrecord ( getLastPatches )-import Darcs.Commands.WhatsNew ( announceFiles )-import Darcs.Utils ( clarifyErrors )-import Printer ( renderString )-import Progress ( debugMessage )-import Darcs.Witnesses.Sealed ( Sealed(..), FlippedSeal(..) )-import IsoDate ( getIsoDateTime )-#include "impossible.h"-#include "gadts.h"--rollbackDescription :: String-rollbackDescription =- "Record a new patch reversing some recorded changes."--rollbackHelp :: String-rollbackHelp =- "Rollback is used to undo the effects of one or more patches without actually\n"++- "deleting them. Instead, it creates a new patch reversing selected portions.\n"++- "of those changes. Unlike obliterate and unrecord (which accomplish a similar\n"++- "goal) rollback is perfectly safe, since it leaves in the repository a record\n"++- "of its changes.\n"--rollback :: DarcsCommand-rollback = DarcsCommand {commandName = "rollback",- commandHelp = rollbackHelp,- commandDescription = rollbackDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["[FILE or DIRECTORY]..."],- commandCommand = rollbackCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = listRegisteredFiles,- commandArgdefaults = nodefaults,- commandAdvancedOptions = [nocompress,umaskOption],- commandBasicOptions = [matchSeveralOrLast,- allInteractive,- author, patchnameOption, askLongComment,- notest, leaveTestDir,- workingRepoDir]}--rollbackCmd :: [DarcsFlag] -> [String] -> IO ()-rollbackCmd opts args = withRepoLock opts $- \repository -> do- files <- sort `fmap` fixSubPaths opts args- let files_fp = map toFilePath files- existing_files <- announceFiles repository files "Recording changes in"- when (null existing_files && (not $ null files)) $- fail "None of the files you specified exist!"- allpatches <- readRepo repository- FlippedSeal patches <- return $ if firstMatch opts- then getLastPatches opts allpatches- else FlippedSeal $ newset2RL allpatches- let patches_context = selectionContext "rollback" opts Nothing files_fp- (_ :> ps) <- runSelection (selectChanges LastReversed (reverseRL patches)) patches_context- when (nullFL ps) $ do putStrLn "No patches selected!"- exitWith ExitSuccess- definePatches ps- let hunks_context = selectionContextPrim "rollback" opts Nothing files_fp- hunks = (concatFL $ mapFL_FL canonize $ sortCoalesceFL $ effect ps)- runSelection (selectChanges Last hunks) hunks_context >>=- (rollItBackNow opts repository ps)--rollItBackNow :: (RepoPatch p1, RepoPatch p) =>- [DarcsFlag] -> Repository p1 C(r u t) -> FL (PatchInfoAnd p) C(x y)- -> (q :> FL Prim) C(a t) -> IO ()-rollItBackNow opts repository ps (_ :> ps'') =- do when (nullFL ps'') $ do putStrLn "No changes selected!"- exitWith ExitSuccess- let make_log = worldReadableTemp "darcs-rollback"- newlog = Just ("", "":"rolling back:":"":lines (renderString $ summary ps ))- --tentativelyRemovePatches repository opts (mapFL_FL hopefully ps)- (name, my_log, logf) <- getLog opts newlog make_log $ invert ps''- date <- getIsoDateTime- my_author <- getAuthor opts- rbp <- n2pia `fmap` namepatch date name my_author my_log- (fromPrims $ invert ps'')- debugMessage "Adding rollback patch to repository."- Sealed pw <- tentativelyMergePatches repository "rollback" (MarkConflicts : opts)- NilFL (rbp :>: NilFL)- debugMessage "Finalizing rollback changes..."- invalidateIndex repository- withGutsOf repository $ do- finalizeRepositoryChanges repository- debugMessage "About to apply rolled-back changes to working directory."- revertable $ applyToWorking repository opts pw- return ()- when (isJust logf) $ removeFile (fromJust logf)- putStrLn "Finished rolling back."- where revertable x = x `clarifyErrors` unlines- ["Error applying patch to the working directory.","",- "This may have left your working directory an inconsistent",- "but recoverable state. If you had no un-recorded changes",- "by using 'darcs revert' you should be able to make your",- "working directory consistent again."]-\end{code}-
+ src/Darcs/Commands/Send.hs view
@@ -0,0 +1,366 @@+-- Copyright (C) 2002-2004 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.++{-# LANGUAGE CPP, TypeOperators #-}++module Darcs.Commands.Send ( send ) where+import System.Exit ( exitWith, ExitCode( ExitSuccess ) )+#ifndef HAVE_MAPI+import System.Exit ( ExitCode( ExitFailure ) )+#endif+import System.IO.Error ( ioeGetErrorString )+import System.IO ( hClose )+import Control.Monad ( when, unless, forM_ )+import Storage.Hashed.Tree ( Tree )+import Data.Maybe ( isNothing )++import Darcs.Commands ( DarcsCommand(..), putInfo, putVerbose )+import Darcs.Arguments ( DarcsFlag( EditDescription, LogFile,+ Target, Context,+ DryRun, Quiet+ ),+ fixUrl, setEnvDarcsPatches,+ getCc, getAuthor, workingRepoDir,+ editDescription, logfile, rmlogfile,+ sign, getSubject, depsSel, getInReplyTo,+ matchSeveral, setDefault, outputAutoName,+ output, ccSend, subject, target, author, sendmailCmd,+ inReplyTo, remoteRepo, networkOptions,+ allInteractive, getSendmailCmd,+ printDryRunMessageAndExit,+ summary, allowUnrelatedRepos,+ fromOpt, dryRun, sendToContext, getOutput,+ changesReverse,+ )+import Darcs.Flags ( willRemoveLogFile, doReverse )+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, hopefully, patchDesc )+import Darcs.Repository ( PatchSet, Repository,+ amInHashedRepository, identifyRepositoryFor, withRepoReadLock, RepoJob(..),+ readRepo, readRecorded, prefsUrl, checkUnrelatedRepos )+#ifdef GADT_WITNESSES+import Darcs.Patch.Set ( Origin )+#endif+import Darcs.Patch ( RepoPatch, description, applyToTree, invert )+import Darcs.Witnesses.Unsafe ( unsafeCoerceP )+import Darcs.Witnesses.Ordered ( FL(..), (:>)(..), (:\/:)(..), (:>)(..),+ mapFL, mapFL_FL, lengthFL, nullFL )+import Darcs.Patch.Bundle ( makeBundleN, scanContext, patchFilename )+import Darcs.Repository.Prefs ( defaultrepo, setDefaultrepo, getPreflist )+import Darcs.External ( signString, sendEmailDoc, fetchFilePS, Cachable(..), generateEmail+#ifndef HAVE_MAPI+ , haveSendmail+#endif+ )+import ByteStringUtils ( mmapFilePS )+import qualified Data.ByteString.Char8 as BC (unpack)+import Darcs.Lock ( withOpenTemp, writeDocBinFile, readDocBinFile, worldReadableTemp, removeFileMayNotExist )+import Darcs.SelectChanges ( selectChanges, WhichChanges(..), selectionContext, runSelection )+import Darcs.Patch.Depends ( findCommonWithThem )+import Darcs.Utils ( askUser, promptYorn, catchall, editFile, formatPath )+import Progress ( debugMessage )+import Darcs.Email ( makeEmail )+import Printer ( Doc, vsep, vcat, text, ($$), (<+>), (<>), putDoc )+import Darcs.RepoPath ( FilePathLike, toFilePath, AbsolutePath, AbsolutePathOrStd,+ getCurrentDirectory, useAbsoluteOrStd )+import HTTP ( postUrl )+#include "impossible.h"++#include "gadts.h"++sendDescription :: String+sendDescription =+ "Send by email a bundle of one or more patches."++sendHelp :: String+sendHelp =+ "Send is used to prepare a bundle of patches that can be applied to a target\n"+++ "repository. Send accepts the URL of the repository as an argument. When\n"+++ "called without an argument, send will use the most recent repository that\n"+++ "was either pushed to, pulled from or sent to. By default, the patch bundle\n"+++ "is sent by email, although you may save it to a file.\n"++send :: DarcsCommand+send = DarcsCommand {commandProgramName = "darcs",+ commandName = "send",+ commandHelp = sendHelp,+ commandDescription = sendDescription,+ commandExtraArgs = 1,+ commandExtraArgHelp = ["[REPOSITORY]"],+ commandCommand = sendCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = getPreflist "repos",+ commandArgdefaults = defaultrepo,+ commandAdvancedOptions = [logfile, rmlogfile,+ remoteRepo,+ sendToContext, changesReverse] +++ networkOptions,+ commandBasicOptions = [matchSeveral, depsSel,+ allInteractive,+ fromOpt, author,+ target,ccSend,subject, inReplyTo,+ output,outputAutoName,sign]+ ++dryRun++[summary,+ editDescription,+ setDefault False,+ workingRepoDir,+ sendmailCmd,+ allowUnrelatedRepos]}++sendCmd :: [DarcsFlag] -> [String] -> IO ()+sendCmd input_opts [""] = sendCmd input_opts []+sendCmd input_opts [unfixedrepodir] = withRepoReadLock input_opts $ RepoJob $+ \(repository :: Repository p C(r u r)) -> do+ context_ps <- the_context input_opts+ case context_ps of+ Just them -> do+ wtds <- decideOnBehavior input_opts (Nothing :: Maybe (Repository p C(r u r)))+ sendToThem repository input_opts wtds "CONTEXT" them+ Nothing -> do+ repodir <- fixUrl input_opts unfixedrepodir+ -- Test to make sure we aren't trying to push to the current repo+ here <- getCurrentDirectory+ when (repodir == toFilePath here) $+ fail ("Can't send to current repository! Did you mean send --context?")+ old_default <- getPreflist "defaultrepo"+ when (old_default == [repodir] && not (Quiet `elem` input_opts)) $+ putStrLn $ "Creating patch to "++formatPath repodir++"..."+ repo <- identifyRepositoryFor repository repodir+ them <- readRepo repo+ setDefaultrepo repodir input_opts+ wtds <- decideOnBehavior input_opts (Just 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++sendToThem :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> [WhatToDo] -> String -> PatchSet p C(Origin x) -> IO ()+sendToThem repo opts wtds their_name them = do+#ifndef HAVE_MAPI+ -- Check if the user has sendmail or provided a --sendmail-cmd+ -- (unless -o/-O or --dry-run is used)+ sendmail <- haveSendmail+ sm_cmd <- getSendmailCmd opts+ when (isNothing (getOutput opts "") && DryRun `notElem` opts &&+ not sendmail && sm_cmd == "") $ do+ putInfo opts $ text "No working sendmail instance on your machine!"+ exitWith $ ExitFailure 1+#endif+ us <- readRepo repo+ common :> us' <- return $ findCommonWithThem us them+ checkUnrelatedRepos opts us them+ (case us' of+ NilFL -> do putInfo opts $ text "No recorded local changes to send!"+ exitWith ExitSuccess+ _ -> putVerbose opts $ text "We have the following patches to send:"+ $$ (vcat $ mapFL description us')) :: IO ()+ pristine <- readRecorded repo+ let context = selectionContext "send" opts Nothing Nothing+ selector = if doReverse opts+ then selectChanges FirstReversed+ else selectChanges First+ (to_be_sent :> _) <- runSelection (selector us') context+ printDryRunMessageAndExit "send" opts to_be_sent+ when (nullFL to_be_sent) $ do+ putInfo opts $ text "You don't want to send any patches, and that's fine with me!"+ exitWith ExitSuccess+ setEnvDarcsPatches to_be_sent+ bundle <- prepareBundle opts common pristine (us':\/:to_be_sent)+ let make_fname (tb:>:_) = patchFilename $ patchDesc tb+ make_fname _ = impossible+ fname = make_fname to_be_sent+ outname = getOutput opts fname+ case outname of+ Just fname' -> writeBundleToFile opts to_be_sent bundle fname' wtds their_name+ Nothing -> sendBundle opts to_be_sent bundle fname wtds their_name++prepareBundle :: forall p C(x y z). RepoPatch p => [DarcsFlag] -> PatchSet p C(Origin z)+ -> Tree IO -> ((FL (PatchInfoAnd p)) :\/: (FL (PatchInfoAnd p))) C(x y)+ -> IO Doc+prepareBundle opts common pristine (us' :\/: to_be_sent) = do+ pristine' <- applyToTree (invert $ mapFL_FL hopefully us') pristine+ unsig_bundle <- makeBundleN (Just pristine') (unsafeCoerceP common) (mapFL_FL hopefully to_be_sent)+ signString opts unsig_bundle++sendBundle :: forall p C(x y) . (RepoPatch p) => [DarcsFlag] -> FL (PatchInfoAnd p) C(x y)+ -> Doc -> String -> [WhatToDo] -> String -> IO ()+sendBundle opts to_be_sent bundle fname wtds their_name=+ let+ auto_subject :: forall pp C(a b) . FL (PatchInfoAnd pp) C(a b) -> String+ auto_subject (p:>:NilFL) = "darcs patch: " ++ trim (patchDesc p) 57+ auto_subject (p:>:ps) = "darcs patch: " ++ trim (patchDesc p) 43 +++ " (and " ++ show (lengthFL ps) ++ " more)"+ auto_subject _ = error "Tried to get a name from empty patch list."+ trim st n = if length st <= n then st+ else take (n-3) st ++ "..."+ in do+ thetargets <- getTargets wtds+ from <- getAuthor opts+ let thesubject = case getSubject opts of+ Nothing -> auto_subject to_be_sent+ Just subj -> subj+ (mailcontents, mailfile) <- getDescription opts their_name to_be_sent+ let body = makeEmail their_name+ (maybe [] (\x -> [("In-Reply-To", x), ("References", x)]) . getInReplyTo $ opts)+ (Just mailcontents)+ bundle+ (Just fname)+ contentAndBundle = Just (mailcontents, bundle)++ sendmail = do+ sm_cmd <- getSendmailCmd opts+ (sendEmailDoc from (lt [t | SendMail t <- thetargets]) (thesubject) (getCc opts)+ sm_cmd contentAndBundle body >>+ (putInfo opts . text $ ("Successfully sent patch bundle to: "+ ++ lt [ t | SendMail t <- thetargets ]+ ++ ccs (getCc opts) ++".")))+ `catch` \e -> let msg = "Email body left in " in+ do case mailfile of+ Just mf -> putStrLn $ msg++mf++"."+ Nothing -> return ()+ fail $ ioeGetErrorString e+ ccs [] = []+ ccs cs = " and cc'ed " ++ cs++ when (null [ p | Post p <- thetargets]) sendmail+ nbody <- withOpenTemp $ \ (fh,fn) -> do+ generateEmail fh from (lt [t | SendMail t <- thetargets]) thesubject (getCc opts) body+ hClose fh+ mmapFilePS fn+ forM_ [ p | Post p <- thetargets]+ (\url -> do+ putInfo opts . text $ "Posting patch to " ++ url+ postUrl url (BC.unpack nbody) "message/rfc822")+ `catch` const sendmail+ cleanup opts mailfile+++lt :: [String] -> String+lt [t] = t+lt [t,""] = t+lt (t:ts) = t++" , "++lt ts+lt [] = ""++cleanup :: (FilePathLike t) => [DarcsFlag] -> Maybe t -> IO ()+cleanup opts (Just mailfile) = when (isNothing (getFileopt opts) || (willRemoveLogFile opts)) $+ removeFileMayNotExist mailfile+cleanup _ Nothing = return ()++writeBundleToFile :: forall p C(x y) . (RepoPatch p) => [DarcsFlag] -> FL (PatchInfoAnd p) C(x y) -> Doc ->+ AbsolutePathOrStd -> [WhatToDo] -> String -> IO ()+writeBundleToFile opts to_be_sent bundle fname wtds their_name =+ do (d,f) <- getDescription opts their_name to_be_sent+ let putabs a = do writeDocBinFile a (d $$ bundle)+ putStrLn $ "Wrote patch to " ++ toFilePath a ++ "."+ putstd = putDoc (d $$ bundle)+ useAbsoluteOrStd putabs putstd fname+ let mails = lt [ t | SendMail t <- wtds ]+ unless (null mails) $ putInfo opts $ text $ "The usual recipent for this bundle is: " ++ mails+ cleanup opts f+++data WhatToDo+ = Post String -- ^ POST the patch via HTTP+ | SendMail String -- ^ send patch via email+++decideOnBehavior :: RepoPatch p => [DarcsFlag] -> Maybe (Repository p C(r u t)) -> IO [WhatToDo]+decideOnBehavior opts remote_repo =+ case the_targets of+ [] -> do wtds <- case remote_repo of+ Nothing -> return []+ Just r -> check_post r+ unless (null wtds) $ announce_recipients wtds+ return wtds+ ts -> do announce_recipients ts+ return ts+ where the_targets = collectTargets opts+#ifdef HAVE_HTTP+ -- the ifdef above is to so that darcs only checks the remote+ -- _darcs/post if we have an implementation of postUrl. See+ -- our HTTP module for more details+ check_post the_remote_repo =+ do p <- ((readPost . BC.unpack) `fmap`+ fetchFilePS (prefsUrl the_remote_repo++"/post")+ (MaxAge 600)) `catchall` return []+ emails <- who_to_email the_remote_repo+ return (p++emails)+ readPost p = map pp (lines p) where+ pp ('m':'a':'i':'l':'t':'o':':':s) = SendMail s+ pp s = Post s+#else+ check_post = who_to_email+#endif+ who_to_email the_remote_repo =+ do email <- (BC.unpack `fmap`+ fetchFilePS (prefsUrl the_remote_repo++"/email")+ (MaxAge 600))+ `catchall` return ""+ if '@' `elem` email then return . map SendMail $ lines email+ else return []+ announce_recipients emails =+ let pn (SendMail s) = s+ pn (Post p) = p+ in if DryRun `elem` opts+ then putInfo opts . text $ "Patch bundle would be sent to: "++unwords (map pn emails)+ else when (null the_targets && isNothing (getOutput opts "")) $+ putInfo opts . text $ "Patch bundle will be sent to: "++unwords (map pn emails)++getTargets :: [WhatToDo] -> IO [WhatToDo]+getTargets [] = do fmap ((:[]) . SendMail) $ askUser "What is the target email address? "+getTargets wtds = return wtds++collectTargets :: [DarcsFlag] -> [WhatToDo]+collectTargets flags = [ f t | Target t <- flags ] where+ f url@('h':'t':'t':'p':':':_) = Post url+ f em = SendMail em++getDescription :: RepoPatch p => [DarcsFlag] -> String -> FL (PatchInfoAnd p) C(x y) -> IO (Doc, Maybe String)+getDescription opts their_name patches =+ case get_filename of+ Just f -> do file <- f+ when (EditDescription `elem` opts) $ do+ when (isNothing $ getFileopt opts) $+ writeDocBinFile file patchdesc+ debugMessage $ "About to edit file " ++ file+ (_, changed) <- editFile file+ unless changed $ do+ confirmed <- promptYorn "File content did not change. Continue anyway?"+ unless confirmed $ do putStrLn "Aborted."+ exitWith ExitSuccess+ return ()+ doc <- readDocBinFile file+ return (doc, Just file)+ Nothing -> return (patchdesc, Nothing)+ where patchdesc = text (if lengthFL patches == 1+ then "1 patch"+ else show (lengthFL patches) ++ " patches")+ <+> text "for repository" <+> text their_name <> text ":"+ $$ text ""+ $$ vsep (mapFL description patches)+ get_filename = case getFileopt opts of+ Just f -> Just $ return $ toFilePath f+ Nothing -> if EditDescription `elem` opts+ then Just tempfile+ else Nothing+ tempfile = worldReadableTemp "darcs-temp-mail"++getFileopt :: [DarcsFlag] -> Maybe AbsolutePath+getFileopt (LogFile f:_) = Just f+getFileopt (_:flags) = getFileopt flags+getFileopt [] = Nothing
− src/Darcs/Commands/Send.lhs
@@ -1,451 +0,0 @@-% Copyright (C) 2002-2004 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.--\darcsCommand{send}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP, TypeOperators #-}--module Darcs.Commands.Send ( send ) where-import System.Exit ( exitWith, ExitCode( ExitSuccess ) )-import System.IO.Error ( ioeGetErrorString )-import System.IO ( hClose )-import Control.Monad ( when, unless, forM_ )-import Storage.Hashed.Tree ( Tree )-import Data.Maybe ( isNothing )--import Darcs.Commands ( DarcsCommand(..), putInfo, putVerbose )-import Darcs.Arguments ( DarcsFlag( EditDescription, LogFile,- Target, Context,- DryRun, Quiet, Unified- ), getOutput,- fixUrl, definePatches,- getCc, getAuthor, workingRepoDir,- editDescription, logfile, rmlogfile,- sign, getSubject, depsSel, getInReplyTo,- matchSeveral, setDefault, outputAutoName,- output, ccSend, subject, target, author, sendmailCmd,- inReplyTo, remoteRepo, networkOptions,- allInteractive, getSendmailCmd,- printDryRunMessageAndExit,- summary, allowUnrelatedRepos,- fromOpt, dryRun, sendToContext, getOutput,- changesReverse,- )-import Darcs.Flags ( willRemoveLogFile, doReverse )-import Darcs.Hopefully ( PatchInfoAnd, hopefully, patchDesc )-import Darcs.Repository ( PatchSet, Repository,- amInRepository, identifyRepositoryFor, withRepoReadLock, ($-),- readRepo, readRecorded, prefsUrl, checkUnrelatedRepos )-#ifdef GADT_WITNESSES-import Darcs.Patch.Set ( Origin )-#endif-import Darcs.Patch ( RepoPatch, description, applyToTree, invert )-import Darcs.Witnesses.Ordered ( FL(..), (:>)(..), (:\/:)(..), (:>>)(..),- mapFL, mapFL_FL, lengthFL, nullFL, unsafeCoerceP )-import Darcs.Patch.Bundle ( makeBundleN, scanContext, patchFilename )-import Darcs.Repository.Prefs ( defaultrepo, setDefaultrepo, getPreflist )-import Darcs.External ( signString, sendEmailDoc, fetchFilePS, Cachable(..), generateEmail )-import ByteStringUtils ( mmapFilePS )-import qualified Data.ByteString.Char8 as BC (unpack)-import Darcs.Lock ( withOpenTemp, writeDocBinFile, readDocBinFile, worldReadableTemp, removeFileMayNotExist )-import Darcs.SelectChanges ( selectChanges, WhichChanges(..), selectionContext, runSelection )-import Darcs.Patch.Depends ( findCommonWithThem )-import Darcs.Utils ( askUser, catchall, editFile, formatPath )-import Progress ( debugMessage )-import Darcs.Email ( makeEmail )-import Printer ( Doc, vsep, vcat, text, ($$), (<+>), (<>), putDoc )-import Darcs.RepoPath ( FilePathLike, toFilePath, AbsolutePath, AbsolutePathOrStd,- getCurrentDirectory, useAbsoluteOrStd )-import HTTP ( postUrl )-#include "impossible.h"--#include "gadts.h"--sendDescription :: String-sendDescription =- "Send by email a bundle of one or more patches."--sendHelp :: String-sendHelp =- "Send is used to prepare a bundle of patches that can be applied to a target\n"++- "repository. Send accepts the URL of the repository as an argument. When\n"++- "called without an argument, send will use the most recent repository that\n"++- "was either pushed to, pulled from or sent to. By default, the patch bundle\n"++- "is sent by email, although you may save it to a file.\n"-\end{code}--Do not confuse the \verb!--author! options with the return address-that \verb!darcs send! will set for your patch bundle.--For example, if you have two email addresses A and B:-\begin{description}-\item If you use-\verb!--author A! but your machine is configured to send mail from-address B by default, then the return address on your message will be B.--\item If you use \verb!--from A! and your mail client supports setting the-From: address arbitrarily (some non-Unix-like mail clients, especially,-may not support this), then the return address will be A; if it does-not support this, then the return address will be B.--\item If you supply neither \verb!--from! nor \verb!--author!, then the return-address will be B.-\end{description}--In addition, unless you specify the sendmail command with-\verb!--sendmail-command!, darcs sends email using the default email-command on your computer. This default command is determined by the-\verb!configure! script. Thus, on some non-Unix-like OSes,-\verb!--from! is likely to not work at all.--\begin{code}-send :: DarcsCommand-send = DarcsCommand {commandName = "send",- commandHelp = sendHelp,- commandDescription = sendDescription,- commandExtraArgs = 1,- commandExtraArgHelp = ["[REPOSITORY]"],- commandCommand = sendCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = getPreflist "repos",- commandArgdefaults = defaultrepo,- commandAdvancedOptions = [logfile, rmlogfile,- remoteRepo,- sendToContext, changesReverse] ++- networkOptions,- commandBasicOptions = [matchSeveral, depsSel,- allInteractive,- fromOpt, author,- target,ccSend,subject, inReplyTo,- output,outputAutoName,sign]- ++dryRun++[summary,- editDescription,- setDefault False,- workingRepoDir,- sendmailCmd,- allowUnrelatedRepos]}--sendCmd :: [DarcsFlag] -> [String] -> IO ()-sendCmd input_opts [""] = sendCmd input_opts []-sendCmd input_opts [unfixedrepodir] = withRepoReadLock input_opts $- \repository -> do- context_ps <- the_context input_opts- case context_ps of- Just them -> sendToThem repository input_opts [] "CONTEXT" them- Nothing -> do- repodir <- fixUrl input_opts unfixedrepodir- -- Test to make sure we aren't trying to push to the current repo- here <- getCurrentDirectory- when (repodir == toFilePath here) $- fail ("Can't send to current repository! Did you mean send --context?")- repo <- identifyRepositoryFor repository repodir- them <- readRepo repo- old_default <- getPreflist "defaultrepo"- 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--sendToThem :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> [WhatToDo] -> String -> PatchSet p C(Origin x) -> IO ()-sendToThem repo opts wtds their_name them = do- us <- readRepo repo- common :>> us' <- return $ findCommonWithThem us them- checkUnrelatedRepos opts us them- (case us' of- NilFL -> do putInfo opts $ text "No recorded local changes to send!"- exitWith ExitSuccess- _ -> putVerbose opts $ text "We have the following patches to send:"- $$ (vcat $ mapFL description us')) :: IO ()- pristine <- readRecorded repo- let context = selectionContext "send" opts Nothing []- selector = if doReverse opts- then selectChanges FirstReversed- else selectChanges First- (to_be_sent :> _) <- runSelection (selector us') context- printDryRunMessageAndExit "send" opts to_be_sent- when (nullFL to_be_sent) $ do- putInfo opts $ text "You don't want to send any patches, and that's fine with me!"- exitWith ExitSuccess- definePatches to_be_sent- bundle <- prepareBundle opts common pristine (us':\/:to_be_sent)- let make_fname (tb:>:_) = patchFilename $ patchDesc tb- make_fname _ = impossible- fname = make_fname to_be_sent- outname = getOutput opts fname- case outname of- Just fname' -> writeBundleToFile opts to_be_sent bundle fname' wtds their_name- Nothing -> sendBundle opts to_be_sent bundle fname wtds their_name--prepareBundle :: forall p C(x y z). RepoPatch p => [DarcsFlag] -> PatchSet p C(Origin z)- -> Tree IO -> ((FL (PatchInfoAnd p)) :\/: (FL (PatchInfoAnd p))) C(x y)- -> IO Doc-prepareBundle opts common pristine (us' :\/: to_be_sent) = do- pristine' <- applyToTree (invert $ mapFL_FL hopefully us') pristine- unsig_bundle <- makeBundleN (Just pristine') (unsafeCoerceP common) (mapFL_FL hopefully to_be_sent)- signString opts unsig_bundle--sendBundle :: forall p C(x y) . (RepoPatch p) => [DarcsFlag] -> FL (PatchInfoAnd p) C(x y)- -> Doc -> String -> [WhatToDo] -> String -> IO ()-sendBundle opts to_be_sent bundle fname wtds their_name=- let- auto_subject :: forall pp C(x y) . FL (PatchInfoAnd pp) C(x y) -> String- auto_subject (p:>:NilFL) = "darcs patch: " ++ trim (patchDesc p) 57- auto_subject (p:>:ps) = "darcs patch: " ++ trim (patchDesc p) 43 ++- " (and " ++ show (lengthFL ps) ++ " more)"- auto_subject _ = error "Tried to get a name from empty patch list."- trim st n = if length st <= n then st- else take (n-3) st ++ "..."- in do- thetargets <- getTargets wtds- from <- getAuthor opts- let thesubject = case getSubject opts of- Nothing -> auto_subject to_be_sent- Just subj -> subj- (mailcontents, mailfile) <- getDescription opts their_name to_be_sent- let body = makeEmail their_name- (maybe [] (\x -> [("In-Reply-To", x), ("References", x)]) . getInReplyTo $ opts)- (Just mailcontents)- bundle- (Just fname)- contentAndBundle = Just (mailcontents, bundle)-- sendmail = do- sm_cmd <- getSendmailCmd opts- (sendEmailDoc from (lt [t | SendMail t <- thetargets]) (thesubject) (getCc opts)- sm_cmd contentAndBundle body >>- (putInfo opts . text $ ("Successfully sent patch bundle to: "- ++ lt [ t | SendMail t <- thetargets ]- ++ ccs (getCc opts) ++".")))- `catch` \e -> let msg = "Email body left in " in- do case mailfile of- Just mf -> putStrLn $ msg++mf++"."- Nothing -> return ()- fail $ ioeGetErrorString e- ccs [] = []- ccs cs = " and cc'ed " ++ cs-- when (null [ p | Post p <- thetargets]) sendmail- nbody <- withOpenTemp $ \ (fh,fn) -> do- generateEmail fh from (lt [t | SendMail t <- thetargets]) thesubject (getCc opts) body- hClose fh- mmapFilePS fn- forM_ [ p | Post p <- thetargets]- (\url -> do- putInfo opts . text $ "Posting patch to " ++ url- postUrl url (BC.unpack nbody) "message/rfc822")- `catch` const sendmail- cleanup opts mailfile---lt :: [String] -> String-lt [t] = t-lt [t,""] = t-lt (t:ts) = t++" , "++lt ts-lt [] = ""--cleanup :: (FilePathLike t) => [DarcsFlag] -> Maybe t -> IO ()-cleanup opts (Just mailfile) = when (isNothing (getFileopt opts) || (willRemoveLogFile opts)) $- removeFileMayNotExist mailfile-cleanup _ Nothing = return ()--writeBundleToFile :: forall p C(x y) . (RepoPatch p) => [DarcsFlag] -> FL (PatchInfoAnd p) C(x y) -> Doc ->- AbsolutePathOrStd -> [WhatToDo] -> String -> IO ()-writeBundleToFile opts to_be_sent bundle fname wtds their_name =- do (d,f) <- getDescription opts their_name to_be_sent- let putabs a = do writeDocBinFile a (d $$ bundle)- putStrLn $ "Wrote patch to " ++ toFilePath a ++ "."- putstd = putDoc (d $$ bundle)- useAbsoluteOrStd putabs putstd fname- let mails = lt [ t | SendMail t <- wtds ]- unless (null mails) $ putInfo opts $ text $ "The usual recipent for this bundle is: " ++ mails- cleanup opts f-\end{code}--\begin{options}---output, --to, --cc-\end{options}--The \verb!--output!, \verb!--output-auto-name!, and \verb!--to! flags determine-what darcs does with the patch bundle after creating it. If you provide an-\verb!--output! argument, the patch bundle is saved to that file. If you-specify \verb!--output-auto-name!, the patch bundle is saved to a file with an-automatically generated name. If you give one or more \verb!--to! arguments,-the bundle of patches is sent to those locations. The locations may either be email-addresses or urls that the patch should be submitted to via HTTP.--If you don't provide any of these options, darcs will look at the contents of-the \verb!_darcs/prefs/email! file in the target repository (if it exists), and-send the patch by email to that address. In this case, you may use the-\verb!--cc! option to specify additional recipients without overriding the-default repository email address.--If \texttt{\_darcs/prefs/post} exists in the target repository, darcs will-upload to the URL contained in that file, which may either be a-\texttt{mailto:} URL, or an \texttt{http://} URL. In the latter case, the-patch is posted to that URL.--If there is no email address associated with the repository, darcs will-prompt you for an email address.--\begin{options}---subject-\end{options}--Use the \verb!--subject! flag to set the subject of the e-mail to be sent.-If you don't provide a subject on the command line, darcs will make one up-based on names of the patches in the patch bundle.--\begin{options}---in-reply-to-\end{options}--Use the \verb!--in-reply-to! flag to set the In-Reply-To and References headers-of the e-mail to be sent. By default no additional headers are included so e-mail-will not be treated as reply by mail readers.--\begin{code}--data WhatToDo- = Post String -- ^ POST the patch via HTTP- | SendMail String -- ^ send patch via email---decideOnBehavior :: RepoPatch p => [DarcsFlag] -> Repository p C(r u t) -> IO [WhatToDo]-decideOnBehavior opts the_remote_repo =- case the_targets of- [] -> do wtds <- check_post- unless (null wtds) $ announce_recipients wtds- return wtds- ts -> do announce_recipients ts- return ts- where the_targets = collectTargets opts-#ifdef HAVE_HTTP- -- the ifdef above is to so that darcs only checks the remote- -- _darcs/post if we have an implementation of postUrl. See- -- our HTTP module for more details- check_post = do p <- ((readPost . BC.unpack) `fmap`- fetchFilePS (prefsUrl the_remote_repo++"/post")- (MaxAge 600)) `catchall` return []- emails <- who_to_email- return (p++emails)- readPost p = map pp (lines p) where- pp ('m':'a':'i':'l':'t':'o':':':s) = SendMail s- pp s = Post s-#else- check_post = who_to_email-#endif- who_to_email =- do email <- (BC.unpack `fmap`- fetchFilePS (prefsUrl the_remote_repo++"/email")- (MaxAge 600))- `catchall` return ""- if '@' `elem` email then return . map SendMail $ lines email- else return []- announce_recipients emails =- let pn (SendMail s) = s- pn (Post p) = p- in if DryRun `elem` opts- then putInfo opts . text $ "Patch bundle would be sent to: "++unwords (map pn emails)- else when (null the_targets) $- putInfo opts . text $ "Patch bundle will be sent to: "++unwords (map pn emails)--getTargets :: [WhatToDo] -> IO [WhatToDo]-getTargets [] = do fmap ((:[]) . SendMail) $ askUser "What is the target email address? "-getTargets wtds = return wtds--collectTargets :: [DarcsFlag] -> [WhatToDo]-collectTargets flags = [ f t | Target t <- flags ] where- f url@('h':'t':'t':'p':':':_) = Post url- f em = SendMail em---\end{code}--\begin{options}---matches, --patches, --tags, --no-deps-\end{options}--The \verb!--patches!, \verb!--matches!, \verb!--tags!, and \verb!--no-deps!-options can be used to select which patches to send, as described in-subsection~\ref{selecting}.--\begin{options}---edit-description-\end{options}--If you want to include a description or explanation along with the bundle-of patches, you need to specify the \verb!--edit-description! flag, which-will cause darcs to open up an editor with which you can compose a message-to go along with your patches.--\begin{options}---sendmail-command-\end{options}--If you want to use a command different from the default one for sending email,-you need to specify a command line with the \verb!--sendmail-command! option. The-command line can contain some format specifiers which are replaced by the actual-values. Accepted format specifiers are \verb!%s! for subject, \verb!%t! for to,-\verb!%c! for cc, \verb!%b! for the body of the mail, \verb!%f! for from, \verb!%a!-for the patch bundle and the same specifiers in uppercase for the URL-encoded values.-Additionally you can add \verb!%<! to the end of the command line if the command-expects the complete email message on standard input. E.g.\ the command lines for evolution-and msmtp look like this:--\begin{verbatim}-evolution "mailto:%T?subject=%S&attach=%A&cc=%C&body=%B"-msmtp -t %<-\end{verbatim}--\begin{code}-getDescription :: RepoPatch p => [DarcsFlag] -> String -> FL (PatchInfoAnd p) C(x y) -> IO (Doc, Maybe String)-getDescription opts their_name patches =- case get_filename of- Just f -> do file <- f- when (EditDescription `elem` opts) $ do- when (isNothing $ getFileopt opts) $- writeDocBinFile file patchdesc- debugMessage $ "About to edit file " ++ file- editFile file- return ()- doc <- readDocBinFile file- return (doc, Just file)- Nothing -> return (patchdesc, Nothing)- where patchdesc = text (if lengthFL patches == 1- then "1 patch"- else show (lengthFL patches) ++ " patches")- <+> text "for repository" <+> text their_name <> text ":"- $$ text ""- $$ vsep (mapFL description patches)- get_filename = case getFileopt opts of- Just f -> Just $ return $ toFilePath f- Nothing -> if EditDescription `elem` opts- then Just tempfile- else Nothing- tempfile = worldReadableTemp "darcs-temp-mail"--getFileopt :: [DarcsFlag] -> Maybe AbsolutePath-getFileopt (LogFile f:_) = Just f-getFileopt (_:flags) = getFileopt flags-getFileopt [] = Nothing-\end{code}
+ src/Darcs/Commands/SetPref.hs view
@@ -0,0 +1,108 @@+-- Copyright (C) 2003 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.++{-# LANGUAGE CPP #-}++module Darcs.Commands.SetPref ( setpref ) where++import System.Exit ( exitWith, ExitCode(..) )+import Control.Monad (when)+import Data.Maybe (fromMaybe)++import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Arguments ( DarcsFlag, workingRepoDir, umaskOption )+import Darcs.Repository ( amInHashedRepository, addToPending, withRepoLock, RepoJob(..) )+import Darcs.Patch ( changepref )+import Darcs.Witnesses.Ordered ( FL(..) )+import Darcs.Repository.Prefs ( getPrefval, changePrefval, )+import English ( orClauses )+#include "impossible.h"++-- | A list of all valid preferences for @_darcs/prefs/prefs@.+validPrefData :: [(String, String)] -- ^ (name, one line description)+validPrefData =+ [("test", "a shell command that runs regression tests"),+ ("predist", "a shell command to run before `darcs dist'"),+ ("boringfile", "the path to a version-controlled boring file"),+ ("binariesfile", "the path to a version-controlled binaries file")]++validPrefs :: [String]+validPrefs = map fst validPrefData++setprefDescription :: String+setprefDescription =+ "Set a preference (" ++ orClauses validPrefs ++ ")."++setprefHelp :: String+setprefHelp =+ "When working on project with multiple repositories and contributors,\n" +++ "it is sometimes desirable for a preference to be set consistently\n" +++ "project-wide. This is achieved by treating a preference set with\n" +++ "`darcs setpref' as an unrecorded change, which can then be recorded\n" +++ "and then treated like any other patch.\n" +++ "\n" +++ "Valid preferences are:\n" +++ "\n" +++ unlines [" "++x++" -- "++y | (x,y) <- validPrefData] +++ "\n" +++ "For example, a project using GNU autotools, with a `make test' target\n" +++ "to perform regression tests, might enable Darcs' integrated regression\n" +++ "testing with the following command:\n" +++ "\n" +++ " darcs setpref test 'autoconf && ./configure && make && make test'\n" +++ "\n" +++ "Note that merging is not currently implemented for preferences: if two\n" +++ "patches attempt to set the same preference, the last patch applied to\n" +++ "the repository will always take precedence. This is considered a\n" +++ "low-priority bug, because preferences are seldom set.\n"++setpref :: DarcsCommand+setpref = DarcsCommand {commandProgramName = "darcs",+ commandName = "setpref",+ commandHelp = setprefHelp,+ commandDescription = setprefDescription,+ commandExtraArgs = 2,+ commandExtraArgHelp = ["<PREF>",+ "<VALUE>"],+ commandCommand = setprefCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = return validPrefs,+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [umaskOption],+ commandBasicOptions =+ [workingRepoDir]}++setprefCmd :: [DarcsFlag] -> [String] -> IO ()+setprefCmd opts [pref,val] = withRepoLock opts $ RepoJob $ \repository -> do+ when (' ' `elem` pref) $ do+ putStrLn $ "'"++pref+++ "' is not a valid preference name: no spaces allowed!"+ exitWith $ ExitFailure 1+ when (pref `notElem` validPrefs) $ do+ putStrLn $ "'"++pref++"' is not a valid preference name!"+ putStrLn $ "Try one of: " ++ unwords validPrefs+ exitWith $ ExitFailure 1+ oval <- getPrefval pref+ let old = fromMaybe "" oval+ when ('\n' `elem` val) $ do+ putStrLn $ val ++ "is not a valid preference value: newlines forbidden!"+ exitWith $ ExitFailure 1+ changePrefval pref old val+ putStrLn $ "Changing value of "++pref++" from '"++old++"' to '"++val++"'"+ addToPending repository (changepref pref old val :>: NilFL)+setprefCmd _ _ = impossible+
− src/Darcs/Commands/SetPref.lhs
@@ -1,111 +0,0 @@-% Copyright (C) 2003 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.--\darcsCommand{setpref}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--module Darcs.Commands.SetPref ( setpref ) where--import System.Exit ( exitWith, ExitCode(..) )-import Control.Monad (when)--import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Arguments ( DarcsFlag, workingRepoDir, umaskOption )-import Darcs.Repository ( amInRepository, addToPending, withRepoLock, ($-) )-import Darcs.Patch ( changepref )-import Darcs.Witnesses.Ordered ( FL(..) )-import Darcs.Repository.Prefs ( getPrefval, changePrefval, )-import English ( orClauses )-#include "impossible.h"---- | A list of all valid preferences for @_darcs/prefs/prefs@.-validPrefData :: [(String, String)] -- ^ (name, one line description)-validPrefData =- [("test", "a shell command that runs regression tests"),- ("predist", "a shell command to run before `darcs dist'"),- ("boringfile", "the path to a version-controlled boring file"),- ("binariesfile", "the path to a version-controlled binaries file")]--validPrefs :: [String]-validPrefs = map fst validPrefData--setprefDescription :: String-setprefDescription =- "Set a preference (" ++ orClauses validPrefs ++ ")."--setprefHelp :: String-setprefHelp =- "When working on project with multiple repositories and contributors,\n" ++- "it is sometimes desirable for a preference to be set consistently\n" ++- "project-wide. This is achieved by treating a preference set with\n" ++- "`darcs setpref' as an unrecorded change, which can then be recorded\n" ++- "and then treated like any other patch.\n" ++- "\n" ++- "Valid preferences are:\n" ++- "\n" ++- unlines [" "++x++" -- "++y | (x,y) <- validPrefData] ++- "\n" ++- "For example, a project using GNU autotools, with a `make test' target\n" ++- "to perform regression tests, might enable Darcs' integrated regression\n" ++- "testing with the following command:\n" ++- "\n" ++- " darcs setpref test 'autoconf && ./configure && make && make test'\n" ++- "\n" ++- "Note that merging is not currently implemented for preferences: if two\n" ++- "patches attempt to set the same preference, the last patch applied to\n" ++- "the repository will always take precedence. This is considered a\n" ++- "low-priority bug, because preferences are seldom set.\n"--setpref :: DarcsCommand-setpref = DarcsCommand {commandName = "setpref",- commandHelp = setprefHelp,- commandDescription = setprefDescription,- commandExtraArgs = 2,- commandExtraArgHelp = ["<PREF>",- "<VALUE>"],- commandCommand = setprefCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = return validPrefs,- commandArgdefaults = nodefaults,- commandAdvancedOptions = [umaskOption],- commandBasicOptions =- [workingRepoDir]}--setprefCmd :: [DarcsFlag] -> [String] -> IO ()-setprefCmd opts [pref,val] = withRepoLock opts $- \repository -> do- when (' ' `elem` pref) $ do- putStrLn $ "'"++pref++- "' is not a valid preference name: no spaces allowed!"- exitWith $ ExitFailure 1- when (not $ pref `elem` validPrefs) $ do- putStrLn $ "'"++pref++"' is not a valid preference name!"- putStrLn $ "Try one of: " ++ unwords validPrefs- exitWith $ ExitFailure 1- oval <- getPrefval pref- old <- case oval of Just v -> return v- Nothing -> return ""- when ('\n' `elem` val) $ do- putStrLn $ val ++ "is not a valid preference value: newlines forbidden!"- exitWith $ ExitFailure 1- changePrefval pref old val- putStrLn $ "Changing value of "++pref++" from '"++old++"' to '"++val++"'"- addToPending repository (changepref pref old val :>: NilFL)-setprefCmd _ _ = impossible-\end{code}-
+ src/Darcs/Commands/Show.hs view
@@ -0,0 +1,82 @@+-- Copyright (C) 2002-2004 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.++module Darcs.Commands.Show ( showCommand, list, query ) where++import Darcs.Commands ( DarcsCommand(..),+ CommandControl(CommandData, HiddenCommand),+ commandAlias,+ )+import Darcs.Commands.ShowAuthors ( showAuthors )+import Darcs.Commands.ShowBug ( showBug )+import Darcs.Commands.ShowContents ( showContents )+import Darcs.Commands.ShowFiles ( showFiles, manifestCmd, toListManifest )+import Darcs.Commands.ShowTags ( showTags )+import Darcs.Commands.ShowRepo ( showRepo )+import Darcs.Commands.ShowIndex ( showIndex, showPristineCmd )+import Darcs.Repository ( amInRepository )++showDescription :: String+showDescription = "Show information which is stored by darcs."++showHelp :: String+showHelp =+ "Use the --help option with the subcommands to obtain help for\n"+++ "subcommands (for example, \"darcs show files --help\").\n" +++ "\n" +++ "In previous releases, this command was called `darcs query'.\n" +++ "Currently this is a deprecated alias.\n"++showCommand :: DarcsCommand+showCommand = SuperCommand {commandProgramName = "darcs",+ commandName = "show",+ commandHelp = showHelp,+ commandDescription = showDescription,+ commandPrereq = amInRepository,+ commandSubCommands = [HiddenCommand showBug,+ CommandData showContents,+ CommandData showFiles, HiddenCommand showManifest,+ CommandData showIndex,+ CommandData showPristine,+ CommandData showRepo,+ CommandData showAuthors,+ CommandData showTags]+ }++query :: DarcsCommand+query = commandAlias "query" Nothing showCommand++list :: DarcsCommand+list = commandAlias "list" Nothing showCommand++-- unfortunately, aliases for sub-commands have to live in their parent command+-- to avoid an import cycle+showPristine :: DarcsCommand+showPristine = (commandAlias "pristine" (Just showCommand) showIndex) {+ commandCommand = showPristineCmd,+ commandDescription = "Dump contents of pristine cache.",+ commandHelp =+ "The `darcs show pristine' command lists all version-controlled files " +++ "and directories along with the hashes of their pristine copies. " +++ "For files, the fields correspond to file size, sha256 of the pristine " +++ "file content and the filename." }++showManifest :: DarcsCommand+showManifest = (commandAlias "manifest" (Just showCommand) showFiles) {+ commandCommand = manifestCmd toListManifest+}+
− src/Darcs/Commands/Show.lhs
@@ -1,94 +0,0 @@-% Copyright (C) 2002-2004 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.--\begin{code}-module Darcs.Commands.Show ( showCommand, list, query ) where--import Darcs.Commands ( DarcsCommand(..),- CommandControl(CommandData, HiddenCommand),- commandAlias,- )-import Darcs.Commands.ShowAuthors ( showAuthors )-import Darcs.Commands.ShowBug ( showBug )-import Darcs.Commands.ShowContents ( showContents )-import Darcs.Commands.ShowFiles ( showFiles, manifestCmd, toListManifest )-import Darcs.Commands.ShowTags ( showTags )-import Darcs.Commands.ShowRepo ( showRepo )-import Darcs.Commands.ShowIndex ( showIndex, showPristineCmd )-import Darcs.Repository ( amInRepository )--showDescription :: String-showDescription = "Show information which is stored by darcs."--showHelp :: String-showHelp =- "Use the --help option with the subcommands to obtain help for\n"++- "subcommands (for example, \"darcs show files --help\").\n" ++- "\n" ++- "In previous releases, this command was called `darcs query'.\n" ++- "Currently this is a deprecated alias.\n"--showCommand :: DarcsCommand-showCommand = SuperCommand {commandName = "show",- commandHelp = showHelp,- commandDescription = showDescription,- commandPrereq = amInRepository,- commandSubCommands = [HiddenCommand showBug,- CommandData showContents,- CommandData showFiles, HiddenCommand showManifest,- CommandData showIndex,- CommandData showPristine,- CommandData showRepo,- CommandData showAuthors,- CommandData showTags]- }--query :: DarcsCommand-query = commandAlias "query" Nothing showCommand--list :: DarcsCommand-list = commandAlias "list" Nothing showCommand---- unfortunately, aliases for sub-commands have to live in their parent command--- to avoid an import cycle-showPristine :: DarcsCommand-showPristine = (commandAlias "pristine" (Just showCommand) showIndex) {- commandCommand = showPristineCmd,- commandDescription = "Dump contents of pristine cache.",- commandHelp =- "The `darcs show pristine' command lists all version-controlled files " ++- "and directories along with the hashes of their pristine copies. " ++- "For files, the fields correspond to file size, sha256 of the pristine " ++- "file content and the filename." }--showManifest :: DarcsCommand-showManifest = (commandAlias "manifest" (Just showCommand) showFiles) {- commandCommand = manifestCmd toListManifest-}-\end{code}--\subsection{darcs show}--The show command provides access to several subcommands which can be-used to investigate the state of a repository.--\input{Darcs/Commands/ShowAuthors.lhs}-\input{Darcs/Commands/ShowContents.lhs}-\input{Darcs/Commands/ShowFiles.lhs}-\input{Darcs/Commands/ShowTags.lhs}-\input{Darcs/Commands/ShowRepo.lhs}-
+ src/Darcs/Commands/ShowAuthors.hs view
@@ -0,0 +1,192 @@+-- Copyright (C) 2004-2009 David Roundy, Eric Kow, Simon Michael, Tomas Caithaml+--+-- 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.++module Darcs.Commands.ShowAuthors ( showAuthors ) where++import qualified Ratified( readFile )+import Control.Arrow ((&&&), (***))+import Data.List ( isInfixOf, sortBy, groupBy, group, sort)+import Data.Ord (comparing)+import Data.Char ( toLower, isSpace )+import Data.Maybe( isJust )+import Text.ParserCombinators.Parsec hiding (lower, count, Line)+import Text.ParserCombinators.Parsec.Error+import Text.Regex ( Regex, mkRegexWithOpts, matchRegex )++import Darcs.Arguments ( DarcsFlag(..), workingRepoDir )+import Darcs.Commands ( DarcsCommand(..), nodefaults, putWarning )+import Darcs.External ( viewDoc )+import Darcs.Patch.PatchInfoAnd ( info )+import Darcs.Repository ( amInRepository, readRepo, withRepository, RepoJob(..) )+import Darcs.Patch.Info ( piAuthor )+import Darcs.Patch.Set ( newset2RL )+import Darcs.Witnesses.Ordered ( mapRL )+import Printer ( text )+import Data.Function (on)++data Spelling = Spelling String String [Regex] -- name, email, regexps+type ParsedLine = Maybe Spelling -- Nothing for blank lines+++showAuthorsDescription :: String+showAuthorsDescription = "List authors by patch count."++showAuthorsHelp :: String+showAuthorsHelp =+ "The `darcs show authors' command lists the authors of the current\n" +++ "repository, sorted by the number of patches contributed. With the\n" +++ "--verbose option, this command simply lists the author of each patch\n" +++ "(without aggregation or sorting).\n" +++ "\n" +++ "An author's name or email address may change over time. To tell Darcs\n" +++ "when multiple author strings refer to the same individual, create an\n" +++ "`.authorspellings' file in the root of the working tree. Each line in\n" +++ "this file begins with an author's canonical name and address, and may\n" +++ "be followed by a comma separated list of extended regular expressions.\n" +++ "Blank lines and lines beginning with two hyphens are ignored.\n" +++ "The format of .authorspelling can be described by this pattern:\n" +++ "\n" +++ " name <address> [, regexp ]*\n" +++ "\n" +++ "There are some pitfalls concerning special characters:\n" +++ "Whitespaces are stripped, if you need space in regexp use [ ]. \n" +++ "Because comma serves as a separator you have to escape it if you want\n" +++ "it in regexp. Note that .authorspelingfile use extended regular\n" +++ "expressions so +, ? and so on are metacharacters and you need to \n" +++ "escape them to be interpreted literally.\n" +++ "\n" +++ "Any patch with an author string that matches the canonical address or\n" +++ "any of the associated regexps is considered to be the work of that\n" +++ "author. All matching is case-insensitive and partial (it can match a\n" +++ "substring). Use ^,$ to match the whole string in regexps\n" +++ "\n" +++ "Currently this canonicalization step is done only in `darcs show\n" +++ "authors'. Other commands, such as `darcs changes' use author strings\n" +++ "verbatim.\n" +++ "\n" +++ "An example .authorspelling file is:\n" +++ "\n" +++ " -- This is a comment.\n" +++ " Fred Nurk <fred@example.com>\n" +++ " John Snagge <snagge@bbc.co.uk>, John, snagge@, js@(si|mit).edu\n" +++ " Chuck Jones\\, Jr. <chuck@pobox.com>, cj\\+user@example.com\n"++showAuthors :: DarcsCommand+showAuthors = DarcsCommand {+ commandProgramName = "darcs",+ commandName = "authors",+ commandHelp = showAuthorsHelp,+ commandDescription = showAuthorsDescription,+ commandExtraArgs = 0,+ commandExtraArgHelp = [],+ commandCommand = authorsCmd,+ commandPrereq = amInRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [],+ commandBasicOptions = [workingRepoDir] }++authorsCmd :: [DarcsFlag] -> [String] -> IO ()+authorsCmd opts _ = withRepository opts $ RepoJob $ \repository -> do+ patches <- readRepo repository+ spellings <- compiledAuthorSpellings opts+ let authors = mapRL (piAuthor . info) $ newset2RL patches+ viewDoc $ text $ unlines $+ if Verbose `elem` opts+ then authors+ else -- A list of the form ["<count> <canonical name>"]...++ -- Turn the final result into a list of strings.+ map (\ (count, name) -> show count ++ "\t" ++ name) $+ -- Sort by descending patch count.+ reverse $ sortBy (comparing fst) $+ -- Combine duplicates from a list [(count, canonized name)]+ -- with duplicates canonized names (see next comment).+ map ((sum *** head) . unzip) $+ groupBy ((==) `on` snd) $+ sortBy (comparing snd) $+ -- Because it would take a long time to canonize "foo" into+ -- "foo <foo@bar.baz>" once per patch, the code below+ -- generates a list [(count, canonized name)].+ map (length &&& (canonizeAuthor spellings . head)) $+ group $ sort authors++canonizeAuthor :: [Spelling] -> String -> String+canonizeAuthor spells author = getName canonicals+ where+ getName [] = author+ getName ((Spelling name email _):_) = name ++ " <" ++ email ++ ">"+ canonicals = filter (ismatch author) spells+ ismatch s (Spelling _ mail regexps) =+ s `correspondsTo` mail || any (s `contains_regex`) regexps+ contains_regex a r = isJust $ matchRegex r a+ correspondsTo a b = lower b `isInfixOf` lower a+ lower = map toLower++compiledAuthorSpellings :: [DarcsFlag] -> IO [Spelling]+compiledAuthorSpellings opts = do+ let as_file = ".authorspellings"+ contents <- (Ratified.readFile -- never unlinked from within darcs+ as_file `catch` (\_ -> return ""))+ let parse_results = map (parse sentence as_file) $ lines contents+ clean 1 parse_results+ where+ clean :: Int -> [Either ParseError ParsedLine] -> IO [Spelling]+ clean _ [] = return []+ -- print parse error+ clean n ((Left err):xs) = do+ let npos = setSourceLine (errorPos err) n+ putWarning opts . text . show $ setErrorPos npos err+ clean (n+1) xs+ -- skip blank line+ clean n ((Right Nothing):xs) = clean (n+1) xs+ -- unwrap Spelling+ clean n ((Right (Just a):xs)) = do+ as <- clean (n+1) xs+ return (a:as)++----------+-- PARSERS++sentence :: Parser ParsedLine+sentence = spaces >> (comment <|> blank <|> addressline)+ where+ comment = string "--" >> return Nothing+ blank = eof >> return Nothing++addressline :: Parser ParsedLine+addressline = do+ name <- canonicalName <?> "Canonical name"+ addr <- between (char '<') (char '>') (many1 (noneOf ">")) <?> "Address"+ spaces+ rest <- option [] (char ',' >> regexp `sepBy` char ',') <?> "List of regexps"+ return $ Just $ Spelling (strip name) addr (compile rest)+ where+ strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse+ makeRegex s = mkRegexWithOpts s True False+ compile = map makeRegex . filter (not . null) . map strip++regexp :: Parser String+regexp = many1 p <?> "Regular expression"+ where p = try (string "\\," >> return ',')+ <|> noneOf ","++canonicalName :: Parser String+canonicalName = many1 p+ where p = try (string "\\," >> return ',')+ <|> noneOf ",<"+
− src/Darcs/Commands/ShowAuthors.lhs
@@ -1,194 +0,0 @@-% Copyright (C) 2004-2009 David Roundy, Eric Kow, Simon Michael, Tomas Caithaml-%-% 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.--\darcsCommand{show authors}-\begin{code}-module Darcs.Commands.ShowAuthors ( showAuthors ) where--import qualified Ratified( readFile )-import Control.Arrow ((&&&), (***))-import Data.List ( isInfixOf, sortBy, groupBy, group, sort)-import Data.Ord (comparing)-import Data.Char ( toLower, isSpace )-import Data.Maybe( isJust )-import Text.ParserCombinators.Parsec hiding (lower, count, Line)-import Text.ParserCombinators.Parsec.Error-import Text.Regex ( Regex, mkRegexWithOpts, matchRegex )--import Darcs.Arguments ( DarcsFlag(..), workingRepoDir )-import Darcs.Commands ( DarcsCommand(..), nodefaults, putWarning )-import Darcs.External ( viewDoc )-import Darcs.Hopefully ( info )-import Darcs.Repository ( amInRepository, readRepo, withRepository, ($-) )-import Darcs.Patch.Info ( piAuthor )-import Darcs.Patch.Set ( newset2RL )-import Darcs.Witnesses.Ordered ( mapRL, concatRL )-import Printer ( text )-import Data.Function (on)--data Spelling = Spelling String String [Regex] -- name, email, regexps-type ParsedLine = Maybe Spelling -- Nothing for blank lines---showAuthorsDescription :: String-showAuthorsDescription = "List authors by patch count."--showAuthorsHelp :: String-showAuthorsHelp =- "The `darcs show authors' command lists the authors of the current\n" ++- "repository, sorted by the number of patches contributed. With the\n" ++- "--verbose option, this command simply lists the author of each patch\n" ++- "(without aggregation or sorting).\n" ++- "\n" ++- "An author's name or email address may change over time. To tell Darcs\n" ++- "when multiple author strings refer to the same individual, create an\n" ++- "`.authorspellings' file in the root of the working tree. Each line in\n" ++- "this file begins with an author's canonical name and address, and may\n" ++- "be followed by a comma separated list of extended regular expressions.\n" ++- "Blank lines and lines beginning with two hyphens are ignored.\n" ++- "The format of .authorspelling can be described by this pattern:\n" ++- "\n" ++- " name <address> [, regexp ]*\n" ++- "\n" ++- "There are some pitfalls concerning special characters:\n" ++- "Whitespaces are stripped, if you need space in regexp use [ ]. \n" ++- "Because comma serves as a separator you have to escape it if you want\n" ++- "it in regexp. Note that .authorspelingfile use extended regular\n" ++- "expressions so +, ? and so on are metacharacters and you need to \n" ++- "escape them to be interpreted literally.\n" ++- "\n" ++- "Any patch with an author string that matches the canonical address or\n" ++- "any of the associated regexps is considered to be the work of that\n" ++- "author. All matching is case-insensitive and partial (it can match a\n" ++- "substring). Use ^,$ to match the whole string in regexps\n" ++- "\n" ++- "Currently this canonicalization step is done only in `darcs show\n" ++- "authors'. Other commands, such as `darcs changes' use author strings\n" ++- "verbatim.\n" ++- "\n" ++- "An example .authorspelling file is:\n" ++- "\n" ++- " -- This is a comment.\n" ++- " Fred Nurk <fred@example.com>\n" ++- " John Snagge <snagge@bbc.co.uk>, John, snagge@, js@(si|mit).edu\n" ++- " Chuck Jones\\, Jr. <chuck@pobox.com>, cj\\+user@example.com\n"--showAuthors :: DarcsCommand-showAuthors = DarcsCommand {- commandName = "authors",- commandHelp = showAuthorsHelp,- commandDescription = showAuthorsDescription,- commandExtraArgs = 0,- commandExtraArgHelp = [],- commandCommand = authorsCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [],- commandBasicOptions = [workingRepoDir] }--authorsCmd :: [DarcsFlag] -> [String] -> IO ()-authorsCmd opts _ = withRepository opts $- \repository -> do- patches <- readRepo repository- spellings <- compiledAuthorSpellings opts- let authors = mapRL (piAuthor . info) $ newset2RL patches- viewDoc $ text $ unlines $- if Verbose `elem` opts- then authors- else -- A list of the form ["<count> <canonical name>"]...-- -- Turn the final result into a list of strings.- map (\ (count, name) -> show count ++ "\t" ++ name) $- -- Sort by descending patch count.- reverse $ sortBy (comparing fst) $- -- Combine duplicates from a list [(count, canonized name)]- -- with duplicates canonized names (see next comment).- map ((sum *** head) . unzip) $- groupBy ((==) `on` snd) $- sortBy (comparing snd) $- -- Because it would take a long time to canonize "foo" into- -- "foo <foo@bar.baz>" once per patch, the code below- -- generates a list [(count, canonized name)].- map (length &&& (canonizeAuthor spellings . head)) $- group $ sort authors--canonizeAuthor :: [Spelling] -> String -> String-canonizeAuthor spells author = getName canonicals- where- getName [] = author- getName ((Spelling name email _):_) = name ++ " <" ++ email ++ ">"- canonicals = filter (ismatch author) spells- ismatch s (Spelling _ mail regexps) =- s `correspondsTo` mail || any (s `contains_regex`) regexps- contains_regex a r = isJust $ matchRegex r a- correspondsTo a b = lower b `isInfixOf` lower a- lower = map toLower--compiledAuthorSpellings :: [DarcsFlag] -> IO [Spelling]-compiledAuthorSpellings opts = do- let as_file = ".authorspellings"- contents <- (Ratified.readFile -- never unlinked from within darcs- as_file `catch` (\_ -> return ""))- let parse_results = map (parse sentence as_file) $ lines contents- clean 1 parse_results- where- clean :: Int -> [Either ParseError ParsedLine] -> IO [Spelling]- clean _ [] = return []- -- print parse error- clean n ((Left err):xs) = do- let npos = setSourceLine (errorPos err) n- putWarning opts . text . show $ setErrorPos npos err- clean (n+1) xs- -- skip blank line- clean n ((Right Nothing):xs) = clean (n+1) xs- -- unwrap Spelling- clean n ((Right (Just a):xs)) = do- as <- clean (n+1) xs- return (a:as)--------------- PARSERS--sentence :: Parser ParsedLine-sentence = spaces >> (comment <|> blank <|> addressline)- where- comment = string "--" >> return Nothing- blank = eof >> return Nothing--addressline :: Parser ParsedLine-addressline = do- name <- canonicalName <?> "Canonical name"- addr <- between (char '<') (char '>') (many1 (noneOf ">")) <?> "Address"- spaces- rest <- option [] (char ',' >> regexp `sepBy` char ',') <?> "List of regexps"- return $ Just $ Spelling (strip name) addr (compile rest)- where- strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse- makeRegex s = mkRegexWithOpts s True False- compile = map makeRegex . filter (not . null) . map strip--regexp :: Parser String-regexp = many1 p <?> "Regular expression"- where p = try (string "\\," >> return ',')- <|> noneOf ","--canonicalName :: Parser String-canonicalName = many1 p- where p = try (string "\\," >> return ',')- <|> noneOf ",<"--\end{code}
+ src/Darcs/Commands/ShowBug.hs view
@@ -0,0 +1,51 @@+-- Copyright (C) 2007 Eric Kow+--+-- 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 CPP #-}++module Darcs.Commands.ShowBug ( showBug ) where++import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Arguments ( DarcsFlag, workingRepoDir )+import Darcs.Repository ( findRepository )+#include "impossible.h"++showBugDescription :: String+showBugDescription = "Simulate a run-time failure."++showBugHelp :: String+showBugHelp =+ "Show bug can be used to see what darcs would show you if you encountered.\n"+ ++"a bug in darcs.\n"++showBug :: DarcsCommand+showBug = DarcsCommand {commandProgramName = "darcs",+ commandName = "bug",+ commandHelp = showBugHelp,+ commandDescription = showBugDescription,+ commandExtraArgs = 0,+ commandExtraArgHelp = [],+ commandCommand = showBugCmd,+ commandPrereq = findRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [],+ commandBasicOptions = [workingRepoDir]}++showBugCmd :: [DarcsFlag] -> [String] -> IO ()+showBugCmd _ _ = bug "This is actually a fake bug in darcs."+
− src/Darcs/Commands/ShowBug.lhs
@@ -1,53 +0,0 @@-% Copyright (C) 2007 Eric Kow-%-% 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.--\darcsCommand{show bug}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--module Darcs.Commands.ShowBug ( showBug ) where--import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Arguments ( DarcsFlag, workingRepoDir )-import Darcs.Repository ( findRepository )-#include "impossible.h"--showBugDescription :: String-showBugDescription = "Simulate a run-time failure."--showBugHelp :: String-showBugHelp =- "Show bug can be used to see what darcs would show you if you encountered.\n"- ++"a bug in darcs.\n"--showBug :: DarcsCommand-showBug = DarcsCommand {commandName = "bug",- commandHelp = showBugHelp,- commandDescription = showBugDescription,- commandExtraArgs = 0,- commandExtraArgHelp = [],- commandCommand = showBugCmd,- commandPrereq = findRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [],- commandBasicOptions = [workingRepoDir]}--showBugCmd :: [DarcsFlag] -> [String] -> IO ()-showBugCmd _ _ = bug "This is actually a fake bug in darcs."-\end{code}
+ src/Darcs/Commands/ShowContents.hs view
@@ -0,0 +1,90 @@+-- Copyright (C) 2007 Eric Kow+--+-- 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.++module Darcs.Commands.ShowContents ( showContents ) where++import Control.Monad ( filterM, forM_, forM, unless )+import Control.Monad.Trans( liftIO )+import System.IO ( stdout )+import Data.Maybe( fromJust )++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL++import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Arguments ( DarcsFlag, matchOne,+ workingRepoDir, fixSubPaths )+import Darcs.RepoPath ( sp2fn, toFilePath )+import Darcs.Patch.FileName( FileName, fp2fn )+import Darcs.Patch.ApplyMonad ( mReadFilePS, withFiles )+import Darcs.Patch.Match( Matcher )+import Darcs.Match ( haveNonrangeMatch, applyInvToMatcher, nonrangeMatcher+ , InclusiveOrExclusive(..), matchExists )+import Darcs.Repository ( withRepository, RepoJob(..), findRepository, readRepo, readRecorded )+import Darcs.Patch( RepoPatch )+import qualified Storage.Hashed.Monad as HSM+import Storage.Hashed.AnchoredPath( floatPath, anchorPath )++showContentsDescription :: String+showContentsDescription = "Outputs a specific version of a file."++showContentsHelp :: String+showContentsHelp =+ "Show contents can be used to display an earlier version of some file(s).\n"+++ "If you give show contents no version arguments, it displays the recorded\n"+++ "version of the file(s).\n"++showContents :: DarcsCommand+showContents = DarcsCommand {commandProgramName = "darcs",+ commandName = "contents",+ commandHelp = showContentsHelp,+ commandDescription = showContentsDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp+ = ["[FILE]..."],+ commandCommand = showContentsCmd,+ commandPrereq = findRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [],+ commandBasicOptions = [matchOne, workingRepoDir]}++getMatcher :: (RepoPatch p) => [DarcsFlag] -> Matcher p+getMatcher = fromJust . nonrangeMatcher++showContentsCmd :: [DarcsFlag] -> [String] -> IO ()+showContentsCmd _ [] = fail+ "show contents needs at least one argument."+showContentsCmd opts args = withRepository opts $ RepoJob $ \repository -> do+ path_list <- map sp2fn `fmap` fixSubPaths opts args+ pristine <- readRecorded repository+ let matcher = getMatcher opts+ unapply_to_match = applyInvToMatcher Exclusive matcher+ unapply <- if (haveNonrangeMatch opts)+ then do patchset <- readRepo repository+ unless (matchExists matcher patchset) $+ fail $ "Couldn't match pattern " ++ show matcher+ return (unapply_to_match patchset)+ else return (return ())+ let dump :: HSM.TreeIO [(FileName, B.ByteString)]+ dump = do okpaths <- filterM HSM.fileExists $ map (floatPath . toFilePath) path_list+ forM okpaths $ \f -> do content <- HSM.readFile f+ return (fp2fn $ ("./" ++) $ anchorPath "" f, B.concat $ BL.toChunks content)+ files <- flip withFiles unapply `fmap` fst `fmap` HSM.virtualTreeIO dump pristine+ forM_ files $ \(_, f) -> B.hPut stdout f+ return ()+
− src/Darcs/Commands/ShowContents.lhs
@@ -1,86 +0,0 @@-% Copyright (C) 2007 Eric Kow-%-% 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.--\darcsCommand{show contents}-\begin{code}-module Darcs.Commands.ShowContents ( showContents ) where--import Control.Monad ( filterM, forM_, unless )-import Control.Monad.Trans( liftIO )-import System.IO ( stdout )-import Data.Maybe( fromJust )--import qualified Data.ByteString as B--import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Arguments ( DarcsFlag, matchOne,- workingRepoDir, fixSubPaths )-import Darcs.RepoPath ( sp2fn )-import Darcs.IO ( mReadFilePS, mDoesFileExist )-import Darcs.Patch.Match( Matcher )-import Darcs.Match ( haveNonrangeMatch, applyInvToMatcher, nonrangeMatcher- , InclusiveOrExclusive(..), matchExists )-import Darcs.Repository ( withRepository, ($-), findRepository, readRepo, readRecorded )-import Darcs.Patch( RepoPatch )-import Storage.Hashed.Monad( virtualTreeIO )--showContentsDescription :: String-showContentsDescription = "Outputs a specific version of a file."--showContentsHelp :: String-showContentsHelp =- "Show contents can be used to display an earlier version of some file(s).\n"++- "If you give show contents no version arguments, it displays the recorded\n"++- "version of the file(s).\n"--showContents :: DarcsCommand-showContents = DarcsCommand {commandName = "contents",- commandHelp = showContentsHelp,- commandDescription = showContentsDescription,- commandExtraArgs = -1,- commandExtraArgHelp- = ["[FILE]..."],- commandCommand = showContentsCmd,- commandPrereq = findRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [],- commandBasicOptions = [matchOne, workingRepoDir]}--getMatcher :: (RepoPatch p) => [DarcsFlag] -> Matcher p-getMatcher = fromJust . nonrangeMatcher--showContentsCmd :: [DarcsFlag] -> [String] -> IO ()-showContentsCmd _ [] = fail- "show contents needs at least one argument."-showContentsCmd opts args = withRepository opts $- \repository -> do- path_list <- map sp2fn `fmap` fixSubPaths opts args- pristine <- readRecorded repository- let matcher = getMatcher opts- unapply_to_match = applyInvToMatcher Exclusive matcher- matched <- if (haveNonrangeMatch opts)- then do patchset <- readRepo repository- unless (matchExists matcher patchset) $- fail $ "Couldn't match pattern " ++ show matcher- snd `fmap` virtualTreeIO (unapply_to_match patchset) pristine- else return pristine- let dump = do okpaths <- filterM mDoesFileExist path_list- forM_ okpaths $ \f -> do content <- mReadFilePS f- liftIO (B.hPut stdout content)- virtualTreeIO dump matched- return ()-\end{code}
+ src/Darcs/Commands/ShowFiles.hs view
@@ -0,0 +1,121 @@+-- Copyright (C) 2005 Florian Weimer+--+-- 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 CPP #-}+#include "gadts.h"+module Darcs.Commands.ShowFiles ( showFiles+ , manifestCmd, toListManifest -- for alias+ ) where+import Darcs.Arguments ( DarcsFlag(..), workingRepoDir,+ files, directories, pending, nullFlag, matchOne )+import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Repository ( Repository, amInRepository, withRepository,+ RepoJob(..) )+import Darcs.Patch ( RepoPatch )+import Darcs.Repository.State ( readRecorded, readRecordedAndPending )+import Storage.Hashed.Tree( Tree, TreeItem(..), list, expand )+import Storage.Hashed.AnchoredPath( anchorPath )+import Storage.Hashed.Plain( readPlainTree )++import Data.List( isPrefixOf )++import Darcs.Match ( haveNonrangeMatch, getNonrangeMatch )+import Darcs.Lock ( withDelayedDir )+showFilesDescription :: String+showFilesDescription = "Show version-controlled files in the working copy."++showFilesHelp :: String+showFilesHelp =+ "The `darcs show files' command lists those files and directories in\n" +++ "the working tree that are under version control. This command is\n" +++ "primarily for scripting purposes; end users will probably want `darcs\n" +++ "whatsnew --summary'.\n" +++ "\n" +++ "A file is `pending' if it has been added but not recorded. By\n" +++ "default, pending files (and directories) are listed; the --no-pending\n" +++ "option prevents this.\n" +++ "\n" +++ "By default `darcs show files' lists both files and directories, but\n" +++ "the alias `darcs show manifest' only lists files. The --files,\n" +++ "--directories, --no-files and --no-directories modify this behaviour.\n" +++ "\n" +++ "By default entries are one-per-line (i.e. newline separated). This\n" +++ "can cause problems if the files themselves contain newlines or other\n" +++ "control characters. To get aroudn this, the --null option uses the\n" +++ "null character instead. The script interpreting output from this\n" +++ "command needs to understand this idiom; `xargs -0' is such a command.\n" +++ "\n" +++ "For example, to list version-controlled files by size:\n" +++ "\n" +++ " darcs show files -0 | xargs -0 ls -ldS\n"++showFiles :: DarcsCommand+showFiles = DarcsCommand {+ commandProgramName = "darcs",+ commandName = "files",+ commandHelp = showFilesHelp,+ commandDescription = showFilesDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["[FILE or DIRECTORY]..."],+ commandCommand = manifestCmd toListFiles,+ commandPrereq = amInRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [],+ commandBasicOptions = [files, directories, pending, nullFlag, matchOne,+ workingRepoDir] }++toListFiles, toListManifest :: [DarcsFlag] -> Tree m -> [FilePath]+toListFiles opts = filesDirs (NoFiles `notElem` opts) (NoDirectories `notElem` opts)+toListManifest opts = filesDirs (NoFiles `notElem` opts) (Directories `elem` opts)++filesDirs :: Bool -> Bool -> Tree m -> [FilePath]+filesDirs False False _ = []+filesDirs False True t = "." : [ anchorPath "." p | (p, SubTree _) <- list t ]+filesDirs True False t = [ anchorPath "." p | (p, File _) <- list t ]+filesDirs True True t = "." : (map (anchorPath "." . fst) $ list t)++manifestCmd :: ([DarcsFlag] -> Tree IO -> [FilePath]) -> [DarcsFlag] -> [String] -> IO ()+manifestCmd to_list opts argList = do+ list' <- (to_list opts) `fmap` withRepository opts (RepoJob myslurp)+ case argList of+ [] -> mapM_ output list'+ prefixes -> mapM_ output (onlysubdirs prefixes list')+ where myslurp :: RepoPatch p => Repository p C(r u r) -> IO (Tree IO)+ myslurp r = do let fRevisioned = haveNonrangeMatch opts+ fPending = Pending `elem` opts+ fNoPending = NoPending `elem` opts+ -- this covers all 8 options+ expand =<< case (fRevisioned,fPending,fNoPending) of+ (True,False,_) -> slurpRevision opts r+ (True,True,_) -> error $ "can't mix revisioned and pending flags"+ (False,False,True) -> readRecorded r+ (False,_,False) -> readRecordedAndPending r -- pending is default+ (False,True,True) -> error $ "can't mix pending and no-pending flags"+ output_null name = do { putStr name ; putChar '\0' }+ output = if NullFlag `elem` opts then output_null else putStrLn+ isParentDir a b = a == b+ || (a ++ "/") `isPrefixOf` b+ || ("./" ++ a ++ "/") `isPrefixOf` b+ || "./" ++ a == b+ onlysubdirs suffixes = filter $ or . mapM isParentDir suffixes++slurpRevision :: RepoPatch p => [DarcsFlag] -> Repository p C(r u r) -> IO (Tree IO)+slurpRevision opts r = withDelayedDir "revisioned.showfiles" $ \_ -> do+ getNonrangeMatch r opts+ expand =<< readPlainTree "."+
− src/Darcs/Commands/ShowFiles.lhs
@@ -1,124 +0,0 @@-% Copyright (C) 2005 Florian Weimer-%-% 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.--\darcsCommand{show files}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}-#include "gadts.h"-module Darcs.Commands.ShowFiles ( showFiles- , manifestCmd, toListManifest -- for alias- ) where-import Darcs.Arguments ( DarcsFlag(..), workingRepoDir,- files, directories, pending, nullFlag, matchOne )-import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Repository ( Repository, amInRepository, withRepository )-import Darcs.Patch ( RepoPatch )-import Darcs.Repository.State ( readRecorded, readRecordedAndPending )-import Storage.Hashed.Tree( Tree, TreeItem(..), list, expand )-import Storage.Hashed.AnchoredPath( anchorPath )-import Storage.Hashed.Plain( readPlainTree )--import Data.List( isPrefixOf )--import Darcs.Match ( haveNonrangeMatch, getNonrangeMatch )-import Darcs.Lock ( withDelayedDir )-showFilesDescription :: String-showFilesDescription = "Show version-controlled files in the working copy."--showFilesHelp :: String-showFilesHelp =- "The `darcs show files' command lists those files and directories in\n" ++- "the working tree that are under version control. This command is\n" ++- "primarily for scripting purposes; end users will probably want `darcs\n" ++- "whatsnew --summary'.\n" ++- "\n" ++- "A file is `pending' if it has been added but not recorded. By\n" ++- "default, pending files (and directories) are listed; the --no-pending\n" ++- "option prevents this.\n" ++- "\n" ++- "By default `darcs show files' lists both files and directories, but\n" ++- "the alias `darcs show manifest' only lists files. The --files,\n" ++- "--directories, --no-files and --no-directories modify this behaviour.\n" ++- "\n" ++- "By default entries are one-per-line (i.e. newline separated). This\n" ++- "can cause problems if the files themselves contain newlines or other\n" ++- "control characters. To get aroudn this, the --null option uses the\n" ++- "null character instead. The script interpreting output from this\n" ++- "command needs to understand this idiom; `xargs -0' is such a command.\n" ++- "\n" ++- "For example, to list version-controlled files by size:\n" ++- "\n" ++- " darcs show files -0 | xargs -0 ls -ldS\n"--showFiles :: DarcsCommand-showFiles = DarcsCommand {- commandName = "files",- commandHelp = showFilesHelp,- commandDescription = showFilesDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["[FILE or DIRECTORY]..."],- commandCommand = manifestCmd toListFiles,- commandPrereq = amInRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [],- commandBasicOptions = [files, directories, pending, nullFlag, matchOne,- workingRepoDir] }--toListFiles, toListManifest :: [DarcsFlag] -> Tree m -> [FilePath]-toListFiles opts = filesDirs (NoFiles `notElem` opts) (NoDirectories `notElem` opts)-toListManifest opts = filesDirs (NoFiles `notElem` opts) (Directories `elem` opts)--filesDirs :: Bool -> Bool -> Tree m -> [FilePath]-filesDirs False False _ = []-filesDirs False True t = "." : [ anchorPath "." p | (p, SubTree _) <- list t ]-filesDirs True False t = [ anchorPath "." p | (p, File _) <- list t ]-filesDirs True True t = "." : (map (anchorPath "." . fst) $ list t)--manifestCmd :: ([DarcsFlag] -> Tree IO -> [FilePath]) -> [DarcsFlag] -> [String] -> IO ()-manifestCmd to_list opts argList = do- list <- (to_list opts) `fmap` withRepository opts myslurp- case argList of- [] -> mapM_ output list- prefixes -> mapM_ output (onlysubdirs prefixes list)- where myslurp :: RepoPatch p => Repository p C(r u r) -> IO (Tree IO)- myslurp r = do let fRevisioned = haveNonrangeMatch opts- fPending = Pending `elem` opts- fNoPending = NoPending `elem` opts- -- this covers all 8 options- expand =<< case (fRevisioned,fPending,fNoPending) of- (True,False,_) -> slurpRevision opts r- (True,True,_) -> error $ "can't mix revisioned and pending flags"- (False,False,True) -> readRecorded r- (False,_,False) -> readRecordedAndPending r -- pending is default- (False,True,True) -> error $ "can't mix pending and no-pending flags"- output_null name = do { putStr name ; putChar '\0' }- output = if NullFlag `elem` opts then output_null else putStrLn- isParentDir a b = a == b- || (a ++ "/") `isPrefixOf` b- || ("./" ++ a ++ "/") `isPrefixOf` b- || "./" ++ a == b- onlysubdirs suffixes = filter $ or . mapM isParentDir suffixes--slurpRevision :: RepoPatch p => [DarcsFlag] -> Repository p C(r u r) -> IO (Tree IO)-slurpRevision opts r = withDelayedDir "revisioned.showfiles" $ \_ -> do- getNonrangeMatch r opts- expand =<< readPlainTree "."---\end{code}
+ src/Darcs/Commands/ShowIndex.hs view
@@ -0,0 +1,84 @@+-- Copyright (C) 2009 Petr Rockai+--+-- Permission is hereby granted, free of charge, to any person+-- obtaining a copy of this software and associated documentation+-- files (the "Software"), to deal in the Software without+-- restriction, including without limitation the rights to use, copy,+-- modify, merge, publish, distribute, sublicense, and/or sell copies+-- of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be+-- included in all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+-- BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+-- ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+-- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+-- SOFTWARE.++{-# LANGUAGE CPP #-}+#include "gadts.h"+module Darcs.Commands.ShowIndex ( showIndex+ , showPristineCmd -- for alias+ ) where+import Darcs.Arguments ( DarcsFlag(..), workingRepoDir,+ files, directories, nullFlag )+import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Repository ( amInRepository, withRepository, RepoJob(..), readIndex )+import Darcs.Repository.State ( readRecorded )++import Storage.Hashed( floatPath )+import Storage.Hashed.Hash( encodeBase16, Hash( NoHash ) )+import Storage.Hashed.Tree( list, expand, itemHash, Tree, TreeItem( SubTree ) )+import Storage.Hashed.Index( updateIndex )+import Storage.Hashed.AnchoredPath( anchorPath )++import qualified Data.ByteString.Char8 as BS++showIndex :: DarcsCommand+showIndex = DarcsCommand {+ commandProgramName = "darcs",+ commandName = "index",+ commandDescription = "Dump contents of working tree index.",+ commandHelp =+ "The `darcs show index' command lists all version-controlled files and " +++ "directories along with their hashes as stored in _darcs/index. " +++ "For files, the fields correspond to file size, sha256 of the current " +++ "file content and the filename.",+ commandExtraArgs = 0,+ commandExtraArgHelp = [],+ commandCommand = showIndexCmd,+ commandPrereq = amInRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [],+ commandBasicOptions = [files, directories, nullFlag, workingRepoDir] }++dump :: [DarcsFlag] -> Tree IO -> IO ()+dump opts tree = do+ let line | NullFlag `elem` opts = \t -> putStr t >> putChar '\0'+ | otherwise = putStrLn+ output (p, i) = do+ let hash = case itemHash i of+ NoHash -> "(no hash available)"+ h -> BS.unpack $ encodeBase16 h+ path = anchorPath "" p+ isdir = case i of+ SubTree _ -> "/"+ _ -> ""+ line $ hash ++ " " ++ path ++ isdir+ x <- expand tree+ mapM_ output $ (floatPath ".", SubTree x) : list x++showIndexCmd :: [DarcsFlag] -> [String] -> IO ()+showIndexCmd opts _ = withRepository opts $ RepoJob $ \repo -> do+ readIndex repo >>= updateIndex >>= dump opts++showPristineCmd :: [DarcsFlag] -> [String] -> IO ()+showPristineCmd opts _ = withRepository opts $ RepoJob $ \repo -> do+ readRecorded repo >>= dump opts+
− src/Darcs/Commands/ShowIndex.lhs
@@ -1,87 +0,0 @@-% Copyright (C) 2009 Petr Rockai-%-% Permission is hereby granted, free of charge, to any person-% obtaining a copy of this software and associated documentation-% files (the "Software"), to deal in the Software without-% restriction, including without limitation the rights to use, copy,-% modify, merge, publish, distribute, sublicense, and/or sell copies-% of the Software, and to permit persons to whom the Software is-% furnished to do so, subject to the following conditions:-%-% The above copyright notice and this permission notice shall be-% included in all copies or substantial portions of the Software.-%-% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,-% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF-% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND-% NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS-% BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN-% ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN-% CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE-% SOFTWARE.--\darcsCommand{show index}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}-#include "gadts.h"-module Darcs.Commands.ShowIndex ( showIndex- , showPristineCmd -- for alias- ) where-import Darcs.Arguments ( DarcsFlag(..), workingRepoDir,- files, directories, nullFlag )-import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Repository ( amInRepository, withRepository, ($-), readIndex )-import Darcs.Repository.State ( readRecorded )--import Storage.Hashed( floatPath )-import Storage.Hashed.Hash( encodeBase16, Hash( NoHash ) )-import Storage.Hashed.Tree( list, expand, itemHash, Tree, TreeItem( SubTree ) )-import Storage.Hashed.Index( updateIndex )-import Storage.Hashed.AnchoredPath( anchorPath )--import qualified Data.ByteString.Char8 as BS--showIndex :: DarcsCommand-showIndex = DarcsCommand {- commandName = "index",- commandDescription = "Dump contents of working tree index.",- commandHelp =- "The `darcs show index' command lists all version-controlled files and " ++- "directories along with their hashes as stored in _darcs/index. " ++- "For files, the fields correspond to file size, sha256 of the current " ++- "file content and the filename.",- commandExtraArgs = 0,- commandExtraArgHelp = [],- commandCommand = showIndexCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [],- commandBasicOptions = [files, directories, nullFlag, workingRepoDir] }--dump :: [DarcsFlag] -> Tree IO -> IO ()-dump opts tree = do- let line | NullFlag `elem` opts = \t -> putStr t >> putChar '\0'- | otherwise = putStrLn- output (p, i) = do- let hash = case itemHash i of- NoHash -> "(no hash available)"- h -> BS.unpack $ encodeBase16 h- path = anchorPath "" p- isdir = case i of- SubTree _ -> "/"- _ -> ""- line $ hash ++ " " ++ path ++ isdir- x <- expand tree- mapM_ output $ (floatPath ".", SubTree x) : list x--showIndexCmd :: [DarcsFlag] -> [String] -> IO ()-showIndexCmd opts _ = withRepository opts $- \repo -> do- readIndex repo >>= updateIndex >>= dump opts--showPristineCmd :: [DarcsFlag] -> [String] -> IO ()-showPristineCmd opts _ = withRepository opts $- \repo -> do- readRecorded repo >>= dump opts--\end{code}
+ src/Darcs/Commands/ShowRepo.hs view
@@ -0,0 +1,146 @@+-- Copyright (C) 2007 Kevin Quick+--+-- 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 CPP #-}+#include "gadts.h"+module Darcs.Commands.ShowRepo ( showRepo ) where++import Data.Char ( toLower, isSpace )+import Data.List ( intersperse )+import Control.Monad ( when, unless )+import Text.Html ( tag, stringToHtml )+import Darcs.Arguments ( DarcsFlag(..), workingRepoDir, files, xmloutput )+import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Repository ( withRepository, RepoJob(..), amInRepository, readRepo )+import Darcs.Repository.Internal ( Repository(..), RepoType(..) )+import Darcs.Repository.Format ( RepoFormat(..) )+import Darcs.Repository.Prefs ( getPreflist )+import Darcs.Repository.Motd ( getMotd )+import Darcs.Patch ( RepoPatch )+import Darcs.Patch.Set ( newset2RL )+import Darcs.Witnesses.Ordered ( lengthRL )+import qualified Data.ByteString.Char8 as BC (unpack)++showRepoHelp :: String+showRepoHelp =+ "The `darcs show repo' command displays statistics about the current\n" +++ "repository, allowing third-party scripts to access this information\n" +++ "without inspecting _darcs directly (and without breaking when the\n" +++ "_darcs format changes).\n" +++ "\n" +++ "By default, the number of patches is shown. If this data isn't\n" +++ "needed, use --no-files to accelerate this command from O(n) to O(1).\n" +++ "\n" +++ "By default, output is in a human-readable format. The --xml-output\n" +++ "option can be used to generate output for machine postprocessing.\n"++showRepoDescription :: String+showRepoDescription = "Show repository summary information"++showRepo :: DarcsCommand+showRepo = DarcsCommand { commandProgramName = "darcs",+ commandName = "repo",+ commandHelp = showRepoHelp,+ commandDescription = showRepoDescription,+ commandExtraArgs = 0,+ commandExtraArgHelp = [],+ commandCommand = repoCmd,+ commandPrereq = amInRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [],+ commandBasicOptions = [workingRepoDir, files, xmloutput] }++repoCmd :: [DarcsFlag] -> [String] -> IO ()+repoCmd opts _ = let put_mode = if XMLOutput `elem` opts then showInfoXML else showInfoUsr+ in withRepository opts $ RepoJob $ \repository -> actuallyShowRepo (putInfo put_mode) repository++-- Some convenience functions to output a labelled text string or an+-- XML tag + value (same API). If no value, output is suppressed+-- entirely. Borrow some help from Text.Html to perform XML output.++type ShowInfo = String -> String -> String++showInfoXML :: ShowInfo+showInfoXML t i = show $ tag (safeTag t) $ stringToHtml i++safeTag :: String -> String+safeTag [] = []+safeTag (' ':cs) = safeTag cs+safeTag ('#':cs) = "num_" ++ (safeTag cs)+safeTag (c:cs) = toLower c : safeTag cs++-- labelled strings: labels are right-aligned at 14 characters;+-- subsequent lines in multi-line output are indented accordingly.+showInfoUsr :: ShowInfo+showInfoUsr t i = (replicate (14 - length(t)) ' ') ++ t ++ ": " +++ (concat $ intersperse ('\n' : (replicate 16 ' ')) $ lines i) ++ "\n"++type PutInfo = String -> String -> IO ()+putInfo :: ShowInfo -> PutInfo+putInfo m t i = unless (null i) (putStr $ m t i)++-- Primary show-repo operation. Determines ordering of output for+-- sub-displays. The `out' argument is one of the above operations to+-- output a labelled text string or an XML tag and contained value.++actuallyShowRepo :: RepoPatch p => PutInfo -> Repository p C(r u r) -> IO ()+actuallyShowRepo out r@(Repo loc opts rf rt) = do+ when (XMLOutput `elem` opts) (putStr "<repository>\n")+ showRepoType out rt+ when (Verbose `elem` opts) (out "Show" $ show r)+ showRepoFormat out rf+ out "Root" loc+ showRepoAux out rt+ showRepoPrefs out+ unless (NoFiles `elem` opts) (numPatches r >>= (out "Num Patches" . show ))+ showRepoMOTD out r+ when (XMLOutput `elem` opts) (putStr "</repository>\n")++-- Most of the actual elements being displayed are part of the Show+-- class; that's fine for a Haskeller, but not for the common user, so+-- the routines below work to provide more human-readable information+-- regarding the repository elements.++showRepoType :: PutInfo -> RepoType p -> IO ()+showRepoType out (DarcsRepository _ _) = out "Type" "darcs"++showRepoFormat :: PutInfo -> RepoFormat -> IO ()+showRepoFormat out (RF rf) = out "Format" $+ concat $ intersperse ", " (map (concat . intersperse "|" . map BC.unpack) rf)++showRepoAux :: PutInfo -> RepoType p -> IO ()+showRepoAux out (DarcsRepository pris cs) =+ do out "Pristine" $ show pris+ out "Cache" $ concat $ intersperse ", " $ lines $ show cs+++showRepoPrefs :: PutInfo -> IO ()+showRepoPrefs out = do+ getPreflist "prefs" >>= mapM_ prefOut+ getPreflist "author" >>= out "Author" . unlines+ getPreflist "defaultrepo" >>= out "Default Remote" . unlines+ where prefOut = uncurry out . (\(p,v) -> (p++" Pref", (dropWhile isSpace v))) . break isSpace++showRepoMOTD :: RepoPatch p => PutInfo -> Repository p C(r u r) -> IO ()+showRepoMOTD out (Repo loc _ _ _) = getMotd loc >>= out "MOTD" . BC.unpack++-- Support routines to provide information used by the PutInfo operations above.++numPatches :: RepoPatch p => Repository p C(r u r) -> IO Int+numPatches r = readRepo r >>= (return . lengthRL . newset2RL)+
− src/Darcs/Commands/ShowRepo.lhs
@@ -1,150 +0,0 @@-% Copyright (C) 2007 Kevin Quick-%-% 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.--\darcsCommand{show repo}--\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}-#include "gadts.h"-module Darcs.Commands.ShowRepo ( showRepo ) where--import Data.Char ( toLower, isSpace )-import Data.List ( intersperse )-import Control.Monad ( when, unless )-import Text.Html ( tag, stringToHtml )-import Darcs.Arguments ( DarcsFlag(..), workingRepoDir, files, xmloutput )-import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Repository ( withRepository, ($-), amInRepository, readRepo )-import Darcs.Repository.Internal ( Repository(..), RepoType(..) )-import Darcs.Repository.Format ( RepoFormat(..) )-import Darcs.Repository.Prefs ( getPreflist )-import Darcs.Repository.Motd ( getMotd )-import Darcs.Patch ( RepoPatch )-import Darcs.Patch.Set ( newset2RL )-import Darcs.Witnesses.Ordered ( lengthRL )-import qualified Data.ByteString.Char8 as BC (unpack)--showRepoHelp :: String-showRepoHelp =- "The `darcs show repo' command displays statistics about the current\n" ++- "repository, allowing third-party scripts to access this information\n" ++- "without inspecting _darcs directly (and without breaking when the\n" ++- "_darcs format changes).\n" ++- "\n" ++- "By default, the number of patches is shown. If this data isn't\n" ++- "needed, use --no-files to accelerate this command from O(n) to O(1).\n" ++- "\n" ++- "By default, output is in a human-readable format. The --xml-output\n" ++- "option can be used to generate output for machine postprocessing.\n"--showRepoDescription :: String-showRepoDescription = "Show repository summary information"--showRepo :: DarcsCommand-showRepo = DarcsCommand { commandName = "repo",- commandHelp = showRepoHelp,- commandDescription = showRepoDescription,- commandExtraArgs = 0,- commandExtraArgHelp = [],- commandCommand = repoCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [],- commandBasicOptions = [workingRepoDir, files, xmloutput] }--repoCmd :: [DarcsFlag] -> [String] -> IO ()-repoCmd opts _ = let put_mode = if XMLOutput `elem` opts then showInfoXML else showInfoUsr- in withRepository opts $- \repository -> actuallyShowRepo (putInfo put_mode) repository---- Some convenience functions to output a labelled text string or an--- XML tag + value (same API). If no value, output is suppressed--- entirely. Borrow some help from Text.Html to perform XML output.--type ShowInfo = String -> String -> String--showInfoXML :: ShowInfo-showInfoXML t i = show $ tag (safeTag t) $ stringToHtml i--safeTag :: String -> String-safeTag [] = []-safeTag (' ':cs) = safeTag cs-safeTag ('#':cs) = "num_" ++ (safeTag cs)-safeTag (c:cs) = toLower c : safeTag cs---- labelled strings: labels are right-aligned at 14 characters;--- subsequent lines in multi-line output are indented accordingly.-showInfoUsr :: ShowInfo-showInfoUsr t i = (replicate (14 - length(t)) ' ') ++ t ++ ": " ++- (concat $ intersperse ('\n' : (replicate 16 ' ')) $ lines i) ++ "\n"--type PutInfo = String -> String -> IO ()-putInfo :: ShowInfo -> PutInfo-putInfo m t i = unless (null i) (putStr $ m t i)---- Primary show-repo operation. Determines ordering of output for--- sub-displays. The `out' argument is one of the above operations to--- output a labelled text string or an XML tag and contained value.--actuallyShowRepo :: RepoPatch p => PutInfo -> Repository p C(r u r) -> IO ()-actuallyShowRepo out r@(Repo loc opts rf rt) = do- when (XMLOutput `elem` opts) (putStr "<repository>\n")- showRepoType out rt- when (Verbose `elem` opts) (out "Show" $ show r)- showRepoFormat out rf- out "Root" loc- showRepoAux out rt- showRepoPrefs out- unless (NoFiles `elem` opts) (numPatches r >>= (out "Num Patches" . show ))- showRepoMOTD out r- when (XMLOutput `elem` opts) (putStr "</repository>\n")---- Most of the actual elements being displayed are part of the Show--- class; that's fine for a Haskeller, but not for the common user, so--- the routines below work to provide more human-readable information--- regarding the repository elements.--showRepoType :: PutInfo -> RepoType p -> IO ()-showRepoType out (DarcsRepository _ _) = out "Type" "darcs"--showRepoFormat :: PutInfo -> RepoFormat -> IO ()-showRepoFormat out (RF rf) = out "Format" $- concat $ intersperse ", " (map (concat . intersperse "|" . map BC.unpack) rf)--showRepoAux :: PutInfo -> RepoType p -> IO ()-showRepoAux out (DarcsRepository pris cs) =- do out "Pristine" $ show pris- out "Cache" $ concat $ intersperse ", " $ lines $ show cs---showRepoPrefs :: PutInfo -> IO ()-showRepoPrefs out = do- getPreflist "prefs" >>= mapM_ prefOut- getPreflist "author" >>= out "Author" . unlines- getPreflist "defaultrepo" >>= out "Default Remote" . unlines- where prefOut = uncurry out . (\(p,v) -> (p++" Pref", (dropWhile isSpace v))) . break isSpace--showRepoMOTD :: RepoPatch p => PutInfo -> Repository p C(r u r) -> IO ()-showRepoMOTD out (Repo loc _ _ _) = getMotd loc >>= out "MOTD" . BC.unpack---- Support routines to provide information used by the PutInfo operations above.--numPatches :: RepoPatch p => Repository p C(r u r) -> IO Int-numPatches r = readRepo r >>= (return . lengthRL . newset2RL)--\end{code}
+ src/Darcs/Commands/ShowTags.hs view
@@ -0,0 +1,82 @@+-- Copyright (C) 2007 Florian Weimer+--+-- 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.++module Darcs.Commands.ShowTags ( showTags ) where+import Darcs.Arguments ( DarcsFlag(..), possiblyRemoteRepoDir, getRepourl )+import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Patch.PatchInfoAnd ( info )+import Darcs.Repository ( findRepository, readRepo, withRepositoryDirectory, RepoJob(..) )+import Darcs.Patch.Info ( piTag )+import Darcs.Patch.Set ( newset2RL )+import Darcs.Witnesses.Ordered ( mapRL )+import Data.Maybe ( fromMaybe )+import System.IO ( stderr, hPutStrLn )+-- import Printer ( renderPS )++showTagsDescription :: String+showTagsDescription = "Show all tags in the repository."++showTagsHelp :: String+showTagsHelp =+ "The tags command writes a list of all tags in the repository to standard\n"+++ "output.\n" +++ "\n" +++ "Tab characters (ASCII character 9) in tag names are changed to spaces\n" +++ "for better interoperability with shell tools. A warning is printed if\n" +++ "this happens."++showTags :: DarcsCommand+showTags = DarcsCommand {+ commandProgramName = "darcs",+ commandName = "tags",+ commandHelp = showTagsHelp,+ commandDescription = showTagsDescription,+ commandExtraArgs = 0,+ commandExtraArgHelp = [],+ commandCommand = tagsCmd,+ commandPrereq = findRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [],+ commandBasicOptions = [possiblyRemoteRepoDir] }++tagsCmd :: [DarcsFlag] -> [String] -> IO ()+tagsCmd opts _ =+ let repodir = fromMaybe "." (getRepourl opts) in+ withRepositoryDirectory opts repodir $ RepoJob $ \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 ()+ normalize :: String -> String -> Bool -> IO String+ normalize _ [] _ = return []+ normalize t (x : xs) flag =+ if x == '\t' then do+ if flag+ then return ()+ else hPutStrLn stderr+ ("warning: tag with TAB character: " ++ t)+ rest <- (normalize t xs True)+ return $ ' ' : rest+ else do+ rest <- (normalize t xs flag)+ return $ x : rest+
− src/Darcs/Commands/ShowTags.lhs
@@ -1,81 +0,0 @@-% Copyright (C) 2007 Florian Weimer-%-% 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.--\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 )--- import Printer ( renderPS )--showTagsDescription :: String-showTagsDescription = "Show all tags in the repository."--showTagsHelp :: String-showTagsHelp =- "The tags command writes a list of all tags in the repository to standard\n"++- "output.\n" ++- "\n" ++- "Tab characters (ASCII character 9) in tag names are changed to spaces\n" ++- "for better interoperability with shell tools. A warning is printed if\n" ++- "this happens."--showTags :: DarcsCommand-showTags = DarcsCommand {- commandName = "tags",- commandHelp = showTagsHelp,- commandDescription = showTagsDescription,- commandExtraArgs = 0,- commandExtraArgHelp = [],- commandCommand = tagsCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [],- commandBasicOptions = [workingRepoDir] }--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 ()- normalize :: String -> String -> Bool -> IO String- normalize _ [] _ = return []- normalize t (x : xs) flag =- if x == '\t' then do- if flag- then return ()- else hPutStrLn stderr- ("warning: tag with TAB character: " ++ t)- rest <- (normalize t xs True)- return $ ' ' : rest- else do- rest <- (normalize t xs flag)- return $ x : rest--\end{code}
+ src/Darcs/Commands/Tag.hs view
@@ -0,0 +1,123 @@+-- Copyright (C) 2003-2004 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.++module Darcs.Commands.Tag ( tag ) where+import System.Directory ( removeFile )+import Control.Monad ( when )++import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Arguments ( nocompress, umaskOption, patchnameOption, author,+ pipeInteractive, askLongComment,+ workingRepoDir, getAuthor )+import Darcs.Patch.PatchInfoAnd ( n2pia )+import Darcs.Repository ( amInHashedRepository, withRepoLock, Repository, RepoJob(..), readRepo,+ tentativelyAddPatch, finalizeRepositoryChanges,+ )+import Darcs.Patch ( infopatch, adddeps, Patchy, PrimPatch, PrimOf )+import Darcs.Patch.Info ( patchinfo )+import Darcs.Patch.Depends ( getTagsRight )+import Darcs.Commands.Record ( getDate, getLog )+import Darcs.Witnesses.Ordered ( FL(..) )+import Darcs.Lock ( worldReadableTemp )+import Darcs.Flags ( DarcsFlag(..), compression )+import System.IO ( hPutStr, stderr )++#include "gadts.h"++tagDescription :: String+tagDescription = "Name the current repository state for future reference."++tagHelp :: String+tagHelp =+ "The `darcs tag' command names the current repository state, so that it\n" +++ "can easily be referred to later. Every `important' state should be\n" +++ "tagged; in particular it is good practice to tag each stable release\n" +++ "with a number or codename. Advice on release numbering can be found\n" +++ "at http://producingoss.com/en/development-cycle.html.\n" +++ "\n" +++ "To reproduce the state of a repository `R' as at tag `t', use the\n" +++ "command `darcs get --tag t R'. The command `darcs show tags' lists\n" +++ "all tags in the current repository.\n" +++ "\n" +++ "Tagging also provides significant performance benefits: when Darcs\n" +++ "reaches a shared tag that depends on all antecedent patches, it can\n" +++ "simply stop processing.\n" +++ "\n" +++ "Like normal patches, a tag has a name, an author, a timestamp and an\n" +++ "optional long description, but it does not change the working tree.\n" +++ "A tag can have any name, but it is generally best to pick a naming\n" +++ "scheme and stick to it.\n" +++ "\n" +++ "The `darcs tag' command accepts the --pipe option, which behaves as\n" +++ "described in `darcs record'.\n"++tag :: DarcsCommand+tag = DarcsCommand {commandProgramName = "darcs",+ commandName = "tag",+ commandHelp = tagHelp,+ commandDescription = tagDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["[TAGNAME]"],+ commandCommand = tagCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [nocompress,umaskOption],+ commandBasicOptions = [patchnameOption, author,+ pipeInteractive,+ askLongComment,+ workingRepoDir]}++tagCmd :: [DarcsFlag] -> [String] -> IO ()+tagCmd opts args = withRepoLock opts $ RepoJob $ \(repository :: Repository p C(r u r)) -> do+ date <- getDate opts+ the_author <- getAuthor opts+ deps <- getTagsRight `fmap` readRepo repository+ (name, long_comment, mlogf) <- get_name_log (NilFL :: FL (PrimOf p) C(a a)) opts args+ myinfo <- patchinfo date name the_author long_comment+ let mypatch = infopatch myinfo NilFL+-- Warning: A do-notation statement discarded a result of type Darcs.Repository.InternalTypes.Repository p r u r.+ _ <- tentativelyAddPatch repository (compression opts) $ n2pia $ adddeps mypatch deps+ finalizeRepositoryChanges repository+ maybe (return ()) removeFile mlogf+ putStrLn $ "Finished tagging patch '"++name++"'"+ where get_name_log ::(Patchy prim, PrimPatch prim) => FL prim C(a a) -> [DarcsFlag] -> [String] -> IO (String, [String], Maybe String)+ get_name_log nilFL o a+ = do let o2 = if null a then o else (add_patch_name o (unwords a))+ (name, comment, mlogf) <- getLog o2 Nothing (worldReadableTemp "darcs-tag") nilFL+ when (length name < 2) $ hPutStr stderr $+ "Do you really want to tag '"+ ++name++"'? If not type: darcs obliterate --last=1\n"+ return ("TAG " ++ name, comment, mlogf)+ add_patch_name :: [DarcsFlag] -> String -> [DarcsFlag]+ add_patch_name o a| has_patch_name o = o+ | otherwise = [PatchName a] ++ o+ has_patch_name (PatchName _:_) = True+ has_patch_name (_:fs) = has_patch_name fs+ has_patch_name [] = False++-- This may be useful for developers, but users don't care about+-- internals:+--+-- A tagged version automatically depends on all patches in the+-- repository. This allows you to later reproduce precisely that+-- version. The tag does this by depending on all patches in the+-- repository, except for those which are depended upon by other tags+-- already in the repository. In the common case of a sequential+-- series of tags, this means that the tag depends on all patches+-- since the last tag, plus that tag itself.+
− src/Darcs/Commands/Tag.lhs
@@ -1,125 +0,0 @@-% Copyright (C) 2003-2004 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.--\darcsCommand{tag}-\begin{code}-module Darcs.Commands.Tag ( tag ) where-import System.Directory ( removeFile )-import Control.Monad ( when )--import Darcs.Commands ( DarcsCommand(DarcsCommand, commandName, commandHelp,- commandDescription, commandExtraArgs,- commandExtraArgHelp, commandCommand, commandPrereq,- commandGetArgPossibilities, commandArgdefaults,- commandAdvancedOptions, commandBasicOptions),- nodefaults )-import Darcs.Arguments ( nocompress, umaskOption, patchnameOption, author,- pipeInteractive, askLongComment,- workingRepoDir, getAuthor )-import Darcs.Hopefully ( n2pia )-import Darcs.Repository ( amInRepository, withRepoLock, ($-), readRepo,- tentativelyAddPatch, finalizeRepositoryChanges,- )-import Darcs.Patch ( infopatch, identity, adddeps )-import Darcs.Patch.Info ( patchinfo )-import Darcs.Patch.Depends ( getTagsRight )-import Darcs.Commands.Record ( getDate, getLog )-import Darcs.Witnesses.Ordered ( FL(..) )-import Darcs.Lock ( worldReadableTemp )-import Darcs.Flags ( DarcsFlag(..) )-import System.IO ( hPutStr, stderr )--tagDescription :: String-tagDescription = "Name the current repository state for future reference."--tagHelp :: String-tagHelp =- "The `darcs tag' command names the current repository state, so that it\n" ++- "can easily be referred to later. Every `important' state should be\n" ++- "tagged; in particular it is good practice to tag each stable release\n" ++- "with a number or codename. Advice on release numbering can be found\n" ++- "at http://producingoss.com/en/development-cycle.html.\n" ++- "\n" ++- "To reproduce the state of a repository `R' as at tag `t', use the\n" ++- "command `darcs get --tag t R'. The command `darcs show tags' lists\n" ++- "all tags in the current repository.\n" ++- "\n" ++- "Tagging also provides significant performance benefits: when Darcs\n" ++- "reaches a shared tag that depends on all antecedent patches, it can\n" ++- "simply stop processing.\n" ++- "\n" ++- "Like normal patches, a tag has a name, an author, a timestamp and an\n" ++- "optional long description, but it does not change the working tree.\n" ++- "A tag can have any name, but it is generally best to pick a naming\n" ++- "scheme and stick to it.\n" ++- "\n" ++- "The `darcs tag' command accepts the --pipe option, which behaves as\n" ++- "described in `darcs record'.\n"--tag :: DarcsCommand-tag = DarcsCommand {commandName = "tag",- commandHelp = tagHelp,- commandDescription = tagDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["[TAGNAME]"],- commandCommand = tagCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [nocompress,umaskOption],- commandBasicOptions = [patchnameOption, author,- pipeInteractive,- askLongComment,- workingRepoDir]}--tagCmd :: [DarcsFlag] -> [String] -> IO ()-tagCmd opts args = withRepoLock opts $- \repository -> do- date <- getDate opts- the_author <- getAuthor opts- deps <- getTagsRight `fmap` readRepo repository- (name, long_comment, mlogf) <- get_name_log opts args- myinfo <- patchinfo date name the_author long_comment- let mypatch = infopatch myinfo identity- tentativelyAddPatch repository opts $ n2pia $ adddeps mypatch deps- finalizeRepositoryChanges repository- maybe (return ()) removeFile mlogf- putStrLn $ "Finished tagging patch '"++name++"'"- where get_name_log :: [DarcsFlag] -> [String] -> IO (String, [String], Maybe String)- get_name_log o a = do let o2 = if null a then o else (add_patch_name o (unwords a))- (name, comment, mlogf) <- getLog o2 Nothing (worldReadableTemp "darcs-tag") NilFL- when (length name < 2) $ hPutStr stderr $- "Do you really want to tag '"- ++name++"'? If not type: darcs obliterate --last=1\n"- return ("TAG " ++ name, comment, mlogf)- add_patch_name :: [DarcsFlag] -> String -> [DarcsFlag]- add_patch_name o a| has_patch_name o = o- | otherwise = [PatchName a] ++ o- has_patch_name (PatchName _:_) = True- has_patch_name (_:fs) = has_patch_name fs- has_patch_name [] = False---- This may be useful for developers, but users don't care about--- internals:------ A tagged version automatically depends on all patches in the--- repository. This allows you to later reproduce precisely that--- version. The tag does this by depending on all patches in the--- repository, except for those which are depended upon by other tags--- already in the repository. In the common case of a sequential--- series of tags, this means that the tag depends on all patches--- since the last tag, plus that tag itself.-\end{code}
+ src/Darcs/Commands/TrackDown.hs view
@@ -0,0 +1,188 @@+-- Copyright (C) 2002-2005 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.++module Darcs.Commands.TrackDown ( trackdown ) where+import Prelude hiding ( init )+import System.Exit ( ExitCode(..) )+import System.Cmd ( system )+import System.IO ( hFlush, stdout )+import Control.Monad( when )++import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Arguments ( DarcsFlag(SetScriptsExecutable, Bisect), workingRepoDir, bisect,+ setScriptsExecutableOption, makeScriptsExecutable )+import Darcs.Patch.PatchInfoAnd ( hopefully )+import Darcs.Repository ( amInHashedRepository, readRepo, withRepoReadLock, RepoJob(..), withRecorded,+ setScriptsExecutable )+import Darcs.Witnesses.Ordered ( RL(..), (:<)(..), (+<+),+ reverseRL, splitAtRL, lengthRL, mapRL, mapFL, mapRL_RL )+import Darcs.Patch.Conflict ( Conflict )+import Darcs.Patch.FileHunk ( IsHunk )+import Darcs.Patch.Format ( PatchListFormat )+import Darcs.Patch.Patchy ( Patchy, Invert, Apply, ShowPatch )+import Darcs.Patch ( RepoPatch, Named, description, apply, invert )+import Darcs.Patch.Set ( newset2RL )+import Printer ( putDocLn )+import Darcs.Test ( getTest )+import Darcs.Lock ( withTempDir )++#include "gadts.h"++trackdownDescription :: String+trackdownDescription = "Locate the most recent version lacking an error."++trackdownHelp :: String+trackdownHelp =+ "Trackdown tries to find the most recent version in the repository which\n"+++ "passes a test. Given no arguments, it uses the default repository test.\n"+++ "Given one argument, it treats it as a test command. Given two arguments,\n"+++ "the first is an initialization command with is run only once, and the\n"+++ "second is the test command.\n\n"+++ "Without the --bisect option, trackdown does linear search starting from head,\n"+++ "and moving away from head. With the --bisect option, it does binary search.\n\n"+++ "Under the assumption that failure is monotonous, trackdown produces\n"+++ "the same result with and without --bisect. (Monotonous means that when\n"+++ "moving away from head, the test result changes only once from \"fail\" to \"ok\".)\n"+++ "If failure is not monotonous, any one of the patches that break the test is\n"+++ "found at random."++trackdown :: DarcsCommand+trackdown = DarcsCommand {commandProgramName = "darcs",+ commandName = "trackdown",+ commandHelp = trackdownHelp,+ commandDescription = trackdownDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["[[INITIALIZATION]",+ "COMMAND]"],+ commandCommand = trackdownCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [setScriptsExecutableOption],+ commandBasicOptions = [workingRepoDir, bisect]}++trackdownCmd :: [DarcsFlag] -> [String] -> IO ()+trackdownCmd opts args = withRepoReadLock opts $ RepoJob $ \repository -> do+ patches <- readRepo repository+ (init,test) <- case args of+ [] ->+ do t <- getTest opts+ return (return ExitSuccess, t)+ [cmd] ->+ do putStrLn $ "Tracking down command:\n"++cmd+ return $ (return ExitSuccess, system cmd)+ [init,cmd] ->+ do putStrLn $ "Initializing with command:\n"++init+ putStrLn $ "Tracking down command:\n"++cmd+ return $ (system init, system cmd)+ _ -> fail "Trackdown expects zero to two arguments."+ withRecorded repository (withTempDir "trackingdown") $ \_ -> do+ when (SetScriptsExecutable `elem` opts) setScriptsExecutable+ _ <- init+ (if Bisect `elem` opts+ then trackBisect+ else trackNextLinear) opts test (mapRL_RL hopefully . newset2RL $ patches)++-- | linear search (without --bisect)+trackNextLinear :: RepoPatch p => [DarcsFlag] -> IO ExitCode -> RL (Named p) C(x y) -> IO ()+trackNextLinear opts test (p:<:ps) = do+ test_result <- test+ if test_result == ExitSuccess+ then putStrLn "Success!"+ else do apply (invert p) `catch` \e -> fail ("Bad patch:\n" ++ show e)+ makeScriptsExecutable opts (invert p)+ putStrLn "Trying without the patch:"+ putDocLn $ description $ invert p+ hFlush stdout+ trackNextLinear opts test ps+trackNextLinear _opts test NilRL = do+ test_result <- test+ if test_result == ExitSuccess+ then putStrLn "Success!"+ else putStrLn "Noone passed the test!"++-- | binary search (with --bisect)+trackBisect :: (IsHunk p, Conflict p, PatchListFormat p, Patchy p) => [DarcsFlag] -> IO ExitCode -> RL p C(x y) -> IO ()+trackBisect _ test NilRL = do+ test_result <- test+ if test_result == ExitSuccess+ then putStrLn "Success!"+ else putStrLn "Noone passed the test!"+trackBisect opts test ps = do+ test_result <- test+ if test_result == ExitSuccess+ then putStrLn ("Test does not fail on head.")+ else trackNextBisect opts curr_prog test BisectRight (patchTreeFromRL ps)+ where+ curr_prog = (1, 1 + round ((logBase 2 $ fromIntegral $ lengthRL ps) :: Double)) :: (Int,Int)++-- | Bisect Patch Tree+data PatchTree p C(x y) where+ Leaf :: p C(x y) -> PatchTree p C(x y)+ Fork :: PatchTree p C(y z) -> PatchTree p C(x y) -> PatchTree p C(x z)++-- | Direction of Bisect trackdown+data BisectDir = BisectLeft | BisectRight deriving Show++-- | Progress of Bisect+type BisectState = (Int, Int)++-- | Create Bisect PatchTree from the RL+patchTreeFromRL :: (Patchy p) => RL p C(x y) -> PatchTree p C(x y)+patchTreeFromRL (l :<: NilRL) = Leaf l+patchTreeFromRL xs = case splitAtRL (lengthRL xs `div` 2) xs of+ (l :< r) -> Fork (patchTreeFromRL l) (patchTreeFromRL r)++-- | Convert PatchTree back to RL+patchTree2RL :: (Patchy p) => PatchTree p C(x y) -> RL p C(x y)+patchTree2RL (Leaf p) = p :<: NilRL+patchTree2RL (Fork l r) = (patchTree2RL l) +<+ (patchTree2RL r)++-- | Iterate the Patch Tree+trackNextBisect :: (IsHunk p, Conflict p, PatchListFormat p, Patchy p)+ => [DarcsFlag] -> BisectState -> IO ExitCode -> BisectDir -> PatchTree p C(x y) -> IO ()+trackNextBisect opts (dnow, dtotal) test dir (Fork l r) = do+ putStr ("Trying " ++ show dnow ++ "/" ++ show dtotal ++ " sequences...\n")+ hFlush stdout+ case dir of+ BisectRight -> jumpHalfOnRight opts l -- move in temporary repo+ BisectLeft -> jumpHalfOnLeft opts r -- within given direction+ test_result <- test -- execute test on repo+ case test_result of+ ExitSuccess -> trackNextBisect opts (dnow+1, dtotal) test BisectLeft l -- continue left (to the present)+ _ -> trackNextBisect opts (dnow+1, dtotal) test BisectRight r -- continue right (to the past)+trackNextBisect _ _ _ _ (Leaf p) = do+ putStrLn ("Last recent patch that fails the test (assuming monotony in the given range):")+ putDocLn (description p)++jumpHalfOnRight :: (IsHunk p, Conflict p, PatchListFormat p, Patchy p) => [DarcsFlag] -> PatchTree p C(x y) -> IO ()+jumpHalfOnRight opts l = unapplyRL ps >> makeScriptsExecutable opts ps+ where ps = patchTree2RL l++jumpHalfOnLeft :: (IsHunk p, Conflict p, PatchListFormat p, Patchy p) => [DarcsFlag] -> PatchTree p C(x y) -> IO ()+jumpHalfOnLeft opts r = applyRL p >> makeScriptsExecutable opts p+ where p = patchTree2RL r++applyRL :: (Invert p, ShowPatch p, Apply p) => RL p C(x y) -> IO ()+applyRL patches = sequence_ (mapFL safeApply (reverseRL $ patches))++unapplyRL :: (Invert p, ShowPatch p, Apply p) => RL p C(x y) -> IO ()+unapplyRL patches = sequence_ (mapRL (safeApply . invert) patches)++safeApply :: (Invert p, ShowPatch p, Apply p) => p C(x y) -> IO ()+safeApply p = apply p `catch` (\msg -> fail ("Bad patch (during trackdown --bisect):\n" ++ show msg))+
− src/Darcs/Commands/TrackDown.lhs
@@ -1,228 +0,0 @@-% Copyright (C) 2002-2005 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.--\darcsCommand{trackdown}-\begin{code}-module Darcs.Commands.TrackDown ( trackdown ) where-import Prelude hiding ( init )-import System.Exit ( ExitCode(..) )-import System.Cmd ( system )-import System.IO ( hFlush, stdout )-import Control.Monad( when )--import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Arguments ( DarcsFlag(SetScriptsExecutable, Bisect), workingRepoDir, bisect,- setScriptsExecutableOption )-import Darcs.Hopefully ( hopefully )-import Darcs.Repository ( amInRepository, readRepo, withRepoReadLock, ($-), withRecorded,- setScriptsExecutable )-import Darcs.Witnesses.Ordered ( RL(..), (:<)(..), (+<+),- reverseRL, splitAtRL, lengthRL, mapRL, mapFL, mapRL_RL, concatRL )-import Darcs.Patch.Patchy ( Invert, Apply, ShowPatch )-import Darcs.Patch ( RepoPatch, Named, description, apply, invert )-import Darcs.Patch.Set ( newset2RL )-import Printer ( putDocLn )-import Darcs.Test ( getTest )-import Darcs.Lock ( withTempDir )--#include "gadts.h"--trackdownDescription :: String-trackdownDescription = "Locate the most recent version lacking an error."--trackdownHelp :: String-trackdownHelp =- "Trackdown tries to find the most recent version in the repository which\n"++- "passes a test. Given no arguments, it uses the default repository test.\n"++- "Given one argument, it treats it as a test command. Given two arguments,\n"++- "the first is an initialization command with is run only once, and the\n"++- "second is the test command.\n\n"++- "Without the --bisect option, trackdown does linear search starting from head,\n"++- "and moving away from head. With the --bisect option, it does binary search.\n\n"++- "Under the assumption that failure is monotonous, trackdown produces\n"++- "the same result with and without --bisect. (Monotonous means that when\n"++- "moving away from head, the test result changes only once from \"fail\" to \"ok\".)\n"++- "If failure is not monotonous, any one of the patches that break the test is\n"++- "found at random."--trackdown :: DarcsCommand-trackdown = DarcsCommand {commandName = "trackdown",- commandHelp = trackdownHelp,- commandDescription = trackdownDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["[[INITIALIZATION]",- "COMMAND]"],- commandCommand = trackdownCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [setScriptsExecutableOption],- commandBasicOptions = [workingRepoDir, bisect]}--trackdownCmd :: [DarcsFlag] -> [String] -> IO ()-trackdownCmd opts args = withRepoReadLock opts $- \repository -> do- patches <- readRepo repository- (init,test) <- case args of- [] ->- do t <- getTest opts- return (return ExitSuccess, t)- [cmd] ->- do putStrLn $ "Tracking down command:\n"++cmd- return $ (return ExitSuccess, system cmd)- [init,cmd] ->- do putStrLn $ "Initializing with command:\n"++init- putStrLn $ "Tracking down command:\n"++cmd- return $ (system init, system cmd)- _ -> fail "Trackdown expects zero to two arguments."- withRecorded repository (withTempDir "trackingdown") $ \_ -> do- when (SetScriptsExecutable `elem` opts) setScriptsExecutable- _ <- init- (if Bisect `elem` opts- then trackBisect- else trackNextLinear) opts test (mapRL_RL hopefully . newset2RL $ patches)---- | linear search (without --bisect)-trackNextLinear :: RepoPatch p => [DarcsFlag] -> IO ExitCode -> RL (Named p) C(x y) -> IO ()-trackNextLinear opts test (p:<:ps) = do- test_result <- test- if test_result == ExitSuccess- then putStrLn "Success!"- else do apply opts (invert p) `catch` \e -> fail ("Bad patch:\n" ++ show e)- putStrLn "Trying without the patch:"- putDocLn $ description $ invert p- hFlush stdout- trackNextLinear opts test ps-trackNextLinear _opts test NilRL = do- test_result <- test- if test_result == ExitSuccess- then putStrLn "Success!"- else putStrLn "Noone passed the test!"---- | binary search (with --bisect)-trackBisect :: (Invert p, ShowPatch p, Apply p) => [DarcsFlag] -> IO ExitCode -> RL p C(x y) -> IO ()-trackBisect opts test NilRL = do- test_result <- test- if test_result == ExitSuccess- then putStrLn "Success!"- else putStrLn "Noone passed the test!"-trackBisect opts test ps = do- test_result <- test- if test_result == ExitSuccess- then putStrLn ("Test does not fail on head.")- else trackNextBisect opts curr_prog test BisectRight (patchTreeFromRL ps)- where- curr_prog = (1, 1 + round ((logBase 2 $ fromIntegral $ lengthRL ps) :: Double)) :: (Int,Int)---- | Bisect Patch Tree-data PatchTree p C(x y) where- Leaf :: p C(x y) -> PatchTree p C(x y)- Fork :: PatchTree p C(y z) -> PatchTree p C(x y) -> PatchTree p C(x z)---- | Direction of Bisect trackdown-data BisectDir = BisectLeft | BisectRight deriving Show---- | Progress of Bisect-type BisectState = (Int, Int)---- | Create Bisect PatchTree from the RL-patchTreeFromRL :: (Invert p, ShowPatch p, Apply p) => RL p C(x y) -> PatchTree p C(x y)-patchTreeFromRL (l :<: NilRL) = Leaf l-patchTreeFromRL xs = case splitAtRL (lengthRL xs `div` 2) xs of- (l :< r) -> Fork (patchTreeFromRL l) (patchTreeFromRL r)---- | Convert PatchTree back to RL-patchTree2RL :: (Invert p) => PatchTree p C(x y) -> RL p C(x y)-patchTree2RL (Leaf p) = p :<: NilRL-patchTree2RL (Fork l r) = (patchTree2RL l) +<+ (patchTree2RL r)---- | Iterate the Patch Tree-trackNextBisect :: (Invert p, ShowPatch p, Apply p) => [DarcsFlag] -> BisectState -> IO ExitCode -> BisectDir -> PatchTree p C(x y) -> IO ()-trackNextBisect opts (dnow, dtotal) test dir (Fork l r) = do- putStr ("Trying " ++ show dnow ++ "/" ++ show dtotal ++ " sequences...\n")- hFlush stdout- case dir of- BisectRight -> jumpHalfOnRight opts l -- move in temporary repo- BisectLeft -> jumpHalfOnLeft opts r -- within given direction- test_result <- test -- execute test on repo- case test_result of- ExitSuccess -> trackNextBisect opts (dnow+1, dtotal) test BisectLeft l -- continue left (to the present)- _ -> trackNextBisect opts (dnow+1, dtotal) test BisectRight r -- continue right (to the past)-trackNextBisect _ _ _ _ (Leaf p) = do- putStrLn ("Last recent patch that fails the test (assuming monotony in the given range):")- putDocLn (description p)--jumpHalfOnRight :: (Invert p, ShowPatch p, Apply p) => [DarcsFlag] -> PatchTree p C(x y) -> IO ()-jumpHalfOnRight opts l = unapplyRL opts (patchTree2RL l)--jumpHalfOnLeft :: (Invert p, ShowPatch p, Apply p) => [DarcsFlag] -> PatchTree p C(x y) -> IO ()-jumpHalfOnLeft opts r = applyRL opts (patchTree2RL r)--applyRL :: (Invert p, ShowPatch p, Apply p) => [DarcsFlag] -> RL p C(x y) -> IO ()-applyRL opts patches = sequence_ (mapFL (safeApply opts) (reverseRL $ patches))--unapplyRL :: (Invert p, ShowPatch p, Apply p) => [DarcsFlag] -> RL p C(x y) -> IO ()-unapplyRL opts patches = sequence_ (mapRL ((safeApply opts) . invert) patches)--safeApply :: (Invert p, ShowPatch p, Apply p) => [DarcsFlag] -> p C(x y) -> IO ()-safeApply opts p = apply opts p `catch` (\msg -> fail ("Bad patch (during trackdown --bisect):\n" ++ show msg))--\end{code}--Trackdown is helpful for locating when something was broken. It creates-a temporary directory with the latest repository content in it and cd to it.-First, and only once, it runs the initialization command if any,-for example-\begin{verbatim}-'autoconf; ./configure >/dev/null'-\end{verbatim}-Then it runs the test command, for example-\begin{verbatim}-'make && cd tests && sh /tmp/test.sh'-\end{verbatim}-While the test command exits with an error return code, darcs-``unapplies'' one patch from the version controlled files to retrieve-an earlier version, and repeats the test command. If the test command-finally succeeds, the name of the hunted down patch is found in the-output before the last test run.--The \verb!--bisect! variant of trackdown can be useful when the sought after-patch is likely buried deep in the repository history; however, it currently-requires an potentially expensive process of applying or unapplying half the-repository's patches at a time. You may often find the straightforward linear-trackdown to be more efficient in practice.--\subsubsection{Example usage}-If you want to find the last version of darcs that had a FIXME note in the-file Record.lhs, you could run-\begin{verbatim}-% darcs trackdown 'grep FIXME Record.lhs'-\end{verbatim}--To find the latest version that compiles, you can run-\begin{verbatim}-% darcs trackdown 'autoconf' './configure && make'-\end{verbatim}--Trackdown can also be used to see how other features of the code changed-with time. For example-\begin{verbatim}-% darcs trackdown 'autoconf; ./configure' \- "make darcs > /dev/null && cd ~/darcs && time darcs check && false"-\end{verbatim}-would let you see how long `darcs check' takes to run on each previous-version of darcs that will actually compile. The ``\verb!&& false!''-ensures that trackdown keeps going.
+ src/Darcs/Commands/TransferMode.hs view
@@ -0,0 +1,86 @@+-- Copyright (C) 2008 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.++{-# LANGUAGE CPP, PatternGuards #-}++-- The pragma above is only for pattern guards.+module Darcs.Commands.TransferMode ( transferMode ) where++import Prelude hiding ( catch )+import Control.Exception.Extensible ( catch )+import System.IO ( stdout, hFlush )++import Darcs.Utils ( withCurrentDirectory, prettyException )+import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Arguments ( DarcsFlag, workingRepoDir )+import Darcs.Repository ( amInRepository )+import Progress ( setProgressMode )+import Darcs.Global ( darcsdir )++import qualified Data.ByteString as B (hPut, readFile, length, ByteString)++transferModeDescription :: String+transferModeDescription = "Internal command for efficient ssh transfers."++transferModeHelp :: String+transferModeHelp =+ "When pulling from or pushing to a remote repository over ssh, if both\n" +++ "the local and remote ends have Darcs 2, the `transfer-mode' command\n" +++ "will be invoked on the remote end. This allows Darcs to intelligently\n" +++ "transfer information over a single ssh connection.\n" +++ "\n" +++ "If either end runs Darcs 1, a separate ssh connection will be created\n" +++ "for each transfer. As well as being less efficient, this means users\n" +++ "who do not run ssh-agent will be prompted for the ssh password tens or\n" +++ "hundreds of times!\n"++transferMode :: DarcsCommand+transferMode = DarcsCommand {commandProgramName = "darcs",+ commandName = "transfer-mode",+ commandHelp = transferModeHelp,+ commandDescription = transferModeDescription,+ commandExtraArgs = 0,+ commandExtraArgHelp = [],+ commandGetArgPossibilities = return [],+ commandCommand = transferModeCmd,+ commandPrereq = amInRepository,+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [],+ commandBasicOptions = [workingRepoDir]}++transferModeCmd :: [DarcsFlag] -> [String] -> IO ()+transferModeCmd _ _ = do setProgressMode False+ putStrLn "Hello user, I am darcs transfer mode"+ hFlush stdout+ withCurrentDirectory darcsdir $ transfer++transfer :: IO ()+transfer = do 'g':'e':'t':' ':fn <- getLine+ x <- readfile fn+ case x of+ Right c -> do putStrLn $ "got " ++ fn+ print $ B.length c+ B.hPut stdout c+ hFlush stdout+ Left e -> do putStrLn $ "error " ++ fn+ print e+ hFlush stdout+ transfer++readfile :: String -> IO (Either String B.ByteString)+readfile fn = (Right `fmap` B.readFile fn) `catch` (\e -> return $ Left (prettyException e))+
− src/Darcs/Commands/TransferMode.lhs
@@ -1,88 +0,0 @@-% Copyright (C) 2008 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.--\darcsCommand{transfer-mode}-\begin{code}-{-# OPTIONS_GHC -cpp -fglasgow-exts #-}-{-# LANGUAGE CPP, PatternGuards #-}---- The pragma above is only for pattern guards.-module Darcs.Commands.TransferMode ( transferMode ) where--import Prelude hiding ( catch )-import Control.Exception.Extensible ( catch )-import System.IO ( stdout, hFlush )--import Darcs.Utils ( withCurrentDirectory, prettyException )-import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Arguments ( DarcsFlag, workingRepoDir )-import Darcs.Repository ( amInRepository )-import Progress ( setProgressMode )-import Darcs.Global ( darcsdir )--import qualified Data.ByteString as B (hPut, readFile, length, ByteString)--transferModeDescription :: String-transferModeDescription = "Internal command for efficient ssh transfers."--transferModeHelp :: String-transferModeHelp =- "When pulling from or pushing to a remote repository over ssh, if both\n" ++- "the local and remote ends have Darcs 2, the `transfer-mode' command\n" ++- "will be invoked on the remote end. This allows Darcs to intelligently\n" ++- "transfer information over a single ssh connection.\n" ++- "\n" ++- "If either end runs Darcs 1, a separate ssh connection will be created\n" ++- "for each transfer. As well as being less efficient, this means users\n" ++- "who do not run ssh-agent will be prompted for the ssh password tens or\n" ++- "hundreds of times!\n"--transferMode :: DarcsCommand-transferMode = DarcsCommand {commandName = "transfer-mode",- commandHelp = transferModeHelp,- commandDescription = transferModeDescription,- commandExtraArgs = 0,- commandExtraArgHelp = [],- commandGetArgPossibilities = return [],- commandCommand = transferModeCmd,- commandPrereq = amInRepository,- commandArgdefaults = nodefaults,- commandAdvancedOptions = [],- commandBasicOptions = [workingRepoDir]}--transferModeCmd :: [DarcsFlag] -> [String] -> IO ()-transferModeCmd _ _ = do setProgressMode False- putStrLn "Hello user, I am darcs transfer mode"- hFlush stdout- withCurrentDirectory darcsdir $ transfer--transfer :: IO ()-transfer = do 'g':'e':'t':' ':fn <- getLine- x <- readfile fn- case x of- Right c -> do putStrLn $ "got " ++ fn- putStrLn $ show $ B.length c- B.hPut stdout c- hFlush stdout- Left e -> do putStrLn $ "error " ++ fn- putStrLn $ show e- hFlush stdout- transfer--readfile :: String -> IO (Either String B.ByteString)-readfile fn = (Right `fmap` B.readFile fn) `catch` (\e -> return $ Left (prettyException e))-\end{code}
+ src/Darcs/Commands/Unrecord.hs view
@@ -0,0 +1,253 @@+-- Copyright (C) 2002-2005 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.++{-# LANGUAGE CPP #-}++module Darcs.Commands.Unrecord ( unrecord, unpull, obliterate, getLastPatches ) where+import Control.Monad ( when )+import System.Exit ( exitWith, ExitCode( ExitSuccess ) )+import Data.Maybe( isJust )++import Printer ( text, putDoc )+import English ( presentParticiple )+import Darcs.Patch.PatchInfoAnd ( hopefully, patchDesc )+import Darcs.Commands ( DarcsCommand(..), nodefaults, commandAlias,+ putVerbose )+import Darcs.Arguments ( DarcsFlag,+ output, outputAutoName, getOutput,+ workingRepoDir, nocompress, setEnvDarcsPatches,+ matchSeveralOrLast, depsSel,+ ignoretimes,+ allInteractive, umaskOption, summary, dryRun,+ printDryRunMessageAndExit, changesReverse+ )+import Darcs.Flags ( doReverse, UseIndex(..), ScanKnown(..), compression )+import Darcs.Match ( firstMatch, matchFirstPatchset, matchAPatchread )+import Darcs.Repository ( PatchInfoAnd, withGutsOf,+ withRepoLock, RepoJob(..),+ tentativelyRemovePatches, finalizeRepositoryChanges,+ tentativelyAddToPending,+ applyToWorking,+ readRepo, amInHashedRepository,+ invalidateIndex, unrecordedChanges )+import Darcs.Patch ( RepoPatch, invert, commute, effect )+import Darcs.Patch.Set ( PatchSet(..), Tagged(..), appendPSFL )+#ifdef GADT_WITNESSES+import Darcs.Patch.Set ( Origin )+#endif+import Darcs.Witnesses.Ordered ( RL(..), (:>)(..), (+<+),+ mapFL_FL, nullFL,+ reverseRL, mapRL, FL(..) )+import Darcs.Patch.Depends ( findCommonWithThem )+import Darcs.SelectChanges ( selectChanges+ , WhichChanges(..)+ , selectionContext, runSelection )+import Darcs.Patch.Bundle ( makeBundleN, patchFilename, contextPatches )+import Progress ( debugMessage )+import Darcs.Witnesses.Sealed ( Sealed(..) )+import Darcs.RepoPath( useAbsoluteOrStd )+import Darcs.Lock( writeDocBinFile )+#include "gadts.h"++unrecordDescription :: String+unrecordDescription =+ "Remove recorded patches without changing the working copy."++unrecordHelp :: String+unrecordHelp =+ "Unrecord does the opposite of record in that it makes the changes from\n"+++ "patches active changes again which you may record or revert later. The\n"+++ "working copy itself will not change.\n"+++ "Beware that you should not use this command if you are going to\n"+++ "re-record the changes in any way and there is a possibility that\n"+++ "another user may have already pulled the patch.\n"++unrecord :: DarcsCommand+unrecord = DarcsCommand {commandProgramName = "darcs",+ commandName = "unrecord",+ commandHelp = unrecordHelp,+ commandDescription = unrecordDescription,+ commandExtraArgs = 0,+ commandExtraArgHelp = [],+ commandCommand = unrecordCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions =+ [nocompress,umaskOption,changesReverse],+ commandBasicOptions = [matchSeveralOrLast,+ depsSel,+ allInteractive,+ workingRepoDir]}++unrecordCmd :: [DarcsFlag] -> [String] -> IO ()+unrecordCmd opts _ = withRepoLock opts $ RepoJob $ \repository -> do+ allpatches <- readRepo repository+ (_ :> patches) <- return $ if firstMatch opts+ then getLastPatches opts allpatches+ else matchingHead opts allpatches+ let context = selectionContext "unrecord" opts Nothing Nothing+ selector = if doReverse opts+ then selectChanges Last+ else selectChanges LastReversed+ (_ :> to_unrecord) <- runSelection (selector patches) context+ when (nullFL to_unrecord) $ do putStrLn "No patches selected!"+ exitWith ExitSuccess+ putVerbose opts $ text+ "About to write out (potentially) modified patches..."+ setEnvDarcsPatches to_unrecord+ invalidateIndex repository+-- Warning: A do-notation statement discarded a result of type Darcs.Repository.InternalTypes.Repository p r u z.+ withGutsOf repository $ do _ <- tentativelyRemovePatches repository (compression opts) to_unrecord+ finalizeRepositoryChanges repository+ putStrLn "Finished unrecording."++getLastPatches :: RepoPatch p => [DarcsFlag] -> PatchSet p C(Origin r)+ -> ((PatchSet p) :> (FL (PatchInfoAnd p))) C(Origin r)+getLastPatches opts ps =+ case matchFirstPatchset opts ps of+ Sealed p1s -> findCommonWithThem ps p1s++unpullDescription :: String+unpullDescription =+ "Opposite of pull; unsafe if patch is not in remote repository."++unpullHelp :: String+unpullHelp =+ "Unpull completely removes recorded patches from your local repository.\n"+++ "The changes will be undone in your working copy and the patches will not be\n"+++ "shown in your changes list anymore.\n"+++ "Beware that if the patches are not still present in another repository you\n"+++ "will lose precious code by unpulling!\n"++unpull :: DarcsCommand+unpull = (commandAlias "unpull" Nothing obliterate)+ {commandHelp = unpullHelp,+ commandDescription = unpullDescription,+ commandCommand = unpullCmd}++unpullCmd :: [DarcsFlag] -> [String] -> IO ()+unpullCmd = genericObliterateCmd "unpull"+++obliterateDescription :: String+obliterateDescription =+ "Delete selected patches from the repository. (UNSAFE!)"++obliterateHelp :: String+obliterateHelp =+ "Obliterate completely removes recorded patches from your local repository.\n"+++ "The changes will be undone in your working copy and the patches will not be\n"+++ "shown in your changes list anymore.\n"+++ "Beware that you can lose precious code by obliterating!\n"++obliterate :: DarcsCommand+obliterate = DarcsCommand {commandProgramName = "darcs",+ commandName = "obliterate",+ commandHelp = obliterateHelp,+ commandDescription = obliterateDescription,+ commandExtraArgs = 0,+ commandExtraArgHelp = [],+ commandCommand = obliterateCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [nocompress,ignoretimes,umaskOption, changesReverse],+ commandBasicOptions = [matchSeveralOrLast,+ depsSel,+ allInteractive,+ workingRepoDir,+ summary,+ output,+ outputAutoName]+++ dryRun}+obliterateCmd :: [DarcsFlag] -> [String] -> IO ()+obliterateCmd = genericObliterateCmd "obliterate"++-- | genericObliterateCmd is the function that executes the "obliterate" and+-- "unpull" commands.+genericObliterateCmd :: String -- ^ The name under which the command is invoked (@unpull@ or @obliterate@)+ -> [DarcsFlag] -- ^ The flags given on the command line+ -> [String] -- ^ Files given on the command line (unused)+ -> IO ()+genericObliterateCmd cmdname opts _ = withRepoLock opts $ RepoJob $ \repository -> do+ -- FIXME we may need to honour --ignore-times here, although this command+ -- does not take that option (yet)+ pend <- unrecordedChanges (UseIndex, ScanKnown) repository Nothing+ allpatches <- readRepo repository+ (auto_kept :> removal_candidates) <- return $+ if firstMatch opts+ then getLastPatches opts allpatches+ else matchingHead opts allpatches+ let+ context = selectionContext cmdname opts Nothing Nothing+ selector = if doReverse opts+ then selectChanges Last+ else selectChanges LastReversed+ (kept :> removed) <- runSelection (selector removal_candidates) context+ when (nullFL removed) $ do putStrLn "No patches selected!"+ exitWith ExitSuccess+ case commute (effect removed :> pend) of+ Nothing -> fail $ "Can't "++ cmdname +++ " patch without reverting some unrecorded change."+ Just (_ :> p_after_pending) -> do+ printDryRunMessageAndExit "obliterate" opts removed+ setEnvDarcsPatches removed+ when (isJust $ getOutput opts "") $+ savetoBundle opts (auto_kept `appendPSFL` kept) removed+ invalidateIndex repository+ withGutsOf repository $+-- Warning: A do-notation statement discarded a result of type Darcs.Repository.InternalTypes.Repository p r u z.+ do _ <- tentativelyRemovePatches repository (compression opts) removed+ tentativelyAddToPending repository opts $ invert $ effect removed+ finalizeRepositoryChanges repository+ debugMessage "Applying patches to working directory..."+ _ <- applyToWorking repository opts (invert p_after_pending) `catch` \e ->+ fail ("Couldn't undo patch in working dir.\n" ++ show e)+ return ()+ putStrLn $ "Finished " ++ presentParticiple cmdname ++ "."++-- | matchingHead returns the repository up to some tag. The tag t is+-- the last tag such that there is a patch after t that is matched by+-- the user's query.+matchingHead :: forall p C(r). RepoPatch p =>+ [DarcsFlag] -> PatchSet p C(Origin r)+ -> (PatchSet p :> FL (PatchInfoAnd p)) C(Origin r)+matchingHead opts set =+ case mh set of+ (start :> patches) -> (start :> reverseRL patches)+ where+ mh :: FORALL(x) PatchSet p C(Origin x)+ -> (PatchSet p :> RL (PatchInfoAnd p)) C(Origin x)+ mh s@(PatchSet x _)+ | or (mapRL (matchAPatchread opts) x) = contextPatches s+ mh (PatchSet x (Tagged t _ ps :<: ts))+ = case mh (PatchSet (t:<:ps) ts)+ of (start :> patches) -> (start :> x +<+ patches)+ mh ps = (ps :> NilRL)++savetoBundle :: RepoPatch p => [DarcsFlag]+ -> PatchSet p C(Origin z) -> FL (PatchInfoAnd p) C(z t)+ -> IO ()+savetoBundle opts kept removed@(x :>: _) = do+ bundle <- makeBundleN Nothing kept (mapFL_FL hopefully removed)+ let filename = patchFilename $ patchDesc x+ Just outname = getOutput opts filename+ useAbsoluteOrStd writeDocBinFile putDoc outname $ bundle++savetoBundle _ _ NilFL = return ()+
− src/Darcs/Commands/Unrecord.lhs
@@ -1,352 +0,0 @@-% Copyright (C) 2002-2005 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.--\darcsCommand{unrecord}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--module Darcs.Commands.Unrecord ( unrecord, unpull, obliterate, getLastPatches ) where-import Control.Monad ( when )-import System.Exit ( exitWith, ExitCode( ExitSuccess ) )-import Data.Maybe( isJust )--import Printer ( text, putDoc )-import English ( presentParticiple )-import Darcs.Hopefully ( hopefully, info, patchDesc )-import Darcs.Commands ( DarcsCommand(..), nodefaults, commandAlias,- putVerbose )-import Darcs.Arguments ( DarcsFlag,- output, outputAutoName, getOutput,- workingRepoDir, nocompress, definePatches,- matchSeveralOrLast, depsSel,- ignoretimes,- allInteractive, umaskOption, summary, dryRun,- printDryRunMessageAndExit, changesReverse- )-import Darcs.Flags ( doReverse )-import Darcs.Match ( firstMatch, matchFirstPatchset, matchAPatchread )-import Darcs.Repository ( PatchInfoAnd, withGutsOf,- withRepoLock, ($-),- tentativelyRemovePatches, finalizeRepositoryChanges,- tentativelyAddToPending,- applyToWorking,- readRepo, amInRepository- , invalidateIndex, unrecordedChanges )-import Darcs.Patch ( Patchy, RepoPatch, invert, commute, effect )-import Darcs.Patch.Set ( PatchSet(..), Tagged(..) )-#ifdef GADT_WITNESSES-import Darcs.Patch.Set ( Origin )-#endif-import Darcs.Witnesses.Ordered ( RL(..), (:>)(..), (+<+), (:>>)(..), reverseFL,- mapFL_FL, nullFL,- reverseRL, mapRL, FL(..), mapFL )-import Darcs.Patch.Depends ( findCommonWithThem )-import Darcs.SelectChanges ( selectChanges- , WhichChanges(..)- , selectionContext, runSelection )-import Darcs.Patch.Bundle ( makeBundle, patchFilename, contextPatches )-import Progress ( debugMessage )-import Darcs.Witnesses.Sealed ( Sealed(..), FlippedSeal(..), mapFlipped )-import Darcs.RepoPath( useAbsoluteOrStd )-import Darcs.Lock( writeDocBinFile )-#include "gadts.h"--unrecordDescription :: String-unrecordDescription =- "Remove recorded patches without changing the working copy."-\end{code}--Unrecord can be thought of as undo-record.-If a record is followed by an unrecord, everything looks like before-the record; all the previously unrecorded changes are back, and can be-recorded again in a new patch. The unrecorded patch however is actually-removed from your repository, so there is no way to record it again to get-it back.\footnote{The patch file itself is not actually deleted, but its-context is lost, so it cannot be reliably read---your only choice would be-to go in by hand and read its contents.}.--If you want to remove-the changes from the working copy too (where they otherwise will show-up as unrecorded changes again), you'll also need to \verb!darcs revert!.-To do unrecord and revert in one go, you can use \verb!darcs obliterate!.--If you don't revert after unrecording, then the changes made by the-unrecorded patches are left in your working tree. If these patches are-actually from another repository, interaction (either pushes or pulls) with-that repository may be massively slowed down, as darcs tries to cope with-the fact that you appear to have made a large number of changes that-conflict with those present in the other repository. So if you really want-to undo the result of a \emph{pull} operation, use obliterate! Unrecord is-primarily intended for when you record a patch, realize it needs just one-more change, but would rather not have a separate patch for just that one-change.--\newcommand{\pullwarning}[1]{-\textbf{WARNING:} #1 should not be run when there is a possibility-that another user may be pulling from the same repository. Attempting to do so-may cause repository corruption.}--\pullwarning{Unrecord}--\begin{options}---from-match, --from-patch, --from-tag, --last-\end{options}--Usually you only want to unrecord the latest changes,-and almost never would you want to unrecord changes before a tag---you-would have to have unrecorded the tag as well to do that.-Therefore, and for efficiency, darcs only prompts you for the latest patches,-after some optimal tag.--If you do want to unrecord more patches in one go,-there are the \verb!--from! and \verb!--last! options-to set the earliest patch selectable to unrecord.--\begin{options}---matches, --patches, --tags, --no-deps-\end{options}--The \verb!--patches!, \verb!--matches!, \verb!--tags!, and \verb!--no-deps!-options can be used to select which patches to unrecord, as described in-subsection~\ref{selecting}.--With these options you can specify-what patch or patches to be prompted for by unrecord.-This is especially useful when you want to unrecord patches with dependencies,-since all the dependent patches (but no others) will be included in the choices.-Or if you use \verb!--no-deps! you won't be asked about patches that can't be-unrecorded due to depending patches.--Selecting patches can be slow, so darcs cuts the search at the last-optimized tag. Use the \verb!--from! or \verb!--last! options to search-more or fewer patches.--\begin{code}-unrecordHelp :: String-unrecordHelp =- "Unrecord does the opposite of record in that it makes the changes from\n"++- "patches active changes again which you may record or revert later. The\n"++- "working copy itself will not change.\n"++- "Beware that you should not use this command if you are going to\n"++- "re-record the changes in any way and there is a possibility that\n"++- "another user may have already pulled the patch.\n"--unrecord :: DarcsCommand-unrecord = DarcsCommand {commandName = "unrecord",- commandHelp = unrecordHelp,- commandDescription = unrecordDescription,- commandExtraArgs = 0,- commandExtraArgHelp = [],- commandCommand = unrecordCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions =- [nocompress,umaskOption,changesReverse],- commandBasicOptions = [matchSeveralOrLast,- depsSel,- allInteractive,- workingRepoDir]}--unrecordCmd :: [DarcsFlag] -> [String] -> IO ()-unrecordCmd opts _ = withRepoLock opts $- \repository -> do- allpatches <- readRepo repository- FlippedSeal patches <- return $ if firstMatch opts- then getLastPatches opts allpatches- else matchingHead opts allpatches- let context = selectionContext "unrecord" opts Nothing []- selector = if doReverse opts- then selectChanges Last- else selectChanges LastReversed- (_ :> to_unrecord) <- runSelection (selector (reverseRL patches)) context- when (nullFL to_unrecord) $ do putStrLn "No patches selected!"- exitWith ExitSuccess- putVerbose opts $ text- "About to write out (potentially) modified patches..."- definePatches to_unrecord- invalidateIndex repository- withGutsOf repository $ do tentativelyRemovePatches repository opts to_unrecord- finalizeRepositoryChanges repository- putStrLn "Finished unrecording."--getLastPatches :: RepoPatch p => [DarcsFlag] -> PatchSet p C(Origin r)- -> FlippedSeal (RL (PatchInfoAnd p)) C(r)-getLastPatches opts ps =- case matchFirstPatchset opts ps of- Sealed p1s -> case findCommonWithThem ps p1s of _ :>> us -> FlippedSeal (reverseFL us)--unpullDescription :: String-unpullDescription =- "Opposite of pull; unsafe if patch is not in remote repository."--unpullHelp :: String-unpullHelp =- "Unpull completely removes recorded patches from your local repository.\n"++- "The changes will be undone in your working copy and the patches will not be\n"++- "shown in your changes list anymore.\n"++- "Beware that if the patches are not still present in another repository you\n"++- "will lose precious code by unpulling!\n"--unpull :: DarcsCommand-unpull = (commandAlias "unpull" Nothing obliterate)- {commandHelp = unpullHelp,- commandDescription = unpullDescription,- commandCommand = unpullCmd}--unpullCmd :: [DarcsFlag] -> [String] -> IO ()-unpullCmd = genericObliterateCmd "unpull"--\end{code}-\darcsCommand{obliterate}-\begin{code}--obliterateDescription :: String-obliterateDescription =- "Delete selected patches from the repository. (UNSAFE!)"--obliterateHelp :: String-obliterateHelp =- "Obliterate completely removes recorded patches from your local repository.\n"++- "The changes will be undone in your working copy and the patches will not be\n"++- "shown in your changes list anymore.\n"++- "Beware that you can lose precious code by obliterating!\n"--\end{code}-Obliterate deletes a patch from the repository \emph{and} removes those-changes from the working directory. It is therefore a \emph{very-dangerous} command. When there are no local changes, obliterate is-equivalent to an unrecord followed by a revert, except that revert can be-unreverted. In the case of tags, obliterate removes the tag itself, not-any other patches.--Note that unpull was the old name for obliterate. Unpull is still an-hidden alias for obliterate.--\pullwarning{Obliterate}--\begin{options}---from-match, --from-patch, --from-tag, --last-\end{options}--Usually you only want to obliterate the latest changes, and almost never would-you want to obliterate changes before a tag---you would have to have obliterated-the tag as well to do that. Therefore, and for efficiency, darcs only-prompts you for the latest patches, after some optimal tag.--If you do want to obliterate more patches in one go, there are the-\verb!--from! and \verb!--last! options to set the earliest patch-selectable to obliterate.--\begin{options}---matches, --patches, --tags, --no-deps-\end{options}--The \verb!--patches!, \verb!--matches!, \verb!--tags!, and \verb!--no-deps!-options can be used to select which patches to obliterate, as described in-subsection~\ref{selecting}.--With these options you can specify what patch or patches to be prompted for-by obliterate. This is especially useful when you want to obliterate patches with-dependencies, since all the dependent patches (but no others) will be-included in the choices. Or if you use \verb!--no-deps! you won't be asked-about patches that can't be obliterated due to depending patches.--Selecting patches can be slow, so darcs cuts the search at the last-optimized tag. Use the \verb!--from! or \verb!--last! options to search-more or fewer patches.--\begin{code}-obliterate :: DarcsCommand-obliterate = DarcsCommand {commandName = "obliterate",- commandHelp = obliterateHelp,- commandDescription = obliterateDescription,- commandExtraArgs = 0,- commandExtraArgHelp = [],- commandCommand = obliterateCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [nocompress,ignoretimes,umaskOption, changesReverse],- commandBasicOptions = [matchSeveralOrLast,- depsSel,- allInteractive,- workingRepoDir,- summary]++- dryRun}-obliterateCmd :: [DarcsFlag] -> [String] -> IO ()-obliterateCmd = genericObliterateCmd "obliterate"---- | genericObliterateCmd is the function that executes the "obliterate" and--- "unpull" commands.-genericObliterateCmd :: String -- ^ The name under which the command is invoked (@unpull@ or @obliterate@)- -> [DarcsFlag] -- ^ The flags given on the command line- -> [String] -- ^ Files given on the command line (unused)- -> IO ()-genericObliterateCmd cmdname opts _ = withRepoLock opts $- \repository -> do- pend <- unrecordedChanges opts repository []- allpatches <- readRepo repository- FlippedSeal patches <- return $ if firstMatch opts- then getLastPatches opts allpatches- else matchingHead opts allpatches- let- context = selectionContext cmdname opts Nothing []- selector = if doReverse opts- then selectChanges Last- else selectChanges LastReversed- (kept :> removed) <- runSelection (selector (reverseRL patches)) context- case commute (effect removed :> pend) of- Nothing -> fail $ "Can't "++ cmdname ++- " patch without reverting some unrecorded change."- Just (_ :> p_after_pending) -> do- when (nullFL removed) $ do putStrLn "No patches selected!"- exitWith ExitSuccess- printDryRunMessageAndExit "obliterate" opts removed- definePatches removed- when (isJust $ getOutput opts "") $- savetoBundle opts (reverseFL kept) removed- invalidateIndex repository- withGutsOf repository $- do tentativelyRemovePatches repository opts removed- tentativelyAddToPending repository opts $ invert $ effect removed- finalizeRepositoryChanges repository- debugMessage "Applying patches to working directory..."- applyToWorking repository opts (invert p_after_pending) `catch` \e ->- fail ("Couldn't undo patch in working dir.\n" ++ show e)- return ()- putStrLn $ "Finished " ++ presentParticiple cmdname ++ "."--matchingHead :: RepoPatch p => [DarcsFlag] -> PatchSet p C(Origin r)- -> FlippedSeal (RL (PatchInfoAnd p)) C(r)-matchingHead opts set@(PatchSet x _)- | or (mapRL (matchAPatchread opts) x) = contextPatches set-matchingHead opts (PatchSet x (Tagged t _ ps :<: ts))- = (x +<+) `mapFlipped` matchingHead opts (PatchSet (t:<:ps) ts)-matchingHead _ (PatchSet _ NilRL) = FlippedSeal NilRL--savetoBundle :: RepoPatch p => [DarcsFlag]- -> RL (PatchInfoAnd p) C(x z) -> FL (PatchInfoAnd p) C(z t)- -> IO ()-savetoBundle opts kept removed@(x :>: _) = do- bundle <- makeBundle Nothing kept (mapFL_FL hopefully removed)- let filename = patchFilename $ patchDesc x- Just outname = getOutput opts filename- useAbsoluteOrStd writeDocBinFile putDoc outname $ bundle--savetoBundle _ _ NilFL = return ()-\end{code}-
+ src/Darcs/Commands/Unrevert.hs view
@@ -0,0 +1,132 @@+-- Copyright (C) 2003-2005 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.++{-# LANGUAGE CPP, GADTs #-}++#include "gadts.h"++module Darcs.Commands.Unrevert ( unrevert, writeUnrevert ) where+import System.Exit ( ExitCode(..), exitWith )+import Storage.Hashed.Tree( Tree )++import Darcs.Commands ( DarcsCommand(..), nodefaults )+import Darcs.Flags( diffingOpts )+import Darcs.Arguments ( DarcsFlag( MarkConflicts ),+ ignoretimes, workingRepoDir,+ allInteractive, umaskOption,+ )+import Darcs.Repository ( SealedPatchSet, Repository, withRepoLock, RepoJob(..),+ unrevertUrl, considerMergeToWorking,+ tentativelyAddToPending, finalizeRepositoryChanges,+ readRepo, amInHashedRepository,+ readRecorded,+ applyToWorking, unrecordedChanges )+import Darcs.Patch ( RepoPatch, PrimOf, commute, namepatch, fromPrims )+#ifdef GADT_WITNESSES+import Darcs.Patch.Set ( Origin )+#endif+import Darcs.Witnesses.Ordered ( FL(..), (:>)(..), (+>+) )+import Darcs.SelectChanges ( selectChanges, WhichChanges(First),+ runSelection, selectionContextPrim )+import qualified Data.ByteString as B+import Darcs.Lock ( writeDocBinFile, removeFileMayNotExist )+import Darcs.Patch.Depends ( mergeThem )+import Darcs.Utils ( askUser, catchall )+import Darcs.Patch.Bundle ( scanBundle, makeBundleN )+import IsoDate ( getIsoDateTime )+import Darcs.SignalHandler ( withSignalsBlocked )+import Progress ( debugMessage )+import Darcs.Witnesses.Sealed ( Sealed(Sealed) )+#include "impossible.h"++unrevertDescription :: String+unrevertDescription =+ "Undo the last revert (may fail if changes after the revert)."++unrevertHelp :: String+unrevertHelp =+ "Unrevert is a rescue command in case you accidentally reverted\n" +++ "something you wanted to keep (for example, typing `darcs rev -a'\n" +++ "instead of `darcs rec -a').\n" +++ "\n" +++ "This command may fail if the repository has changed since the revert\n" +++ "took place. Darcs will ask for confirmation before executing an\n" +++ "interactive command that will DEFINITELY prevent unreversion.\n"++unrevert :: DarcsCommand+unrevert = DarcsCommand {commandProgramName = "darcs",+ commandName = "unrevert",+ commandHelp = unrevertHelp,+ commandDescription = unrevertDescription,+ commandExtraArgs = 0,+ commandExtraArgHelp = [],+ commandCommand = unrevertCmd,+ commandPrereq = amInHashedRepository,+ commandGetArgPossibilities = return [],+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [umaskOption],+ commandBasicOptions = [ignoretimes,+ allInteractive,+ workingRepoDir]}++unrevertCmd :: [DarcsFlag] -> [String] -> IO ()+unrevertCmd opts [] = withRepoLock opts $ RepoJob $ \repository -> do+ us <- readRepo repository+ Sealed them <- unrevertPatchBundle repository+ rec <- readRecorded repository+ unrec <- unrecordedChanges (diffingOpts opts {- always ScanKnown here -}) repository Nothing+ Sealed h_them <- return $ mergeThem us them+ Sealed pw <- considerMergeToWorking repository "pull" (MarkConflicts:opts) NilFL h_them+ let context = selectionContextPrim "unrevert" opts Nothing Nothing+ (p :> skipped) <- runSelection (selectChanges First pw) context+ tentativelyAddToPending repository opts p+ withSignalsBlocked $+ do finalizeRepositoryChanges repository+ _ <- applyToWorking repository opts p `catch` \e ->+ fail ("Error applying unrevert to working directory...\n"+ ++ show e)+ debugMessage "I'm about to writeUnrevert."+ writeUnrevert repository skipped rec (unrec+>+p)+ debugMessage "Finished unreverting."+unrevertCmd _ _ = impossible++writeUnrevert :: RepoPatch p => Repository p C(r u t) -> FL (PrimOf p) C(x y)+ -> Tree IO -> FL (PrimOf p) C(r x) -> IO ()+writeUnrevert repository NilFL _ _ = removeFileMayNotExist $ unrevertUrl repository+writeUnrevert repository ps rec pend = do+ case commute (pend :> ps) of+ Nothing -> do really <- askUser "You will not be able to unrevert this operation! Proceed? "+ case really of ('y':_) -> return ()+ _ -> exitWith $ ExitSuccess+ writeUnrevert repository NilFL rec pend+ Just (p' :> _) -> do+ rep <- readRepo repository+ date <- getIsoDateTime+ np <- namepatch date "unrevert" "anon" [] (fromRepoPrims repository p')+ bundle <- makeBundleN (Just rec) rep (np :>: NilFL)+ writeDocBinFile (unrevertUrl repository) bundle+ where fromRepoPrims :: RepoPatch p => Repository p C(r u t) -> FL (PrimOf p) C(r y) -> FL p C(r y)+ fromRepoPrims _ xs = fromPrims xs++unrevertPatchBundle :: RepoPatch p => Repository p C(r u t) -> IO (SealedPatchSet p C(Origin))+unrevertPatchBundle repository = do+ pf <- B.readFile (unrevertUrl repository)+ `catchall` fail "There's nothing to unrevert!"+ case scanBundle pf of+ Right ps -> return ps+ Left err -> fail $ "Couldn't parse unrevert patch:\n" ++ err+
− src/Darcs/Commands/Unrevert.lhs
@@ -1,134 +0,0 @@-% Copyright (C) 2003-2005 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.--\darcsCommand{unrevert}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP, GADTs #-}--#include "gadts.h"--module Darcs.Commands.Unrevert ( unrevert, writeUnrevert ) where-import System.Exit ( ExitCode(..), exitWith )-import Storage.Hashed.Tree( Tree )--import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Arguments ( DarcsFlag( Unified, MarkConflicts ),- ignoretimes, workingRepoDir,- allInteractive, umaskOption,- )-import Darcs.Repository ( SealedPatchSet, Repository, withRepoLock, ($-),- unrevertUrl, considerMergeToWorking,- tentativelyAddToPending, finalizeRepositoryChanges,- readRepo, amInRepository,- readRecorded,- applyToWorking, unrecordedChanges )-import Darcs.Patch ( RepoPatch, Prim, commute, namepatch, fromPrims )-#ifdef GADT_WITNESSES-import Darcs.Patch.Set ( Origin )-#endif-import Darcs.Patch.Set ( PatchSet(..) )-import Darcs.Witnesses.Ordered ( FL(..), (:>)(..), (+>+) )-import Darcs.SelectChanges ( selectChanges, WhichChanges(First),- runSelection, selectionContextPrim )-import qualified Data.ByteString as B-import Darcs.Lock ( writeDocBinFile, removeFileMayNotExist )-import Darcs.Patch.Depends ( mergeThem )-import Darcs.Utils ( askUser, catchall )-import Darcs.Patch.Bundle ( scanBundle, makeBundleN )-import IsoDate ( getIsoDateTime )-import Darcs.SignalHandler ( withSignalsBlocked )-import Progress ( debugMessage )-import Darcs.Witnesses.Sealed ( Sealed(Sealed) )-#include "impossible.h"--unrevertDescription :: String-unrevertDescription =- "Undo the last revert (may fail if changes after the revert)."--unrevertHelp :: String-unrevertHelp =- "Unrevert is a rescue command in case you accidentally reverted\n" ++- "something you wanted to keep (for example, typing `darcs rev -a'\n" ++- "instead of `darcs rec -a').\n" ++- "\n" ++- "This command may fail if the repository has changed since the revert\n" ++- "took place. Darcs will ask for confirmation before executing an\n" ++- "interactive command that will DEFINITELY prevent unreversion.\n"--unrevert :: DarcsCommand-unrevert = DarcsCommand {commandName = "unrevert",- commandHelp = unrevertHelp,- commandDescription = unrevertDescription,- commandExtraArgs = 0,- commandExtraArgHelp = [],- commandCommand = unrevertCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = return [],- commandArgdefaults = nodefaults,- commandAdvancedOptions = [umaskOption],- commandBasicOptions = [ignoretimes,- allInteractive,- workingRepoDir]}--unrevertCmd :: [DarcsFlag] -> [String] -> IO ()-unrevertCmd opts [] = withRepoLock opts $- \repository -> do- us <- readRepo repository- Sealed them <- unrevertPatchBundle repository- rec <- readRecorded repository- unrec <- unrecordedChanges opts repository []- Sealed h_them <- return $ mergeThem us them- Sealed pw <- considerMergeToWorking repository "pull" (MarkConflicts:opts) NilFL h_them- let context = selectionContextPrim "unrevert" opts Nothing []- (p :> skipped) <- runSelection (selectChanges First pw) context- tentativelyAddToPending repository opts p- withSignalsBlocked $- do finalizeRepositoryChanges repository- applyToWorking repository opts p `catch` \e ->- fail ("Error applying unrevert to working directory...\n"- ++ show e)- debugMessage "I'm about to writeUnrevert."- writeUnrevert repository skipped rec (unrec+>+p)- debugMessage "Finished unreverting."-unrevertCmd _ _ = impossible--writeUnrevert :: RepoPatch p => Repository p C(r u t) -> FL Prim C(x y)- -> Tree IO -> FL Prim C(r x) -> IO ()-writeUnrevert repository NilFL _ _ = removeFileMayNotExist $ unrevertUrl repository-writeUnrevert repository ps rec pend = do- case commute (pend :> ps) of- Nothing -> do really <- askUser "You will not be able to unrevert this operation! Proceed? "- case really of ('y':_) -> return ()- _ -> exitWith $ ExitSuccess- writeUnrevert repository NilFL rec pend- Just (p' :> _) -> do- rep <- readRepo repository- date <- getIsoDateTime- np <- namepatch date "unrevert" "anon" [] (fromRepoPrims repository p')- bundle <- makeBundleN (Just rec) rep (np :>: NilFL)- writeDocBinFile (unrevertUrl repository) bundle- where fromRepoPrims :: RepoPatch p => Repository p C(r u t) -> FL Prim C(r y) -> p C(r y)- fromRepoPrims _ xs = fromPrims xs--unrevertPatchBundle :: RepoPatch p => Repository p C(r u t) -> IO (SealedPatchSet p C(Origin))-unrevertPatchBundle repository = do- pf <- B.readFile (unrevertUrl repository)- `catchall` fail "There's nothing to unrevert!"- case scanBundle pf of- Right ps -> return ps- Left err -> fail $ "Couldn't parse unrevert patch:\n" ++ err-\end{code}
+ src/Darcs/Commands/Util.hs view
@@ -0,0 +1,57 @@+-- Copyright (C) 2002-2004 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.++{-# LANGUAGE CPP #-}++#include "gadts.h"++module Darcs.Commands.Util ( announceFiles, filterExistingFiles ) where++import Darcs.Arguments ( DarcsFlag(LookForAdds) )+import Darcs.Patch ( RepoPatch )+import Darcs.RepoPath ( SubPath, toFilePath )+import Darcs.Repository ( Repository, extractOptions, readRecordedAndPending,+ readUnrecorded )+import Darcs.Repository.State ( applyTreeFilter, restrictBoring )+import Storage.Hashed( floatPath, readPlainTree )+import Storage.Hashed.Monad ( virtualTreeIO, exists )++announceFiles :: Maybe [SubPath] -> String -> IO ()+announceFiles Nothing _ = return ()+announceFiles (Just files) message = putStrLn $ message ++ " " +++ unwords (map show files) ++ ":\n"++filterExistingFiles :: (RepoPatch p) => Repository p C(r u t) -> [SubPath] -> IO [SubPath]+filterExistingFiles repo files = do+ pristine <- readRecordedAndPending repo+ -- TODO this is slightly inefficient, since we should really somehow+ -- extract the unrecorded state as a side-effect of unrecordedChanges+ index <- readUnrecorded repo $ Just files+ nonboring <- restrictBoring index+ working <- applyTreeFilter nonboring `fmap` readPlainTree "."+ let paths = map toFilePath files+ check = virtualTreeIO (mapM exists $ map floatPath paths)+ (in_working, _) <- check working+ (in_pending, _) <- check pristine+ mapM_ maybe_warn $ zip3 paths in_working in_pending+ return [ path | (path, True) <- zip files (zipWith (||) in_working in_pending) ]+ where maybe_warn (file, False, False) =+ putStrLn $ "WARNING: File '"++file++"' does not exist!"+ maybe_warn (file, True, False) | LookForAdds `notElem` extractOptions repo =+ putStrLn $ "WARNING: File '" ++ file ++ "' not in repository!"+ maybe_warn _ = return ()+
+ src/Darcs/Commands/WhatsNew.hs view
@@ -0,0 +1,163 @@+-- Copyright (C) 2002-2004 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.++{-# LANGUAGE CPP #-}++#include "gadts.h"++module Darcs.Commands.WhatsNew ( whatsnew, status ) where+import System.Exit ( ExitCode(..), exitWith )+import Data.List ( sort, (\\) )+import Control.Monad ( when )+import Control.Applicative ( (<$>) )++import Darcs.Commands ( DarcsCommand(..), nodefaults, commandAlias )+import Darcs.Commands.Util ( announceFiles )+import Darcs.Arguments ( DarcsFlag(..), workingRepoDir, lookforadds,+ ignoretimes, noskipBoring,+ unified, summary,+ fixSubPaths,+ listRegisteredFiles,+ )+import Darcs.Flags( isUnified, diffingOpts )++import Darcs.Repository ( Repository, withRepository, RepoJob(..)+ , amInRepository+ , unrecordedChanges, readRecorded )+import Darcs.Repository.Prefs ( filetypeFunction )+import Darcs.Patch ( RepoPatch, PrimPatch, PrimOf, plainSummaryPrims, primIsHunk, applyToTree )+import Darcs.Patch.TouchesFiles( choosePreTouching )+import Darcs.Patch.Permutations ( partitionRL )+import Darcs.RepoPath( SubPath, toFilePath )+import Darcs.PrintPatch ( printPatch, contextualPrintPatch )+import Darcs.Witnesses.Ordered ( FL(..), reverseRL, reverseFL, (:>)(..), nullFL )+import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )+import Darcs.Diff( treeDiff )++import Printer ( putDocLn, renderString, vcat, text )++whatsnewDescription :: String+whatsnewDescription = "List unrecorded changes in the working tree."++whatsnewHelp :: String+whatsnewHelp =+ "The `darcs whatsnew' command lists unrecorded changes to the working\n" +++ "tree. If you specify a set of files and directories, only unrecorded\n" +++ "changes to those files and directories are listed.\n" +++ "\n" +++ "With the --summary option, the changes are condensed to one line per\n" +++ "file, with mnemonics to indicate the nature and extent of the change.\n" +++ "The --look-for-adds option causes candidates for `darcs add' to be\n" +++ "included in the summary output. Summary mnemonics are as follows:\n" +++ "\n" +++ " `A f' and `A d/' respectively mean an added file or directory.\n" +++ " `R f' and `R d/' respectively mean a removed file or directory.\n" +++ " `M f -N +M rP' means a modified file, with N lines deleted, M\n" +++ " lines added, and P lexical replacements.\n" +++ " `f -> g' means a moved file or directory.\n" +++ "\n" +++ " An exclamation mark (!) as in `R! foo.c', means the hunk is known to\n" +++ " conflict with a hunk in another patch. The phrase `duplicated'\n" +++ " means the hunk is known to be identical to a hunk in another patch.\n" +++ "\n" +++ "By default, `darcs whatsnew' uses Darcs' internal format for changes.\n" +++ "To see some context (unchanged lines) around each change, use the\n" +++ "--unified option. To view changes in conventional `diff' format, use\n" +++ "the `darcs diff' command; but note that `darcs whatsnew' is faster.\n" +++ "\n" +++ "This command exits unsuccessfully (returns a non-zero exit status) if\n" +++ "there are no unrecorded changes.\n"++whatsnew :: DarcsCommand+whatsnew = DarcsCommand {commandProgramName = "darcs",+ commandName = "whatsnew",+ commandHelp = whatsnewHelp,+ commandDescription = whatsnewDescription,+ commandExtraArgs = -1,+ commandExtraArgHelp = ["[FILE or DIRECTORY]..."],+ commandCommand = whatsnewCmd,+ commandPrereq = amInRepository,+ commandGetArgPossibilities = listRegisteredFiles,+ commandArgdefaults = nodefaults,+ commandAdvancedOptions = [ignoretimes, noskipBoring],+ commandBasicOptions = [summary, unified,+ lookforadds,+ workingRepoDir]}++filteredChanges :: RepoPatch p => [DarcsFlag] -> Repository p C(r u t)+ -> Maybe [SubPath] -> IO (Sealed (FL (PrimOf p) C(t)))+filteredChanges opts repo files =+ choosePreTouching (map toFilePath <$> files) `fmap` unrecordedChanges (diffingOpts opts) repo files++whatsnewCmd :: [DarcsFlag] -> [String] -> IO ()+whatsnewCmd opts' args+ | LookForAdds `elem` opts' && NoSummary `notElem` opts' =+ -- add Summary to the opts since 'darcs whatsnew --look-for-adds'+ -- implies summary+ withRepository (Summary:opts')+ $ RepoJob $ \(repository :: Repository p C(r u r)) -> do+ files <- if null args then return Nothing+ else Just <$> fixSubPaths opts' args+ announceFiles files "What's new in"+ Sealed all_changes <- filteredChanges opts' repository files+ Sealed chold <- filteredChanges (opts' \\ [LookForAdds]) repository files+ pristine <- readRecorded repository+ ftf <- filetypeFunction+ cho_adds :> _ <- return $ partitionRL primIsHunk $ reverseFL chold+ cha :> _ <- return $ partitionRL primIsHunk $ reverseFL all_changes++ cho_adds_t <- applyToTree (reverseRL cho_adds) pristine+ cha_t <- applyToTree (reverseRL cha) pristine+ Sealed chn <- unFreeLeft `fmap` treeDiff ftf cho_adds_t cha_t :: IO (Sealed (FL (PrimOf p) C(r)))++ exitOnNoChanges (chn, chold)+ putDocLn $ plainSummaryPrims chold+ printSummary chn+ where lower_as x = vcat $ map (text . l_as) $ lines x+ l_as ('A':x) = 'a':x+ l_as x = x+ exitOnNoChanges :: (FL prim C(x y), FL p C(u v)) -> IO ()+ exitOnNoChanges (NilFL, NilFL) = do putStrLn "No changes!"+ exitWith $ ExitFailure 1+ exitOnNoChanges _ = return ()+ printSummary :: PrimPatch prim => FL prim C(x y) -> IO ()+ printSummary NilFL = return ()+ printSummary new = putDocLn $ lower_as $ renderString $ plainSummaryPrims new++whatsnewCmd opts args+ | otherwise =+ withRepository opts $ RepoJob $ \repository -> do+ files <- if null args then return Nothing+ else Just . sort <$> fixSubPaths opts args+ announceFiles files "What's new in"+ Sealed changes <- filteredChanges opts repository files+ when (nullFL changes) $ putStrLn "No changes!" >> (exitWith $ ExitFailure 1)+ printSummary repository changes+ where printSummary :: RepoPatch p => Repository p C(r u t) -> FL (PrimOf p) C(r y) -> IO ()+ printSummary _ NilFL = do putStrLn "No changes!"+ exitWith $ ExitFailure 1+ printSummary r ch | Summary `elem` opts = putDocLn $ plainSummaryPrims ch+ | isUnified opts = do pristine <- readRecorded r+ contextualPrintPatch pristine ch+ | otherwise = printPatch ch++status :: DarcsCommand+status = (commandAlias "status" Nothing whatsnew)+ { commandCommand = \fs -> commandCommand whatsnew (Summary : LookForAdds : fs)+ , commandDescription = "Alias for `darcs " ++ commandName whatsnew ++ " -ls '."+ }+
− src/Darcs/Commands/WhatsNew.lhs
@@ -1,182 +0,0 @@-% Copyright (C) 2002-2004 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.--\darcsCommand{whatsnew}-\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--#include "gadts.h"--module Darcs.Commands.WhatsNew ( whatsnew, announceFiles ) where-import System.Exit ( ExitCode(..), exitWith )-import Data.List ( sort, (\\) )-import Control.Monad ( when )--import Darcs.Commands ( DarcsCommand(..), nodefaults )-import Darcs.Arguments ( DarcsFlag(..), workingRepoDir, lookforadds,- ignoretimes, noskipBoring,- unified, summary,- areFileArgs, fixSubPaths,- listRegisteredFiles,- )-import Darcs.Flags( isUnified )-import Darcs.RepoPath ( SubPath, sp2fn )--import Darcs.Repository ( Repository, withRepository, ($-)- , amInRepository, extractOptions- , unrecordedChanges, readRecordedAndPending, readRecorded, readUnrecorded )-import Darcs.Repository.State( restrictBoring, applyTreeFilter )-import Darcs.Repository.Prefs ( filetypeFunction )-import Darcs.Patch ( RepoPatch, Prim, plainSummary, primIsHunk, applyToTree )-import Darcs.Patch.TouchesFiles( choosePreTouching )-import Darcs.Patch.Permutations ( partitionRL )-import Darcs.Patch.Real ( RealPatch, prim2real )-import Darcs.RepoPath( toFilePath )-import Darcs.PrintPatch ( printPatch, contextualPrintPatch )-import Darcs.Witnesses.Ordered ( FL(..), mapFL_FL, reverseRL, reverseFL, (:>)(..), nullFL )-import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )-import Darcs.Diff( treeDiff )--import Storage.Hashed.Monad( virtualTreeIO, exists )-import Storage.Hashed( readPlainTree )-import Storage.Hashed( floatPath )--import Printer ( putDocLn, renderString, vcat, text )--whatsnewDescription :: String-whatsnewDescription = "List unrecorded changes in the working tree."--whatsnewHelp :: String-whatsnewHelp =- "The `darcs whatsnew' command lists unrecorded changes to the working\n" ++- "tree. If you specify a set of files and directories, only unrecorded\n" ++- "changes to those files and directories are listed.\n" ++- "\n" ++- "With the --summary option, the changes are condensed to one line per\n" ++- "file, with mnemonics to indicate the nature and extent of the change.\n" ++- "The --look-for-adds option causes candidates for `darcs add' to be\n" ++- "included in the summary output. Summary mnemonics are as follows:\n" ++- "\n" ++- " `A f' and `A d/' respectively mean an added file or directory.\n" ++- " `R f' and `R d/' respectively mean a removed file or directory.\n" ++- " `M f -N +M rP' means a modified file, with N lines deleted, M\n" ++- " lines added, and P lexical replacements.\n" ++- " `f -> g' means a moved file or directory.\n" ++- "\n" ++- " An exclamation mark (!) as in `R! foo.c', means the hunk is known to\n" ++- " conflict with a hunk in another patch. The phrase `duplicated'\n" ++- " means the hunk is known to be identical to a hunk in another patch.\n" ++- "\n" ++- "By default, `darcs whatsnew' uses Darcs' internal format for changes.\n" ++- "To see some context (unchanged lines) around each change, use the\n" ++- "--unified option. To view changes in conventional `diff' format, use\n" ++- "the `darcs diff' command; but note that `darcs whatsnew' is faster.\n" ++- "\n" ++- "This command exits unsuccessfully (returns a non-zero exit status) if\n" ++- "there are no unrecorded changes.\n"--whatsnew :: DarcsCommand-whatsnew = DarcsCommand {commandName = "whatsnew",- commandHelp = whatsnewHelp,- commandDescription = whatsnewDescription,- commandExtraArgs = -1,- commandExtraArgHelp = ["[FILE or DIRECTORY]..."],- commandCommand = whatsnewCmd,- commandPrereq = amInRepository,- commandGetArgPossibilities = listRegisteredFiles,- commandArgdefaults = nodefaults,- commandAdvancedOptions = [ignoretimes, noskipBoring],- commandBasicOptions = [summary, unified,- lookforadds,- workingRepoDir]}--filteredChanges opts repo files =- choosePreTouching (map toFilePath files) `fmap` unrecordedChanges opts repo files--announceFiles :: (RepoPatch p) => Repository p C(r u t) -> [SubPath] -> String -> IO [SubPath]-announceFiles repo files message =- if (areFileArgs files) then do- pristine <- readRecordedAndPending repo- -- TODO this is slightly inefficient, since we should really somehow- -- extract the unrecorded state as a side-effect of unrecordedChanges- index <- readUnrecorded repo files- nonboring <- restrictBoring index- working <- applyTreeFilter nonboring `fmap` readPlainTree "."- let paths = map toFilePath files- check = virtualTreeIO (mapM exists $ map floatPath paths)- (in_working, _) <- check working- (in_pending, _) <- check pristine- mapM_ maybe_warn $ zip3 paths in_working in_pending- putStrLn $ message ++ " " ++ unwords (map show files)++":\n"- return [ path | (path, True) <- zip files (zipWith (||) in_working in_pending) ]- else return files- where maybe_warn (file, False, False) =- putStrLn $ "WARNING: File '"++file++"' does not exist!"- maybe_warn (file, True, False) | LookForAdds `notElem` extractOptions repo =- putStrLn $ "WARNING: File '" ++ file ++ "' not in repository!"- maybe_warn _ = return ()--whatsnewCmd :: [DarcsFlag] -> [String] -> IO ()-whatsnewCmd opts' args- | LookForAdds `elem` opts' && NoSummary `notElem` opts' =- -- add Summary to the opts since 'darcs whatsnew --look-for-adds'- -- implies summary- withRepository (Summary:opts') $- \repository -> do- files <- fixSubPaths opts' args- announceFiles repository files "What's new in"- Sealed all_changes <- filteredChanges opts' repository files- Sealed chold <- filteredChanges (opts' \\ [LookForAdds]) repository files- pristine <- readRecorded repository- ftf <- filetypeFunction- cho_adds :> _ <- return $ partitionRL primIsHunk $ reverseFL chold- cha :> _ <- return $ partitionRL primIsHunk $ reverseFL all_changes-- cho_adds_t <- applyToTree (reverseRL cho_adds) pristine- cha_t <- applyToTree (reverseRL cha) pristine- Sealed chn <- unFreeLeft `fmap` treeDiff ftf cho_adds_t cha_t-- exitOnNoChanges (chn, chold)- putDocLn $ plainSummary chold- printSummary chn- where lower_as x = vcat $ map (text . l_as) $ lines x- l_as ('A':x) = 'a':x- l_as x = x- exitOnNoChanges :: (FL Prim C(x y), FL p C(u v)) -> IO ()- exitOnNoChanges (NilFL, NilFL) = do putStrLn "No changes!"- exitWith $ ExitFailure 1- exitOnNoChanges _ = return ()- printSummary :: FL Prim C(x y) -> IO ()- printSummary NilFL = return ()- printSummary new = putDocLn $ lower_as $ renderString $ plainSummary new--whatsnewCmd opts args- | otherwise =- withRepository opts $- \repository -> do- files <- sort `fmap` fixSubPaths opts args- announceFiles repository files "What's new in"- Sealed changes <- filteredChanges opts repository files- when (nullFL changes) $ putStrLn "No changes!" >> (exitWith $ ExitFailure 1)- printSummary repository $ mapFL_FL prim2real changes- where printSummary :: RepoPatch p => Repository p C(r u t) -> FL RealPatch C(r y) -> IO ()- printSummary _ NilFL = do putStrLn "No changes!"- exitWith $ ExitFailure 1- printSummary r ch | Summary `elem` opts = putDocLn $ plainSummary ch- | isUnified opts = do pristine <- readRecorded r- contextualPrintPatch pristine ch- | otherwise = printPatch ch-\end{code}
src/Darcs/CommandsAux.hs view
@@ -15,12 +15,12 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} #include "gadts.h" module Darcs.CommandsAux ( checkPaths, maliciousPatches, hasMaliciousPath,+ isMaliciousPath, isMaliciousSubPath, ) where import Darcs.Flags ( DarcsFlag( RestrictPaths, DontRestrictPaths ) ) import Darcs.Patch ( Patchy, listTouchedFiles )@@ -28,7 +28,7 @@ import Darcs.Witnesses.Sealed ( Sealed2(..), unseal2 ) import Darcs.Global ( darcsdir ) import Data.List ( intersect )-import System.FilePath ( splitDirectories )+import System.FilePath ( splitDirectories, isRelative ) -- * File paths {-@@ -102,7 +102,17 @@ -} isMaliciousPath :: String -> Bool isMaliciousPath fp =- not (isExplicitlyRelative fp) ||+ not (isExplicitlyRelative fp) || isGenerallyMalicious fp++-- | Warning : this is less rigorous than isMaliciousPath+-- but it's to allow for subpath representations that+-- don't start with ./+isMaliciousSubPath :: String -> Bool+isMaliciousSubPath fp =+ not (isRelative fp) || isGenerallyMalicious fp++isGenerallyMalicious :: String -> Bool+isGenerallyMalicious fp = splitDirectories fp `contains_any` [ "..", darcsdir ] where contains_any a b = not . null $ intersect a b
src/Darcs/Compat.hs view
@@ -69,8 +69,10 @@ mkStdoutTemp str = do (fd, fn) <- mkstempCore str hFlush stdout hFlush stderr- dupTo fd stdOutput- dupTo fd stdError+-- Warning: A do-notation statement discarded a result of type Fd.+ _ <- dupTo fd stdOutput+-- Warning: A do-notation statement discarded a result of type Fd.+ _ <- dupTo fd stdError hFlush stdout hFlush stderr hSetBuffering stdout NoBuffering
src/Darcs/Diff.hs view
@@ -24,7 +24,7 @@ import Darcs.Witnesses.Ordered ( FL(..), (+>+) ) import Darcs.Witnesses.Sealed ( Gap(..) ) import Darcs.Repository.Prefs ( FileType(..) )-import Darcs.Patch ( Prim, hunk, canonize, binary+import Darcs.Patch ( PrimPatch, hunk, canonize, binary , addfile, rmfile, adddir, rmdir, invert) import Storage.Hashed.Tree( diffTrees, zipTrees, TreeItem(..), Tree@@ -46,9 +46,9 @@ getDiff p Nothing (Just t) = (p, Added t) getDiff p (Just from) (Just to) = (p, Changed from to) getDiff p (Just t) Nothing = (p, Removed t)-getDiff p Nothing Nothing = impossible -- zipTrees should never return this+getDiff _ Nothing Nothing = impossible -- zipTrees should never return this -treeDiff :: forall m w . (Functor m, Monad m, Gap w) => (FilePath -> FileType) -> Tree m -> Tree m -> m (w (FL Prim))+treeDiff :: forall m w prim . (Functor m, Monad m, Gap w, PrimPatch prim) => (FilePath -> FileType) -> Tree m -> Tree m -> m (w (FL prim)) treeDiff ft t1 t2 = do (from, to) <- diffTrees t1 t2 diffs <- mapM (uncurry diff) $ sortBy organise $ zipTrees getDiff from to@@ -62,13 +62,13 @@ organise (p1, Added _) (p2, Added _) = compare p1 p2 organise (p1, Removed _) (p2, Removed _) = compare p2 p1 - organise (p1, Removed _) _ = LT- organise _ (p1, Removed _) = GT+ organise (_, Removed _) _ = LT+ organise _ (_, Removed _) = GT - organise (p1, Changed _ _) _ = LT- organise _ (p1, Changed _ _) = GT+ organise (_, Changed _ _) _ = LT+ organise _ (_, Changed _ _) = GT - diff :: AnchoredPath -> Diff m -> m (w (FL Prim))+ diff :: AnchoredPath -> Diff m -> m (w (FL prim)) diff _ (Changed (SubTree _) (SubTree _)) = return (emptyGap NilFL) diff p (Removed (SubTree _)) = return $ freeGap (rmdir (anchorPath "" p) :>: NilFL)
src/Darcs/Email.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} module Darcs.Email ( makeEmail, readEmail, formatHeader ) where @@ -200,9 +199,9 @@ text "DarcsURL:" <+> text repodir $$ foldl (\m (h,v) -> m $$ (text (h ++ ":") <+> text v)) empty headers $$ text "MIME-Version: 1.0"- $$ text "Content-Type: multipart/mixed; boundary=\"=_\""+ $$ text "Content-Type: multipart/mixed; boundary=\"=-\"" $$ text ""- $$ text "--=_"+ $$ text "--=-" $$ (case mcontents of Just contents -> text "Content-Type: text/plain"@@ -210,9 +209,21 @@ $$ text "" $$ packedString (qpencode (renderPS contents)) $$ text ""- $$ text "--=_"+ $$ text "--=-" Nothing -> empty)- $$ text "Content-Type: text/x-darcs-patch" <>+ $$ text "Content-Type: multipart/alternative; boundary=\"=_\""+ $$ text ""+ $$ text "--=_"+ $$ text "Content-Type: text/x-darcs-patch"+ $$ text "Content-Transfer-Encoding: quoted-printable"+ $$ text "Content-Description: Patch preview"+ $$ text ""+ $$ (case betweenLinesPS (BC.pack "New patches:") (BC.pack "Context:") (renderPS bundle) of+ Just s -> packedString $ qpencode s+ -- this should not happen, but in case it does, keep everything+ Nothing -> packedString $ qpencode $ renderPS bundle)+ $$ text "--=_"+ $$ text "Content-Type: application/x-darcs-patch" <> (case mfilename of Just filename -> text "; name=\"" <> text filename <> text "\"" Nothing -> empty)@@ -221,6 +232,7 @@ $$ text "" $$ packedString (qpencode (renderPS bundle)) $$ text "--=_--"+ $$ text "--=---" $$ text "" $$ text "." $$ text ""
src/Darcs/External.hs view
@@ -2,18 +2,18 @@ module Darcs.External ( backupByRenaming, backupByCopying,- copyFileOrUrl, speculateFileOrUrl, copyFilesOrUrls, copyLocal, cloneFile,- cloneTree, cloneTreeExcept, clonePartialsTree, clonePaths,+ copyFileOrUrl, speculateFileOrUrl, copyLocal, cloneFile,+ cloneTree, cloneTreeExcept, fetchFilePS, fetchFileLazyPS, gzFetchFilePS, sendEmail, generateEmail, sendEmailDoc, resendEmail, signString, verifyPS, execDocPipe, execPipeIgnoreError, getTermNColors, pipeDoc, pipeDocSSH, execSSH,- remoteDarcsCmd, maybeURLCmd, Cachable(Cachable, Uncachable, MaxAge), viewDoc, viewDocWith,+ haveSendmail, sendmailPath, diffProgram, darcsProgram ) where @@ -50,11 +50,12 @@ import System.Directory ( createDirectoryIfMissing ) import System.FilePath.Posix ( (</>), takeDirectory, normalise ) -import Darcs.Flags ( DarcsFlag( SignAs, Sign, SignSSL, NoLinks,- Verify, VerifySSL, RemoteDarcs ) )+import Darcs.Flags ( DarcsFlag( SignAs, Sign, SignSSL,+ Verify, VerifySSL )+ , RemoteDarcs(..) ) import Darcs.RepoPath ( AbsolutePath, toFilePath )-import Darcs.Utils ( withCurrentDirectory, breakCommand, getViewer, ortryrunning, )-import Progress ( withoutProgress, progressList, debugMessage )+import Darcs.Utils ( breakCommand, getViewer, ortryrunning, )+import Progress ( withoutProgress, debugMessage ) import ByteStringUtils (gzReadFilePS, linesPS, unlinesPS) import qualified Data.ByteString as B (ByteString, empty, null, readFile@@ -66,16 +67,24 @@ import Darcs.Lock ( withTemp, withOpenTemp, tempdirLoc, removeFileMayNotExist ) import CommandLine ( parseCmd, addUrlencoded ) import URL ( copyUrl, copyUrlFirst, waitUrl )-import Ssh ( getSSH, copySSH, copySSHs, SSHCmd(..) )+import Ssh ( getSSH, copySSH, SSHCmd(..) ) import URL ( Cachable(..) ) import Exec ( exec, Redirect(..), withoutNonBlock )-import Darcs.URL ( isFile, isUrl, isSsh )+import Darcs.URL ( isFile, isHttpUrl, isSshUrl, splitSshUrl, SshFilePath, sshUhost ) import Darcs.Utils ( catchall ) import Printer ( Doc, Printers, putDocLnWith, hPutDoc, hPutDocLn, hPutDocWith, ($$), renderPS, simplePrinters, text, empty, packedString, vcat, renderString ) import Darcs.Email ( formatHeader ) +#ifdef HAVE_HTTP+import Network.Browser ( browse, request, setErrHandler, setOutHandler+ , setAllowRedirects )+import Network.HTTP ( RequestMethod(GET), rspCode, rspBody, rspReason+ , mkRequest )+import Network.URI ( parseURI, uriScheme )+#endif+ sendmailPath :: IO String sendmailPath = do l <- filterM doesFileExist $ liftM2 (</>)@@ -126,75 +135,57 @@ where next = f ++ suffix suffix = "-darcs-backup" ++ show i --- | @fetchFile fileOrUrl cache@ returns the content of its argument--- (either a file or an URL). If it has to download an url, then it--- will use a cache as required by its second argument.+copyAndReadFile :: (FilePath -> IO a) -> String -> Cachable -> IO a+copyAndReadFile readfn fou _ | isFile fou = readfn fou+copyAndReadFile readfn fou cache = withTemp $ \t -> do copyFileOrUrl DefaultRemoteDarcs fou t cache+ readfn t++-- | @fetchFile fileOrUrl cache@ returns the content of its argument (either a+-- file or an URL). If it has to download an url, then it will use a cache as+-- required by its second argument.+--+-- We always use default remote darcs, since it is not fatal if the remote+-- darcs does not exist or is too old -- anything that supports transfer-mode+-- should do, and if not, we will fall back to SFTP or SCP. fetchFilePS :: String -> Cachable -> IO B.ByteString-fetchFilePS fou _ | isFile fou = B.readFile fou-fetchFilePS fou cache = withTemp $ \t -> do let opts = [] -- FIXME: no network flags- copyFileOrUrl opts fou t cache- B.readFile t+fetchFilePS = copyAndReadFile B.readFile --- | @fetchFileLazyPS fileOrUrl cache@ lazily reads the content of--- its argument (either a file or an URL). Warning: this function may--- constitute a fd leak; make sure to force consumption of file contents--- to avoid that.+-- | @fetchFileLazyPS fileOrUrl cache@ lazily reads the content of its argument+-- (either a file or an URL). Warning: this function may constitute a fd leak;+-- make sure to force consumption of file contents to avoid that. See+-- "fetchFilePS" for details. fetchFileLazyPS :: String -> Cachable -> IO BL.ByteString-fetchFileLazyPS fou _ | isFile fou = BL.readFile fou-fetchFileLazyPS fou cache = withTemp $ \t -> do let opts = [] -- FIXME: no network flags- copyFileOrUrl opts fou t cache- BL.readFile t+#ifdef HAVE_HTTP+fetchFileLazyPS x c = case parseURI x of+ Just x' | uriScheme x' == "http:" -> do+ rsp <- fmap snd . browse $ do+ setErrHandler . const $ return ()+ setOutHandler . const $ return ()+ setAllowRedirects True+ request $ mkRequest GET x'+ if rspCode rsp /= (2, 0, 0)+ then fail $ "fetchFileLazyPS: " ++ rspReason rsp+ else return $ rspBody rsp+ _ -> copyAndReadFile BL.readFile x c+#else+fetchFileLazyPS x c = copyAndReadFile BL.readFile x c+#endif gzFetchFilePS :: String -> Cachable -> IO B.ByteString-gzFetchFilePS fou _ | isFile fou = gzReadFilePS fou-gzFetchFilePS fou cache = withTemp $ \t-> do let opts = [] -- FIXME: no network flags- copyFileOrUrl opts fou t cache- gzReadFilePS t--remoteDarcsCmd :: [DarcsFlag] -> String-remoteDarcsCmd flags = head $ [ c | (RemoteDarcs c) <- flags ] ++ ["darcs"]+gzFetchFilePS = copyAndReadFile gzReadFilePS -copyFileOrUrl :: [DarcsFlag] -> FilePath -> FilePath -> Cachable -> IO ()-copyFileOrUrl opts fou out _ | isFile fou = copyLocal opts fou out-copyFileOrUrl _ fou out cache | isUrl fou = copyRemote fou out cache-copyFileOrUrl opts fou out _ | isSsh fou = copySSH (remoteDarcsCmd opts) fou out+copyFileOrUrl :: RemoteDarcs -> FilePath -> FilePath -> Cachable -> IO ()+copyFileOrUrl _ fou out _ | isFile fou = copyLocal fou out+copyFileOrUrl _ fou out cache | isHttpUrl fou = copyRemote fou out cache+copyFileOrUrl rd fou out _ | isSshUrl fou = copySSH rd (splitSshUrl fou) out copyFileOrUrl _ fou _ _ = fail $ "unknown transport protocol: " ++ fou speculateFileOrUrl :: String -> FilePath -> IO ()-speculateFileOrUrl fou out | isUrl fou = speculateRemote fou out+speculateFileOrUrl fou out | isHttpUrl fou = speculateRemote fou out | otherwise = return () -speculateFilesOrUrls :: FilePath -> [String] -> FilePath -> IO ()-speculateFilesOrUrls _ _ _ = return () -- FIXME--copyLocal :: [DarcsFlag] -> String -> FilePath -> IO ()-copyLocal opts fou out | NoLinks `elem` opts = cloneFile fou out- | otherwise = createLink fou out `catchall` cloneFile fou out--clonePaths :: FilePath -> FilePath -> [FilePath] -> IO ()-clonePaths source dest = mapM_ (clonePath source dest)--clonePath :: FilePath -> FilePath -> FilePath -> IO ()-clonePath source dest path- = do let source' = source </> path- dest' = dest </> path- 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 ("clonePath: Bad file " ++ source')- `catch` fail ("clonePath: Bad file " ++ source </> path)--clonePartialsTree :: FilePath -> FilePath -> [FilePath] -> IO ()-clonePartialsTree source dest = mapM_ (clonePartialTree source dest)--clonePartialTree :: FilePath -> FilePath -> FilePath -> IO ()-clonePartialTree source dest "" = cloneTree source dest-clonePartialTree source dest pref- = do createDirectoryIfMissing True (dest </> takeDirectory pref)- cloneSubTree (source </> pref) (dest </> pref)+copyLocal :: String -> FilePath -> IO ()+copyLocal fou out = createLink fou out `catchall` cloneFile fou out cloneTree :: FilePath -> FilePath -> IO () cloneTree = cloneTreeExcept []@@ -262,67 +253,13 @@ copyRemoteNormal :: String -> FilePath -> Cachable -> IO () copyRemoteNormal u v cache = copyUrlFirst u v cache >> waitUrl u -copyFilesOrUrls :: [DarcsFlag]->FilePath->[String]->FilePath->Cachable->IO ()-copyFilesOrUrls opts dou ns out _ | isFile dou = copyLocals opts dou ns out-copyFilesOrUrls _ dou ns out c | isUrl dou = copyRemotes dou ns out c-copyFilesOrUrls opts dou ns out _ | isSsh dou = copySSHs (remoteDarcsCmd opts) dou ns out-copyFilesOrUrls _ dou _ _ _ = fail $ "unknown transport protocol: "++dou---copyLocals :: [DarcsFlag] -> String -> [String] -> FilePath -> IO ()-copyLocals opts u ns d =- doWithPatches (\n -> copyLocal opts (u++"/"++n) (d++"/"++n)) ns--copyRemotes :: String -> [String] -> FilePath -> Cachable -> IO()-copyRemotes u ns d cache =- do maybeget <- maybeURLCmd "GET" u- maybemget <- maybeURLCmd "MGET" u- case (maybeget, maybemget) of- (Nothing, _) -> copyRemotesNormal u ns d cache- (Just _, Nothing) -> doWithPatches (\n -> copyRemote (u++"/"++n) (d++"/"++n) cache) ns- (Just _, Just mget) -> mgetRemotes mget u ns d--stringToInt :: String -> Int -> Int-stringToInt num def = case reads num of [(x,"")] -> x- _ -> def--mgetRemotes :: String -> String -> [String] -> FilePath -> IO()-mgetRemotes _ _ [] _ = return ()-mgetRemotes mget u ns d = do- mgetmax <- getEnv "DARCS_MGETMAX" `catch` \_ -> return ""- let (nsnow, nslater) = splitAt (stringToInt mgetmax 200) ns- (cmd, args) = breakCommand mget- urls = map (\n -> u++"/"++n) nsnow- withCurrentDirectory d $ do- r <- exec cmd (args++urls) (Null,Null,AsIs)- when (r /= ExitSuccess) $- fail $ unlines $- ["(" ++ mget ++ ") failed to fetch files.",- "source directory: " ++ d,- "source files:"] ++ (upto 5 nsnow) ++- ["still to go:"] ++ (upto 5 nslater)- mgetRemotes mget u nslater d- where- upto :: Integer -> [String] -> [String]- upto _ [] = []- upto 0 l = [ "(" ++ (show (length l)) ++ " more)" ]- upto n (h : t) = h : (upto (n - 1) t)--copyRemotesNormal :: String -> [String] -> FilePath -> Cachable -> IO()-copyRemotesNormal u ns d cache =- do mapM_ (\n -> copyUrl (u++"/"++n) (d++"/"++n) cache) ns- doWithPatches (\n -> waitUrl (u++"/"++n)) ns--doWithPatches :: (String -> IO ()) -> [String] -> IO ()-doWithPatches f patches = mapM_ (\p -> seq p $ f p) $ progressList "Copying patch" patches- -- | Run a command on a remote location without passing it any input or -- reading its output. Return its ExitCode-execSSH :: String -> String -> IO ExitCode+execSSH :: SshFilePath -> String -> IO ExitCode execSSH remoteAddr command = do (ssh, ssh_args) <- getSSH SSH remoteAddr- debugMessage $ unwords (ssh:ssh_args++[remoteAddr,command])- withoutProgress $ do hid <- runProcess ssh (ssh_args++[remoteAddr,command])+ debugMessage $ unwords (ssh:ssh_args++[sshUhost remoteAddr,command])+ withoutProgress $ do hid <- runProcess ssh (ssh_args++[sshUhost remoteAddr,command]) Nothing Nothing Nothing Nothing Nothing waitForProcess hid @@ -333,11 +270,13 @@ hSetBinaryMode i True hSetBinaryMode o True mvare <- newEmptyMVar- forkIO ((Ratified.hGetContents e >>= -- ratify: immediately consumed+-- Warning: A do-notation statement discarded a result of type GHC.Conc.ThreadId.+ _ <- forkIO ((Ratified.hGetContents e >>= -- ratify: immediately consumed hPutStr stderr) `finally` putMVar mvare ()) mvaro <- newEmptyMVar- forkIO ((Ratified.hGetContents o >>= -- ratify: immediately consumed+-- Warning: A do-notation statement discarded a result of type GHC.Conc.ThreadId.+ _ <- forkIO ((Ratified.hGetContents o >>= -- ratify: immediately consumed hPutStr stdout) `finally` putMVar mvaro ()) hPutDoc i inp@@ -349,10 +288,10 @@ putStrLn $ "Command not found:\n "++ show (c:args) return rval -pipeDocSSH :: String -> [String] -> Doc -> IO ExitCode+pipeDocSSH :: SshFilePath -> [String] -> Doc -> IO ExitCode pipeDocSSH remoteAddr args input = do (ssh, ssh_args) <- getSSH SSH remoteAddr- pipeDoc ssh (ssh_args++ (remoteAddr:args)) input+ pipeDoc ssh (ssh_args++ (sshUhost remoteAddr:args)) input sendEmail :: String -> String -> String -> String -> String -> String -> IO () sendEmail f t s cc scmd body =@@ -510,9 +449,11 @@ execDocPipe :: String -> [String] -> Doc -> IO Doc execDocPipe c args instr = withoutProgress $ do (i,o,e,pid) <- runInteractiveProcess c args Nothing Nothing- forkIO $ hPutDoc i instr >> hClose i+-- Warning: A do-notation statement discarded a result of type GHC.Conc.ThreadId.+ _ <- forkIO $ hPutDoc i instr >> hClose i mvare <- newEmptyMVar- forkIO ((Ratified.hGetContents e >>= -- ratify: immediately consumed+-- Warning: A do-notation statement discarded a result of type GHC.Conc.ThreadId.+ _ <- forkIO ((Ratified.hGetContents e >>= -- ratify: immediately consumed hPutStr stderr) `finally` putMVar mvare ()) out <- B.hGetContents o@@ -528,13 +469,16 @@ execPipeIgnoreError :: String -> [String] -> Doc -> IO Doc execPipeIgnoreError c args instr = withoutProgress $ do (i,o,e,pid) <- runInteractiveProcess c args Nothing Nothing- forkIO $ hPutDoc i instr >> hClose i+-- Warning: A do-notation statement discarded a result of type GHC.Conc.ThreadId.+ _ <- forkIO $ hPutDoc i instr >> hClose i mvare <- newEmptyMVar- forkIO ((Ratified.hGetContents e >>= -- ratify: immediately consumed+-- Warning: A do-notation statement discarded a result of type GHC.Conc.ThreadId.+ _ <- forkIO ((Ratified.hGetContents e >>= -- ratify: immediately consumed hPutStr stderr) `finally` putMVar mvare ()) out <- B.hGetContents o- waitForProcess pid+-- Warning: A do-notation statement discarded a result of type ExitCode.+ _ <- waitForProcess pid takeMVar mvare return $ packedString out @@ -646,7 +590,8 @@ viewDocWith :: Printers -> Doc -> IO () viewDocWith pr msg = do isTerminal <- hIsTerminalDevice stdout- if isTerminal && lengthGreaterThan (20 :: Int) (lines $ renderString msg)+-- Warning: A do-notation statement discarded a result of type ExitCode.+ _ <- if isTerminal && lengthGreaterThan (20 :: Int) (lines $ renderString msg) then do viewerPlusArgs <- getViewer let (viewer:args) = words viewerPlusArgs pipeDocToPager viewer args pr msg@@ -680,5 +625,6 @@ putStrLn $ "Command not found:\n "++ show (c:args) return x where- cleanup (f,h) = do try (hClose h) :: IO (Either SomeException ())+-- Warning: A do-notation statement discarded a result of type Either SomeException ().+ cleanup (f,h) = do _ <- try (hClose h) :: IO (Either SomeException ()) removeFileMayNotExist f
− src/Darcs/FilePathMonad.hs
@@ -1,83 +0,0 @@--- Copyright (C) 2005 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.---{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--module Darcs.FilePathMonad ( FilePathMonad, withFilePaths ) where--import Control.Monad ( MonadPlus, mplus, mzero )-import Data.Maybe ( catMaybes )--import Darcs.IO ( ReadableDirectory(..), WriteableDirectory(..) )-import Darcs.Patch.FileName ( FileName, fp2fn, fn2fp, superName, breakOnDir,- normPath, movedirfilename )-#include "impossible.h"--data FilePathMonad a = FPM ([FileName] -> ([FileName], a))--withFilePaths :: [FilePath] -> FilePathMonad a -> [FilePath]-withFilePaths fps (FPM x) = map fn2fp $ fst $ x $ map fp2fn fps--instance Functor FilePathMonad where- fmap f m = m >>= return . f--instance Monad FilePathMonad where- (FPM x) >>= y = FPM z where z fs = case x fs of- (fs', a) -> case y a of- FPM yf -> yf fs'- return x = FPM $ \fs -> (fs, x)--instance MonadPlus FilePathMonad where- mzero = fail "mzero FilePathMonad" -- yuck!- a `mplus` _ = a--instance ReadableDirectory FilePathMonad where- -- We can't check it actually is a directory here- mDoesDirectoryExist d =- FPM $ \fs -> (fs, normPath d `elem` map normPath fs)- -- We can't check it actually is a file here- mDoesFileExist f =- FPM $ \fs -> (fs, normPath f `elem` map normPath fs)- mInCurrentDirectory d (FPM j) =- FPM $ \fs -> (fs, snd $ j $ catMaybes $ map indir fs)- where indir f = do (d',f') <- breakOnDir f- if d == d' then Just f'- else Nothing- mGetDirectoryContents =- FPM $ \fs -> (fs, filter (\f -> fp2fn "." == superName f) fs)- mReadFilePS = bug "can't mReadFilePS in FilePathMonad!"--instance WriteableDirectory FilePathMonad where- mWithCurrentDirectory d (FPM j) =- FPM $ \fs ->- let splitfs = map splitf fs- others = catMaybes $ map snd splitfs- (myfs, a) = j $ catMaybes $ map fst splitfs- splitf f = case breakOnDir f of- Just (d', f') | d' == d -> (Just f', Nothing)- _ -> (Nothing, Just f)- in (others ++ myfs, a)- mSetFileExecutable _ _ = return ()- mWriteFilePS _ _ = return ()- mCreateDirectory _ = return ()- mRemoveFile f = FPM $ \fs -> (filter (/= f) fs, ())- mRemoveDirectory f = FPM $ \fs -> (filter (/= f) fs, ())- mRename a b = FPM $ \fs -> (map (movedirfilename a b) fs, ())- mModifyFilePS _ _ = return ()- mModifyFilePSs _ _ = return ()
src/Darcs/Flags.hs view
@@ -15,13 +15,16 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -module Darcs.Flags ( DarcsFlag( .. ), Compression( .. ), compression,+module Darcs.Flags ( DarcsFlag( .. ),+ Compression( .. ), UseIndex(..), ScanKnown(..), RemoteDarcs(..),+ compression, remoteDarcs, diffingOpts, wantExternalMerge, isInteractive, maxCount, willIgnoreTimes, willRemoveLogFile, isUnified,- willStoreInMemory, doHappyForwarding, includeBoring,+ isNotUnified, doHappyForwarding, includeBoring, doAllowCaseOnly, doAllowWindowsReserved, doReverse,- showChangesOnlyToFiles,- defaultFlag,+ usePacks,+ showChangesOnlyToFiles, rollbackInWorkingDir,+ defaultFlag ) where import Data.Maybe( fromMaybe ) import Darcs.Patch.MatchData ( PatchMatch )@@ -43,7 +46,7 @@ | TagName String | LastN Int | MaxCount Int | PatchIndexRange Int Int | NumberPatches | OneTag String | AfterTag String | UpToTag String- | Context AbsolutePath | Count+ | GenContext | Context AbsolutePath | Count | LogFile AbsolutePath | RmLogFile | DontRmLogFile | DistName String | All | Recursive | NoRecursive | Reorder@@ -56,7 +59,7 @@ | HappyForwarding | NoHappyForwarding | Verify AbsolutePath | VerifySSL AbsolutePath | SSHControlMaster | NoSSHControlMaster- | RemoteDarcs String+ | RemoteDarcsOpt String | EditDescription | NoEditDescription | Toks String | EditLongComment | NoEditLongComment | PromptLongComment@@ -76,20 +79,27 @@ | DiffCmd String | ExternalMerge String | Summary | NoSummary | Unified | NonUnified | Reverse | Forward- | Partial | Complete | Lazy | Ephemeral+ | Complete | Lazy | FixFilePath AbsolutePath AbsolutePath | DiffFlags String | XMLOutput | ForceReplace | OnePattern PatchMatch | SeveralPattern PatchMatch | AfterPattern PatchMatch | UpToPattern PatchMatch | NonApply | NonVerify | NonForce- | DryRun | SetDefault | NoSetDefault- | FancyMoveAdd | NoFancyMoveAdd+ | DryRun++ -- The Bool parameters are a bit of a hack so that we can tell+ -- whether the user explicitly set the option or not.+ -- A more general mechanism would be better.+ -- True = explicitly set by user (on command-line or in prefs/defaults),+ -- False = defaulted by darcs+ | SetDefault Bool | NoSetDefault Bool+ | Disable | SetScriptsExecutable | DontSetScriptsExecutable | Bisect- | UseHashedInventory | UseOldFashionedInventory+ | UseHashedInventory | UseFormat2- | PristinePlain | PristineNone | NoUpdateWorking- | Sibling AbsolutePath | Relink | RelinkPristine | NoLinks+ | NoUpdateWorking+ | Sibling AbsolutePath | Relink | OptimizePristine | OptimizeHTTP | UpgradeFormat | Files | NoFiles | Directories | NoDirectories@@ -99,17 +109,36 @@ | UMask String | StoreInMemory | ApplyOnDisk | NoHTTPPipelining+ | Packs | NoPacks | NoCache | AllowUnrelatedRepos | Check | Repair | JustThisRepo | NullFlag+ | RecordRollback | NoRecordRollback deriving ( Eq, Show ) +-- ADTs for selecting specific behaviour... FIXME These should be eventually+-- moved out from this module, closer to where they are actually used+ data Compression = NoCompression | GzipCompression compression :: [DarcsFlag] -> Compression compression f | NoCompress `elem` f = NoCompression | otherwise = GzipCompression +remoteDarcs :: [DarcsFlag] -> RemoteDarcs+remoteDarcs f | (x:_) <- [ c | RemoteDarcsOpt c <- f ] = RemoteDarcs x+ | otherwise = DefaultRemoteDarcs++data UseIndex = UseIndex | IgnoreIndex+data ScanKnown = ScanKnown | ScanAll+diffingOpts :: [DarcsFlag] -> (UseIndex, ScanKnown)+diffingOpts opts = (if willIgnoreTimes opts then IgnoreIndex else UseIndex,+ if LookForAdds `elem` opts then ScanAll else ScanKnown)++data RemoteDarcs = RemoteDarcs String | DefaultRemoteDarcs++----------------------+ wantExternalMerge :: [DarcsFlag] -> Maybe String wantExternalMerge [] = Nothing wantExternalMerge (ExternalMerge c:_) = Just c@@ -132,6 +161,10 @@ -- | @lastWord [(flag, value)] default opts@ scans @opts@ for a flag -- in the list and returns the value of the first match, or @default@ -- if none is found.+--+-- We call this the \"last\" word because we assume that flags are+-- *prepended* in the order they arrive, so what is first internally+-- is last from the user's point of view. lastWord :: [(DarcsFlag,a)] -> a -> [DarcsFlag] -> a lastWord known_flags = foldr . flip $ \ def -> fromMaybe def . flip lookup known_flags @@ -147,8 +180,8 @@ isUnified :: [DarcsFlag] -> Bool isUnified = getBoolFlag Unified NonUnified -willStoreInMemory :: [DarcsFlag] -> Bool-willStoreInMemory = getBoolFlag Unified NonUnified+isNotUnified :: [DarcsFlag] -> Bool+isNotUnified = getBoolFlag NonUnified Unified doHappyForwarding :: [DarcsFlag] -> Bool doHappyForwarding = getBoolFlag HappyForwarding NoHappyForwarding@@ -166,6 +199,9 @@ doReverse :: [DarcsFlag] -> Bool doReverse = getBoolFlag Reverse Forward +usePacks :: [DarcsFlag] -> Bool+usePacks = not . getBoolFlag NoPacks Packs+ showChangesOnlyToFiles :: [DarcsFlag] -> Bool showChangesOnlyToFiles = getBoolFlag OnlyChangesToFiles ChangesToAllFiles @@ -176,3 +212,6 @@ -> [DarcsFlag] -- ^ updated flags defaultFlag alts def flags = if any (`elem` flags) alts then flags else def : flags++rollbackInWorkingDir :: [DarcsFlag] -> Bool+rollbackInWorkingDir = getBoolFlag NoRecordRollback RecordRollback
src/Darcs/Global.hs view
@@ -22,12 +22,12 @@ -- purity of darcs, in favour of programming convenience. module Darcs.Global ( atexit, withAtexit, sshControlMasterDisabled, setSshControlMasterDisabled,- verboseMode, setVerboseMode, timingsMode, setTimingsMode, whenDebugMode, withDebugMode, setDebugMode, debugMessage, debugFail, putTiming, addCRCWarning, getCRCWarnings, resetCRCWarnings,- darcsdir+ addBadSource, getBadSourcesList, isBadSource, darcsdir,+ isReachableSource, addReachableSource ) where import Control.Monad ( when )@@ -113,17 +113,6 @@ timingsMode :: Bool timingsMode = unsafePerformIO $ readIORef _timingsMode -{-# NOINLINE _verboseMode #-}-_verboseMode :: IORef Bool-_verboseMode = unsafePerformIO $ newIORef False--setVerboseMode :: IO ()-setVerboseMode = writeIORef _verboseMode True--{-# NOINLINE verboseMode #-}-verboseMode :: Bool-verboseMode = unsafePerformIO $ readIORef _verboseMode- {-# NOINLINE _sshControlMasterDisabled #-} _sshControlMasterDisabled :: IORef Bool _sshControlMasterDisabled = unsafePerformIO $ newIORef False@@ -148,6 +137,34 @@ resetCRCWarnings :: IO () resetCRCWarnings = writeIORef _crcWarningList []++{- NOINLINE _badSourcesList -}+_badSourcesList :: IORef [String]+_badSourcesList = unsafePerformIO $ newIORef []++addBadSource :: String -> IO ()+addBadSource cache = modifyIORef _badSourcesList (cache:)++getBadSourcesList :: IO [String]+getBadSourcesList = readIORef _badSourcesList++isBadSource :: IO (String -> Bool)+isBadSource = do badSources <- getBadSourcesList+ return (`elem` badSources)++{- NOINLINE _reachableSourcesList -}+_reachableSourcesList :: IORef [String]+_reachableSourcesList = unsafePerformIO $ newIORef []++addReachableSource :: String -> IO ()+addReachableSource src = modifyIORef _reachableSourcesList (src:)++getReachableSources :: IO [String]+getReachableSources = readIORef _reachableSourcesList++isReachableSource :: IO (String -> Bool)+isReachableSource = do reachableSources <- getReachableSources+ return (`elem` reachableSources) darcsdir :: String darcsdir = "_darcs"
− src/Darcs/Hopefully.hs
@@ -1,207 +0,0 @@--- Copyright (C) 2006 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.--{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--#include "gadts.h"--module Darcs.Hopefully ( Hopefully, PatchInfoAnd,- WPatchInfo, unWPatchInfo, compareWPatchInfo,- piap, n2pia, patchInfoAndPatch,- conscientiously, hopefully, info, winfo,- hopefullyM, createHashed, extractHash,- actually, unavailable, patchDesc ) where--import System.IO.Unsafe ( unsafeInterleaveIO )--import Darcs.SignalHandler ( catchNonSignal )-import Printer ( Doc, renderString, errorDoc, text, ($$) )-import Darcs.Patch.Info ( PatchInfo, humanFriendly, idpatchinfo, justName )-import Darcs.Patch ( RepoPatch, Named, patch2patchinfo )-import Darcs.Patch.Prim ( Effect(..), Conflict(..) )-import Darcs.Patch.Patchy ( Patchy, ReadPatch(..), Apply(..), Invert(..),- ShowPatch(..), Commute(..) )-import Darcs.Witnesses.Ordered ( MyEq, EqCheck(..), unsafeCoerceP, unsafeCompare, (:>)(..), (:\/:)(..), (:/\:)(..) )-import Darcs.Witnesses.Sealed ( Sealed(Sealed), seal, mapSeal )-import Darcs.Utils ( prettyException )---- | @'Hopefully' p C@ @(x y)@ is @'Either' String (p C@ @(x y))@ in a--- form adapted to darcs patches. The @C@ @(x y)@ represents the type--- witness for the patch that should be there. The @Hopefully@ type--- just tells whether we expect the patch to be hashed or not, and--- 'SimpleHopefully' does the real work of emulating--- 'Either'. @Hopefully sh@ represents an expected unhashed patch, and--- @Hashed hash sh@ represents an expected hashed patch with its hash.-data Hopefully a C(x y) = Hopefully (SimpleHopefully a C(x y)) | Hashed String (SimpleHopefully a C(x y))---- | @SimpleHopefully@ is a variant of @Either String@ adapted for--- type witnesses. @Actually@ is the equivalent of @Right@, while--- @Unavailable@ is @Left@.-data SimpleHopefully a C(x y) = Actually (a C(x y)) | Unavailable String---- | @'PatchInfoAnd' p C(a b)@ represents a hope we have to get a--- patch through its info. We're not sure we have the patch, but we--- know its info.-data PatchInfoAnd p C(a b) = PIAP !PatchInfo (Hopefully (Named p) C(a b))---- | @'WPatchInfo' C(a b)@ represents the info of a patch, marked with--- the patch's witnesses.-newtype WPatchInfo C(a b) = WPatchInfo { unWPatchInfo :: PatchInfo }---- This is actually unsafe if we ever commute patches and then compare them--- using this function. TODO: consider adding an extra existential to WPatchInfo--- (as with TaggedPatch in Darcs.Patch.Choices)-compareWPatchInfo :: WPatchInfo C(a b) -> WPatchInfo C(c d) -> EqCheck C((a, b) (c, d))-compareWPatchInfo (WPatchInfo x) (WPatchInfo y) = if x == y then unsafeCoerceP IsEq else NotEq--instance MyEq WPatchInfo where- WPatchInfo x `unsafeCompare` WPatchInfo y = x == y--fmapH :: (a C(x y) -> b C(w z)) -> Hopefully a C(x y) -> Hopefully b C(w z)-fmapH f (Hopefully sh) = Hopefully (ff sh)- where ff (Actually a) = Actually (f a)- ff (Unavailable e) = Unavailable e-fmapH f (Hashed h sh) = Hashed h (ff sh)- where ff (Actually a) = Actually (f a)- ff (Unavailable e) = Unavailable e--info :: PatchInfoAnd p C(a b) -> PatchInfo-info (PIAP i _) = i--patchDesc :: forall p C(x y) . PatchInfoAnd p C(x y) -> String-patchDesc p = justName $ info p--winfo :: PatchInfoAnd p C(a b) -> WPatchInfo C(a b)-winfo (PIAP i _) = WPatchInfo i---- | @'piap' i p@ creates a PatchInfoAnd containing p with info i.-piap :: PatchInfo -> Named p C(a b) -> PatchInfoAnd p C(a b)-piap i p = PIAP i (Hopefully $ Actually p)---- | @n2pia@ creates a PatchInfoAnd representing a @Named@ patch.-n2pia :: Named p C(x y) -> PatchInfoAnd p C(x y)-n2pia x = patch2patchinfo x `piap` x--patchInfoAndPatch :: PatchInfo -> Hopefully (Named p) C(a b) -> PatchInfoAnd p C(a b)-patchInfoAndPatch = PIAP---- | @'hopefully' hp@ tries to get a patch from a 'PatchInfoAnd'--- value. If it fails, it outputs an error \"failed to read patch:--- \<description of the patch>\". We get the description of the patch--- from the info part of 'hp'-hopefully :: PatchInfoAnd p C(a b) -> Named p C(a b)-hopefully = conscientiously $ \e -> text "failed to read patch:" $$ e---- | @'conscientiously' er hp@ tries to extract a patch from a 'PatchInfoAnd'.--- If it fails, it applies the error handling function @er@ to a description--- of the patch info component of @hp@.-conscientiously :: (Doc -> Doc)- -> PatchInfoAnd p C(a b) -> Named p C(a b)-conscientiously er (PIAP pinf hp) =- case hopefully2either hp of- Right p -> p- Left e -> errorDoc $ er (humanFriendly pinf $$ text e)---- | @hopefullyM@ is a version of @hopefully@ which calls @fail@ in a--- monad instead of erroring.-hopefullyM :: Monad m => PatchInfoAnd p C(a b) -> m (Named p C(a b))-hopefullyM (PIAP pinf hp) = case hopefully2either hp of- Right p -> return p- Left e -> fail $ renderString (humanFriendly pinf $$ text e)---- Any recommendations for a nice adverb to name the below?-hopefully2either :: Hopefully a C(x y) -> Either String (a C(x y))-hopefully2either (Hopefully (Actually p)) = Right p-hopefully2either (Hashed _ (Actually p)) = Right p-hopefully2either (Hopefully (Unavailable e)) = Left e-hopefully2either (Hashed _ (Unavailable e)) = Left e--actually :: a C(x y) -> Hopefully a C(x y)-actually = Hopefully . Actually--createHashed :: String -> (String -> IO (Sealed (a C(x)))) -> IO (Sealed (Hopefully a C(x)))-createHashed h f = do mapSeal (Hashed h) `fmap` unsafeInterleaveIO (f' `catchNonSignal` handler)- where- f' = do Sealed x <- f h- return (Sealed (Actually x))- handler e = return $ seal $ Unavailable $ prettyException e--extractHash :: PatchInfoAnd p C(a b) -> Either (Named p C(a b)) String-extractHash (PIAP _ (Hashed s _)) = Right s-extractHash hp = Left $ conscientiously (\e -> text "unable to read patch:" $$ e) hp--unavailable :: String -> Hopefully a C(x y)-unavailable = Hopefully . Unavailable--instance MyEq p => MyEq (PatchInfoAnd p) where- unsafeCompare (PIAP i _) (PIAP i2 _) = i == i2----instance Invert (p C(x y)) => Invert (PatchInfoAnd (p C(x y))) where-instance Invert p => Invert (PatchInfoAnd p) where- identity = PIAP idpatchinfo (actually identity)- invert (PIAP i p) = PIAP i (invert `fmapH` p)--instance (Conflict p, Effect p, ShowPatch p) => ShowPatch (PatchInfoAnd p) where- showPatch (PIAP n p) = case hopefully2either p of- Right x -> showPatch x- Left _ -> humanFriendly n- showContextPatch (PIAP n p) = case hopefully2either p of- Right x -> showContextPatch x- Left _ -> return $ humanFriendly n- description (PIAP n _) = humanFriendly n- summary (PIAP n p) = case hopefully2either p of- Right x -> summary x- Left _ -> humanFriendly n- showNicely (PIAP n p) = case hopefully2either p of- Right x -> showNicely x- Left _ -> humanFriendly n--instance Commute p => Commute (PatchInfoAnd p) where- commute (x :> y) = do y' :> x' <- commute (hopefully x :> hopefully y)- return $ (info y `piap` y') :> (info x `piap` x')- listTouchedFiles = listTouchedFiles . hopefully- merge (x :\/: y) = case merge (hopefully x :\/: hopefully y) of- y' :/\: x' -> (info y `piap` y') :/\: (info x `piap` x')- hunkMatches _ _ = error "hunkmatches not implemented for PatchInfoAnd"--instance Apply p => Apply (PatchInfoAnd p) where- apply opts p = apply opts $ hopefully p- applyAndTryToFix p = do mp' <- applyAndTryToFix $ hopefully p- case mp' of- Nothing -> return Nothing- Just (e,p') -> return $ Just (e, n2pia p')--instance ReadPatch p => ReadPatch (PatchInfoAnd p) where- readPatch' wanteof = do x <- readPatch' wanteof- case x of- Just (Sealed p) -> return $ Just $ Sealed $ n2pia p- Nothing -> return Nothing--instance Effect p => Effect (PatchInfoAnd p) where- effect = effect . hopefully- effectRL = effectRL . hopefully--instance Conflict p => Conflict (PatchInfoAnd p) where- listConflictedFiles = listConflictedFiles . hopefully- resolveConflicts = resolveConflicts . hopefully- commuteNoConflicts (x:>y) = do y':>x' <- commuteNoConflicts (hopefully x :> hopefully y)- return (info y `piap` y' :> info x `piap` x')- conflictedEffect = conflictedEffect . hopefully- isInconsistent = isInconsistent . hopefully--instance RepoPatch p => Patchy (PatchInfoAnd p)
src/Darcs/IO.hs view
@@ -16,9 +16,7 @@ -- Boston, MA 02110-1301, USA. {-# OPTIONS_GHC -fglasgow-exts #-}-module Darcs.IO ( ReadableDirectory(..), WriteableDirectory(..),- TolerantIO, runTolerantly, runSilently,- ) where+module Darcs.IO ( runTolerantly, runSilently ) where import Prelude hiding ( catch ) import Data.Char ( toLower )@@ -31,77 +29,30 @@ renameFile, renameDirectory, doesDirectoryExist, doesFileExist, )+import Darcs.Repository.Prefs( changePrefval ) import ByteStringUtils ( linesPS, unlinesPS) import qualified Data.ByteString as B (ByteString, empty, null, readFile, concat) import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Char8 as BC (unpack, pack) -import Darcs.Utils ( withCurrentDirectory, prettyException )+import Darcs.Utils ( prettyException ) import Darcs.External ( backupByCopying, backupByRenaming )-import Printer ( Doc, renderPS )-import Darcs.Patch.FileName ( FileName, fn2fp, fp2fn )-import Darcs.Lock ( writeBinFile, readBinFile, writeAtomicFilePS )+import Darcs.Patch.FileName ( FileName, fn2fp )+import Darcs.Lock ( writeAtomicFilePS ) import Workaround ( setExecutable )--import qualified Storage.Hashed.Monad as HSM-import Storage.Hashed.AnchoredPath( AnchoredPath, floatPath )--class (Functor m, MonadPlus m) => ReadableDirectory m where- mDoesDirectoryExist :: FileName -> m Bool- mDoesFileExist :: FileName -> m Bool- mInCurrentDirectory :: FileName -> m a -> m a- mGetDirectoryContents :: m [FileName]- mReadBinFile :: FileName -> m String- mReadBinFile f = liftM BC.unpack $ mReadFilePS f- mReadFilePS :: FileName -> m B.ByteString- mReadFilePSs :: FileName -> m [B.ByteString]- mReadFilePSs f = linesPS `liftM` mReadFilePS f--class ReadableDirectory m => WriteableDirectory m where- mWithCurrentDirectory :: FileName -> m a -> m a- mSetFileExecutable :: FileName -> Bool -> m ()- mWriteBinFile :: FileName -> String -> m ()- mWriteBinFile fn s = mWriteFilePS fn $ BC.pack s- mWriteFilePS :: FileName -> B.ByteString -> m ()- mWriteFilePSs :: FileName -> [B.ByteString] -> m ()- mWriteFilePSs f ss = mWriteFilePS f (unlinesPS ss)- mCreateDirectory :: FileName -> m ()- mRemoveDirectory :: FileName -> m ()- mWriteDoc :: FileName -> Doc -> m ()- mWriteDoc f d = mWriteFilePS f (renderPS d)- mCreateFile :: FileName -> m ()- mCreateFile f = mWriteFilePS f B.empty- mRemoveFile :: FileName -> m ()- mRename :: FileName -> FileName -> m ()- mModifyFilePS :: FileName -> (B.ByteString -> m B.ByteString) -> m ()- mModifyFilePS f j = do ps <- mReadFilePS f- ps' <- j ps- mWriteFilePS f ps'- mModifyFilePSs :: FileName -> ([B.ByteString] -> m [B.ByteString]) -> m ()- mModifyFilePSs f j = do ps <- mReadFilePSs f- ps' <- j ps- mWriteFilePSs f ps'+import Darcs.Patch.ApplyMonad( ApplyMonad(..) ) -instance ReadableDirectory IO where+instance ApplyMonad IO where mDoesDirectoryExist = doesDirectoryExist . fn2fp- mDoesFileExist = doesFileExist . fn2fp- mInCurrentDirectory = withCurrentDirectory . fn2fp- mGetDirectoryContents = map fp2fn `liftM` getDirectoryContents "."- mReadBinFile = readBinFile . fn2fp- mReadFilePS = B.readFile . fn2fp--instance WriteableDirectory IO where- mWithCurrentDirectory = mInCurrentDirectory- mSetFileExecutable = setExecutable . fn2fp- mWriteBinFile = writeBinFile . fn2fp- mWriteFilePS = writeAtomicFilePS . fn2fp+ mChangePref = changePrefval+ mModifyFilePS f j = B.readFile (fn2fp f) >>= j >>= writeAtomicFilePS (fn2fp f) mCreateDirectory = createDirectory . fn2fp- mCreateFile f = do exf <- mDoesFileExist f+ mCreateFile f = do exf <- doesFileExist (fn2fp f) if exf then fail $ "File '"++fn2fp f++"' already exists!"- else do exd <- mDoesDirectoryExist f+ else do exd <- doesDirectoryExist $ fn2fp f if exd then fail $ "File '"++fn2fp f++"' already exists!"- else mWriteFilePS f B.empty+ else writeAtomicFilePS (fn2fp f) B.empty mRemoveFile f = do let fp = fn2fp f x <- B.readFile fp when (not $ B.null x) $@@ -162,37 +113,15 @@ fail s = runTM $ fail s return x = runTM $ return x -instance MonadPlus TolerantIO where- mzero = runTM mzero- mplus a b = runTM (mplus (runIO a) (runIO b))-instance MonadPlus SilentIO where- mzero = runTM mzero- mplus a b = runTM (mplus (runIO a) (runIO b))--instance ReadableDirectory TolerantIO where+instance ApplyMonad TolerantIO where mDoesDirectoryExist d = runTM $ mDoesDirectoryExist d- mDoesFileExist f = runTM $ mDoesFileExist f- mInCurrentDirectory i j = runTM $ mInCurrentDirectory i (runIO j)- mGetDirectoryContents = runTM mGetDirectoryContents- mReadBinFile f = runTM $ mReadBinFile f mReadFilePS f = runTM $ mReadFilePS f-instance ReadableDirectory SilentIO where- mDoesDirectoryExist d = runTM $ mDoesDirectoryExist d- mDoesFileExist f = runTM $ mDoesFileExist f- mInCurrentDirectory i j = runTM $ mInCurrentDirectory i (runIO j)- mGetDirectoryContents = runTM mGetDirectoryContents- mReadBinFile f = runTM $ mReadBinFile f- mReadFilePS f = runTM $ mReadFilePS f--instance WriteableDirectory TolerantIO where- mWithCurrentDirectory = mInCurrentDirectory- mSetFileExecutable f e = warning $ mSetFileExecutable f e- mWriteBinFile f s = warning $ mWriteBinFile f s- mWriteFilePS f s = warning $ mWriteFilePS f s- mCreateFile f = warning $ backup f >> mWriteFilePS f B.empty- mCreateDirectory d = warning $ backup d >> mCreateDirectory d- mRemoveFile f = warning $ mRemoveFile f- mRemoveDirectory d = warning $ catch+ mChangePref a b c = warning $ mChangePref a b c+ mModifyFilePS f j = warning $ mModifyFilePS f (runIO . j)+ mCreateFile f = warning $ backup f >> mCreateFile f+ mCreateDirectory d = warning $ backup d >> mCreateDirectory d+ mRemoveFile f = warning $ mRemoveFile f+ mRemoveDirectory d = warning $ catch (mRemoveDirectory d) (\(e :: IOException) -> if "(Directory not empty)" `isSuffixOf` show e@@ -200,10 +129,10 @@ "Not deleting " ++ fn2fp d ++ " because it is not empty." else ioError $ userError $ "Not deleting " ++ fn2fp d ++ " because:\n" ++ show e)- mRename a b = warning $ catch+ mRename a b = warning $ catch (let do_backup = if (map toLower x == map toLower y)- then backupByCopying y -- avoid making the original vanish- else backupByRenaming y+ then backupByCopying (fn2fp b) -- avoid making the original vanish+ else backupByRenaming (fn2fp b) in do_backup >> mRename a b) (\e -> case () of _ | isPermissionError e -> ioError $ userError $@@ -216,15 +145,16 @@ x = fn2fp a y = fn2fp b couldNotRename = "Could not rename " ++ x ++ " to " ++ y-instance WriteableDirectory SilentIO where- mWithCurrentDirectory = mInCurrentDirectory- mSetFileExecutable f e = warning $ mSetFileExecutable f e- mWriteBinFile f s = warning $ mWriteBinFile f s- mWriteFilePS f s = warning $ mWriteFilePS f s- mCreateFile f = warning $ backup f >> mWriteFilePS f B.empty- mCreateDirectory d = warning $ backup d >> mCreateDirectory d- mRemoveFile f = warning $ mRemoveFile f- mRemoveDirectory d = warning $ catch++instance ApplyMonad SilentIO where+ mDoesDirectoryExist d = runTM $ mDoesDirectoryExist d+ mReadFilePS f = runTM $ mReadFilePS f+ mChangePref a b c = warning $ mChangePref a b c+ mModifyFilePS f j = warning $ mModifyFilePS f (runIO . j)+ mCreateFile f = warning $ backup f >> mCreateFile f+ mCreateDirectory d = warning $ backup d >> mCreateDirectory d+ mRemoveFile f = warning $ mRemoveFile f+ mRemoveDirectory d = warning $ catch (mRemoveDirectory d) (\(e :: SomeException) -> if "(Directory not empty)" `isSuffixOf` show e@@ -232,10 +162,10 @@ "Not deleting " ++ fn2fp d ++ " because it is not empty." else ioError $ userError $ "Not deleting " ++ fn2fp d ++ " because:\n" ++ show e)- mRename a b = warning $ catch+ mRename a b = warning $ catch (let do_backup = if (map toLower x == map toLower y)- then backupByCopying y -- avoid making the original vanish- else backupByRenaming y+ then backupByCopying (fn2fp b) -- avoid making the original vanish+ else backupByRenaming (fn2fp b) in do_backup >> mRename a b) (\e -> case () of _ | isPermissionError e -> ioError $ userError $@@ -250,24 +180,4 @@ couldNotRename = "Could not rename " ++ x ++ " to " ++ y backup :: FileName -> IO ()-backup f = backupByRenaming $ fn2fp f--floatFn :: FileName -> AnchoredPath-floatFn = floatPath . fn2fp--instance (Functor m, MonadPlus m, MonadError e m) => ReadableDirectory (HSM.TreeMonad m) where- mDoesDirectoryExist d = HSM.directoryExists (floatFn d)- mDoesFileExist f = HSM.fileExists (floatFn f)- mInCurrentDirectory d action = HSM.withDirectory (floatFn d) action- mGetDirectoryContents = error "get dir contents"- mReadFilePS p = do x <- HSM.readFile (floatFn p)- return $ B.concat (BL.toChunks x)--instance (Functor m, MonadPlus m, MonadError e m) => WriteableDirectory (HSM.TreeMonad m) where- mWithCurrentDirectory = mInCurrentDirectory- mSetFileExecutable _ _ = return ()- mWriteFilePS p ps = HSM.writeFile (floatFn p) (BL.fromChunks [ps])- mCreateDirectory p = HSM.createDirectory (floatFn p)- mRename from to = HSM.rename (floatFn from) (floatFn to)- mRemoveDirectory = HSM.unlink . floatFn- mRemoveFile = HSM.unlink . floatFn+backup f = backupByRenaming (fn2fp f)
src/Darcs/Lock.hs view
@@ -82,7 +82,7 @@ withLockCanFail :: String -> IO a -> IO (Either () a) withLockCanFail s job = bracket (takeLock s)- (\l -> if l then releaseLock s else return ())+ (\l -> when l $ releaseLock s) (\l -> if l then job >>= (return.Right) else return $ Left ()) @@ -141,14 +141,15 @@ hClose h return f --- |'withOpenTemp' creates an already open temporary--- file. Both of them run their argument and then delete the file. Also,+-- |'withOpenTemp' creates a temporary file, and opens it.+-- Both of them run their argument and then delete the file. Also, -- both of them (to my knowledge) are not susceptible to race conditions on -- the temporary file (as long as you never delete the temporary file; that -- would reintroduce a race condition). withOpenTemp :: ((Handle, String) -> IO a) -> IO a withOpenTemp = bracket get_empty_file cleanup- where cleanup (h,f) = do try (hClose h) :: IO (Either SomeException ())+-- Warning: A do-notation statement discarded a result of type Either SomeException ().+ where cleanup (h,f) = do _ <- try (hClose h) :: IO (Either SomeException ()) removeFileMayNotExist f get_empty_file = invert `fmap` openBinaryTempFile "." "darcs" invert (a,b) = (b,a)@@ -254,10 +255,10 @@ do isd <- doesDirectoryReallyExist d if not isd then removeFile d- else when isd $ do conts <- actual_dir_contents- withCurrentDirectory d $- mapM_ rmRecursive conts- removeDirectory d+ else do conts <- actual_dir_contents+ withCurrentDirectory d $+ mapM_ rmRecursive conts+ removeDirectory d where actual_dir_contents = -- doesn't include . or .. do c <- getDirectoryContents d return $ filter (/=".") $ filter (/="..") c@@ -278,7 +279,8 @@ editText :: String -> B.ByteString -> IO B.ByteString editText desc txt = withNamedTemp desc $ \f -> do B.writeFile f txt- runEditor f+-- Warning: A do-notation statement discarded a result of type ExitCode.+ _ <- runEditor f B.readFile f readBinFile :: FilePathLike p => p -> IO String
+ src/Darcs/Match.hs view
@@ -0,0 +1,443 @@+-- Copyright (C) 2004-2005 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.++{-# LANGUAGE CPP, ScopedTypeVariables, MultiParamTypeClasses, FlexibleInstances, Rank2Types #-}++#include "gadts.h"++-- | /First matcher, Second matcher and Nonrange matcher/+--+-- When we match for patches, we have a PatchSet, of which we want a+-- subset. This subset is formed by the patches in a given interval+-- which match a given criterion. If we represent time going left to+-- right, then we have (up to) three 'Matcher's:+--+-- * the 'firstMatcher' is the left bound of the interval,+--+-- * the 'secondMatcher' is the right bound, and+--+-- * the 'nonrangeMatcher' is the criterion we use to select among+-- patches in the interval.+---+-- Each of these matchers can be present or not according to the+-- options. The patches we want would then be the ones that all+-- present matchers have in common.+--+-- (Implementation note: keep in mind that the PatchSet is written+-- backwards with respect to the timeline, ie., from right to left)+module Darcs.Match ( matchFirstPatchset, matchSecondPatchset,+ matchPatch,+ matchAPatch, matchAPatchread,+ getFirstMatch, getNonrangeMatch, getNonrangeMatchS,+ getPartialFirstMatch, getPartialSecondMatch,+ getPartialNonrangeMatch,+ firstMatch, secondMatch, haveNonrangeMatch,+ havePatchsetMatch, getOnePatchset,+ checkMatchSyntax, applyInvToMatcher, nonrangeMatcher,+ InclusiveOrExclusive(..), matchExists+ ) where++import Text.Regex ( mkRegex, matchRegex )+import Control.Monad ( when )+import Data.Maybe ( isJust )+import Data.List ( isPrefixOf )++import Darcs.MonadProgress ( MonadProgress )+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info, piap,+ conscientiously, hopefully )+import Darcs.Patch.Info ( justName )+import Darcs.Patch ( RepoPatch, Patchy, Named, invert, invertRL, patch2patchinfo, apply )+import Darcs.Patch.Dummy ( DummyPatch )+import Darcs.Repository ( Repository, readRepo, createPristineDirectoryTree )+import Darcs.Patch.Set ( PatchSet(..), Tagged(..), SealedPatchSet, newset2RL )+#ifdef GADT_WITNESSES+import Darcs.Patch.Set ( Origin )+#endif+import Darcs.Repository.ApplyPatches ( applyPatches )+import Darcs.Patch.Depends ( getPatchesBeyondTag )+import Darcs.Witnesses.Ordered ( RL(..), consRLSealed )++import ByteStringUtils ( mmapFilePS )++import Darcs.Flags ( DarcsFlag( OnePatch, SeveralPatch, Context,+ AfterPatch, UpToPatch, LastN, PatchIndexRange,+ OneTag, AfterTag, UpToTag,+ OnePattern, SeveralPattern,+ AfterPattern, UpToPattern ) )+import Darcs.Patch.Bundle ( scanContext )+import Darcs.Patch.Match ( Matcher, MatchFun, matchPattern, applyMatcher, makeMatcher, parseMatch )+import Darcs.Patch.MatchData ( PatchMatch )+import Printer ( text, ($$) )++import Darcs.RepoPath ( toFilePath )+import Darcs.Patch.ApplyMonad ( ApplyMonad(..) )+import Darcs.Patch.FileName ( FileName )+import Darcs.Witnesses.Sealed ( FlippedSeal(..), Sealed2(..),+ seal, flipSeal, seal2, unsealFlipped, unseal2, unseal )+#include "impossible.h"++data InclusiveOrExclusive = Inclusive | Exclusive deriving Eq++-- | @haveNonrangeMatch flags@ tells whether there is a flag in+-- @flags@ which corresponds to a match that is "non-range". Thus,+-- @--match@, @--patch@ and @--index@ make @haveNonrangeMatch@+-- true, but not @--from-patch@ or @--to-patch@.+haveNonrangeMatch :: [DarcsFlag] -> Bool+haveNonrangeMatch fs = isJust (hasIndexRange fs) || isJust (nonrangeMatcher fs::Maybe (Matcher DummyPatch))++-- | @havePatchsetMatch flags@ tells whether there is a "patchset+-- match" in the flag list. A patchset match is @--match@ or+-- @--patch@, or @--context@, but not @--from-patch@ nor (!)+-- @--index@.+-- Question: Is it supposed not to be a subset of @haveNonrangeMatch@?+havePatchsetMatch :: [DarcsFlag] -> Bool+havePatchsetMatch fs = isJust (nonrangeMatcher fs::Maybe (Matcher DummyPatch)) || hasC fs+ where hasC [] = False+ hasC (Context _:_) = True+ hasC (_:xs) = hasC xs++getNonrangeMatch :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> IO ()+getNonrangeMatch r fs = withRecordedMatch r (getNonrangeMatchS fs)++getPartialNonrangeMatch :: RepoPatch p => Repository p C(r u t)+ -> [DarcsFlag] -> [FileName] -> IO ()+getPartialNonrangeMatch r fs _ =+ withRecordedMatch r (getNonrangeMatchS fs)++getNonrangeMatchS :: (ApplyMonad m, MonadProgress m, RepoPatch p) =>+ [DarcsFlag] -> PatchSet p C(Origin x) -> m ()+getNonrangeMatchS fs repo =+ case nonrangeMatcher fs of+ Just m -> if nonrangeMatcherIsTag fs+ then getTagS m repo+ else getMatcherS Exclusive m repo+ Nothing -> fail "Pattern not specified in getNonrangeMatch."++-- | @firstMatch fs@ tells whether @fs@ implies a "first match", that+-- is if we match against patches from a point in the past on, rather+-- than against all patches since the creation of the repository.+firstMatch :: [DarcsFlag] -> Bool+firstMatch fs = isJust (hasLastn fs)+ || isJust (firstMatcher fs::Maybe (Matcher DummyPatch))+ || isJust (hasIndexRange fs)++getFirstMatch :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> IO ()+getFirstMatch r fs = withRecordedMatch r (getFirstMatchS fs)++getPartialFirstMatch :: RepoPatch p => Repository p C(r u t)+ -> [DarcsFlag] -> Maybe [FileName] -> IO ()+getPartialFirstMatch r fs _ =+ withRecordedMatch r (getFirstMatchS fs)++getFirstMatchS :: (ApplyMonad m, MonadProgress m, RepoPatch p) =>+ [DarcsFlag] -> PatchSet p C(Origin x) -> m ()+getFirstMatchS fs repo =+ case hasLastn fs of+ Just n -> unpullLastN repo n+ Nothing ->+ case hasIndexRange fs of+ Just (_,b) -> unpullLastN repo b -- b is chronologically earlier than a+ Nothing ->+ case firstMatcher fs of+ Nothing -> fail "Pattern not specified in getFirstMatch."+ Just m -> if firstMatcherIsTag fs+ then getTagS m repo+ else getMatcherS Inclusive m repo++-- | @secondMatch fs@ tells whether @fs@ implies a "second match", that+-- is if we match against patches up to a point in the past on, rather+-- than against all patches until now.+secondMatch :: [DarcsFlag] -> Bool+secondMatch fs = isJust (secondMatcher fs::Maybe (Matcher DummyPatch)) || isJust (hasIndexRange fs)++getPartialSecondMatch :: RepoPatch p => Repository p C(r u t)+ -> [DarcsFlag] -> Maybe [FileName] -> IO ()+getPartialSecondMatch r fs _ =+ withRecordedMatch r $ \repo ->+ case secondMatcher fs of+ Nothing -> case hasIndexRange fs of+ Just (a,_) -> unpullLastN repo (a-1)+ Nothing -> fail "Two patterns not specified in get_second_match."+ Just m -> if secondMatcherIsTag fs+ then getTagS m repo+ else getMatcherS Exclusive m repo++unpullLastN :: (ApplyMonad m, MonadProgress m, Patchy p) => PatchSet p C(x y) -> Int -> m ()+unpullLastN repo n = applyInvRL `unsealFlipped` (safetake n $ newset2RL repo)++checkMatchSyntax :: [DarcsFlag] -> IO ()+checkMatchSyntax opts = do+ case getMatchPattern opts of+ Nothing -> return ()+ Just p -> either fail (const $ return ()) $ (parseMatch p::Either String (MatchFun DummyPatch))++getMatchPattern :: [DarcsFlag] -> Maybe PatchMatch+getMatchPattern [] = Nothing+getMatchPattern (OnePattern m:_) = Just m+getMatchPattern (SeveralPattern m:_) = Just m+getMatchPattern (_:fs) = getMatchPattern fs++tagmatch :: String -> Matcher p+tagmatch r = makeMatcher ("tag-name "++r) tm+ where tm (Sealed2 p) =+ let n = justName (info p) in+ "TAG " `isPrefixOf` n && isJust (matchRegex (mkRegex r) $ drop 4 n)++mymatch :: String -> Matcher p+mymatch r = makeMatcher ("patch-name "++r) mm+ where mm (Sealed2 p) = isJust . matchRegex (mkRegex r) . justName . info $ p+++-- | strictJust is a strict version of the Just constructor, used to ensure+-- that if we claim we've got a pattern match, that the pattern will+-- actually match (rathern than fail to compile properly).+strictJust :: a -> Maybe a+strictJust x = Just $! x++-- | @nonrangeMatcher@ is the criterion that is used to match against+-- patches in the interval. It is 'Just m' when the @--patch@, @--match@,+-- @--tag@ options are passed (or their plural variants).+nonrangeMatcher :: Patchy p => [DarcsFlag] -> Maybe (Matcher p)+nonrangeMatcher [] = Nothing+nonrangeMatcher (OnePattern m:_) = strictJust $ matchPattern m+nonrangeMatcher (OneTag t:_) = strictJust $ tagmatch t+nonrangeMatcher (OnePatch p:_) = strictJust $ mymatch p+nonrangeMatcher (SeveralPattern m:_) = strictJust $ matchPattern m+nonrangeMatcher (SeveralPatch p:_) = strictJust $ mymatch p+nonrangeMatcher (_:fs) = nonrangeMatcher fs++-- | @nonrangeMatcherIsTag@ returns true if the matching option was+-- '--tag'+nonrangeMatcherIsTag :: [DarcsFlag] -> Bool+nonrangeMatcherIsTag [] = False+nonrangeMatcherIsTag (OneTag _:_) = True+nonrangeMatcherIsTag (_:fs) = nonrangeMatcherIsTag fs++-- | @firstMatcher@ returns the left bound of the matched interval.+-- This left bound is also specified when we use the singular versions+-- of @--patch@, @--match@ and @--tag@. Otherwise, @firstMatcher@+-- returns @Nothing@.+firstMatcher :: Patchy p => [DarcsFlag] -> Maybe (Matcher p)+firstMatcher [] = Nothing+firstMatcher (OnePattern m:_) = strictJust $ matchPattern m+firstMatcher (AfterPattern m:_) = strictJust $ matchPattern m+firstMatcher (AfterTag t:_) = strictJust $ tagmatch t+firstMatcher (OnePatch p:_) = strictJust $ mymatch p+firstMatcher (AfterPatch p:_) = strictJust $ mymatch p+firstMatcher (_:fs) = firstMatcher fs++firstMatcherIsTag :: [DarcsFlag] -> Bool+firstMatcherIsTag [] = False+firstMatcherIsTag (AfterTag _:_) = True+firstMatcherIsTag (_:fs) = firstMatcherIsTag fs++secondMatcher :: Patchy p => [DarcsFlag] -> Maybe (Matcher p)+secondMatcher [] = Nothing+secondMatcher (OnePattern m:_) = strictJust $ matchPattern m+secondMatcher (UpToPattern m:_) = strictJust $ matchPattern m+secondMatcher (OnePatch p:_) = strictJust $ mymatch p+secondMatcher (UpToPatch p:_) = strictJust $ mymatch p+secondMatcher (UpToTag t:_) = strictJust $ tagmatch t+secondMatcher (_:fs) = secondMatcher fs++secondMatcherIsTag :: [DarcsFlag] -> Bool+secondMatcherIsTag [] = False+secondMatcherIsTag (UpToTag _:_) = True+secondMatcherIsTag (_:fs) = secondMatcherIsTag fs++-- | @matchAPatchread fs p@ tells whether @p@ matches the matchers in+-- the flags listed in @fs@.+matchAPatchread :: Patchy p => [DarcsFlag] -> PatchInfoAnd p C(x y) -> Bool+matchAPatchread fs = case nonrangeMatcher fs of+ Nothing -> const True+ Just m -> applyMatcher m++-- | @matchAPatch fs p@ tells whether @p@ matches the matchers in+-- the flags @fs@+matchAPatch :: Patchy p => [DarcsFlag] -> Named p C(x y) -> Bool+matchAPatch fs p =+ case nonrangeMatcher fs of+ Nothing -> True+ Just m -> applyMatcher m (patch2patchinfo p `piap` p)++matchPatch :: RepoPatch p => [DarcsFlag] -> PatchSet p C(start x) -> Sealed2 (Named p)+matchPatch fs ps =+ case hasIndexRange fs of+ Just (a,a') | a == a' -> case (unseal myhead) $ dropn (a-1) ps of+ Just (Sealed2 p) -> seal2 $ hopefully p+ Nothing -> error "Patch out of range!"+ | otherwise -> bug ("Invalid index range match given to matchPatch: "+++ show (PatchIndexRange a a'))+ where myhead :: PatchSet p C(start x) -> Maybe (Sealed2 (PatchInfoAnd p))+ myhead (PatchSet NilRL (Tagged t _ _ :<: _)) = Just $ seal2 t+ myhead (PatchSet (x:<:_) _) = Just $ seal2 x+ myhead _ = Nothing+ Nothing -> case nonrangeMatcher fs of+ Nothing -> bug "Couldn't matchPatch"+ Just m -> findAPatch m ps++getOnePatchset :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] ->+ IO (SealedPatchSet p C(Origin))+getOnePatchset repository fs =+ case nonrangeMatcher fs of+ Just m -> do ps <- readRepo repository+ if nonrangeMatcherIsTag fs+ then return $ getMatchingTag m ps+ else return $ matchAPatchset m ps+ Nothing -> (seal . scanContext) `fmap` mmapFilePS (toFilePath $ context_f fs)+ where context_f [] = bug "Couldn't match_nonrange_patchset"+ context_f (Context f:_) = f+ context_f (_:xs) = context_f xs++-- | @hasLastn fs@ return the @--last@ argument in @fs@, if any.+hasLastn :: [DarcsFlag] -> Maybe Int+hasLastn [] = Nothing+hasLastn (LastN (-1):_) = error "--last requires a positive integer argument."+hasLastn (LastN n:_) = Just n+hasLastn (_:fs) = hasLastn fs++hasIndexRange :: [DarcsFlag] -> Maybe (Int,Int)+hasIndexRange [] = Nothing+hasIndexRange (PatchIndexRange x y:_) = Just (x,y)+hasIndexRange (_:fs) = hasIndexRange fs++-- | @matchFirstPatchset fs ps@ returns the part of @ps@ before its+-- first matcher, ie the one that comes first dependencywise. Hence,+-- patches in @matchFirstPatchset fs ps@ are the context for the ones+-- we don't want.+matchFirstPatchset :: RepoPatch p => [DarcsFlag] -> PatchSet p C(start x)+ -> SealedPatchSet p C(start)+matchFirstPatchset fs patchset =+ case hasLastn fs of+ Just n -> dropn n patchset+ Nothing ->+ case hasIndexRange fs of+ Just (_,b) -> dropn b patchset+ Nothing ->+ case firstMatcher fs of+ Nothing -> bug "Couldn't matchFirstPatchset"+ Just m -> unseal (dropn 1) $ if firstMatcherIsTag fs+ then getMatchingTag m patchset+ else matchAPatchset m patchset++-- | @dropn n ps@ drops the @n@ last patches from @ps@.+dropn :: Int -> PatchSet p C(start x) -> SealedPatchSet p C(start)+dropn n ps | n <= 0 = seal ps+dropn n (PatchSet NilRL (Tagged t _ ps :<: ts)) = dropn n $ PatchSet (t:<:ps) ts+dropn _ (PatchSet NilRL NilRL) = seal $ PatchSet NilRL NilRL+dropn n (PatchSet (_:<:ps) ts) = dropn (n-1) $ PatchSet ps ts++-- | @matchSecondPatchset fs ps@ returns the part of @ps@ before its+-- second matcher, ie the one that comes last dependencywise.+matchSecondPatchset :: RepoPatch p => [DarcsFlag] -> PatchSet p C(start x)+ -> SealedPatchSet p C(start)+matchSecondPatchset fs ps =+ case hasIndexRange fs of+ Just (a,_) -> dropn (a-1) ps+ Nothing ->+ case secondMatcher fs of+ Nothing -> bug "Couldn't matchSecondPatchset"+ Just m -> if secondMatcherIsTag fs+ then getMatchingTag m ps+ else matchAPatchset m ps++-- | @findAPatch m ps@ returns the last patch in @ps@ matching @m@, and+-- calls 'error' if there is none.+findAPatch :: RepoPatch p => Matcher p -> PatchSet p C(start x) -> Sealed2 (Named p)+findAPatch m (PatchSet NilRL NilRL) = error $ "Couldn't find patch matching " ++ show m+findAPatch m (PatchSet NilRL (Tagged t _ ps :<: ts)) = findAPatch m (PatchSet (t:<:ps) ts)+findAPatch m (PatchSet (p:<:ps) ts) | applyMatcher m p = seal2 $ hopefully p+ | otherwise = findAPatch m (PatchSet ps ts)++-- | @matchAPatchset m ps@ returns a (the largest?) subset of @ps@+-- ending in patch which matches @m@. Calls 'error' if there is none.+matchAPatchset :: RepoPatch p => Matcher p -> PatchSet p C(start x)+ -> SealedPatchSet p C(start)+matchAPatchset m (PatchSet NilRL NilRL) = error $ "Couldn't find patch matching " ++ show m+matchAPatchset m (PatchSet NilRL (Tagged t _ ps :<: ts)) = matchAPatchset m (PatchSet (t:<:ps) ts)+matchAPatchset m (PatchSet (p:<:ps) ts) | applyMatcher m p = seal (PatchSet (p:<:ps) ts)+ | otherwise = matchAPatchset m (PatchSet ps ts)++-- | @getMatchingTag m ps@, where @m@ is a 'Matcher' which matches tags+-- returns a 'SealedPatchSet' containing all patches in the last tag which+-- matches @m@. Last tag means the most recent tag in repository order,+-- i.e. the last one you'd see if you ran darcs changes -t @m@. Calls+-- 'error' if there is no matching tag.+getMatchingTag :: RepoPatch p => Matcher p -> PatchSet p C(start x) -> SealedPatchSet p C(start)+getMatchingTag m (PatchSet NilRL NilRL) = error $ "Couldn't find a tag matching " ++ show m+getMatchingTag m (PatchSet NilRL (Tagged t _ ps :<: ts)) = getMatchingTag m (PatchSet (t:<:ps) ts)+getMatchingTag m (PatchSet (p:<:ps) ts)+ | applyMatcher m p = seal $ PatchSet (p:<:ps) ts+ | otherwise = getMatchingTag m (PatchSet ps ts)++-- | @matchExists m ps@ tells whether there is a patch matching+-- @m@ in @ps@+matchExists :: Matcher p -> PatchSet p C(start x) -> Bool+matchExists _ (PatchSet NilRL NilRL) = False+matchExists m (PatchSet NilRL (Tagged t _ ps :<: ts)) = matchExists m (PatchSet (t:<:ps) ts)+matchExists m (PatchSet (p:<:ps) ts) | applyMatcher m $ p = True+ | otherwise = matchExists m (PatchSet ps ts)++applyInvToMatcher :: (RepoPatch p, ApplyMonad m)+ => InclusiveOrExclusive -> Matcher p -> PatchSet p C(Origin x) -> m ()+applyInvToMatcher _ _ (PatchSet NilRL NilRL) = impossible+applyInvToMatcher ioe m (PatchSet NilRL (Tagged t _ ps :<: ts)) = applyInvToMatcher ioe m+ (PatchSet (t:<:ps) ts)+applyInvToMatcher ioe m (PatchSet (p:<:ps) xs)+ | applyMatcher m p = when (ioe == Inclusive) (applyInvp p)+ | otherwise = applyInvp p >> applyInvToMatcher ioe m (PatchSet ps xs)++getMatcherS :: (ApplyMonad m, RepoPatch p) =>+ InclusiveOrExclusive -> Matcher p -> PatchSet p C(Origin x) -> m ()+getMatcherS ioe m repo =+ if matchExists m repo+ then applyInvToMatcher ioe m repo+ else fail $ "Couldn't match pattern "++ show m++getTagS :: (ApplyMonad m, MonadProgress m, RepoPatch p) =>+ Matcher p -> PatchSet p C(Origin x) -> m ()+getTagS match repo = do+ let pinfo = patch2patchinfo `unseal2` (findAPatch match repo)+ case getPatchesBeyondTag pinfo repo of+ FlippedSeal extras -> applyInvRL extras++-- | @applyInvp@ tries to get the patch that's in a 'PatchInfoAnd+-- patch', and to apply its inverse. If we fail to fetch the patch+-- (presumably in a partial repositiory), then we share our sorrow+-- with the user.+applyInvp :: (Patchy p, ApplyMonad m) => PatchInfoAnd p C(x y) -> m ()+applyInvp hp = apply (invert $ fromHopefully hp)+ where fromHopefully = conscientiously $ \e ->+ text "Sorry, partial repository problem. Patch not available:"+ $$ e+ $$ text ""+ $$ text "If you think what you're trying to do is ok then"+ $$ text "report this as a bug on the darcs-user list."++-- | a version of 'take' for 'RL' lists that cater for contexts.+safetake :: Int -> RL a C(x y) -> FlippedSeal (RL a) C(y)+safetake 0 _ = flipSeal NilRL+safetake _ NilRL = error "There aren't that many patches..."+safetake i (a:<:as) = a `consRLSealed` safetake (i-1) as++withRecordedMatch :: RepoPatch p => Repository p C(r u t)+ -> (PatchSet p C(Origin r) -> IO ()) -> IO ()+withRecordedMatch r job = do createPristineDirectoryTree r "."+ readRepo r >>= job++applyInvRL :: (ApplyMonad m, MonadProgress m, Patchy p) => RL (PatchInfoAnd p) C(x r) -> m ()+applyInvRL = applyPatches . invertRL -- this gives nicer feedback
− src/Darcs/Match.lhs
@@ -1,473 +0,0 @@-% Copyright (C) 2004-2005 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.--\begin{code}-{-# OPTIONS_GHC -cpp -fglasgow-exts #-}-{-# LANGUAGE CPP, ScopedTypeVariables, MultiParamTypeClasses, FlexibleInstances, Rank2Types #-}--#include "gadts.h"--module Darcs.Match ( matchFirstPatchset, matchSecondPatchset,- matchPatch,- matchAPatch, matchAPatchread,- getFirstMatch, getNonrangeMatch,- getPartialFirstMatch, getPartialSecondMatch,- getPartialNonrangeMatch,- firstMatch, secondMatch, haveNonrangeMatch,- havePatchsetMatch, getOnePatchset,- checkMatchSyntax, applyInvToMatcher, nonrangeMatcher,- InclusiveOrExclusive(..), matchExists- ) where--import Text.Regex ( mkRegex, matchRegex )-import Control.Monad ( when )-import Data.Maybe ( isJust )-import Data.List ( isPrefixOf )--import Darcs.Hopefully ( PatchInfoAnd, info, piap,- conscientiously, hopefully )-import Darcs.Patch.Info ( justName )-import Darcs.Patch ( RepoPatch, Patch, Patchy, Named, invert, invertRL, patch2patchinfo, apply )-import Darcs.Repository ( Repository, readRepo, createPristineDirectoryTree )-import Darcs.Patch.Set ( PatchSet(..), Tagged(..), SealedPatchSet, newset2RL )-#ifdef GADT_WITNESSES-import Darcs.Patch.Set ( Origin )-#endif-import Darcs.Repository.ApplyPatches ( applyPatches )-import Darcs.Patch.Depends ( getPatchesInTag, getPatchesBeyondTag )-import Darcs.Witnesses.Ordered ( RL(..), concatRL, consRLSealed )--import ByteStringUtils ( mmapFilePS )--import Darcs.Flags ( DarcsFlag( OnePatch, SeveralPatch, Context,- AfterPatch, UpToPatch, LastN, PatchIndexRange,- OneTag, AfterTag, UpToTag,- OnePattern, SeveralPattern,- AfterPattern, UpToPattern ) )-import Darcs.Patch.Bundle ( scanContext )-import Darcs.Patch.Match ( Matcher, MatchFun, matchPattern, applyMatcher, makeMatcher, parseMatch )-import Darcs.Patch.MatchData ( PatchMatch )-import Printer ( text, ($$) )--import Darcs.RepoPath ( toFilePath )-import Darcs.IO ( WriteableDirectory(..) )-import Darcs.Patch.FileName ( FileName )-import Darcs.Witnesses.Sealed ( FlippedSeal(..), Sealed2(..),- seal, flipSeal, seal2, unsealFlipped, unseal2, unseal )-#include "impossible.h"-\end{code}--\paragraph{Selecting patches}\label{selecting}--Many commands operate on a patch or patches that have already been recorded.-There are a number of options that specify which patches are selected for-these operations: \verb!--patch!, \verb!--match!, \verb!--tag!, and variants-on these, which for \verb!--patch! are \verb!--patches!,-\verb!--from-patch!, and \verb!--to-patch!. The \verb!--patch! and-\verb!--tag! forms simply take (POSIX extended, aka \verb!egrep!) regular-expressions and match them against tag and patch names. \verb!--match!,-described below, allows more powerful patterns.--The plural forms of these options select all matching patches. The singular-forms select the last matching patch. The range (from and to) forms select-patches after or up to (both inclusive) the last matching patch.--These options use the current order of patches in the repository. darcs may-reorder patches, so this is not necessarily the order of creation or the-order in which patches were applied. However, as long as you are just-recording patches in your own repository, they will remain in order.--% NOTE --no-deps is implemented in SelectChanges.lhs, but documented here-% for concistency.-When a patch or a group of patches is selected, all patches they depend on-get silently selected too. For example: \verb!darcs pull --patches bugfix!-means ``pull all the patches with `bugfix' in their name, along with any-patches they require.'' If you really only want patches with `bugfix' in-their name, you should use the \verb!--no-deps! option, which makes darcs-exclude any matched patches from the selection which have dependencies that-are themselves not explicitly matched by the selection.--For \verb!unrecord!, \verb!unpull! and \verb!obliterate!, patches that-depend on the selected patches are silently included, or if-\verb!--no-deps! is used selected patches with dependencies on not selected-patches are excluded from the selection.--\begin{code}-data InclusiveOrExclusive = Inclusive | Exclusive deriving Eq---- | @haveNonrangeMatch flags@ tells whether there is a flag in--- @flags@ which corresponds to a match that is "non-range". Thus,--- @--match@, @--patch@ and @--index@ make @haveNonrangeMatch@--- true, but not @--from-patch@ or @--to-patch@.-haveNonrangeMatch :: [DarcsFlag] -> Bool-haveNonrangeMatch fs = isJust (hasIndexRange fs) || isJust (nonrangeMatcher fs::Maybe (Matcher Patch))---- | @havePatchsetMatch flags@ tells whether there is a "patchset--- match" in the flag list. A patchset match is @--match@ or--- @--patch@, or @--context@, but not @--from-patch@ nor (!)--- @--index@.--- Question: Is it supposed not to be a subset of @haveNonrangeMatch@?-havePatchsetMatch :: [DarcsFlag] -> Bool-havePatchsetMatch fs = isJust (nonrangeMatcher fs::Maybe (Matcher Patch)) || hasC fs- where hasC [] = False- hasC (Context _:_) = True- hasC (_:xs) = hasC xs--getNonrangeMatch :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> IO ()-getNonrangeMatch r fs = withRecordedMatch r (getNonrangeMatchS fs)--getPartialNonrangeMatch :: RepoPatch p => Repository p C(r u t)- -> [DarcsFlag] -> [FileName] -> IO ()-getPartialNonrangeMatch r fs _ =- withRecordedMatch r (getNonrangeMatchS fs)--getNonrangeMatchS :: (RepoPatch p) =>- [DarcsFlag] -> PatchSet p C(Origin x) -> IO ()-getNonrangeMatchS fs repo =- case nonrangeMatcher fs of- Just m -> if nonrangeMatcherIsTag fs- then getTagS m repo- else getMatcherS Exclusive m repo- Nothing -> fail "Pattern not specified in getNonrangeMatch."---- | @firstMatch fs@ tells whether @fs@ implies a "first match", that--- is if we match against patches from a point in the past on, rather--- than against all patches since the creation of the repository.-firstMatch :: [DarcsFlag] -> Bool-firstMatch fs = isJust (hasLastn fs)- || isJust (firstMatcher fs::Maybe (Matcher Patch))- || isJust (hasIndexRange fs)--getFirstMatch :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> IO ()-getFirstMatch r fs = withRecordedMatch r (getFirstMatchS fs)--getPartialFirstMatch :: RepoPatch p => Repository p C(r u t)- -> [DarcsFlag] -> [FileName] -> IO ()-getPartialFirstMatch r fs _ =- withRecordedMatch r (getFirstMatchS fs)--getFirstMatchS :: (RepoPatch p) =>- [DarcsFlag] -> PatchSet p C(Origin x) -> IO ()-getFirstMatchS fs repo =- case hasLastn fs of- Just n -> unpullLastN repo n- Nothing ->- case hasIndexRange fs of- Just (_,b) -> unpullLastN repo b -- b is chronologically earlier than a- Nothing ->- case firstMatcher fs of- Nothing -> fail "Pattern not specified in getFirstMatch."- Just m -> if firstMatcherIsTag fs- then getTagS m repo- else getMatcherS Inclusive m repo---- | @secondMatch fs@ tells whether @fs@ implies a "second match", that--- is if we match against patches up to a point in the past on, rather--- than against all patches until now.-secondMatch :: [DarcsFlag] -> Bool-secondMatch fs = isJust (secondMatcher fs::Maybe (Matcher Patch)) || isJust (hasIndexRange fs)--getPartialSecondMatch :: RepoPatch p => Repository p C(r u t)- -> [DarcsFlag] -> [FileName] -> IO ()-getPartialSecondMatch r fs _ =- withRecordedMatch r $ \repo ->- case secondMatcher fs of- Nothing -> case hasIndexRange fs of- Just (a,_) -> unpullLastN repo (a-1)- Nothing -> fail "Two patterns not specified in get_second_match."- Just m -> if secondMatcherIsTag fs- then getTagS m repo- else getMatcherS Exclusive m repo--unpullLastN :: Patchy p => PatchSet p C(x y) -> Int -> IO ()-unpullLastN repo n = applyInvRL `unsealFlipped` (safetake n $ newset2RL repo)--checkMatchSyntax :: [DarcsFlag] -> IO ()-checkMatchSyntax opts = do- case getMatchPattern opts of- Nothing -> return ()- Just p -> either fail (const $ return ()) $ (parseMatch p::Either String (MatchFun Patch))--getMatchPattern :: [DarcsFlag] -> Maybe PatchMatch-getMatchPattern [] = Nothing-getMatchPattern (OnePattern m:_) = Just m-getMatchPattern (SeveralPattern m:_) = Just m-getMatchPattern (_:fs) = getMatchPattern fs--tagmatch :: String -> Matcher p-tagmatch r = makeMatcher ("tag-name "++r) tm- where tm (Sealed2 p) =- let n = justName (info p) in- "TAG " `isPrefixOf` n && isJust (matchRegex (mkRegex r) $ drop 4 n)--mymatch :: String -> Matcher p-mymatch r = makeMatcher ("patch-name "++r) mm- where mm (Sealed2 p) = isJust . matchRegex (mkRegex r) . justName . info $ p----- | strictJust is a strict version of the Just constructor, used to ensure--- that if we claim we've got a pattern match, that the pattern will--- actually match (rathern than fail to compile properly).------ /First matcher, Second matcher and Nonrange matcher/------ When we match for patches, we have a PatchSet, of which we want a--- subset. This subset is formed by the patches in a given interval--- which match a given criterion. If we represent time going left to--- right (which means the 'PatchSet' is written right to left), then--- we have (up to) three 'Matcher's: the 'nonrangeMatcher' is the--- criterion we use to select among patches in the interval, the--- 'firstMatcher' is the left bound of the interval, and the--- 'last_matcher' is the right bound. Each of these matchers can be--- present or not according to the options.-strictJust :: a -> Maybe a-strictJust x = Just $! x---- | @nonrangeMatcher@ is the criterion that is used to match against--- patches in the interval. It is 'Just m' when the @--patch@, @--match@,--- @--tag@ options are passed (or their plural variants).-nonrangeMatcher :: Patchy p => [DarcsFlag] -> Maybe (Matcher p)-nonrangeMatcher [] = Nothing-nonrangeMatcher (OnePattern m:_) = strictJust $ matchPattern m-nonrangeMatcher (OneTag t:_) = strictJust $ tagmatch t-nonrangeMatcher (OnePatch p:_) = strictJust $ mymatch p-nonrangeMatcher (SeveralPattern m:_) = strictJust $ matchPattern m-nonrangeMatcher (SeveralPatch p:_) = strictJust $ mymatch p-nonrangeMatcher (_:fs) = nonrangeMatcher fs---- | @nonrangeMatcherIsTag@ returns true if the matching option was--- '--tag'-nonrangeMatcherIsTag :: [DarcsFlag] -> Bool-nonrangeMatcherIsTag [] = False-nonrangeMatcherIsTag (OneTag _:_) = True-nonrangeMatcherIsTag (_:fs) = nonrangeMatcherIsTag fs---- | @firstMatcher@ returns the left bound of the matched interval.--- This left bound is also specified when we use the singular versions--- of @--patch@, @--match@ and @--tag@. Otherwise, @firstMatcher@--- returns @Nothing@.-firstMatcher :: Patchy p => [DarcsFlag] -> Maybe (Matcher p)-firstMatcher [] = Nothing-firstMatcher (OnePattern m:_) = strictJust $ matchPattern m-firstMatcher (AfterPattern m:_) = strictJust $ matchPattern m-firstMatcher (AfterTag t:_) = strictJust $ tagmatch t-firstMatcher (OnePatch p:_) = strictJust $ mymatch p-firstMatcher (AfterPatch p:_) = strictJust $ mymatch p-firstMatcher (_:fs) = firstMatcher fs--firstMatcherIsTag :: [DarcsFlag] -> Bool-firstMatcherIsTag [] = False-firstMatcherIsTag (AfterTag _:_) = True-firstMatcherIsTag (_:fs) = firstMatcherIsTag fs--secondMatcher :: Patchy p => [DarcsFlag] -> Maybe (Matcher p)-secondMatcher [] = Nothing-secondMatcher (OnePattern m:_) = strictJust $ matchPattern m-secondMatcher (UpToPattern m:_) = strictJust $ matchPattern m-secondMatcher (OnePatch p:_) = strictJust $ mymatch p-secondMatcher (UpToPatch p:_) = strictJust $ mymatch p-secondMatcher (UpToTag t:_) = strictJust $ tagmatch t-secondMatcher (_:fs) = secondMatcher fs--secondMatcherIsTag :: [DarcsFlag] -> Bool-secondMatcherIsTag [] = False-secondMatcherIsTag (UpToTag _:_) = True-secondMatcherIsTag (_:fs) = secondMatcherIsTag fs---- | @matchAPatchread fs p@ tells whether @p@ matches the matchers in--- the flags listed in @fs@.-matchAPatchread :: Patchy p => [DarcsFlag] -> PatchInfoAnd p C(x y) -> Bool-matchAPatchread fs = case nonrangeMatcher fs of- Nothing -> const True- Just m -> applyMatcher m---- | @matchAPatch fs p@ tells whether @p@ matches the matchers in--- the flags @fs@-matchAPatch :: Patchy p => [DarcsFlag] -> Named p C(x y) -> Bool-matchAPatch fs p =- case nonrangeMatcher fs of- Nothing -> True- Just m -> applyMatcher m (patch2patchinfo p `piap` p)--matchPatch :: RepoPatch p => [DarcsFlag] -> PatchSet p C(start x) -> Sealed2 (Named p)-matchPatch fs ps =- case hasIndexRange fs of- Just (a,a') | a == a' -> case (unseal myhead) $ dropn (a-1) ps of- Just (Sealed2 p) -> seal2 $ hopefully p- Nothing -> error "Patch out of range!"- | otherwise -> bug ("Invalid index range match given to matchPatch: "++- show (PatchIndexRange a a'))- where myhead :: PatchSet p C(start x) -> Maybe (Sealed2 (PatchInfoAnd p))- myhead (PatchSet NilRL (Tagged t _ _ :<: _)) = Just $ seal2 t- myhead (PatchSet (x:<:_) _) = Just $ seal2 x- myhead _ = Nothing- Nothing -> case nonrangeMatcher fs of- Nothing -> bug "Couldn't matchPatch"- Just m -> findAPatch m ps--getOnePatchset :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] ->- IO (SealedPatchSet p C(Origin))-getOnePatchset repository fs =- case nonrangeMatcher fs of- Just m -> do ps <- readRepo repository- if nonrangeMatcherIsTag fs- then return $ getMatchingTag m ps- else return $ matchAPatchset m ps- Nothing -> (seal . scanContext) `fmap` mmapFilePS (toFilePath $ context_f fs)- where context_f [] = bug "Couldn't match_nonrange_patchset"- context_f (Context f:_) = f- context_f (_:xs) = context_f xs---- | @hasLastn fs@ return the @--last@ argument in @fs@, if any.-hasLastn :: [DarcsFlag] -> Maybe Int-hasLastn [] = Nothing-hasLastn (LastN (-1):_) = error "--last requires a positive integer argument."-hasLastn (LastN n:_) = Just n-hasLastn (_:fs) = hasLastn fs--hasIndexRange :: [DarcsFlag] -> Maybe (Int,Int)-hasIndexRange [] = Nothing-hasIndexRange (PatchIndexRange x y:_) = Just (x,y)-hasIndexRange (_:fs) = hasIndexRange fs---- | @matchFirstPatchset fs ps@ returns the part of @ps@ before its--- first matcher, ie the one that comes first dependencywise. Hence,--- patches in @matchFirstPatchset fs ps@ are the ones we don't want.------ Question: are they really? Florent-matchFirstPatchset :: RepoPatch p => [DarcsFlag] -> PatchSet p C(start x)- -> SealedPatchSet p C(start)-matchFirstPatchset fs patchset =- case hasLastn fs of- Just n -> dropn n patchset- Nothing ->- case hasIndexRange fs of- Just (_,b) -> dropn b patchset- Nothing ->- case firstMatcher fs of- Nothing -> bug "Couldn't matchFirstPatchset"- Just m -> unseal (dropn 1) $ if firstMatcherIsTag fs- then getMatchingTag m patchset- else matchAPatchset m patchset---- | @dropn n ps@ drops the @n@ last patches from @ps@.-dropn :: Int -> PatchSet p C(start x) -> SealedPatchSet p C(start)-dropn n ps | n <= 0 = seal ps-dropn n (PatchSet NilRL (Tagged t _ ps :<: ts)) = dropn n $ PatchSet (t:<:ps) ts-dropn _ (PatchSet NilRL NilRL) = seal $ PatchSet NilRL NilRL-dropn n (PatchSet (_:<:ps) ts) = dropn (n-1) $ PatchSet ps ts---- | @matchSecondPatchset fs ps@ returns the part of @ps@ before its--- second matcher, ie the one that comes last dependencywise.-matchSecondPatchset :: RepoPatch p => [DarcsFlag] -> PatchSet p C(start x)- -> SealedPatchSet p C(start)-matchSecondPatchset fs ps =- case hasIndexRange fs of- Just (a,_) -> dropn (a-1) ps- Nothing ->- case secondMatcher fs of- Nothing -> bug "Couldn't matchSecondPatchset"- Just m -> if secondMatcherIsTag fs- then getMatchingTag m ps- else matchAPatchset m ps---- | @findAPatch m ps@ returns the last patch in @ps@ matching @m@, and--- calls 'error' if there is none.-findAPatch :: RepoPatch p => Matcher p -> PatchSet p C(start x) -> Sealed2 (Named p)-findAPatch m (PatchSet NilRL NilRL) = error $ "Couldn't find patch matching " ++ show m-findAPatch m (PatchSet NilRL (Tagged t _ ps :<: ts)) = findAPatch m (PatchSet (t:<:ps) ts)-findAPatch m (PatchSet (p:<:ps) ts) | applyMatcher m p = seal2 $ hopefully p- | otherwise = findAPatch m (PatchSet ps ts)---- | @matchAPatchset m ps@ returns a (the largest?) subset of @ps@--- ending in patch which matches @m@. Calls 'error' if there is none.-matchAPatchset :: RepoPatch p => Matcher p -> PatchSet p C(start x)- -> SealedPatchSet p C(start)-matchAPatchset m (PatchSet NilRL NilRL) = error $ "Couldn't find patch matching " ++ show m-matchAPatchset m (PatchSet NilRL (Tagged t _ ps :<: ts)) = matchAPatchset m (PatchSet (t:<:ps) ts)-matchAPatchset m (PatchSet (p:<:ps) ts) | applyMatcher m p = seal (PatchSet (p:<:ps) ts)- | otherwise = matchAPatchset m (PatchSet ps ts)---- | @getMatchingTag m ps@, where @m@ is a 'Matcher' which matches tags--- returns a 'SealedPatchSet' containing all patches in the last tag which--- matches @m@. Last tag means the most recent tag in repository order,--- i.e. the last one you'd see if you ran darcs changes -t @m@. Calls--- 'error' if there is no matching tag.-getMatchingTag :: RepoPatch p => Matcher p -> PatchSet p C(start x) -> SealedPatchSet p C(start)-getMatchingTag m (PatchSet NilRL NilRL) = error $ "Couldn't find a tag matching " ++ show m-getMatchingTag m (PatchSet NilRL (Tagged t _ ps :<: ts)) = getMatchingTag m (PatchSet (t:<:ps) ts)-getMatchingTag m (PatchSet (p:<:ps) ts)- | applyMatcher m p = seal $ PatchSet (p:<:ps) ts- | otherwise = getMatchingTag m (PatchSet ps ts)---- | @matchExists m ps@ tells whether there is a patch matching--- @m@ in @ps@-matchExists :: Matcher p -> PatchSet p C(start x) -> Bool-matchExists _ (PatchSet NilRL NilRL) = False-matchExists m (PatchSet NilRL (Tagged t _ ps :<: ts)) = matchExists m (PatchSet (t:<:ps) ts)-matchExists m (PatchSet (p:<:ps) ts) | applyMatcher m $ p = True- | otherwise = matchExists m (PatchSet ps ts)--applyInvToMatcher :: (RepoPatch p, WriteableDirectory m) => InclusiveOrExclusive -> Matcher p -> PatchSet p C(Origin x) -> m ()-applyInvToMatcher _ _ (PatchSet NilRL NilRL) = impossible-applyInvToMatcher ioe m (PatchSet NilRL (Tagged t _ ps :<: ts)) = applyInvToMatcher ioe m- (PatchSet (t:<:ps) ts)-applyInvToMatcher ioe m (PatchSet (p:<:ps) xs)- | applyMatcher m p = when (ioe == Inclusive) (applyInvp p)- | otherwise = applyInvp p >> applyInvToMatcher ioe m (PatchSet ps xs)--getMatcherS :: (WriteableDirectory m, RepoPatch p) =>- InclusiveOrExclusive -> Matcher p -> PatchSet p C(Origin x) -> m ()-getMatcherS ioe m repo =- if matchExists m repo- then applyInvToMatcher ioe m repo- else fail $ "Couldn't match pattern "++ show m--getTagS :: (RepoPatch p) =>- Matcher p -> PatchSet p C(Origin x) -> IO ()-getTagS match repo = do- let pinfo = patch2patchinfo `unseal2` (findAPatch match repo)- case getPatchesBeyondTag pinfo repo of- FlippedSeal extras -> applyInvRL extras---- | @applyInvp@ tries to get the patch that's in a 'PatchInfoAnd--- patch', and to apply its inverse. If we fail to fetch the patch--- (presumably in a partial repositiory), then we share our sorrow--- with the user.-applyInvp :: (Patchy p, WriteableDirectory m) => PatchInfoAnd p C(x y) -> m ()-applyInvp hp = apply [] (invert $ fromHopefully hp)- where fromHopefully = conscientiously $ \e ->- text "Sorry, partial repository problem. Patch not available:"- $$ e- $$ text ""- $$ text "If you think what you're trying to do is ok then"- $$ text "report this as a bug on the darcs-user list."---- | a version of 'take' for 'RL' lists that cater for contexts.-safetake :: Int -> RL a C(x y) -> FlippedSeal (RL a) C(y)-safetake 0 _ = flipSeal NilRL-safetake _ NilRL = error "There aren't that many patches..."-safetake i (a:<:as) = a `consRLSealed` safetake (i-1) as--withRecordedMatch :: RepoPatch p => Repository p C(r u t)- -> (PatchSet p C(Origin r) -> IO ()) -> IO ()-withRecordedMatch r job = do createPristineDirectoryTree r "."- readRepo r >>= job--applyInvRL :: (Patchy p) => RL (PatchInfoAnd p) C(x r) -> IO ()-applyInvRL = applyPatches [] . invertRL -- this gives nicer feedback-\end{code}
+ src/Darcs/MonadProgress.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE TypeSynonymInstances #-}+-- Copyright (C) 2011 Ganesh Sittampalam+--+-- Permission is hereby granted, free of charge, to any person+-- obtaining a copy of this software and associated documentation+-- files (the "Software"), to deal in the Software without+-- restriction, including without limitation the rights to use, copy,+-- modify, merge, publish, distribute, sublicense, and/or sell copies+-- of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be+-- included in all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+-- BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+-- ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+-- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+-- SOFTWARE.++module Darcs.MonadProgress ( MonadProgress(..), ProgressAction(..)+ , silentlyRunProgressActions )+ where++import Progress ( beginTedious, endTedious, tediousSize, finishedOneIO )+import Printer ( hPutDocLn, Doc )+import Darcs.ColorPrinter () -- for instance Show Doc+import System.IO ( stderr )+import qualified Storage.Hashed.Monad as HSM++-- |a monadic action, annotated with a progress message that could be printed out+-- while running the action, and a message that could be printed out on error.+-- Actually printing out these messages is optional to allow non-IO monads to+-- just run the action.+data ProgressAction m a =+ ProgressAction+ {paAction :: m a+ ,paMessage :: Doc+ ,paOnError :: Doc+ }++class Monad m => MonadProgress m where+ -- |run a list of 'ProgressAction's. In some monads (typically IO-based ones),+ -- the progress and error messages will be used. In others they will be+ -- ignored and just the actions will be run.+ runProgressActions :: String -> [ProgressAction m ()] -> m ()++instance MonadProgress IO where+ runProgressActions _ [] = return ()+ runProgressActions what items =+ do beginTedious what+ tediousSize what (length items)+ mapM_ go items+ endTedious what+ where go item =+ do finishedOneIO what (show $ paMessage item)+ paAction item `catch` \e ->+ do hPutDocLn stderr $ paOnError item+ ioError e++-- |run a list of 'ProgressAction's without any feedback messages+silentlyRunProgressActions :: Monad m => String -> [ProgressAction m ()] -> m ()+silentlyRunProgressActions _ = mapM_ paAction++instance (Functor m, Monad m) => MonadProgress (HSM.TreeMonad m) where+ runProgressActions = silentlyRunProgressActions
+ src/Darcs/Patch.hs view
@@ -0,0 +1,93 @@+-- Copyright (C) 2002-2003 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.++{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}+#include "gadts.h"+module Darcs.Patch ( RepoPatch,+ PrimOf, Named, Patchy,+ joinPatches,+ fromPrim, fromPrims,+ rmfile, addfile, rmdir, adddir, move,+ hunk, tokreplace, namepatch, anonymous,+ binary,+ description,+ showContextPatch, showPatch, showNicely,+ infopatch, changepref,+ thing, things,+ primIsAddfile, primIsHunk, primIsSetpref,+ merge,+ commute, listTouchedFiles, hunkMatches,+ forceTokReplace,+ PrimPatch,+ -- for PatchTest+ resolveConflicts,+ Effect, effect,+ primIsBinary, gzWritePatch, writePatch, primIsAdddir,+ invert, invertFL, invertRL,+ commuteFLorComplain, commuteRL,+ readPatch, readPatchPartial,+ canonize, sortCoalesceFL,+ tryToShrink,+ patchname, patchcontents,+ applyToFilepaths, apply,+ applyToTree,+ patch2patchinfo,+ summary, summaryFL, plainSummary, xmlSummary, plainSummaryPrims,+ adddeps, getdeps,+ listConflictedFiles,+ isInconsistent,+ ) where+import Darcs.Patch.Commute ( commuteFLorComplain, commuteRL )+import Darcs.Patch.Invert ( invertRL, invertFL )+import Darcs.Patch.Named ( Named,+ adddeps, namepatch,+ anonymous,+ getdeps,+ infopatch,+ patch2patchinfo, patchname, patchcontents )+import Darcs.Patch.Read ( readPatch, readPatchPartial )+import Darcs.Patch.Patchy ( Patchy,+ showPatch, showNicely, showContextPatch,+ invert,+ thing, things,+ apply,+ description, summary, summaryFL,+ commute, listTouchedFiles, hunkMatches+ )+import Darcs.Patch.RepoPatch ( RepoPatch )+import Darcs.Patch.Show ( writePatch, gzWritePatch )+import Darcs.Patch.Summary ( xmlSummary, plainSummary, plainSummaryPrims )+import Darcs.Patch.Apply ( applyToFilepaths, applyToTree )+import Darcs.Patch.V1.Commute ( merge )+import Darcs.Patch.Conflict ( Conflict, CommuteNoConflicts, listConflictedFiles, resolveConflicts )+import Darcs.Patch.Effect ( Effect(effect) )+import Darcs.Patch.FileHunk ( IsHunk )+import Darcs.Patch.Format ( PatchListFormat )+import Darcs.Patch.Prim ( FromPrims, fromPrims, joinPatches, FromPrim, fromPrim,+ canonize,+ sortCoalesceFL,+ rmdir, rmfile, tokreplace, adddir, addfile,+ binary, changepref, hunk, move,+ primIsAdddir, primIsAddfile,+ primIsHunk, primIsBinary, primIsSetpref,+ tryToShrink,+ PrimPatch, PrimPatchBase(..) )+import Darcs.Patch.TokenReplace ( forceTokReplace )+import Darcs.Patch.Repair ( isInconsistent )++instance (CommuteNoConflicts p, Conflict p, IsHunk p, PatchListFormat p, PrimPatchBase p, Patchy p) => Patchy (Named p)
− src/Darcs/Patch.lhs
@@ -1,139 +0,0 @@-% Copyright (C) 2002-2003 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.--\chapter{Theory of patches}-\label{Patch}--\newtheorem{thm}{Theorem}-\newtheorem{dfn}{Definition}--\section{Background}--I think a little background on the author is in order. I am a physicist,-and think like a physicist. The proofs and theorems given here are what I-would call ``physicist'' proofs and theorems, which is to say that while-the proofs may not be rigorous, they are practical, and the theorems are-intended to give physical insight. It would be great to have a-mathematician work on this to give patch theory better formalized-foundations.--From the beginning of this theory, which originated as the result of a-series of email discussions with Tom Lord, I have looked at patches as-being analogous to the operators of quantum mechanics. I include in this-appendix footnotes explaining the theory of patches in terms of the theory-of quantum mechanics. I advise against taking this analogy too seriously,-although it could provide some insight into how a physicist might think-about darcs.--\begin{code}-{-# OPTIONS_GHC -cpp -fno-warn-orphans #-}-#include "gadts.h"-module Darcs.Patch ( RepoPatch, Prim, Patch, RealPatch, Named, Patchy,- flattenFL, joinPatches,- fromPrim, fromPrims,- isNullPatch, nullP,- rmfile, addfile, rmdir, adddir, move,- hunk, tokreplace, namepatch, anonymous,- binary,- description,- showContextPatch, showPatch, showNicely,- infopatch, changepref,- thing, things,- isSimilar, primIsAddfile, primIsHunk, primIsSetpref,- isMerger, merge,- commute, listTouchedFiles, hunkMatches,- -- for PatchTest- elegantMerge,- resolveConflicts,- Effect, effect,- primIsBinary, gzWritePatch, writePatch, primIsAdddir,- invert, invertFL, invertRL, identity,- commuteFLorComplain, commuteRL,- readPatch,- canonize, sortCoalesceFL,- tryToShrink,- patchname, patchcontents,- applyToFilepaths, apply,- applyToTree,- patch2patchinfo,- LineMark(AddedLine, RemovedLine, AddedRemovedLine, None),- MarkedUpFile, markupFile, emptyMarkedupFile,- summary, plainSummary, xmlSummary,- adddeps, getdeps,- listConflictedFiles,- modernizePatch, isInconsistent,- -- for Population- DirMark(..), patchChanges, applyToPop,- ) where-import Darcs.PopulationData ( DirMark(..) )-import Darcs.Patch.Core ( Patch, Named,- flattenFL,- adddeps, namepatch,- anonymous,- isMerger,- getdeps,- isNullPatch, nullP, infopatch,- patch2patchinfo, patchname, patchcontents )-import Darcs.Patch.Read ( readPatch )-import Darcs.Patch.Patchy ( Patchy, writePatch, gzWritePatch,- showPatch, showNicely, showContextPatch,- invert, invertRL, invertFL, identity,- thing, things,- commuteFLorComplain, commuteRL, apply,- description, summary,- commute, listTouchedFiles, hunkMatches- )-import Darcs.Patch.Viewing ( xmlSummary, plainSummary )-import Darcs.Patch.Apply ( applyToPop, patchChanges, emptyMarkedupFile,- markupFile,- applyToFilepaths,- LineMark(..), MarkedUpFile, applyToTree )-import Darcs.Patch.Commute ( modernizePatch,- merge, elegantMerge,- )-import Darcs.Patch.Prim ( FromPrims, fromPrims, joinPatches, FromPrim, fromPrim,- Conflict, Effect(effect), listConflictedFiles, resolveConflicts,- Prim, canonize,- sortCoalesceFL,- rmdir, rmfile, tokreplace, adddir, addfile,- binary, changepref, hunk, move,- primIsAdddir, primIsAddfile,- primIsHunk, primIsBinary, primIsSetpref,- isSimilar, isInconsistent,- tryToShrink )-import Darcs.Witnesses.Ordered ( FL )-import Darcs.Patch.Real ( RealPatch )--instance Patchy Patch-instance (Conflict p, Effect p, Patchy p) => Patchy (Named p)--class (Patchy p, Effect p, FromPrim p, Conflict p) => RepoPatchBase p-instance RepoPatchBase Patch-instance RepoPatchBase RealPatch--class (Patchy p, Effect p, FromPrims p, Conflict p) => RepoPatch p-instance RepoPatch Patch-instance RepoPatchBase p => RepoPatch (FL p)--\end{code}--\input{Darcs/Patch/Apply.lhs}-\input{Darcs/Patch/Core.lhs}-\input{Darcs/Patch/Prim.lhs}-\input{Darcs/Patch/Commute.lhs}-\input{Darcs/Patch/Show.lhs}-
+ src/Darcs/Patch/Apply.hs view
@@ -0,0 +1,57 @@+-- Copyright (C) 2002-2005 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.+++{-# LANGUAGE CPP #-}++#include "gadts.h"++module Darcs.Patch.Apply ( Apply(..),+ applyToFilepaths,+ applyToTree,+ )+ where++import Prelude hiding ( catch, pi )++import Darcs.Witnesses.Ordered ( FL(..), RL(..) )++import Darcs.Patch.ApplyMonad ( ApplyMonad(..), withFilePaths )+import Darcs.Patch.FileName( fn2fp, fp2fn )+import Storage.Hashed.Tree( Tree )+import Storage.Hashed.Monad( virtualTreeMonad )++import Control.Monad ( MonadPlus )+++class Apply p where+ apply :: ApplyMonad m => p C(x y) -> m ()++instance Apply p => Apply (FL p) where+ apply NilFL = return ()+ apply (p:>:ps) = apply p >> apply ps++instance Apply p => Apply (RL p) where+ apply NilRL = return ()+ apply (p:<:ps) = apply ps >> apply p++applyToFilepaths :: Apply p => p C(x y) -> [FilePath] -> [FilePath]+applyToFilepaths pa fs = map fn2fp $ withFilePaths (map fp2fn fs) (apply pa)++-- | Apply a patch to a 'Tree', yielding a new 'Tree'.+applyToTree :: (Apply p, Functor m, MonadPlus m) => p C(x y) -> Tree m -> m (Tree m)+applyToTree patch t = snd `fmap` virtualTreeMonad (apply patch) t
− src/Darcs/Patch/Apply.lhs
@@ -1,524 +0,0 @@-% Copyright (C) 2002-2005 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.---\begin{code}-{-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans #-}-{-# LANGUAGE CPP #-}--#include "gadts.h"--module Darcs.Patch.Apply ( applyToFilepaths,- forceTokReplace,- markupFile, emptyMarkedupFile,- patchChanges,- applyToPop,- applyToTree,- LineMark(..), MarkedUpFile )- where--import Prelude hiding ( catch, pi )-import Darcs.Flags ( DarcsFlag( SetScriptsExecutable ) )--import qualified Data.ByteString.Char8 as BC (split, break, pack, singleton)--import qualified Data.ByteString as B (ByteString, null, empty, concat, isPrefixOf)-import ByteStringUtils ( linesPS, unlinesPS, breakAfterNthNewline, breakBeforeNthNewline, )--import Darcs.Patch.FileName ( fn2ps, fn2fp, fp2fn,- movedirfilename )-import Darcs.PopulationData ( Population(..), PopTree(..), Info(..), DirMark(..) )-import Data.List ( intersperse )-import Data.Maybe ( catMaybes )-import Darcs.Patch.Patchy ( Apply, apply, applyAndTryToFixFL, applyAndTryToFix,- mapMaybeSnd )-import Darcs.Patch.Commute ()-import Darcs.Patch.Core ( Patch(..), Named(..) )-import Darcs.Patch.Prim ( Prim(..), Effect(effect),- DirPatchType(..), FilePatchType(..),- tryTokInternal, showHunk, FileNameFormat(..) )-import Darcs.Patch.Info ( PatchInfo )-import Control.Monad ( when )-import Darcs.Patch.RegChars ( regChars )-import Darcs.Repository.Prefs ( changePrefval )-import Darcs.Global ( darcsdir )-import Darcs.IO ( WriteableDirectory(..), ReadableDirectory(..) )-import Darcs.FilePathMonad ( withFilePaths )-#include "impossible.h"-import Darcs.Witnesses.Ordered ( FL(..), (:>)(..),- mapFL, mapFL_FL, spanFL, foldlFL )--import Storage.Hashed.Tree( Tree )-import Storage.Hashed.Monad( virtualTreeIO )-import Printer( renderString )--type FileContents = B.ByteString-\end{code}----\section{Introduction}--A patch describes a change to the tree. It could be either a primitive-patch (such as a file add/remove, a directory rename, or a hunk replacement-within a file), or a composite patch describing many such changes. Every-patch type must satisfy the conditions described in this appendix. The-theory of patches is independent of the data which the patches manipulate,-which is what makes it both powerful and useful, as it provides a framework-upon which one can build a revision control system in a sane manner.--Although in a sense, the defining property of any patch is that it can be-applied to a certain tree, and thus make a certain change, this change does-not wholly define the patch. A patch is defined by a-\emph{representation}, together with a set of rules for how it behaves-(which it has in common with its patch type). The \emph{representation} of-a patch defines what change that particular patch makes, and must be-defined in the context of a specific tree. The theory of patches is a-theory of the many ways one can change the representation of a patch to-place it in the context of a different tree. The patch itself is not-changed, since it describes a single change, which must be the same-regardless of its representation\footnote{For those comfortable with-quantum mechanics, think of a patch as a quantum mechanical operator, and-the representation as the basis set. The analogy breaks down pretty-quickly, however, since an operator could be described in any complete-basis set, while a patch modifying the file {\tt foo} can only be described-in the rather small set of contexts which have a file {\tt foo} to be-modified.}.--So how does one define a tree, or the context of a patch? The simplest way-to define a tree is as the result of a series of patches applied to the-empty tree\footnote{This is very similar to the second-quantized picture,-in which any state is seen as the result of a number of creation operators-acting on the vacuum, and provides a similar set of simplifications---in-particular, the exclusion principle is very elegantly enforced by the-properties of the anti-hermitian fermion creation operators.}. Thus, the-context of a patch consists of the set of patches that precede it.--\section{Applying patches}---\begin{code}-applyToFilepaths :: Apply p => p C(x y) -> [FilePath] -> [FilePath]-applyToFilepaths pa fs = withFilePaths fs (apply [] pa)--instance Apply p => Apply (Named p) where- apply opts (NamedP _ _ p) = apply opts p- applyAndTryToFix (NamedP n d p) = mapMaybeSnd (NamedP n d) `fmap` applyAndTryToFix p--instance Apply Patch where- apply opts p = applyFL opts $ effect p- applyAndTryToFixFL (PP x) = mapMaybeSnd (mapFL_FL PP) `fmap` applyAndTryToFixFL x- applyAndTryToFixFL (ComP xs) = mapMaybeSnd (\xs' -> ComP xs' :>: NilFL) `fmap` applyAndTryToFix xs- applyAndTryToFixFL x = do apply [] x; return Nothing- applyAndTryToFix (ComP xs) = mapMaybeSnd ComP `fmap` applyAndTryToFix xs- applyAndTryToFix x = do mapMaybeSnd ComP `fmap` applyAndTryToFixFL x--instance Apply Prim where- apply opts (Split ps) = applyFL opts ps- apply _ Identity = return ()- apply _ (FP f RmFile) = mRemoveFile f- apply _ (FP f AddFile) = mCreateFile f- apply opts p@(FP _ (Hunk _ _ _)) = applyFL opts (p :>: NilFL)- apply _ (FP f (TokReplace t o n)) = mModifyFilePSs f doreplace- where doreplace ls =- case mapM (tryTokInternal t (BC.pack o) (BC.pack n)) ls of- Nothing -> fail $ "replace patch to " ++ fn2fp f- ++ " couldn't apply."- Just ls' -> return $ map B.concat ls'- apply _ (FP f (Binary o n)) = mModifyFilePS f doapply- where doapply oldf = if o == oldf- then return n- else fail $ "binary patch to " ++ fn2fp f- ++ " couldn't apply."- apply _ (DP d AddDir) = mCreateDirectory d- apply _ (DP d RmDir) = mRemoveDirectory d- apply _ (Move f f') = mRename f f'- apply _ (ChangePref p f t) =- do b <- mDoesDirectoryExist (fp2fn $ darcsdir++"/prefs")- when b $ changePrefval p f t- applyAndTryToFixFL (FP f RmFile) =- do x <- mReadFilePS f- if B.null x then do mRemoveFile f- return Nothing- else do mWriteFilePS f B.empty- mRemoveFile f- return $ Just ("WARNING: Fixing removal of non-empty file "++fn2fp f,- FP f (Binary x B.empty) :>: FP f RmFile :>: NilFL )- applyAndTryToFixFL p = do apply [] p; return Nothing--applyFL :: WriteableDirectory m => [DarcsFlag] -> FL Prim C(x y) -> m ()-applyFL _ NilFL = return ()-applyFL opts ((FP f h@(Hunk _ _ _)):>:the_ps)- = case spanFL f_hunk the_ps of- (xs :> ps') ->- do let foo = h :>: mapFL_FL (\(FP _ h') -> h') xs- mModifyFilePS f $ hunkmod foo- case h of- (Hunk 1 _ (n:_)) | BC.pack "#!" `B.isPrefixOf` n &&- SetScriptsExecutable `elem` opts- -> mSetFileExecutable f True- _ -> return ()- applyFL opts ps'- where f_hunk (FP f' (Hunk _ _ _)) | f == f' = True- f_hunk _ = False- hunkmod :: WriteableDirectory m => FL FilePatchType C(x y)- -> B.ByteString -> m B.ByteString- hunkmod NilFL ps = return ps- hunkmod (Hunk line old new:>:hs) ps- = case applyHunkLines [(line,old,new)] ps of- Just ps' -> hunkmod hs ps'- Nothing -> fail $ "Error applying hunk " ++- (renderString $ showHunk NewFormat f line old new) ++- " to file " ++ fn2fp f ++ ": " ++ show ps- hunkmod _ _ = impossible-applyFL opts (p:>:ps) = do apply opts p- applyFL opts ps-\end{code}--\subsection{Hunk patches}--Hunks are an example of a complex filepatch. A hunk is a set of lines of a-text file to be replaced by a different set of lines. Either of these sets-may be empty, which would mean a deletion or insertion of lines.-\begin{code}-applyHunks :: [(Int, [B.ByteString], [B.ByteString])]- -> B.ByteString -> Maybe [B.ByteString]-applyHunks [] ps = Just [ps]-applyHunks ((l, [], n):hs) ps- = case breakBeforeNthNewline (l - 2) ps of- (prfix, after_prefix) -> do rest <- applyHunks hs after_prefix- return $ intersperse nl (prfix:n) ++ rest- where nl = BC.singleton '\n'-applyHunks ((l, o, n):hs) ps- = case breakBeforeNthNewline (l - 2) ps of- (prfix, after_prefix) ->- case breakBeforeNthNewline (length o) after_prefix of- (oo, _) | oo /= unlinesPS (B.empty:o) -> fail "applyHunks error"- (_, suffix) ->- do rest <- applyHunks hs suffix- return $ intersperse nl (prfix:n) ++ rest- where nl = BC.singleton '\n'--applyHunkLines :: [(Int, [B.ByteString], [B.ByteString])]- -> FileContents -> Maybe FileContents-applyHunkLines [] c = Just c-applyHunkLines [(1, [], n)] ps | B.null ps = Just $ unlinesPS (n++[B.empty])-applyHunkLines hs@((l, o, n):hs') ps =- do pss <- case l of- 1 -> case breakAfterNthNewline (length o) ps of- Nothing -> if ps == unlinesPS o- then return $ intersperse nl n- else fail "applyHunkLines: Unexpected hunks"- Just (shouldbeo, suffix)- | shouldbeo /= unlinesPS (o++[B.empty]) ->- fail $ "applyHunkLines: Bad patch!"- | null n ->- do x <- applyHunkLines hs' suffix- return [x]- | otherwise ->- do rest <- applyHunks hs' suffix- return $ intersperse nl n ++ nl:rest- _ | l < 0 -> bug "Prim.applyHunkLines: After -ve lines?"- | otherwise -> applyHunks hs ps- let result = B.concat pss- return result- where nl = BC.singleton '\n'-\end{code}--\subsection{Token replace patches}\label{token_replace}--Although most filepatches will be hunks, darcs is clever enough to support-other types of changes as well. A ``token replace'' patch replaces all-instances of a given token with some other version. A token, here, is-defined by a regular expression, which must be of the simple [a--z\ldots]\ type,-indicating which characters are allowed in a token, with all other-characters acting as delimiters. For example, a C identifier would be a-token with the flag \verb![A-Za-z_0-9]!.--\begin{code}-forceTokReplace :: String -> String -> String- -> FileContents -> Maybe FileContents-forceTokReplace t os ns c = Just $ unlinesPS $ map forceReplace $ linesPS c- where o = BC.pack os- n = BC.pack ns- tokchar = regChars t- toks_and_intratoks ps | B.null ps = []- toks_and_intratoks ps =- let (before,s') = BC.break tokchar ps- (tok, after) = BC.break (not . tokchar) s'- in before : tok : toks_and_intratoks after- forceReplace ps = B.concat $ map o_t_n $ toks_and_intratoks ps- o_t_n s | s == o = n- | otherwise = s-\end{code}--What makes the token replace patch special is the fact that a token replace-can be merged with almost any ordinary hunk, giving exactly what you would-want. For example, you might want to change the patch type {\tt-TokReplace} to {\tt TokenReplace} (if you decided that saving two-characters of space was stupid). If you did this using hunks, it would-modify every line where {\tt TokReplace} occurred, and quite likely provoke-a conflict with another patch modifying those lines. On the other hand, if-you did this using a token replace patch, the only change that it could-conflict with would be if someone else had used the token ``{\tt-TokenReplace}'' in their patch rather than TokReplace---and that actually-would be a real conflict!--%\section{Outputting interesting and useful information}--%Just being able to manipulate patches and trees is not enough. We also-%want to be able to view the patches and files. This requires another set-%of functions, closely related to the patch application functions, which-%will give us the necessary information to browse the changes we have made.-%It is \emph{not} the Patch module's responsibility to add any sort of-%markup or formatting, but simply to provide the information necessary for an-%external module to do the formatting.--\begin{code}-data LineMark = AddedLine PatchInfo | RemovedLine PatchInfo- | AddedRemovedLine PatchInfo PatchInfo | None- deriving (Show)-type MarkedUpFile = [(B.ByteString, LineMark)]-emptyMarkedupFile :: MarkedUpFile-emptyMarkedupFile = [(B.empty, None)]--markupFile :: Effect p => PatchInfo -> p C(x y)- -> (FilePath, MarkedUpFile) -> (FilePath, MarkedUpFile)-markupFile x p = mps (effect p)- where mps :: FL Prim C(a b) -> (FilePath, MarkedUpFile) -> (FilePath, MarkedUpFile)- mps NilFL = id- mps (pp:>:pps) = mps pps . markupPrim x pp--markupPrim :: PatchInfo -> Prim C(x y)- -> (FilePath, MarkedUpFile) -> (FilePath, MarkedUpFile)-markupPrim _ (Split NilFL) (f, mk) = (f, mk)-markupPrim n (Split (p:>:ps)) (f, mk) = markupPrim n (Split ps) $- markupPrim n p (f, mk)-markupPrim _ (FP _ AddFile) (f, mk) = (f, mk)-markupPrim _ (FP _ RmFile) (f, mk) = (f, mk)-markupPrim n (FP f' (Hunk line old new)) (f, mk)- | fn2fp f' /= f = (f, mk)- | otherwise = (f, markupHunk n line old new mk)-markupPrim name (FP f' (TokReplace t o n)) (f, mk)- | fn2fp f' /= f = (f, mk)- | otherwise = (f, markupTok name t o n mk)-markupPrim _ (DP _ _) (f, mk) = (f, mk)-markupPrim _ (Move d d') (f, mk) = (fn2fp $ movedirfilename d d' (fp2fn f), mk)-markupPrim _ (ChangePref _ _ _) (f,mk) = (f,mk)-markupPrim _ Identity (f,mk) = (f,mk)-markupPrim n (FP f' (Binary _ _)) (f,mk)- | fn2fp f' == f = (f,(BC.pack "Binary file", AddedLine n):mk)- | otherwise = (f,mk)--markupHunk :: PatchInfo -> Int -> [B.ByteString] -> [B.ByteString]- -> MarkedUpFile -> MarkedUpFile-markupHunk n l old new ((sf, RemovedLine pi):mk) =- (sf, RemovedLine pi) : markupHunk n l old new mk-markupHunk n l old new ((sf, AddedRemovedLine po pn):mk) =- (sf, AddedRemovedLine po pn) : markupHunk n l old new mk--markupHunk name 1 old (n:ns) mk =- (n, AddedLine name) : markupHunk name 1 old ns mk-markupHunk n 1 (o:os) [] ((sf, None):mk)- | o == sf = (sf, RemovedLine n) : markupHunk n 1 os [] mk- | otherwise = [(BC.pack "Error in patch application", AddedLine n)]-markupHunk n 1 (o:os) [] ((sf, AddedLine nold):mk)- | o == sf = (sf, AddedRemovedLine nold n) : markupHunk n 1 os [] mk- | otherwise = [(BC.pack "Error in patch application", AddedLine n)]-markupHunk _ 1 [] [] mk = mk--markupHunk n l old new ((sf, AddedLine pi):mk)- | l > 1 = (sf, AddedLine pi) : markupHunk n (l-1) old new mk- | l < 1 = (sf, AddedLine pi) : markupHunk n (l-1) old new mk-markupHunk n l old new ((sf, None):mk)- | l > 1 = (sf, None) : markupHunk n (l-1) old new mk- | l < 1 = (sf, None) : markupHunk n (l-1) old new mk--markupHunk _ _ _ _ [] = []--markupHunk _ _ _ _ mk = (BC.pack "Error: ",None) : mk--markupTok :: PatchInfo -> String -> String -> String- -> MarkedUpFile -> MarkedUpFile-markupTok name t ostr nstr mk = concatMap mt mk- where o = BC.pack ostr- n = BC.pack nstr- mt (sf, AddedLine pi) =- case B.concat `fmap` tryTokInternal t o n sf of- Just sf' | sf' == sf -> [(sf, AddedLine pi)]- | otherwise -> [(sf, AddedRemovedLine pi name),- (sf', AddedLine name)]- Nothing ->- [(sf, AddedLine pi),- (BC.pack "There seems to be an inconsistency...", None),- (BC.pack "Please run darcs check.", None)]- mt mark = [mark]-\end{code}--%files or directories, changed by a patch-%we get it solely from the patch here-%instead of performing patch apply on a population-%we !could! achieve the same by applying a patch to a cleaned population-%and getting modified files and dirs-%but this should be significantly slower when the population grows large-%This could be useful for just presenting a summary of what a patch does-%(especially useful for larger repos)--\begin{code}-patchChanges :: Prim C(x y) -> [(String,DirMark)]-patchChanges (Move f1 f2) = [(fn2fp f1,MovedFile $ fn2fp f2),- (fn2fp f2,MovedFile $ fn2fp f1)]-patchChanges (DP d AddDir) = [(fn2fp d,AddedDir)]-patchChanges (DP d RmDir) = [(fn2fp d,RemovedDir)]-patchChanges (FP f AddFile) = [(fn2fp f,AddedFile)]-patchChanges (FP f RmFile) = [(fn2fp f,RemovedFile)]-patchChanges (FP f _) = [(fn2fp f,ModifiedFile)]-patchChanges (Split ps) = concat $ mapFL patchChanges ps-patchChanges (ChangePref _ _ _) = []-patchChanges Identity = []-\end{code}--%apply a patch to a population at a given time--\begin{code}-applyToPop :: PatchInfo -> FL Prim C(x y) -> Population -> Population-applyToPop _ NilFL = id-applyToPop pinf (p:>:ps) = applyToPop pinf ps . applyToPop' pinf p--applyToPop'- :: PatchInfo -> Prim C(x y) -> Population -> Population-applyToPop' pi patch (Pop _ tree)- = Pop pi (applyToPopTree patch tree)- -- ``pi'' is global below!- where applyToPopTree :: Prim C(x y) -> PopTree -> PopTree- applyToPopTree (Split ps) tr =- foldlFL (\t p -> applyToPopTree p t) tr ps- applyToPopTree p@(FP f AddFile) tr =- let xxx = BC.split '/' (fn2ps f) in- popChange xxx p $ fst $ breakP xxx tr- applyToPopTree p@(FP f _) tr = popChange (BC.split '/' (fn2ps f)) p tr- applyToPopTree p@(DP f AddDir) tr =- let xxx = BC.split '/' (fn2ps f) in- popChange xxx p $ fst $ breakP xxx tr- applyToPopTree p@(DP d _) tr = popChange (BC.split '/' (fn2ps d)) p tr- -- precondition: ``to'' does not exist yet!- applyToPopTree (Move from to) tr- = case breakP (BC.split '/' (fn2ps from)) $- fst $ breakP (BC.split '/' $ fn2ps to) tr of- (tr',Just ins) ->- let to' = (BC.split '/' (fn2ps to))- ins' = case ins of- PopDir i trs -> PopDir (i {nameI = last to',- modifiedByI = pi,- modifiedHowI = MovedDir (fn2fp from)})- trs- PopFile i -> PopFile (i {nameI = last to',- modifiedByI = pi,- modifiedHowI = MovedFile (fn2fp from)})- in insertP to' tr' ins'- _ -> tr -- ignore the move if ``from'' couldn't be found- applyToPopTree (ChangePref _ _ _) tr = tr- applyToPopTree Identity tr = tr-- -- insert snd arg into fst arg- insertP :: [B.ByteString] -> PopTree -> PopTree -> PopTree- insertP [parent,_] org@(PopDir f trs) tr- | parent == (nameI f) = PopDir f (tr:trs)- | otherwise = org- insertP (n:rest) org@(PopDir f trs) tr- | (nameI f) == n = PopDir f trs'- | otherwise = org- where trs' = map (\o -> insertP rest o tr) trs- insertP _ org _ = org-- -- change a population according to a patch- popChange :: [B.ByteString] -> Prim C(x y) -> PopTree -> PopTree- popChange [parent,path] (DP d AddDir) tr@(PopDir f trs)- | parent == (nameI f) = PopDir f (new:trs)- | otherwise = tr- where new = PopDir (Info {nameI = path,- modifiedByI = pi,- modifiedHowI = AddedDir,- createdByI = Just pi,- creationNameI = Just $ fn2ps d}) []- -- only mark a directory (and contents) as ``deleted'' do not delete it actually- popChange [path] (DP _ RmDir) tr@(PopDir f trs)- | path == (nameI f) = PopDir (f {modifiedByI = pi,- modifiedHowI = RemovedDir}) trs'- | otherwise = tr- where trs' = map markDel trs -- recursively ``delete'' the contents-- popChange [parent,path] (FP d AddFile) tr@(PopDir f trs)- | parent == (nameI f) = PopDir f (new:trs)- | otherwise = tr- where new = PopFile (Info {nameI = path,- modifiedByI = pi,- modifiedHowI = AddedFile,- createdByI = Just pi,- creationNameI = Just $ fn2ps d})- popChange [path] (FP _ RmFile) tr@(PopFile f)- | path == (nameI f) = PopFile (f {modifiedByI = pi,- modifiedHowI = RemovedFile})- | otherwise = tr- popChange [path] (FP _ _) (PopFile f)- | path == (nameI f)- = PopFile (f {modifiedByI = pi,- modifiedHowI = if modifiedHowI f == AddedFile && modifiedByI f == pi- then AddedFile- else ModifiedFile})- popChange (n:rest) p tr@(PopDir f trs)- | (nameI f) == n = PopDir f (map (popChange rest p) trs)- | otherwise = tr- popChange _ _ tr = tr- markDel (PopDir f trs) = PopDir (f {modifiedByI = pi,- modifiedHowI = RemovedDir}) trs'- where trs' = map markDel trs- markDel (PopFile f) = PopFile (f {modifiedByI = pi,- modifiedHowI = RemovedFile})---- break a poptree fst: org tree with subtree removed,--- snd: removed subtree-breakP :: [B.ByteString] -> PopTree -> (PopTree,Maybe PopTree)-breakP [parent,path] tr@(PopDir f trees)- | parent == (nameI f) = case findRem path trees of- Just (trees',tree') -> (PopDir f trees',Just tree')- _ -> (tr,Nothing)- | otherwise = (tr,Nothing)- where findRem _ [] = Nothing- findRem the_path (d:trs)- | the_path == pname d = Just (trs,d)- | otherwise = do (trs',d') <- findRem the_path trs- return (d:trs',d')-breakP (n:rest) tr@(PopDir f trs)- | (nameI f) == n = case catMaybes inss of- [ins] -> (PopDir f trs', Just ins)- [] -> (tr,Nothing)- _ -> error "breakP: more than one break"- | otherwise = (tr,Nothing)- where (trs',inss) = unzip (map (breakP rest) trs)-breakP _ tr = (tr,Nothing)--pname :: PopTree -> B.ByteString-pname (PopDir i _) = nameI i-pname (PopFile i) = nameI i---- | Apply a patch to a 'Tree', yielding a new 'Tree'.-applyToTree :: (Apply p) => p C(x y) -> Tree IO -> IO (Tree IO)-applyToTree patch t = snd `fmap` virtualTreeIO (apply [] patch) t--\end{code}-
+ src/Darcs/Patch/ApplyMonad.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE TypeSynonymInstances #-}+-- Copyright (C) 2010, 2011 Petr Rockai+--+-- Permission is hereby granted, free of charge, to any person+-- obtaining a copy of this software and associated documentation+-- files (the "Software"), to deal in the Software without+-- restriction, including without limitation the rights to use, copy,+-- modify, merge, publish, distribute, sublicense, and/or sell copies+-- of the Software, and to permit persons to whom the Software is+-- furnished to do so, subject to the following conditions:+--+-- The above copyright notice and this permission notice shall be+-- included in all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+-- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+-- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+-- BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+-- ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+-- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+-- SOFTWARE.+module Darcs.Patch.ApplyMonad( ApplyMonad(..), withFilePaths, withFiles ) where++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.Map as M+import qualified Storage.Hashed.Monad as HSM+import ByteStringUtils( linesPS, unlinesPS )+import Darcs.Patch.FileName( FileName, movedirfilename, fn2fp )+import Storage.Hashed.AnchoredPath( floatPath, AnchoredPath )+import Control.Monad.State.Strict+import Darcs.MonadProgress++fn2ap :: FileName -> AnchoredPath+fn2ap = floatPath . fn2fp++class (Functor m, Monad m) => ApplyMonad m where+ mDoesDirectoryExist :: FileName -> m Bool+ mReadFilePS :: FileName -> m B.ByteString+ mReadFilePSs :: FileName -> m [B.ByteString]+ mReadFilePSs f = linesPS `fmap` mReadFilePS f+ mCreateDirectory :: FileName -> m ()+ mRemoveDirectory :: FileName -> m ()+ mCreateFile :: FileName -> m ()+ mCreateFile f = mModifyFilePS f $ \_ -> return B.empty+ mRemoveFile :: FileName -> m ()+ mRename :: FileName -> FileName -> m ()+ mModifyFilePS :: FileName -> (B.ByteString -> m B.ByteString) -> m ()+ mModifyFilePSs :: FileName -> ([B.ByteString] -> m [B.ByteString]) -> m ()+ mModifyFilePSs f j = mModifyFilePS f (fmap unlinesPS . j . linesPS)+ mChangePref :: String -> String -> String -> m ()+ mChangePref _ _ _ = return ()++instance (Functor m, Monad m) => ApplyMonad (HSM.TreeMonad m) where+ mDoesDirectoryExist d = HSM.directoryExists (fn2ap d)+ mReadFilePS p = B.concat `fmap` BL.toChunks `fmap` HSM.readFile (fn2ap p)+ mModifyFilePS p j = do have <- HSM.fileExists (fn2ap p)+ x <- if have then B.concat `fmap` BL.toChunks `fmap` HSM.readFile (fn2ap p)+ else return B.empty+ HSM.writeFile (fn2ap p) . BL.fromChunks . (:[]) =<< j x+ mCreateDirectory p = HSM.createDirectory (fn2ap p)+ mRename from to = HSM.rename (fn2ap from) (fn2ap to)+ mRemoveDirectory = HSM.unlink . fn2ap+ mRemoveFile = HSM.unlink . fn2ap++type FilePathMonad = State [FileName]++withFilePaths :: [FileName] -> FilePathMonad a -> [FileName]+withFilePaths fps x = execState x fps++instance ApplyMonad FilePathMonad where+ -- We can't check it actually is a directory here+ mDoesDirectoryExist d = gets (d `elem`)+ mCreateDirectory _ = return ()+ mRemoveFile f = modify $ filter (/= f)+ mRemoveDirectory f = modify $ filter (/= f)+ mRename a b = modify $ map (movedirfilename a b)+ mModifyFilePS _ _ = return ()++instance MonadProgress FilePathMonad where+ runProgressActions = silentlyRunProgressActions++type RestrictedApply = State (M.Map FileName B.ByteString)++instance ApplyMonad RestrictedApply where+ mDoesDirectoryExist _ = return True+ mCreateDirectory _ = return ()+ mRemoveFile f = modify $ M.delete f+ mRemoveDirectory _ = return ()+ mRename a b = modify $ M.mapKeys (movedirfilename a b)+ mModifyFilePS f j = do look <- gets $ M.lookup f+ case look of+ Nothing -> return ()+ Just bits -> do+ new <- j bits+ modify $ M.insert f new++instance MonadProgress RestrictedApply where+ runProgressActions = silentlyRunProgressActions++withFiles :: [(FileName, B.ByteString)] -> RestrictedApply a -> [(FileName, B.ByteString)]+withFiles p x = M.toList $ execState x $ M.fromList p
+ src/Darcs/Patch/Bracketed.hs view
@@ -0,0 +1,40 @@+module Darcs.Patch.Bracketed+ ( Bracketed(..), mapBracketed, unBracketed+ , BracketedFL, mapBracketedFL_FL, unBracketedFL+ ) where++#include "gadts.h"++import Darcs.Patch.Format ( PatchListFormat )+import Darcs.Witnesses.Ordered ( FL(..), mapFL_FL, concatFL )++-- |This type exists for legacy support of on-disk format patch formats.+-- It is a wrapper type that explicitly tracks the nesting of braces and parens+-- in the on-disk representation of such patches. It is used as an intermediate+-- form when reading such patches normally, and also for round-tripping such+-- patches when checking the hash in bundles.+-- It shouldn't be used for anything else.+data Bracketed p C(x y) where+ Singleton :: p C(x y) -> Bracketed p C(x y) -- A single patch, not wrapped in anything+ Braced :: BracketedFL p C(x y) -> Bracketed p C(x y) -- A list of patches, wrapped in {}+ Parens :: BracketedFL p C(x y) -> Bracketed p C(x y) -- A list of patches, wrapped in ()++type BracketedFL p C(x y) = FL (Bracketed p) C(x y)++unBracketed :: Bracketed p C(x y) -> FL p C(x y)+unBracketed (Singleton p) = p :>: NilFL+unBracketed (Braced ps) = unBracketedFL ps+unBracketed (Parens ps) = unBracketedFL ps++unBracketedFL :: BracketedFL p C(x y) -> FL p C(x y)+unBracketedFL = concatFL . mapFL_FL unBracketed++mapBracketed :: (FORALL(a b) p C(a b) -> q C(a b)) -> Bracketed p C(x y) -> Bracketed q C(x y)+mapBracketed f (Singleton p) = Singleton (f p)+mapBracketed f (Braced ps) = Braced (mapBracketedFL_FL f ps)+mapBracketed f (Parens ps) = Parens (mapBracketedFL_FL f ps)++mapBracketedFL_FL :: (FORALL(a b) p C(a b) -> q C(a b)) -> BracketedFL p C(x y) -> BracketedFL q C(x y)+mapBracketedFL_FL f ps = mapFL_FL (mapBracketed f) ps++instance PatchListFormat (Bracketed p)
+ src/Darcs/Patch/Bracketed/Instances.hs view
@@ -0,0 +1,21 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Darcs.Patch.Bracketed.Instances () where++import Darcs.Patch.Bracketed ( Bracketed(..) )+import Darcs.Patch.Show ( ShowPatchBasic(..) )++import Darcs.Witnesses.Ordered ( FL(NilFL), mapFL )++import Printer ( vcat, blueText, ($$) )++#include "gadts.h"++instance ShowPatchBasic p => ShowPatchBasic (Bracketed p) where+ showPatch (Singleton p) = showPatch p+ showPatch (Braced NilFL) = blueText "{" $$ blueText "}"+ showPatch (Braced ps) = blueText "{" $$ vcat (mapFL showPatch ps) $$ blueText "}"+ showPatch (Parens ps) = blueText "(" $$ vcat (mapFL showPatch ps) $$ blueText ")"++-- the ReadPatch instance is defined in Darcs.Patch.Read as it is+-- used as an intermediate form during reading of lists of patches+-- that are specified as ListFormatV1 or ListFormatV2.
src/Darcs/Patch/Bundle.hs view
@@ -15,29 +15,34 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} #include "gadts.h" -module Darcs.Patch.Bundle ( hashBundle, makeBundle, makeBundle2, makeBundleN, scanBundle,- contextPatches, scanContext, patchFilename+module Darcs.Patch.Bundle ( hashBundle, makeBundle2, makeBundleN, scanBundle,+ contextPatches, scanContext, patchFilename, getContext,+ parseBundle ) where import Data.Char ( isAlpha, toLower, isDigit, isSpace )-import Darcs.Hopefully ( PatchInfoAnd, piap,+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, piap, fmapFL_PIAP, patchInfoAndPatch, unavailable, hopefully )-import Darcs.Patch ( RepoPatch, Named, showPatch, showContextPatch, readPatch )+import Darcs.Patch ( RepoPatch, Named, showPatch, showContextPatch, readPatchPartial )+import Darcs.Patch.Bracketed ( Bracketed, unBracketedFL )+import Darcs.Patch.Bracketed.Instances ()+import Darcs.Patch.Format ( PatchListFormat ) import Darcs.Patch.Info ( PatchInfo, readPatchInfo, showPatchInfo, humanFriendly, isTag ) import Darcs.Patch.Set ( PatchSet(..), Tagged(..), SealedPatchSet )+import Darcs.Patch.Show ( ShowPatchBasic ) import Darcs.Patch.Depends ( slightlyOptimizePatchset )-import Darcs.Hopefully( info )+import Darcs.Patch.ReadMonads ( parseStrictly )+import Darcs.Patch.PatchInfoAnd( info ) #ifdef GADT_WITNESSES import Darcs.Patch.Set ( Origin ) #endif-import Darcs.Witnesses.Sealed ( flipSeal, FlippedSeal(..) )-import Darcs.Witnesses.Ordered ( RL(..), FL(..), unsafeCoerceP,+import Darcs.Witnesses.Unsafe ( unsafeCoerceP )+import Darcs.Witnesses.Ordered ( RL(..), FL(..), (:>)(..), reverseFL, (+<+), mapFL, mapFL_FL, mapRL ) import Printer ( Doc, renderPS, newline, text, ($$), (<>), vcat, vsep, renderString )@@ -47,13 +52,16 @@ import qualified Data.ByteString.Char8 as BC (unpack, break, pack) import SHA1( sha1PS )-import Darcs.Witnesses.Sealed ( Sealed(Sealed), mapSeal )+import Darcs.Witnesses.Sealed ( Sealed(Sealed)) import Storage.Hashed.Tree( Tree ) import Storage.Hashed.Monad( virtualTreeIO ) -hashBundle :: RepoPatch p => [PatchInfo] -> FL (Named p) C(x y) -> String-hashBundle _ to_be_sent = sha1PS $ renderPS+-- |hashBundle creates a SHA1 string of a given a FL of named patches. This+-- allows us to ensure that the patches in a received patchBundle have not been+-- modified in transit.+hashBundle :: (PatchListFormat p, ShowPatchBasic p) => FL (Named p) C(x y) -> String+hashBundle to_be_sent = sha1PS $ renderPS $ vcat (mapFL showPatch to_be_sent) <> newline makeBundleN :: RepoPatch p => Maybe (Tree IO)@@ -63,10 +71,6 @@ makeBundleN the_s (PatchSet ps NilRL) to_be_sent = makeBundle2 the_s ps to_be_sent to_be_sent -makeBundle :: RepoPatch p => Maybe (Tree IO) -> RL (PatchInfoAnd p) C(start x)- -> FL (Named p) C(x y) -> IO Doc-makeBundle the_s common to_be_sent = makeBundle2 the_s common to_be_sent to_be_sent- -- | In makeBundle2, it is presumed that the two patch sequences are -- identical, but that they may be lazily generated. If two different -- patch sequences are passed, a bundle with a mismatched hash will be@@ -88,18 +92,19 @@ $$ text "" $$ (vcat $ map showPatchInfo common) $$ text "Patch bundle hash:"- $$ text (hashBundle common to_be_sent2)+ $$ text (hashBundle to_be_sent2) $$ text "" common = mapRL info common' -scanBundle :: RepoPatch p => B.ByteString -> Either String (SealedPatchSet p C(Origin))-scanBundle ps+parseBundle ::forall p. RepoPatch p => B.ByteString+ -> Either String (Sealed ((PatchSet p :> FL (PatchInfoAnd p)) C(Origin)))+parseBundle ps | B.null ps = Left "Bad patch bundle!" | otherwise = case sillyLex ps of ("New patches:",rest) -> case getPatches rest of- (Sealed patches, rest') ->+ (Sealed bracketedPatches, rest') -> case sillyLex rest' of ("Context:", rest'') -> case getContext rest'' of@@ -107,16 +112,16 @@ case substrPS (BC.pack "Patch bundle hash:") maybe_hash of Just n ->- if hashBundle cont (mapFL_FL hopefully patches)+ if hashBundle (mapFL_FL hopefully bracketedPatches) == fst (sillyLex $ snd $ sillyLex $ B.drop n maybe_hash)- then seal_up_patches patches cont+ then Right $ sealContextWithPatches cont bracketedPatches else Left $ "Patch bundle failed hash!\n" ++ "This probably means that the patch has been "++ "corrupted by a mailer.\n"++ "The most likely culprit is CRLF newlines."- Nothing -> seal_up_patches patches cont+ Nothing -> Right $ sealContextWithPatches cont bracketedPatches (a,r) -> Left $ "Malformed patch bundle: '"++a++"' is not 'Context:'" ++ "\n" ++ BC.unpack r ("Context:",rest) ->@@ -124,29 +129,38 @@ (cont, rest') -> case sillyLex rest' of ("New patches:", rest'') ->- case parsePatches rest'' of- Sealed ps'' -> seal_up_patches ps'' cont+ case getPatches rest'' of+ (Sealed bracketedPatches, _) -> Right $ sealContextWithPatches cont bracketedPatches (a,_) -> Left $ "Malformed patch bundle: '" ++ a ++ "' is not 'New patches:'" ("-----BEGIN PGP SIGNED MESSAGE-----",rest) ->- scanBundle $ filterGpgDashes rest- (_,rest) -> scanBundle rest- where seal_up_patches :: RepoPatch p => FL (PatchInfoAnd p) C(x y) -> [PatchInfo]- -> Either String (SealedPatchSet p C(Origin))- seal_up_patches xxx yyy =- case reverse yyy of+ parseBundle $ filterGpgDashes rest+ (_,rest) -> parseBundle rest+ where sealContextWithPatches :: RepoPatch p => [PatchInfo] -> FL (PatchInfoAnd (Bracketed p)) C(x y) -> Sealed ((PatchSet p :> FL (PatchInfoAnd p)) C(Origin))+ sealContextWithPatches context bracketedPatches =+ let patches = mapFL_FL (fmapFL_PIAP unBracketedFL) bracketedPatches in+ case reverse context of (x:ry) | isTag x ->- Right $ Sealed (PatchSet- (reverseFL xxx +<+ unavailablePatches (reverse ry))- (Tagged (piUnavailable x) Nothing NilRL :<: NilRL))- _ -> Right $ Sealed (PatchSet (reverseFL xxx +<+ unavailablePatches yyy)- NilRL)+ Sealed $ (PatchSet+ (unavailablePatches (reverse ry))+ (Tagged (piUnavailable x) Nothing NilRL :<: NilRL)+ :> patches)+ _ -> Sealed ((PatchSet (unavailablePatches context)+ NilRL) :> patches) -- The above NilRLs aren't quite right, because ther *are* -- earlier patches, but we can't set this to undefined -- because there are situations where we look at the rest. -- :{ --- filterGpgDashes is needed because clearsigned patches escape dashes:++scanBundle ::forall p . RepoPatch p => B.ByteString+ -> Either String (SealedPatchSet p C(Origin))+scanBundle bundle = do+ Sealed ((PatchSet recent tagged):>ps) <- parseBundle bundle+ return . Sealed $ PatchSet (reverseFL ps +<+ recent) tagged++-- |filterGpgDashes unescapes a clearsigned patch, which will have had any+-- lines starting with dashes escaped with a leading "- ". filterGpgDashes :: B.ByteString -> B.ByteString filterGpgDashes ps = unlinesPS $ map drop_dashes $@@ -159,56 +173,60 @@ not_context_or_newpatches s = (s /= BC.pack "Context:") && (s /= BC.pack "New patches:") +-- |unavailablePatches converts a list of PatchInfos into a RL of PatchInfoAnd+-- Unavailable patches. This is used to represent the Context of a patchBundle. unavailablePatches :: RepoPatch p => [PatchInfo] -> RL (PatchInfoAnd p) C(x y) unavailablePatches [] = unsafeCoerceP NilRL unavailablePatches (x:xs) = piUnavailable x :<: unavailablePatches xs +-- |piUnavailable returns an Unavailable within a PatchInfoAnd given a+-- PatchInfo. piUnavailable :: RepoPatch p => PatchInfo -> PatchInfoAnd p C(x y) piUnavailable i = (i `patchInfoAndPatch` unavailable ("Patch not stored in patch bundle:\n" ++ renderString (humanFriendly i)))++-- |getContext parses a context list, returning a tuple containing the list,+-- and remaining ByteString input. getContext :: B.ByteString -> ([PatchInfo],B.ByteString) getContext ps =- case readPatchInfo ps of+ case parseStrictly readPatchInfo ps of Just (pinfo,r') -> case getContext r' of (pis,r'') -> (pinfo:pis, r'') Nothing -> ([],ps)++-- |(-:-) is used to build up a Sealed FL of patches and tuple it, along with+-- any unconsumed input. (-:-) :: a C(x y) -> (Sealed (FL a C(y)),b) -> (Sealed (FL a C(x)),b) p -:- (Sealed ps, r) = (Sealed (p:>:ps), r)-getPatches :: RepoPatch p => B.ByteString -> (Sealed (FL (PatchInfoAnd p) C(x)), B.ByteString)++-- |getPatches attempts to parse a sequence of patches from a ByteString,+-- returning the FL of as many patches-with-info as were successfully parsed,+-- along with any unconsumed input.+getPatches :: RepoPatch p => B.ByteString -> (Sealed (FL (PatchInfoAnd (Bracketed p)) C(x)), B.ByteString) getPatches ps =- case readPatchInfo ps of+ case parseStrictly readPatchInfo ps of Nothing -> (Sealed NilFL, ps) Just (pinfo,_) ->- case readPatch ps of+ case readPatchPartial ps of Nothing -> (Sealed NilFL, ps) Just (Sealed p, r) -> (pinfo `piap` p) -:- getPatches r-parsePatches :: RepoPatch p => B.ByteString -> Sealed (FL (PatchInfoAnd p) C(x))-parsePatches ps =- case readPatchInfo ps of- Nothing -> Sealed NilFL- Just (pinfo,_) ->- case readPatch ps of- Nothing -> Sealed NilFL- Just (Sealed p, r) -> ((pinfo `piap` p) :>:) `mapSeal` parsePatches r +-- |sillyLex takes a ByteString and breaks it upon the first newline, having+-- removed any leading spaces. The before-newline part is unpacked to a String,+-- and tupled up with the remaining ByteString. sillyLex :: B.ByteString -> (String, B.ByteString) sillyLex ps = (BC.unpack a, b) where (a, b) = BC.break (== '\n') (dropSpace ps) -{--sillyLex ps = (BC.unpack $ BC.takeWhile (/='\n') ps', BC.dropWhile (/='\n') ps')- where- ps' = dropSpace ps--}---contextPatches :: RepoPatch p => PatchSet p C(Origin x) -> FlippedSeal (RL (PatchInfoAnd p)) C(x)+contextPatches :: RepoPatch p => PatchSet p C(Origin x) ->+ (PatchSet p :> (RL (PatchInfoAnd p))) C(Origin x) contextPatches set = case slightlyOptimizePatchset set of- PatchSet ps (Tagged t _ _ :<: _) -> flipSeal (ps +<+ (t :<: NilRL))- PatchSet ps NilRL -> flipSeal ps+ PatchSet ps (Tagged t _ ps' :<: ts)+ -> (PatchSet ps' ts) :> (ps +<+ (t :<: NilRL))+ PatchSet ps NilRL -> (PatchSet NilRL NilRL :> ps) -- are the type witnesses sensible? scanContext :: RepoPatch p => B.ByteString -> PatchSet p C(Origin x)@@ -226,7 +244,8 @@ scanContext $ filterGpgDashes rest (_,rest) -> scanContext rest -+-- |patchFilename maps a patch description string to a safe (lowercased, spaces+-- removed and ascii-only characters) patch filename. patchFilename :: String -> String patchFilename the_summary = name ++ ".dpatch" where name = map safeFileChar the_summary
src/Darcs/Patch/Choices.hs view
@@ -15,9 +15,7 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP #-}--- , TypeOperators, GeneralizedNewtypeDeriving, ScopedTypeVariables #-} #include "gadts.h" @@ -62,15 +60,23 @@ substitute ) where -import Control.Monad.State( State(..) )+import Control.Monad.Identity ( Identity )+import Control.Monad.State ( StateT(..), State ) +import Prelude hiding ( pred )+ import Darcs.Patch+ ( Patchy, commuteRL, commute, merge, listTouchedFiles, hunkMatches+ , invert )+import Darcs.Patch.Merge ( Merge ) import Darcs.Patch.Permutations ( commuteWhatWeCanRL, commuteWhatWeCanFL )-import Darcs.Patch.Patchy ( Invert, Commute )-import Darcs.Witnesses.Ordered ( FL(..), RL(..), MyEq, unsafeCompare, EqCheck(..),+import Darcs.Patch.Patchy ( Invert, Commute, PatchInspect )+import Darcs.Witnesses.Eq ( MyEq(..), EqCheck(..) )+import Darcs.Witnesses.Unsafe ( unsafeCoerceP )+import Darcs.Witnesses.Ordered ( FL(..), RL(..), (:>)(..), (:\/:)(..), (:/\:)(..), (:||:)(..), zipWithFL, mapFL_FL, concatFL,- (+>+), reverseRL, unsafeCoerceP, anyFL )+ (+>+), reverseRL, anyFL ) import Darcs.Witnesses.Sealed ( Sealed2(..) ) @@ -95,11 +101,11 @@ -- | The @Bool@ parameter indicates whether the patch has been explicitely -- selected (or rejected) by the user. data PatchChoice p C(x y) = PC { pcPatch :: (TaggedPatch p C(x y))- , choice :: Bool}+ , _pcChoice :: Bool} data PatchChoices p C(x y) where- PCs { firsts :: FL (TaggedPatch p) C(x m)- , lasts :: FL (PatchChoice p) C(m y)} :: PatchChoices p C(x y)+ PCs { pcsFirsts :: FL (TaggedPatch p) C(x m)+ , pcsLasts :: FL (PatchChoice p) C(m y)} :: PatchChoices p C(x y) -- | See module documentation for 'Darcs.Patch.Choices' data Slot = InFirst | InMiddle | InLast@@ -124,21 +130,28 @@ instance Invert p => Invert (TaggedPatch p) where invert = liftTP invert- identity = TP (TG Nothing (-1)) identity instance Commute p => Commute (TaggedPatch p) where commute (TP t1 p1 :> TP t2 p2) = do p2' :> p1' <- commute (p1 :> p2) return (TP t2 p2' :> TP t1 p1')++instance PatchInspect p => PatchInspect (TaggedPatch p) where listTouchedFiles (TP _ p) = listTouchedFiles p hunkMatches f (TP _ p) = hunkMatches f p++instance Merge p => Merge (TaggedPatch p) where merge (TP t1 p1 :\/: TP t2 p2) = case merge (p1 :\/: p2) of p2' :/\: p1' -> TP t2 p2' :/\: TP t1 p1' instance Commute p => Commute (PatchChoice p) where commute (PC p1 c1 :> PC p2 c2) = do p2' :> p1' <- commute (p1 :> p2) return (PC p2' c2 :> PC p1' c1)++instance PatchInspect p => PatchInspect (PatchChoice p) where listTouchedFiles (PC p _) = listTouchedFiles p hunkMatches f (PC p _) = hunkMatches f p++instance Merge p => Merge (PatchChoice p) where merge (PC tp1 c1 :\/: PC tp2 c2) = case merge (tp1 :\/: tp2) of tp2' :/\: tp1' -> PC tp2' c2 :/\: PC tp1' c1 @@ -214,33 +227,33 @@ else psLast f NilRL NilRL l where foundIn = anyFL ((== t) . tag)- psLast :: FORALL(m b l)+ psLast :: FORALL(m c l) FL (TaggedPatch p) C(x m) ->- RL (TaggedPatch p) C(m b) ->- RL (TaggedPatch p) C(b l) ->+ RL (TaggedPatch p) C(m c) ->+ RL (TaggedPatch p) C(c l) -> FL (PatchChoice p) C(l y) -> (Slot, PatchChoices p C(x y)) psLast firsts middles bubble (PC tp True :>: ls) | tag tp == t = (InLast- , PCs { firsts = firsts- , lasts = settleM middles- +>+ settleB bubble- +>+ PC tp True :>: ls})+ , PCs { pcsFirsts = firsts+ , pcsLasts = settleM middles+ +>+ settleB bubble+ +>+ PC tp True :>: ls}) psLast firsts middles bubble (PC tp False :>: ls) | tag tp == t = case commuteRL (bubble :> tp) of Just (tp' :> bubble') -> (InMiddle,- PCs { firsts = firsts- , lasts = settleM middles- +>+ PC tp' False- :>: settleB bubble'- +>+ ls})+ PCs { pcsFirsts = firsts+ , pcsLasts = settleM middles+ +>+ PC tp' False+ :>: settleB bubble'+ +>+ ls}) Nothing -> (InLast,- PCs { firsts = firsts- , lasts = settleM middles- +>+ settleB bubble- +>+ PC tp True- :>: ls})+ PCs { pcsFirsts = firsts+ , pcsLasts = settleM middles+ +>+ settleB bubble+ +>+ PC tp True+ :>: ls}) psLast firsts middles bubble (PC tp True :>: ls) = psLast firsts middles (tp :<: bubble) ls psLast firsts middles bubble (PC tp False :>: ls) =@@ -252,15 +265,15 @@ settleB bubble = mapFL_FL (\tp -> PC tp True) $ reverseRL bubble patchSlot' :: Patchy p =>- TaggedPatch p C(a b) -> State (PatchChoices p C(x y)) Slot-patchSlot' = State . patchSlot+ TaggedPatch p C(a b) -> StateT (PatchChoices p C(x y)) Identity Slot+patchSlot' tp = StateT (return . patchSlot tp) forceMatchingFirst :: forall p C(a b). Patchy p => ( FORALL(x y) TaggedPatch p C(x y) -> Bool) -> PatchChoices p C(a b) -> PatchChoices p C(a b)-forceMatchingFirst pred (PCs f l) =- fmfLasts f NilRL l+forceMatchingFirst pred (PCs fn l) =+ fmfLasts fn NilRL l where fmfLasts :: FL (TaggedPatch p) C(a m) -> RL (PatchChoice p) C(m n)@@ -274,8 +287,8 @@ f' = f +>+ mapFL_FL pcPatch (reverseRL deps) +>+ (pcPatch a' :>: NilFL) in fmfLasts f' l1' l2 fmfLasts f l1 (a :>: l2) = fmfLasts f (a :<: l1) l2- fmfLasts f l1 NilFL = PCs { firsts = f- , lasts = reverseRL l1 }+ fmfLasts f l1 NilFL = PCs { pcsFirsts = f+ , pcsLasts = reverseRL l1 } pred_pc :: FORALL(x y) PatchChoice p C(x y) -> Bool pred_pc (PC tp _) = pred tp @@ -328,8 +341,8 @@ in fmlFirst pred b f1 f2' l' fmlFirst pred b f1 (a :>: f2) l = fmlFirst pred b (a :<: f1) f2 l-fmlFirst pred b f1 NilFL l = PCs { firsts = reverseRL f1- , lasts = mapFL_FL ch l}+fmlFirst pred b f1 NilFL l = PCs { pcsFirsts = reverseRL f1+ , pcsLasts = mapFL_FL ch l} where ch (PC tp c) = (PC tp (if pred tp then b else c) ) forceLasts :: Patchy p => [Tag]@@ -354,8 +367,8 @@ Patchy p => PatchChoices p C(x y) -> PatchChoices p C(x y) makeEverythingSooner (PCs f l) = case mes NilRL NilRL l- of (m :> l) ->- PCs (f +>+ m) l+ of (m :> l') ->+ PCs (f +>+ m) l' where mes :: FORALL(m1 m2 m3) RL (TaggedPatch p) C(m1 m2) ->
+ src/Darcs/Patch/Commute.hs view
@@ -0,0 +1,74 @@+module Darcs.Patch.Commute+ ( Commute(..),+ commuteFL, commuteFLorComplain,+ commuteRL, commuteRLFL,+ toFwdCommute, toRevCommute+ )+ where++import Darcs.Witnesses.Ordered (FL(..), RL(..), + reverseFL, reverseRL,+ (:>)(..), (:<)(..)+ )+import Darcs.Witnesses.Sealed ( Sealed2, seal2 )++#include "gadts.h"++-- | Things that can commute.+class Commute p where+ commute :: (p :> p) C(x y) -> Maybe ((p :> p) C(x y))++-- | Swaps the ordered pair type so that commute can be+-- called directly.+toFwdCommute :: (Commute p, Commute q, Monad m)+ => ((p :< q) C(x y) -> m ((q :< p) C(x y)))+ -> (q :> p) C(x y) -> m ((p :> q) C(x y))+toFwdCommute c (x :> y) = do x' :< y' <- c (y :< x)+ return (y' :> x')++-- | Swaps the ordered pair type from the order expected+-- by commute to the reverse order.+toRevCommute :: (Commute p, Commute q, Monad m)+ => ((p :> q) C(x y) -> m ((q :> p) C(x y)))+ -> (q :< p) C(x y) -> m ((p :< q) C(x y))+toRevCommute c (x :< y) = do x' :> y' <- c (y :> x)+ return (y' :< x')++++instance Commute p => Commute (FL p) where+ commute (NilFL :> x) = Just (x :> NilFL)+ commute (x :> NilFL) = Just (NilFL :> x)+ commute (xs :> ys) = do ys' :> rxs' <- commuteRLFL (reverseFL xs :> ys)+ return $ ys' :> reverseRL rxs'+++commuteRLFL :: Commute p => (RL p :> FL p) C(x y) -> Maybe ((FL p :> RL p) C(x y))+commuteRLFL (NilRL :> ys) = Just (ys :> NilRL)+commuteRLFL (xs :> NilFL) = Just (NilFL :> xs)+commuteRLFL (xs :> y :>: ys) = do y' :> xs' <- commuteRL (xs :> y)+ ys' :> xs'' <- commuteRLFL (xs' :> ys)+ return (y' :>: ys' :> xs'')++commuteRL :: Commute p => (RL p :> p) C(x y) -> Maybe ((p :> RL p) C(x y))+commuteRL (z :<: zs :> w) = do w' :> z' <- commute (z :> w)+ w'' :> zs' <- commuteRL (zs :> w')+ return (w'' :> z' :<: zs')+commuteRL (NilRL :> w) = Just (w :> NilRL)++commuteFLorComplain :: Commute p => (p :> FL p) C(x y) -> Either (Sealed2 p) ((FL p :> p) C(x y))+commuteFLorComplain (p :> NilFL) = Right (NilFL :> p)+commuteFLorComplain (q :> p :>: ps) = case commute (q :> p) of+ Just (p' :> q') ->+ case commuteFLorComplain (q' :> ps) of+ Right (ps' :> q'') -> Right (p' :>: ps' :> q'')+ Left l -> Left l+ Nothing -> Left $ seal2 p++commuteFL :: Commute p => (p :> FL p) C(x y) -> Maybe ((FL p :> p) C(x y))+commuteFL = either (const Nothing) Just . commuteFLorComplain++instance Commute p => Commute (RL p) where+ commute (xs :> ys) = do fys' :> xs' <- commuteRLFL (xs :> reverseRL ys)+ return (reverseFL fys' :> xs')+
− src/Darcs/Patch/Commute.lhs
@@ -1,870 +0,0 @@-% Copyright (C) 2002-2003 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.---\begin{code}-{-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans #-}-{-# LANGUAGE CPP #-}--- , TypeOperators #-}--#include "gadts.h"--module Darcs.Patch.Commute ( fromPrims,- modernizePatch,- merge, elegantMerge,- merger, unravel,- publicUnravel, mangleUnravelled,- CommuteFunction, Perhaps(..),- -- for other commutes:- toMaybe,- )- where--import Control.Monad ( MonadPlus, mplus, msum, mzero, guard )--import Darcs.Patch.FileName ( FileName, fn2fp, fp2fn )-import Darcs.Patch.Info ( invertName, idpatchinfo )-import Darcs.Patch.Patchy ( Commute(..), Invert(..), toFwdCommute, toRevCommute )-import Darcs.Patch.Core ( Patch(..), Named(..),- flattenFL,- isMerger,- mergerUndo,- joinPatchesFL )-import Darcs.Patch.Prim ( Prim(..), FromPrims(..),- Conflict(..), Effect(..),- is_filepatch, sortCoalesceFL,- FilePatchType(..), DirPatchType(..),- primIsHunk, modernizePrim )-import qualified Data.ByteString.Char8 as BC (pack, last)-import qualified Data.ByteString as B (null, ByteString)-import Data.Maybe ( isJust )-import Data.List ( intersperse, sort )-import Darcs.Patch.Permutations ( headPermutationsRL, simpleHeadPermutationsFL )-import Printer ( text, vcat, ($$) )-import Darcs.Patch.Patchy ( invertRL )-import Darcs.Patch.Show ( showPatch_ )-import Data.List ( nub, nubBy )-import Darcs.Witnesses.Sealed ( unsafeUnseal, unsafeUnsealFlipped )-import Darcs.Utils ( nubsort )-#include "impossible.h"-import Darcs.Witnesses.Sealed ( Sealed(..), mapSeal, unseal, FlippedSeal(..), mapFlipped, unsealFlipped )-import Darcs.Witnesses.Ordered ( mapFL, mapFL_FL, unsafeCoerceP,- unsafeCoercePStart, unsafeCoercePEnd,- FL(..), RL(..),- (:/\:)(..), (:<)(..), (:\/:)(..), (:>)(..),- lengthFL, mapRL,- reverseFL, reverseRL, concatFL,- MyEq, unsafeCompare, EqCheck(..), (=\/=)- )----import Darcs.ColorPrinter ( traceDoc )---import Printer ( greenText )-\end{code}--\section{Commuting patches}--\subsection{Composite patches}--Composite patches are made up of a series of patches intended to be applied-sequentially. They are represented by a list of patches, with the first-patch in the list being applied first.--\newcommand{\commutex}{\longleftrightarrow}-\newcommand{\commutes}{\longleftrightarrow}--The first way (of only two) to change the context of a patch is by-commutation, which is the process of changing the order of two sequential-patches.-\begin{dfn}-The commutation of patches $P_1$ and $P_2$ is represented by-\[ P_2 P_1 \commutes {P_1}' {P_2}'. \]-Here $P_1'$ is intended to describe the same change as $P_1$, with the-only difference being that $P_1'$ is applied after $P_2'$ rather than-before $P_2$.-\end{dfn}-The above definition is obviously rather vague, the reason being that what-is the ``same change'' has not been defined, and we simply assume (and-hope) that the code's view of what is the ``same change'' will match those-of its human users. The `$\commutes$' operator should be read as something-like the $==$ operator in C, indicating that the right hand side performs-identical changes to the left hand side, but the two patches are in-reversed order. When read in this manner, it is clear that commutation-must be a reversible process, and indeed this means that commutation-\emph{can} fail, and must fail in certain cases. For example, the creation-and deletion of the same file cannot be commuted. When two patches fail to-commutex, it is said that the second patch depends on the first, meaning-that it must have the first patch in its context (remembering that the-context of a patch is a set of patches, which is how we represent a tree).-\footnote{The fact that commutation can fail makes a huge difference in the-whole patch formalism. It may be possible to create a formalism in which-commutation always succeeds, with the result of what would otherwise be a-commutation that fails being something like a virtual particle (which can-violate conservation of energy), and it may be that such a formalism would-allow strict mathematical proofs (whereas those used in the current-formalism are mostly only hand waving ``physicist'' proofs). However, I'm-not sure how you'd deal with a request to delete a file that has not yet-been created, for example. Obviously you'd need to create some kind of-antifile, which would annihilate with the file when that file finally got-created, but I'm not entirely sure how I'd go about doing this.-$\ddot\frown$ So I'm sticking with my hand waving formalism.}--%I should add that one using the inversion relationship of sequential-%patches, one can avoid having to provide redundant definitions of-%commutation.--% There is another interesting property which is that a commutex's results-% can't be affected by commuting another thingamabopper.--\begin{code}-data Perhaps a = Unknown | Failed | Succeeded a--instance Monad Perhaps where- (Succeeded x) >>= k = k x- Failed >>= _ = Failed- Unknown >>= _ = Unknown- Failed >> _ = Failed- (Succeeded _) >> k = k- Unknown >> k = k- return = Succeeded- fail _ = Unknown--instance MonadPlus Perhaps where- mzero = Unknown- Unknown `mplus` ys = ys- Failed `mplus` _ = Failed- (Succeeded x) `mplus` _ = Succeeded x--toMaybe :: Perhaps a -> Maybe a-toMaybe (Succeeded x) = Just x-toMaybe _ = Nothing--toPerhaps :: Maybe a -> Perhaps a-toPerhaps (Just x) = Succeeded x-toPerhaps Nothing = Failed--cleverCommute :: CommuteFunction -> CommuteFunction-cleverCommute c (p1:<p2) =- case c (p1 :< p2) of- Succeeded x -> Succeeded x- Failed -> Failed- Unknown -> case c (invert p2 :< invert p1) of- Succeeded (p1' :< p2') -> Succeeded (invert p2' :< invert p1')- Failed -> Failed- Unknown -> Unknown--speedyCommute :: CommuteFunction-speedyCommute (p1 :< p2) -- Deal with common case quickly!- | p1_modifies /= Nothing && p2_modifies /= Nothing &&- p1_modifies /= p2_modifies = Succeeded (unsafeCoerceP p2 :< unsafeCoerceP p1)- | otherwise = Unknown- where p1_modifies = isFilepatchMerger p1- p2_modifies = isFilepatchMerger p2--instance Commute p => Commute (Named p) where- commute (NamedP n1 d1 p1 :> NamedP n2 d2 p2) =- if n2 `elem` d1 || n1 `elem` d2- then Nothing- else do (p2' :> p1') <- commute (p1 :> p2)- return (NamedP n2 d2 p2' :> NamedP n1 d1 p1')- merge (NamedP n1 d1 p1 :\/: NamedP n2 d2 p2)- = case merge (p1 :\/: p2) of- (p2' :/\: p1') -> NamedP n2 d2 p2' :/\: NamedP n1 d1 p1'- listTouchedFiles (NamedP _ _ p) = listTouchedFiles p- hunkMatches f (NamedP _ _ p) = hunkMatches f p--instance Conflict p => Conflict (Named p) where- listConflictedFiles (NamedP _ _ p) = listConflictedFiles p- resolveConflicts (NamedP _ _ p) = resolveConflicts p- isInconsistent (NamedP _ _ p) = isInconsistent p--everythingElseCommute :: MaybeCommute -> CommuteFunction-everythingElseCommute c x = eec x- where- eec :: CommuteFunction- eec (PP px :< PP py) = toPerhaps $ do x' :> y' <- commute (py :> px)- return (PP y' :< PP x')- eec (ComP NilFL :< p1) = Succeeded (unsafeCoerceP p1 :< (ComP NilFL))- eec (p2 :< ComP NilFL) = Succeeded (ComP NilFL :< unsafeCoerceP p2)- eec (ComP (p:>:ps) :< p1) = toPerhaps $ do- (p1' :< p') <- c (p :< p1)- (p1'' :< ComP ps') <- c (ComP ps :< p1')- return (p1'' :< ComP (p':>:ps'))- eec (patch2 :< ComP patches) =- toPerhaps $ do (patches' :< patch2') <- ccr (patch2 :< reverseFL patches)- return (ComP (reverseRL patches') :< patch2')- where ccr :: FORALL(x y) (Patch :< RL Patch) C(x y) -> Maybe ((RL Patch :< Patch) C(x y))- ccr (p2 :< NilRL) = seq p2 $ return (NilRL :< p2)- ccr (p2 :< p:<:ps) = do (p' :< p2') <- c (p2 :< p)- (ps' :< p2'') <- ccr (p2' :< ps)- return (p':<:ps' :< p2'')- eec _xx =- msum [- cleverCommute commuteRecursiveMerger _xx- ,cleverCommute otherCommuteRecursiveMerger _xx- ]--{--Note that it must be true that--commutex (A^-1 A, P) = Just (P, A'^-1 A')--and--if commutex (A, B) == Just (B', A')-then commutex (B^-1, A^-1) == Just (A'^-1, B'^-1)--}--unsafeMerger :: String -> Patch C(x y) -> Patch C(x z) -> Patch C(a b)-unsafeMerger x p1 p2 = unsafeCoercePStart $ unsafeUnseal $ merger x p1 p2--mergerCommute :: (Patch :< Patch) C(x y) -> Perhaps ((Patch :< Patch) C(x y))-mergerCommute (Merger _ _ p1 p2 :< pA)- | unsafeCompare pA p1 = Succeeded (unsafeMerger "0.0" p2 p1 :< unsafeCoercePStart p2)- | unsafeCompare pA (invert (unsafeMerger "0.0" p2 p1)) = Failed-mergerCommute (Merger _ _- (Merger _ _ c b)- (Merger _ _ c' a) :<- Merger _ _ b' c'')- | unsafeCompare b' b && unsafeCompare c c' && unsafeCompare c c'' =- Succeeded (unsafeMerger "0.0" (unsafeMerger "0.0" b (unsafeCoercePStart a)) (unsafeMerger "0.0" b c) :<- unsafeMerger "0.0" b (unsafeCoercePStart a))-mergerCommute _ = Unknown--instance Commute Patch where- merge (y :\/: z) =- case actualMerge (y:\/:z) of- Sealed y' -> case commute (z :> y') of- Nothing -> bugDoc $ text "merge_patches bug"- $$ showPatch_ y- $$ showPatch_ z- $$ showPatch_ y'- Just (_ :> z') -> -- actualMerge returns one arm of a- -- merge result, so commuting then gives- -- us the other arm but we have to assert- -- that the starting context is correct- unsafeCoercePStart z' :/\: y'- commute x = toMaybe $ msum- [toFwdCommute speedyCommute x,- toFwdCommute (cleverCommute mergerCommute) x,- toFwdCommute (everythingElseCommute (toRevCommute commute)) x- ]- -- Recurse on everything, these are potentially spoofed patches- listTouchedFiles (ComP ps) = nubsort $ concat $ mapFL listTouchedFiles ps- listTouchedFiles (Merger _ _ p1 p2) = nubsort $ listTouchedFiles p1- ++ listTouchedFiles p2- listTouchedFiles c@(Regrem _ _ _ _) = listTouchedFiles $ invert c- listTouchedFiles (PP p) = listTouchedFiles p-- hunkMatches f (ComP ps) = or $ mapFL (hunkMatches f) ps- hunkMatches f (Merger _ _ p1 p2) = hunkMatches f p1 || hunkMatches f p2- hunkMatches f c@(Regrem _ _ _ _) = hunkMatches f $ invert c- hunkMatches f (PP p) = hunkMatches f p--commuteNoMerger :: MaybeCommute-commuteNoMerger x =- toMaybe $ msum [speedyCommute x,- everythingElseCommute commuteNoMerger x]--isFilepatchMerger :: Patch C(x y) -> Maybe FileName-isFilepatchMerger (PP p) = is_filepatch p-isFilepatchMerger (Merger _ _ p1 p2) = do- f1 <- isFilepatchMerger p1- f2 <- isFilepatchMerger p2- if f1 == f2 then return f1 else Nothing-isFilepatchMerger (Regrem und unw p1 p2)- = isFilepatchMerger (Merger und unw p1 p2)-isFilepatchMerger (ComP _) = Nothing--commuteRecursiveMerger :: (Patch :< Patch) C(x y) -> Perhaps ((Patch :< Patch) C(x y))-commuteRecursiveMerger (p@(Merger _ _ p1 p2) :< pA) = toPerhaps $- do (_ :> pA') <- commute (pA :> undo)- commute (pA' :> invert undo)- (_ :> pAmid) <- commute (pA :> unsafeCoercePStart (invert p1))- (p1' :> pAx) <- commute (pAmid :> p1)- guard (pAx `unsafeCompare` pA)- (p2' :> _) <- commute (pAmid :> p2)- (p2o :> _) <- commute (invert pAmid :> p2')- guard (p2o `unsafeCompare` p2)- let p' = if unsafeCompare p1' p1 && unsafeCompare p2' p2- then unsafeCoerceP p- else unsafeMerger "0.0" p1' p2'- undo' = mergerUndo p'- (pAo :> _) <- commute (undo' :> pA')- guard (pAo `unsafeCompare` pA)- return (pA' :< p')- where undo = mergerUndo p-commuteRecursiveMerger _ = Unknown--otherCommuteRecursiveMerger :: (Patch :< Patch) C(x y) -> Perhaps ((Patch :< Patch) C(x y))-otherCommuteRecursiveMerger (pA':< p_old@(Merger _ _ p1' p2')) =- toPerhaps $- do (pA :> _) <- commute (mergerUndo p_old :> pA')- (pAmid :> p1) <- commute (unsafeCoercePEnd p1' :> pA)- (_ :> pAmido) <- commute (pA :> invert p1)- guard (pAmido `unsafeCompare` pAmid)- (p2 :> _) <- commute (invert pAmid :> p2')- (p2o' :> _) <- commute (pAmid :> p2)- guard (p2o' `unsafeCompare` p2')- let p = if p1 `unsafeCompare` p1' && p2 `unsafeCompare` p2'- then unsafeCoerceP p_old- else unsafeMerger "0.0" p1 p2- undo = mergerUndo p- guard (not $ pA `unsafeCompare` p1) -- special case here...- (_ :> pAo') <- commute (pA :> undo)- guard (pAo' `unsafeCompare` pA')- return (p :< pA)-otherCommuteRecursiveMerger _ = Unknown--type CommuteFunction = FORALL(x y) (Patch :< Patch) C(x y) -> Perhaps ((Patch :< Patch) C(x y))-type MaybeCommute = FORALL(x y) (Patch :< Patch) C(x y) -> Maybe ((Patch :< Patch) C(x y))-\end{code}--\paragraph{Merge}-\newcommand{\merge}{\Longrightarrow}-The second way one can change the context of a patch is by a {\bf merge}-operation. A merge is an operation that takes two parallel patches and-gives a pair of sequential patches. The merge operation is represented by-the arrow ``\( \merge \)''.-\begin{dfn}\label{merge_dfn}-The result of a merge of two patches, $P_1$ and $P_2$ is one of two patches,-$P_1'$ and $P_2'$, which satisfy the relationship:-\[ P_2 \parallel P_1 \merge {P_2}' P_1 \commutex {P_1}' P_2. \]-\end{dfn}-Note that the sequential patches resulting from a merge are \emph{required}-to commutex. This is an important consideration, as without it most of the-manipulations we would like to perform would not be possible. The other-important fact is that a merge \emph{cannot fail}. Naively, those two-requirements seem contradictory. In reality, what it means is that the-result of a merge may be a patch which is much more complex than any we-have yet considered\footnote{Alas, I don't know how to prove that the two-constraints even \emph{can} be satisfied. The best I have been able to do-is to believe that they can be satisfied, and to be unable to find an case-in which my implementation fails to satisfy them. These two requirements-are the foundation of the entire theory of patches (have you been counting-how many foundations it has?).}.--\subsection{How merges are actually performed}--The constraint that any two compatible patches (patches which can-successfully be applied to the same tree) can be merged is actually quite-difficult to apply. The above merge constraints also imply that the result-of a series of merges must be independent of the order of the merges. So-I'm putting a whole section here for the interested to see what algorithms-I use to actually perform the merges (as this is pretty close to being the-most difficult part of the code).--The first case is that in which the two merges don't actually conflict, but-don't trivially merge either (e.g.\ hunk patches on the same file, where the-line number has to be shifted as they are merged). This kind of merge can-actually be very elegantly dealt with using only commutation and inversion.--There is a handy little theorem which is immensely useful when trying to-merge two patches.-\begin{thm}\label{merge_thm}-$ P_2' P_1 \commutex P_1' P_2 $ if and only if $ P_1'^{ -1}-P_2' \commutex P_2 P_1^{ -1} $, provided both commutations succeed. If-either commutex fails, this theorem does not apply.-\end{thm}-This can easily be proven by multiplying both sides of the first-commutation by $P_1'^{ -1}$ on the left, and by $P_1^{ -1}$ on the right.-Besides being used in merging, this theorem is also useful in the recursive-commutations of mergers. From Theorem~\ref{merge_thm}, we see that the-merge of $P_1$ and $P_2'$ is simply the commutation of $P_2$ with $P_1^{--1}$ (making sure to do the commutation the right way). Of course, if this-commutation fails, the patches conflict. Moreover, one must check that the-merged result actually commutes with $P_1$, as the theorem applies only-when \emph{both} commutations are successful.--\begin{code}--elegantMerge :: (Patch :\/: Patch) C(x y)- -> Maybe ((Patch :/\: Patch) C(x y))-elegantMerge (p1 :\/: p2) = do- p1' :> ip2' <- commute (invert p2 :> p1)- p1o :> _ <- commute (p2 :> p1')- guard $ unsafeCompare p1o p1 -- should be a redundant check- return $ invert ip2' :/\: p1'--\end{code}--Of course, there are patches that actually conflict, meaning a merge where-the two patches truly cannot both be applied (e.g.\ trying to create a file-and a directory with the same name). We deal with this case by creating a-special kind of patch to support the merge, which we will call a-``merger''. Basically, a merger is a patch that contains the two patches-that conflicted, and instructs darcs basically to resolve the conflict. By-construction a merger will satisfy the commutation property (see-Definition~\ref{merge_dfn}) that characterizes all merges. Moreover the-merger's properties are what makes the order of merges unimportant (which-is a rather critical property for darcs as a whole).--The job of a merger is basically to undo the two conflicting patches, and-then apply some sort of a ``resolution'' of the two instead. In the case-of two conflicting hunks, this will look much like what CVS does, where it-inserts both versions into the file. In general, of course, the two-conflicting patches may both be mergers themselves, in which case the-situation is considerably more complicated.--\begin{code}-{--A note about mergers and type witnesses------------------------------------------The merger code predates the introduction of type witnesses, and because-of its complexity has proved the hardest part of the codebase to retrofit.-Attempting to do this has exposed various places where the code behaves-oddly (e.g. 'putBefore' below); these are likely to be bugs but fixing-them would be potentially disruptive and dangerous as it might change-the existing merge behaviour and thus break existing repositories.--As a result the addition of witnesses to this code has required the-liberal use of unsafe operators. In effect, witnesses bring no safety-in this area; the sole purpose of adding them here was to allow this-code to run as part of a codebase that uses witnesses everywhere else.--A key problem point is the type of the 'Merger' and 'Regrem' constructors-of Patch, where the witnesses seem odd. It is likely that some or many-of the unsafe operations could be removed by finding a better type for-these constructors.--}---actualMerge :: (Patch :\/: Patch) C(x y) -> Sealed (Patch C(y))--actualMerge (ComP the_p1s :\/: ComP the_p2s) =- mapSeal joinPatchesFL $ mc (the_p1s :\/: the_p2s)- where mc :: (FL Patch :\/: FL Patch) C(x y) -> Sealed (FL Patch C(y))- mc (NilFL :\/: (_:>:_)) = Sealed NilFL- mc (p1s :\/: NilFL) = Sealed p1s- mc (p1s :\/: (p2:>:p2s)) = case mergePatchesAfterPatch (p1s:\/:p2) of- Sealed x -> mc (x:\/:p2s)-actualMerge (ComP p1s :\/: p2) = seq p2 $- mapSeal joinPatchesFL $ mergePatchesAfterPatch (p1s:\/:p2)-actualMerge (p1 :\/: ComP p2s) = seq p1 $ mergePatchAfterPatches (p1:\/:p2s)--actualMerge (p1 :\/: p2) = case elegantMerge (p1:\/:p2) of- Just (_ :/\: p1') -> Sealed p1'- Nothing -> merger "0.0" p2 p1--mergePatchAfterPatches :: (Patch :\/: FL Patch) C(x y) -> Sealed (Patch C(y))-mergePatchAfterPatches (p :\/: (p1:>:p1s)) =- case actualMerge (p:\/:p1) of- Sealed x -> mergePatchAfterPatches (x :\/: p1s)-mergePatchAfterPatches (p :\/: NilFL) = Sealed p--mergePatchesAfterPatch :: (FL Patch :\/: Patch) C(x y) -> Sealed (FL Patch C(y))-mergePatchesAfterPatch (p2s :\/: p) =- case mergePatchAfterPatches (p :\/: p2s) of- Sealed x -> case commute (joinPatchesFL p2s :> x) of- Just (_ :> ComP p2s') -> Sealed (unsafeCoercePStart p2s')- _ -> impossible-\end{code}--Much of the merger code depends on a routine which recreates from a single-merger the entire sequence of patches which led up to that merger (this is,-of course, assuming that this is the complicated general case of a merger-of mergers of mergers). This ``unwind'' procedure is rather complicated,-but absolutely critical to the merger code, as without it we wouldn't even-be able to undo the effects of the patches involved in the merger, since we-wouldn't know what patches were all involved in it.--Basically, unwind takes a merger such as-\begin{verbatim}-M( M(A,B), M(A,M(C,D)))-\end{verbatim}-From which it recreates a merge history:-\begin{verbatim}-C-A-M(A,B)-M( M(A,B), M(A,M(C,D)))-\end{verbatim}-(For the curious, yes I can easily unwind this merger in my head [and on-paper can unwind insanely more complex mergers]---that's what comes of-working for a few months on an algorithm.) Let's start with a simple-unwinding. The merger \verb!M(A,B)! simply means that two patches-(\verb!A! and \verb!B!) conflicted, and of the two of them \verb!A! is-first in the history. The last two patches in the unwinding of any merger-are always just this easy. So this unwinds to:-\begin{verbatim}-A-M(A,B)-\end{verbatim}-What about a merger of mergers? How about \verb!M(A,M(C,D))!. In this case-we know the two most recent patches are:-\begin{verbatim}-A-M(A,M(C,D))-\end{verbatim}-But obviously the unwinding isn't complete, since we don't yet see where-\verb!C! and \verb!D! came from. In this case we take the unwinding of-\verb!M(C,D)! and drop its latest patch (which is \verb!M(C,D)! itself) and-place that at the beginning of our patch train:-\begin{verbatim}-C-A-M(A,M(C,D))-\end{verbatim}-As we look at \verb!M( M(A,B), M(A,M(C,D)))!, we consider the unwindings of-each of its subpatches:-\begin{verbatim}- C-A A-M(A,B) M(A,M(C,D))-\end{verbatim}-As we did with \verb!M(A,M(C,D))!, we'll drop the first patch on the-right and insert the first patch on the left. That moves us up to the two-\verb!A!'s. Since these agree, we can use just one of them (they-``should'' agree). That leaves us with the \verb!C! which goes first.--The catch is that things don't always turn out this easily. There is no-guarantee that the two \verb!A!'s would come out at the same time, and if-they didn't, we'd have to rearrange things until they did. Or if there was-no way to rearrange things so that they would agree, we have to go on to-plan B, which I will explain now.--Consider the case of \verb!M( M(A,B), M(C,D))!. We can easily unwind the-two subpatches-\begin{verbatim}-A C-M(A,B) M(C,D)-\end{verbatim}-Now we need to reconcile the \verb!A! and \verb!C!. How do we do this?-Well, as usual, the solution is to use the most wonderful-Theorem~\ref{merge_thm}. In this case we have to use it in the reverse of-how we used it when merging, since we know that \verb!A! and \verb!C! could-either one be the \emph{last} patch applied before \verb!M(A,B)! or-\verb!M(C,D)!. So we can find \verb!C'! using-\[-A^{ -1} C \commutex C' A'^{ -1}-\]-Giving an unwinding of-\begin{verbatim}-C'-A-M(A,B)-M( M(A,B), M(C,D) )-\end{verbatim}-There is a bit more complexity to the unwinding process (mostly having to-do with cases where you have deeper nesting), but I think the general-principles that are followed are pretty much included in the above-discussion.--\begin{code}-unwind :: Patch C(x y) -> Sealed (RL Patch C(x)) -- Recreates a patch history in reverse.-unwind (Merger _ unwindings _ _) = Sealed unwindings-unwind p = Sealed (p :<: NilRL)--trueUnwind :: Patch C(x y) -> Sealed (RL Patch C(x)) -- Recreates a patch history in reverse.-trueUnwind p@(Merger _ _ p1 p2) =- case (unwind p1, unwind p2) of- (Sealed (_:<:p1s),Sealed (_:<:p2s)) ->- Sealed (p :<: unsafeCoerceP p1 :<: unsafeUnsealFlipped (reconcileUnwindings p p1s (unsafeCoercePEnd p2s)))- _ -> impossible-trueUnwind _ = impossible--reconcileUnwindings :: Patch C(a b) -> RL Patch C(x z) -> RL Patch C(y z) -> FlippedSeal (RL Patch) C(z)-reconcileUnwindings _ NilRL p2s = FlippedSeal p2s-reconcileUnwindings _ p1s NilRL = FlippedSeal p1s-reconcileUnwindings p (p1:<:p1s) p2s@(p2:<:tp2s) =- case [(p1s', p2s')|- p1s'@(hp1s':<:_) <- headPermutationsRL (p1:<:p1s),- p2s'@(hp2s':<:_) <- headPermutationsRL p2s,- hp1s' `unsafeCompare` hp2s'] of- ((p1':<:p1s', _:<:p2s'):_) ->- mapFlipped (p1' :<:) $ reconcileUnwindings p p1s' (unsafeCoercePEnd p2s')- [] -> case reverseFL `fmap` putBefore p1 (reverseRL p2s) of- Just p2s' -> mapFlipped (p1 :<:) $ reconcileUnwindings p p1s p2s'- Nothing ->- case fmap reverseFL $ putBefore p2 $- reverseRL (p1:<:p1s) of- Just p1s' -> mapFlipped (p2 :<:) $- reconcileUnwindings p p1s' tp2s- Nothing ->- bugDoc $ text "in function reconcileUnwindings"- $$ text "Original patch:"- $$ showPatch_ p- _ -> bug "in reconcileUnwindings"---- This code seems wrong, shouldn't the commute be invert p1 :> p2 ? And why isn't p1' re-inverted?--- it seems to have been this way forever:--- Fri May 23 10:27:04 BST 2003 droundy@abridgegame.org--- * fix bug in unwind and add docs on unwind algorithm.-putBefore :: Patch C(y z) -> FL Patch C(x z) -> Maybe (FL Patch C(y w))-putBefore p1 (p2:>:p2s) =- do p1' :> p2' <- commute (unsafeCoerceP p2 :> invert p1)- commute (p2' :> p1)- (unsafeCoerceP p2' :>:) `fmap` putBefore p1' (unsafeCoerceP p2s)-putBefore _ NilFL = Just (unsafeCoerceP NilFL)-\end{code}--\section{Conflicts}--There are a couple of simple constraints on the routine which determines-how to resolve two conflicting patches (which is called `glump'). These-must be satisfied in order that the result of a series of merges is always-independent of their order. Firstly, the output of glump cannot change-when the order of the two conflicting patches is switched. If it did, then-commuting the merger could change the resulting patch, which would be bad.-Secondly, the result of the merge of three (or more) conflicting patches-cannot depend on the order in which the merges are performed.--The conflict resolution code (glump) begins by ``unravelling'' the merger-into a set of sequences of patches. Each sequence of patches corresponds-to one non-conflicted patch that got merged together with the others. The-result of the unravelling of a series of merges must obviously be-independent of the order in which those merges are performed. This-unravelling code (which uses the unwind code mentioned above) uses probably-the second most complicated algorithm. Fortunately, if we can successfully-unravel the merger, almost any function of the unravelled merger satisfies-the two constraints mentioned above that the conflict resolution code must-satisfy.--\begin{code}-instance Conflict Patch where- commuteNoConflicts (x:>y) = do x' :< y' <- commuteNoMerger (y :< x)- return (y':>x')- resolveConflicts patch = rcs NilFL $ reverseFL $ flattenFL patch- where rcs :: FL Patch C(y w) -> RL Patch C(x y) -> [[Sealed (FL Prim C(w))]]- rcs _ NilRL = []- rcs passedby (p@(Merger _ _ _ _):<:ps) =- case commuteNoMerger (joinPatchesFL passedby:<p) of- Just (p'@(Merger _ _ p1 p2):<_) ->- (map Sealed $ nubBy unsafeCompare $- effect (unsafeCoercePStart $ unsafeUnseal (glump09 p1 p2)) : map (unsafeCoercePStart . unsafeUnseal) (unravel p'))- : rcs (p :>: passedby) ps- Nothing -> rcs (p :>: passedby) ps- _ -> impossible- rcs passedby (p:<:ps) = seq passedby $- rcs (p :>: passedby) ps---- This type seems wrong - the most natural type for the result would seem to be--- [Sealed (FL Prim C(x))], given the type of unwind.--- However downstream code in darcs convert assumes the C(y) type, and I was unable--- to figure out whether this could/should reasonably be changed -- Ganesh 13/4/10-publicUnravel :: Patch C(x y) -> [Sealed (FL Prim C(y))]-publicUnravel = map (mapSeal unsafeCoercePStart) . unravel--unravel :: Patch C(x y) -> [Sealed (FL Prim C(x))]-unravel p = nub $ map (mapSeal (sortCoalesceFL . concatFL . mapFL_FL effect)) $- getSupers $ map (mapSeal reverseRL) $ unseal (newUr p) $ unwind p--getSupers :: [Sealed (FL Patch C(x))] -> [Sealed (FL Patch C(x))]-getSupers (x:xs) =- case filter (not.(x `isSuperpatchOf`)) xs of- xs' -> if or $ map (`isSuperpatchOf` x) xs'- then getSupers xs'- else x : getSupers xs'-getSupers [] = []--isSuperpatchOf :: Sealed (FL Patch C(x)) -> Sealed (FL Patch C(x)) -> Bool-Sealed x `isSuperpatchOf` Sealed y | lengthFL y > lengthFL x = False -- should be just an optimisation-Sealed x `isSuperpatchOf` Sealed y = x `iso` y- where iso :: FL Patch C(x y) -> FL Patch C(x z) -> Bool- _ `iso` NilFL = True- NilFL `iso` _ = False- a `iso` (b:>:bs) =- head $ ([as `iso` bs | (ah :>: as) <- simpleHeadPermutationsFL a, IsEq <- [ah =\/= b]] :: [Bool]) ++ [False]--merger :: String -> Patch C(x y) -> Patch C(x z) -> Sealed (Patch C(y))-merger "0.0" p1 p2 = Sealed $ Merger undoit unwindings p1 p2- where fake_p = Merger identity NilRL p1 p2- unwindings = unsafeUnseal (trueUnwind fake_p)- p = Merger identity unwindings p1 p2- undoit =- case (isMerger p1, isMerger p2) of- (True ,True ) -> case unwind p of- Sealed (_:<:t) -> unsafeCoerceP $ joinPatchesFL $ invertRL t- _ -> impossible- (False,False) -> unsafeCoerceP $ invert p1- (True ,False) -> unsafeCoerceP $ joinPatchesFL NilFL- (False,True ) -> unsafeCoerceP $ joinPatchesFL (invert p1 :>: mergerUndo p2 :>: NilFL)-merger g _ _ =- error $ "Cannot handle mergers other than version 0.0\n"++g- ++ "\nPlease use darcs optimize --modernize with an older darcs."--glump09 :: Patch C(x y) -> Patch C(x z) -> Sealed (Patch C(y))-glump09 p1 p2 = mapSeal fromPrims $ mangleUnravelled $ unseal unravel $ merger "0.0" p1 p2--mangleUnravelled :: [Sealed (FL Prim C(x))] -> Sealed (FL Prim C(x))-mangleUnravelled pss = if onlyHunks pss- then (:>: NilFL) `mapSeal` mangleUnravelledHunks pss- else head pss--onlyHunks :: [Sealed (FL Prim C(x))] -> Bool-onlyHunks [] = False-onlyHunks pss = fn2fp f /= "" && all oh pss- where f = getAFilename pss- oh :: Sealed (FL Prim C(x)) -> Bool- oh (Sealed (p:>:ps)) = primIsHunk p &&- [fn2fp f] == listTouchedFiles p &&- oh (Sealed ps)- oh (Sealed NilFL) = True--applyHunks :: [Maybe B.ByteString] -> FL Prim C(x y) -> [Maybe B.ByteString]-applyHunks ms (FP _ (Hunk l o n):>:ps) = applyHunks (rls l ms) ps- where rls 1 mls = map Just n ++ drop (length o) mls- rls i (ml:mls) = ml : rls (i-1) mls- rls _ [] = bug "rls in applyHunks"-applyHunks ms NilFL = ms-applyHunks _ (_:>:_) = impossible--getOld :: [Maybe B.ByteString] -> [Sealed (FL Prim C(x))] -> [Maybe B.ByteString]-getOld mls (ps:pss) = getOld (getHunksOld mls ps) pss-getOld mls [] = mls--getAFilename :: [Sealed (FL Prim C(x))] -> FileName-getAFilename ((Sealed (FP f _:>:_)):_) = f-getAFilename _ = fp2fn ""--getHunksOld :: [Maybe B.ByteString] -> Sealed (FL Prim C(x))- -> [Maybe B.ByteString]-getHunksOld mls (Sealed ps) =- applyHunks (applyHunks mls ps) (invert ps)--getHunksNew :: [Maybe B.ByteString] -> Sealed (FL Prim C(x))- -> [Maybe B.ByteString]-getHunksNew mls (Sealed ps) = applyHunks mls ps--getHunkline :: [[Maybe B.ByteString]] -> Int-getHunkline = ghl 1- where ghl :: Int -> [[Maybe B.ByteString]] -> Int- ghl n pps =- if any (isJust . head) pps- then n- else ghl (n+1) $ map tail pps--makeChunk :: Int -> [Maybe B.ByteString] -> [B.ByteString]-makeChunk n mls = pull_chunk $ drop (n-1) mls- where pull_chunk (Just l:mls') = l : pull_chunk mls'- pull_chunk (Nothing:_) = []- pull_chunk [] = bug "should this be [] in pull_chunk?"--mangleUnravelledHunks :: [Sealed (FL Prim C(x))] -> Sealed (Prim C(x))---mangleUnravelledHunks [[h1],[h2]] = Deal with simple cases handily?-mangleUnravelledHunks pss =- if null nchs then bug "mangleUnravelledHunks"- else Sealed (FP filename (Hunk l old new))- where oldf = getOld (repeat Nothing) pss- newfs = map (getHunksNew oldf) pss- l = getHunkline $ oldf : newfs- nchs = sort $ map (makeChunk l) newfs- filename = getAFilename pss- old = makeChunk l oldf- new = [top] ++ concat (intersperse [middle] nchs) ++ [bottom]- top = BC.pack $ "v v v v v v v" ++ eol_c- middle = BC.pack $ "*************" ++ eol_c- bottom = BC.pack $ "^ ^ ^ ^ ^ ^ ^" ++ eol_c- eol_c = if any (\ps -> not (B.null ps) && BC.last ps == '\r') old- then "\r"- else ""--instance Effect Patch where- effect p@(Merger _ _ _ _) = sortCoalesceFL $ effect $ mergerUndo p- effect p@(Regrem _ _ _ _) = invert $ effect $ invert p- effect (ComP ps) = concatFL $ mapFL_FL effect ps- effect (PP p) = effect p- isHunk p = do PP p' <- return p- isHunk p'---- |@modernizePatch@ is used during conversion to Darcs 2 format.--- It does the following:------ * removes mergers by linearising them, thus removing the ability--- to commute them------ * drops mv a b ; add b which was introduced by an error in earlier--- versions of darcs (TODO: check this; identify the versions)-modernizePatch :: Patch C(x y) -> Patch C(x y)-modernizePatch p@(Merger _ _ _ _) = fromPrims $ effect p-modernizePatch p@(Regrem _ _ _ _) = fromPrims $ effect p-modernizePatch (ComP ps) = ComP $ filtermv $ mapFL_FL modernizePatch ps- where filtermv :: FL Patch C(x y) -> FL Patch C(x y)- filtermv (PP (Move _ b :: Prim C(x z)):>:xs)- | IsEq <- hasadd xs = filtermv xs- where hasadd :: FL Patch C(a b) -> EqCheck C(x z)- hasadd (PP (FP b' AddFile):>:_) | b' == b = unsafeCoerceP IsEq- hasadd (PP (DP b' AddDir):>:_) | b' == b = unsafeCoerceP IsEq- hasadd (PP (FP b' RmFile):>:_) | b' == b = NotEq- hasadd (PP (DP b' RmDir):>:_) | b' == b = NotEq- hasadd (_:>:z) = hasadd z- hasadd NilFL = NotEq- filtermv (x:>:xs) = x :>: filtermv xs- filtermv NilFL = NilFL--modernizePatch (PP p) = fromPrims $ modernizePrim p--instance FromPrims Patch where- fromPrims (p :>: NilFL) = PP p- fromPrims ps = joinPatchesFL $ mapFL_FL PP ps- joinPatches = joinPatchesFL--newUr :: Patch C(a b) -> RL Patch C(x y) -> [Sealed (RL Patch C(x))]-newUr p (Merger _ _ p1 p2 :<: ps) =- case filter (\(pp:<:_) -> pp `unsafeCompare` p1) $ headPermutationsRL ps of- ((_:<:ps'):_) -> newUr p (unsafeCoercePStart p1:<:ps') ++ newUr p (unsafeCoercePStart p2:<:ps')- _ -> bugDoc $ text "in function newUr"- $$ text "Original patch:"- $$ showPatch_ p- $$ text "Unwound:"- $$ vcat (unseal (mapRL showPatch_) $ unwind p)--newUr op ps =- case filter (\(p:<:_) -> isMerger p) $ headPermutationsRL ps of- [] -> [Sealed ps]- (ps':_) -> newUr op ps'--instance Invert p => Invert (Named p) where- invert (NamedP n d p) = NamedP (invertName n) (map invertName d) (invert p)- identity = NamedP idpatchinfo [] identity--instance Invert Patch where- invert (Merger undo unwindings p1 p2)- = Regrem undo unwindings p1 p2- invert (Regrem undo unwindings p1 p2)- = Merger undo unwindings p1 p2- invert (PP p) = PP (invert p)- invert (ComP ps) = ComP $ invert ps- identity = ComP NilFL--instance MyEq Patch where- unsafeCompare = eqPatches-instance MyEq p => MyEq (Named p) where- unsafeCompare (NamedP n1 d1 p1) (NamedP n2 d2 p2) =- n1 == n2 && d1 == d2 && unsafeCompare p1 p2--eqPatches :: Patch C(x y) -> Patch C(w z) -> Bool-eqPatches (PP p1) (PP p2) = unsafeCompare p1 p2-eqPatches (ComP ps1) (ComP ps2)- = eqFL eqPatches ps1 ps2-eqPatches (ComP NilFL) (PP Identity) = True-eqPatches (PP Identity) (ComP NilFL) = True-eqPatches (Merger _ _ p1a p1b) (Merger _ _ p2a p2b)- = eqPatches p1a p2a &&- eqPatches p1b p2b-eqPatches (Regrem _ _ p1a p1b) (Regrem _ _ p2a p2b)- = eqPatches p1a p2a &&- eqPatches p1b p2b-eqPatches _ _ = False--eqFL :: (FORALL(b c d e) a C(b c) -> a C(d e) -> Bool)- -> FL a C(x y) -> FL a C(w z) -> Bool-eqFL _ NilFL NilFL = True-eqFL f (x:>:xs) (y:>:ys) = f x y && eqFL f xs ys-eqFL _ _ _ = False--\end{code}
+ src/Darcs/Patch/Conflict.hs view
@@ -0,0 +1,89 @@+module Darcs.Patch.Conflict+ ( Conflict(..), CommuteNoConflicts(..)+ , IsConflictedPrim(..), ConflictState(..) )+ where++import Darcs.Patch.Effect ( Effect(..) )+import Darcs.Patch.Inspect ( PatchInspect(..) )+import Darcs.Patch.Permutations ()+import Darcs.Patch.Prim.Class ( PrimOf )+import Darcs.Witnesses.Ordered+ ( FL(..), RL(..), (:>)(..)+ , mapFL, reverseFL, mapRL, reverseRL+ )+import Darcs.Witnesses.Sealed ( Sealed, unseal )+import Darcs.Utils ( nubsort )++#include "gadts.h"++class (Effect p, PatchInspect (PrimOf p)) => Conflict p where+ listConflictedFiles :: p C(x y) -> [FilePath]+ listConflictedFiles p =+ nubsort $ concatMap (unseal listTouchedFiles) $ concat $ resolveConflicts p+ resolveConflicts :: p C(x y) -> [[Sealed (FL (PrimOf p) C(y))]]++ conflictedEffect :: p C(x y) -> [IsConflictedPrim (PrimOf p)]+ conflictedEffect x = case listConflictedFiles x of+ [] -> mapFL (IsC Okay) $ effect x+ _ -> mapFL (IsC Conflicted) $ effect x++class CommuteNoConflicts p where+ -- | If 'commuteNoConflicts' @x :> y@ succeeds, we know that that @x@ commutes+ -- past @y@ without any conflicts. This function is useful for patch types+ -- for which 'commute' is defined to always succeed; so we need some way to+ -- pick out the specific cases where commutation succeeds without any conflicts.+ commuteNoConflicts :: (p :> p) C(x y) -> Maybe ((p :> p) C(x y))++instance (CommuteNoConflicts p, Conflict p) => Conflict (FL p) where+ listConflictedFiles = nubsort . concat . mapFL listConflictedFiles+ resolveConflicts NilFL = []+ resolveConflicts x = resolveConflicts $ reverseFL x+ conflictedEffect = concat . mapFL conflictedEffect++instance CommuteNoConflicts p => CommuteNoConflicts (FL p) where+ commuteNoConflicts (NilFL :> x) = Just (x :> NilFL)+ commuteNoConflicts (x :> NilFL) = Just (NilFL :> x)+ commuteNoConflicts (xs :> ys) = do ys' :> rxs' <- commuteNoConflictsRLFL (reverseFL xs :> ys)+ return $ ys' :> reverseRL rxs'++instance (CommuteNoConflicts p, Conflict p) => Conflict (RL p) where+ listConflictedFiles = nubsort . concat . mapRL listConflictedFiles+ resolveConflicts x = rcs x NilFL+ where rcs :: RL p C(x y) -> FL p C(y w) -> [[Sealed (FL (PrimOf p) C(w))]]+ rcs NilRL _ = []+ rcs (p:<:ps) passedby | (_:_) <- resolveConflicts p =+ case commuteNoConflictsFL (p:>passedby) of+ Just (_:> p') -> resolveConflicts p' ++ rcs ps (p:>:passedby)+ Nothing -> rcs ps (p:>:passedby)+ rcs (p:<:ps) passedby = seq passedby $ rcs ps (p:>:passedby)+ conflictedEffect = concat . reverse . mapRL conflictedEffect++instance CommuteNoConflicts p => CommuteNoConflicts (RL p) where+ commuteNoConflicts (NilRL :> x) = Just (x :> NilRL)+ commuteNoConflicts (x :> NilRL) = Just (NilRL :> x)+ commuteNoConflicts (xs :> ys) = do ys' :> rxs' <- commuteNoConflictsRLFL (xs :> reverseRL ys)+ return $ reverseFL ys' :> rxs'++data IsConflictedPrim prim where+ IsC :: !ConflictState -> !(prim C(x y)) -> IsConflictedPrim prim+data ConflictState = Okay | Conflicted | Duplicated deriving ( Eq, Ord, Show, Read)++commuteNoConflictsFL :: CommuteNoConflicts p => (p :> FL p) C(x y) -> Maybe ((FL p :> p) C(x y))+commuteNoConflictsFL (p :> NilFL) = Just (NilFL :> p)+commuteNoConflictsFL (q :> p :>: ps) = do p' :> q' <- commuteNoConflicts (q :> p)+ ps' :> q'' <- commuteNoConflictsFL (q' :> ps)+ return (p' :>: ps' :> q'')++commuteNoConflictsRL :: CommuteNoConflicts p => (RL p :> p) C(x y) -> Maybe ((p :> RL p) C(x y))+commuteNoConflictsRL (NilRL :> p) = Just (p :> NilRL)+commuteNoConflictsRL (p :<: ps :> q) = do q' :> p' <- commuteNoConflicts (p :> q)+ q'' :> ps' <- commuteNoConflictsRL (ps :> q')+ return (q'' :> p' :<: ps')++commuteNoConflictsRLFL :: CommuteNoConflicts p => (RL p :> FL p) C(x y) -> Maybe ((FL p :> RL p) C(x y))+commuteNoConflictsRLFL (NilRL :> ys) = Just (ys :> NilRL)+commuteNoConflictsRLFL (xs :> NilFL) = Just (NilFL :> xs)+commuteNoConflictsRLFL (xs :> y :>: ys) = do y' :> xs' <- commuteNoConflictsRL (xs :> y)+ ys' :> xs'' <- commuteNoConflictsRLFL (xs' :> ys)+ return (y' :>: ys' :> xs'')+
+ src/Darcs/Patch/ConflictMarking.hs view
@@ -0,0 +1,99 @@+-- Copyright (C) 2002-2003 David Roundy, 2010 Ganesh Sittampalam+{-# LANGUAGE ViewPatterns #-}+module Darcs.Patch.ConflictMarking+ ( mangleUnravelled+ ) where++import qualified Data.ByteString.Char8 as BC (pack, last)+import qualified Data.ByteString as B (null, ByteString)+import Data.List ( sort, intersperse )+import Data.Maybe ( isJust )++import Darcs.Patch.FileHunk ( FileHunk(..), IsHunk, isHunk )+import Darcs.Patch.FileName ( FileName, fn2fp, fp2fn )+import Darcs.Patch.Inspect ( PatchInspect(..) )+import Darcs.Patch.Invert ( Invert(..) )+import Darcs.Patch.Permutations ()+import Darcs.Patch.Prim ( PrimPatch, is_filepatch, primIsHunk, primFromHunk )+import Darcs.Witnesses.Ordered ( FL(..) )+import Darcs.Witnesses.Sealed ( Sealed(..), mapSeal )++#include "gadts.h"+#include "impossible.h"++applyHunks :: IsHunk prim => [Maybe B.ByteString] -> FL prim C(x y) -> [Maybe B.ByteString]+applyHunks ms ((isHunk -> Just (FileHunk _ l o n)):>:ps) = applyHunks (rls l ms) ps+ where rls k _ | k <=0 = bug $ "bad hunk: start position <=0 (" ++ show k ++ ")"+ rls 1 mls = map Just n ++ drop (length o) mls+ rls i (ml:mls) = ml : rls (i-1) mls+ rls _ [] = bug "rls in applyHunks"+applyHunks ms NilFL = ms+applyHunks _ (_:>:_) = impossible++getAFilename :: PrimPatch prim => [Sealed (FL prim C(x))] -> FileName+getAFilename ((Sealed ((is_filepatch -> Just f):>:_)):_) = f+getAFilename _ = fp2fn ""++getOld :: PrimPatch prim => [Maybe B.ByteString] -> [Sealed (FL prim C(x))] -> [Maybe B.ByteString]+getOld mls (ps:pss) = getOld (getHunksOld mls ps) pss+getOld mls [] = mls++getHunksOld :: PrimPatch prim => [Maybe B.ByteString] -> Sealed (FL prim C(x))+ -> [Maybe B.ByteString]+getHunksOld mls (Sealed ps) =+ applyHunks (applyHunks mls ps) (invert ps)++getHunksNew :: IsHunk prim => [Maybe B.ByteString] -> Sealed (FL prim C(x))+ -> [Maybe B.ByteString]+getHunksNew mls (Sealed ps) = applyHunks mls ps++getHunkline :: [[Maybe B.ByteString]] -> Int+getHunkline = ghl 1+ where ghl :: Int -> [[Maybe B.ByteString]] -> Int+ ghl n pps =+ if any (isJust . head) pps+ then n+ else ghl (n+1) $ map tail pps++makeChunk :: Int -> [Maybe B.ByteString] -> [B.ByteString]+makeChunk n mls = pull_chunk $ drop (n-1) mls+ where pull_chunk (Just l:mls') = l : pull_chunk mls'+ pull_chunk (Nothing:_) = []+ pull_chunk [] = bug "should this be [] in pull_chunk?"+++mangleUnravelled :: PrimPatch prim => [Sealed (FL prim C(x))] -> Sealed (FL prim C(x))+mangleUnravelled pss = if onlyHunks pss+ then (:>: NilFL) `mapSeal` mangleUnravelledHunks pss+ else head pss++onlyHunks :: forall prim C(x) . PrimPatch prim => [Sealed (FL prim C(x))] -> Bool+onlyHunks [] = False+onlyHunks pss = fn2fp f /= "" && all oh pss+ where f = getAFilename pss+ oh :: Sealed (FL prim C(y)) -> Bool+ oh (Sealed (p:>:ps)) = primIsHunk p &&+ [fn2fp f] == listTouchedFiles p &&+ oh (Sealed ps)+ oh (Sealed NilFL) = True++mangleUnravelledHunks :: PrimPatch prim => [Sealed (FL prim C(x))] -> Sealed (prim C(x))+--mangleUnravelledHunks [[h1],[h2]] = Deal with simple cases handily?+mangleUnravelledHunks pss =+ if null nchs then bug "mangleUnravelledHunks"+ else Sealed (primFromHunk (FileHunk filename l old new))+ where oldf = getOld (repeat Nothing) pss+ newfs = map (getHunksNew oldf) pss+ l = getHunkline $ oldf : newfs+ nchs = sort $ map (makeChunk l) newfs+ filename = getAFilename pss+ old = makeChunk l oldf+ new = [top] ++ old ++ [initial] ++ concat (intersperse [middle] nchs) ++ [bottom]+ top = BC.pack $ "v v v v v v v" ++ eol_c+ initial= BC.pack $ "=============" ++ eol_c+ middle = BC.pack $ "*************" ++ eol_c+ bottom = BC.pack $ "^ ^ ^ ^ ^ ^ ^" ++ eol_c+ eol_c = if any (\ps -> not (B.null ps) && BC.last ps == '\r') old+ then "\r"+ else ""+
− src/Darcs/Patch/Core.lhs
@@ -1,181 +0,0 @@-% Copyright (C) 2002-2003 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.---\section{Patch relationships}--\begin{code}-{-# OPTIONS_GHC -cpp -fglasgow-exts #-}-{-# LANGUAGE CPP #-}--- , GADTs, PatternGuards #-}--#include "gadts.h"--module Darcs.Patch.Core- ( Patch(..), Named(..),- joinPatchesFL, concatFL, flattenFL,- nullP, isNullPatch, infopatch,- nFn,- adddeps, namepatch, anonymous,- mergerUndo, isMerger,- getdeps,- patch2patchinfo, patchname, patchcontents,- )- where--import Prelude hiding ( pi )-import Darcs.Patch.Info ( PatchInfo, patchinfo, makeFilename )-import Darcs.Patch.Patchy ( Patchy )-import Darcs.Witnesses.Ordered-import Darcs.Patch.Prim ( Prim(..), FromPrim(..), Effect(effect, effectRL), nFn )-#include "impossible.h"--data Patch C(x y) where- PP :: Prim C(x y) -> Patch C(x y)- ComP :: FL Patch C(x y) -> Patch C(x y)- Merger :: Patch C(x y)- -> RL Patch C(x b)- -> Patch C(c b)- -> Patch C(c d)- -> Patch C(x y)- Regrem :: Patch C(x y)- -> RL Patch C(x b)- -> Patch C(c b)- -> Patch C(c a)- -> Patch C(y x)--instance FromPrim Patch where- fromPrim = PP---- | The @Named@ type adds a patch info about a patch, that is a name.-data Named p C(x y) where- NamedP :: !PatchInfo- -> ![PatchInfo]- -> !(p C(x y))- -> Named p C(x y)--- ^ @NamedP info deps p@ represents patch @p@ with name--- @info@. @deps@ is a list of dependencies added at the named patch--- level, compared with the unnamed level (ie, dependencies added with--- @darcs record --ask-deps@).--instance Effect p => Effect (Named p) where- effect (NamedP _ _ p) = effect p- effectRL (NamedP _ _ p) = effectRL p--isNullPatch :: Patch C(x y) -> Bool-isNullPatch (ComP ps) = and $ mapFL isNullPatch ps-isNullPatch _ = False--nullP :: Patch C(x y) -> EqCheck C(x y)-nullP (ComP NilFL) = IsEq-nullP (ComP (x:>:xs)) | IsEq <- nullP x = nullP (ComP xs)-nullP _ = NotEq--isMerger :: Patch C(a b) -> Bool-isMerger (Merger _ _ _ _) = True-isMerger (Regrem _ _ _ _) = True-isMerger _ = False--mergerUndo :: Patch C(x y) -> Patch C(x y)-mergerUndo (Merger undo _ _ _) = undo-mergerUndo _ = impossible-\end{code}--%Another nice thing to be able to do with composite patches is to `flatten'-%them, that is, turn them into a simple list of patches (appropriately-%ordered, of course), with all nested compositeness unnested.--\begin{code}-{- INLINE flattenFL -}-flattenFL :: Patch C(x y) -> FL Patch C(x y)-flattenFL (ComP ps) = concatFL (mapFL_FL flattenFL ps)-flattenFL (PP Identity) = NilFL-flattenFL p = p :>: NilFL--joinPatchesFL :: FL Patch C(x y) -> Patch C(x y)-joinPatchesFL ps = ComP $! ps--infopatch :: Patchy p => PatchInfo -> p C(x y) -> Named p C(x y)-adddeps :: Named p C(x y) -> [PatchInfo] -> Named p C(x y)-getdeps :: Named p C(x y) -> [PatchInfo]--namepatch :: Patchy p => String -> String -> String -> [String] -> p C(x y) -> IO (Named p C(x y))-namepatch date name author desc p- | '\n' `elem` name = error "Patch names cannot contain newlines."- | otherwise = do pinf <- patchinfo date name author desc- return $ NamedP pinf [] p--anonymous :: Patchy p => p C(x y) -> IO (Named p C(x y))-anonymous p = namepatch "today" "anonymous" "unknown" ["anonymous"] p--infopatch pi p = NamedP pi [] p-adddeps (NamedP pi _ p) ds = NamedP pi ds p-getdeps (NamedP _ ds _) = ds--patch2patchinfo :: Named p C(x y) -> PatchInfo-patch2patchinfo (NamedP i _ _) = i--patchname :: Named p C(x y) -> String-patchname (NamedP i _ _) = makeFilename i--patchcontents :: Named p C(x y) -> p C(x y)-patchcontents (NamedP _ _ p) = p-\end{code}--The simplest relationship between two patches is that of ``sequential''-patches, which means that the context of the second patch (the one on the-left) consists of the first patch (on the right) plus the context of the-first patch. The composition of two patches (which is also a patch) refers-to the patch which is formed by first applying one and then the other. The-composition of two patches, $P_1$ and $P_2$ is represented as $P_2P_1$,-where $P_1$ is to be applied first, then $P_2$\footnote{This notation is-inspired by the notation of matrix multiplication or the application of-operators upon a Hilbert space. In the algebra of patches, there is-multiplication (i.e.\ composition), which is associative but not-commutative, but no addition or subtraction.}--There is one other very useful relationship that two patches can have,-which is to be parallel patches, which means that the two patches have an-identical context (i.e.\ their representation applies to identical trees).-This is represented by $P_1\parallel P_2$. Of course, two patches may also-have no simple relationship to one another. In that case, if you want to-do something with them, you'll have to manipulate them with respect to-other patches until they are either in sequence or in parallel.--The most fundamental and simple property of patches is that they must be-invertible. The inverse of a patch is described by: $P^{ -1}$. In the-darcs implementation, the inverse is required to be computable from-knowledge of the patch only, without knowledge of its context, but that-(although convenient) is not required by the theory of patches.-\begin{dfn}-The inverse of patch $P$ is $P^{ -1}$, which is the ``simplest'' patch for-which the composition \( P^{ -1} P \) makes no changes to the tree.-\end{dfn}-Using this definition, it is trivial to prove the following theorem-relating to the inverse of a composition of two patches.-\begin{thm} The inverse of the composition of two patches is-\[ (P_2 P_1)^{ -1} = P_1^{ -1} P_2^{ -1}. \]-\end{thm}-Moreover, it is possible to show that the right inverse of a patch is equal-to its left inverse. In this respect, patches continue to be analogous to-square matrices, and indeed the proofs relating to these properties of the-inverse are entirely analogous to the proofs in the case of matrix-multiplication. The compositions proofs can also readily be extended to-the composition of more than two patches.-\begin{code}--\end{code}
src/Darcs/Patch/Depends.hs view
@@ -15,9 +15,7 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP , ScopedTypeVariables #-}---, TypeOperators #-} #include "gadts.h" @@ -36,17 +34,16 @@ import Darcs.Patch ( RepoPatch, getdeps, commute, commuteFLorComplain, commuteRL ) import Darcs.Patch.Info ( PatchInfo, isTag, humanFriendly )-import Darcs.Patch.Patchy ( mergeFL )+import Darcs.Patch.Merge ( mergeFL ) import Darcs.Patch.Permutations ( partitionFL, partitionRL, removeSubsequenceRL )-import Darcs.Hopefully( PatchInfoAnd, hopefully, hopefullyM, info )-import Darcs.Witnesses.Ordered ( (:\/:)(..), (:/\:)(..), (:>)(..), (:>>)(..),- (=\/=), (=/\=), (+>+), EqCheck(..), mapFL,+import Darcs.Patch.PatchInfoAnd( PatchInfoAnd, hopefully, hopefullyM, info )+import Darcs.Witnesses.Eq ( EqCheck(..), (=\/=), (=/\=) )+import Darcs.Witnesses.Unsafe ( unsafeCoerceP, unsafeCoercePStart )+import Darcs.Witnesses.Ordered ( (:\/:)(..), (:/\:)(..), (:>)(..), (:>)(..),+ (+>+), mapFL, RL(..), FL(..), isShorterThanRL, (+<+),- reverseFL, reverseRL, mapRL, unsafeCoerceP, unsafeCoercePStart )+ reverseFL, reverseRL, mapRL, ) import Darcs.Patch.Set ( PatchSet(..), Tagged(..), SealedPatchSet, newset2RL )-#ifdef GADT_WITNESSES-import Darcs.Patch.Set ( Origin )-#endif import Darcs.ProgressPatches ( progressRL ) import Darcs.Witnesses.Sealed (Sealed(..), FlippedSeal(..), flipSeal, seal ) import Printer ( renderString, vcat )@@ -82,7 +79,7 @@ = case hopefullyM tb of Just _ -> with_partial_intersection aaa (PatchSet (b+<+tb:<:pb) tbs) j Nothing -> case splitOnTag (info tb) aaa of- PatchSet NilRL com :>> us -> j com us (unsafeCoerceP b)+ PatchSet NilRL com :> us -> j com us (unsafeCoerceP b) _ -> impossible getPatchesBeyondTag :: RepoPatch p => PatchInfo -> PatchSet p C(start x) -> FlippedSeal (RL (PatchInfoAnd p)) C(x)@@ -91,7 +88,7 @@ if info hp == t then if getTagsRight patchset == [info hp] then flipSeal $ NilRL -- special case to avoid looking at redundant patches- else case splitOnTag t patchset of _ :>> e -> flipSeal e+ else case splitOnTag t patchset of _ :> e -> flipSeal e else case getPatchesBeyondTag t (PatchSet ps ts) of FlippedSeal xxs -> FlippedSeal (hp :<: xxs) getPatchesBeyondTag t (PatchSet NilRL NilRL) = bug $ "tag\n" ++@@ -100,25 +97,25 @@ getPatchesBeyondTag t0 (PatchSet NilRL (Tagged t _ ps :<: ts)) = getPatchesBeyondTag t0 (PatchSet (t:<:ps) ts) -splitOnTag :: RepoPatch p => PatchInfo -> PatchSet p C(start x) -> (PatchSet p C(start) :>> RL (PatchInfoAnd p)) C(x)+splitOnTag :: RepoPatch p => PatchInfo -> PatchSet p C(start x) -> (PatchSet p :> RL (PatchInfoAnd p)) C(start x) splitOnTag t (PatchSet ps (Tagged hp x ps2 :<: ts))- | info hp == t = (PatchSet NilRL (Tagged hp x ps2 :<: ts)) :>> ps+ | info hp == t = (PatchSet NilRL (Tagged hp x ps2 :<: ts)) :> ps splitOnTag t patchset@(PatchSet (hp:<:ps) ts) | info hp == t = if getTagsRight patchset == [info hp]- then PatchSet NilRL (Tagged hp Nothing ps :<: ts) :>> NilRL+ then PatchSet NilRL (Tagged hp Nothing ps :<: ts) :> NilRL else case partitionRL ((`notElem` (t:ds)) . info) (hp:<:ps) of (x:<:a) :> b -> if getTagsRight (PatchSet (x:<:a) ts) == [t]- then PatchSet NilRL (Tagged x Nothing a :<: ts) :>> b+ then PatchSet NilRL (Tagged x Nothing a :<: ts) :> b else case splitOnTag t $ eatOne $ PatchSet (x:<:a) ts of- xx :>> yy -> xx :>> (b +<+ yy)- -- NilRL :> _ -> impossible+ xx :> yy -> xx :> (b +<+ yy)+ _ -> impossible where ds = getdeps (hopefully hp) eatOne :: PatchSet p C(start x) -> PatchSet p C(start x) eatOne (PatchSet ps1 (Tagged x _ ps2 :<: ts')) = PatchSet (ps1+<+x:<:ps2) ts' eatOne _ = bug "a stubborn case in splitOnTag (theoretically possible)" splitOnTag t (PatchSet (p:<:ps) ts) = case splitOnTag t (PatchSet ps ts) of- ns :>> x -> ns :>> (p:<:x)+ ns :> x -> ns :> (p:<:x) splitOnTag t0 (PatchSet NilRL (Tagged t _ ps :<: ts)) = splitOnTag t0 (PatchSet (t:<:ps) ts) splitOnTag t0 (PatchSet NilRL NilRL) = bug $ "tag\n" ++ renderString (humanFriendly t0) ++@@ -128,8 +125,16 @@ -- patches in @ps@ which are contained in @t@. getPatchesInTag :: RepoPatch p => PatchInfo -> PatchSet p C(start x) -> SealedPatchSet p C(start) getPatchesInTag t ns = case splitOnTag t ns of- ns' :>> _ -> seal ns'+ ns' :> _ -> seal ns' +-- | @getTagsRight ps@ returns the 'PatchInfo' for all the patches in+-- @ps@ that are not depended on by anything else *through explicit+-- dependencies*. Tags are a likely candidate, although we may also+-- find some non-tag patches in this list.+--+-- Keep in mind that in a typical repository with a lot of tags, only a small+-- fraction of tags would be returned as they would be at least indirectly+-- depended on by the topmost ones. getTagsRight :: PatchSet p C(start x) -> [PatchInfo] getTagsRight (PatchSet ps NilRL) = getTagsR (mapRL infoAndDeps ps) getTagsRight (PatchSet ps (Tagged t _ _ :<: _)) = getTagsR (mapRL infoAndDeps (ps+<+t:<:NilRL))@@ -139,6 +144,19 @@ getTagsR ((i0,Nothing):pps0) = i0 : getTagsR pps0 getTagsR ((i0,Just ds0):pps0) = i0 : getTagsR (drop_tags_r ds0 pps0) where+ -- example traversal given dependencies:+ --+ -- X1 -> X2+ -- X1 -> X4+ -- X2 -> X3+ --+ -- [X2,X4]: | o1 o2 X2 o3 o4 X3 o5 X5+ -- o1 |o2 X2 o3 o4 X3 o5 X5+ -- [X4,X3]: o1 o2 | o3 o4 X3 o5 X5+ -- ...+ -- [X4]: o1 o2 o3 o4 | o5 X5+ -- ...+ -- []: o1 o2 o3 o4 o5 drop_tags_r :: [PatchInfo] -> [(PatchInfo, Maybe [PatchInfo])] -> [(PatchInfo, Maybe [PatchInfo])] drop_tags_r [] pps = pps@@ -154,33 +172,53 @@ | isTag (info p) = (info p, getdeps `fmap` hopefullyM p) | otherwise = (info p, Nothing) +-- | @deepOptimizePatchset@ runs through all patches whether they are in the+-- surface inventory or the deep one. deepOptimizePatchset :: PatchSet p C(start x) -> PatchSet p C(start x) deepOptimizePatchset ns = optimizePatchset (PatchSet (newset2RL ns) NilRL) +-- | @optimizePatchset@ is similar to @slightlyOptimizePatchset@ in+-- that it only works on the surface inventory (see below), but it+-- works a bit harder and can optimize several tags.+--+-- * surface inventory: the sequence of patches that corresponds+-- to the @\_darcs/hashed\_inventory@ or @\_darcs/inventory@ files+--+-- * deep inventory: the sequence of sequences of patches that+-- corresponds to the @\_darcs/inventories@ directory optimizePatchset :: PatchSet p C(start x) -> PatchSet p C(start x) optimizePatchset (PatchSet NilRL ts) = PatchSet NilRL ts optimizePatchset (PatchSet (p:<:ps) ts) | isTag (info p) && getTagsRight (PatchSet (p:<:ps) ts) == [info p]+ -- all subsequent patches depend on p = case optimizePatchset (PatchSet ps ts) of PatchSet ps' ts' -> PatchSet NilRL (Tagged p Nothing ps' :<: ts') | otherwise = case optimizePatchset (PatchSet ps ts) of PatchSet ps' ts' -> PatchSet (p:<:ps') ts' +-- | @slightlyOptimizePatchset@ only works on the surface inventory+-- (see 'optimizePatchset') and only optimises at most one tag in+-- there, going for the most recent tag which has no non-depended+-- patch after it. Older tags won't be 'clean', which means the+-- PatchSet will not be in 'unclean :< clean' state. slightlyOptimizePatchset :: PatchSet p C(start x) -> PatchSet p C(start x) slightlyOptimizePatchset (PatchSet ps0 ts0) = sops $ PatchSet (progressRL "Optimizing inventory" ps0) ts0 where sops :: PatchSet p C(start y) -> PatchSet p C(start y) sops (PatchSet NilRL ts) = PatchSet NilRL ts sops (PatchSet (hp:<:ps) ts) | isTag (info hp) = if getTagsRight (PatchSet (hp:<:ps) ts) == [info hp]- then PatchSet NilRL (Tagged hp Nothing ps :<: ts)- else case sops $ PatchSet (progressRL "Optimizing inventory" ps) ts of+ then -- exactly one tag and it depends on everything not already archived+ PatchSet NilRL (Tagged hp Nothing ps :<: ts)+ else -- other tags or other top-level patches too (so move past hp)+ case sops $ PatchSet (progressRL "Optimizing inventory" ps) ts of PatchSet ps' ts' -> PatchSet (hp:<:ps') ts'- | otherwise = case sops $ PatchSet ps ts of+ | otherwise = -- move past hp+ case sops $ PatchSet ps ts of PatchSet ps' ts' -> PatchSet (hp:<:ps') ts' commuteToEnd :: forall p C(start x y). RepoPatch p => RL (PatchInfoAnd p) C(x y)- -> PatchSet p C(start y) -> (PatchSet p C(start) :>> RL (PatchInfoAnd p)) C(x)-commuteToEnd NilRL (PatchSet ps ts) = PatchSet NilRL ts :>> ps+ -> PatchSet p C(start y) -> (PatchSet p :> RL (PatchInfoAnd p)) C(start x)+commuteToEnd NilRL (PatchSet ps ts) = PatchSet NilRL ts :> ps commuteToEnd (p:<:ps) (PatchSet xs ts) | info p `elem` mapRL info xs = case fastRemoveRL p xs of Just xs' -> commuteToEnd ps (PatchSet xs' ts)@@ -203,21 +241,21 @@ rfns bad (PatchSet (ps+<+t:<:tps) ts) findCommonWithThem :: RepoPatch p => PatchSet p C(start x) -> PatchSet p C(start y)- -> (PatchSet p C(start) :>> FL (PatchInfoAnd p)) C(x)+ -> (PatchSet p :> FL (PatchInfoAnd p)) C(start x) findCommonWithThem us them = with_partial_intersection us them $ \common us' them' -> case partitionFL ((`elem` mapRL info them') . info) $ reverseRL us' of _ :> bad@(_:>:_) :> _ -> bug $ "Failed to commute common patches:\n" ++ (renderString $ vcat $ mapRL (humanFriendly . info) $ reverseFL bad)- common2 :> _ :> only_ours -> PatchSet (reverseFL common2) common :>> unsafeCoerceP only_ours+ common2 :> _nilfl :> only_ours -> PatchSet (reverseFL common2) common :> unsafeCoerceP only_ours findUncommon :: RepoPatch p => PatchSet p C(start x) -> PatchSet p C(start y) -> (FL (PatchInfoAnd p) :\/: FL (PatchInfoAnd p)) C(x y) findUncommon us them = case findCommonWithThem us them of- common :>> us' -> case findCommonWithThem them us of- _ :>> them' -> unsafeCoercePStart us' :\/: them'+ _common :> us' -> case findCommonWithThem them us of+ _ :> them' -> unsafeCoercePStart us' :\/: them' countUsThem :: RepoPatch p => PatchSet p C(start x) -> PatchSet p C(start y) -> (Int, Int) countUsThem us them =
+ src/Darcs/Patch/Dummy.hs view
@@ -0,0 +1,27 @@+{-# OPTIONS_GHC -fno-warn-missing-methods #-}+{-# LANGUAGE EmptyDataDecls #-}+module Darcs.Patch.Dummy ( DummyPatch ) where++import Darcs.Patch.FileHunk ( IsHunk )+import Darcs.Patch.Format ( PatchListFormat )+import Darcs.Patch.Patchy+ ( Patchy, ShowPatch, Invert, Commute, Apply, PatchInspect+ , ReadPatch )+import Darcs.Patch.Show ( ShowPatchBasic )+import Darcs.Witnesses.Eq ( MyEq )++#include "gadts.h"++data DummyPatch C(x y)++instance IsHunk DummyPatch+instance PatchListFormat DummyPatch+instance MyEq DummyPatch+instance Invert DummyPatch+instance PatchInspect DummyPatch+instance ReadPatch DummyPatch+instance ShowPatchBasic DummyPatch+instance ShowPatch DummyPatch+instance Commute DummyPatch+instance Apply DummyPatch+instance Patchy DummyPatch
+ src/Darcs/Patch/Effect.hs view
@@ -0,0 +1,29 @@+module Darcs.Patch.Effect ( Effect(..) ) where++import Darcs.Patch.Prim.Class ( PrimOf )++import Darcs.Witnesses.Ordered+ ( FL(..), RL(..), reverseFL, reverseRL+ , concatFL, concatRL, mapFL_FL, mapRL_RL+ )++#include "gadts.h"++-- | Patches whose concrete effect which can be expressed as a list of+-- primitive patches.+--+-- A minimal definition would be either of @effect@ or @effectRL@.+class Effect p where+ effect :: p C(x y) -> FL (PrimOf p) C(x y)+ effect = reverseRL . effectRL+ effectRL :: p C(x y) -> RL (PrimOf p) C(x y)+ effectRL = reverseFL . effect++instance Effect p => Effect (FL p) where+ effect p = concatFL $ mapFL_FL effect p+ effectRL p = concatRL $ mapRL_RL effectRL $ reverseFL p++instance Effect p => Effect (RL p) where+ effect p = concatFL $ mapFL_FL effect $ reverseRL p+ effectRL p = concatRL $ mapRL_RL effectRL p+
+ src/Darcs/Patch/FileHunk.hs view
@@ -0,0 +1,27 @@+module Darcs.Patch.FileHunk+ ( FileHunk(..), IsHunk(..), showFileHunk+ )+ where++import Darcs.Patch.FileName ( FileName )+import Darcs.Patch.Format ( FileNameFormat )+import Darcs.Patch.Show ( formatFileName )++import Printer+ ( Doc, blueText, text, lineColor, vcat, userchunkPS+ , prefix, ($$), (<+>), Color(Cyan, Magenta) )++import qualified Data.ByteString as B ( ByteString )++#include "gadts.h"++data FileHunk C(x y) = FileHunk !FileName !Int [B.ByteString] [B.ByteString]++class IsHunk p where+ isHunk :: p C(x y) -> Maybe (FileHunk C(x y))++showFileHunk :: FileNameFormat -> FileHunk C(x y) -> Doc+showFileHunk x (FileHunk f line old new) =+ blueText "hunk" <+> formatFileName x f <+> text (show line)+ $$ lineColor Magenta (prefix "-" (vcat $ map userchunkPS old))+ $$ lineColor Cyan (prefix "+" (vcat $ map userchunkPS new))
src/Darcs/Patch/FileName.hs view
@@ -28,7 +28,6 @@ breakup ) where -import System.IO import Data.Char ( isSpace, chr, ord ) import ByteStringUtils ( packStringToUTF8, unpackPSFromUTF8 ) import qualified Data.ByteString.Char8 as BC (unpack, pack)
+ src/Darcs/Patch/Format.hs view
@@ -0,0 +1,31 @@+module Darcs.Patch.Format+ ( PatchListFormat(..), ListFormat(..)+ , FileNameFormat(..) )+ where++#include "gadts.h"++-- |Showing and reading lists of patches This class allows us to control how+-- lists of patches are formatted on disk. For legacy reasons V1 patches+-- have their own special treatment (see 'ListFormat'). Other patch types+-- use the default format which just puts them in a sequence without separators+-- or any prelude/epilogue.+--+-- This means that 'FL (FL p)' etc would be ambiguous, so there are+-- no instances for 'FL p' or other list types.+class PatchListFormat p where+ patchListFormat :: ListFormat p+ patchListFormat = ListFormatDefault++-- | This type is used to tweak the way that lists of 'p' are shown for a+-- given 'Patch' type 'p'. It is needed to maintain backwards compatibility+-- for V1 and V2 patches.+data ListFormat (p :: PATCHKIND)+ = ListFormatDefault -- ^Show and read lists without braces.+ | ListFormatV1 -- ^Show lists with a single layer of braces around the outside,+ -- except for singletons which have no braces.+ -- Read with arbitrary nested braces and parens and flatten them out.+ | ListFormatV2 -- ^Show lists without braces+ -- Read with arbitrary nested parens and flatten them out.++data FileNameFormat = OldFormat | NewFormat
src/Darcs/Patch/Info.hs view
@@ -16,25 +16,31 @@ -- Boston, MA 02110-1301, USA. module Darcs.Patch.Info ( PatchInfo(..), patchinfo, invertName,- idpatchinfo, addJunk,+ idpatchinfo, addJunk, makePatchname, makeFilename, makeAltFilename, readPatchInfo, justName, justAuthor, justLog, repopatchinfo, RepoPatchInfo, humanFriendly, toXml, piDate, setPiDate, piDateString, piDateBytestring, piName, piRename, piAuthor, piTag, piLog,- showPatchInfo, isTag+ showPatchInfo, isTag, readPatchInfos, escapeXML ) where-import Text.Html hiding (name, text)+import Text.Html hiding (name, text, option) import System.Random ( randomRIO ) import Numeric ( showHex )-import Control.Monad ( when )+import Control.Monad ( when, unless ) -import ByteStringUtils-import qualified Data.ByteString as B (length, splitAt, null, drop+import ByteStringUtils ( unlinesPS, packStringToUTF8, unpackPSFromUTF8, decodeLocale)+import qualified Darcs.Patch.ReadMonads as RM ( take )+import Darcs.Patch.ReadMonads as RM ( skipSpace, char,+ takeTill, anyChar, ParserM,+ option, parseStrictly,+ takeTillChar,+ linesStartingWithEndingWith)+import qualified Data.ByteString as B (length, splitAt, null ,isPrefixOf, tail, concat ,empty, head, cons, append ,ByteString )-import qualified Data.ByteString.Char8 as BC (index, head, unpack, pack, break)+import qualified Data.ByteString.Char8 as BC (index, head, unpack, pack) import Data.List( isPrefixOf ) import Printer ( renderString, Doc, packedString,@@ -86,8 +92,8 @@ do x <- randomRIO (0,2^(128 ::Integer) :: Integer) when (_piLog pinf /= ignoreJunk (_piLog pinf)) $ do putStrLn "Lines beginning with 'Ignore-this: ' will be ignored."- yorn <- promptYorn "Proceed? "- when (yorn == 'n') $ fail "User cancelled because of Ignore-this."+ confirmed <- promptYorn "Proceed? "+ unless confirmed $ fail "User cancelled because of Ignore-this." return $ pinf { _piLog = BC.pack (head ignored++showHex x ""): _piLog pinf } @@ -200,7 +206,7 @@ <+> text "date='" <> escapeXMLByteString (_piDate pi) <> text "'" <+> text "local_date='" <> escapeXML (friendlyD $ _piDate pi) <> text "'" <+> text "inverted='" <> text (show $ isInverted pi) <> text "'"- <+> text "hash='" <> text (makeFilename pi) <> text "'>"+ <+> text "hash='" <> text (makePatchname pi) <> text "'>" $$ prefix "\t" ( text "<name>" <> escapeXMLByteString (_piName pi) <> text "</name>" $$ commentsAsXml (_piLog pi))@@ -249,11 +255,23 @@ makeAltFilename pi@(PatchInfo { isInverted = True}) = makeAltFilename (pi { isInverted = False }) ++ "-inverted" --- This makes darcs-1 (non-hashed repos) filenames, and is also generally used in both in--- hashed and non-hashed repo code for making patch "hashes"+-- | This makes darcs-1 (non-hashed repos) filenames, and is also generally+-- used in both in hashed and non-hashed repo code for making patch "hashes".+--+-- The name consists of three segments:+--+-- * timestamp (ISO8601-compatible yyyymmmddHHMMSS, UTC)+--+-- * SHA1 hash of the author+--+-- * SHA1 hash of the patch name, author, date, log, and \"inverted\"+-- flag. makeFilename :: PatchInfo -> String-makeFilename pi =- showIsoDateTime d++"-"++sha1_a++"-"++sha1PS sha1_me++".gz"+makeFilename pi = makePatchname pi ++ ".gz"++makePatchname :: PatchInfo -> String+makePatchname pi =+ showIsoDateTime d++"-"++sha1_a++"-"++sha1PS sha1_me where b2ps True = BC.pack "t" b2ps False = BC.pack "f" sha1_me = B.concat [_piName pi,@@ -326,49 +344,29 @@ where mul [] = text "\n" mul (s:ss) = text "\n " <> packedString s <> mul ss ------ Note, Data.ByteString rewrites break ((==) x) into the memchr-based--- breakByte. For this rule to fire, we keep it in prefix application form-----readPatchInfo :: B.ByteString -> Maybe (PatchInfo, B.ByteString)-readPatchInfo s | B.null (dropSpace s) = Nothing-readPatchInfo s =- if BC.head (dropSpace s) /= '[' -- ]- then Nothing- else case BC.break ((==) '\n') $ B.tail $ dropSpace s of- (name,s') ->- case BC.break ((==) '*') $ B.tail s' of- (author,s2) ->- case BC.break (\c->c==']'||c=='\n') $ B.drop 2 s2 of- (ct,s''') ->- do (log, s4) <- linesStartingWithEndingWith ' ' ']' $ dn s'''- return $ (PatchInfo { _piDate = ct- , _piName = name- , _piAuthor = author- , _piLog = log- , isInverted = BC.index s2 1 /= '*'- }, s4)- where dn x = if B.null x || BC.head x /= '\n' then x else B.tail x+readPatchInfo :: ParserM m => m (PatchInfo)+readPatchInfo = do+ skipSpace+ char '['+ name <- takeTillChar '\n'+ _ <- anyChar+ author <- takeTillChar '*'+ s2 <- RM.take 2+ ct <- takeTill (\c->c==']'||c=='\n')+ option () (char '\n' >> return ()) -- consume newline char, if present+ log <- linesStartingWithEndingWith ' ' ']'+ return $ PatchInfo { _piDate = ct+ , _piName = name+ , _piAuthor = author+ , _piLog = log+ , isInverted = BC.index s2 1 /= '*'+ } -linesStartingWithEndingWith :: Char -> Char -> B.ByteString- -> Maybe ([B.ByteString],B.ByteString)-linesStartingWithEndingWith st en s = lswew s- where- lswew x | B.null x = Nothing- lswew x =- if BC.head x == en- then Just ([], B.tail x)- else if BC.head x /= st- then Nothing- else case BC.break ((==) '\n') $ B.tail x of- (l,r) -> case lswew $ B.tail r of- Just (ls,r') -> Just (l:ls,r')- Nothing ->- case breakLastPS en l of- Just (l2,_) ->- Just ([l2], B.drop (B.length l2+2) x)- Nothing -> Nothing+readPatchInfos :: B.ByteString -> [PatchInfo]+readPatchInfos inv | B.null inv = []+readPatchInfos inv = case parseStrictly readPatchInfo inv of+ Just (pinfo,r) -> pinfo : readPatchInfos r+ _ -> [] htmlPatchInfo :: RepoPatchInfo -> Html htmlPatchInfo (RPI r pi) =
+ src/Darcs/Patch/Inspect.hs view
@@ -0,0 +1,24 @@+module Darcs.Patch.Inspect+ ( PatchInspect(..)+ )+ where++import Darcs.Witnesses.Ordered ( FL, RL, reverseRL, mapFL )++import qualified Data.ByteString.Char8 as BC+import Data.List ( nub )++#include "gadts.h"++class PatchInspect p where+ listTouchedFiles :: p C(x y) -> [FilePath]+ hunkMatches :: (BC.ByteString -> Bool) -> p C(x y) -> Bool++instance PatchInspect p => PatchInspect (FL p) where+ listTouchedFiles xs = nub $ concat $ mapFL listTouchedFiles xs+ hunkMatches f = or . mapFL (hunkMatches f)++instance PatchInspect p => PatchInspect (RL p) where+ listTouchedFiles = listTouchedFiles . reverseRL+ hunkMatches f = hunkMatches f . reverseRL+
+ src/Darcs/Patch/Invert.hs view
@@ -0,0 +1,19 @@+module Darcs.Patch.Invert+ ( Invert(..), invertFL, invertRL+ )+ where++import Darcs.Witnesses.Ordered ( FL(..), RL(..) )++#include "gadts.h"++class Invert p where+ invert :: p C(x y) -> p C(y x)++invertFL :: Invert p => FL p C(x y) -> RL p C(y x)+invertFL NilFL = NilRL+invertFL (x:>:xs) = invert x :<: invertFL xs++invertRL :: Invert p => RL p C(x y) -> FL p C(y x)+invertRL NilRL = NilFL+invertRL (x:<:xs) = invert x :>: invertRL xs
+ src/Darcs/Patch/Match.hs view
@@ -0,0 +1,228 @@+-- Copyright (C) 2004 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.++#include "gadts.h"++module Darcs.Patch.Match ( PatchMatch, Matcher, MatchFun,+ patchMatch, matchPattern,+ applyMatcher, makeMatcher,+ parseMatch,+ matchParser, helpOnMatchers,+ ) where++import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec.Expr+import Text.Regex ( mkRegex, matchRegex )+import Data.Maybe ( isJust )+import System.IO.Unsafe ( unsafePerformIO )++import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, hopefully, info )+import Darcs.Patch ( Patchy, hunkMatches, listTouchedFiles, patchcontents )+import Darcs.Patch.Info ( justName, justAuthor, justLog, makeFilename,+ piDate )+import Darcs.Witnesses.Sealed ( Sealed2(..), seal2 )+import DateMatcher ( parseDateMatcher )++import Darcs.Patch.MatchData ( PatchMatch(..), patchMatch )+import qualified Data.ByteString.Char8 as BC++import Darcs.Patch.Dummy ( DummyPatch )++-- | A type for predicates over patches which do not care about+-- contexts+type MatchFun p = Sealed2 (PatchInfoAnd p) -> Bool++-- | A @Matcher@ is made of a 'MatchFun' which we will use to match+-- patches and a @String@ representing it.+data Matcher p = MATCH String (MatchFun p)++instance Show (Matcher p) where+ show (MATCH s _) = '"':s ++ "\""++makeMatcher :: String -> (Sealed2 (PatchInfoAnd p) -> Bool) -> Matcher p+makeMatcher s m = MATCH s m++-- | @applyMatcher@ applies a matcher to a patch.+applyMatcher :: Matcher p -> PatchInfoAnd p C(x y) -> Bool+applyMatcher (MATCH _ m) = m . seal2++parseMatch :: Patchy p => PatchMatch -> Either String (MatchFun p)+parseMatch (PatternMatch s) =+ case parse matchParser "match" s of+ Left err -> Left $ "Invalid -"++"-match pattern '"++s+++ "'.\n"++ unlines (map (" "++) $ lines $ show err) -- indent+ Right m -> Right m++matchPattern :: Patchy p => PatchMatch -> Matcher p+matchPattern p@(PatternMatch s) =+ case parseMatch p of+ Left err -> error err+ Right m -> makeMatcher s m++trivial :: Patchy p => MatchFun p+trivial = const True++matchParser :: Patchy p => CharParser st (MatchFun p)+matchParser = do m <- option trivial submatch+ eof+ return m++submatch :: Patchy p => CharParser st (MatchFun p)+submatch = buildExpressionParser table match <?> "match rule"++table :: OperatorTable Char st (MatchFun p)+table = [ [prefix "not" negate_match,+ prefix "!" negate_match ]+ , [binary "||" or_match,+ binary "or" or_match,+ binary "&&" and_match,+ binary "and" and_match ]+ ]+ where binary name fun =+ Infix (do _ <- trystring name+ spaces+ return fun) AssocLeft+ prefix name fun = Prefix $ do _ <- trystring name+ spaces+ return fun+ negate_match a p = not (a p)+ or_match m1 m2 p = (m1 p) || (m2 p)+ and_match m1 m2 p = (m1 p) && (m2 p)++trystring :: String -> CharParser st String+trystring s = try $ string s++match :: Patchy p => CharParser st (MatchFun p)+match = between spaces spaces+ (parens submatch+ <|> choice matchers_+ <?> "simple match")+ where matchers_ = map createMatchHelper primitiveMatchers+++createMatchHelper :: (String, String, [String], String -> MatchFun p)+ -> CharParser st (MatchFun p)+createMatchHelper (key,_,_,matcher) =+ do _ <- trystring key+ spaces+ q <- quoted+ return $ matcher q++-- FIXME: would this be better defined in Darcs.Commands.Help?+-- | The string that is emitted when the user runs @darcs help --match@.+helpOnMatchers :: String+helpOnMatchers = unlines $+ ["Selecting Patches:",+ "",+ "The --patches option yields patches with names matching an `extended'",+ "regular expression. See regex(7) for details. The --matches option",+ "yields patches that match a logical (Boolean) expression: one or more",+ "primitive expressions combined by grouping (parentheses) and the",+ "complement (not), conjunction (and) and disjunction (or) operators.",+ "The C notation for logic operators (!, && and ||) can also be used.",+ "",+ " --patches=regex is a synonym for --matches='name regex'",+ " --from-patch and --to-patch are synonyms for --from-match='name... and --to-match='name...",+ " --from-patch and --to-match can be unproblematically combined:",+ " darcs changes --from-patch='html.*documentation' --to-match='date 20040212'",+ "",+ "The following primitive Boolean expressions are supported:"]+ ++ keywords+ ++ ["", "Here are some examples:"]+ ++ examples+ where -- This type signature exists to appease GHC.+ ps :: [(String, String, [String], String -> MatchFun DummyPatch)]+ ps = primitiveMatchers+ keywords = [showKeyword k d | (k,d,_,_) <- ps]+ examples = [showExample k e | (k,_,es,_) <- ps, e <- es]+ showKeyword keyword description =+ -- FIXME: it would be nice to have a variable name here:+ -- "author REGEX - match against author (email address)"+ -- or "exact STRING - match against exact patch name".+ " " ++ keyword ++ " - " ++ description ++ "."+ showExample keyword example =+ -- FIXME: this string is long, and its not a use case I've+ -- ever seen in practice. Can we use something else,+ -- like "darcs changes --matches"? --twb, 2008-12-28+ " darcs annotate --summary --match "+ ++ "'" ++ keyword ++ " " ++ example ++ "'"++primitiveMatchers :: Patchy p => [(String, String, [String], String -> MatchFun p)]+ -- ^ keyword (operator), help description, list+ -- of examples, matcher function+primitiveMatchers =+ [ ("exact", "check a literal string against the patch name"+ , ["\"Resolve issue17: use dynamic memory allocation.\""]+ , exactmatch )+ , ("name", "check a regular expression against the patch name"+ , ["issue17", "\"^[Rr]esolve issue17\\>\""]+ , mymatch )+ , ("author", "check a regular expression against the author name"+ , ["\"David Roundy\"", "droundy", "droundy@darcs.net"]+ , authormatch )+ , ("hunk", "check a regular expression against the contents of a hunk patch"+ , ["\"foo = 2\"", "\"^instance .* Foo where$\""]+ , hunkmatch )+ , ("comment", "check a regular expression against the log message"+ , ["\"prevent deadlocks\""]+ , logmatch )+ , ("hash", "match the darcs hash for a patch"+ , ["20040403105958-53a90-c719567e92c3b0ab9eddd5290b705712b8b918ef"]+ , hashmatch )+ , ("date", "match the patch date"+ , ["\"2006-04-02 22:41\"", "\"tea time yesterday\""]+ , datematch )+ , ("touch", "match file paths for a patch"+ , ["src/foo.c", "src/", "\"src/*.(c|h)\""]+ , touchmatch ) ]++parens :: CharParser st (MatchFun p)+ -> CharParser st (MatchFun p)+parens p = between (string "(") (string ")") p++quoted :: CharParser st String+quoted = between (char '"') (char '"')+ (many $ do { _ <- char '\\' -- allow escapes+ ; try (oneOf ['\\', '"']) <|> return '\\'+ }+ <|> noneOf ['"'])+ <|> between spaces spaces (many $ noneOf " ()")+ <?> "string"++mymatch, exactmatch, authormatch, hunkmatch, hashmatch, datematch, touchmatch :: Patchy p => String -> MatchFun p++mymatch r (Sealed2 hp) = isJust $ matchRegex (mkRegex r) $ justName (info hp)++exactmatch r (Sealed2 hp) = r == (justName (info hp))++authormatch a (Sealed2 hp) = isJust $ matchRegex (mkRegex a) $ justAuthor (info hp)++logmatch :: Patchy p => String -> MatchFun p+logmatch l (Sealed2 hp) = isJust $ matchRegex (mkRegex l) $ justLog (info hp)++hunkmatch r (Sealed2 hp) = let patch = patchcontents $ hopefully hp+ regexMatcher = isJust . (matchRegex (mkRegex r) . BC.unpack)+ in hunkMatches regexMatcher patch++hashmatch h (Sealed2 hp) = let rh = makeFilename (info hp) in+ (rh == h) || (rh == h++".gz")++datematch d (Sealed2 hp) = let dm = unsafePerformIO $ parseDateMatcher d+ in dm $ piDate (info hp)++touchmatch r (Sealed2 hp) = let files = listTouchedFiles $ patchcontents $ hopefully hp+ in or $ map (isJust . matchRegex (mkRegex r)) files
− src/Darcs/Patch/Match.lhs
@@ -1,372 +0,0 @@-% Copyright (C) 2004 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.--\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--#include "gadts.h"--module Darcs.Patch.Match ( PatchMatch, Matcher, MatchFun,- patchMatch, matchPattern,- applyMatcher, makeMatcher,- parseMatch,- matchParser, helpOnMatchers,- ) where--import Text.ParserCombinators.Parsec-import Text.ParserCombinators.Parsec.Expr-import Text.Regex ( mkRegex, matchRegex )-import Data.Maybe ( isJust )-import System.IO.Unsafe ( unsafePerformIO )--import Darcs.Hopefully ( PatchInfoAnd, hopefully, info )-import Darcs.Patch ( Patch, Patchy, hunkMatches, listTouchedFiles, patchcontents )-import Darcs.Patch.Info ( justName, justAuthor, justLog, makeFilename,- piDate )-import Darcs.Witnesses.Sealed ( Sealed2(..), seal2 )-import DateMatcher ( parseDateMatcher )--import Darcs.Patch.MatchData ( PatchMatch(..), patchMatch )-import qualified Data.ByteString.Char8 as BC---- | A type for predicates over patches which do not care about--- contexts-type MatchFun p = Sealed2 (PatchInfoAnd p) -> Bool---- | A @Matcher@ is made of a 'MatchFun' which we will use to match--- patches and a @String@ representing it.-data Matcher p = MATCH String (MatchFun p)--instance Show (Matcher p) where- show (MATCH s _) = '"':s ++ "\""--makeMatcher :: String -> (Sealed2 (PatchInfoAnd p) -> Bool) -> Matcher p-makeMatcher s m = MATCH s m---- | @applyMatcher@ applies a matcher to a patch.-applyMatcher :: Matcher p -> PatchInfoAnd p C(x y) -> Bool-applyMatcher (MATCH _ m) = m . seal2--parseMatch :: Patchy p => PatchMatch -> Either String (MatchFun p)-parseMatch (PatternMatch s) =- case parse matchParser "match" s of- Left err -> Left $ "Invalid -"++"-match pattern '"++s++- "'.\n"++ unlines (map (" "++) $ lines $ show err) -- indent- Right m -> Right m--matchPattern :: Patchy p => PatchMatch -> Matcher p-matchPattern p@(PatternMatch s) =- case parseMatch p of- Left err -> error err- Right m -> makeMatcher s m--trivial :: Patchy p => MatchFun p-trivial = const True-\end{code}--\subsection{Match}--Currently \verb!--match! accepts eight primitive match types, although-there are plans to expand it to match more patterns. Also, note that the-syntax is still preliminary and subject to change.--The first match type accepts a literal string which is checked against-the patch name. The syntax is-\begin{verbatim}-darcs annotate --summary --match 'exact foo+bar'-\end{verbatim}-This is useful for situations where a patch name contains characters that-could be considered special for regular expressions.--In this and the other match types, the argument must be enclosed in double-quotes if it contains spaces. You can escape a quote in the argument with a-backslash; backslash escapes itself, but it is treated literally if followed-by a character other than a double quote or backslash, so it is typically not-necessary to escape a backslash. No such escaping is necessary unless the-argument is enclosed in double quotes.--The second match type accepts a regular expression which is checked against-the patch name. The syntax is-\begin{verbatim}-darcs annotate --summary --match 'name foo'-\end{verbatim}-Note that to match regexp metacharacters, such as \verb|(|, literally, they-must be escaped with backslash along with any embedded double quotes. To-match a literal backslash it must be written quadrupled in general, but often-it need not be escaped, since backslash is only special in regexps when-followed by a metacharacter. In the following example pairs, the first-literal is matched by the second sequence in the match name:-``\verb|"|'':``\verb|\"|'', ``\verb|\|'':``\verb|\\\\|'',-``\verb|\x|'':``\verb|\x|'', ``\verb|(|'':``\verb|\(|''.--The third match type matches the darcs hash for each patch:-\begin{verbatim}-darcs annotate --summary --match \- 'hash 20040403105958-53a90-c719567e92c3b0ab9eddd5290b705712b8b918ef'-\end{verbatim}-Note you need to provide the full hash string as above.-This is intended to be used, for example, by programs allowing you to view-darcs repositories (e.g.\ CGI scripts like viewCVS).--The fourth match type accepts a regular expression which is checked against-the patch author. The syntax is-\begin{verbatim}-darcs annotate --summary --match 'author foo'-\end{verbatim}--There is also support for matching by date. This is done using commands such as-\begin{verbatim}-darcs annotate --summary --match 'date "last week"'-darcs annotate --summary --match 'date yesterday'-darcs annotate --summary --match 'date "today 14:00"'-darcs annotate --summary --match 'date "tea time yesterday"'-darcs annotate --summary --match 'date "3 days before last year at 17:00"'-darcs changes --from-match 'date "Sat Jun 30 11:31:30 EDT 2004"'-\end{verbatim}--Only English date specifications are supported---specifically you must use-English day and month names. Also, only a limited set of time zones is-supported (compatible with GNU coreutils' date parsing). Unrecognized zones-are treated as UTC, which may result in the timestamps printed in change-entries not being recognized by the date matching. You can avoid this problem-on a POSIX-like system by running darcs in the UTC zone to get the times-initially, e.g.:-\begin{verbatim}-TZ=UTC darcs changes-\end{verbatim}--When matching on the ISO format, a partial date is treated as a range.-English dates can either refer to a specific day (``6 months ago',``day before-yesterday''), or to an interval-from some past date (``last month'') to the present. Putting this all-together, if today is ``2004-07-24'' then the following matches should work:--\begin{tabular}{|ll|}-\hline-\textbf{date} & \textbf{patches selected} \\-\hline-2004 & from 2004-01-01 up to and including 2004-12-31 \\-2004-01 & from 2004-01-01 up to and including 2004-01-31 \\-2004-01-01 & during 2004-01-01 \\-\hline-today & during 2004-07-24 (starting midnight in your timezone) \\-yesterday & during 2004-07-23 \\-6 months ago & during 2004-01-23 \\-\hline-last 6 months & since 2004-01-23 \\-last month & since 2004-06-23 (not 2004-06-01!) \\-last week & since 2004-07-16 \\-\hline-\end{tabular}--For more precise control, you may specify an interval, either-in a small subset of English or-of \htmladdnormallinkfoot{the ISO 8601 format}{http://www.w3.org/TR/NOTE-datetime}.-If you use the ISO format, note that durations, when-specified alone, are interpreted as being relative to the current date and time.-\begin{verbatim}-darcs annotate --summary --match 'date "between 2004-03-12 and last week"'-darcs annotate --summary --match 'date "after 2005"'-darcs annotate --summary --match 'date "in the last 3 weeks"'-darcs annotate --summary --match 'date "P3M/2006-03-17"'-darcs annotate --summary --match 'date "2004-01-02/2006-03-17"'-darcs annotate --summary --match 'date "P2M6D"'-\end{verbatim}--You may also prefer to combine date matching with a more specific pattern.-\begin{verbatim}-darcs annotate --summary --match 'date "last week" && name foo'-\end{verbatim}--The sixth match type accepts a regular expression which is checked against-file paths that the patch touches. The syntax is-\begin{verbatim}-darcs annotate --summary --match 'touch foo/bar.c'-\end{verbatim}--The seventh match type accepts a regular expression which is checked-against every hunk. The syntax is-\begin{verbatim}-darcs annotate --summary --match 'hunk "^instance .* Foo where$"'-\end{verbatim}--The eight match type accepts a regular expression which is checked-against the long comment. The syntax is-\begin{verbatim}-darcs annotate --summary --match 'comment "remote repository"'-\end{verbatim}--The \verb!--match! pattern can include the logical operators \verb!&&!,-\verb!||! and \verb!not!, as well as grouping of patterns with parentheses.-For example-\begin{verbatim}-darcs annotate --summary --match 'name record && not name overrode'-\end{verbatim}--\begin{code}-matchParser :: Patchy p => CharParser st (MatchFun p)-matchParser = do m <- option trivial submatch- eof- return m--submatch :: Patchy p => CharParser st (MatchFun p)-submatch = buildExpressionParser table match <?> "match rule"--table :: OperatorTable Char st (MatchFun p)-table = [ [prefix "not" negate_match,- prefix "!" negate_match ]- , [binary "||" or_match,- binary "or" or_match,- binary "&&" and_match,- binary "and" and_match ]- ]- where binary name fun =- Infix (do trystring name- spaces- return fun) AssocLeft- prefix name fun = Prefix $ do trystring name- spaces- return fun- negate_match a p = not (a p)- or_match m1 m2 p = (m1 p) || (m2 p)- and_match m1 m2 p = (m1 p) && (m2 p)--trystring :: String -> CharParser st String-trystring s = try $ string s--match :: Patchy p => CharParser st (MatchFun p)-match = between spaces spaces- (parens submatch- <|> choice matchers_- <?> "simple match")- where matchers_ = map createMatchHelper primitiveMatchers---createMatchHelper :: (String, String, [String], String -> MatchFun p)- -> CharParser st (MatchFun p)-createMatchHelper (key,_,_,matcher) =- do trystring key- spaces- q <- quoted- return $ matcher q---- FIXME: would this be better defined in Darcs.Commands.Help?--- | The string that is emitted when the user runs @darcs help --match@.-helpOnMatchers :: String-helpOnMatchers = unlines $- ["Selecting Patches:",- "",- "The --patches option yields patches with names matching an `extended'",- "regular expression. See regex(7) for details. The --matches option",- "yields patches that match a logical (Boolean) expression: one or more",- "primitive expressions combined by grouping (parentheses) and the",- "complement (not), conjunction (and) and disjunction (or) operators.",- "The C notation for logic operators (!, && and ||) can also be used.",- "",- " --patches=regex is a synonym for --matches='name regex'",- " --from-patch and --to-patch are synonyms for --from-match='name... and --to-match='name...",- " --from-patch and --to-match can be unproblematically combined:",- " darcs changes --from-patch='html.*documentation' --to-match='date 20040212'",- "",- "The following primitive Boolean expressions are supported:"]- ++ keywords- ++ ["", "Here are some examples:"]- ++ examples- where -- This type signature exists to appease GHC.- ps :: [(String, String, [String], String -> MatchFun Patch)]- ps = primitiveMatchers- keywords = [showKeyword k d | (k,d,_,_) <- ps]- examples = [showExample k e | (k,_,es,_) <- ps, e <- es]- showKeyword keyword description =- -- FIXME: it would be nice to have a variable name here:- -- "author REGEX - match against author (email address)"- -- or "exact STRING - match against exact patch name".- " " ++ keyword ++ " - " ++ description ++ "."- showExample keyword example =- -- FIXME: this string is long, and its not a use case I've- -- ever seen in practice. Can we use something else,- -- like "darcs changes --matches"? --twb, 2008-12-28- " darcs annotate --summary --match "- ++ "'" ++ keyword ++ " " ++ example ++ "'"--primitiveMatchers :: Patchy p => [(String, String, [String], String -> MatchFun p)]- -- ^ keyword (operator), help description, list- -- of examples, matcher function-primitiveMatchers =- [ ("exact", "check a literal string against the patch name"- , ["\"Resolve issue17: use dynamic memory allocation.\""]- , exactmatch )- , ("name", "check a regular expression against the patch name"- , ["issue17", "\"^[Rr]esolve issue17\\>\""]- , mymatch )- , ("author", "check a regular expression against the author name"- , ["\"David Roundy\"", "droundy", "droundy@darcs.net"]- , authormatch )- , ("hunk", "check a regular expression against the contents of a hunk patch"- , ["\"foo = 2\"", "\"^instance .* Foo where$\""]- , hunkmatch )- , ("comment", "check a regular expression against the log message"- , ["\"prevent deadlocks\""]- , logmatch )- , ("hash", "match the darcs hash for a patch"- , ["20040403105958-53a90-c719567e92c3b0ab9eddd5290b705712b8b918ef"]- , hashmatch )- , ("date", "match the patch date"- , ["\"2006-04-02 22:41\"", "\"tea time yesterday\""]- , datematch )- , ("touch", "match file paths for a patch"- , ["src/foo.c", "src/", "\"src/*.(c|h)\""]- , touchmatch ) ]--parens :: CharParser st (MatchFun p)- -> CharParser st (MatchFun p)-parens p = between (string "(") (string ")") p--quoted :: CharParser st String-quoted = between (char '"') (char '"')- (many $ do { char '\\' -- allow escapes- ; try (oneOf ['\\', '"']) <|> return '\\'- }- <|> noneOf ['"'])- <|> between spaces spaces (many $ noneOf " ()")- <?> "string"--mymatch, exactmatch, authormatch, hunkmatch, hashmatch, datematch, touchmatch :: Patchy p => String -> MatchFun p--mymatch r (Sealed2 hp) = isJust $ matchRegex (mkRegex r) $ justName (info hp)--exactmatch r (Sealed2 hp) = r == (justName (info hp))--authormatch a (Sealed2 hp) = isJust $ matchRegex (mkRegex a) $ justAuthor (info hp)--logmatch :: Patchy p => String -> MatchFun p-logmatch l (Sealed2 hp) = isJust $ matchRegex (mkRegex l) $ justLog (info hp)--hunkmatch r (Sealed2 hp) = let patch = patchcontents $ hopefully hp- regexMatcher = isJust . (matchRegex (mkRegex r) . BC.unpack)- in hunkMatches regexMatcher patch--hashmatch h (Sealed2 hp) = let rh = makeFilename (info hp) in- (rh == h) || (rh == h++".gz")--datematch d (Sealed2 hp) = let dm = unsafePerformIO $ parseDateMatcher d- in dm $ piDate (info hp)--touchmatch r (Sealed2 hp) = let files = listTouchedFiles $ patchcontents $ hopefully hp- in or $ map (isJust . matchRegex (mkRegex r)) files-\end{code}
+ src/Darcs/Patch/Merge.hs view
@@ -0,0 +1,36 @@+module Darcs.Patch.Merge+ ( Merge(..), mergeFL )+ where++import Darcs.Patch.Commute ( Commute )++import Darcs.Witnesses.Ordered ( (:\/:)(..), (:/\:)(..),+ FL(..), RL,+ reverseFL, reverseRL+ )++import Data.Maybe ( fromJust )++#include "gadts.h"++-- | Things that can always be merged+class Commute p => Merge p where+ merge :: (p :\/: p) C(x y) -> (p :/\: p) C(x y)++instance Merge p => Merge (FL p) where+ merge (NilFL :\/: x) = x :/\: NilFL+ merge (x :\/: NilFL) = NilFL :/\: x+ merge ((x:>:xs) :\/: ys) = fromJust $ do ys' :/\: x' <- return $ mergeFL (x :\/: ys)+ xs' :/\: ys'' <- return $ merge (ys' :\/: xs)+ return (ys'' :/\: (x' :>: xs'))++mergeFL :: Merge p => (p :\/: FL p) C(x y) -> (FL p :/\: p) C(x y)+mergeFL (p :\/: NilFL) = NilFL :/\: p+mergeFL (p :\/: (x :>: xs)) = fromJust $ do x' :/\: p' <- return $ merge (p :\/: x)+ xs' :/\: p'' <- return $ mergeFL (p' :\/: xs)+ return ((x' :>: xs') :/\: p'')++instance Merge p => Merge (RL p) where+ merge (x :\/: y) = case merge (reverseRL x :\/: reverseRL y) of+ (ry' :/\: rx') -> reverseFL ry' :/\: reverseFL rx'+
+ src/Darcs/Patch/Named.hs view
@@ -0,0 +1,196 @@+-- Copyright (C) 2002-2003 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.++{-# LANGUAGE CPP #-}++#include "gadts.h"++module Darcs.Patch.Named+ ( Named(..),+ infopatch,+ adddeps, namepatch, anonymous,+ getdeps,+ patch2patchinfo, patchname, patchcontents,+ fmapNamed, fmapFL_Named+ )+ where++import Prelude hiding ( pi )+import Darcs.Patch.Conflict ( Conflict(..), CommuteNoConflicts )+import Darcs.Patch.Effect ( Effect(effect, effectRL) )+import Darcs.Patch.FileHunk ( IsHunk(..) )+import Darcs.Patch.Format ( PatchListFormat )+import Darcs.Patch.Info ( PatchInfo, readPatchInfo, showPatchInfo, patchinfo,+ humanFriendly, makePatchname, invertName )+import Darcs.Patch.Merge ( Merge(..) )+import Darcs.Patch.Patchy ( Patchy, Commute(..), Invert(..), Apply(..),+ PatchInspect(..), ReadPatch(..) )+import Darcs.Patch.Prim ( PrimOf, PrimPatchBase )+import Darcs.Patch.ReadMonads ( ParserM, option, lexChar,+ choice, skipWhile, anyChar )+import Darcs.Patch.Repair ( mapMaybeSnd, Repair(..), RepairToFL, Check(..) )+import Darcs.Patch.Show ( ShowPatchBasic(..), ShowPatch(..), showNamedPrefix )+import Darcs.Patch.Summary ( plainSummary )+import Darcs.Patch.Viewing () -- for ShowPatch FL instances++import Darcs.Witnesses.Eq ( MyEq(..) )+import Darcs.Witnesses.Ordered ( (:>)(..), (:\/:)(..), (:/\:)(..), FL, mapFL, mapFL_FL )+import Darcs.Witnesses.Sealed ( Sealed, mapSeal )+import Darcs.Witnesses.Show ( ShowDict(..), Show1(..), Show2(..) )++import Printer ( renderString, ($$), (<+>), (<>), prefix, text, vcat )++-- | The @Named@ type adds a patch info about a patch, that is a name.+data Named p C(x y) where+ NamedP :: !PatchInfo+ -> ![PatchInfo]+ -> !(FL p C(x y))+ -> Named p C(x y)+-- ^ @NamedP info deps p@ represents patch @p@ with name+-- @info@. @deps@ is a list of dependencies added at the named patch+-- level, compared with the unnamed level (ie, dependencies added with+-- @darcs record --ask-deps@).++instance PrimPatchBase p => PrimPatchBase (Named p) where+ type PrimOf (Named p) = PrimOf p++instance Effect p => Effect (Named p) where+ effect (NamedP _ _ p) = effect p+ effectRL (NamedP _ _ p) = effectRL p++instance IsHunk (Named p) where+ isHunk _ = Nothing++instance PatchListFormat (Named p)++instance (ReadPatch p, PatchListFormat p) => ReadPatch (Named p) where+ readPatch' = readNamed++readNamed :: (ReadPatch p, PatchListFormat p, ParserM m) => m (Sealed (Named p C(x )))+readNamed+ = do n <- readPatchInfo+ d <- readDepends+ p <- readPatch'+ return $ (NamedP n d) `mapSeal` p++readDepends :: ParserM m => m [PatchInfo]+readDepends =+ option [] $ do lexChar '<'+ readPis++readPis :: ParserM m => m [PatchInfo]+readPis = choice [ do pi <- readPatchInfo+ pis <- readPis+ return (pi:pis)+ , do skipWhile (/= '>')+ _ <- anyChar+ return [] ]++instance Apply p => Apply (Named p) where+ apply (NamedP _ _ p) = apply p++instance RepairToFL p => Repair (Named p) where+ applyAndTryToFix (NamedP n d p) = mapMaybeSnd (NamedP n d) `fmap` applyAndTryToFix p++infopatch :: Patchy p => PatchInfo -> FL p C(x y) -> Named p C(x y)+adddeps :: Named p C(x y) -> [PatchInfo] -> Named p C(x y)+getdeps :: Named p C(x y) -> [PatchInfo]++namepatch :: Patchy p => String -> String -> String -> [String] -> FL p C(x y) -> IO (Named p C(x y))+namepatch date name author desc p+ | '\n' `elem` name = error "Patch names cannot contain newlines."+ | otherwise = do pinf <- patchinfo date name author desc+ return $ NamedP pinf [] p++anonymous :: Patchy p => FL p C(x y) -> IO (Named p C(x y))+anonymous p = namepatch "today" "anonymous" "unknown" ["anonymous"] p++infopatch pi p = NamedP pi [] p+adddeps (NamedP pi _ p) ds = NamedP pi ds p+getdeps (NamedP _ ds _) = ds++patch2patchinfo :: Named p C(x y) -> PatchInfo+patch2patchinfo (NamedP i _ _) = i++patchname :: Named p C(x y) -> String+patchname (NamedP i _ _) = makePatchname i++patchcontents :: Named p C(x y) -> FL p C(x y)+patchcontents (NamedP _ _ p) = p++fmapNamed :: (FORALL(a b) p C(a b) -> q C(a b)) -> Named p C(x y) -> Named q C(x y)+fmapNamed f (NamedP i deps p) = NamedP i deps (mapFL_FL f p)++fmapFL_Named :: (FL p C(x y) -> FL q C(x y)) -> Named p C(x y) -> Named q C(x y)+fmapFL_Named f (NamedP i deps p) = NamedP i deps (f p)++instance (Commute p, MyEq p) => MyEq (Named p) where+ unsafeCompare (NamedP n1 d1 p1) (NamedP n2 d2 p2) =+ n1 == n2 && d1 == d2 && unsafeCompare p1 p2++instance (Commute p, Invert p) => Invert (Named p) where+ invert (NamedP n d p) = NamedP (invertName n) (map invertName d) (invert p)+++instance Commute p => Commute (Named p) where+ commute (NamedP n1 d1 p1 :> NamedP n2 d2 p2) =+ if n2 `elem` d1 || n1 `elem` d2+ then Nothing+ else do (p2' :> p1') <- commute (p1 :> p2)+ return (NamedP n2 d2 p2' :> NamedP n1 d1 p1')++instance Merge p => Merge (Named p) where+ merge (NamedP n1 d1 p1 :\/: NamedP n2 d2 p2)+ = case merge (p1 :\/: p2) of+ (p2' :/\: p1') -> NamedP n2 d2 p2' :/\: NamedP n1 d1 p1'++instance PatchInspect p => PatchInspect (Named p) where+ listTouchedFiles (NamedP _ _ p) = listTouchedFiles p+ hunkMatches f (NamedP _ _ p) = hunkMatches f p++instance (CommuteNoConflicts p, Conflict p) => Conflict (Named p) where+ listConflictedFiles (NamedP _ _ p) = listConflictedFiles p+ resolveConflicts (NamedP _ _ p) = resolveConflicts p++instance Check p => Check (Named p) where+ isInconsistent (NamedP _ _ p) = isInconsistent p++instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (Named p) where+ showPatch (NamedP n [] p) = showPatchInfo n <> showPatch p+ showPatch (NamedP n d p) = showNamedPrefix n d <+> showPatch p++instance (Apply p, CommuteNoConflicts p, Conflict p, IsHunk p, PatchListFormat p, PrimPatchBase p, ShowPatch p) => ShowPatch (Named p) where+ showContextPatch (NamedP n [] p) = showContextPatch p >>= return . (showPatchInfo n <>)+ showContextPatch (NamedP n d p) = showContextPatch p >>= return . (showNamedPrefix n d <+>)+ description (NamedP n _ _) = humanFriendly n+ summary p = description p $$ text "" $$+ prefix " " (plainSummary p) -- this isn't summary because summary does the+ -- wrong thing with (Named (FL p)) so that it can+ -- get the summary of a sequence of named patches+ -- right.+ summaryFL = vcat . mapFL summary+ showNicely p@(NamedP _ _ pt) = description p $$+ prefix " " (showNicely pt)++instance (PatchListFormat p, ShowPatch p) => Show (Named p C(x y)) where+ show = renderString . showPatch++instance (PatchListFormat p, ShowPatch p) => Show1 (Named p C(x)) where+ showDict1 = ShowDictClass++instance (PatchListFormat p, ShowPatch p) => Show2 (Named p) where+ showDict2 = ShowDictClass
− src/Darcs/Patch/Non.hs
@@ -1,202 +0,0 @@--- Copyright (C) 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.--{-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans #-}-{-# LANGUAGE CPP #-}--- , TypeOperators, GADTs, FlexibleContexts #-}--#include "gadts.h"---- |'NonPatch' and 'Non' patches are patches that store a context as a--- sequence of patches. See "Darcs.Patch.Real" for example usage.-module Darcs.Patch.Non- ( Non(..), Nonable(..), unNon,- showNon, readNon, showNons, readNons,- add, rem, addP, remP, addPs, remPs, remAddP, remAddPs, remNons,- (*>), (>*), (*>>), (>>*),- propAdjustTwice ) where--import Prelude hiding ( rem )-import Data.List ( delete )-import Control.Monad ( liftM )-import Darcs.Patch.Prim ( Prim, FromPrim(..), ToFromPrim(..), Effect(..),- showPrim, FileNameFormat(..), sortCoalesceFL )-import Darcs.Patch.Patchy-import Darcs.Patch.ReadMonads ( ParserM, lexChar )-import Darcs.Witnesses.Ordered-import Darcs.Patch.Read ( readPrim )-import Darcs.Patch.Viewing ()-import Darcs.Patch.Permutations ( removeFL, commuteWhatWeCanFL )-import Darcs.Witnesses.Show-import Darcs.Witnesses.Sealed ( Sealed(Sealed) )-import Printer ( Doc, empty, vcat, hiddenPrefix, blueText, redText, ($$) )----import Darcs.ColorPrinter ( traceDoc )---import Printer ( greenText )--showNons :: ShowPatch (FL p) => [Non p C(x)] -> Doc-showNons [] = empty-showNons xs = blueText "{{" $$ vcat (map showNon xs) $$ blueText "}}"--showNon :: ShowPatch (FL p) => Non p C(x) -> Doc-showNon (Non c p) = hiddenPrefix "|" (showPatch c)- $$ hiddenPrefix "|" (blueText ":")- $$ showPrim NewFormat p--readNons :: (ReadPatch p, ParserM m) => m [Non p C(x)]-readNons = peekfor "{{" rns (return [])- where rns = peekfor "}}" (return []) $- do Just (Sealed ps) <- readPatch' False- lexChar ':'- Just (Sealed p) <- readPrim NewFormat- (Non ps p :) `liftM` rns--readNon :: (ReadPatch p, ParserM m) => m (Maybe (Non p C(x)))-readNon = do Just (Sealed ps) <- readPatch' False- peekfor ":" (do Just (Sealed p) <- readPrim NewFormat- return $ Just $ Non ps p)- (return Nothing)--instance (Commute p, MyEq p) => Eq (Non p C(x)) where- (Non cx x) == (Non cy y) | IsEq <- cx =\/= cy,- IsEq <- x =\/= y = True- | otherwise = False---- | 'Non' stores a context with a 'Prim' patch.-data Non p C(x) where- Non :: FL p C(a x) -> Prim C(x y) -> Non p C(a)---- | Return as a list the context followed by the primitive patch.-unNon :: FromPrim p => Non p C(x) -> Sealed (FL p C(x))-unNon (Non c x) = Sealed (c +>+ fromPrim x :>: NilFL)--class Nonable p where- non :: p C(x y) -> Non p C(x)---- | 'addP' @x cy@ tries to commute @x@ past @cy@ and always returns some--- variant @cy'@. -- commutation suceeds, the variant is just--- straightforwardly the commuted versian. If commutation fails, the variant--- consists of @x@ prepended to the context of @cy@.-addP :: (Patchy p, ToFromPrim p) => p C(x y) -> Non p C(y) -> Non p C(x)-addP p n | Just n' <- p >* n = n'-addP p (Non c x) = Non (p:>:c) x---- | 'addPs' @xs cy@ commutes as many patches of @xs@ past @cy@ as--- possible, stopping at the first patch that fails to commute.--- Note the fact @xs@ is a 'RL'------ Suppose we have------ > x1 x2 x3 [c1 c2 y]------ and that in our example @c1@ fails to commute past @x1@, this--- function would commute down to------ > x1 [c1'' c2'' y''] x2' x3'------ and return @[x1 c1'' c2'' y'']@-addPs :: (Patchy p, ToFromPrim p) => RL p C(x y) -> Non p C(y) -> Non p C(x)-addPs NilRL n = n-addPs (p:<:ps) n = addPs ps $ addP p n--add :: (Effect q, Patchy p, ToFromPrim p) => q C(x y) -> Non p C(y) -> Non p C(x)-add q = addPs (mapRL_RL fromPrim $ effectRL q)---- remNons really only works right if the relevant nons are conflicting...-remNons :: (Nonable p, Effect p, Patchy p, ToFromPrim p, ShowPatch p) => [Non p C(x)] -> Non p C(x) -> Non p C(x)-remNons ns (Non c x) = case remNonHelper ns c of- NilFL :> c' -> Non c' x- _ -> Non c x--remNonHelper :: (Nonable p, Effect p, Patchy p, ToFromPrim p) => [Non p C(x)] -> FL p C(x y)- -> (FL Prim :> FL p) C(x y)-remNonHelper [] x = NilFL :> x-remNonHelper ns (c:>:cs)- | non c `elem` ns = case remNonHelper (map (addP $ invert c) $ delete (non c) ns) cs of- a :> z -> sortCoalesceFL (effect c+>+a) :> z- | otherwise = case commuteWhatWeCanFL (c :> cs) of- b :> c' :> d ->- case remNonHelper ns b of- a :> b' -> a :> (b'+>+c':>:d)-remNonHelper _ NilFL = NilFL :> NilFL--remP :: (Patchy p, ToFromPrim p) => p C(x y) -> Non p C(x) -> Maybe (Non p C(y))-remP p n | Just n' <- n *> p = Just n'-remP p (Non pc x) = do c <- removeFL p pc- return (Non c x)--remPs :: (Patchy p, ToFromPrim p) => FL p C(x y) -> Non p C(x) -> Maybe (Non p C(y))-remPs NilFL n = Just n-remPs (p:>:ps) n = remP p n >>= remPs ps--rem :: (Effect q, Patchy p, ToFromPrim p) => q C(x y) -> Non p C(x) -> Maybe (Non p C(y))-rem q = remPs (mapFL_FL fromPrim $ effect q)--remAddP :: (Patchy p, ToFromPrim p) => p C(x y) -> Non p C(y) -> Non p C(x)-remAddP p n = maybe (addP p n) id $ remP (invert p) n--remAddPs :: (Patchy p, ToFromPrim p) => RL p C(x y) -> Non p C(y) -> Non p C(x)-remAddPs NilRL n = n-remAddPs (x:<:xs) n = remAddPs xs $ remAddP x n--(*>) :: (Patchy p, ToFromPrim p) => Non p C(x) -> p C(x y) -> Maybe (Non p C(y))-n *> p = invert p >* n--(>*) :: (Patchy p, ToFromPrim p) => p C(x y) -> Non p C(y) -> Maybe (Non p C(x))-y >* (Non c x) = case commuteFLorComplain (y :> c) of- Right (c' :> y') -> do- px' :> _ <- commute (y' :> fromPrim x)- x' <- toPrim px'- return (Non c' x')- _ -> Nothing--(*>>) :: (Effect q, Patchy q, Patchy p, ToFromPrim p) => Non p C(x) -> q C(x y) -> Maybe (Non p C(y))-n *>> p = invert p >>* n--(>>*) :: (Effect q, Patchy p, ToFromPrim p) => q C(x y) -> Non p C(y) -> Maybe (Non p C(x))-q >>* nn = adj (effectRL q) nn- where adj :: (Patchy p, ToFromPrim p) => RL Prim C(x y) -> Non p C(y) -> Maybe (Non p C(x))- adj NilRL n = Just n- adj (x:<:xs) n = fromPrim x >* n >>= adj xs--propAdjustTwice :: (Patchy p, ToFromPrim p) => p C(x y) -> Non p C(y) -> Maybe Doc-propAdjustTwice p n =- do n' <- p >* n- case n' *> p of- Nothing -> Just (redText "prop_adjust_inverse 1")- Just n'' | n'' /= n -> Just (redText "prop_adjust_inverse 2")- _ -> case n *> invert p of- Nothing -> Just (redText "prop_adjust_inverse 3")- Just n'' | n'' /= n' -> Just (redText "prop_adjust_inverse 4")- _ -> case invert p >* n' of- Nothing -> Just (redText "prop_adjust_inverse 5")- Just n'' | n'' /= n -> Just (redText "prop_adjust_inverse 6")- _ -> Nothing---instance Nonable Prim where- non = Non NilFL--instance Show2 p => Show (Non p C(x)) where- showsPrec d (Non cs p) = showParen (d > appPrec) $ showString "Non " .- showsPrec2 (appPrec + 1) cs . showString " " .- showsPrec (appPrec + 1) p--instance Show2 p => Show1 (Non p) where- showDict1 = ShowDictClass--instance Patchy Prim
src/Darcs/Patch/OldDate.hs view
@@ -113,34 +113,34 @@ cvsDateTime :: Int -> CharParser a CalendarTime cvsDateTime tz = do y <- year- char '/'+ _ <- char '/' mon <- monthNum- char '/'+ _ <- char '/' d <- day- mySpaces+ _ <- mySpaces h <- hour- char ':'+ _ <- char ':' m <- minute- char ':'+ _ <- char ':' s <- second z <- option tz $ mySpaces >> zone return (CalendarTime y mon d h m s 0 Monday 0 "" z False) oldDateTime :: CharParser a CalendarTime oldDateTime = do wd <- dayName- mySpaces+ _ <- mySpaces mon <- monthName- mySpaces+ _ <- mySpaces d <- day- mySpaces+ _ <- mySpaces h <- hour- char ':'+ _ <- char ':' m <- minute- char ':'+ _ <- char ':' s <- second- mySpaces+ _ <- mySpaces z <- zone- mySpaces+ _ <- mySpaces y <- year return (CalendarTime y mon d h m s 0 wd 0 "" z False) @@ -181,7 +181,7 @@ week_date = --yyyy-Www-dd try $ do yfn <- year_ optional dash- char 'W'+ _ <- char 'W' -- offset human 'week 1' -> computer 'week 0' w' <- (\x -> x-1) `liftM` twoDigits wd <- option 1 $ do { optional dash; nDigits 1 }@@ -233,7 +233,7 @@ | digsExp > picoExp = read $ take picoExp digs | otherwise = 10 ^ (picoExp - digsExp) * (read digs) return $ \c -> c { ctPicosec = frac }- zulu = do { char 'Z'; return (\c -> c { ctTZ = 0 }) }+ zulu = do { _ <- char 'Z'; return (\c -> c { ctTZ = 0 }) } offset = do sign <- choice [ do { char '+' >> return 1 } , do { char '-' >> return (-1) } ] h <- twoDigits@@ -323,8 +323,8 @@ zone :: CharParser a Int zone = choice- [ do { char '+'; h <- hour; m <- minute; return (((h*60)+m)*60) }- , do { char '-'; h <- hour; m <- minute; return (-((h*60)+m)*60) }+ [ do { _ <- char '+'; h <- hour; m <- minute; return (((h*60)+m)*60) }+ , do { _ <- char '-'; h <- hour; m <- minute; return (-((h*60)+m)*60) } , mkZone "UTC" 0 , mkZone "UT" 0 , mkZone "GMT" 0@@ -339,12 +339,12 @@ , mkZone "CEST" 2 , mkZone "EEST" 3 -- if we don't understand it, just give a GMT answer...- , do { manyTill (oneOf $ ['a'..'z']++['A'..'Z']++[' '])+ , do { _ <- manyTill (oneOf $ ['a'..'z']++['A'..'Z']++[' ']) (lookAhead space_digit); return 0 } ] where mkZone n o = try $ do { caseString n; return (o*60*60) }- space_digit = try $ do { char ' '; oneOf ['0'..'9'] }+ space_digit = try $ do { _ <- char ' '; oneOf ['0'..'9'] } nullCalendar :: CalendarTime nullCalendar = CalendarTime 0 January 0 0 0 0 1 Sunday 0 "" 0 False
+ src/Darcs/Patch/PatchInfoAnd.hs view
@@ -0,0 +1,230 @@+-- Copyright (C) 2006 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.++{-# LANGUAGE CPP #-}++#include "gadts.h"++module Darcs.Patch.PatchInfoAnd ( Hopefully, PatchInfoAnd,+ WPatchInfo, unWPatchInfo, compareWPatchInfo,+ piap, n2pia, patchInfoAndPatch,+ fmapPIAP, fmapFL_PIAP,+ conscientiously, hopefully, info, winfo,+ hopefullyM, createHashed, extractHash,+ actually, unavailable, patchDesc ) where++import System.IO.Unsafe ( unsafeInterleaveIO )++import Darcs.SignalHandler ( catchNonSignal )+import Printer ( Doc, renderString, errorDoc, text, ($$), vcat )+import Darcs.Patch.Info ( PatchInfo, humanFriendly, justName )+import Darcs.Patch ( RepoPatch, Named, patch2patchinfo )+import Darcs.Patch.Conflict ( Conflict, CommuteNoConflicts )+import Darcs.Patch.Effect ( Effect(..) )+import Darcs.Patch.FileHunk ( IsHunk(..) )+import Darcs.Patch.Format ( PatchListFormat )+import Darcs.Patch.Merge ( Merge(..) )+import Darcs.Patch.Named ( fmapNamed, fmapFL_Named )+import Darcs.Patch.Prim ( PrimPatchBase(..) )+import Darcs.Patch.Patchy ( Patchy, ReadPatch(..), Apply(..), Invert(..),+ ShowPatch(..), Commute(..), PatchInspect(..) )+import Darcs.Patch.Repair ( Repair(..), RepairToFL )+import Darcs.Patch.Show ( ShowPatchBasic(..) )+import Darcs.Witnesses.Eq ( MyEq(..), EqCheck(..) )+import Darcs.Witnesses.Unsafe ( unsafeCoerceP )+import Darcs.Witnesses.Ordered ( (:>)(..), (:\/:)(..), (:/\:)(..), FL, mapFL )+import Darcs.Witnesses.Sealed ( Sealed(Sealed), seal, mapSeal )+import Darcs.Utils ( prettyException )++import Control.Applicative ( (<$>) )++-- | @'Hopefully' p C@ @(x y)@ is @'Either' String (p C@ @(x y))@ in a+-- form adapted to darcs patches. The @C@ @(x y)@ represents the type+-- witness for the patch that should be there. The @Hopefully@ type+-- just tells whether we expect the patch to be hashed or not, and+-- 'SimpleHopefully' does the real work of emulating+-- 'Either'. @Hopefully sh@ represents an expected unhashed patch, and+-- @Hashed hash sh@ represents an expected hashed patch with its hash.+data Hopefully a C(x y) = Hopefully (SimpleHopefully a C(x y)) | Hashed String (SimpleHopefully a C(x y))++-- | @SimpleHopefully@ is a variant of @Either String@ adapted for+-- type witnesses. @Actually@ is the equivalent of @Right@, while+-- @Unavailable@ is @Left@.+data SimpleHopefully a C(x y) = Actually (a C(x y)) | Unavailable String++-- | @'PatchInfoAnd' p C(a b)@ represents a hope we have to get a+-- patch through its info. We're not sure we have the patch, but we+-- know its info.+data PatchInfoAnd p C(a b) = PIAP !PatchInfo (Hopefully (Named p) C(a b))++instance PrimPatchBase p => PrimPatchBase (PatchInfoAnd p) where+ type PrimOf (PatchInfoAnd p) = PrimOf p++-- | @'WPatchInfo' C(a b)@ represents the info of a patch, marked with+-- the patch's witnesses.+newtype WPatchInfo C(a b) = WPatchInfo { unWPatchInfo :: PatchInfo }++-- This is actually unsafe if we ever commute patches and then compare them+-- using this function. TODO: consider adding an extra existential to WPatchInfo+-- (as with TaggedPatch in Darcs.Patch.Choices)+compareWPatchInfo :: WPatchInfo C(a b) -> WPatchInfo C(c d) -> EqCheck C((a, b) (c, d))+compareWPatchInfo (WPatchInfo x) (WPatchInfo y) = if x == y then unsafeCoerceP IsEq else NotEq++instance MyEq WPatchInfo where+ WPatchInfo x `unsafeCompare` WPatchInfo y = x == y++fmapH :: (a C(x y) -> b C(w z)) -> Hopefully a C(x y) -> Hopefully b C(w z)+fmapH f (Hopefully sh) = Hopefully (ff sh)+ where ff (Actually a) = Actually (f a)+ ff (Unavailable e) = Unavailable e+fmapH f (Hashed h sh) = Hashed h (ff sh)+ where ff (Actually a) = Actually (f a)+ ff (Unavailable e) = Unavailable e++info :: PatchInfoAnd p C(a b) -> PatchInfo+info (PIAP i _) = i++patchDesc :: forall p C(x y) . PatchInfoAnd p C(x y) -> String+patchDesc p = justName $ info p++winfo :: PatchInfoAnd p C(a b) -> WPatchInfo C(a b)+winfo (PIAP i _) = WPatchInfo i++-- | @'piap' i p@ creates a PatchInfoAnd containing p with info i.+piap :: PatchInfo -> Named p C(a b) -> PatchInfoAnd p C(a b)+piap i p = PIAP i (Hopefully $ Actually p)++-- | @n2pia@ creates a PatchInfoAnd representing a @Named@ patch.+n2pia :: Named p C(x y) -> PatchInfoAnd p C(x y)+n2pia x = patch2patchinfo x `piap` x++patchInfoAndPatch :: PatchInfo -> Hopefully (Named p) C(a b) -> PatchInfoAnd p C(a b)+patchInfoAndPatch = PIAP++fmapPIAP :: (FORALL(a b) p C(a b) -> q C(a b)) -> PatchInfoAnd p C(x y) -> PatchInfoAnd q C(x y)+fmapPIAP f (PIAP i hp) = PIAP i (fmapH (fmapNamed f) hp)++fmapFL_PIAP :: (FL p C(x y) -> FL q C(x y)) -> PatchInfoAnd p C(x y) -> PatchInfoAnd q C(x y)+fmapFL_PIAP f (PIAP i hp) = PIAP i (fmapH (fmapFL_Named f) hp)++-- | @'hopefully' hp@ tries to get a patch from a 'PatchInfoAnd'+-- value. If it fails, it outputs an error \"failed to read patch:+-- \<description of the patch>\". We get the description of the patch+-- from the info part of 'hp'+hopefully :: PatchInfoAnd p C(a b) -> Named p C(a b)+hopefully = conscientiously $ \e -> text "failed to read patch:" $$ e++-- | @'conscientiously' er hp@ tries to extract a patch from a 'PatchInfoAnd'.+-- If it fails, it applies the error handling function @er@ to a description+-- of the patch info component of @hp@.+conscientiously :: (Doc -> Doc)+ -> PatchInfoAnd p C(a b) -> Named p C(a b)+conscientiously er (PIAP pinf hp) =+ case hopefully2either hp of+ Right p -> p+ Left e -> errorDoc $ er (humanFriendly pinf $$ text e)++-- | @hopefullyM@ is a version of @hopefully@ which calls @fail@ in a+-- monad instead of erroring.+hopefullyM :: Monad m => PatchInfoAnd p C(a b) -> m (Named p C(a b))+hopefullyM (PIAP pinf hp) = case hopefully2either hp of+ Right p -> return p+ Left e -> fail $ renderString (humanFriendly pinf $$ text e)++-- Any recommendations for a nice adverb to name the below?+hopefully2either :: Hopefully a C(x y) -> Either String (a C(x y))+hopefully2either (Hopefully (Actually p)) = Right p+hopefully2either (Hashed _ (Actually p)) = Right p+hopefully2either (Hopefully (Unavailable e)) = Left e+hopefully2either (Hashed _ (Unavailable e)) = Left e++actually :: a C(x y) -> Hopefully a C(x y)+actually = Hopefully . Actually++createHashed :: String -> (String -> IO (Sealed (a C(x)))) -> IO (Sealed (Hopefully a C(x)))+createHashed h f = do mapSeal (Hashed h) `fmap` unsafeInterleaveIO (f' `catchNonSignal` handler)+ where+ f' = do Sealed x <- f h+ return (Sealed (Actually x))+ handler e = return $ seal $ Unavailable $ prettyException e++extractHash :: PatchInfoAnd p C(a b) -> Either (Named p C(a b)) String+extractHash (PIAP _ (Hashed s _)) = Right s+extractHash hp = Left $ conscientiously (\e -> text "unable to read patch:" $$ e) hp++unavailable :: String -> Hopefully a C(x y)+unavailable = Hopefully . Unavailable++instance (Commute p, MyEq p) => MyEq (PatchInfoAnd p) where+ unsafeCompare (PIAP i _) (PIAP i2 _) = i == i2++--instance Invert (p C(x y)) => Invert (PatchInfoAnd (p C(x y))) where+instance (Commute p, Invert p) => Invert (PatchInfoAnd p) where+ invert (PIAP i p) = PIAP i (invert `fmapH` p)++instance PatchListFormat (PatchInfoAnd p)++instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (PatchInfoAnd p) where+ showPatch (PIAP n p) = case hopefully2either p of+ Right x -> showPatch x+ Left _ -> humanFriendly n++instance (Apply p, Conflict p, CommuteNoConflicts p, IsHunk p, PatchListFormat p, PrimPatchBase p, ShowPatch p) => ShowPatch (PatchInfoAnd p) where+ showContextPatch (PIAP n p) = case hopefully2either p of+ Right x -> showContextPatch x+ Left _ -> return $ humanFriendly n+ description (PIAP n _) = humanFriendly n+ summary (PIAP n p) = case hopefully2either p of+ Right x -> summary x+ Left _ -> humanFriendly n+ summaryFL = vcat . mapFL summary+ showNicely (PIAP n p) = case hopefully2either p of+ Right x -> showNicely x+ Left _ -> humanFriendly n++instance Commute p => Commute (PatchInfoAnd p) where+ commute (x :> y) = do y' :> x' <- commute (hopefully x :> hopefully y)+ return $ (info y `piap` y') :> (info x `piap` x')++instance Merge p => Merge (PatchInfoAnd p) where+ merge (x :\/: y) = case merge (hopefully x :\/: hopefully y) of+ y' :/\: x' -> (info y `piap` y') :/\: (info x `piap` x')++instance PatchInspect p => PatchInspect (PatchInfoAnd p) where+ listTouchedFiles = listTouchedFiles . hopefully+ hunkMatches _ _ = error "hunkmatches not implemented for PatchInfoAnd"++instance Apply p => Apply (PatchInfoAnd p) where+ apply p = apply $ hopefully p++instance RepairToFL p => Repair (PatchInfoAnd p) where+ applyAndTryToFix p = do mp' <- applyAndTryToFix $ hopefully p+ case mp' of+ Nothing -> return Nothing+ Just (e,p') -> return $ Just (e, n2pia p')++instance (ReadPatch p, PatchListFormat p) => ReadPatch (PatchInfoAnd p) where+ readPatch' = mapSeal n2pia <$> readPatch'++instance Effect p => Effect (PatchInfoAnd p) where+ effect = effect . hopefully+ effectRL = effectRL . hopefully++instance IsHunk (PatchInfoAnd p) where+ isHunk _ = Nothing++instance RepoPatch p => Patchy (PatchInfoAnd p)
src/Darcs/Patch/Patchy.hs view
@@ -15,235 +15,24 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP #-}--- , TypeOperators, GADTs #-} #include "gadts.h" -module Darcs.Patch.Patchy ( Patchy,- Apply, apply, applyAndTryToFix, applyAndTryToFixFL,- mapMaybeSnd,- Commute(..), commuteFLorComplain, commuteRL,- commuteFL, commuteRLFL,- mergeFL, toFwdCommute, toRevCommute,- ShowPatch(..),- ReadPatch, readPatch', bracketedFL, peekfor,- Invert(..), invertFL, invertRL ) where--import Control.Monad ( liftM )-import Data.Maybe ( fromJust )-import Data.Word ( Word8 )-import Data.List ( nub )--import Storage.Hashed.Monad( TreeIO )-import Darcs.Witnesses.Sealed ( Sealed(..), Sealed2(..), seal2 )-import Darcs.Patch.ReadMonads ( ParserM, lexEof, peekInput, myLex, work, alterInput )-import Darcs.Witnesses.Ordered-import Printer ( Doc, (<>), text )-import Darcs.Lock ( writeDocBinFile, gzWriteDocFile )-import Darcs.IO ( WriteableDirectory )-import Darcs.Flags ( DarcsFlag )-import English ( plural, Noun(Noun) )--import ByteStringUtils ( ifHeadThenTail, dropSpace )-import qualified Data.ByteString.Char8 as BC (pack, ByteString)----import Darcs.ColorPrinter ( traceDoc )---import Printer ( greenText, ($$) )--class (Apply p, Commute p, ShowPatch p, ReadPatch p, Invert p) => Patchy p where--- instance (ShowPatch p, Invert p) => Patchy p where--class Apply p where- apply :: WriteableDirectory m => [DarcsFlag] -> p C(x y) -> m ()- apply _ p = do mp' <- applyAndTryToFix p- case mp' of- Nothing -> return ()- Just (e, _) -> fail $ "Unable to apply a patch: " ++ e- applyAndTryToFix :: WriteableDirectory m => p C(x y) -> m (Maybe (String, p C(x y)))- applyAndTryToFix p = do apply [] p; return Nothing- applyAndTryToFixFL :: WriteableDirectory m => p C(x y) -> m (Maybe (String, FL p C(x y)))- applyAndTryToFixFL p = mapMaybeSnd (:>:NilFL) `liftM` applyAndTryToFix p--mapMaybeSnd :: (a -> b) -> Maybe (c, a) -> Maybe (c, b)-mapMaybeSnd f (Just (a,b)) = Just (a,f b)-mapMaybeSnd _ Nothing = Nothing---- | Things that can commute.-class Commute p where- commute :: (p :> p) C(x y) -> Maybe ((p :> p) C(x y))- merge :: (p :\/: p) C(x y) -> (p :/\: p) C(x y)- listTouchedFiles :: p C(x y) -> [FilePath]- hunkMatches :: (BC.ByteString -> Bool) -> p C(x y) -> Bool---- | Swaps the ordered pair type so that commute can be--- called directly.-toFwdCommute :: (Commute p, Commute q, Monad m)- => ((p :< q) C(x y) -> m ((q :< p) C(x y)))- -> (q :> p) C(x y) -> m ((p :> q) C(x y))-toFwdCommute c (x :> y) = do x' :< y' <- c (y :< x)- return (y' :> x')---- | Swaps the ordered pair type from the order expected--- by commute to the reverse order.-toRevCommute :: (Commute p, Commute q, Monad m)- => ((p :> q) C(x y) -> m ((q :> p) C(x y)))- -> (q :< p) C(x y) -> m ((p :< q) C(x y))-toRevCommute c (x :< y) = do x' :> y' <- c (y :> x)- return (y' :< x')--class Commute p => ShowPatch p where- showPatch :: p C(x y) -> Doc- showNicely :: p C(x y) -> Doc- showNicely = showPatch- showContextPatch :: p C(x y) -> TreeIO Doc- showContextPatch p = return $ showPatch p- description :: p C(x y) -> Doc- description = showPatch- summary :: p C(x y) -> Doc- summary = showPatch- writePatch :: FilePath -> p C(x y) -> IO ()- writePatch f p = writeDocBinFile f $ showPatch p <> text "\n"- gzWritePatch :: FilePath -> p C(x y) -> IO ()- gzWritePatch f p = gzWriteDocFile f $ showPatch p <> text "\n"- thing :: p C(x y) -> String- thing _ = "patch"- things :: p C(x y) -> String- things x = plural (Noun $ thing x) ""--class ReadPatch p where- readPatch'- :: ParserM m => Bool -> m (Maybe (Sealed (p C(x ))))--class MyEq p => Invert p where- invert :: p C(x y) -> p C(y x)- identity :: p C(x x)- sloppyIdentity :: p C(x y) -> EqCheck C(x y)- sloppyIdentity p = identity =\/= p--instance Apply p => Apply (FL p) where- apply _ NilFL = return ()- apply opts (p:>:ps) = apply opts p >> apply opts ps- applyAndTryToFix NilFL = return Nothing- applyAndTryToFix (p:>:ps) = do mp <- applyAndTryToFixFL p- mps <- applyAndTryToFix ps- return $ case (mp,mps) of- (Nothing, Nothing) -> Nothing- (Just (e,p'),Nothing) -> Just (e,p'+>+ps)- (Nothing, Just (e,ps')) -> Just (e,p:>:ps')- (Just (e,p'), Just (es,ps')) ->- Just (unlines [e,es], p'+>+ps')--instance Commute p => Commute (FL p) where- commute (NilFL :> x) = Just (x :> NilFL)- commute (x :> NilFL) = Just (NilFL :> x)- commute (xs :> ys) = do ys' :> rxs' <- commuteRLFL (reverseFL xs :> ys)- return $ ys' :> reverseRL rxs'- merge (NilFL :\/: x) = x :/\: NilFL- merge (x :\/: NilFL) = NilFL :/\: x- merge ((x:>:xs) :\/: ys) = fromJust $ do ys' :/\: x' <- return $ mergeFL (x :\/: ys)- xs' :/\: ys'' <- return $ merge (ys' :\/: xs)- return (ys'' :/\: (x' :>: xs'))- listTouchedFiles xs = nub $ concat $ mapFL listTouchedFiles xs- hunkMatches f = or . mapFL (hunkMatches f)--mergeFL :: Commute p => (p :\/: FL p) C(x y) -> (FL p :/\: p) C(x y)-mergeFL (p :\/: NilFL) = NilFL :/\: p-mergeFL (p :\/: (x :>: xs)) = fromJust $ do x' :/\: p' <- return $ merge (p :\/: x)- xs' :/\: p'' <- return $ mergeFL (p' :\/: xs)- return ((x' :>: xs') :/\: p'')--commuteRLFL :: Commute p => (RL p :> FL p) C(x y) -> Maybe ((FL p :> RL p) C(x y))-commuteRLFL (NilRL :> ys) = Just (ys :> NilRL)-commuteRLFL (xs :> NilFL) = Just (NilFL :> xs)-commuteRLFL (xs :> y :>: ys) = do y' :> xs' <- commuteRL (xs :> y)- ys' :> xs'' <- commuteRLFL (xs' :> ys)- return (y' :>: ys' :> xs'')--commuteRL :: Commute p => (RL p :> p) C(x y) -> Maybe ((p :> RL p) C(x y))-commuteRL (z :<: zs :> w) = do w' :> z' <- commute (z :> w)- w'' :> zs' <- commuteRL (zs :> w')- return (w'' :> z' :<: zs')-commuteRL (NilRL :> w) = Just (w :> NilRL)--commuteFLorComplain :: Commute p => (p :> FL p) C(x y) -> Either (Sealed2 p) ((FL p :> p) C(x y))-commuteFLorComplain (p :> NilFL) = Right (NilFL :> p)-commuteFLorComplain (q :> p :>: ps) = case commute (q :> p) of- Just (p' :> q') ->- case commuteFLorComplain (q' :> ps) of- Right (ps' :> q'') -> Right (p' :>: ps' :> q'')- Left l -> Left l- Nothing -> Left $ seal2 p--commuteFL :: Commute p => (p :> FL p) C(x y) -> Maybe ((FL p :> p) C(x y))-commuteFL = either (const Nothing) Just . commuteFLorComplain--instance ReadPatch p => ReadPatch (FL p) where- readPatch' want_eof = Just `liftM` read_patches- where read_patches :: ParserM m => m (Sealed (FL p C(x )))- read_patches = do --tracePeek "starting FL read"- mp <- readPatch' False- case mp of- Just (Sealed p) -> do --tracePeek "found one patch"- Sealed ps <- read_patches- return $ Sealed (p:>:ps)- Nothing -> if want_eof- then do --tracePeek "no more patches"- unit' <- lexEof- case unit' of- () -> return $ Sealed NilFL- else do --tracePeek "no more patches"- return $ Sealed NilFL--- tracePeek x = do y <- peekInput--- traceDoc (greenText x $$ greenText (show $ sal_to_string y)) return ()--{-# INLINE bracketedFL #-}-bracketedFL :: forall p m C(x) . (ReadPatch p, ParserM m) =>- (FORALL(y) m (Maybe (Sealed (p C(y))))) -> Word8 -> Word8 -> m (Maybe (Sealed (FL p C(x))))-bracketedFL parser pre post =- peekforw pre bfl (return Nothing)- where bfl :: FORALL(z) m (Maybe (Sealed (FL p C(z))))- bfl = peekforw post (return $ Just $ Sealed NilFL)- (do Just (Sealed p) <- parser- Just (Sealed ps) <- bfl- return $ Just $ Sealed (p:>:ps))--{-# INLINE peekforw #-}-peekforw :: ParserM m => Word8 -> m a -> m a -> m a-peekforw w ifstr ifnot = do s <- peekInput- case ifHeadThenTail w $ dropSpace s of- Just s' -> alterInput (const s') >> ifstr- Nothing -> ifnot--peekforPS :: ParserM m => BC.ByteString -> m a -> m a -> m a-peekforPS ps ifstr ifnot = do s <- peekInput- case ((ps ==) . fst) `fmap` myLex s of- Just True -> work myLex >> ifstr- _ -> ifnot--{-# INLINE peekfor #-}-peekfor :: ParserM m => String -> m a -> m a -> m a-peekfor = peekforPS . BC.pack+module Darcs.Patch.Patchy+ ( Patchy,+ Apply(..), Commute(..), Invert(..),+ PatchInspect(..), ReadPatch(..),+ showPatch, ShowPatch(..)+ ) where -instance Apply p => Apply (RL p) where- apply _ NilRL = return ()- apply opts (p:<:ps) = apply opts ps >> apply opts p-instance Commute p => Commute (RL p) where- commute (xs :> ys) = do fys' :> xs' <- commuteRLFL (xs :> reverseRL ys)- return (reverseFL fys' :> xs')- merge (x :\/: y) = case merge (reverseRL x :\/: reverseRL y) of- (ry' :/\: rx') -> reverseFL ry' :/\: reverseFL rx'- listTouchedFiles = listTouchedFiles . reverseRL- hunkMatches f = hunkMatches f . reverseRL-instance ReadPatch p => ReadPatch (RL p) where- readPatch' want_eof = do Just (Sealed fl) <- readPatch' want_eof- return $ Just $ Sealed $ reverseFL fl+import Darcs.Patch.Apply ( Apply(..) )+import Darcs.Patch.Commute ( Commute(..) )+import Darcs.Patch.Invert ( Invert(..) )+import Darcs.Patch.Inspect ( PatchInspect(..) )+import Darcs.Patch.Read ( ReadPatch(..) )+import Darcs.Patch.Show ( showPatch, ShowPatch(..), ShowPatchBasic )+import Darcs.Witnesses.Eq ( MyEq ) -invertFL :: Invert p => FL p C(x y) -> RL p C(y x)-invertFL NilFL = NilRL-invertFL (x:>:xs) = invert x :<: invertFL xs+class (MyEq p, Apply p, Commute p, PatchInspect p, ShowPatch p, ReadPatch p, Invert p) => Patchy p -invertRL :: Invert p => RL p C(x y) -> FL p C(y x)-invertRL NilRL = NilFL-invertRL (x:<:xs) = invert x :>: invertRL xs
+ src/Darcs/Patch/Patchy/Instances.hs view
@@ -0,0 +1,13 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Darcs.Patch.Patchy.Instances () where++import Darcs.Patch.Format ( PatchListFormat )+import Darcs.Patch.Patchy ( Patchy )+import Darcs.Patch.Permutations ()+import Darcs.Patch.FileHunk ( IsHunk )+import Darcs.Patch.Viewing ()+import Darcs.Witnesses.Ordered ( FL, RL )++instance (IsHunk p, PatchListFormat p, Patchy p) => Patchy (FL p)+instance (IsHunk p, PatchListFormat p, Patchy p) => Patchy (RL p)
src/Darcs/Patch/Permutations.hs view
@@ -16,9 +16,8 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE CPP #-}--- , TypeOperators, PatternGuards #-} #include "gadts.h" @@ -30,17 +29,24 @@ headPermutationsFL, removeSubsequenceFL, removeSubsequenceRL, partitionConflictingFL,- CommuteFn, selfCommuter, commuterIdRL,+ CommuteFn, selfCommuter,+ commuterIdFL, commuterFLId,+ commuterIdRL ) where -import Data.Maybe ( catMaybes )-import Darcs.Patch.Patchy ( Commute, commute, commuteFLorComplain, commuteRL, Invert(..), invertFL, invertRL )-import Darcs.Witnesses.Ordered+import Data.Maybe ( mapMaybe )+import Darcs.Patch.Commute ( Commute, commute, commuteFLorComplain, commuteRL )+import Darcs.Patch.Invert ( Invert(..), invertFL, invertRL )+import Darcs.Witnesses.Eq ( MyEq(..), EqCheck(..) )+import Darcs.Witnesses.Ordered ( FL(..), RL(..), (:>)(..), (+<+)+ , reverseFL, (+>+), (:\/:)(..), lengthFL+ , lengthRL, reverseRL ) #include "impossible.h" --- |split an 'FL' into "left" and "right" lists according to a predicate, using commutation as necessary.+-- |split an 'FL' into "left" and "right" lists according to a predicate @p@, using commutation as necessary. -- If a patch does satisfy the predicate but cannot be commuted past one that does not satisfy--- the predicate, it goes in the "right" list.+-- the predicate, it goes in the "middle" list; to sum up, we have: @all p left@ and @all (not.p) right@, while+-- midddle is mixed. partitionFL :: Commute p => (FORALL(u v) p C(u v) -> Bool) -- ^predicate; if true we would like the patch in the "left" list -> FL p C(x y) -- ^input 'FL'@@ -192,7 +198,7 @@ headPermutationsFL :: Commute p => FL p C(x y) -> [(p :> FL p) C(x y)] headPermutationsFL NilFL = [] headPermutationsFL (p:>:ps) =- (p:>ps) : catMaybes (map (swapfirstFL.(p:>)) $ headPermutationsFL ps)+ (p:>ps) : mapMaybe (swapfirstFL.(p:>)) (headPermutationsFL ps) where swapfirstFL (p1:>p2:>xs) = do p2':>p1' <- commute (p1:>p2) Just $ p2':>p1':>:xs @@ -202,7 +208,7 @@ headPermutationsRL :: Commute p => RL p C(x y) -> [RL p C(x y)] headPermutationsRL NilRL = [] headPermutationsRL (p:<:ps) =- (p:<:ps) : catMaybes (map (swapfirstRL.(p:<:)) $ headPermutationsRL ps)+ (p:<:ps) : mapMaybe (swapfirstRL.(p:<:)) (headPermutationsRL ps) where swapfirstRL (p1:<:p2:<:xs) = do p1':>p2' <- commute (p2:>p1) Just $ p2':<:p1':<:xs swapfirstRL _ = Nothing@@ -218,10 +224,6 @@ instance (Invert p, Commute p) => Invert (FL p) where invert = reverseRL . invertFL- identity = NilFL- sloppyIdentity NilFL = IsEq- sloppyIdentity (x:>:xs) | IsEq <- sloppyIdentity x = sloppyIdentity xs- sloppyIdentity _ = NotEq instance (MyEq p, Commute p) => MyEq (RL p) where unsafeCompare = bug "Buggy use of unsafeCompare on RL"@@ -235,10 +237,6 @@ instance (Commute p, Invert p) => Invert (RL p) where invert = reverseFL . invertRL- identity = NilRL- sloppyIdentity NilRL = IsEq- sloppyIdentity (x:<:xs) | IsEq <- sloppyIdentity x = sloppyIdentity xs- sloppyIdentity _ = NotEq -- |CommuteFn is the basis of a general framework for building up commutation -- operations between different patch types in a generic manner. Unfortunately@@ -260,6 +258,20 @@ = do ys' :> x' <- commuterIdRL commuter (x :> ys) y' :> x'' <- commuter (x' :> y) return ((y' :<: ys') :> x'')++commuterIdFL :: CommuteFn p1 p2 -> CommuteFn p1 (FL p2)+commuterIdFL _ (x :> NilFL) = return (NilFL :> x)+commuterIdFL commuter (x :> (y :>: ys))+ = do y' :> x' <- commuter (x :> y)+ ys' :> x'' <- commuterIdFL commuter (x' :> ys)+ return ((y' :>: ys') :> x'')++commuterFLId :: CommuteFn p1 p2 -> CommuteFn (FL p1) p2+commuterFLId _ (NilFL :> y) = return (y :> NilFL)+commuterFLId commuter ((x :>: xs) :> y)+ = do y' :> xs' <- commuterFLId commuter (xs :> y)+ y'' :> x' <- commuter (x :> y')+ return (y'' :> (x' :>: xs')) -- |Partition a list into the patches that commute with the given patch and those that don't (including dependencies) partitionConflictingFL :: (Commute p1, Invert p1) => CommuteFn p1 p2 -> FL p1 C(x y) -> p2 C(x z) -> (FL p1 :> FL p1) C(x y)
+ src/Darcs/Patch/Prim.hs view
@@ -0,0 +1,28 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Darcs.Patch.Prim+ ( showPrim, showPrimFL,+ adddir, addfile, binary, changepref,+ hunk, move, rmdir, rmfile, tokreplace,+ primFromHunk,+ primIsAddfile, primIsHunk, primIsBinary, primIsSetpref,+ primIsAdddir, is_filepatch,+ canonize, tryToShrink,+ sortCoalesceFL, join, canonizeFL,+ tryShrinkingInverse,+ summarizePrim,+ applyPrimFL,+ readPrim,+ FromPrim(..), FromPrims(..), ToFromPrim(..),+ PrimPatch, PrimPatchBase(..)+ )+ where++import Darcs.Patch.Prim.Class+ ( PrimConstruct(..), PrimCanonize(..)+ , PrimClassify(..), PrimDetails(..)+ , PrimShow(..), showPrimFL, PrimRead(..)+ , PrimApply(..)+ , FromPrim(..), FromPrims(..), ToFromPrim(..)+ , PrimPatchBase(..), PrimPatch+ )+
− src/Darcs/Patch/Prim.lhs
@@ -1,1165 +0,0 @@-% Copyright (C) 2002-2003,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.--\begin{code}-{-# OPTIONS_GHC -cpp -fglasgow-exts #-}-{-# LANGUAGE CPP #-}--- , MagicHash, TypeOperators, GADTs, PatternGuards #-}--#include "gadts.h"--module Darcs.Patch.Prim- ( Prim(..), IsConflictedPrim(IsC), ConflictState(..), showPrim, showPrimFL, showHunk,- DirPatchType(..), FilePatchType(..),- CommuteFunction, Perhaps(..),- null_patch, nullP, isNullPatch,- isIdentity,- formatFileName, FileNameFormat(..),- adddir, addfile, binary, changepref,- hunk, move, rmdir, rmfile, tokreplace,- primIsAddfile, primIsHunk, primIsBinary, primIsSetpref,- isSimilar, primIsAdddir, is_filepatch,- canonize, tryToShrink, modernizePrim,- subcommutes, sortCoalesceFL, join, canonizeFL,- tryTokInternal,- tryShrinkingInverse,- nFn,- FromPrim(..), FromPrims(..), ToFromPrim(..),- Conflict(..), Effect(..), commuteNoConflictsFL, commuteNoConflictsRL- )- where--import Prelude hiding ( pi )-import Control.Monad ( MonadPlus, msum, mzero, mplus )-import Data.Maybe ( isNothing, listToMaybe, catMaybes )-import Data.Map ( elems, fromListWith, mapWithKey )--import ByteStringUtils ( substrPS, fromPS2Hex)-import qualified Data.ByteString as B (ByteString, length, null, head, take, concat, drop)-import qualified Data.ByteString.Char8 as BC (break, pack, head)--import Darcs.Patch.FileName ( FileName, fn2ps, fn2fp, fp2fn, normPath,- movedirfilename, encodeWhite )-import Darcs.Witnesses.Ordered-import Darcs.Witnesses.Sealed ( Sealed, unseal, Sealed2(..), unsafeUnseal2 )-import Darcs.Patch.Patchy ( Invert(..), Commute(..), toFwdCommute, toRevCommute )-import Darcs.Patch.Permutations () -- for Invert instance of FL-import Darcs.Witnesses.Show-import Darcs.Utils ( nubsort )-import Lcs ( getChanges )-import Darcs.Patch.RegChars ( regChars )-import Printer ( Doc, vcat, packedString, Color(Cyan,Magenta), lineColor,- text, userchunk, invisibleText, invisiblePS, blueText,- ($$), (<+>), (<>), prefix, userchunkPS,- )-import GHC.Base (unsafeCoerce#)-#include "impossible.h"--data Prim C(x y) where- Move :: !FileName -> !FileName -> Prim C(x y)- DP :: !FileName -> !(DirPatchType C(x y)) -> Prim C(x y)- FP :: !FileName -> !(FilePatchType C(x y)) -> Prim C(x y)- Split :: FL Prim C(x y) -> Prim C(x y)- Identity :: Prim C(x x)- ChangePref :: !String -> !String -> !String -> Prim C(x y)--data FilePatchType C(x y) = RmFile | AddFile- | Hunk !Int [B.ByteString] [B.ByteString]- | TokReplace !String !String !String- | Binary B.ByteString B.ByteString- deriving (Eq,Ord)--data DirPatchType C(x y) = RmDir | AddDir- deriving (Eq,Ord)--instance MyEq FilePatchType where- unsafeCompare a b = a == unsafeCoerce# b--instance MyEq DirPatchType where- unsafeCompare a b = a == unsafeCoerce# b--null_patch :: Prim C(x x)-null_patch = Identity--isNullPatch :: Prim C(x y) -> Bool-isNullPatch (FP _ (Binary x y)) = B.null x && B.null y-isNullPatch (FP _ (Hunk _ [] [])) = True-isNullPatch Identity = True-isNullPatch _ = False--nullP :: Prim C(x y) -> EqCheck C(x y)-nullP = sloppyIdentity--isIdentity :: Prim C(x y) -> EqCheck C(x y)-isIdentity (FP _ (Binary old new)) | old == new = unsafeCoerce# IsEq-isIdentity (FP _ (Hunk _ old new)) | old == new = unsafeCoerce# IsEq-isIdentity (FP _ (TokReplace _ old new)) | old == new = unsafeCoerce# IsEq-isIdentity (Move old new) | old == new = unsafeCoerce# IsEq-isIdentity Identity = IsEq-isIdentity _ = NotEq---- FIXME: The following code needs to be moved.---- | Tells you if two patches are in the same category, human-wise.--- Currently just returns true if they are filepatches on the same--- file.-isSimilar :: Prim C(x y) -> Prim C(a b) -> Bool-isSimilar (FP f _) (FP f' _) = f == f'-isSimilar (DP f _) (DP f' _) = f == f'-isSimilar _ _ = False--primIsAddfile :: Prim C(x y) -> Bool-primIsAddfile (FP _ AddFile) = True-primIsAddfile _ = False--primIsAdddir :: Prim C(x y) -> Bool-primIsAdddir (DP _ AddDir) = True-primIsAdddir _ = False--primIsHunk :: Prim C(x y) -> Bool-primIsHunk (FP _ (Hunk _ _ _)) = True-primIsHunk _ = False--primIsBinary :: Prim C(x y) -> Bool-primIsBinary (FP _ (Binary _ _)) = True-primIsBinary _ = False--primIsSetpref :: Prim C(x y) -> Bool-primIsSetpref (ChangePref _ _ _) = True-primIsSetpref _ = False--addfile :: FilePath -> Prim C(x y)-rmfile :: FilePath -> Prim C(x y)-adddir :: FilePath -> Prim C(x y)-rmdir :: FilePath -> Prim C(x y)-move :: FilePath -> FilePath -> Prim C(x y)-changepref :: String -> String -> String -> Prim C(x y)-hunk :: FilePath -> Int -> [B.ByteString] -> [B.ByteString] -> Prim C(x y)-tokreplace :: FilePath -> String -> String -> String -> Prim C(x y)-binary :: FilePath -> B.ByteString -> B.ByteString -> Prim C(x y)--evalargs :: (a -> b -> c) -> a -> b -> c-evalargs f x y = (f $! x) $! y--addfile f = FP (fp2fn $ nFn f) AddFile-rmfile f = FP (fp2fn $ nFn f) RmFile-adddir d = DP (fp2fn $ nFn d) AddDir-rmdir d = DP (fp2fn $ nFn d) RmDir-move f f' = Move (fp2fn $ nFn f) (fp2fn $ nFn f')-changepref p f t = ChangePref p f t-hunk f line old new = evalargs FP (fp2fn $ nFn f) (Hunk line old new)-tokreplace f tokchars old new =- evalargs FP (fp2fn $ nFn f) (TokReplace tokchars old new)-binary f old new = FP (fp2fn $! nFn f) $ Binary old new--nFn :: FilePath -> FilePath-nFn f = "./"++(fn2fp $ normPath $ fp2fn f)--instance Invert Prim where- invert Identity = Identity- invert (FP f RmFile) = FP f AddFile- invert (FP f AddFile) = FP f RmFile- invert (FP f (Hunk line old new)) = FP f $ Hunk line new old- invert (FP f (TokReplace t o n)) = FP f $ TokReplace t n o- invert (FP f (Binary o n)) = FP f $ Binary n o- invert (DP d RmDir) = DP d AddDir- invert (DP d AddDir) = DP d RmDir- invert (Move f f') = Move f' f- invert (ChangePref p f t) = ChangePref p t f- invert (Split ps) = Split $ invert ps- identity = Identity- sloppyIdentity Identity = IsEq- sloppyIdentity _ = NotEq--instance Show (Prim C(x y)) where- showsPrec d (Move fn1 fn2) = showParen (d > appPrec) $ showString "Move " .- showsPrec (appPrec + 1) fn1 . showString " " .- showsPrec (appPrec + 1) fn2- showsPrec d (DP fn dp) = showParen (d > appPrec) $ showString "DP " .- showsPrec (appPrec + 1) fn . showString " " .- showsPrec (appPrec + 1) dp- showsPrec d (FP fn fp) = showParen (d > appPrec) $ showString "FP " .- showsPrec (appPrec + 1) fn . showString " " .- showsPrec (appPrec + 1) fp- showsPrec d (Split l) = showParen (d > appPrec) $ showString "Split " .- showsPrec (appPrec + 1) l- showsPrec _ Identity = showString "Identity"- showsPrec d (ChangePref p f t) = showParen (d > appPrec) $ showString "ChangePref " .- showsPrec (appPrec + 1) p . showString " " .- showsPrec (appPrec + 1) f . showString " " .- showsPrec (appPrec + 1) t--instance Show2 Prim where- showDict2 = ShowDictClass--instance Show (FilePatchType C(x y)) where- showsPrec _ RmFile = showString "RmFile"- showsPrec _ AddFile = showString "AddFile"- showsPrec d (Hunk line old new) | all ((==1) . B.length) old && all ((==1) . B.length) new- = showParen (d > appPrec) $ showString "Hunk " .- showsPrec (appPrec + 1) line . showString " " .- showsPrecC old . showString " " .- showsPrecC new- where showsPrecC [] = showString "[]"- showsPrecC ss = showParen True $ showString "packStringLetters " . showsPrec (appPrec + 1) (map BC.head ss)- showsPrec d (Hunk line old new) = showParen (d > appPrec) $ showString "Hunk " .- showsPrec (appPrec + 1) line . showString " " .- showsPrec (appPrec + 1) old . showString " " .- showsPrec (appPrec + 1) new- showsPrec d (TokReplace t old new) = showParen (d > appPrec) $ showString "TokReplace " .- showsPrec (appPrec + 1) t . showString " " .- showsPrec (appPrec + 1) old . showString " " .- showsPrec (appPrec + 1) new- -- this case may not work usefully- showsPrec d (Binary old new) = showParen (d > appPrec) $ showString "Binary " .- showsPrec (appPrec + 1) old . showString " " .- showsPrec (appPrec + 1) new--instance Show (DirPatchType C(x y)) where- showsPrec _ RmDir = showString "RmDir"- showsPrec _ AddDir = showString "AddDir"--{--instance Show (Prim C(x y)) where- show p = renderString (showPrim p) ++ "\n"--}--data FileNameFormat = OldFormat | NewFormat-formatFileName :: FileNameFormat -> FileName -> Doc-formatFileName OldFormat = packedString . fn2ps-formatFileName NewFormat = text . encodeWhite . fn2fp--showPrim :: FileNameFormat -> Prim C(a b) -> Doc-showPrim x (FP f AddFile) = showAddFile x f-showPrim x (FP f RmFile) = showRmFile x f-showPrim x (FP f (Hunk line old new)) = showHunk x f line old new-showPrim x (FP f (TokReplace t old new)) = showTok x f t old new-showPrim x (FP f (Binary old new)) = showBinary x f old new-showPrim x (DP d AddDir) = showAddDir x d-showPrim x (DP d RmDir) = showRmDir x d-showPrim x (Move f f') = showMove x f f'-showPrim _ (ChangePref p f t) = showChangePref p f t-showPrim x (Split ps) = showSplit x ps-showPrim _ Identity = blueText "{}"--showPrimFL :: FileNameFormat -> FL Prim C(a b) -> Doc-showPrimFL f xs = vcat (mapFL (showPrim f) xs)--\end{code}---\paragraph{Add file}-Add an empty file to the tree.--\verb!addfile filename!-\begin{code}-showAddFile :: FileNameFormat -> FileName -> Doc-showAddFile x f = blueText "addfile" <+> formatFileName x f-\end{code}--\paragraph{Remove file}-Delete a file from the tree.--\verb!rmfile filename!-\begin{code}-showRmFile :: FileNameFormat -> FileName -> Doc-showRmFile x f = blueText "rmfile" <+> formatFileName x f-\end{code}--\paragraph{Move}-Rename a file or directory.--\verb!move oldname newname!-\begin{code}-showMove :: FileNameFormat -> FileName -> FileName -> Doc-showMove x d d' = blueText "move" <+> formatFileName x d <+> formatFileName x d'-\end{code}--\paragraph{Change Pref}-Change one of the preference settings. Darcs stores a number of simple-string settings. Among these are the name of the test script and the name-of the script that must be called prior to packing in a make dist.-\begin{verbatim}-changepref prefname-oldval-newval-\end{verbatim}-\begin{code}-showChangePref :: String -> String -> String -> Doc-showChangePref p f t = blueText "changepref" <+> text p- $$ userchunk f- $$ userchunk t-\end{code}--\paragraph{Add dir}-Add an empty directory to the tree.--\verb!adddir filename!-\begin{code}-showAddDir :: FileNameFormat -> FileName -> Doc-showAddDir x d = blueText "adddir" <+> formatFileName x d-\end{code}--\paragraph{Remove dir}-Delete a directory from the tree.--\verb!rmdir filename!-\begin{code}-showRmDir :: FileNameFormat -> FileName -> Doc-showRmDir x d = blueText "rmdir" <+> formatFileName x d-\end{code}---\paragraph{Hunk}-Replace a hunk (set of contiguous lines) of text with a new-hunk.-\begin{verbatim}-hunk FILE LINE#--LINE-...-+LINE-...-\end{verbatim}-\begin{code}-showHunk :: FileNameFormat -> FileName -> Int -> [B.ByteString] -> [B.ByteString] -> Doc-showHunk x f line old new =- blueText "hunk" <+> formatFileName x f <+> text (show line)- $$ lineColor Magenta (prefix "-" (vcat $ map userchunkPS old))- $$ lineColor Cyan (prefix "+" (vcat $ map userchunkPS new))-\end{code}--\paragraph{Token replace}--Replace a token with a new token. Note that this format means that-whitespace must not be allowed within a token. If you know of a practical-application of whitespace within a token, let me know and I may change-this.-\begin{verbatim}-replace FILENAME [REGEX] OLD NEW-\end{verbatim}-\begin{code}-showTok :: FileNameFormat -> FileName -> String -> String -> String -> Doc-showTok x f t o n = blueText "replace" <+> formatFileName x f- <+> text "[" <> userchunk t <> text "]"- <+> userchunk o- <+> userchunk n-\end{code}--\paragraph{Binary file modification}--Modify a binary file-\begin{verbatim}-binary FILENAME-oldhex-*HEXHEXHEX-...-newhex-*HEXHEXHEX-...-\end{verbatim}-\begin{code}-showBinary :: FileNameFormat -> FileName -> B.ByteString -> B.ByteString -> Doc-showBinary x f o n =- blueText "binary" <+> formatFileName x f- $$ invisibleText "oldhex"- $$ (vcat $ map makeprintable $ breakEvery 78 $ fromPS2Hex o)- $$ invisibleText "newhex"- $$ (vcat $ map makeprintable $ breakEvery 78 $ fromPS2Hex n)- where makeprintable ps = invisibleText "*" <> invisiblePS ps--breakEvery :: Int -> B.ByteString -> [B.ByteString]-breakEvery n ps | B.length ps < n = [ps]- | otherwise = B.take n ps : breakEvery n (B.drop n ps)-\end{code}--\paragraph{Split patch [OBSOLETE!]}-A split patch is similar to a composite patch but rather than being-composed of several patches grouped together, it is created from one-patch that has been split apart, typically through a merge or-commutation.-\begin{verbatim}-(- <put patches here> (indented two)-)-\end{verbatim}-\begin{code}-showSplit :: FileNameFormat -> FL Prim C(x y) -> Doc-showSplit x ps = blueText "("- $$ vcat (mapFL (showPrim x) ps)- $$ blueText ")"--commuteSplit :: CommuteFunction-commuteSplit (Split patches :< patch) =- toPerhaps $ cs (patches :< patch) >>= sc- where cs :: ((FL Prim) :< Prim) C(x y) -> Maybe ((Prim :< (FL Prim)) C(x y))- cs (NilFL :< p1) = return (p1 :< NilFL)- cs (p:>:ps :< p1) = do p' :> p1' <- commute (p1 :> p)- p1'' :< ps' <- cs (ps :< p1')- return (p1'' :< p':>:ps')- sc :: (Prim :< (FL Prim)) C(x y) -> Maybe ((Prim :< Prim) C(x y))- sc (p1 :< ps) = scFL $ p1 :< (sortCoalesceFL ps)- where scFL :: (Prim :< (FL Prim)) C(x y)- -> Maybe ((Prim :< Prim) C(x y))- scFL (p1' :< (p :>: NilFL)) = return (p1' :< p)- scFL (p1' :< ps') = return (p1' :< Split ps')-commuteSplit _ = Unknown--tryToShrink :: FL Prim C(x y) -> FL Prim C(x y)-tryToShrink = mapPrimFL tryHarderToShrink--mapPrimFL :: (FORALL(x y) FL Prim C(x y) -> FL Prim C(x y))- -> FL Prim C(w z) -> FL Prim C(w z)-mapPrimFL f x =--- an optimisation; break the list up into independent sublists--- and apply f to each of them- case mapM toSimpleSealed $ mapFL Sealed2 x of- Just sx -> concatFL $ unsealList $ elems $- mapWithKey (\ k p -> Sealed2 (f (fromSimples k (unsealList (p []))))) $- fromListWith (flip (.)) $- map (\ (a,b) -> (a,(b:))) sx- Nothing -> f x- where- unsealList :: [Sealed2 p] -> FL p C(a b)- unsealList [] = unsafeCoerceP NilFL- unsealList (x:xs) = unsafeUnseal2 x :>: unsealList xs-- toSimpleSealed :: Sealed2 Prim -> Maybe (FileName, Sealed2 Simple)- toSimpleSealed (Sealed2 p) = fmap (\(fn, s) -> (fn, Sealed2 s)) (toSimple p)----data Simple C(x y) = SFP !(FilePatchType C(x y)) | SDP !(DirPatchType C(x y))- | SCP String String String- deriving ( Show )--toSimple :: Prim C(x y) -> Maybe (FileName, Simple C(x y))-toSimple (FP a b) = Just (a, SFP b)-toSimple (DP a AddDir) = Just (a, SDP AddDir)-toSimple (DP _ RmDir) = Nothing -- ordering is trickier with rmdir present-toSimple (Move _ _) = Nothing-toSimple (Split _) = Nothing-toSimple Identity = Nothing-toSimple (ChangePref a b c) = Just (fp2fn "_darcs/prefs/prefs", SCP a b c)--fromSimple :: FileName -> Simple C(x y) -> Prim C(x y)-fromSimple a (SFP b) = FP a b-fromSimple a (SDP b) = DP a b-fromSimple _ (SCP a b c) = ChangePref a b c--fromSimples :: FileName -> FL Simple C(x y) -> FL Prim C(x y)-fromSimples a bs = mapFL_FL (fromSimple a) bs--tryHarderToShrink :: FL Prim C(x y) -> FL Prim C(x y)-tryHarderToShrink x = tryToShrink2 $ maybe x id (tryShrinkingInverse x)--tryToShrink2 :: FL Prim C(x y) -> FL Prim C(x y)-tryToShrink2 psold =- let ps = sortCoalesceFL psold- ps_shrunk = shrinkABit ps- in- if lengthFL ps_shrunk < lengthFL ps- then tryToShrink2 ps_shrunk- else ps_shrunk--tryShrinkingInverse :: FL Prim C(x y) -> Maybe (FL Prim C(x y))-tryShrinkingInverse (x:>:y:>:z)- | IsEq <- invert x =\/= y = Just z- | otherwise = case tryShrinkingInverse (y:>:z) of- Nothing -> Nothing- Just yz' -> Just $ case tryShrinkingInverse (x:>:yz') of- Nothing -> x:>:yz'- Just xyz' -> xyz'-tryShrinkingInverse _ = Nothing--shrinkABit :: FL Prim C(x y) -> FL Prim C(x y)-shrinkABit NilFL = NilFL-shrinkABit (p:>:ps) =- case tryOne NilRL p ps of- Nothing -> p :>: shrinkABit ps- Just ps' -> ps'--tryOne :: RL Prim C(w x) -> Prim C(x y) -> FL Prim C(y z)- -> Maybe (FL Prim C(w z))-tryOne _ _ NilFL = Nothing-tryOne sofar p (p1:>:ps) =- case coalesce (p1 :< p) of- Just p' -> Just (reverseRL sofar +>+ p':>:NilFL +>+ ps)- Nothing -> case commute (p :> p1) of- Nothing -> Nothing- Just (p1' :> p') -> tryOne (p1':<:sofar) p' ps---- | 'canonizeFL' @ps@ puts a sequence of primitive patches into--- canonical form. Even if the patches are just hunk patches,--- this is not necessarily the same set of results as you would get--- if you applied the sequence to a specific tree and recalculated--- a diff.------ Note that this process does not preserve the commutation behaviour--- of the patches and is therefore not appropriate for use when--- working with already recorded patches (unless doing amend-record--- or the like).-canonizeFL :: FL Prim C(x y) -> FL Prim C(x y)--- Running canonize twice is apparently necessary to fix issue525;--- would be nice to understand why.-canonizeFL = concatFL . mapFL_FL canonize . sortCoalesceFL .- concatFL . mapFL_FL canonize---- | 'sortCoalesceFL' @ps@ coalesces as many patches in @ps@ as--- possible, sorting the results according to the scheme defined--- in 'comparePrim'-sortCoalesceFL :: FL Prim C(x y) -> FL Prim C(x y)-sortCoalesceFL = mapPrimFL sortCoalesceFL2---- | The heart of "sortCoalesceFL"-sortCoalesceFL2 :: FL Prim C(x y) -> FL Prim C(x y)-sortCoalesceFL2 NilFL = NilFL-sortCoalesceFL2 (x:>:xs) | IsEq <- nullP x = sortCoalesceFL2 xs-sortCoalesceFL2 (x:>:xs) | IsEq <- isIdentity x = sortCoalesceFL2 xs-sortCoalesceFL2 (x:>:xs) = either id id $ pushCoalescePatch x $ sortCoalesceFL2 xs---- | 'pushCoalescePatch' @new ps@ is almost like @new :>: ps@ except--- as an alternative to consing, we first try to coalesce @new@ with--- the head of @ps@. If this fails, we try again, using commutation--- to push @new@ down the list until we find a place where either--- (a) @new@ is @LT@ the next member of the list [see 'comparePrim']--- (b) commutation fails or--- (c) coalescing succeeds.--- The basic principle is to coalesce if we can and cons otherwise.------ As an additional optimization, pushCoalescePatch outputs a Left--- value if it wasn't able to shrink the patch sequence at all, and--- a Right value if it was indeed able to shrink the patch sequence.--- This avoids the O(N) calls to lengthFL that were in the older--- code.------ Also note that pushCoalescePatch is only ever used (and should--- only ever be used) as an internal function in in--- sortCoalesceFL2.-pushCoalescePatch :: Prim C(x y) -> FL Prim C(y z)- -> Either (FL Prim C(x z)) (FL Prim C(x z))-pushCoalescePatch new NilFL = Left (new:>:NilFL)-pushCoalescePatch new ps@(p:>:ps')- = case coalesce (p :< new) of- Just new' | IsEq <- nullP new' -> Right ps'- | otherwise -> Right $ either id id $ pushCoalescePatch new' ps'- Nothing -> if comparePrim new p == LT then Left (new:>:ps)- else case commute (new :> p) of- Just (p' :> new') ->- case pushCoalescePatch new' ps' of- Right r -> Right $ either id id $- pushCoalescePatch p' r- Left r -> Left (p' :>: r)- Nothing -> Left (new:>:ps)--isInDirectory :: FileName -> FileName -> Bool-isInDirectory d f = iid (fn2fp d) (fn2fp f)- where iid (cd:cds) (cf:cfs)- | cd /= cf = False- | otherwise = iid cds cfs- iid [] ('/':_) = True- iid [] [] = True -- Count directory itself as being in directory...- iid _ _ = False--data Perhaps a = Unknown | Failed | Succeeded a--instance Monad Perhaps where- (Succeeded x) >>= k = k x- Failed >>= _ = Failed- Unknown >>= _ = Unknown- Failed >> _ = Failed- (Succeeded _) >> k = k- Unknown >> k = k- return = Succeeded- fail _ = Unknown--instance MonadPlus Perhaps where- mzero = Unknown- Unknown `mplus` ys = ys- Failed `mplus` _ = Failed- (Succeeded x) `mplus` _ = Succeeded x--toMaybe :: Perhaps a -> Maybe a-toMaybe (Succeeded x) = Just x-toMaybe _ = Nothing--toPerhaps :: Maybe a -> Perhaps a-toPerhaps (Just x) = Succeeded x-toPerhaps Nothing = Failed--cleverCommute :: CommuteFunction -> CommuteFunction-cleverCommute c (p1:<p2) =- case c (p1 :< p2) of- Succeeded x -> Succeeded x- Failed -> Failed- Unknown -> case c (invert p2 :< invert p1) of- Succeeded (p1' :< p2') -> Succeeded (invert p2' :< invert p1')- Failed -> Failed- Unknown -> Unknown---cleverCommute c (p1,p2) = c (p1,p2) `mplus`--- (case c (invert p2,invert p1) of--- Succeeded (p1', p2') -> Succeeded (invert p2', invert p1')--- Failed -> Failed--- Unknown -> Unknown)--speedyCommute :: CommuteFunction-speedyCommute (p1 :< p2) -- Deal with common case quickly!- | p1_modifies /= Nothing && p2_modifies /= Nothing &&- p1_modifies /= p2_modifies = Succeeded (unsafeCoerce# p2 :< unsafeCoerce# p1)- | otherwise = Unknown- where p1_modifies = is_filepatch p1- p2_modifies = is_filepatch p2--everythingElseCommute :: CommuteFunction-everythingElseCommute x = eec x- where- eec :: CommuteFunction- eec (ChangePref p f t :<p1) = Succeeded (unsafeCoerce# p1 :< ChangePref p f t)- eec (p2 :<ChangePref p f t) = Succeeded (ChangePref p f t :< unsafeCoerce# p2)- eec (Identity :< p1) = Succeeded (p1 :< Identity)- eec (p2 :< Identity) = Succeeded (Identity :< p2)- eec xx =- msum [- cleverCommute commuteFiledir xx- ,cleverCommute commuteSplit xx- ]--{--Note that it must be true that--commutex (A^-1 A, P) = Just (P, A'^-1 A')--and--if commutex (A, B) == Just (B', A')-then commutex (B^-1, A^-1) == Just (A'^-1, B'^-1)--}--instance Commute Prim where- merge (y :\/: z) =- case elegantMerge (y:\/:z) of- Just (z' :/\: y') -> z' :/\: y'- Nothing -> error "Commute Prim merge"- commute x = toMaybe $ msum [toFwdCommute speedyCommute x,- toFwdCommute everythingElseCommute x- ]- -- Recurse on everything, these are potentially spoofed patches- listTouchedFiles (Move f1 f2) = map fn2fp [f1, f2]- listTouchedFiles (Split ps) = nubsort $ concat $ mapFL listTouchedFiles ps- listTouchedFiles (FP f _) = [fn2fp f]- listTouchedFiles (DP d _) = [fn2fp d]- listTouchedFiles (ChangePref _ _ _) = []- listTouchedFiles Identity = []-- hunkMatches f (FP _ (Hunk _ remove add)) = anyMatches remove || anyMatches add- where anyMatches = foldr ((||) . f) False- hunkMatches _ (FP _ _) = False- hunkMatches f (Split ps) = or $ mapFL (hunkMatches f) ps- hunkMatches _ (DP _ _) = False- hunkMatches _ (ChangePref _ _ _) = False- hunkMatches _ Identity = False- hunkMatches _ (Move _ _) = False--is_filepatch :: Prim C(x y) -> Maybe FileName-is_filepatch (FP f _) = Just f-is_filepatch _ = Nothing--isSuperdir :: FileName -> FileName -> Bool-isSuperdir d1 d2 = isd (fn2fp d1) (fn2fp d2)- where isd s1 s2 =- length s2 >= length s1 + 1 && take (length s1 + 1) s2 == s1 ++ "/"--commuteFiledir :: CommuteFunction-commuteFiledir (FP f1 p1 :< FP f2 p2) =- if f1 /= f2 then Succeeded ( FP f2 (unsafeCoerce# p2) :< FP f1 (unsafeCoerce# p1) )- else commuteFP f1 (p1 :< p2)-commuteFiledir (DP d1 p1 :< DP d2 p2) =- if (not $ isInDirectory d1 d2) && (not $ isInDirectory d2 d1) &&- d1 /= d2- then Succeeded ( DP d2 (unsafeCoerce# p2) :< DP d1 (unsafeCoerce# p1) )- else Failed-commuteFiledir (DP d dp :< FP f fp) =- if not $ isInDirectory d f- then Succeeded (FP f (unsafeCoerce# fp) :< DP d (unsafeCoerce# dp))- else Failed--commuteFiledir (Move d d' :< FP f2 p2)- | f2 == d' = Failed- | (p2 == AddFile || p2 == RmFile) && d == f2 = Failed- | otherwise = Succeeded (FP (movedirfilename d d' f2) (unsafeCoerce# p2) :< Move d d')-commuteFiledir (Move d d' :< DP d2 p2)- | isSuperdir d2 d' || isSuperdir d2 d = Failed- | (p2 == AddDir || p2 == RmDir) && d == d2 = Failed- | d2 == d' = Failed- | otherwise = Succeeded (DP (movedirfilename d d' d2) (unsafeCoerce# p2) :< Move d d')-commuteFiledir (Move d d' :< Move f f')- | f == d' || f' == d = Failed- | f == d || f' == d' = Failed- | d `isSuperdir` f && f' `isSuperdir` d' = Failed- | otherwise =- Succeeded (Move (movedirfilename d d' f) (movedirfilename d d' f') :<- Move (movedirfilename f' f d) (movedirfilename f' f d'))--commuteFiledir _ = Unknown--type CommuteFunction = FORALL(x y) (Prim :< Prim) C(x y) -> Perhaps ((Prim :< Prim) C(x y))-subcommutes :: [(String, (Prim :< Prim) C(x y) -> Perhaps ((Prim :< Prim) C(x y)))]-subcommutes =- [("speedyCommute", speedyCommute),- ("commuteFiledir", cleverCommute commuteFiledir),- ("commuteFilepatches", cleverCommute commuteFilepatches),- ("commutex", toPerhaps . toRevCommute commute)- ]--elegantMerge :: (Prim :\/: Prim) C(x y)- -> Maybe ((Prim :/\: Prim) C(x y))-elegantMerge (p1 :\/: p2) =- do p1':>ip2' <- commute (invert p2 :> p1)- -- The following should be a redundant check- p1o:>_ <- commute (p2 :> p1')- IsEq <- return $ p1o =\/= p1- return (invert ip2' :/\: p1')-\end{code}--It can sometimes be handy to have a canonical representation of a given-patch. We achieve this by defining a canonical form for each patch type,-and a function ``{\tt canonize}'' which takes a patch and puts it into-canonical form. This routine is used by the diff function to create an-optimal patch (based on an LCS algorithm) from a simple hunk describing the-old and new version of a file.-\begin{code}-canonize :: Prim C(x y) -> FL Prim C(x y)-canonize (Split ps) = sortCoalesceFL ps-canonize p | IsEq <- isIdentity p = NilFL-canonize (FP f (Hunk line old new)) = canonizeHunk f line old new-canonize p = p :>: NilFL-\end{code}--A simpler, faster (and more generally useful) cousin of canonize is the-coalescing function. This takes two sequential patches, and tries to turn-them into one patch. This function is used to deal with ``split'' patches,-which are created when the commutation of a primitive patch can only be-represented by a composite patch. In this case the resulting composite-patch must return to the original primitive patch when the commutation is-reversed, which a split patch accomplishes by trying to coalesce its-contents each time it is commuted.--\begin{code}--- | 'coalesce' @p2 :< p1@ tries to combine @p1@ and @p2@ into a single--- patch without intermediary changes. For example, two hunk patches--- modifying adjacent lines can be coalesced into a bigger hunk patch.--- Or a patch which moves file A to file B can be coalesced with a--- patch that moves file B into file C, yielding a patch that moves--- file A to file C.-coalesce :: (Prim :< Prim) C(x y) -> Maybe (Prim C(x y))-coalesce (FP f1 _ :< FP f2 _) | f1 /= f2 = Nothing-coalesce (p2 :< p1) | IsEq <- p2 =\/= invert p1 = Just null_patch-coalesce (FP f1 p1 :< FP _ p2) = coalesceFilePrim f1 (p1 :< p2) -- f1 = f2-coalesce (Identity :< p) = Just p-coalesce (p :< Identity) = Just p-coalesce (Split NilFL :< p) = Just p-coalesce (p :< Split NilFL) = Just p-coalesce (Move a b :< Move b' a') | a == a' = Just $ Move b' b-coalesce (Move a b :< FP f AddFile) | f == a = Just $ FP b AddFile-coalesce (Move a b :< DP f AddDir) | f == a = Just $ DP b AddDir-coalesce (FP f RmFile :< Move a b) | b == f = Just $ FP a RmFile-coalesce (DP f RmDir :< Move a b) | b == f = Just $ DP a RmDir-coalesce (ChangePref p f1 t1 :< ChangePref p2 f2 t2) | p == p2 && t2 == f1 = Just $ ChangePref p f2 t1-coalesce _ = Nothing--join :: (Prim :> Prim) C(x y) -> Maybe (Prim C(x y))-join (x :> y) = coalesce (y :< x)-\end{code}--\subsection{File patches}--A file patch is a patch which only modifies a single-file. There are some rules which can be made about file patches in-general, which makes them a handy class.-For example, commutation of two filepatches is trivial if they modify-different files. If they happen to-modify the same file, we'll have to check whether or not they commutex.-\begin{code}-commuteFilepatches :: CommuteFunction-commuteFilepatches (FP f1 p1 :< FP f2 p2) | f1 == f2 = commuteFP f1 (p1 :< p2)-commuteFilepatches _ = Unknown--commuteFP :: FileName -> (FilePatchType :< FilePatchType) C(x y)- -> Perhaps ((Prim :< Prim) C(x y))-commuteFP f (Hunk line1 [] [] :< p2) =- seq f $ Succeeded (FP f (unsafeCoerceP p2) :< FP f (Hunk line1 [] []))-commuteFP f (p2 :< Hunk line1 [] []) =- seq f $ Succeeded (FP f (Hunk line1 [] []) :< FP f (unsafeCoerceP p2))-commuteFP f (Hunk line1 old1 new1 :< Hunk line2 old2 new2) = seq f $- toPerhaps $ commuteHunk f (Hunk line1 old1 new1 :< Hunk line2 old2 new2)-commuteFP f (TokReplace t o n :< Hunk line2 old2 new2) = seq f $- case tryTokReplace t o n old2 of- Nothing -> Failed- Just old2' ->- case tryTokReplace t o n new2 of- Nothing -> Failed- Just new2' -> Succeeded (FP f (Hunk line2 old2' new2') :<- FP f (TokReplace t o n))-commuteFP f (TokReplace t o n :< TokReplace t2 o2 n2)- | seq f $ t /= t2 = Failed- | o == o2 = Failed- | n == o2 = Failed- | o == n2 = Failed- | n == n2 = Failed- | otherwise = Succeeded (FP f (TokReplace t2 o2 n2) :<- FP f (TokReplace t o n))-commuteFP _ _ = Unknown--coalesceFilePrim :: FileName -> (FilePatchType :< FilePatchType) C(x y)- -> Maybe (Prim C(x y))-coalesceFilePrim f (Hunk line1 old1 new1 :< Hunk line2 old2 new2)- = coalesceHunk f line1 old1 new1 line2 old2 new2--- Token replace patches operating right after (or before) AddFile (RmFile)--- is an identity patch, as far as coalescing is concerned.-coalesceFilePrim f (TokReplace _ _ _ :< AddFile) = Just $ FP f AddFile-coalesceFilePrim f (RmFile :< TokReplace _ _ _) = Just $ FP f RmFile-coalesceFilePrim f (TokReplace t1 o1 n1 :< TokReplace t2 o2 n2)- | t1 == t2 && n2 == o1 = Just $ FP f $ TokReplace t1 o2 n1-coalesceFilePrim f (Binary m n :< Binary o m')- | m == m' = Just $ FP f $ Binary o n-coalesceFilePrim _ _ = Nothing-\end{code}--\subsection{Hunks}--The hunk is the simplest patch that has a commuting pattern in which the-commuted patches differ from the originals (rather than simple success or-failure). This makes commuting or merging two hunks a tad tedious.-\begin{code}-commuteHunk :: FileName -> (FilePatchType :< FilePatchType) C(x y)- -> Maybe ((Prim :< Prim) C(x y))-commuteHunk f (Hunk line2 old2 new2 :< Hunk line1 old1 new1)- | seq f $ line1 + lengthnew1 < line2 =- Just (FP f (Hunk line1 old1 new1) :<- FP f (Hunk (line2 - lengthnew1 + lengthold1) old2 new2))- | line2 + lengthold2 < line1 =- Just (FP f (Hunk (line1+ lengthnew2 - lengthold2) old1 new1) :<- FP f (Hunk line2 old2 new2))- | line1 + lengthnew1 == line2 &&- lengthold2 /= 0 && lengthold1 /= 0 && lengthnew2 /= 0 && lengthnew1 /= 0 =- Just (FP f (Hunk line1 old1 new1) :<- FP f (Hunk (line2 - lengthnew1 + lengthold1) old2 new2))- | line2 + lengthold2 == line1 &&- lengthold2 /= 0 && lengthold1 /= 0 && lengthnew2 /= 0 && lengthnew1 /= 0 =- Just (FP f (Hunk (line1 + lengthnew2 - lengthold2) old1 new1) :<- FP f (Hunk line2 old2 new2))- | otherwise = seq f Nothing- where lengthnew1 = length new1- lengthnew2 = length new2- lengthold1 = length old1- lengthold2 = length old2-commuteHunk _ _ = impossible-\end{code}-Hunks, of course, can be coalesced if they have any overlap. Note that-coalesce code doesn't check if the two patches are conflicting. If you are-coalescing two conflicting hunks, you've already got a bug somewhere.--\begin{code}-coalesceHunk :: FileName- -> Int -> [B.ByteString] -> [B.ByteString]- -> Int -> [B.ByteString] -> [B.ByteString]- -> Maybe (Prim C(x y))-coalesceHunk f line1 old1 new1 line2 old2 new2- | line1 == line2 && lengthold1 < lengthnew2 =- if take lengthold1 new2 /= old1- then Nothing- else case drop lengthold1 new2 of- extranew -> Just (FP f (Hunk line1 old2 (new1 ++ extranew)))- | line1 == line2 && lengthold1 > lengthnew2 =- if take lengthnew2 old1 /= new2- then Nothing- else case drop lengthnew2 old1 of- extraold -> Just (FP f (Hunk line1 (old2 ++ extraold) new1))- | line1 == line2 = if new2 == old1 then Just (FP f (Hunk line1 old2 new1))- else Nothing- | line1 < line2 && lengthold1 >= line2 - line1 =- case take (line2 - line1) old1 of- extra-> coalesceHunk f line1 old1 new1 line1 (extra ++ old2) (extra ++ new2)- | line1 > line2 && lengthnew2 >= line1 - line2 =- case take (line1 - line2) new2 of- extra-> coalesceHunk f line2 (extra ++ old1) (extra ++ new1) line2 old2 new2- | otherwise = Nothing- where lengthold1 = length old1- lengthnew2 = length new2-\end{code}--One of the most important pieces of code is the canonization of a hunk,-which is where the ``diff'' algorithm is performed. This algorithm begins-with chopping off the identical beginnings and endings of the old and new-hunks. This isn't strictly necessary, but is a good idea, since this-process is $O(n)$, while the primary diff algorithm is something-considerably more painful than that\ldots\ actually the head would be dealt-with all right, but with more space complexity. I think it's more-efficient to just chop the head and tail off first.--\begin{code}-canonizeHunk :: FileName -> Int- -> [B.ByteString] -> [B.ByteString] -> FL Prim C(x y)-canonizeHunk f line old new- | null old || null new- = FP f (Hunk line old new) :>: NilFL-canonizeHunk f line old new = makeHoley f line $ getChanges old new--makeHoley :: FileName -> Int -> [(Int,[B.ByteString], [B.ByteString])]- -> FL Prim C(x y)-makeHoley f line changes =- unsafeMap_l2f (\ (l,o,n) -> FP f (Hunk (l+line) o n)) changes--tryTokReplace :: String -> String -> String- -> [B.ByteString] -> Maybe [B.ByteString]-tryTokReplace t o n mss =- mapM (fmap B.concat . tryTokInternal t (BC.pack o) (BC.pack n)) mss---tryTokInternal :: String -> B.ByteString -> B.ByteString- -> B.ByteString -> Maybe [B.ByteString]-tryTokInternal _ o n s | isNothing (substrPS o s) &&- isNothing (substrPS n s) = Just [s]-tryTokInternal t o n s =- case BC.break (regChars t) s of- (before,s') ->- case BC.break (not . regChars t) s' of- (tok,after) ->- case tryTokInternal t o n after of- Nothing -> Nothing- Just rest ->- if tok == o- then Just $ before : n : rest- else if tok == n- then Nothing- else Just $ before : tok : rest--modernizePrim :: Prim C(x y) -> FL Prim C(x y)-modernizePrim (Split ps) = concatFL $ mapFL_FL modernizePrim ps-modernizePrim p = p :>: NilFL--instance MyEq Prim where- unsafeCompare (Move a b) (Move c d) = a == c && b == d- unsafeCompare (DP d1 p1) (DP d2 p2)- = d1 == d2 && p1 `unsafeCompare` p2- unsafeCompare (FP f1 fp1) (FP f2 fp2)- = f1 == f2 && fp1 `unsafeCompare` fp2- unsafeCompare (Split ps1) (Split ps2)- = eqFL unsafeCompare ps1 ps2- unsafeCompare (ChangePref a1 b1 c1) (ChangePref a2 b2 c2)- = c1 == c2 && b1 == b2 && a1 == a2- unsafeCompare Identity Identity = True- unsafeCompare _ _ = False--mergeOrders :: Ordering -> Ordering -> Ordering-mergeOrders EQ x = x-mergeOrders LT _ = LT-mergeOrders GT _ = GT---- | 'comparePrim' @p1 p2@ is used to provide an arbitrary ordering between--- @p1@ and @p2@. Basically, identical patches are equal and--- @Move < DP < FP < Split < Identity < ChangePref@.--- Everything else is compared in dictionary order of its arguments.-comparePrim :: Prim C(x y) -> Prim C(w z) -> Ordering-comparePrim (Move a b) (Move c d) = compare (a, b) (c, d)-comparePrim (Move _ _) _ = LT-comparePrim _ (Move _ _) = GT-comparePrim (DP d1 p1) (DP d2 p2) = compare (d1, p1) $ unsafeCoerceP (d2, p2)-comparePrim (DP _ _) _ = LT-comparePrim _ (DP _ _) = GT-comparePrim (FP f1 fp1) (FP f2 fp2) = compare (f1, fp1) $ unsafeCoerceP (f2, fp2)-comparePrim (FP _ _) _ = LT-comparePrim _ (FP _ _) = GT-comparePrim (Split ps1) (Split ps2) = compareFL comparePrim ps1 $ unsafeCoerceP ps2-comparePrim (Split _) _ = LT-comparePrim _ (Split _) = GT-comparePrim Identity Identity = EQ-comparePrim Identity _ = LT-comparePrim _ Identity = GT-comparePrim (ChangePref a1 b1 c1) (ChangePref a2 b2 c2)- = compare (c1, b1, a1) (c2, b2, a2)--eqFL :: (FORALL(b c d e) a C(b c) -> a C(d e) -> Bool)- -> FL a C(x y) -> FL a C(w z) -> Bool-eqFL _ NilFL NilFL = True-eqFL f (x:>:xs) (y:>:ys) = f x y && eqFL f xs ys-eqFL _ _ _ = False--compareFL :: (FORALL(b c d e) a C(b c) -> a C(d e) -> Ordering)- -> FL a C(x y) -> FL a C(w z) -> Ordering-compareFL _ NilFL NilFL = EQ-compareFL _ NilFL _ = LT-compareFL _ _ NilFL = GT-compareFL f (x:>:xs) (y:>:ys) = f x y `mergeOrders` compareFL f xs ys---class FromPrim p where- fromPrim :: Prim C(x y) -> p C(x y)--class FromPrim p => ToFromPrim p where- toPrim :: p C(x y) -> Maybe (Prim C(x y))--class FromPrims p where- fromPrims :: FL Prim C(x y) -> p C(x y)- joinPatches :: FL p C(x y) -> p C(x y)--instance FromPrim Prim where- fromPrim = id-instance ToFromPrim Prim where- toPrim = Just . id--instance FromPrim p => FromPrims (FL p) where- fromPrims = mapFL_FL fromPrim- joinPatches = concatFL-instance FromPrim p => FromPrims (RL p) where- fromPrims = reverseFL . mapFL_FL fromPrim- joinPatches = concatRL . reverseFL--class (Invert p, Commute p, Effect p) => Conflict p where- listConflictedFiles :: p C(x y) -> [FilePath]- listConflictedFiles p =- nubsort $ concatMap (unseal listTouchedFiles) $ concat $ resolveConflicts p- resolveConflicts :: p C(x y) -> [[Sealed (FL Prim C(y))]]- resolveConflicts _ = []- -- | If 'commuteNoConflicts' @x :> y@ succeeds, we know that that @x@ commutes- -- past @y@ without any conflicts. This function is useful for patch types- -- for which 'commute' is defined to always succeed; so we need some way to- -- pick out the specific cases where commutation succeeds without any conflicts.- --- -- Consider the commute square with patch names written in capital letters and- -- repository states written in small letters.- --- -- @- -- X- -- o-->--a- -- | |- -- Y' v v Y- -- | |- -- z-->--b- -- X'- -- @- --- -- The default definition of this function checks that we can mirror the- -- commutation with patch inverses (written with the negative sign)- --- -- @- -- -X X- -- a-->--o-->--a- -- | | |- -- Y'' v Y' v v Y- -- | | |- -- b-->--z-->--b- -- (-X)' X'- -- @- --- --- -- We check that commuting @X@ and @Y@ succeeds, as does commuting @-X@ and @Y'@.- -- It also checks that @Y'' == Y@ and that @-(X')@ is the same as @(-X)'@- commuteNoConflicts :: (p :> p) C(x y) -> Maybe ((p :> p) C(x y))- commuteNoConflicts (x:>y) =- do y':>x' <- commute (x:>y)- y'':>ix'' <- commute (invert x :> y')- IsEq <- return $ y'' =\/= y- IsEq <- return $ ix'' =\/= invert x'- return (y':>x')- conflictedEffect :: p C(x y) -> [IsConflictedPrim]- conflictedEffect x = case listConflictedFiles x of- [] -> mapFL (IsC Okay) $ effect x- _ -> mapFL (IsC Conflicted) $ effect x- isInconsistent :: p C(x y) -> Maybe Doc- isInconsistent _ = Nothing--instance Conflict p => Conflict (FL p) where- listConflictedFiles = nubsort . concat . mapFL listConflictedFiles- resolveConflicts NilFL = []- resolveConflicts x = resolveConflicts $ reverseFL x- commuteNoConflicts (NilFL :> x) = Just (x :> NilFL)- commuteNoConflicts (x :> NilFL) = Just (NilFL :> x)- commuteNoConflicts (xs :> ys) = do ys' :> rxs' <- commuteNoConflictsRLFL (reverseFL xs :> ys)- return $ ys' :> reverseRL rxs'- conflictedEffect = concat . mapFL conflictedEffect- isInconsistent = listToMaybe . catMaybes . mapFL isInconsistent--instance Conflict p => Conflict (RL p) where- listConflictedFiles = nubsort . concat . mapRL listConflictedFiles- resolveConflicts x = rcs x NilFL- where rcs :: RL p C(x y) -> FL p C(y w) -> [[Sealed (FL Prim C(w))]]- rcs NilRL _ = []- rcs (p:<:ps) passedby | (_:_) <- resolveConflicts p =- case commuteNoConflictsFL (p:>passedby) of- Just (_:> p') -> resolveConflicts p' ++ rcs ps (p:>:passedby)- Nothing -> rcs ps (p:>:passedby)- rcs (p:<:ps) passedby = seq passedby $ rcs ps (p:>:passedby)- commuteNoConflicts (NilRL :> x) = Just (x :> NilRL)- commuteNoConflicts (x :> NilRL) = Just (NilRL :> x)- commuteNoConflicts (xs :> ys) = do ys' :> rxs' <- commuteNoConflictsRLFL (xs :> reverseRL ys)- return $ reverseFL ys' :> rxs'- conflictedEffect = concat . reverse . mapRL conflictedEffect- isInconsistent = listToMaybe . catMaybes . mapRL isInconsistent--data IsConflictedPrim where- IsC :: !ConflictState -> !(Prim C(x y)) -> IsConflictedPrim-data ConflictState = Okay | Conflicted | Duplicated deriving ( Eq, Ord, Show, Read)---- | Patches whose concrete effect which can be expressed as a list of--- primitive patches.------ A minimal definition would be either of @effect@ or @effectRL@.-class Effect p where- effect :: p C(x y) -> FL Prim C(x y)- effect = reverseRL . effectRL- effectRL :: p C(x y) -> RL Prim C(x y)- effectRL = reverseFL . effect- isHunk :: p C(x y) -> Maybe (Prim C(x y))- isHunk _ = Nothing--instance Effect Prim where- effect p | IsEq <- sloppyIdentity p = NilFL- | otherwise = p :>: NilFL- effectRL p | IsEq <- sloppyIdentity p = NilRL- | otherwise = p :<: NilRL- isHunk p = if primIsHunk p then Just p else Nothing--instance Conflict Prim--instance Effect p => Effect (FL p) where- effect p = concatFL $ mapFL_FL effect p- effectRL p = concatRL $ mapRL_RL effectRL $ reverseFL p--instance Effect p => Effect (RL p) where- effect p = concatFL $ mapFL_FL effect $ reverseRL p- effectRL p = concatRL $ mapRL_RL effectRL p--commuteNoConflictsFL :: Conflict p => (p :> FL p) C(x y) -> Maybe ((FL p :> p) C(x y))-commuteNoConflictsFL (p :> NilFL) = Just (NilFL :> p)-commuteNoConflictsFL (q :> p :>: ps) = do p' :> q' <- commuteNoConflicts (q :> p)- ps' :> q'' <- commuteNoConflictsFL (q' :> ps)- return (p' :>: ps' :> q'')--commuteNoConflictsRL :: Conflict p => (RL p :> p) C(x y) -> Maybe ((p :> RL p) C(x y))-commuteNoConflictsRL (NilRL :> p) = Just (p :> NilRL)-commuteNoConflictsRL (p :<: ps :> q) = do q' :> p' <- commuteNoConflicts (p :> q)- q'' :> ps' <- commuteNoConflictsRL (ps :> q')- return (q'' :> p' :<: ps')--commuteNoConflictsRLFL :: Conflict p => (RL p :> FL p) C(x y) -> Maybe ((FL p :> RL p) C(x y))-commuteNoConflictsRLFL (NilRL :> ys) = Just (ys :> NilRL)-commuteNoConflictsRLFL (xs :> NilFL) = Just (NilFL :> xs)-commuteNoConflictsRLFL (xs :> y :>: ys) = do y' :> xs' <- commuteNoConflictsRL (xs :> y)- ys' :> xs'' <- commuteNoConflictsRLFL (xs' :> ys)- return (y' :>: ys' :> xs'')--\end{code}
+ src/Darcs/Patch/Prim/Class.hs view
@@ -0,0 +1,130 @@+module Darcs.Patch.Prim.Class+ ( PrimConstruct(..), PrimCanonize(..)+ , PrimClassify(..), PrimDetails(..)+ , PrimShow(..), showPrimFL, PrimRead(..)+ , PrimApply(..)+ , PrimPatch, PrimPatchBase(..)+ , FromPrim(..), FromPrims(..), ToFromPrim(..)+ )+ where++import Darcs.Patch.ApplyMonad ( ApplyMonad )+import Darcs.Patch.FileHunk ( FileHunk, IsHunk )+import Darcs.Patch.FileName ( FileName )+import Darcs.Patch.Format ( PatchListFormat, FileNameFormat(..) )+import Darcs.Patch.Patchy ( Patchy )+import Darcs.Patch.ReadMonads ( ParserM )+import Darcs.Patch.Repair ( RepairToFL )+import Darcs.Patch.SummaryData ( SummDetail )+import Darcs.Witnesses.Ordered+ ( FL(..), RL, (:>), mapFL, mapFL_FL, concatFL, reverseFL, concatRL )+import Darcs.Witnesses.Sealed ( Sealed )++import Printer ( Doc, vcat )++import qualified Data.ByteString as B ( ByteString )++#include "gadts.h"++class (Patchy prim, PatchListFormat prim, IsHunk prim, RepairToFL prim+ ,PrimConstruct prim, PrimCanonize prim+ ,PrimClassify prim, PrimDetails prim+ ,PrimShow prim, PrimRead prim, PrimApply prim+ )+ => PrimPatch prim++class PrimPatch (PrimOf p) => PrimPatchBase p where+ type PrimOf (p :: PATCHKIND) :: PATCHKIND++instance PrimPatchBase p => PrimPatchBase (FL p) where+ type PrimOf (FL p) = PrimOf p++instance PrimPatchBase p => PrimPatchBase (RL p) where+ type PrimOf (RL p) = PrimOf p++class FromPrim p where+ fromPrim :: PrimOf p C(x y) -> p C(x y)++class FromPrim p => ToFromPrim p where+ toPrim :: p C(x y) -> Maybe (PrimOf p C(x y))++class FromPrims p where+ fromPrims :: FL (PrimOf p) C(x y) -> p C(x y)+ joinPatches :: FL p C(x y) -> p C(x y)++instance FromPrim p => FromPrim (FL p) where+ fromPrim p = fromPrim p :>: NilFL++instance FromPrim p => FromPrims (FL p) where+ fromPrims = mapFL_FL fromPrim+ joinPatches = concatFL++instance FromPrim p => FromPrims (RL p) where+ fromPrims = reverseFL . mapFL_FL fromPrim+ joinPatches = concatRL . reverseFL++class PrimClassify prim where+ primIsAddfile :: prim C(x y) -> Bool+ primIsAdddir :: prim C(x y) -> Bool+ primIsHunk :: prim C(x y) -> Bool+ primIsBinary :: prim C(x y) -> Bool+ primIsSetpref :: prim C(x y) -> Bool+ is_filepatch :: prim C(x y) -> Maybe FileName++class PrimConstruct prim where+ addfile :: FilePath -> prim C(x y)+ rmfile :: FilePath -> prim C(x y)+ adddir :: FilePath -> prim C(x y)+ rmdir :: FilePath -> prim C(x y)+ move :: FilePath -> FilePath -> prim C(x y)+ changepref :: String -> String -> String -> prim C(x y)+ hunk :: FilePath -> Int -> [B.ByteString] -> [B.ByteString] -> prim C(x y)+ tokreplace :: FilePath -> String -> String -> String -> prim C(x y)+ binary :: FilePath -> B.ByteString -> B.ByteString -> prim C(x y)+ primFromHunk :: FileHunk C(x y) -> prim C(x y)++class PrimCanonize prim where+ tryToShrink :: FL prim C(x y) -> FL prim C(x y)+ tryShrinkingInverse :: FL prim C(x y) -> Maybe (FL prim C(x y))++ -- | 'sortCoalesceFL' @ps@ coalesces as many patches in @ps@ as+ -- possible, sorting the results in some standard order.+ sortCoalesceFL :: FL prim C(x y) -> FL prim C(x y)++ -- | It can sometimes be handy to have a canonical representation of a given+ -- patch. We achieve this by defining a canonical form for each patch type,+ -- and a function 'canonize' which takes a patch and puts it into+ -- canonical form. This routine is used by the diff function to create an+ -- optimal patch (based on an LCS algorithm) from a simple hunk describing the+ -- old and new version of a file.+ canonize :: prim C(x y) -> FL prim C(x y)++ -- | 'canonizeFL' @ps@ puts a sequence of primitive patches into+ -- canonical form. Even if the patches are just hunk patches,+ -- this is not necessarily the same set of results as you would get+ -- if you applied the sequence to a specific tree and recalculated+ -- a diff.+ --+ -- Note that this process does not preserve the commutation behaviour+ -- of the patches and is therefore not appropriate for use when+ -- working with already recorded patches (unless doing amend-record+ -- or the like).+ canonizeFL :: FL prim C(x y) -> FL prim C(x y)++ join :: (prim :> prim) C(x y) -> Maybe (FL prim C(x y))+++class PrimDetails prim where+ summarizePrim :: prim C(x y) -> [SummDetail]++class PrimShow prim where+ showPrim :: FileNameFormat -> prim C(a b) -> Doc++showPrimFL :: PrimShow prim => FileNameFormat -> FL prim C(a b) -> Doc+showPrimFL f xs = vcat (mapFL (showPrim f) xs)++class PrimRead prim where+ readPrim :: ParserM m => FileNameFormat -> m (Sealed (prim C(x )))++class PrimApply prim where+ applyPrimFL :: ApplyMonad m => FL prim C(x y) -> m ()
+ src/Darcs/Patch/Prim/V1.hs view
@@ -0,0 +1,16 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Darcs.Patch.Prim.V1 ( Prim ) where++import Darcs.Patch.Prim.V1.Apply ()+import Darcs.Patch.Prim.V1.Coalesce ()+import Darcs.Patch.Prim.V1.Commute ()+import Darcs.Patch.Prim.V1.Core ( Prim )+import Darcs.Patch.Prim.V1.Details ()+import Darcs.Patch.Prim.V1.Read ()+import Darcs.Patch.Prim.V1.Show ()++import Darcs.Patch.Prim.Class ( PrimPatch )+import Darcs.Patch.Patchy ( Patchy )++instance PrimPatch Prim+instance Patchy Prim
+ src/Darcs/Patch/Prim/V1/Apply.hs view
@@ -0,0 +1,131 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Darcs.Patch.Prim.V1.Apply () where++import Darcs.Patch.Apply ( Apply(..) )+import Darcs.Patch.Repair ( RepairToFL(..) )++import Darcs.Patch.Prim.Class ( PrimApply(..) )+import Darcs.Patch.Prim.V1.Core+ ( Prim(..),+ DirPatchType(..), FilePatchType(..) )+import Darcs.Patch.Prim.V1.Show ( showHunk )++import Darcs.Patch.FileName ( fn2fp, fp2fn )+import Darcs.Patch.Format ( FileNameFormat(..) )+import Darcs.Patch.TokenReplace ( tryTokInternal )++import Darcs.Global ( darcsdir )+import Darcs.Patch.ApplyMonad ( ApplyMonad(..) )++import Darcs.Repository.Prefs ( changePrefval )++import Darcs.Witnesses.Ordered ( FL(..), mapFL_FL, spanFL, (:>)(..) )++import ByteStringUtils ( unlinesPS, breakAfterNthNewline, breakBeforeNthNewline, )+import Printer( renderString )++import Control.Monad ( when )+import qualified Data.ByteString as B ( ByteString, empty, null, concat )+import qualified Data.ByteString.Char8 as BC (pack, singleton, unpack)+import Data.List ( intersperse )++#include "gadts.h"+#include "impossible.h"++type FileContents = B.ByteString++instance Apply Prim where+ apply (FP f RmFile) = mRemoveFile f+ apply (FP f AddFile) = mCreateFile f+ apply p@(FP _ (Hunk _ _ _)) = applyPrimFL (p :>: NilFL)+ apply (FP f (TokReplace t o n)) = mModifyFilePSs f doreplace+ where doreplace ls =+ case mapM (tryTokInternal t (BC.pack o) (BC.pack n)) ls of+ Nothing -> fail $ "replace patch to " ++ fn2fp f+ ++ " couldn't apply."+ Just ls' -> return $ map B.concat ls'+ apply (FP f (Binary o n)) = mModifyFilePS f doapply+ where doapply oldf = if o == oldf+ then return n+ else fail $ "binary patch to " ++ fn2fp f+ ++ " couldn't apply."+ apply (DP d AddDir) = mCreateDirectory d+ apply (DP d RmDir) = mRemoveDirectory d+ apply (Move f f') = mRename f f'+ apply (ChangePref p f t) = mChangePref p f t++instance RepairToFL Prim where+ applyAndTryToFixFL (FP f RmFile) =+ do x <- mReadFilePS f+ mRemoveFile f+ return $ case B.null x of+ True -> Nothing+ False -> Just ("WARNING: Fixing removal of non-empty file "++fn2fp f,+ FP f (Binary x B.empty) :>: FP f RmFile :>: NilFL )+ applyAndTryToFixFL p = do apply p; return Nothing++instance PrimApply Prim where+ applyPrimFL NilFL = return ()+ applyPrimFL ((FP f h@(Hunk _ _ _)):>:the_ps)+ = case spanFL f_hunk the_ps of+ (xs :> ps') ->+ do let foo = h :>: mapFL_FL (\(FP _ h') -> h') xs+ mModifyFilePS f $ hunkmod foo+ applyPrimFL ps'+ where f_hunk (FP f' (Hunk _ _ _)) | f == f' = True+ f_hunk _ = False+ hunkmod :: ApplyMonad m => FL FilePatchType C(x y)+ -> B.ByteString -> m B.ByteString+ hunkmod NilFL ps = return ps+ hunkmod (Hunk line old new:>:hs) ps+ = case applyHunkLines [(line,old,new)] ps of+ Just ps' -> hunkmod hs ps'+ Nothing -> fail $ "### Error applying:\n" +++ (renderString $ showHunk NewFormat f line old new) +++ "\n### to file " ++ fn2fp f ++ ":\n" ++ BC.unpack ps+ hunkmod _ _ = impossible+ applyPrimFL (p:>:ps) = do apply p+ applyPrimFL ps++applyHunks :: [(Int, [B.ByteString], [B.ByteString])]+ -> B.ByteString -> Maybe [B.ByteString]+applyHunks [] ps = Just [ps]+applyHunks ((l, [], n):hs) ps+ = case breakBeforeNthNewline (l - 2) ps of+ (prfix, after_prefix) -> do rest <- applyHunks hs after_prefix+ return $ intersperse nl (prfix:n) ++ rest+ where nl = BC.singleton '\n'+applyHunks ((l, o, n):hs) ps+ = case breakBeforeNthNewline (l - 2) ps of+ (prfix, after_prefix) ->+ case breakBeforeNthNewline (length o) after_prefix of+ (oo, _) | oo /= unlinesPS (B.empty:o) -> fail "applyHunks error"+ (_, suffix) ->+ do rest <- applyHunks hs suffix+ return $ intersperse nl (prfix:n) ++ rest+ where nl = BC.singleton '\n'++applyHunkLines :: [(Int, [B.ByteString], [B.ByteString])]+ -> FileContents -> Maybe FileContents+applyHunkLines [] c = Just c+applyHunkLines [(1, [], n)] ps | B.null ps = Just $ unlinesPS (n++[B.empty])+applyHunkLines hs@((l, o, n):hs') ps =+ do pss <- case l of+ 1 -> case breakAfterNthNewline (length o) ps of+ Nothing -> if ps == unlinesPS o+ then return $ intersperse nl n+ else fail "applyHunkLines: Unexpected hunks"+ Just (shouldbeo, suffix)+ | shouldbeo /= unlinesPS (o++[B.empty]) ->+ fail $ "applyHunkLines: Bad patch!"+ | null n ->+ do x <- applyHunkLines hs' suffix+ return [x]+ | otherwise ->+ do rest <- applyHunks hs' suffix+ return $ intersperse nl n ++ nl:rest+ _ | l < 0 -> bug "Prim.applyHunkLines: After -ve lines?"+ | otherwise -> applyHunks hs ps+ let result = B.concat pss+ return result+ where nl = BC.singleton '\n'
+ src/Darcs/Patch/Prim/V1/Coalesce.hs view
@@ -0,0 +1,239 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Darcs.Patch.Prim.V1.Coalesce+ ()+ where++import Prelude hiding ( pi )+import Data.Map ( elems, fromListWith, mapWithKey )++import qualified Data.ByteString as B (ByteString)++import Darcs.Patch.FileName ( FileName, fp2fn )+import Darcs.Patch.Prim.Class ( PrimCanonize(..) )+import Darcs.Patch.Prim.V1.Commute ()+import Darcs.Patch.Prim.V1.Core+ ( Prim(..), FilePatchType(..), DirPatchType(..)+ , comparePrim, isIdentity+ )+import Darcs.Patch.Prim.V1.Show ()+import Darcs.Witnesses.Eq ( MyEq(..), EqCheck(..) )+import Darcs.Witnesses.Ordered ( FL(..), RL(..), (:>)(..), (:<)(..)+ , reverseRL, mapFL, mapFL_FL+ , concatFL, lengthFL, (+>+) )+import Darcs.Witnesses.Sealed ( unseal, Sealed2(..), unsafeUnseal2+ , Gap(..), unFreeLeft+ )+import Darcs.Witnesses.Unsafe ( unsafeCoerceP, unsafeCoercePEnd )+import Darcs.Patch.Invert ( Invert(..) )+import Darcs.Patch.Commute ( Commute(..) )+-- import Darcs.Patch.Permutations () -- for Invert instance of FL+import Lcs ( getChanges )++#include "gadts.h"+#include "impossible.h"++-- | 'coalesce' @p2 :< p1@ tries to combine @p1@ and @p2@ into a single+-- patch without intermediary changes. For example, two hunk patches+-- modifying adjacent lines can be coalesced into a bigger hunk patch.+-- Or a patch which moves file A to file B can be coalesced with a+-- patch that moves file B into file C, yielding a patch that moves+-- file A to file C.+coalesce :: (Prim :< Prim) C(x y) -> Maybe (FL Prim C(x y))+coalesce (FP f1 _ :< FP f2 _) | f1 /= f2 = Nothing+coalesce (p2 :< p1) | IsEq <- p2 =\/= invert p1 = Just NilFL+coalesce (FP f1 p1 :< FP _ p2) = fmap (:>: NilFL) $ coalesceFilePrim f1 (p1 :< p2) -- f1 = f2+coalesce (Move a b :< Move b' a') | a == a' = Just $ Move b' b :>: NilFL+coalesce (Move a b :< FP f AddFile) | f == a = Just $ FP b AddFile :>: NilFL+coalesce (Move a b :< DP f AddDir) | f == a = Just $ DP b AddDir :>: NilFL+coalesce (FP f RmFile :< Move a b) | b == f = Just $ FP a RmFile :>: NilFL+coalesce (DP f RmDir :< Move a b) | b == f = Just $ DP a RmDir :>: NilFL+coalesce (ChangePref p f1 t1 :< ChangePref p2 f2 t2) | p == p2 && t2 == f1 = Just $ ChangePref p f2 t1 :>: NilFL+coalesce _ = Nothing++mapPrimFL :: (FORALL(x y) FL Prim C(x y) -> FL Prim C(x y))+ -> FL Prim C(w z) -> FL Prim C(w z)+mapPrimFL f x =+-- an optimisation; break the list up into independent sublists+-- and apply f to each of them+ case mapM toSimpleSealed $ mapFL Sealed2 x of+ Just sx -> concatFL $ unsealList $ elems $+ mapWithKey (\ k p -> Sealed2 (f (fromSimples k (unsealList (p []))))) $+ fromListWith (flip (.)) $+ map (\ (a,b) -> (a,(b:))) sx+ Nothing -> f x+ where+ unsealList :: [Sealed2 p] -> FL p C(a b)+ unsealList [] = unsafeCoerceP NilFL+ unsealList (y:ys) = unsafeUnseal2 y :>: unsealList ys++ toSimpleSealed :: Sealed2 Prim -> Maybe (FileName, Sealed2 Simple)+ toSimpleSealed (Sealed2 p) = fmap (\(fn, s) -> (fn, Sealed2 s)) (toSimple p)++++data Simple C(x y) = SFP !(FilePatchType C(x y)) | SDP !(DirPatchType C(x y))+ | SCP String String String+ deriving ( Show )++toSimple :: Prim C(x y) -> Maybe (FileName, Simple C(x y))+toSimple (FP a b) = Just (a, SFP b)+toSimple (DP a AddDir) = Just (a, SDP AddDir)+toSimple (DP _ RmDir) = Nothing -- ordering is trickier with rmdir present+toSimple (Move _ _) = Nothing+toSimple (ChangePref a b c) = Just (fp2fn "_darcs/prefs/prefs", SCP a b c)++fromSimple :: FileName -> Simple C(x y) -> Prim C(x y)+fromSimple a (SFP b) = FP a b+fromSimple a (SDP b) = DP a b+fromSimple _ (SCP a b c) = ChangePref a b c++fromSimples :: FileName -> FL Simple C(x y) -> FL Prim C(x y)+fromSimples a bs = mapFL_FL (fromSimple a) bs++tryHarderToShrink :: FL Prim C(x y) -> FL Prim C(x y)+tryHarderToShrink x = tryToShrink2 $ maybe x id (tryShrinkingInverse x)++tryToShrink2 :: FL Prim C(x y) -> FL Prim C(x y)+tryToShrink2 psold =+ let ps = sortCoalesceFL psold+ ps_shrunk = shrinkABit ps+ in+ if lengthFL ps_shrunk < lengthFL ps+ then tryToShrink2 ps_shrunk+ else ps_shrunk++shrinkABit :: FL Prim C(x y) -> FL Prim C(x y)+shrinkABit NilFL = NilFL+shrinkABit (p:>:ps) =+ case tryOne NilRL p ps of+ Nothing -> p :>: shrinkABit ps+ Just ps' -> ps'++tryOne :: RL Prim C(w x) -> Prim C(x y) -> FL Prim C(y z)+ -> Maybe (FL Prim C(w z))+tryOne _ _ NilFL = Nothing+tryOne sofar p (p1:>:ps) =+ case coalesce (p1 :< p) of+ Just p' -> Just (reverseRL sofar +>+ p' +>+ ps)+ Nothing -> case commute (p :> p1) of+ Nothing -> Nothing+ Just (p1' :> p') -> tryOne (p1':<:sofar) p' ps++-- | The heart of "sortCoalesceFL"+sortCoalesceFL2 :: FL Prim C(x y) -> FL Prim C(x y)+sortCoalesceFL2 NilFL = NilFL+sortCoalesceFL2 (x:>:xs) | IsEq <- isIdentity x = sortCoalesceFL2 xs+sortCoalesceFL2 (x:>:xs) = either id id $ pushCoalescePatch x $ sortCoalesceFL2 xs++-- | 'pushCoalescePatch' @new ps@ is almost like @new :>: ps@ except+-- as an alternative to consing, we first try to coalesce @new@ with+-- the head of @ps@. If this fails, we try again, using commutation+-- to push @new@ down the list until we find a place where either+-- (a) @new@ is @LT@ the next member of the list [see 'comparePrim']+-- (b) commutation fails or+-- (c) coalescing succeeds.+-- The basic principle is to coalesce if we can and cons otherwise.+--+-- As an additional optimization, pushCoalescePatch outputs a Left+-- value if it wasn't able to shrink the patch sequence at all, and+-- a Right value if it was indeed able to shrink the patch sequence.+-- This avoids the O(N) calls to lengthFL that were in the older+-- code.+--+-- Also note that pushCoalescePatch is only ever used (and should+-- only ever be used) as an internal function in in+-- sortCoalesceFL2.+pushCoalescePatch :: Prim C(x y) -> FL Prim C(y z)+ -> Either (FL Prim C(x z)) (FL Prim C(x z))+pushCoalescePatch new NilFL = Left (new:>:NilFL)+pushCoalescePatch new ps@(p:>:ps')+ = case coalesce (p :< new) of+ Just (new' :>: NilFL) -> Right $ either id id $ pushCoalescePatch new' ps'+ Just NilFL -> Right ps'+ Just _ -> impossible -- coalesce either returns a singleton or empty+ Nothing -> if comparePrim new p == LT then Left (new:>:ps)+ else case commute (new :> p) of+ Just (p' :> new') ->+ case pushCoalescePatch new' ps' of+ Right r -> Right $ either id id $+ pushCoalescePatch p' r+ Left r -> Left (p' :>: r)+ Nothing -> Left (new:>:ps)++coalesceFilePrim :: FileName -> (FilePatchType :< FilePatchType) C(x y)+ -> Maybe (Prim C(x y))+coalesceFilePrim f (Hunk line1 old1 new1 :< Hunk line2 old2 new2)+ = coalesceHunk f line1 old1 new1 line2 old2 new2+-- Token replace patches operating right after (or before) AddFile (RmFile)+-- is an identity patch, as far as coalescing is concerned.+coalesceFilePrim f (TokReplace _ _ _ :< AddFile) = Just $ FP f AddFile+coalesceFilePrim f (RmFile :< TokReplace _ _ _) = Just $ FP f RmFile+coalesceFilePrim f (TokReplace t1 o1 n1 :< TokReplace t2 o2 n2)+ | t1 == t2 && n2 == o1 = Just $ FP f $ TokReplace t1 o2 n1+coalesceFilePrim f (Binary m n :< Binary o m')+ | m == m' = Just $ FP f $ Binary o n+coalesceFilePrim _ _ = Nothing++coalesceHunk :: FileName+ -> Int -> [B.ByteString] -> [B.ByteString]+ -> Int -> [B.ByteString] -> [B.ByteString]+ -> Maybe (Prim C(x y))+coalesceHunk f line1 old1 new1 line2 old2 new2+ | line1 == line2 && lengthold1 < lengthnew2 =+ if take lengthold1 new2 /= old1+ then Nothing+ else case drop lengthold1 new2 of+ extranew -> Just (FP f (Hunk line1 old2 (new1 ++ extranew)))+ | line1 == line2 && lengthold1 > lengthnew2 =+ if take lengthnew2 old1 /= new2+ then Nothing+ else case drop lengthnew2 old1 of+ extraold -> Just (FP f (Hunk line1 (old2 ++ extraold) new1))+ | line1 == line2 = if new2 == old1 then Just (FP f (Hunk line1 old2 new1))+ else Nothing+ | line1 < line2 && lengthold1 >= line2 - line1 =+ case take (line2 - line1) old1 of+ extra-> coalesceHunk f line1 old1 new1 line1 (extra ++ old2) (extra ++ new2)+ | line1 > line2 && lengthnew2 >= line1 - line2 =+ case take (line1 - line2) new2 of+ extra-> coalesceHunk f line2 (extra ++ old1) (extra ++ new1) line2 old2 new2+ | otherwise = Nothing+ where lengthold1 = length old1+ lengthnew2 = length new2++canonizeHunk :: Gap w+ => FileName -> Int -> [B.ByteString] -> [B.ByteString]+ -> w (FL Prim)+canonizeHunk f line old new+ | null old || null new+ = freeGap (FP f (Hunk line old new) :>: NilFL)+canonizeHunk f line old new = makeHoley f line $ getChanges old new++makeHoley :: Gap w+ => FileName -> Int -> [(Int,[B.ByteString], [B.ByteString])]+ -> w (FL Prim)+makeHoley f line changes =+ foldr (joinGap (:>:)) (emptyGap NilFL) $+ map (\ (l,o,n) -> freeGap (FP f (Hunk (l+line) o n))) changes++instance PrimCanonize Prim where+ tryToShrink = mapPrimFL tryHarderToShrink++ tryShrinkingInverse (x:>:y:>:z)+ | IsEq <- invert x =\/= y = Just z+ | otherwise = case tryShrinkingInverse (y:>:z) of+ Nothing -> Nothing+ Just yz' -> Just $ case tryShrinkingInverse (x:>:yz') of+ Nothing -> x:>:yz'+ Just xyz' -> xyz'+ tryShrinkingInverse _ = Nothing++ sortCoalesceFL = mapPrimFL sortCoalesceFL2+ canonize p | IsEq <- isIdentity p = NilFL+ canonize (FP f (Hunk line old new)) = unseal unsafeCoercePEnd $ unFreeLeft $ canonizeHunk f line old new+ canonize p = p :>: NilFL+ -- Running canonize twice is apparently necessary to fix issue525;+ -- would be nice to understand why.+ canonizeFL = concatFL . mapFL_FL canonize . sortCoalesceFL .+ concatFL . mapFL_FL canonize+ join (x :> y) = coalesce (y :< x)
+ src/Darcs/Patch/Prim/V1/Commute.hs view
@@ -0,0 +1,215 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Darcs.Patch.Prim.V1.Commute+ ( Perhaps(..)+ , subcommutes, WrappedCommuteFunction(..)+ )+ where++import Prelude hiding ( pi )+import Control.Monad ( MonadPlus, msum, mzero, mplus )++import qualified Data.ByteString as B (ByteString, concat)+import qualified Data.ByteString.Char8 as BC (pack)++import Darcs.Patch.FileName ( FileName, fn2fp, movedirfilename )+import Darcs.Witnesses.Ordered ( (:<)(..) )+import Darcs.Witnesses.Unsafe ( unsafeCoerceP )+import Darcs.Patch.Prim.V1.Core+ ( Prim(..), FilePatchType(..) )+import Darcs.Patch.Invert ( Invert(..) )+import Darcs.Patch.Commute ( Commute(..), toFwdCommute, toRevCommute )+import Darcs.Patch.Permutations () -- for Invert instance of FL+import Darcs.Patch.TokenReplace ( tryTokInternal )++#include "impossible.h"+#include "gadts.h"++isInDirectory :: FileName -> FileName -> Bool+isInDirectory d f = iid (fn2fp d) (fn2fp f)+ where iid (cd:cds) (cf:cfs)+ | cd /= cf = False+ | otherwise = iid cds cfs+ iid [] ('/':_) = True+ iid [] [] = True -- Count directory itself as being in directory...+ iid _ _ = False++data Perhaps a = Unknown | Failed | Succeeded a++instance Monad Perhaps where+ (Succeeded x) >>= k = k x+ Failed >>= _ = Failed+ Unknown >>= _ = Unknown+ Failed >> _ = Failed+ (Succeeded _) >> k = k+ Unknown >> k = k+ return = Succeeded+ fail _ = Unknown++instance MonadPlus Perhaps where+ mzero = Unknown+ Unknown `mplus` ys = ys+ Failed `mplus` _ = Failed+ (Succeeded x) `mplus` _ = Succeeded x++toMaybe :: Perhaps a -> Maybe a+toMaybe (Succeeded x) = Just x+toMaybe _ = Nothing++toPerhaps :: Maybe a -> Perhaps a+toPerhaps (Just x) = Succeeded x+toPerhaps Nothing = Failed++cleverCommute :: CommuteFunction -> CommuteFunction+cleverCommute c (p1:<p2) =+ case c (p1 :< p2) of+ Succeeded x -> Succeeded x+ Failed -> Failed+ Unknown -> case c (invert p2 :< invert p1) of+ Succeeded (p1' :< p2') -> Succeeded (invert p2' :< invert p1')+ Failed -> Failed+ Unknown -> Unknown+--cleverCommute c (p1,p2) = c (p1,p2) `mplus`+-- (case c (invert p2,invert p1) of+-- Succeeded (p1', p2') -> Succeeded (invert p2', invert p1')+-- Failed -> Failed+-- Unknown -> Unknown)++speedyCommute :: CommuteFunction -- Deal with common cases quickly!+ -- Two file-patches modifying different files trivially commute.+speedyCommute (p2@(FP f' _) :< p1@(FP f _))+ | f /= f' = Succeeded (unsafeCoerceP p1 :< unsafeCoerceP p2)+speedyCommute _other = Unknown++everythingElseCommute :: CommuteFunction+everythingElseCommute x = eec x+ where+ eec :: CommuteFunction+ eec (ChangePref p f t :<p1) = Succeeded (unsafeCoerceP p1 :< ChangePref p f t)+ eec (p2 :<ChangePref p f t) = Succeeded (ChangePref p f t :< unsafeCoerceP p2)+ eec xx = cleverCommute commuteFiledir xx++{-+Note that it must be true that++commutex (A^-1 A, P) = Just (P, A'^-1 A')++and++if commutex (A, B) == Just (B', A')+then commutex (B^-1, A^-1) == Just (A'^-1, B'^-1)+-}++instance Commute Prim where+ commute x = toMaybe $ msum [toFwdCommute speedyCommute x,+ toFwdCommute everythingElseCommute x+ ]++isSuperdir :: FileName -> FileName -> Bool+isSuperdir d1 d2 = isd (fn2fp d1) (fn2fp d2)+ where isd s1 s2 =+ length s2 >= length s1 + 1 && take (length s1 + 1) s2 == s1 ++ "/"++commuteFiledir :: CommuteFunction+commuteFiledir (FP f1 p1 :< FP f2 p2) =+ if f1 /= f2 then Succeeded ( FP f2 (unsafeCoerceP p2) :< FP f1 (unsafeCoerceP p1) )+ else commuteFP f1 (p1 :< p2)+commuteFiledir (DP d1 p1 :< DP d2 p2) =+ if (not $ isInDirectory d1 d2) && (not $ isInDirectory d2 d1) &&+ d1 /= d2+ then Succeeded ( DP d2 (unsafeCoerceP p2) :< DP d1 (unsafeCoerceP p1) )+ else Failed+commuteFiledir (DP d dp :< FP f fp) =+ if not $ isInDirectory d f+ then Succeeded (FP f (unsafeCoerceP fp) :< DP d (unsafeCoerceP dp))+ else Failed++commuteFiledir (Move d d' :< FP f2 p2)+ | f2 == d' = Failed+ | (p2 == AddFile || p2 == RmFile) && d == f2 = Failed+ | otherwise = Succeeded (FP (movedirfilename d d' f2) (unsafeCoerceP p2) :< Move d d')+commuteFiledir (Move d d' :< DP d2 p2)+ | isSuperdir d2 d' || isSuperdir d2 d = Failed+ | d == d2 = Failed -- The exact guard is p2 == AddDir && d == d2+ -- but note d == d2 suffices because we know p2 != RmDir+ -- (and hence p2 == AddDir) since patches must be sequential.+ | d2 == d' = Failed+ | otherwise = Succeeded (DP (movedirfilename d d' d2) (unsafeCoerceP p2) :< Move d d')+commuteFiledir (Move d d' :< Move f f')+ | f == d' || f' == d = Failed+ | f == d || f' == d' = Failed+ | d `isSuperdir` f && f' `isSuperdir` d' = Failed+ | otherwise =+ Succeeded (Move (movedirfilename d d' f) (movedirfilename d d' f') :<+ Move (movedirfilename f' f d) (movedirfilename f' f d'))++commuteFiledir _ = Unknown++type CommuteFunction = FORALL(x y) (Prim :< Prim) C(x y) -> Perhaps ((Prim :< Prim) C(x y))+newtype WrappedCommuteFunction = WrappedCommuteFunction { runWrappedCommuteFunction :: CommuteFunction }++subcommutes :: [(String, WrappedCommuteFunction)]+subcommutes =+ [("speedyCommute", WrappedCommuteFunction speedyCommute),+ ("commuteFiledir", WrappedCommuteFunction (cleverCommute commuteFiledir)),+ ("commuteFilepatches", WrappedCommuteFunction (cleverCommute commuteFilepatches)),+ ("commutex", WrappedCommuteFunction (toPerhaps . toRevCommute commute))+ ]++commuteFilepatches :: CommuteFunction+commuteFilepatches (FP f1 p1 :< FP f2 p2) | f1 == f2 = commuteFP f1 (p1 :< p2)+commuteFilepatches _ = Unknown++commuteFP :: FileName -> (FilePatchType :< FilePatchType) C(x y)+ -> Perhaps ((Prim :< Prim) C(x y))+commuteFP f (Hunk line1 [] [] :< p2) =+ seq f $ Succeeded (FP f (unsafeCoerceP p2) :< FP f (Hunk line1 [] []))+commuteFP f (p2 :< Hunk line1 [] []) =+ seq f $ Succeeded (FP f (Hunk line1 [] []) :< FP f (unsafeCoerceP p2))+commuteFP f (Hunk line1 old1 new1 :< Hunk line2 old2 new2) = seq f $+ toPerhaps $ commuteHunk f (Hunk line1 old1 new1 :< Hunk line2 old2 new2)+commuteFP f (TokReplace t o n :< Hunk line2 old2 new2) = seq f $+ case tryTokReplace t o n old2 of+ Nothing -> Failed+ Just old2' ->+ case tryTokReplace t o n new2 of+ Nothing -> Failed+ Just new2' -> Succeeded (FP f (Hunk line2 old2' new2') :<+ FP f (TokReplace t o n))+commuteFP f (TokReplace t o n :< TokReplace t2 o2 n2)+ | seq f $ t /= t2 = Failed+ | o == o2 = Failed+ | n == o2 = Failed+ | o == n2 = Failed+ | n == n2 = Failed+ | otherwise = Succeeded (FP f (TokReplace t2 o2 n2) :<+ FP f (TokReplace t o n))+commuteFP _ _ = Unknown++commuteHunk :: FileName -> (FilePatchType :< FilePatchType) C(x y)+ -> Maybe ((Prim :< Prim) C(x y))+commuteHunk f (Hunk line2 old2 new2 :< Hunk line1 old1 new1)+ | seq f $ line1 + lengthnew1 < line2 =+ Just (FP f (Hunk line1 old1 new1) :<+ FP f (Hunk (line2 - lengthnew1 + lengthold1) old2 new2))+ | line2 + lengthold2 < line1 =+ Just (FP f (Hunk (line1+ lengthnew2 - lengthold2) old1 new1) :<+ FP f (Hunk line2 old2 new2))+ | line1 + lengthnew1 == line2 &&+ lengthold2 /= 0 && lengthold1 /= 0 && lengthnew2 /= 0 && lengthnew1 /= 0 =+ Just (FP f (Hunk line1 old1 new1) :<+ FP f (Hunk (line2 - lengthnew1 + lengthold1) old2 new2))+ | line2 + lengthold2 == line1 &&+ lengthold2 /= 0 && lengthold1 /= 0 && lengthnew2 /= 0 && lengthnew1 /= 0 =+ Just (FP f (Hunk (line1 + lengthnew2 - lengthold2) old1 new1) :<+ FP f (Hunk line2 old2 new2))+ | otherwise = seq f Nothing+ where lengthnew1 = length new1+ lengthnew2 = length new2+ lengthold1 = length old1+ lengthold2 = length old2+commuteHunk _ _ = impossible++tryTokReplace :: String -> String -> String+ -> [B.ByteString] -> Maybe [B.ByteString]+tryTokReplace t o n mss =+ mapM (fmap B.concat . tryTokInternal t (BC.pack o) (BC.pack n)) mss
+ src/Darcs/Patch/Prim/V1/Core.hs view
@@ -0,0 +1,166 @@+-- Copyright (C) 2002-2003,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.++{-# LANGUAGE CPP #-}++#include "gadts.h"++module Darcs.Patch.Prim.V1.Core+ ( Prim(..),+ DirPatchType(..), FilePatchType(..),+ isIdentity,+ comparePrim,+ )+ where++import Prelude hiding ( pi )++import qualified Data.ByteString as B (ByteString)++import Darcs.Patch.FileName ( FileName, fn2fp, fp2fn, normPath )+import Darcs.Witnesses.Eq ( MyEq(..), EqCheck(..) )+import Darcs.Witnesses.Unsafe ( unsafeCoerceP )+import Darcs.Patch.FileHunk ( FileHunk(..), IsHunk(..) )+import Darcs.Patch.Invert ( Invert(..) )+import Darcs.Patch.Inspect ( PatchInspect(..) )+import Darcs.Patch.Permutations () -- for Invert instance of FL+import Darcs.Patch.Prim.Class ( PrimConstruct(..), PrimClassify(..) )++data Prim C(x y) where+ Move :: !FileName -> !FileName -> Prim C(x y)+ DP :: !FileName -> !(DirPatchType C(x y)) -> Prim C(x y)+ FP :: !FileName -> !(FilePatchType C(x y)) -> Prim C(x y)+ ChangePref :: !String -> !String -> !String -> Prim C(x y)++data FilePatchType C(x y) = RmFile | AddFile+ | Hunk !Int [B.ByteString] [B.ByteString]+ | TokReplace !String !String !String+ | Binary B.ByteString B.ByteString+ deriving (Eq,Ord)++data DirPatchType C(x y) = RmDir | AddDir+ deriving (Eq,Ord)++instance MyEq FilePatchType where+ unsafeCompare a b = a == unsafeCoerceP b++instance MyEq DirPatchType where+ unsafeCompare a b = a == unsafeCoerceP b++isIdentity :: Prim C(x y) -> EqCheck C(x y)+isIdentity (FP _ (Binary old new)) | old == new = unsafeCoerceP IsEq+isIdentity (FP _ (Hunk _ old new)) | old == new = unsafeCoerceP IsEq+isIdentity (FP _ (TokReplace _ old new)) | old == new = unsafeCoerceP IsEq+isIdentity (Move old new) | old == new = unsafeCoerceP IsEq+isIdentity _ = NotEq++instance PrimClassify Prim where+ primIsAddfile (FP _ AddFile) = True+ primIsAddfile _ = False++ primIsAdddir (DP _ AddDir) = True+ primIsAdddir _ = False++ primIsHunk (FP _ (Hunk _ _ _)) = True+ primIsHunk _ = False++ primIsBinary (FP _ (Binary _ _)) = True+ primIsBinary _ = False++ primIsSetpref (ChangePref _ _ _) = True+ primIsSetpref _ = False++ is_filepatch (FP f _) = Just f+ is_filepatch _ = Nothing++evalargs :: (a -> b -> c) -> a -> b -> c+evalargs f x y = (f $! x) $! y++instance PrimConstruct Prim where+ addfile f = FP (fp2fn $ nFn f) AddFile+ rmfile f = FP (fp2fn $ nFn f) RmFile+ adddir d = DP (fp2fn $ nFn d) AddDir+ rmdir d = DP (fp2fn $ nFn d) RmDir+ move f f' = Move (fp2fn $ nFn f) (fp2fn $ nFn f')+ changepref p f t = ChangePref p f t+ hunk f line old new = evalargs FP (fp2fn $ nFn f) (Hunk line old new)+ tokreplace f tokchars old new =+ evalargs FP (fp2fn $ nFn f) (TokReplace tokchars old new)+ binary f old new = FP (fp2fn $! nFn f) $ Binary old new+ primFromHunk (FileHunk fn line before after) = FP fn (Hunk line before after)++nFn :: FilePath -> FilePath+nFn f = "./"++(fn2fp $ normPath $ fp2fn f)++instance IsHunk Prim where+ isHunk (FP fn (Hunk line before after)) = Just (FileHunk fn line before after)+ isHunk _ = Nothing++instance Invert Prim where+ invert (FP f RmFile) = FP f AddFile+ invert (FP f AddFile) = FP f RmFile+ invert (FP f (Hunk line old new)) = FP f $ Hunk line new old+ invert (FP f (TokReplace t o n)) = FP f $ TokReplace t n o+ invert (FP f (Binary o n)) = FP f $ Binary n o+ invert (DP d RmDir) = DP d AddDir+ invert (DP d AddDir) = DP d RmDir+ invert (Move f f') = Move f' f+ invert (ChangePref p f t) = ChangePref p t f++instance PatchInspect Prim where+ -- Recurse on everything, these are potentially spoofed patches+ listTouchedFiles (Move f1 f2) = map fn2fp [f1, f2]+ listTouchedFiles (FP f _) = [fn2fp f]+ listTouchedFiles (DP d _) = [fn2fp d]+ listTouchedFiles (ChangePref _ _ _) = []++ hunkMatches f (FP _ (Hunk _ remove add)) = anyMatches remove || anyMatches add+ where anyMatches = foldr ((||) . f) False+ hunkMatches _ (FP _ _) = False+ hunkMatches _ (DP _ _) = False+ hunkMatches _ (ChangePref _ _ _) = False+ hunkMatches _ (Move _ _) = False++instance MyEq Prim where+ unsafeCompare (Move a b) (Move c d) = a == c && b == d+ unsafeCompare (DP d1 p1) (DP d2 p2)+ = d1 == d2 && p1 `unsafeCompare` p2+ unsafeCompare (FP f1 fp1) (FP f2 fp2)+ = f1 == f2 && fp1 `unsafeCompare` fp2+ unsafeCompare (ChangePref a1 b1 c1) (ChangePref a2 b2 c2)+ = c1 == c2 && b1 == b2 && a1 == a2+ unsafeCompare _ _ = False++instance Eq (Prim C(x y)) where+ (==) = unsafeCompare++-- | 'comparePrim' @p1 p2@ is used to provide an arbitrary ordering between+-- @p1@ and @p2@. Basically, identical patches are equal and+-- @Move < DP < FP < ChangePref@.+-- Everything else is compared in dictionary order of its arguments.+comparePrim :: Prim C(x y) -> Prim C(w z) -> Ordering+comparePrim (Move a b) (Move c d) = compare (a, b) (c, d)+comparePrim (Move _ _) _ = LT+comparePrim _ (Move _ _) = GT+comparePrim (DP d1 p1) (DP d2 p2) = compare (d1, p1) $ unsafeCoerceP (d2, p2)+comparePrim (DP _ _) _ = LT+comparePrim _ (DP _ _) = GT+comparePrim (FP f1 fp1) (FP f2 fp2) = compare (f1, fp1) $ unsafeCoerceP (f2, fp2)+comparePrim (FP _ _) _ = LT+comparePrim _ (FP _ _) = GT+comparePrim (ChangePref a1 b1 c1) (ChangePref a2 b2 c2)+ = compare (c1, b1, a1) (c2, b2, a2)
+ src/Darcs/Patch/Prim/V1/Details.hs view
@@ -0,0 +1,29 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Darcs.Patch.Prim.V1.Details+ ()+ where++import Prelude hiding ( pi )+import Darcs.Patch.Prim.Class ( PrimDetails(..) )+import Darcs.Patch.Prim.V1.Core+ ( Prim(..), FilePatchType(..), DirPatchType(..) )+import Darcs.Patch.SummaryData ( SummDetail(..), SummOp(..) )+import Darcs.Patch.TokenReplace ( tryTokInternal )+import Darcs.Patch.FileName ( fn2fp, fp2fn, movedirfilename, fn2ps )++import qualified Data.ByteString as B ( ByteString, concat )+import qualified Data.ByteString.Char8 as BC ( pack, split )+import Data.Maybe ( catMaybes )++#include "gadts.h"++instance PrimDetails Prim where+ summarizePrim (FP f (Hunk _ o n)) = [SummFile SummMod f (length o) (length n) 0]+ summarizePrim (FP f (Binary _ _)) = [SummFile SummMod f 0 0 0]+ summarizePrim (FP f AddFile) = [SummFile SummAdd f 0 0 0]+ summarizePrim (FP f RmFile) = [SummFile SummRm f 0 0 0]+ summarizePrim (FP f (TokReplace _ _ _)) = [SummFile SummMod f 0 0 1]+ summarizePrim (DP d AddDir) = [SummAddDir d]+ summarizePrim (DP d RmDir) = [SummRmDir d]+ summarizePrim (Move f1 f2) = [SummMv f1 f2]+ summarizePrim (ChangePref _ _ _) = [SummNone]
+ src/Darcs/Patch/Prim/V1/Read.hs view
@@ -0,0 +1,164 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Darcs.Patch.Prim.V1.Read () where++import Darcs.Patch.Prim.Class ( PrimRead(..), hunk, binary )+import Darcs.Patch.Prim.V1.Core+ ( Prim(..),+ DirPatchType(..), FilePatchType(..) )++import Darcs.Patch.FileName ( fn2fp )+import Darcs.Patch.Format ( FileNameFormat(..) )+import Darcs.Patch.Read ( ReadPatch(..), readFileName )+import Darcs.Patch.ReadMonads (ParserM, takeTillChar,+ string, int,+ option, choice,+ anyChar, char, myLex',+ skipSpace, skipWhile, linesStartingWith)++import Darcs.Witnesses.Sealed ( seal )++import ByteStringUtils ( fromHex2PS )++import Control.Monad ( liftM )+import qualified Data.ByteString as B ( ByteString, init, tail, concat )+import qualified Data.ByteString.Char8 as BC ( unpack, pack )++#include "gadts.h"++instance ReadPatch Prim where+ readPatch' = readPrim OldFormat++instance PrimRead Prim where+ readPrim x+ = skipSpace >> choice+ [ return' $ readHunk x+ , return' $ readAddFile x+ , return' $ readAddDir x+ , return' $ readMove x+ , return' $ readRmFile x+ , return' $ readRmDir x+ , return' $ readTok x+ , return' $ readBinary x+ , return' $ readChangePref+ ]+ where+ return' = liftM seal++hunk' :: B.ByteString+hunk' = BC.pack "hunk"++replace :: B.ByteString+replace = BC.pack "replace"++binary' :: B.ByteString+binary' = BC.pack "binary"++addfile :: B.ByteString+addfile = BC.pack "addfile"++adddir :: B.ByteString+adddir = BC.pack "adddir"++rmfile :: B.ByteString+rmfile = BC.pack "rmfile"++rmdir :: B.ByteString+rmdir = BC.pack "rmdir"++move :: B.ByteString+move = BC.pack "move"++changepref :: B.ByteString+changepref = BC.pack "changepref"++readHunk :: ParserM m => FileNameFormat -> m (Prim C(x y))+readHunk x = do+ string hunk'+ fi <- myLex'+ l <- int+ have_nl <- skipNewline+ if have_nl+ then do _ <- linesStartingWith ' ' -- skipping context+ old <- linesStartingWith '-'+ new <- linesStartingWith '+'+ _ <- linesStartingWith ' ' -- skipping context+ return $ hunk (fn2fp $ readFileName x fi) l old new+ else return $ hunk (fn2fp $ readFileName x fi) l [] []++skipNewline :: ParserM m => m Bool+skipNewline = option False (char '\n' >> return True)++readTok :: ParserM m => FileNameFormat -> m (Prim C(x y))+readTok x = do+ string replace+ f <- myLex'+ regstr <- myLex'+ o <- myLex'+ n <- myLex'+ return $ FP (readFileName x f) $ TokReplace (BC.unpack (drop_brackets regstr))+ (BC.unpack o) (BC.unpack n)+ where drop_brackets = B.init . B.tail+++-- * Binary file modification+--+-- | Modify a binary file+--+-- > binary FILENAME+-- > oldhex+-- > *HEXHEXHEX+-- > ...+-- > newhex+-- > *HEXHEXHEX+-- > ...+readBinary :: ParserM m => FileNameFormat -> m (Prim C(x y))+readBinary x = do+ string binary'+ fi <- myLex'+ _ <- myLex'+ skipSpace+ old <- linesStartingWith '*'+ _ <- myLex'+ skipSpace+ new <- linesStartingWith '*'+ return $ binary (fn2fp $ readFileName x fi)+ (fromHex2PS $ B.concat old)+ (fromHex2PS $ B.concat new)++readAddFile :: ParserM m => FileNameFormat -> m (Prim C(x y))+readAddFile x = do string addfile+ f <- myLex'+ return $ FP (readFileName x f) AddFile++readRmFile :: ParserM m => FileNameFormat -> m (Prim C(x y))+readRmFile x = do string rmfile+ f <- myLex'+ return $ FP (readFileName x f) RmFile++readMove :: ParserM m => FileNameFormat -> m (Prim C(x y))+readMove x = do string move+ d <- myLex'+ d' <- myLex'+ return $ Move (readFileName x d) (readFileName x d')++readChangePref :: ParserM m => m (Prim C(x y))+readChangePref+ = do string changepref+ p <- myLex'+ skipWhile (== ' ')+ _ <- anyChar -- skip newline+ f <- takeTillChar '\n'+ _ <- anyChar -- skip newline+ t <- takeTillChar '\n'+ return $ ChangePref (BC.unpack p) (BC.unpack f) (BC.unpack t)++readAddDir :: ParserM m => FileNameFormat -> m (Prim C(x y))+readAddDir x = do string adddir+ f <- myLex'+ return $ DP (readFileName x f) AddDir++readRmDir :: ParserM m => FileNameFormat -> m (Prim C(x y))+readRmDir x = do string rmdir+ f <- myLex'+ return $ DP (readFileName x f) RmDir+
+ src/Darcs/Patch/Prim/V1/Show.hs view
@@ -0,0 +1,149 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE ViewPatterns #-}+module Darcs.Patch.Prim.V1.Show+ ( showHunk )+ where++import Prelude hiding ( pi )++import ByteStringUtils ( fromPS2Hex )+import qualified Data.ByteString as B (ByteString, length, take, drop)+import qualified Data.ByteString.Char8 as BC (head)++import Darcs.Patch.FileHunk ( FileHunk(..), IsHunk(..), showFileHunk )+import Darcs.Patch.FileName ( FileName )+import Darcs.Patch.Format ( PatchListFormat, FileNameFormat(..) )+import Darcs.Patch.Show ( ShowPatchBasic(..), ShowPatch(..), formatFileName )+import Darcs.Patch.Summary ( plainSummaryPrim, plainSummaryPrims )+import Darcs.Patch.Viewing ( showContextHunk )+import Darcs.Patch.Permutations () -- for Invert instance of FL+import Darcs.Patch.Prim.Class ( PrimShow(..) )+import Darcs.Patch.Prim.V1.Core+ ( Prim(..), FilePatchType(..), DirPatchType(..) )+import Darcs.Patch.Prim.V1.Details ()+import Darcs.Witnesses.Show ( appPrec, Show1(..), Show2(..), ShowDict(..) )+import Printer ( Doc, vcat,+ text, userchunk, invisibleText, invisiblePS, blueText,+ ($$), (<+>), (<>),+ )++#include "gadts.h"++-- TODO this instance shouldn't really be necessary, as Prims aren't used generically+instance PatchListFormat Prim++instance ShowPatchBasic Prim where+ showPatch = showPrim OldFormat++instance ShowPatch Prim where+ showContextPatch (isHunk -> Just fh) = showContextHunk fh+ showContextPatch p = return $ showPatch p+ summary = plainSummaryPrim+ summaryFL = plainSummaryPrims+ thing _ = "change"++instance Show (Prim C(x y)) where+ showsPrec d (Move fn1 fn2) = showParen (d > appPrec) $ showString "Move " .+ showsPrec (appPrec + 1) fn1 . showString " " .+ showsPrec (appPrec + 1) fn2+ showsPrec d (DP fn dp) = showParen (d > appPrec) $ showString "DP " .+ showsPrec (appPrec + 1) fn . showString " " .+ showsPrec (appPrec + 1) dp+ showsPrec d (FP fn fp) = showParen (d > appPrec) $ showString "FP " .+ showsPrec (appPrec + 1) fn . showString " " .+ showsPrec (appPrec + 1) fp+ showsPrec d (ChangePref p f t) = showParen (d > appPrec) $ showString "ChangePref " .+ showsPrec (appPrec + 1) p . showString " " .+ showsPrec (appPrec + 1) f . showString " " .+ showsPrec (appPrec + 1) t++instance Show2 Prim where+ showDict2 = ShowDictClass++instance Show1 (Prim C(x)) where+ showDict1 = ShowDictClass++instance Show (FilePatchType C(x y)) where+ showsPrec _ RmFile = showString "RmFile"+ showsPrec _ AddFile = showString "AddFile"+ showsPrec d (Hunk line old new) | all ((==1) . B.length) old && all ((==1) . B.length) new+ = showParen (d > appPrec) $ showString "Hunk " .+ showsPrec (appPrec + 1) line . showString " " .+ showsPrecC old . showString " " .+ showsPrecC new+ where showsPrecC [] = showString "[]"+ showsPrecC ss = showParen True $ showString "packStringLetters " . showsPrec (appPrec + 1) (map BC.head ss)+ showsPrec d (Hunk line old new) = showParen (d > appPrec) $ showString "Hunk " .+ showsPrec (appPrec + 1) line . showString " " .+ showsPrec (appPrec + 1) old . showString " " .+ showsPrec (appPrec + 1) new+ showsPrec d (TokReplace t old new) = showParen (d > appPrec) $ showString "TokReplace " .+ showsPrec (appPrec + 1) t . showString " " .+ showsPrec (appPrec + 1) old . showString " " .+ showsPrec (appPrec + 1) new+ -- this case may not work usefully+ showsPrec d (Binary old new) = showParen (d > appPrec) $ showString "Binary " .+ showsPrec (appPrec + 1) old . showString " " .+ showsPrec (appPrec + 1) new++instance Show (DirPatchType C(x y)) where+ showsPrec _ RmDir = showString "RmDir"+ showsPrec _ AddDir = showString "AddDir"++{-+instance Show (Prim C(x y)) where+ show p = renderString (showPrim p) ++ "\n"+-}++instance PrimShow Prim where+ showPrim x (FP f AddFile) = showAddFile x f+ showPrim x (FP f RmFile) = showRmFile x f+ showPrim x (FP f (Hunk line old new)) = showHunk x f line old new+ showPrim x (FP f (TokReplace t old new)) = showTok x f t old new+ showPrim x (FP f (Binary old new)) = showBinary x f old new+ showPrim x (DP d AddDir) = showAddDir x d+ showPrim x (DP d RmDir) = showRmDir x d+ showPrim x (Move f f') = showMove x f f'+ showPrim _ (ChangePref p f t) = showChangePref p f t++showAddFile :: FileNameFormat -> FileName -> Doc+showAddFile x f = blueText "addfile" <+> formatFileName x f++showRmFile :: FileNameFormat -> FileName -> Doc+showRmFile x f = blueText "rmfile" <+> formatFileName x f++showMove :: FileNameFormat -> FileName -> FileName -> Doc+showMove x d d' = blueText "move" <+> formatFileName x d <+> formatFileName x d'++showChangePref :: String -> String -> String -> Doc+showChangePref p f t = blueText "changepref" <+> text p+ $$ userchunk f+ $$ userchunk t++showAddDir :: FileNameFormat -> FileName -> Doc+showAddDir x d = blueText "adddir" <+> formatFileName x d++showRmDir :: FileNameFormat -> FileName -> Doc+showRmDir x d = blueText "rmdir" <+> formatFileName x d++showHunk :: FileNameFormat -> FileName -> Int -> [B.ByteString] -> [B.ByteString] -> Doc+showHunk x f line old new = showFileHunk x (FileHunk f line old new)++showTok :: FileNameFormat -> FileName -> String -> String -> String -> Doc+showTok x f t o n = blueText "replace" <+> formatFileName x f+ <+> text "[" <> userchunk t <> text "]"+ <+> userchunk o+ <+> userchunk n++showBinary :: FileNameFormat -> FileName -> B.ByteString -> B.ByteString -> Doc+showBinary x f o n =+ blueText "binary" <+> formatFileName x f+ $$ invisibleText "oldhex"+ $$ (vcat $ map makeprintable $ breakEvery 78 $ fromPS2Hex o)+ $$ invisibleText "newhex"+ $$ (vcat $ map makeprintable $ breakEvery 78 $ fromPS2Hex n)+ where makeprintable ps = invisibleText "*" <> invisiblePS ps++breakEvery :: Int -> B.ByteString -> [B.ByteString]+breakEvery n ps | B.length ps < n = [ps]+ | otherwise = B.take n ps : breakEvery n (B.drop n ps)
− src/Darcs/Patch/Properties.lhs
@@ -1,357 +0,0 @@-% Copyright (C) 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.--\documentclass{article}-%\usepackage{color}--\usepackage{verbatim}-\usepackage{html}-\usepackage{fancyvrb}-\newenvironment{code}{\comment}{\endcomment}-% \newenvironment{code}{\color{blue}\verbatim}{\endverbatim}--\newcommand{\commutes}{\longleftrightarrow}--\begin{document}--\begin{code}-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -cpp -fno-warn-deprecations -fno-warn-orphans -fglasgow-exts #-}--#include "gadts.h"--module Darcs.Patch.Properties ( recommute, commuteInverses, permutivity, partialPermutivity,- identityCommutes, inverseDoesntCommute,- patchAndInverseCommute, mergeEitherWay,- show_read,- mergeCommute, mergeConsistent, mergeArgumentsConsistent,- joinInverses, joinCommute ) where--import Control.Monad ( msum, mplus )-import Darcs.Witnesses.Show ( Show2(..), show2 )-import Darcs.Patch.Patchy-import Darcs.Patch.Prim-import Darcs.Patch ()-import Darcs.Patch.Read ( readPatch )-import Darcs.Witnesses.Ordered-import Darcs.Witnesses.Sealed ( Sealed(Sealed) )-import Printer ( Doc, renderPS, redText, greenText, ($$) )---import Darcs.ColorPrinter ( traceDoc )-\end{code}--\section{Patch properties}--Darcs is built on a hierarchy of patch types. At the lowest level are-``primitive'' patches, and from these building blocks, a whole hierarchy of-patch types are built. Each of these patch types must support a number of-functions, which must obey a number of laws.--\subsection{Properties of identity}--\newtheorem{prp}{Property}--\begin{prp}[Identity commutes trivially]- The identity patch must commute with any patch without modifying said patch.-\end{prp}--\begin{code}-identityCommutes :: forall p C(x y). Patchy p => p C(x y) -> Maybe Doc-identityCommutes p = case commute (p :> identity) of- Nothing -> Just $ redText "identityCommutes failed:" $$ showPatch p- Just (i :> p') | IsEq <- i =\/= identity,- IsEq <- p' =\/= p ->- checkRightIdentity $ commute $ identity :> p- Just _ -> Just $ greenText "identityCommutes"- where checkRightIdentity :: Maybe ((p :> p) C(x y)) -> Maybe Doc- checkRightIdentity Nothing = Just $ redText "identityCommutes failed 2:" $$ showPatch p- checkRightIdentity (Just (p2 :> i2)) | IsEq <- i2 =\/= identity,- IsEq <- p2 =\/= p = Nothing- checkRightIdentity (Just _) = Just $ greenText "identityCommutes 2"-\end{code}--\begin{prp}[Inverse doesn't commute]- A patch and its inverse will always commute, unless that patch is an- identity patch (or an identity-like patch that has no effect).-\end{prp}--\begin{code}-inverseDoesntCommute :: Patchy p => p C(a b) -> Maybe Doc-inverseDoesntCommute p | IsEq <- sloppyIdentity p = Nothing- | otherwise = do p' :> _ <- commute (invert p :> p)- Just $ redText "inverseDoesntCommute" $$ showPatch p'-\end{code}--\subsection{Commute properties}--\begin{prp}[Recommute]- $AB \commutes B'A'$ if and only if $B'A' \commutes AB$-\end{prp}--\begin{code}-recommute :: Patchy p => (FORALL(x y) ((p :> p) C(x y) -> Maybe ((p :> p) C(x y))))- -> (p :> p) C(a b) -> Maybe Doc-recommute c (x :> y) =- case c (x :> y) of- Nothing -> Nothing- Just (y' :> x') ->- case c (y' :> x') of- Nothing -> Just (redText "failed" $$ showPatch y' $$ redText ":>" $$ showPatch x')- Just (x'' :> y'') ->- case y'' =/\= y of- NotEq -> Just (redText "y'' =/\\= y failed, where x" $$ showPatch x $$- redText ":> y" $$ showPatch y $$- redText "y'" $$ showPatch y' $$- redText ":> x'" $$ showPatch x' $$- redText "x''" $$ showPatch x'' $$- redText ":> y''" $$ showPatch y'')- IsEq -> case x'' =/\= x of- NotEq -> Just (redText "x'' /= x" $$ showPatch x'' $$ redText ":>" $$ showPatch y'')- IsEq -> Nothing-\end{code}--\begin{prp}[Commute inverses]- $AB \commutes B'A'$ if and only if $B^{-1}A^{-1} \commutes A'^{-1}B'^{-1}$-\end{prp}--\begin{code}-commuteInverses :: Patchy p => (FORALL(x y) (p :> p) C(x y) -> Maybe ((p :> p) C(x y)))- -> (p :> p) C(a b) -> Maybe Doc-commuteInverses c (x :> y) =- case c (x :> y) of- Nothing -> Nothing- Just (y' :> x') ->- case c (invert y :> invert x) of- Nothing -> Just $ redText "second commute failed" $$- redText "x" $$ showPatch x $$ redText "y" $$ showPatch y $$- redText "y'" $$ showPatch y' $$ redText "x'" $$ showPatch x'- Just (ix' :> iy') ->- case invert ix' =/\= x' of- NotEq -> Just $ redText "invert ix' /= x'" $$- redText "x" $$ showPatch x $$- redText "y" $$ showPatch y $$- redText "y'" $$ showPatch y' $$- redText "x'" $$ showPatch x' $$- redText "ix'" $$ showPatch ix' $$- redText "iy'" $$ showPatch iy' $$- redText "invert ix'" $$ showPatch (invert ix') $$- redText "invert iy'" $$ showPatch (invert iy')- IsEq -> case y' =\/= invert iy' of- NotEq -> Just $ redText "y' /= invert iy'" $$ showPatch iy' $$ showPatch y'- IsEq -> Nothing-\end{code}--\begin{prp}[Patch and inverse]- If $AB \commutes B'A'$ then $A^{-1}B' \commutes BA'^{-1}$-\end{prp}--This property is only true of primitive patches.--\begin{code}-patchAndInverseCommute :: Patchy p =>- (FORALL(x y) (p :> p) C(x y) -> Maybe ((p :> p) C(x y)))- -> (p :> p) C(a b) -> Maybe Doc-patchAndInverseCommute c (x :> y) =- do y' :> x' <- c (x :> y)- case c (invert x :> y') of- Nothing -> Just (redText "failure in patchAndInverseCommute")- Just (y'' :> ix') ->- case y'' =\/= y of- NotEq -> Just (redText "y'' /= y" $$- redText "x" $$ showPatch x $$- redText "y" $$ showPatch y $$- redText "x'" $$ showPatch x' $$- redText "y'" $$ showPatch y' $$- redText "y''" $$ showPatch y'' $$- redText ":> x'" $$ showPatch x')- IsEq -> case x' =\/= invert ix' of- NotEq -> Just (redText "x' /= invert ix'" $$- redText "y''" $$ showPatch y'' $$- redText ":> x'" $$ showPatch x' $$- redText "invert x" $$ showPatch (invert x) $$- redText ":> y" $$ showPatch y $$- redText "y'" $$ showPatch y' $$- redText "ix'" $$ showPatch ix')- IsEq -> Nothing-\end{code}--\begin{prp}[Permutivity]- (to be added...)-\end{prp}--\begin{code}-permutivity :: Patchy p => (FORALL(x y) (p :> p) C(x y) -> Maybe ((p :> p) C(x y)))- -> (p :> p :> p) C(a b) -> Maybe Doc-permutivity c (x:>y:>z) =- do y1 :> x1 <- c (x :> y)- z2 :> y2 <- --traceDoc (greenText "first commuted") $- c (y :> z)- z3 :> x3 <- --traceDoc (greenText "second commuted") $- c (x :> z2)- case c (x1 :> z) of- Nothing -> Just $ redText "permutivity1"- Just (z4 :> x4) ->- --traceDoc (greenText "third commuted" $$- -- greenText "about to commute" $$- -- greenText "y1" $$ showPatch y1 $$- -- greenText "z4" $$ showPatch z4) $- case c (y1 :> z4) of- Nothing -> Just $ redText "permutivity2"- Just (z3_ :> y4)- | IsEq <- z3_ =\/= z3 ->- --traceDoc (greenText "passed z3") $ error "foobar test" $- case c (y4 :> x4) of- Nothing -> Just $ redText "permutivity5: input was" $$- redText "x" $$ showPatch x $$- redText "y" $$ showPatch y $$- redText "z" $$ showPatch z $$- redText "z3" $$ showPatch z3 $$- redText "failed commute of" $$- redText "y4" $$ showPatch y4 $$- redText "x4" $$ showPatch x4 $$- redText "whereas commute of x and y give" $$- redText "y1" $$ showPatch y1 $$- redText "x1" $$ showPatch x1- Just (x3_ :> y2_)- | NotEq <- x3_ =\/= x3 -> Just $ redText "permutivity6"- | NotEq <- y2_ =/\= y2 -> Just $ redText "permutivity7"- | otherwise -> Nothing- | otherwise ->- Just $ redText "permutivity failed" $$- redText "z3" $$ showPatch z3 $$- redText "z3_" $$ showPatch z3_--partialPermutivity :: Patchy p => (FORALL(x y) (p :> p) C(x y) -> Maybe ((p :> p) C(x y)))- -> (p :> p :> p) C(a b) -> Maybe Doc-partialPermutivity c (xx:>yy:>zz) = pp (xx:>yy:>zz) `mplus` pp (invert zz:>invert yy:>invert xx)- where pp (x:>y:>z) = do z1 :> y1 <- c (y :> z)- _ :> x1 <- c (x :> z1)- case c (x :> y) of- Just _ -> Nothing -- this is covered by full permutivity test above- Nothing ->- case c (x1 :> y1) of- Nothing -> Nothing- Just _ -> Just $ greenText "partialPermutivity error" $$- greenText "x" $$ showPatch x $$- greenText "y" $$ showPatch y $$- greenText "z" $$ showPatch z--mergeArgumentsConsistent :: Patchy p =>- (FORALL(x y) p C(x y) -> Maybe Doc)- -> (p :\/: p) C(a b) -> Maybe Doc-mergeArgumentsConsistent isConsistent (x :\/: y) =- msum [(\z -> redText "mergeArgumentsConsistent x" $$ showPatch x $$ z) `fmap` isConsistent x,- (\z -> redText "mergeArgumentsConsistent y" $$ showPatch y $$ z) `fmap` isConsistent y]--mergeConsistent :: Patchy p =>- (FORALL(x y) p C(x y) -> Maybe Doc)- -> (p :\/: p) C(a b) -> Maybe Doc-mergeConsistent isConsistent (x :\/: y) =- case merge (x :\/: y) of- y' :/\: x' ->- msum [(\z -> redText "mergeConsistent x" $$ showPatch x $$ z) `fmap` isConsistent x,- (\z -> redText "mergeConsistent y" $$ showPatch y $$ z) `fmap` isConsistent y,- (\z -> redText "mergeConsistent x'" $$ showPatch x' $$ z $$- redText "where x' comes from x" $$ showPatch x $$- redText "and y" $$ showPatch y) `fmap` isConsistent x',- (\z -> redText "mergeConsistent y'" $$ showPatch y' $$ z) `fmap` isConsistent y']--mergeEitherWay :: Patchy p => (p :\/: p) C(x y) -> Maybe Doc-mergeEitherWay (x :\/: y) =- case merge (x :\/: y) of- y' :/\: x' -> case merge (y :\/: x) of- x'' :/\: y'' | IsEq <- x'' =\/= x',- IsEq <- y'' =\/= y' -> Nothing- | otherwise -> Just $ redText "mergeEitherWay bug"--mergeCommute :: Patchy p => (p :\/: p) C(x y) -> Maybe Doc-mergeCommute (x :\/: y) =- case merge (x :\/: y) of- y' :/\: x' ->- case commute (x :> y') of- Nothing -> Just $ redText "mergeCommute 1" $$- redText "x" $$ showPatch x $$- redText "y" $$ showPatch y $$- redText "x'" $$ showPatch x' $$- redText "y'" $$ showPatch y'- Just (y_ :> x'_)- | IsEq <- y_ =\/= y,- IsEq <- x'_ =\/= x' ->- case commute (y :> x') of- Nothing -> Just $ redText "mergeCommute 2 failed" $$- redText "x" $$ showPatch x $$- redText "y" $$ showPatch y $$- redText "x'" $$ showPatch x' $$- redText "y'" $$ showPatch y'- Just (x_ :> y'_)- | IsEq <- x_ =\/= x,- IsEq <- y'_ =\/= y' -> Nothing- | otherwise -> Just $ redText "mergeCommute 3" $$- redText "x" $$ showPatch x $$- redText "y" $$ showPatch y $$- redText "x'" $$ showPatch x' $$- redText "y'" $$ showPatch y' $$- redText "x_" $$ showPatch x_ $$- redText "y'_" $$ showPatch y'_- | otherwise -> Just $ redText "mergeCommute 4" $$- redText "x" $$ showPatch x $$- redText "y" $$ showPatch y $$- redText "x'" $$ showPatch x' $$- redText "y'" $$ showPatch y' $$- redText "x'_" $$ showPatch x'_ $$- redText "y_" $$ showPatch y_--joinInverses :: (FORALL(x y) (Prim :> Prim) C(x y) -> Maybe (Prim C(x y)))- -> Prim C(a b) -> Maybe Doc-joinInverses j p = case j (invert p :> p) of- Just Identity -> Nothing- Just p' -> Just $ redText "joinInverses gave just" $$ showPatch p'- Nothing -> Just $ redText "joinInverses failed"--joinCommute :: (FORALL(x y) (Prim :> Prim) C(x y) -> Maybe (Prim C(x y)))- -> (Prim :> Prim :> Prim) C(a b) -> Maybe Doc-joinCommute j (a :> b :> c) =- do x <- j (b :> c)- case commuteFLorComplain (a :> b :>: c :>: NilFL) of- Right (b' :>: c' :>: NilFL :> a') ->- case commute (a :> x) of- Nothing -> Just $ greenText "joinCommute 1"- Just (x' :> a'') ->- case a'' =/\= a' of- NotEq -> Just $ greenText "joinCommute 3"- IsEq -> case j (b' :> c') of- Nothing -> Just $ greenText "joinCommute 4"- Just x'' -> case x' =\/= x'' of- NotEq -> Just $ greenText "joinCommute 5"- IsEq -> Nothing- _ -> Nothing--show_read :: (Show2 p, Patchy p) => p C(a b) -> Maybe Doc-show_read p = let ps = renderPS (showPatch p)- in case readPatch ps of- Nothing -> Just (redText "unable to read " $$ showPatch p)- Just (Sealed p',_) | IsEq <- p' =\/= p -> Nothing- | otherwise -> Just $ redText "trouble reading patch p" $$- showPatch p $$- redText "reads as p'" $$- showPatch p' $$- redText "aka" $$- greenText (show2 p) $$- redText "and" $$- greenText (show2 p')-\end{code}--\end{document}
src/Darcs/Patch/Read.hs view
@@ -15,235 +15,107 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp -fno-warn-orphans #-} {-# LANGUAGE CPP #-} -module Darcs.Patch.Read ( readPrim, readPatch )+module Darcs.Patch.Read ( ReadPatch(..),+ readPatch, readPatchPartial,+ bracketedFL, peekfor,+ readFileName ) where import Prelude hiding ( pi )-import Control.Monad ( liftM ) -#include "gadts.h"--import ByteStringUtils ( breakFirstPS, fromHex2PS, readIntPS, dropSpace )-import qualified Data.ByteString.Char8 as BC (head, unpack, dropWhile, break)-import qualified Data.ByteString as B (ByteString, null, init, tail, empty, concat)--import Darcs.Patch.FileName ( FileName, fn2fp, fp2fn, ps2fn, decodeWhite )-import Darcs.Patch.Core ( Patch(..), Named(..) )-import Darcs.Patch.Prim ( Prim(..), FileNameFormat(..),- DirPatchType(..), FilePatchType(..),- hunk, binary )-import Darcs.Patch.Commute ( merger )-import Darcs.Patch.Patchy ( invert )-import Darcs.Patch.Info ( PatchInfo, readPatchInfo )-import Darcs.Patch.ReadMonads (ParserM, work, maybeWork, alterInput,- parseStrictly, peekInput, lexString, lexEof, myLex)-#include "impossible.h"-import Darcs.Patch.Patchy ( ReadPatch, readPatch', bracketedFL )-import Darcs.Witnesses.Ordered ( FL(..), unsafeCoerceP )-import Darcs.Witnesses.Sealed ( Sealed(..), seal, mapSeal )--readPatch :: ReadPatch p => B.ByteString -> Maybe (Sealed (p C(x )), B.ByteString)-readPatch ps = case parseStrictly (readPatch' False) ps of- Just (Just p, ps') -> Just (p, ps')- _ -> Nothing--instance ReadPatch p => ReadPatch (Named p) where- readPatch' want_eof- = do s <- peekInput- case liftM (BC.unpack . fst) $ myLex s of- Just ('[':_) -> liftM Just $ readNamed want_eof -- ]- _ -> return Nothing--instance ReadPatch Prim where- readPatch' _ = readPrim OldFormat--readPrim :: ParserM m => FileNameFormat -> m (Maybe (Sealed (Prim C(x ))))-readPrim x- = do s <- peekInput- case liftM (BC.unpack . fst) $ myLex s of- Just "{}" -> do work myLex- return $ Just $ seal Identity- Just "(" -> liftM Just $ readSplit x -- )- Just "hunk" -> liftM (Just . seal) $ readHunk x- Just "replace" -> liftM (Just . seal) $ readTok x- Just "binary" -> liftM (Just . seal) $ readBinary x- Just "addfile" -> liftM (Just . seal) $ readAddFile x- Just "adddir" -> liftM (Just . seal) $ readAddDir x- Just "rmfile" -> liftM (Just . seal) $ readRmFile x- Just "rmdir" -> liftM (Just . seal) $ readRmDir x- Just "move" -> liftM (Just . seal) $ readMove x- Just "changepref" -> liftM (Just . seal) $ readChangePref- _ -> return Nothing--instance ReadPatch Patch where- readPatch' want_eof- = do mps <- bracketedFL (readPatch' False) (fromIntegral $ fromEnum '{') (fromIntegral $ fromEnum '}')- case mps of- Just (Sealed ps) -> return $ Just $ Sealed $ ComP ps- Nothing -> do s <- peekInput- case liftM (BC.unpack . fst) $ myLex s of- Just "merger" -> liftM (Just . seal) $ readMerger True- Just "regrem" -> liftM (Just . seal) $ readMerger False- _ -> liftM (fmap (mapSeal PP)) $ readPatch' want_eof--readPatches :: ParserM m => FileNameFormat -> String -> Bool -> m (Sealed (FL Prim C(x )))-readPatches x str want_eof- = do mp <- readPrim x- case mp of- Nothing -> do unit <- lexString str- case unit of- () -> if want_eof then do unit' <- lexEof- case unit' of- () -> return $ seal NilFL- else return $ seal NilFL- Just (Sealed p) -> do Sealed ps <- readPatches x str want_eof- return $ seal (p:>:ps)--readSplit :: ParserM m => FileNameFormat -> m (Sealed (Prim C(x )))-readSplit x = do- work myLex- ps <- readPatches x ")" False- return $ Split `mapSeal` ps--readFileName :: FileNameFormat -> B.ByteString -> FileName-readFileName OldFormat = ps2fn-readFileName NewFormat = fp2fn . decodeWhite . BC.unpack+import ByteStringUtils ( dropSpace )+import qualified Data.ByteString as B (ByteString, null) -readHunk :: ParserM m => FileNameFormat -> m (Prim C(x y))-readHunk x = do- work myLex- fi <- work myLex- l <- work readIntPS- have_nl <- skipNewline- if have_nl- then do work $ linesStartingWith ' ' -- skipping context- old <- work $ linesStartingWith '-'- new <- work $ linesStartingWith '+'- work $ linesStartingWith ' ' -- skipping context- return $ hunk (fn2fp $ readFileName x fi) l old new- else return $ hunk (fn2fp $ readFileName x fi) l [] []+import Darcs.Patch.Bracketed ( Bracketed(..), unBracketedFL )+import Darcs.Patch.FileName ( FileName, fp2fn, ps2fn, decodeWhite )+import Darcs.Patch.Format ( PatchListFormat(..), ListFormat(..), FileNameFormat(..) )+import Darcs.Patch.ReadMonads (ParserM,+ parseStrictly,+ choice, lexChar, lexString,+ checkConsumes ) -skipNewline :: ParserM m => m Bool-skipNewline = do s <- peekInput- if B.null s- then return False- else if BC.head s /= '\n'- then return False- else alterInput B.tail >> return True+import Darcs.Witnesses.Ordered ( FL(..), RL, reverseFL )+import Darcs.Witnesses.Sealed ( Sealed(..), mapSeal ) -readTok :: ParserM m => FileNameFormat -> m (Prim C(x y))-readTok x = do- work myLex- f <- work myLex- regstr <- work myLex- o <- work myLex- n <- work myLex- return $ FP (readFileName x f) $ TokReplace (BC.unpack (drop_brackets regstr))- (BC.unpack o) (BC.unpack n)- where drop_brackets = B.init . B.tail+import Control.Applicative ( (<$>), (<|>) )+import Control.Monad ( mzero )+import qualified Data.ByteString.Char8 as BC ( ByteString, unpack ) +#include "gadts.h" --- * Binary file modification------ | Modify a binary file------ > binary FILENAME--- > oldhex--- > *HEXHEXHEX--- > ...--- > newhex--- > *HEXHEXHEX--- > ...-readBinary :: ParserM m => FileNameFormat -> m (Prim C(x y))-readBinary x = do- work myLex- fi <- work myLex- work myLex- alterInput dropSpace- old <- work $ linesStartingWith '*'- work myLex- alterInput dropSpace- new <- work $ linesStartingWith '*'- return $ binary (fn2fp $ readFileName x fi)- (fromHex2PS $ B.concat old)- (fromHex2PS $ B.concat new)+class ReadPatch p where+ readPatch'+ :: ParserM m => m (Sealed (p C(x ))) -readAddFile :: ParserM m => FileNameFormat -> m (Prim C(x y))-readAddFile x = do work myLex- f <- work myLex- return $ FP (readFileName x f) AddFile+readPatchPartial :: ReadPatch p => B.ByteString -> Maybe (Sealed (p C(x )), B.ByteString)+readPatchPartial ps+ = case parseStrictly readPatch' ps of+ Just (p, ps') -> Just (p, ps')+ _ -> Nothing -readRmFile :: ParserM m => FileNameFormat -> m (Prim C(x y))-readRmFile x = do work myLex- f <- work myLex- return $ FP (readFileName x f) RmFile+readPatch :: ReadPatch p => B.ByteString -> Maybe (Sealed (p C(x )))+readPatch ps+ = case readPatchPartial ps of+ Just (p, ps') | B.null (dropSpace ps') -> Just p+ _ -> Nothing -readMove :: ParserM m => FileNameFormat -> m (Prim C(x y))-readMove x = do work myLex- d <- work myLex- d' <- work myLex- return $ Move (readFileName x d) (readFileName x d')+instance ReadPatch p => ReadPatch (Bracketed p) where+ readPatch' = mapSeal Braced <$> bracketedFL readPatch' '{' '}'+ <|>+ mapSeal Parens <$> bracketedFL readPatch' '(' ')'+ <|>+ mapSeal Singleton <$> readPatch' -readChangePref :: ParserM m => m (Prim C(x y))-readChangePref- = do work myLex- p <- work myLex- f <- work (Just . BC.break ((==)'\n') . B.tail . BC.dropWhile (== ' '))- t <- work (Just . BC.break ((==)'\n') . B.tail)- return $ ChangePref (BC.unpack p) (BC.unpack f) (BC.unpack t)+instance (ReadPatch p, PatchListFormat p) => ReadPatch (FL p) where+ readPatch'+ | ListFormatV1 <- patchListFormat :: ListFormat p+ = mapSeal unBracketedFL <$> readPatch'+ -- in the V2 format case, we only need to support () on reading, not {}+ -- for simplicity we just go through the same code path.+ | ListFormatV2 <- patchListFormat :: ListFormat p+ = mapSeal unBracketedFL <$> readPatch'+ | otherwise+ = read_patches+ where read_patches :: ParserM m => m (Sealed (FL p C(x )))+ read_patches = do --tracePeek "starting FL read"+ -- checkConsumes is needed to make sure that something is read,+ -- to avoid stack overflow when parsing FL (FL p)+ mp <- (Just <$> checkConsumes readPatch') <|> return Nothing+ case mp of+ Just (Sealed p) -> do --tracePeek "found one patch"+ Sealed ps <- read_patches+ return $ Sealed (p:>:ps)+ Nothing -> return $ Sealed NilFL+-- tracePeek x = do y <- peekInput+-- traceDoc (greenText x $$ greenText (show $ sal_to_string y)) return () -readAddDir :: ParserM m => FileNameFormat -> m (Prim C(x y))-readAddDir x = do work myLex- f <- work myLex- return $ DP (readFileName x f) AddDir+instance (ReadPatch p, PatchListFormat p) => ReadPatch (RL p) where+ readPatch' = mapSeal reverseFL <$> readPatch' -readRmDir :: ParserM m => FileNameFormat -> m (Prim C(x y))-readRmDir x = do work myLex- f <- work myLex- return $ DP (readFileName x f) RmDir+{-# INLINE bracketedFL #-}+bracketedFL :: forall p m C(x) . (ParserM m) =>+ (FORALL(y) m (Sealed (p C(y)))) -> Char -> Char -> m (Sealed (FL p C(x)))+bracketedFL parser pre post =+ peekforc pre bfl mzero+ where bfl :: FORALL(z) m (Sealed (FL p C(z)))+ bfl = peekforc post (return $ Sealed NilFL)+ (do Sealed p <- parser+ Sealed ps <- bfl+ return $ Sealed (p:>:ps)) -readMerger :: ParserM m => Bool -> m (Patch C(x y))-readMerger b = do work myLex- g <- work myLex- lexString "("- Just (Sealed p1) <- readPatch' False- Just (Sealed p2) <- readPatch' False- lexString ")"- Sealed m <- return $ merger (BC.unpack g) p1 p2- return $ if b then unsafeCoerceP m else unsafeCoerceP (invert m)+{-# INLINE peekforc #-}+peekforc :: ParserM m => Char -> m a -> m a -> m a+peekforc c ifstr ifnot = choice [ lexChar c >> ifstr+ , ifnot ] -readNamed :: (ReadPatch p, ParserM m) => Bool -> m (Sealed (Named p C(x )))-readNamed want_eof- = do mn <- maybeWork readPatchInfo- case mn of- Nothing -> bug "readNamed 1"- Just n ->- do d <- readDepends- Just p <- readPatch' want_eof- return $ (NamedP n d) `mapSeal` p-readDepends :: ParserM m => m [PatchInfo]-readDepends = do s <- peekInput- case myLex s of- Just (xs, _) | BC.unpack xs == "<" ->- do work myLex- readPis- _ -> return []-readPis :: ParserM m => m [PatchInfo]-readPis = do mpi <- maybeWork readPatchInfo- case mpi of- Just pi -> do pis <- readPis- return (pi:pis)- Nothing -> do alterInput (B.tail . BC.dropWhile (/= '>'))- return []+peekfor :: ParserM m => BC.ByteString -> m a -> m a -> m a+peekfor ps ifstr ifnot = choice [ do lexString ps+ ifstr+ , ifnot ]+{-# INLINE peekfor #-} -linesStartingWith :: Char -> B.ByteString -> Maybe ([B.ByteString], B.ByteString)-linesStartingWith c thes =- Just (lsw [] thes)- where lsw acc s | B.null s || BC.head s /= c = (reverse acc, s)- lsw acc s = let s' = B.tail s- in case breakFirstPS '\n' s' of- Just (l, r) -> lsw (l:acc) r- Nothing -> (reverse (s':acc), B.empty)+readFileName :: FileNameFormat -> B.ByteString -> FileName+readFileName OldFormat = ps2fn+readFileName NewFormat = fp2fn . decodeWhite . BC.unpack
src/Darcs/Patch/ReadMonads.hs view
@@ -1,100 +1,280 @@+{-# LANGUAGE BangPatterns #-} -- | This module defines our parsing monad. In the past there have been lazy -- and strict parsers in this module. Currently we have only the strict -- variant and it is used for parsing patch files.-module Darcs.Patch.ReadMonads (ParserM, work, maybeWork, alterInput,- parseStrictly,- peekInput,- lexChar, lexString, lexStrings, lexEof,- myLex) where+module Darcs.Patch.ReadMonads (ParserM, Darcs.Patch.ReadMonads.take,+ parse, parseStrictly, char, int,+ option, choice, skipSpace, skipWhile, string,+ lexChar, lexString, lexEof, takeTillChar,+ myLex', anyChar, endOfInput, takeTill,+ checkConsumes,+ linesStartingWith, linesStartingWithEndingWith) where -import ByteStringUtils ( dropSpace, breakSpace )-import qualified Data.ByteString as B (null, empty, ByteString)-import qualified Data.ByteString.Char8 as BC (unpack, pack)+import ByteStringUtils ( dropSpace, breakSpace, breakFirstPS,+ readIntPS, breakLastPS )+import qualified Data.ByteString as B (null, drop, length, tail, empty,+ ByteString)+import qualified Data.ByteString.Char8 as BC ( uncons, dropWhile, break+ , splitAt, length, head )+import Control.Applicative ( Alternative(..), Applicative(..), (<$>) )+import Control.Monad ( MonadPlus(..) ) -- | 'lexChar' checks if the next space delimited token from -- the input stream matches a specific 'Char'. -- Uses 'Maybe' inside 'ParserM' to handle failed matches, so -- that it always returns () on success. lexChar :: ParserM m => Char -> m ()-lexChar c = lexString [c]+lexChar c = do+ skipSpace+ char c+ return () -- | 'lexString' fetches the next whitespace delimited token from--- from the input and checks if it matches the 'String' input.+-- from the input and checks if it matches the 'ByteString' input. -- Uses 'Maybe' inside 'ParserM' to handle failed matches, so -- that it always returns () on success.-lexString :: ParserM m => String -> m ()+lexString :: ParserM m => B.ByteString -> m () lexString str = work $ \s -> case myLex s of- Just (xs, ys) | xs == BC.pack str -> Just ((), ys)+ Just (xs :*: ys) | xs == str -> Just (() :*: ys) _ -> Nothing +-- | Only succeeds if the characters in the input exactly match @str@.+string :: ParserM m => B.ByteString -> m ()+string str = work+ $ \s -> case BC.splitAt (BC.length str) s of+ (h, t) | h == str -> Just (() :*: t)+ _ -> Nothing+ -- | 'lexEof' looks for optional spaces followed by the end of input. -- Uses 'Maybe' inside 'ParserM' to handle failed matches, so -- that it always returns () on success. lexEof :: ParserM m => m () lexEof = work $ \s -> if B.null (dropSpace s)- then Just ((), B.empty)+ then Just (() :*: B.empty) else Nothing --- | Checks if any of the input 'String's match the next--- space delimited token in the input stream.--- Uses 'Maybe' inside 'ParserM' to handle failed matches,--- on success it returns the matching 'String'.-lexStrings :: ParserM m => [String] -> m String-lexStrings str =- work $ \s ->- case myLex s of- Just (xs, ys) | xs' `elem` str -> Just (xs', ys)- where xs' = BC.unpack xs- _ -> Nothing- -- | 'myLex' drops leading spaces and then breaks the string at the -- next space. Returns 'Nothing' when the string is empty after -- dropping leading spaces, otherwise it returns the first sequence -- of non-spaces and the remainder of the input.-myLex :: B.ByteString -> Maybe (B.ByteString, B.ByteString)+myLex :: B.ByteString -> Maybe (ParserState B.ByteString) myLex s = let s' = dropSpace s in if B.null s' then Nothing- else Just $ breakSpace s'+ else Just $ stuple $ breakSpace s' +-- | Like 'myLex' except that it is in ParserM+myLex' :: ParserM m => m B.ByteString+myLex' = work myLex++-- | Accepts the next character and returns it. Only fails at end of+-- input.+anyChar :: ParserM m => m Char+anyChar = work $ \s -> stuple <$> BC.uncons s++-- | Only succeeds at end of input, consumes no characters.+endOfInput :: ParserM m => m ()+endOfInput = work $ \s -> if B.null s+ then Just (() :*: s)+ else Nothing++-- | Accepts only the specified character. Consumes a character, if+-- available.+char :: ParserM m => Char -> m ()+char c = work $ \s ->+ case BC.uncons s of+ Just (c', s') | c == c' -> Just (() :*: s')+ _ -> Nothing++-- | Parse an integer and return it. Skips leading whitespaces and+-- | uses the efficient ByteString readInt.+int :: ParserM m => m Int+int = work $ \s -> stuple <$> readIntPS s++-- | Discards spaces until a non-space character is encountered.+-- Always succeeds.+skipSpace :: ParserM m => m ()+skipSpace = alterInput dropSpace++-- | Discards any characters as long as @p@ returns True. Always+-- | succeeds.+skipWhile :: ParserM m => (Char -> Bool) -> m ()+skipWhile p = alterInput (BC.dropWhile p)++-- | Takes characters while @p@ returns True. Always succeeds.+takeTill :: ParserM m => (Char -> Bool) -> m B.ByteString+takeTill p = work $ \s -> Just $ stuple (BC.break p s)++-- | Equivalent to @takeTill (==c)@, except that it is optimized for+-- | the equality case.+takeTillChar :: ParserM m => Char -> m B.ByteString+takeTillChar c = work $ \s -> Just $ stuple (BC.break (==c) s)++-- | Takes exactly @n@ bytes, or fails.+take :: ParserM m => Int -> m B.ByteString+take n = work $ \s -> if B.length s >= n+ then Just $ stuple $ BC.splitAt n s+ else Nothing++-- | This is a highly optimized way to read lines that start with a+-- particular character. To implement this efficiently we need access+-- to the parser's internal state. If this is implemented in terms of+-- the other primitives for the parser it requires us to consume one+-- character at a time. That leads to @(>>=)@ wasting significant+-- time.+linesStartingWith :: ParserM m => Char -> m [B.ByteString]+linesStartingWith c = work $ linesStartingWith' c++-- | Helper function for 'linesStartingWith'.+linesStartingWith' :: Char -> B.ByteString -> Maybe (ParserState [B.ByteString])+linesStartingWith' c thes =+ Just (lsw [] thes)+ where lsw acc s | B.null s || BC.head s /= c = (reverse acc :*: s)+ lsw acc s = let s' = B.tail s+ in case breakFirstPS '\n' s' of+ Just (l, r) -> lsw (l:acc) r+ Nothing -> (reverse (s':acc) :*: B.empty)++-- | This is a highly optimized way to read lines that start with a+-- particular character, and stops when it reaches a particular |+-- character. See 'linesStartingWith' for details on why this |+-- defined here as a primitive.+linesStartingWithEndingWith :: ParserM m => Char -> Char -> m [B.ByteString]+linesStartingWithEndingWith st en = work $ linesStartingWithEndingWith' st en++-- | Helper function for 'linesStartingWithEndingWith'.+linesStartingWithEndingWith' :: Char -> Char -> B.ByteString+ -> Maybe (ParserState [B.ByteString])+linesStartingWithEndingWith' st en s = lswew s+ where+ lswew x | B.null x = Nothing+ lswew x =+ if BC.head x == en+ then Just ([] :*: B.tail x)+ else if BC.head x /= st+ then Nothing+ else case BC.break ((==) '\n') $ B.tail x of+ (l,r) -> case lswew $ B.tail r of+ Just (ls :*: r') -> Just ((l:ls) :*: r')+ Nothing ->+ case breakLastPS en l of+ Just (l2,_) ->+ Just ([l2] :*: B.drop (B.length l2+2) x)+ Nothing -> Nothing++ -- | Applies a function to the input stream and discards the -- result of the function. alterInput :: ParserM m => (B.ByteString -> B.ByteString) -> m ()-alterInput f = work (\s -> Just ((), f s))+alterInput f = work (\s -> Just (() :*: f s)) -class Monad m => ParserM m where+-- | If @p@ fails it returns @x@, otherwise it returns the result of @p@.+option :: Alternative f => a -> f a -> f a+option x p = p <|> pure x++-- | Attempts each option until one succeeds.+choice :: Alternative f => [f a] -> f a+choice = foldr (<|>) empty++-- |Ensure that a parser consumes input when producing a result+-- Causes the initial state of the input stream to be held on to while the+-- parser runs, so use with caution.+checkConsumes :: ParserM m => m a -> m a+checkConsumes parser = do+ x <- B.length <$> peekInput+ res <- parser+ x' <- B.length <$> peekInput+ if x' < x then return res else mzero++class (Functor m, Applicative m, Alternative m, Monad m, MonadPlus m) => ParserM m where -- | Applies a parsing function inside the 'ParserM' monad.- work :: (B.ByteString -> Maybe (a, B.ByteString)) -> m a+ work :: (B.ByteString -> Maybe (ParserState a)) -> m a -- | Applies a parsing function, that can return 'Nothing', -- inside the 'ParserM' monad.- maybeWork :: (B.ByteString -> Maybe (a, B.ByteString)) -> m (Maybe a)+ maybeWork :: (B.ByteString -> Maybe (ParserState a)) -> m (Maybe a) -- | Allows for the inspection of the input that is yet to be parsed. peekInput :: m B.ByteString+ -- | Run the parser+ parse :: m a -> B.ByteString -> Maybe (a, B.ByteString) ----- Strict Monad ----- -- | 'parseStrictly' applies the parser functions to a string -- and checks that each parser produced a result as it goes. -- The strictness is in the 'ParserM' instance for 'SM'. parseStrictly :: SM a -> B.ByteString -> Maybe (a, B.ByteString)-parseStrictly (SM f) s = f s+parseStrictly (SM f) s = case f s of+ Just (a :*: r) -> Just (a, r)+ _ -> Nothing +-- | ParserState represents the internal state of the parser. We make it+-- strict and specialize it on ByteString. This is purely to help GHC+-- optimize. If performance were not a concern, it could be replaced+-- with @(a, ByteString)@.+data ParserState a = !a :*: !B.ByteString++-- | Convert from a lazy tuple to a strict tuple.+stuple :: (a, B.ByteString) -> ParserState a+stuple (a, b) = a :*: b+ -- | 'SM' is the Strict Monad for parsing.-newtype SM a = SM (B.ByteString -> Maybe (a, B.ByteString))+newtype SM a = SM (B.ByteString -> Maybe (ParserState a))++bindSM :: SM a -> (a -> SM b) -> SM b+bindSM (SM m) k = SM $ \s -> case m s of+ Nothing -> Nothing+ Just (x :*: s') ->+ case k x of+ SM y -> y s'+{-# INLINE bindSM #-}+returnSM :: a -> SM a+returnSM x = SM (\s -> Just (x :*: s))+{-# INLINE returnSM #-}+failSM :: String -> SM a+failSM _ = SM (\_ -> Nothing)+{-# INLINE failSM #-}+ instance Monad SM where- SM m >>= k = SM $ \s -> case m s of- Nothing -> Nothing- Just (x, s') ->- case k x of- SM y -> y s'- return x = SM (\s -> Just (x,s))- fail _ = SM (\_ -> Nothing)+ (>>=) = bindSM+ return = returnSM+ fail = failSM instance ParserM SM where work f = SM f maybeWork f = SM $ \s -> case f s of- Just (x, s') -> Just (Just x, s')- Nothing -> Just (Nothing, s)- peekInput = SM $ \s -> Just (s, s)+ Just (x :*: s') -> Just (Just x :*: s')+ Nothing -> Just (Nothing :*: s)+ peekInput = SM $ \s -> Just (s :*: s)+ parse = parseStrictly++-- The following instances allow us to use more conventional+-- interfaces provided by other parser libraries. The instances are+-- defined using bindSM, returnSM, and failSM to avoid any infinite,+-- or even unneccessary, recursion of instances between between+-- ParserM and Monad. Other recursive uses will be fine, such as+-- (<|>) = mplus.+instance MonadPlus SM where+ mzero = failSM ""+ -- | Over using mplus can lead to space leaks. It's best to push+ -- the use of mplus as far down as possible, because until the the+ -- first parameter completes, we must hold on to the input.+ mplus (SM a) (SM b) = SM $ \s ->+ case a s of+ Nothing -> b s+ r -> r++instance Functor SM where+ fmap f m = m `bindSM` (returnSM . f)++instance Applicative SM where+ pure = returnSM+ a <*> b =+ a `bindSM` \c ->+ b `bindSM` \d ->+ returnSM (c d)++instance Alternative SM where+ empty = failSM ""+ (<|>) = mplus
− src/Darcs/Patch/Real.hs
@@ -1,783 +0,0 @@--- Copyright (C) 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.--{-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans #-}-{-# LANGUAGE CPP #-}--- , TypeOperators, GADTs, PatternGuards #-}--#include "gadts.h"---- | Conflictor patches-module Darcs.Patch.Real- ( RealPatch(..), prim2real, isConsistent, isForward, isDuplicate,- pullCommon, mergeUnravelled ) where--import Control.Monad ( mplus, liftM )-import Data.List ( partition, nub )-import Darcs.Patch.Prim ( Prim, FromPrim(..), ToFromPrim(..), Conflict(..), Effect(..),- showPrim, showPrimFL, FileNameFormat(NewFormat),- IsConflictedPrim(..), ConflictState(..) )-import Darcs.Patch.Read ( readPrim )-import Darcs.Patch.Patchy-import Darcs.Witnesses.Ordered---import Darcs.Patch.Read ()---import Darcs.Patch.Viewing ()---import Darcs.Patch.Apply ()-import Darcs.Patch.Commute ( mangleUnravelled )-import Darcs.Patch.Non ( Non(..), Nonable(..), unNon,- showNons, showNon, readNons, readNon,- add, addP, addPs, remP, remPs, remNons,- (*>), (>*), (*>>), (>>*) )-import Darcs.Patch.Permutations ( commuteWhatWeCanFL, commuteWhatWeCanRL,- genCommuteWhatWeCanRL,- removeRL, removeFL, removeSubsequenceFL )-import qualified Data.ByteString.Char8 as BC ( ByteString, unpack )-import Darcs.Patch.ReadMonads ( work, peekInput, myLex )-import Darcs.Utils ( nubsort )-import Darcs.Witnesses.Sealed ( FlippedSeal(..), Sealed(Sealed), mapSeal )-import Darcs.Witnesses.Show-import Printer ( Doc, renderString, blueText, redText, (<+>), ($$) )-import Darcs.ColorPrinter ( errorDoc, assertDoc )---import Printer ( greenText )---import Darcs.ColorPrinter ( traceDoc )-#include "impossible.h"---- |--- @Duplicate x@: This patch has no effect since @x@ is already present in the repository------ @Etacilpud x: invert (Duplicate x)@------ @Normal prim@: A primitive patch------ @Conflictor ix xx x@:--- @ix@ is the set of patches:------ * that conflict with @x@ and also conflict with another patch in the repository------ * that conflict with a patch that conflict with @x@------ @xx@ is the sequence of patches that conflict *only* with @x@------ @x@ is the current patch------ @ix@ and @x@ are stored as @Non@ objects, which include any necessary--- context to uniquely define the patch that is referred to.------ @InvConflictor ix xx x@: like @invert (Conflictor ix xx x)@-data RealPatch C(x y) where- Duplicate :: Non RealPatch C(x) -> RealPatch C(x x)- Etacilpud :: Non RealPatch C(x) -> RealPatch C(x x)- Normal :: Prim C(x y) -> RealPatch C(x y)- Conflictor :: [Non RealPatch C(x)] -> FL Prim C(x y) -> Non RealPatch C(x) -> RealPatch C(y x)- InvConflictor :: [Non RealPatch C(x)] -> FL Prim C(x y) -> Non RealPatch C(x) -> RealPatch C(x y)---- | 'isDuplicate' @p@ is ' @True@ if @p@ is either a 'Duplicate' or 'Etacilpud' patch-isDuplicate :: RealPatch C(s y) -> Bool-isDuplicate (Duplicate _) = True-isDuplicate (Etacilpud _) = True-isDuplicate _ = False---- | This is only used for unit testing-isForward :: RealPatch C(s y) -> Maybe Doc-isForward p@(InvConflictor _ _ _) =- Just $ redText "An inverse conflictor" $$ showPatch p-isForward p@(Etacilpud _) =- Just $ redText "An inverse duplicate" $$ showPatch p-isForward _ = Nothing--mergeUnravelled :: [Sealed ((FL Prim) C(x))] -> Maybe (FlippedSeal RealPatch C(x))-mergeUnravelled [] = Nothing-mergeUnravelled [_] = Nothing-mergeUnravelled ws = case mergeUnravelled_private ws of- Nothing -> Nothing- Just NilRL -> bug "found no patches in mergeUnravelled"- Just (z:<:_) -> Just $ FlippedSeal z- where notNullS :: Sealed ((FL Prim) C(x)) -> Bool- notNullS (Sealed NilFL) = False- notNullS _ = True- mergeUnravelled_private :: [Sealed (FL Prim C(x))] -> Maybe (RL RealPatch C(x x))- mergeUnravelled_private xs = reverseFL `fmap` mergeConflictingNons- (map sealed2non $ filter notNullS xs)---- | 'sealed2non' @(Sealed xs)@ converts @xs@ to a 'Non'.--- @xs@ must be non-empty since we split this list at the last patch-sealed2non :: Sealed ((FL Prim) C(x)) -> Non RealPatch C(x)-sealed2non (Sealed xs) = case reverseFL xs of- y:<:ys -> Non (mapFL_FL fromPrim $ reverseRL ys) y- NilRL -> bug "NilFL encountered in sealed2non"--mergeConflictingNons :: [Non RealPatch C(x)] -> Maybe (FL RealPatch C(x x))-mergeConflictingNons ns = mcn $ map unNon ns- where mcn :: [Sealed (FL RealPatch C(x))] -> Maybe (FL RealPatch C(x x))- mcn [] = Just NilFL- mcn [Sealed p] = case joinEffects p of -- this is just a safety check, and could- NilFL -> Just p -- be removed when we're sure of the code.- _ -> Nothing- mcn (Sealed p1:Sealed p2:zs) = case pullCommon p1 p2 of- Common c ps qs ->- case merge (ps :\/: qs) of- qs' :/\: _ -> mcn (Sealed (c +>+ ps +>+ qs'):zs)--joinEffects :: Effect p => p C(x y) -> FL Prim C(x y)-joinEffects = joinInverses . effect- where joinInverses :: FL Prim C(x y) -> FL Prim C(x y)- joinInverses NilFL = NilFL- joinInverses (p:>:ps) = case removeFL (invert p) ps' of- Just ps'' -> ps''- Nothing -> p :>: ps'- where ps' = joinInverses ps--assertConsistent :: RealPatch C(x y) -> RealPatch C(x y)-assertConsistent x = assertDoc (do e <- isConsistent x- Just (redText "Inconsistent patch:" $$ showPatch x $$ e)) x---- | @mergeAfterConflicting@ takes as input a sequence of conflicting--- patches @xxx@ (which therefore have no effect) and a sequence of--- primitive patches @yyy@ that follow said sequence of conflicting--- patches, and may depend upon some of the conflicting patches (as a--- resolution).---- The output is two sequences of patches the first consisting of a--- set of mutually-conflicting patches, and the second having the same--- effect as the original primitive patch sequence in the input.---- So far as I can tell, the second output is always identical to--- @mapFL Normal yyy@---- The first output is the set of patches from @xxx@ that are depended--- upon by @yyy@.--mergeAfterConflicting :: FL RealPatch C(x x) -> FL Prim C(x y)- -> Maybe (FL RealPatch C(x x), FL RealPatch C(x y))-mergeAfterConflicting xxx yyy = --traceDoc (greenText "mergeAfterConflicting xxx" $$ showPatch xxx $$- -- greenText "and yyy" $$ showPatch yyy) $- mac (reverseFL xxx) yyy NilFL- where mac :: RL RealPatch C(x y) -> FL Prim C(y z) -> FL RealPatch C(z a)- -> Maybe (FL RealPatch C(x x), FL RealPatch C(x a))- mac NilRL xs goneby = case joinEffects goneby of- NilFL -> Just (NilFL, mapFL_FL Normal xs)- _z -> --traceDoc (greenText "mac1 z" $$ showPatch _z) $- Nothing- mac (p:<:ps) xs goneby = --traceDoc (greenText "mac ps" $$ showPatch ps $$- -- greenText "p" $$ showPatch p $$- -- greenText "xs" $$ showPatch xs $$- -- greenText "goneby" $$ showPatch goneby) $- case commuteFLorComplain (p :> mapFL_FL Normal xs) of- Left _ -> case genCommuteWhatWeCanRL commuteNoConflicts (ps :> p) of- a:>p':>b ->- do (b',xs') <- mac b xs goneby- let pa = joinEffects $ p':<:a- --traceDoc (greenText "foo1" $$- -- showPatch pa) $ Just ()- NilFL <- return pa- return (reverseRL (p':<:a)+>+b', xs')- `mplus` do NilFL <- return goneby- NilFL <- return $ joinEffects (p:<:ps)- return (reverseRL (p:<:ps),- mapFL_FL Normal xs)- Right (l:>p'') ->- case allNormal l of- Just xs'' -> mac ps xs'' (p'':>:goneby)- Nothing ->- case genCommuteWhatWeCanRL commuteNoConflicts (ps :> p) of- a:>p':>b ->- do (b',xs') <- mac b xs goneby- let pa = joinEffects $ p':<:a- --traceDoc (greenText "foo2" $$- -- showPatch pa) $ Just ()- NilFL <- return pa- return $ (reverseRL (p':<:a)+>+b', xs')--geteff :: [Non RealPatch C(x)] -> FL Prim C(x y) -> ([Non RealPatch C(x)], FL RealPatch C(x y))-geteff _ NilFL = ([],NilFL)-geteff ix (x:>:xs) | Just ix' <- mapM (remP (Normal x)) ix- = --traceDoc (greenText "I got rid of x" $$ showPatch x) $- case geteff ix' xs of- (ns,xs') -> (non (Normal x) : map (addP (Normal x)) ns,- Normal x :>: xs')-geteff ix xx = case mergeConflictingNons ix of- Nothing -> errorDoc $ redText "mergeConflictingNons failed in geteff with ix" $$- showNons ix $$ redText "xx" $$ showPatch xx- Just rix -> case mergeAfterConflicting rix xx of- Just (a,x) -> (map (addPs (reverseFL a)) $ toNons x,- a +>+ x)- Nothing -> errorDoc $ redText "mergeAfterConflicting failed in geteff"$$- redText "where ix" $$ showNons ix $$- redText "and xx" $$ showPatch xx $$- redText "and rix" $$ showPatch rix--xx2nons :: [Non RealPatch C(x)] -> FL Prim C(x y) -> [Non RealPatch C(x)]-xx2nons ix xx = fst $ geteff ix xx--xx2patches :: [Non RealPatch C(x)] -> FL Prim C(x y) -> FL RealPatch C(x y)-xx2patches ix xx = snd $ geteff ix xx---- | If @xs@ consists only of 'Normal' patches, 'allNormal' @xs@ returns--- @Just pxs@ those patches (so @lengthFL pxs == lengthFL xs@).--- Otherwise, it returns 'Nothing'.-allNormal :: FL RealPatch C(x y) -> Maybe (FL Prim C(x y))-allNormal (Normal x:>:xs) = (x :>:) `fmap` allNormal xs-allNormal NilFL = Just NilFL-allNormal _ = Nothing---- | This is used for unit-testing and for internal sanity checks-isConsistent :: RealPatch C(x y) -> Maybe Doc-isConsistent (Normal _) = Nothing-isConsistent (Duplicate _) = Nothing-isConsistent (Etacilpud _) = Nothing-isConsistent (Conflictor im mm m@(Non deps _))- | not $ everyoneConflicts im = Just $ redText "Someone doesn't conflict in im in isConsistent"- | Just _ <- remPs rmm m, _:>:_ <- mm = Just $ redText "m doesn't conflict with mm in isConsistent"- | any (\x -> any (x `conflictsWith`) nmm) im- = Just $ redText "mm conflicts with im in isConsistent where nmm is" $$- showNons nmm- | Nothing <- (nmm ++ im) `minus` toNons deps = Just $ redText "dependencies not in conflict:" $$- showNons (toNons deps) $$- redText "compared with deps itself:" $$- showPatch deps- | otherwise = case allConflictsWith m im of- (im1,[]) | im1 `eqSet` im -> Nothing- (_,imnc) -> Just $ redText "m doesn't conflict with im in isConsistent. unconflicting:"- $$ showNons imnc- where (nmm, rmm) = geteff im mm-isConsistent c@(InvConflictor _ _ _) = isConsistent (invert c)--everyoneConflicts :: [Non RealPatch C(x)] -> Bool-everyoneConflicts [] = True-everyoneConflicts (x:xs) = case allConflictsWith x xs of- ([],_) -> False- (_,xs') -> everyoneConflicts xs'--prim2real :: Prim C(x y) -> RealPatch C(x y)-prim2real = Normal--instance Patchy RealPatch--mergeWith :: Non RealPatch C(x) -> [Non RealPatch C(x)] -> Sealed (FL Prim C(x))-mergeWith p [] = effect `mapSeal` unNon p-mergeWith p xs = mergeall $ map unNon $ (p:) $ unconflicting_of $- filter (\x -> not (p `dependsUpon` x) && not (p `conflictsWith` x)) xs- where mergeall :: [Sealed (FL RealPatch C(x))] -> Sealed (FL Prim C(x))- mergeall [Sealed x] = Sealed $ effect x- mergeall [] = Sealed NilFL- mergeall (Sealed x:Sealed y:rest) = case merge (x :\/: y) of- y' :/\: _ -> mergeall (Sealed (x+>+y'):rest)- unconflicting_of [] = []- unconflicting_of (q:qs) = case allConflictsWith q qs of- ([],_) -> q:qs- (_,nc) -> unconflicting_of nc--instance Conflict RealPatch where- conflictedEffect (Duplicate (Non _ x)) = [IsC Duplicated x]- conflictedEffect (Etacilpud _) = impossible- conflictedEffect (Conflictor _ _ (Non _ x)) = [IsC Conflicted x]- conflictedEffect (InvConflictor _ _ _) = impossible- conflictedEffect (Normal x) = [IsC Okay x]- resolveConflicts (Conflictor ix xx x) = [mangleUnravelled unravelled : unravelled]- where unravelled = nub $ filter isn $ map (`mergeWith` (x:ix++nonxx)) (x:ix++nonxx)- nonxx = nonxx_ (nonxx_aux ix xx)- nonxx_aux :: [Non RealPatch C(x)] -> FL Prim C(x y) -> RL RealPatch C(x y)- nonxx_aux a b = reverseFL $ xx2patches a b- nonxx_ :: RL RealPatch C(x y) -> [Non RealPatch C(x)]- nonxx_ NilRL = []- nonxx_ ((Normal q) :<: qs) = [Non (reverseRL qs) q]- nonxx_ _ = []- isn :: Sealed (FL p C(x)) -> Bool- isn (Sealed NilFL) = False- isn _ = True- resolveConflicts _ = []-- -- cA- commuteNoConflicts (Duplicate x :> Duplicate y) = Just (Duplicate y :> Duplicate x)- commuteNoConflicts (Etacilpud x :> Duplicate y) = Just (Duplicate y :> Etacilpud x)- commuteNoConflicts (Duplicate x :> Etacilpud y) = Just (Etacilpud y :> Duplicate x)- commuteNoConflicts (Etacilpud x :> Etacilpud y) = Just (Etacilpud y :> Etacilpud x)- -- cB- commuteNoConflicts (x :> Duplicate d) = if d == addP (invert x) (non x)- then Just (x :> Duplicate d)- else do d' <- remP (invert x) d- return (Duplicate d' :> x)- commuteNoConflicts (Duplicate d' :> x) = Just (x :> Duplicate (addP (invert x) d'))- commuteNoConflicts c@(Etacilpud _ :> _) = invertCommuteNC c- commuteNoConflicts c@(_ :> Etacilpud _) = invertCommuteNC c- -- cE- commuteNoConflicts (Normal x :> Normal y) = do y' :> x' <- commute (x :> y)- return (Normal y' :> Normal x')- -- cF -- involves a conflict- -- cG- commuteNoConflicts (Normal x :> Conflictor iy yy y) =- case commuteFLorComplain (x :> invert yy) of- Right (iyy' :> x') -> do- y':iy' <- mapM (Normal x' >*) (y:iy)- return (Conflictor iy' (invert iyy') y' :> Normal x')- _ -> Nothing- -- cFi+cGi -- handle with previous two pattern matches- commuteNoConflicts c@(InvConflictor _ _ _ :> Normal _) = invertCommuteNC c- -- icG FIXME: where is icF?- commuteNoConflicts (Conflictor iy' yy' y' :> Normal x') =- do x :> iyy <- commuteRL (invertFL yy' :> x')- y:iy <- mapM (*> Normal x') (y':iy')- return (Normal x :> Conflictor iy (invertRL iyy) y)- -- icGi -- handle with previous pattern match- commuteNoConflicts c@(Normal _ :> InvConflictor _ _ _) = invertCommuteNC c- -- cH -- this involves a conflict commute- -- cI- commuteNoConflicts (Conflictor ix xx x :> Conflictor iy yy y) =- do xx' :> yy' <- commute (yy :> xx)- x':ix' <- mapM (yy >>*) (x:ix)- y':iy' <- mapM (*>> xx') (y:iy)- False <- return $ any (conflictsWith y) (x':ix')- False <- return $ any (conflictsWith x') iy- return (Conflictor iy' yy' y' :> Conflictor ix' xx' x')- -- cHi+cIi uses previous two matches- commuteNoConflicts c@(InvConflictor _ _ _ :> InvConflictor _ _ _) = invertCommuteNC c- -- cJ- commuteNoConflicts (InvConflictor ix xx x :> Conflictor iy yy y) =- do iyy' :> xx' <- commute (xx :> invert yy)- y':iy' <- mapM (xx' >>*) (y:iy)- x':ix' <- mapM (invertFL iyy' >>*) (x:ix)- False <- return $ any (conflictsWith y') (x':ix')- False <- return $ any (conflictsWith x') iy'- return (Conflictor iy' (invert iyy') y' :> InvConflictor ix' xx' x')- -- icJ- commuteNoConflicts (Conflictor iy' yy' y' :> InvConflictor ix' xx' x') =- do xx :> iyy <- commute (invert yy' :> xx')- y:iy <- mapM (*>> xx') (y':iy')- x:ix <- mapM (*>> yy') (x':ix')- False <- return $ any (conflictsWith y') (x':ix')- False <- return $ any (conflictsWith x') iy'- return (InvConflictor ix xx x :> Conflictor iy (invert iyy) y)- isInconsistent = isConsistent--instance FromPrim RealPatch where- fromPrim = prim2real-instance ToFromPrim RealPatch where- toPrim (Normal p) = Just p- toPrim _ = Nothing--instance MyEq RealPatch where- (Duplicate x) =\/= (Duplicate y) | x == y = IsEq- (Etacilpud x) =\/= (Etacilpud y) | x == y = IsEq- (Normal x) =\/= (Normal y) = x =\/= y- (Conflictor cx xx x) =\/= (Conflictor cy yy y)- | map (add $ invertFL xx) cx `eqSet`- map (add $ invertFL yy) cy &&- add (invert xx) x == add (invert yy) y = xx =/\= yy- (InvConflictor cx xx x) =\/= (InvConflictor cy yy y)- | cx `eqSet` cy && x == y = xx =\/= yy- _ =\/= _ = NotEq--eqSet :: Eq a => [a] -> [a] -> Bool-eqSet [] [] = True-eqSet (x:xs) xys | Just ys <- remove1 x xys = eqSet xs ys-eqSet _ _ = False--remove1 :: Eq a => a -> [a] -> Maybe [a]-remove1 x (y:ys) | x == y = Just ys- | otherwise = (y :) `fmap` remove1 x ys-remove1 _ [] = Nothing--minus :: Eq a => [a] -> [a] -> Maybe [a]-minus xs [] = Just xs-minus xs (y:ys) = do xs' <- remove1 y xs- xs' `minus` ys--invertNon :: Non RealPatch C(x) -> Non RealPatch C(x)-invertNon (Non c x)- | Just rc' <- removeRL nix (reverseFL c) = Non (reverseRL rc') (invert x)- | otherwise = addPs (Normal x :<: reverseFL c) $ non nix- where nix = Normal $ invert x--nonTouches :: Non RealPatch C(x) -> [FilePath]-nonTouches (Non c x) = listTouchedFiles (c +>+ fromPrim x :>: NilFL)--nonHunkMatches :: (BC.ByteString -> Bool) -> Non RealPatch C(x) -> Bool-nonHunkMatches f (Non c x) = hunkMatches f c || hunkMatches f x--toNons :: (Conflict p, Patchy p, ToFromPrim p, Nonable p) => FL p C(x y) -> [Non p C(x)]-toNons xs = map lastNon $ initsFL xs- where lastNon :: (Conflict p, Patchy p, Nonable p) => Sealed ((p :> FL p) C(x)) -> Non p C(x)- lastNon (Sealed xxx) = case lastNon_aux xxx of- deps :> p :> _ -> case non p of- Non NilFL pp -> Non (reverseRL deps) pp- Non ds pp -> errorDoc $ redText "Weird case in toNons" $$- redText "please report this bug!" $$- (case xxx of- z:>zs -> showPatch (z:>:zs)) $$- redText "ds are" $$ showPatch ds $$- redText "pp is" $$ showPatch pp- reverseFoo :: (p :> FL p) C(x y) -> (RL p :> p) C(x y)- reverseFoo (p :> ps) = rf NilRL p ps- where rf :: RL p C(a b) -> p C(b c) -> FL p C(c d) -> (RL p :> p) C(a d)- rf rs l NilFL = rs :> l- rf rs x (y:>:ys) = rf (x:<:rs) y ys- lastNon_aux :: Commute p => (p :> FL p) C(x y) -> (RL p :> p :> RL p) C(x y)- lastNon_aux = commuteWhatWeCanRL . reverseFoo--initsFL :: Patchy p => FL p C(x y) -> [Sealed ((p :> FL p) C(x))]-initsFL NilFL = []-initsFL (x:>:xs) = Sealed (x:>NilFL) : map (\ (Sealed (y:>xs')) -> Sealed (x:>y:>:xs')) (initsFL xs)--fromNons :: [Non RealPatch C(x)] -> Maybe (Sealed (FL Prim C(x)))-fromNons [] = Just $ Sealed $ NilFL-fromNons ns = do (Sealed p, ns') <- pullInContext ns- ns'' <- mapM (remP $ fromPrim p) ns'- Sealed ps <- fromNons ns''- return $ Sealed $ p :>: ps--pullInContext :: [Non RealPatch C(x)] -> Maybe (Sealed (Prim C(x)), [Non RealPatch C(x)])-pullInContext (Non NilFL p:ns) = Just (Sealed p, ns)-pullInContext (n:ns) = do (sp,ns') <- pullInContext ns- return (sp, n:ns')-pullInContext [] = Nothing--filterConflictsFL :: Non RealPatch C(x) -> FL Prim C(x y) -> (FL Prim :> FL Prim) C(x y)-filterConflictsFL _ NilFL = NilFL :> NilFL-filterConflictsFL n (p:>:ps)- | Just n' <- remP (fromPrim p) n = case filterConflictsFL n' ps of- p1 :> p2 -> p:>:p1 :> p2- | otherwise = case commuteWhatWeCanFL (p :> ps) of- p1 :> p' :> p2 -> case filterConflictsFL n p1 of- p1a :> p1b -> p1a :> p1b +>+ p' :>: p2--instance Invert RealPatch where- invert (Duplicate d) = Etacilpud d- invert (Etacilpud d) = Duplicate d- invert (Normal p) = Normal (invert p)- invert (Conflictor x c p) = InvConflictor x c p- invert (InvConflictor x c p) = Conflictor x c p- identity = Normal identity--instance Commute RealPatch where--- commute (x :> y) | traceDoc (greenText "commuting x" $$ showPatch x $$--- greenText "with y" $$ showPatch y) False = undefined- commute (x :> y) | Just (y' :> x') <- commuteNoConflicts (assertConsistent x :> assertConsistent y) = Just (y' :> x')- -- cF- commute (Normal x :> Conflictor a1'nop2 n1'x p1') -- these patches conflicted- | Just rn1' <- removeRL x (reverseFL n1'x) =- do let p2:n1nons = reverse $ xx2nons a1'nop2 $ reverseRL (x:<:rn1')- a2 = p1':a1'nop2++n1nons- case (a1'nop2, reverseRL rn1', p1') of- ([], NilFL, Non c y) | NilFL <- joinEffects c ->- Just (Normal y :> Conflictor a1'nop2 (y:>:NilFL) p2)- (a1,n1,_) -> Just (Conflictor a1 n1 p1' :> Conflictor a2 NilFL p2)- -- cFi -- handle with previous pattern match- commute c@(InvConflictor _ _ _ :> Normal _) = invertCommute c- -- cH- commute (Conflictor a1 n1 p1 :> Conflictor a2 n2 p2)- | Just a2_minus_p1 <- remove1 p1' a2,- not (p2 `dependsUpon` p1') =- do let n1nons = map (add n2) $ xx2nons a1 n1- n2nons = xx2nons a2 n2- Just a2_minus_p1n1 = a2_minus_p1 `minus` n1nons- n2n1 = n2 +>+ n1- a1' = map (add n2) a1- p2ooo = remNons a1' p2- n1' :> n2' <- return $ filterConflictsFL p2ooo n2n1- let n1'n2'nons = xx2nons a2_minus_p1n1 (n1'+>+n2')- n1'nons = take (lengthFL n1') n1'n2'nons- n2'nons = drop (lengthFL n1') n1'n2'nons- Just a1'nop2 = (a2++n2nons) `minus` (p1':n1'nons)- Just a2'o = --traceDoc (greenText "\n\nConflictor a1 n1 p1 is" $$- -- showPatch (assertConsistent $ Conflictor a1 n1 p1) $$- -- greenText "and Conflictor a2 n2 p2 is" $$- -- showPatch (assertConsistent $ Conflictor a2 n2 p2) $$- -- greenText "where n2'nons is" $$ showNons n2'nons $$- -- greenText "and others are" $$- -- showNons (fst $ allConflictsWith p2 $ a2_minus_p1++n2nons) $$- -- greenText "These came from" $$- -- showNons (a2_minus_p1++n2nons) $$- -- greenText "n1'n2'nons" $$ showNons n1'n2'nons $$- -- greenText "from n1' :> n2'" $$- -- showPatch n1' $$ greenText ":>" $$ showPatch n2' $$- -- greenText "p2" $$ showNon p2 $$- -- greenText "p2 fixed" $$ showNon p2ooo $$- -- -- greenText "pren1" $$ showPatch pren1 $$- -- greenText "n1'" $$ showPatch n1' $$- -- greenText "p2" $$ showNon p2- -- )- (fst $ allConflictsWith p2 $ a2_minus_p1++n2nons) `minus` n2'nons- Just a2' = mapM (remPs (xx2patches a1'nop2 n1')) $- a2'o- Just p2' = remPs (xx2patches a1'nop2 n1') p2- case (a2', n2', p2') of- ([], NilFL, Non c x) | NilFL <- joinEffects c ->- Just (Normal x :> Conflictor a1'nop2 (n1'+>+x:>:NilFL) p1')- | otherwise -> impossible- _ -> Just (Conflictor a2' n2' p2' :> Conflictor (p2:a1'nop2) n1' p1')- where (_,rpn2) = geteff a2 n2- p1' = addPs (reverseFL rpn2) p1- -- cHi -- uses previous match- commute c@(InvConflictor _ _ _ :> InvConflictor _ _ _) = invertCommute c- commute _ = Nothing-- merge (InvConflictor _ _ _ :\/: _) = impossible- merge (_ :\/: InvConflictor _ _ _) = impossible- merge (Etacilpud _ :\/: _) = impossible- merge (_ :\/: Etacilpud _) = impossible--- merge (x :\/: y) | traceDoc (greenText "merging x" $$ showPatch x $$--- greenText "with y" $$ showPatch y) False = impossible- -- mA- merge (Duplicate a :\/: Duplicate b) = Duplicate b :/\: Duplicate a- -- mB- merge (Duplicate a :\/: b) = b :/\: Duplicate (addP (invert b) a) -- FIXME ???- -- smB- merge m@(_ :\/: Duplicate _) = swapMerge m- -- mC--- merge _ | traceDoc (greenText "about to look for conflictingness") False = impossible- merge (x :\/: y) | Just (y' :> ix') <- commute (invert (assertConsistent x) :> assertConsistent y),- Just (y'' :> _) <- commute (x :> y'),- IsEq <- y'' =\/= y = --traceDoc (greenText "These didn't conflict") $- assertConsistent y' :/\: invert (assertConsistent ix')- | IsEq <- x =\/= y,- n <- addP (invert x) $ non x =- --traceDoc (greenText "Found duplicate") $- Duplicate n :/\: Duplicate n--- merge (x :\/: y) | traceDoc (greenText "trying to merging x" $$ showPatch x $$--- greenText "which conflicts with y" $$ showPatch y) False = impossible- -- mD- merge (Normal x :\/: Normal y) =- Conflictor [] (x:>:NilFL) (non $ Normal y) :/\: Conflictor [] (y:>:NilFL) (non $ Normal x)- -- mG- merge (Normal x :\/: Conflictor iy yy y) =- --traceDoc (greenText "merging Normal x" $$ showPatch x $$- -- greenText "and Conflictor iy yy y" $$ showPatch (Conflictor iy yy y)) $- Conflictor iy yyx y :/\: Conflictor (y:iy++nyy) NilFL x'- where yyx = yy +>+ x:>:NilFL- (x':nyy) = reverse $ xx2nons iy yyx- -- smE+smG- merge m@(Conflictor _ _ _ :\/: Normal _) = swapMerge m--- merge (x :\/: y) | traceDoc (greenText "still trying to merge x" $$ showPatch x $$--- greenText "with y" $$ showPatch y) False = impossible- -- mH see also cH- merge (Conflictor ix xx x :\/: Conflictor iy yy y) =- case pullCommonRL (reverseFL xx) (reverseFL yy) of- CommonRL rxx1 ryy1 c ->- case commuteRLFL (ryy1 :> invertRL rxx1) of- Just (ixx' :> ryy') ->- let xx' = invert ixx'- yy' = reverseRL ryy'- y':iy' = map (add $ invertFL ixx') (y:iy)- x':ix' = map (add ryy') (x:ix)- nyy' = xx2nons iy' yy'- nxx' = xx2nons ix' xx'- icx = drop (lengthRL rxx1) $ xx2nons ix (reverseRL $ c+<+rxx1)- ic' = map (add ryy') icx- ixy' = ic' ++ (iy'+++ix')- -- +++ above is a more efficient version of nub- -- (iy'++ix') given that we know each element shows up- -- only once in either list.- in --traceDoc (greenText "here I am! and so is ixy'" $$ showNons ixy' $$- -- greenText "and iy" $$ showNons iy $$ greenText (show $ length iy) $$- -- greenText "and ix" $$ showNons ix $$- -- greenText "and iy'" $$ showNons iy' $$- -- greenText "and ix'" $$ showNons ix' $$- -- greenText "and ic'" $$ showNons ic'- -- ) $- Conflictor (x':ixy'++nxx') yy' y' :/\: Conflictor (y':ixy'++nyy') xx' x'- Nothing -> impossible pullInContext fromNons--- merge _ = error "haven't finished fixing merge"-- listTouchedFiles (Duplicate p) = nonTouches p- listTouchedFiles (Etacilpud p) = nonTouches p- listTouchedFiles (Normal p) = listTouchedFiles p- listTouchedFiles (Conflictor x c p) =- nubsort $ concatMap nonTouches x ++ listTouchedFiles c ++ nonTouches p- listTouchedFiles (InvConflictor x c p) =- nubsort $ concatMap nonTouches x ++ listTouchedFiles c ++ nonTouches p-- hunkMatches f (Duplicate p) = nonHunkMatches f p- hunkMatches f (Etacilpud p) = nonHunkMatches f p- hunkMatches f (Normal p) = hunkMatches f p- hunkMatches f (Conflictor x c p) = or [or $ map (nonHunkMatches f) x, hunkMatches f c, nonHunkMatches f p]- hunkMatches f (InvConflictor x c p) = or [or $ map (nonHunkMatches f) x, hunkMatches f c, nonHunkMatches f p]--{--allConflictsWithFL :: FL Prim C(x y) -> [Non RealPatch C(x)]- -> ([Non RealPatch C(x)], [Non RealPatch C(x)])-allConflictsWithFL xx ns = case partition f ns of- ([],nc) -> ([],nc)- (c,nc) -> case acw c nc of- (c',nc') -> (c++c',nc')- where acw (y:ys) zs = case allConflictsWith y zs of- (c,nc) -> case acw ys nc of- (c',nc') -> (c++c',nc')- acw [] zs = ([],zs)- f (Non c p) = case commuteRLFL (invertFL c :> mapFL_FL Normal xx) of- Nothing -> True- Just (xx' :> _) -> case commuteFLorComplain (Normal (invert p) :> xx') of- Nothing -> True- Just _ -> False--}-allConflictsWith :: Non RealPatch C(x) -> [Non RealPatch C(x)]- -> ([Non RealPatch C(x)], [Non RealPatch C(x)])-allConflictsWith x ys = acw $ partition (conflictsWith x) ys- where acw ([],nc) = ([],nc)- acw (c:cs, nc) = case allConflictsWith c nc of- (c1,nc1) -> case acw (cs, nc1) of- (xs',nc') -> (c:c1++xs',nc')--conflictsWith :: Non RealPatch C(x) -> Non RealPatch C(x) -> Bool-conflictsWith x y | x `dependsUpon` y || y `dependsUpon` x = False-conflictsWith x (Non cy y) =- case remPs cy x of- Just (Non cx' x') -> case commuteFLorComplain (fromPrim (invert y) :> cx' +>+ fromPrim x' :>: NilFL) of- Right _ -> False- Left _ -> True- Nothing -> True--dependsUpon :: Non RealPatch C(x) -> Non RealPatch C(x) -> Bool-dependsUpon (Non xs _) (Non ys y) =- case removeSubsequenceFL (ys +>+ fromPrim y :>: NilFL) xs of- Just _ -> True- Nothing -> False--(+++) :: Eq a => [a] -> [a] -> [a]-[] +++ x = x-x +++ [] = x-(x:xs) +++ xys | Just ys <- remove1 x xys = x : (xs +++ ys)- | otherwise = x : (xs +++ xys)--swapMerge :: (RealPatch :\/: RealPatch) C(x y) -> (RealPatch :/\: RealPatch) C(x y)-swapMerge (x :\/: y) = case merge (y :\/: x) of x' :/\: y' -> y' :/\: x'--invertCommute :: (RealPatch :> RealPatch) C(x y) -> Maybe ((RealPatch :> RealPatch) C(x y))-invertCommute (x :> y) = do ix' :> iy' <- commute (invert y :> invert x)- return (invert iy' :> invert ix')--invertCommuteNC :: (RealPatch :> RealPatch) C(x y) -> Maybe ((RealPatch :> RealPatch) C(x y))-invertCommuteNC (x :> y) = do ix' :> iy' <- commuteNoConflicts (invert y :> invert x)- return (invert iy' :> invert ix')---- | 'pullCommon' @xs ys@ returns the set of patches that can be commuted--- out of both @xs@ and @ys@ along with the remnants of both lists-pullCommon :: Patchy p => FL p C(o x) -> FL p C(o y) -> Common p C(o x y)-pullCommon NilFL ys = Common NilFL NilFL ys-pullCommon xs NilFL = Common NilFL xs NilFL-pullCommon (x:>:xs) xys | Just ys <- removeFL x xys = case pullCommon xs ys of- Common c xs' ys' -> Common (x:>:c) xs' ys'-pullCommon (x:>:xs) ys = case commuteWhatWeCanFL (x :> xs) of- xs1:>x':>xs2 -> case pullCommon xs1 ys of- Common c xs1' ys' -> Common c (xs1'+>+x':>:xs2) ys'---- | 'Common' @cs xs ys@ represents two sequences of patches that have @cs@ in common,--- in other words @cs +>+ xs@ and @cs +>+ ys@-data Common p C(o x y) where- Common :: FL p C(o i) -> FL p C(i x) -> FL p C(i y) -> Common p C(o x y)---- | 'pullCommonRL' @xs ys@ returns the set of patches that can be commuted--- out of both @xs@ and @ys@ along with the remnants of both lists-pullCommonRL :: Patchy p => RL p C(x o) -> RL p C(y o) -> CommonRL p C(x y o)-pullCommonRL NilRL ys = CommonRL NilRL ys NilRL-pullCommonRL xs NilRL = CommonRL xs NilRL NilRL-pullCommonRL (x:<:xs) xys- | Just ys <- removeRL x xys = case pullCommonRL xs ys of- CommonRL xs' ys' c -> CommonRL xs' ys' (x:<:c)-pullCommonRL (x:<:xs) ys =- case commuteWhatWeCanRL (xs :> x) of- xs1:>x':>xs2 -> case pullCommonRL xs2 ys of- CommonRL xs2' ys' c -> CommonRL (xs2'+<+x':<:xs1) ys' c---- | 'CommonRL' @xs ys cs@' represents two sequences of patches that have @cs@ in common,--- in other words @xs +<+ cs@ and @ys +<+ cs@-data CommonRL p C(x y f) where- CommonRL :: RL p C(x i) -> RL p C(y i) -> RL p C(i f) -> CommonRL p C(x y f)--instance Apply RealPatch where- apply opts p = apply opts (effect p)- applyAndTryToFixFL (Normal p) = mapMaybeSnd (mapFL_FL Normal) `liftM` applyAndTryToFixFL p- applyAndTryToFixFL x = do apply [] x; return Nothing--instance ShowPatch RealPatch where- showPatch (Duplicate d) = blueText "duplicate" $$ showNon d- showPatch (Etacilpud d) = blueText "etacilpud" $$ showNon d- showPatch (Normal p) = showPrim NewFormat p- showPatch (Conflictor i NilFL p) =- blueText "conflictor" <+> showNons i <+> blueText "[]" $$ showNon p- showPatch (Conflictor i cs p) =- blueText "conflictor" <+> showNons i <+> blueText "[" $$- showPrimFL NewFormat cs $$- blueText "]" $$- showNon p- showPatch (InvConflictor i NilFL p) =- blueText "rotcilfnoc" <+> showNons i <+> blueText "[]" $$ showNon p- showPatch (InvConflictor i cs p) =- blueText "rotcilfnoc" <+> showNons i <+> blueText "[" $$- showPrimFL NewFormat cs $$- blueText "]" $$- showNon p- showContextPatch (Normal p) = showContextPatch p- showContextPatch c = return $ showPatch c--instance ReadPatch RealPatch where- readPatch' _ =- do s <- peekInput- case fmap (BC.unpack . fst) $ myLex s of- Just "duplicate" ->- do work myLex- p <- readNon- return $ (Sealed . Duplicate) `fmap` p- Just "etacilpud" ->- do work myLex- p <- readNon- return $ (Sealed . Etacilpud) `fmap` p- Just "conflictor" ->- do work myLex- --let tracePeek x = do y <- peekInput- -- traceDoc (greenText x $$ greenText (show $ BC.unpack y)) return ()- i <- readNons- Just (Sealed ps) <- bracketedFL (readPrim NewFormat) (fromIntegral $ fromEnum '[') (fromIntegral $ fromEnum ']')-- Just p <- readNon- return $ Just $ Sealed $ Conflictor i (unsafeCoerceP ps) p- Just "rotcilfnoc" ->- do work myLex- i <- readNons- Just (Sealed ps) <- bracketedFL (readPrim NewFormat) (fromIntegral $ fromEnum '[') (fromIntegral $ fromEnum ']')- Just p <- readNon- return $ Just $ Sealed $ InvConflictor i ps p- _ -> do mp <- readPrim NewFormat- case mp of- Just p -> return $ Just $ Normal `mapSeal` p- Nothing -> return Nothing--instance Show (RealPatch C(x y)) where- show p = renderString $ showPatch p--instance Show2 RealPatch where- showDict2 = ShowDictClass--instance Nonable RealPatch where- non (Duplicate d) = d- non (Etacilpud d) = invertNon d -- FIXME !!! ???- non (Normal p) = Non NilFL p- non (Conflictor _ xx x) = add (invertFL xx) x- non (InvConflictor _ _ n) = invertNon n--instance Effect RealPatch where- effect (Duplicate _) = NilFL- effect (Etacilpud _) = NilFL- effect (Normal p) = effect p- effect (Conflictor _ e _) = invert e- effect (InvConflictor _ e _) = e- effectRL (Duplicate _) = NilRL- effectRL (Etacilpud _) = NilRL- effectRL (Normal p) = effectRL p- effectRL (Conflictor _ e _) = invertFL e- effectRL (InvConflictor _ e _) = reverseFL e- isHunk rp = do Normal p <- return rp- isHunk p
+ src/Darcs/Patch/Repair.hs view
@@ -0,0 +1,52 @@+module Darcs.Patch.Repair+ ( Repair(..), RepairToFL(..), mapMaybeSnd, Check(..) )+ where++import Darcs.Patch.Apply ( Apply(..) )+import Darcs.Patch.ApplyMonad ( ApplyMonad )+import Darcs.Witnesses.Ordered ( FL(..), RL(..), mapFL, mapRL, (+>+) )+import Printer ( Doc )++import Data.Maybe ( catMaybes, listToMaybe )++#include "gadts.h"++class Check p where+ isInconsistent :: p C(x y) -> Maybe Doc+ isInconsistent _ = Nothing++-- |'Repair' and 'RepairToFL' deal with repairing old patches that were+-- were written out due to bugs or that we no longer wish to support.+-- 'Repair' is implemented by collections of patches (FL, Named, PatchInfoAnd) that+-- might need repairing.+class Repair p where+ applyAndTryToFix :: ApplyMonad m => p C(x y) -> m (Maybe (String, p C(x y)))++-- |'RepairToFL' is implemented by single patches that can be repaired (Prim, Patch, RealPatch)+-- There is a default so that patch types with no current legacy problems don't need to+-- have an implementation.+class Apply p => RepairToFL p where+ applyAndTryToFixFL :: ApplyMonad m => p C(x y) -> m (Maybe (String, FL p C(x y)))+ applyAndTryToFixFL p = do apply p; return Nothing++mapMaybeSnd :: (a -> b) -> Maybe (c, a) -> Maybe (c, b)+mapMaybeSnd f (Just (a,b)) = Just (a,f b)+mapMaybeSnd _ Nothing = Nothing++instance Check p => Check (FL p) where+ isInconsistent = listToMaybe . catMaybes . mapFL isInconsistent++instance Check p => Check (RL p) where+ isInconsistent = listToMaybe . catMaybes . mapRL isInconsistent++instance RepairToFL p => Repair (FL p) where+ applyAndTryToFix NilFL = return Nothing+ applyAndTryToFix (p:>:ps) = do mp <- applyAndTryToFixFL p+ mps <- applyAndTryToFix ps+ return $ case (mp,mps) of+ (Nothing, Nothing) -> Nothing+ (Just (e,p'),Nothing) -> Just (e,p'+>+ps)+ (Nothing, Just (e,ps')) -> Just (e,p:>:ps')+ (Just (e,p'), Just (es,ps')) ->+ Just (unlines [e,es], p'+>+ps')+
+ src/Darcs/Patch/RepoPatch.hs view
@@ -0,0 +1,17 @@+module Darcs.Patch.RepoPatch ( RepoPatch ) where++import Darcs.Patch.Conflict ( Conflict, CommuteNoConflicts )+import Darcs.Patch.Effect ( Effect )+import Darcs.Patch.FileHunk ( IsHunk )+import Darcs.Patch.Format ( PatchListFormat )+import Darcs.Patch.Merge ( Merge )+import Darcs.Patch.Patchy ( Patchy )+import Darcs.Patch.Patchy.Instances ()+import Darcs.Patch.Prim ( PrimPatchBase, PrimOf, FromPrim )+import Darcs.Patch.Repair ( RepairToFL, Check )++class (Patchy p, Merge p, Effect p, IsHunk p, FromPrim p, Conflict p, CommuteNoConflicts p, Check p, RepairToFL p, PatchListFormat p,+ PrimPatchBase p, Patchy (PrimOf p), IsHunk (PrimOf p)+ )+ => RepoPatch p+
src/Darcs/Patch/Set.hs view
@@ -15,19 +15,18 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP, EmptyDataDecls #-} #include "gadts.h" module Darcs.Patch.Set ( PatchSet(..), Tagged(..), SealedPatchSet, Origin,- progressPatchSet, tags,+ progressPatchSet, tags, appendPSFL, newset2RL, newset2FL ) where import Progress ( progress ) import Darcs.Patch.Info ( PatchInfo )-import Darcs.Hopefully ( PatchInfoAnd, info )-import Darcs.Witnesses.Ordered ( FL, RL(..), (+<+),+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info )+import Darcs.Witnesses.Ordered ( FL, RL(..), (+<+), reverseFL, reverseRL, mapRL_RL, concatRL, mapRL ) import Darcs.Witnesses.Sealed ( Sealed ) @@ -49,6 +48,10 @@ newset2FL :: PatchSet p C(start x6) -> FL (PatchInfoAnd p) C(start x6) newset2FL = reverseRL . newset2RL++appendPSFL :: PatchSet p C(start x) -> FL (PatchInfoAnd p) C(x y)+ -> PatchSet p C(start y)+appendPSFL (PatchSet ps ts) newps = PatchSet (reverseFL newps +<+ ps) ts 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
+ src/Darcs/Patch/Show.hs view
@@ -0,0 +1,78 @@+-- Copyright (C) 2002-2005 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.++{-# LANGUAGE CPP #-}++module Darcs.Patch.Show+ ( ShowPatchBasic(..), ShowPatch(..)+ , showNamedPrefix+ , writePatch, gzWritePatch+ , formatFileName+ )+ where++import Prelude hiding ( pi )++import Darcs.Lock ( writeDocBinFile, gzWriteDocFile )+import Darcs.Patch.FileName ( FileName, fn2ps, encodeWhite, fn2fp )+import Darcs.Patch.Format ( FileNameFormat(..) )+import Darcs.Patch.Info ( PatchInfo, showPatchInfo )+import Darcs.Witnesses.Ordered ( FL )++import English ( plural, Noun(Noun) )+import Printer ( Doc, vcat, blueText, ($$), (<>), text, packedString )+import Storage.Hashed.Monad( TreeIO )+++#include "gadts.h"++showNamedPrefix :: PatchInfo -> [PatchInfo] -> Doc+showNamedPrefix n d = showPatchInfo n+ $$ blueText "<"+ $$ vcat (map showPatchInfo d)+ $$ blueText ">"++class ShowPatchBasic p where+ showPatch :: p C(x y) -> Doc++class ShowPatchBasic p => ShowPatch p where+ showNicely :: p C(x y) -> Doc+ showNicely = showPatch+ -- | showContextPatch is used to add context to a patch, as diff+ -- -u does. Thus, it differs from showPatch only for hunks. It is+ -- used for instance before putting it into a bundle. As this+ -- unified context is not included in patch representation, this+ -- requires access to the tree.+ showContextPatch :: p C(x y) -> TreeIO Doc+ showContextPatch p = return $ showPatch p+ description :: p C(x y) -> Doc+ description = showPatch+ summary :: p C(x y) -> Doc+ summaryFL :: FL p C(x y) -> Doc+ thing :: p C(x y) -> String+ thing _ = "patch"+ things :: p C(x y) -> String+ things x = plural (Noun $ thing x) ""++writePatch :: ShowPatchBasic p => FilePath -> p C(x y) -> IO ()+writePatch f p = writeDocBinFile f $ showPatch p <> text "\n"+gzWritePatch :: ShowPatchBasic p => FilePath -> p C(x y) -> IO ()+gzWritePatch f p = gzWriteDocFile f $ showPatch p <> text "\n"++formatFileName :: FileNameFormat -> FileName -> Doc+formatFileName OldFormat = packedString . fn2ps+formatFileName NewFormat = text . encodeWhite . fn2fp
− src/Darcs/Patch/Show.lhs
@@ -1,92 +0,0 @@-% Copyright (C) 2002-2005 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.---\begin{code}-{-# OPTIONS_GHC -cpp -fno-warn-orphans -fglasgow-exts #-}-{-# LANGUAGE CPP #-}--module Darcs.Patch.Show ( showPatch_, showNamedPrefix )- where--import Prelude hiding ( pi )--import Printer ( Doc, renderString, vcat,- text, blueText,- ($$), (<+>) )-import Darcs.Patch.Core ( Patch(..) )-import Darcs.Patch.Prim ( showPrim, FileNameFormat(..) )-import Darcs.Patch.Info ( PatchInfo, showPatchInfo )-import Darcs.Witnesses.Ordered ( FL(NilFL), mapFL )-import Darcs.Witnesses.Show ( Show2(..), ShowDict(..) )-#include "gadts.h"-\end{code}--\section{Patch string formatting}--Of course, in order to store our patches in a file, we'll have to save them-as some sort of strings. The convention is that each patch string will end-with a newline, but on parsing we skip any amount of whitespace between-patches.-\begin{code}-instance Show (Patch C(x y)) where- show p = renderString (showPatch_ p) ++ "\n"-instance Show2 Patch where- showDict2 = ShowDictClass--showPatch_ :: Patch C(a b) -> Doc-showPatch_ (PP p) = showPrim OldFormat p-showPatch_ (ComP NilFL) = blueText "{" $$ blueText "}"-showPatch_ (ComP ps) = blueText "{"- $$ vcat (mapFL showPatch_ ps)- $$ blueText "}"-showPatch_ (Merger _ _ p1 p2) = showMerger "merger" p1 p2-showPatch_ (Regrem _ _ p1 p2) = showMerger "regrem" p1 p2-\end{code}--\paragraph{Merger patches}-Merge two patches. The MERGERVERSION is included to allow some degree of-backwards compatibility if the merger algorithm needs to be changed.-\begin{verbatim}-merger MERGERVERSION-<first patch>-<second patch>-\end{verbatim}-\begin{code}-showMerger :: String -> Patch C(a b) -> Patch C(d e) -> Doc-showMerger merger_name p1 p2 =- blueText merger_name <+> text "0.0" <+> blueText "("- $$ showPatch_ p1- $$ showPatch_ p2- $$ blueText ")"-\end{code}--\paragraph{Named patches}--Named patches are displayed as a ``patch id'' which is in square brackets,-followed by a patch. Optionally, after the patch id (but before the patch-itself) can come a list of dependencies surrounded by angle brackets. Each-dependency consists of a patch id.--\begin{code}-showNamedPrefix :: PatchInfo -> [PatchInfo] -> Doc-showNamedPrefix n d = showPatchInfo n- $$ blueText "<"- $$ vcat (map showPatchInfo d)- $$ blueText ">"--\end{code}
src/Darcs/Patch/Split.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, RankNTypes, GADTs #-}+{-# LANGUAGE CPP, RankNTypes, GADTs, ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} -- Copyright (C) 2009 Ganesh Sittampalam --@@ -22,15 +22,17 @@ -- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -- SOFTWARE. -module Darcs.Patch.Split ( Splitter(..), rawSplitter, noSplitter, primSplitter ) where+module Darcs.Patch.Split ( Splitter(..), rawSplitter, noSplitter, primSplitter, reversePrimSplitter ) where import Data.List ( intersperse ) import Darcs.Witnesses.Ordered import Darcs.Witnesses.Sealed -import Darcs.Patch.Patchy ( ReadPatch(..), ShowPatch(..), Invert(..) )-import Darcs.Patch.Prim ( Prim(..), FilePatchType(..), canonize, canonizeFL )+import Darcs.Patch.FileHunk ( FileHunk(..), IsHunk(..) )+import Darcs.Patch.Patchy ( ReadPatch(..), showPatch, ShowPatch(..), Invert(..) )+import Darcs.Patch.Invert (invertFL)+import Darcs.Patch.Prim ( PrimPatch, canonize, canonizeFL, primFromHunk ) import Darcs.Patch.ReadMonads ( parseStrictly ) import Darcs.Patch.Read () import Darcs.Patch.Viewing ()@@ -94,8 +96,8 @@ rawSplitter = Splitter { applySplitter = \p -> Just (renderPS . showPatch $ p,- \str -> case parseStrictly (readPatch' False) str of- Just (Just (Sealed res), _) -> Just (withEditedHead p res)+ \str -> case parseStrictly readPatch' str of+ Just (Sealed res, _) -> Just (withEditedHead p res) _ -> Nothing ) ,canonizeSplit = id@@ -108,8 +110,8 @@ noSplitter = Splitter { applySplitter = const Nothing, canonizeSplit = id } -doPrimSplit :: Prim C(x y) -> Maybe (B.ByteString, B.ByteString -> Maybe (FL Prim C(x y)))-doPrimSplit (FP fn (Hunk n before after))+doPrimSplit :: PrimPatch prim => prim C(x y) -> Maybe (B.ByteString, B.ByteString -> Maybe (FL prim C(x y)))+doPrimSplit (isHunk -> Just (FileHunk fn n before after)) = Just (B.concat $ intersperse (BC.pack "\n") $ concat [ helptext , [mkSep " BEFORE (reference) =========================="]@@ -133,7 +135,8 @@ , " - To split removed text, copy back the part you want to retain" , "" ]- hunk b a = canonize (FP fn (Hunk n b a))+ hunk :: PrimPatch prim => [B.ByteString] -> [B.ByteString] -> FL prim C(a b)+ hunk b a = canonize (primFromHunk (FileHunk fn n b a)) mkSep s = BC.append sep (BC.pack s) breakSep xs = case break (sep `BC.isPrefixOf`) xs of (_, []) -> Nothing@@ -143,5 +146,18 @@ -- |Split a primitive hunk patch up -- by allowing the user to edit both the before and after lines, then insert fixup patches -- to clean up the mess.-primSplitter :: Splitter Prim-primSplitter = Splitter { applySplitter = doPrimSplit, canonizeSplit = canonizeFL }+primSplitter :: PrimPatch p => Splitter p+primSplitter = Splitter { applySplitter = doPrimSplit+ , canonizeSplit = canonizeFL }++doReversePrimSplit :: PrimPatch prim => prim C(x y) -> Maybe (B.ByteString, B.ByteString -> Maybe (FL prim C(x y)))+doReversePrimSplit prim = do+ (text, parser) <- doPrimSplit (invert prim)+ let parser' p = do+ patch <- parser p+ return . reverseRL $ invertFL patch+ return (text, parser')++reversePrimSplitter :: PrimPatch prim => Splitter prim+reversePrimSplitter = Splitter { applySplitter = doReversePrimSplit+ , canonizeSplit = canonizeFL}
+ src/Darcs/Patch/Summary.hs view
@@ -0,0 +1,134 @@+module Darcs.Patch.Summary+ ( plainSummary, plainSummaryPrim, plainSummaryPrims,+ xmlSummary )+ where++import Darcs.Patch.FileName ( fn2fp )+import Darcs.Patch.Conflict ( Conflict(..), IsConflictedPrim(IsC), ConflictState(..) )+import Darcs.Patch.Effect ( Effect )+import Darcs.Patch.Prim.Class ( PrimDetails(..), PrimPatchBase )+import Darcs.Patch.SummaryData ( SummDetail(..), SummOp(..) )+import Darcs.Witnesses.Ordered ( FL, mapFL )++import Printer ( Doc, empty, vcat,+ text,+ minus, plus, ($$), (<+>), (<>),+ )++#include "gadts.h"++plainSummaryPrim :: PrimDetails prim => prim C(x y) -> Doc+plainSummaryPrim = vcat . map summChunkToLine . genSummary . (:[]) . IsC Okay++plainSummaryPrims :: PrimDetails prim => FL prim C(x y) -> Doc+plainSummaryPrims = vcat . map summChunkToLine . genSummary . mapFL (IsC Okay)++plainSummary :: (Conflict e, Effect e, PrimPatchBase e) => e C(x y) -> Doc+plainSummary = vcat . map summChunkToLine . genSummary . conflictedEffect++xmlSummary :: (Effect p, Conflict p, PrimPatchBase p) => p C(x y) -> Doc+xmlSummary p = text "<summary>"+ $$ (vcat . map summChunkToXML . genSummary . conflictedEffect $ p)+ $$ text "</summary>"++-- Yuck duplicated code below...+escapeXML :: String -> Doc+escapeXML = text . strReplace '\'' "'" . strReplace '"' """ .+ strReplace '>' ">" . strReplace '<' "<" . strReplace '&' "&"++strReplace :: Char -> String -> String -> String+strReplace _ _ [] = []+strReplace x y (z:zs)+ | x == z = y ++ (strReplace x y zs)+ | otherwise = z : (strReplace x y zs)+-- end yuck duplicated code.++-- | High-level representation of a piece of patch summary+data SummChunk = SummChunk SummDetail ConflictState+ deriving (Ord, Eq)++genSummary :: forall p . PrimDetails p => [IsConflictedPrim p] -> [SummChunk]+genSummary p+ = combine $ concatMap s2 p+ where s2 :: IsConflictedPrim p -> [SummChunk]+ s2 (IsC c x) = map (\d -> SummChunk d c) $ summarizePrim x+ combine (x1@(SummChunk d1 c1) : x2@(SummChunk d2 c2) : ss)+ = case combineDetail d1 d2 of+ Nothing -> x1 : combine (x2:ss)+ Just d3 -> combine $ SummChunk d3 (combineConflitStates c1 c2) : ss+ combine (x:ss) = x : combine ss+ combine [] = []+ --+ combineDetail (SummFile o1 f1 r1 a1 x1) (SummFile o2 f2 r2 a2 x2) | f1 == f2 =+ do o3 <- combineOp o1 o2+ return $ SummFile o3 f1 (r1 + r2) (a1 + a2) (x1 + x2)+ combineDetail _ _ = Nothing+ --+ combineConflitStates Conflicted _ = Conflicted+ combineConflitStates _ Conflicted = Conflicted+ combineConflitStates Duplicated _ = Duplicated+ combineConflitStates _ Duplicated = Duplicated+ combineConflitStates Okay Okay = Okay+ -- Don't combine AddFile and RmFile: (maybe an old revision of) darcs+ -- allows a single patch to add and remove the same file, see issue 185+ combineOp SummAdd SummRm = Nothing+ combineOp SummRm SummAdd = Nothing+ combineOp SummAdd _ = Just SummAdd+ combineOp _ SummAdd = Just SummAdd+ combineOp SummRm _ = Just SummRm+ combineOp _ SummRm = Just SummRm+ combineOp SummMod SummMod = Just SummMod++summChunkToXML :: SummChunk -> Doc+summChunkToXML (SummChunk detail c) =+ case detail of+ SummRmDir f -> xconf c "remove_directory" (xfn f)+ SummAddDir f -> xconf c "add_directory" (xfn f)+ SummFile SummRm f _ _ _ -> xconf c "remove_file" (xfn f)+ SummFile SummAdd f _ _ _ -> xconf c "add_file" (xfn f)+ SummFile SummMod f r a x -> xconf c "modify_file" $ xfn f <> xrm r <> xad a <> xrp x+ SummMv f1 f2 -> text "<move from=\"" <> xfn f1+ <> text "\" to=\"" <> xfn f2 <> text"\"/>"+ SummNone -> empty+ where+ xconf Okay t x = text ('<':t++">") $$ x $$ text ("</"++t++">")+ xconf Conflicted t x = text ('<':t++" conflict='true'>") $$ x $$ text ("</"++t++">")+ xconf Duplicated t x = text ('<':t++" duplicate='true'>") $$ x $$ text ("</"++t++">")+ xfn = escapeXML . dropDotSlash .fn2fp+ --+ xad 0 = empty+ xad a = text "<added_lines num='" <> text (show a) <> text "'/>"+ xrm 0 = empty+ xrm a = text "<removed_lines num='" <> text (show a) <> text "'/>"+ xrp 0 = empty+ xrp a = text "<replaced_tokens num='" <> text (show a) <> text "'/>"++summChunkToLine :: SummChunk -> Doc+summChunkToLine (SummChunk detail c) =+ case detail of+ SummRmDir f -> lconf c "R" $ text (fn2fp f) <> text "/"+ SummAddDir f -> lconf c "A" $ text (fn2fp f) <> text "/"+ SummFile SummRm f _ _ _ -> lconf c "R" $ text (fn2fp f)+ SummFile SummAdd f _ _ _ -> lconf c "A" $ text (fn2fp f)+ SummFile SummMod f r a x -> lconf c "M" $ text (fn2fp f) <+> rm r <+> ad a <+> rp x+ SummMv f1 f2 -> text " " <> text (fn2fp f1)+ <> text " -> " <> text (fn2fp f2)+ SummNone -> case c of+ Okay -> empty+ _ -> lconf c "" empty+ where+ lconf Okay t x = text t <+> x+ lconf Conflicted t x = text (t ++ "!") <+> x+ lconf Duplicated t x = text t <+> x <+> text "duplicate"+ --+ ad 0 = empty+ ad a = plus <> text (show a)+ rm 0 = empty+ rm a = minus <> text (show a)+ rp 0 = empty+ rp a = text "r" <> text (show a)++dropDotSlash :: FilePath -> FilePath+dropDotSlash ('.':'/':str) = dropDotSlash str+dropDotSlash str = str+
+ src/Darcs/Patch/SummaryData.hs view
@@ -0,0 +1,13 @@+module Darcs.Patch.SummaryData ( SummDetail(..), SummOp(..) ) where++import Darcs.Patch.FileName ( FileName )++data SummDetail = SummAddDir FileName+ | SummRmDir FileName+ | SummFile SummOp FileName Int Int Int+ | SummMv FileName FileName+ | SummNone+ deriving (Ord, Eq)++data SummOp = SummAdd | SummRm | SummMod deriving (Ord, Eq)+
+ src/Darcs/Patch/TokenReplace.hs view
@@ -0,0 +1,45 @@+module Darcs.Patch.TokenReplace + ( tryTokInternal, forceTokReplace ) + where ++import Darcs.Patch.RegChars ( regChars )++import ByteStringUtils ( substrPS, linesPS, unlinesPS )++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import Data.Maybe ( isNothing )++tryTokInternal :: String -> B.ByteString -> B.ByteString+ -> B.ByteString -> Maybe [B.ByteString]+tryTokInternal _ o n s | isNothing (substrPS o s) &&+ isNothing (substrPS n s) = Just [s]+tryTokInternal t o n s =+ case BC.break (regChars t) s of+ (before,s') ->+ case BC.break (not . regChars t) s' of+ (tok,after) ->+ case tryTokInternal t o n after of+ Nothing -> Nothing+ Just rest ->+ if tok == o+ then Just $ before : n : rest+ else if tok == n+ then Nothing+ else Just $ before : tok : rest++forceTokReplace :: String -> String -> String+ -> B.ByteString -> Maybe B.ByteString+forceTokReplace t os ns c = Just $ unlinesPS $ map forceReplace $ linesPS c+ where o = BC.pack os+ n = BC.pack ns+ tokchar = regChars t+ toks_and_intratoks ps | B.null ps = []+ toks_and_intratoks ps =+ let (before,s') = BC.break tokchar ps+ (tok, after) = BC.break (not . tokchar) s'+ in before : tok : toks_and_intratoks after+ forceReplace ps = B.concat $ map o_t_n $ toks_and_intratoks ps+ o_t_n s | s == o = n+ | otherwise = s+
src/Darcs/Patch/TouchesFiles.hs view
@@ -15,7 +15,6 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} #include "gadts.h"@@ -24,6 +23,7 @@ selectTouching, deselectNotTouching, selectNotTouching, ) where+import Control.Applicative ( (<$>) ) import Data.List ( sort, isSuffixOf ) import Darcs.Patch.Choices ( PatchChoices, Tag, TaggedPatch,@@ -34,9 +34,9 @@ import Darcs.Witnesses.Ordered ( FL(..), (:>)(..), mapFL_FL, (+>+) ) import Darcs.Witnesses.Sealed ( Sealed, seal ) -selectTouching :: Patchy p => [FilePath] -> PatchChoices p C(x y) -> PatchChoices p C(x y)-selectTouching [] pc = pc-selectTouching files pc = forceFirsts xs pc+selectTouching :: Patchy p => Maybe [FilePath] -> PatchChoices p C(x y) -> PatchChoices p C(x y)+selectTouching Nothing pc = pc+selectTouching (Just files) pc = forceFirsts xs pc where ct :: Patchy p => [FilePath] -> FL (TaggedPatch p) C(x y) -> [Tag] ct _ NilFL = [] ct fs (tp:>:tps) = case lookTouch fs (tpPatch tp) of@@ -45,9 +45,9 @@ xs = case getChoices pc of _ :> mc :> lc -> ct (map fix files) (mc +>+ lc) -deselectNotTouching :: Patchy p => [FilePath] -> PatchChoices p C(x y) -> PatchChoices p C(x y)-deselectNotTouching [] pc = pc-deselectNotTouching files pc = forceLasts xs pc+deselectNotTouching :: Patchy p => Maybe [FilePath] -> PatchChoices p C(x y) -> PatchChoices p C(x y)+deselectNotTouching Nothing pc = pc+deselectNotTouching (Just files) pc = forceLasts xs pc where ct :: Patchy p => [FilePath] -> FL (TaggedPatch p) C(x y) -> [Tag] ct _ NilFL = [] ct fs (tp:>:tps) = case lookTouch fs (tpPatch tp) of@@ -56,9 +56,9 @@ xs = case getChoices pc of fc :> mc :> _ -> ct (map fix files) (fc +>+ mc) -selectNotTouching :: Patchy p => [FilePath] -> PatchChoices p C(x y) -> PatchChoices p C(x y)-selectNotTouching [] pc = pc-selectNotTouching files pc = forceFirsts xs pc+selectNotTouching :: Patchy p => Maybe [FilePath] -> PatchChoices p C(x y) -> PatchChoices p C(x y)+selectNotTouching Nothing pc = pc+selectNotTouching (Just files) pc = forceFirsts xs pc where ct :: Patchy p => [FilePath] -> FL (TaggedPatch p) C(x y) -> [Tag] ct _ NilFL = [] ct fs (tp:>:tps) = case lookTouch fs (tpPatch tp) of@@ -73,18 +73,14 @@ fix "." = "." fix f = "./" ++ f -chooseTouching :: Patchy p => [FilePath] -> FL p C(x y) -> Sealed (FL p C(x))-chooseTouching [] p = seal p+chooseTouching :: Patchy p => Maybe [FilePath] -> FL p C(x y) -> Sealed (FL p C(x))+chooseTouching Nothing p = seal p chooseTouching files p = case getChoices $ selectTouching files $ patchChoices p of fc :> _ :> _ -> seal $ mapFL_FL tpPatch fc -choosePreTouching :: (Patchy p) => [FilePath] -> FL p C(x y) -> Sealed (FL p C(x))-choosePreTouching files patch = do- let pre_files = applyToFilepaths (invert patch) files- relevant = case files of- [] -> seal patch- _ -> chooseTouching pre_files patch- in relevant+choosePreTouching :: (Patchy p) => Maybe [FilePath] -> FL p C(x y) -> Sealed (FL p C(x))+choosePreTouching files patch = chooseTouching (applyToFilepaths+ (invert patch) <$> files) patch lookTouch :: Patchy p => [FilePath] -> p C(x y) -> (Bool, [FilePath]) lookTouch fs p = (any (\tf -> any (affects tf) fs) (listTouchedFiles p)
+ src/Darcs/Patch/V1.hs view
@@ -0,0 +1,16 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Darcs.Patch.V1 ( Patch ) where++import Darcs.Patch.Patchy ( Patchy )+import Darcs.Patch.Prim ( PrimPatch )+import Darcs.Patch.RepoPatch ( RepoPatch )++import Darcs.Patch.V1.Apply ()+import Darcs.Patch.V1.Commute ()+import Darcs.Patch.V1.Core ( Patch )+import Darcs.Patch.V1.Read ()+import Darcs.Patch.V1.Show ()+import Darcs.Patch.V1.Viewing ()++instance PrimPatch prim => Patchy (Patch prim)+instance PrimPatch prim => RepoPatch (Patch prim)
+ src/Darcs/Patch/V1/Apply.hs view
@@ -0,0 +1,22 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Darcs.Patch.V1.Apply () where++import Darcs.Patch.Apply ( Apply, apply )+import Darcs.Patch.Prim ( PrimPatch, applyPrimFL )+import Darcs.Patch.Repair ( RepairToFL, applyAndTryToFixFL,+ mapMaybeSnd )+import Darcs.Patch.Effect ( effect )++import Darcs.Patch.V1.Commute ()+import Darcs.Patch.V1.Core ( Patch(..) )++import Darcs.Witnesses.Ordered ( mapFL_FL )++#include "gadts.h"++instance PrimPatch prim => Apply (Patch prim) where+ apply p = applyPrimFL $ effect p++instance PrimPatch prim => RepairToFL (Patch prim) where+ applyAndTryToFixFL (PP x) = mapMaybeSnd (mapFL_FL PP) `fmap` applyAndTryToFixFL x+ applyAndTryToFixFL x = do apply x; return Nothing
+ src/Darcs/Patch/V1/Commute.hs view
@@ -0,0 +1,446 @@+-- Copyright (C) 2002-2003 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.++{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}++#include "gadts.h"++module Darcs.Patch.V1.Commute+ (+ merge,+ merger, unravel,+ publicUnravel,+ )+ where++import Control.Monad ( MonadPlus, mplus, msum, mzero, guard )++import Darcs.Patch.Commute ( toFwdCommute )+import Darcs.Patch.ConflictMarking ( mangleUnravelled )+import Darcs.Patch.FileName ( FileName )+import Darcs.Patch.Invert ( invertRL )+import Darcs.Patch.Merge ( Merge(..) )+import Darcs.Patch.Patchy ( Commute(..), PatchInspect(..), Invert(..) )+import Darcs.Patch.V1.Core ( Patch(..),+ isMerger,+ mergerUndo )+import Darcs.Patch.Conflict ( Conflict(..), CommuteNoConflicts(..) )+import Darcs.Patch.Effect ( Effect(..) )+import Darcs.Patch.FileHunk ( IsHunk(..) )+import Darcs.Patch.Prim ( FromPrim(..), PrimPatch,+ is_filepatch, sortCoalesceFL,+ )+import Darcs.Patch.Permutations ( headPermutationsRL, simpleHeadPermutationsFL,+ commuterIdFL, commuterFLId, selfCommuter )+import Printer ( text, vcat, ($$) )+import Darcs.Patch.V1.Show ( showPatch_ )+import Data.List ( nub, nubBy )+import Darcs.Witnesses.Sealed ( unsafeUnseal, unsafeUnsealFlipped )+import Darcs.Utils ( nubsort )+#include "impossible.h"+import Darcs.Witnesses.Sealed ( Sealed(..), mapSeal, unseal, FlippedSeal(..), mapFlipped )+import Darcs.Witnesses.Eq ( EqCheck(..), MyEq(..) )+import Darcs.Witnesses.Unsafe ( unsafeCoerceP, unsafeCoercePStart+ , unsafeCoercePEnd )+import Darcs.Witnesses.Ordered ( mapFL_FL,+ FL(..), RL(..),+ (:/\:)(..), (:<)(..), (:\/:)(..), (:>)(..),+ lengthFL, mapRL,+ reverseFL, reverseRL, concatFL+ )++--import Darcs.ColorPrinter ( traceDoc )+--import Printer ( greenText )++data Perhaps a = Unknown | Failed | Succeeded a++instance Monad Perhaps where+ (Succeeded x) >>= k = k x+ Failed >>= _ = Failed+ Unknown >>= _ = Unknown+ Failed >> _ = Failed+ (Succeeded _) >> k = k+ Unknown >> k = k+ return = Succeeded+ fail _ = Unknown++instance MonadPlus Perhaps where+ mzero = Unknown+ Unknown `mplus` ys = ys+ Failed `mplus` _ = Failed+ (Succeeded x) `mplus` _ = Succeeded x++toMaybe :: Perhaps a -> Maybe a+toMaybe (Succeeded x) = Just x+toMaybe _ = Nothing++toPerhaps :: Maybe a -> Perhaps a+toPerhaps (Just x) = Succeeded x+toPerhaps Nothing = Failed++cleverCommute :: Invert prim => CommuteFunction prim -> CommuteFunction prim+cleverCommute c (p1:<p2) =+ case c (p1 :< p2) of+ Succeeded x -> Succeeded x+ Failed -> Failed+ Unknown -> case c (invert p2 :< invert p1) of+ Succeeded (p1' :< p2') -> Succeeded (invert p2' :< invert p1')+ Failed -> Failed+ Unknown -> Unknown++speedyCommute :: PrimPatch prim => CommuteFunction prim+speedyCommute (p1 :< p2) -- Deal with common case quickly!+ | p1_modifies /= Nothing && p2_modifies /= Nothing &&+ p1_modifies /= p2_modifies = Succeeded (unsafeCoerceP p2 :< unsafeCoerceP p1)+ | otherwise = Unknown+ where p1_modifies = isFilepatchMerger p1+ p2_modifies = isFilepatchMerger p2++everythingElseCommute :: forall prim . PrimPatch prim => CommuteFunction prim+everythingElseCommute x = eec x+ where+ eec :: CommuteFunction prim+ eec (PP px :< PP py) = toPerhaps $ do x' :> y' <- commute (py :> px)+ return (PP y' :< PP x')+ eec _xx =+ msum [+ cleverCommute commuteRecursiveMerger _xx+ ,cleverCommute otherCommuteRecursiveMerger _xx+ ]++{-+Note that it must be true that++commutex (A^-1 A, P) = Just (P, A'^-1 A')++and++if commutex (A, B) == Just (B', A')+then commutex (B^-1, A^-1) == Just (A'^-1, B'^-1)+-}++unsafeMerger :: PrimPatch prim => String -> Patch prim C(x y) -> Patch prim C(x z) -> Patch prim C(a b)+unsafeMerger x p1 p2 = unsafeCoercePStart $ unsafeUnseal $ merger x p1 p2++mergerCommute :: PrimPatch prim => (Patch prim :< Patch prim) C(x y) -> Perhaps ((Patch prim :< Patch prim) C(x y))+mergerCommute (Merger _ _ p1 p2 :< pA)+ | unsafeCompare pA p1 = Succeeded (unsafeMerger "0.0" p2 p1 :< unsafeCoercePStart p2)+ | unsafeCompare pA (invert (unsafeMerger "0.0" p2 p1)) = Failed+mergerCommute (Merger _ _+ (Merger _ _ c b)+ (Merger _ _ c' a) :<+ Merger _ _ b' c'')+ | unsafeCompare b' b && unsafeCompare c c' && unsafeCompare c c'' =+ Succeeded (unsafeMerger "0.0" (unsafeMerger "0.0" b (unsafeCoercePStart a)) (unsafeMerger "0.0" b c) :<+ unsafeMerger "0.0" b (unsafeCoercePStart a))+mergerCommute _ = Unknown++instance PrimPatch prim => Merge (Patch prim) where+ merge (y :\/: z) =+ case actualMerge (y:\/:z) of+ Sealed y' -> case commute (z :> y') of+ Nothing -> bugDoc $ text "merge_patches bug"+ $$ showPatch_ y+ $$ showPatch_ z+ $$ showPatch_ y'+ Just (_ :> z') -> -- actualMerge returns one arm of a+ -- merge result, so commuting then gives+ -- us the other arm but we have to assert+ -- that the starting context is correct+ unsafeCoercePStart z' :/\: y'++instance PrimPatch prim => Commute (Patch prim) where+ commute x = toMaybe $ msum+ [toFwdCommute speedyCommute x,+ toFwdCommute (cleverCommute mergerCommute) x,+ toFwdCommute everythingElseCommute x+ ]++instance PrimPatch prim => PatchInspect (Patch prim) where+ -- Recurse on everything, these are potentially spoofed patches+ listTouchedFiles (Merger _ _ p1 p2) = nubsort $ listTouchedFiles p1+ ++ listTouchedFiles p2+ listTouchedFiles c@(Regrem _ _ _ _) = listTouchedFiles $ invert c+ listTouchedFiles (PP p) = listTouchedFiles p++ hunkMatches f (Merger _ _ p1 p2) = hunkMatches f p1 || hunkMatches f p2+ hunkMatches f c@(Regrem _ _ _ _) = hunkMatches f $ invert c+ hunkMatches f (PP p) = hunkMatches f p++commuteNoMerger :: PrimPatch prim => MaybeCommute prim+commuteNoMerger x =+ toMaybe $ msum [speedyCommute x,+ everythingElseCommute x]++isFilepatchMerger :: PrimPatch prim => Patch prim C(x y) -> Maybe FileName+isFilepatchMerger (PP p) = is_filepatch p+isFilepatchMerger (Merger _ _ p1 p2) = do+ f1 <- isFilepatchMerger p1+ f2 <- isFilepatchMerger p2+ if f1 == f2 then return f1 else Nothing+isFilepatchMerger (Regrem und unw p1 p2)+ = isFilepatchMerger (Merger und unw p1 p2)++commuteRecursiveMerger :: PrimPatch prim => (Patch prim :< Patch prim) C(x y) -> Perhaps ((Patch prim :< Patch prim) C(x y))+commuteRecursiveMerger (p@(Merger _ _ p1 p2) :< pA) = toPerhaps $+ do (_ :> pA') <- commuterIdFL selfCommuter (pA :> undo)+ _ <- commuterIdFL selfCommuter (pA' :> invert undo)+ (_ :> pAmid) <- commute (pA :> unsafeCoercePStart (invert p1))+ (p1' :> pAx) <- commute (pAmid :> p1)+ guard (pAx `unsafeCompare` pA)+ (p2' :> _) <- commute (pAmid :> p2)+ (p2o :> _) <- commute (invert pAmid :> p2')+ guard (p2o `unsafeCompare` p2)+ let p' = if unsafeCompare p1' p1 && unsafeCompare p2' p2+ then unsafeCoerceP p+ else unsafeMerger "0.0" p1' p2'+ undo' = mergerUndo p'+ (pAo :> _) <- commuterFLId selfCommuter (undo' :> pA')+ guard (pAo `unsafeCompare` pA)+ return (pA' :< p')+ where undo = mergerUndo p+commuteRecursiveMerger _ = Unknown++otherCommuteRecursiveMerger :: PrimPatch prim => (Patch prim :< Patch prim) C(x y) -> Perhaps ((Patch prim :< Patch prim) C(x y))+otherCommuteRecursiveMerger (pA':< p_old@(Merger _ _ p1' p2')) =+ toPerhaps $+ do (pA :> _) <- commuterFLId selfCommuter (mergerUndo p_old :> pA')+ (pAmid :> p1) <- commute (unsafeCoercePEnd p1' :> pA)+ (_ :> pAmido) <- commute (pA :> invert p1)+ guard (pAmido `unsafeCompare` pAmid)+ (p2 :> _) <- commute (invert pAmid :> p2')+ (p2o' :> _) <- commute (pAmid :> p2)+ guard (p2o' `unsafeCompare` p2')+ let p = if p1 `unsafeCompare` p1' && p2 `unsafeCompare` p2'+ then unsafeCoerceP p_old+ else unsafeMerger "0.0" p1 p2+ undo = mergerUndo p+ guard (not $ pA `unsafeCompare` p1) -- special case here...+ (_ :> pAo') <- commuterIdFL selfCommuter (pA :> undo)+ guard (pAo' `unsafeCompare` pA')+ return (p :< pA)+otherCommuteRecursiveMerger _ = Unknown++type CommuteFunction prim = FORALL(x y) (Patch prim :< Patch prim) C(x y) -> Perhaps ((Patch prim :< Patch prim) C(x y))+type MaybeCommute prim = FORALL(x y) (Patch prim :< Patch prim) C(x y) -> Maybe ((Patch prim :< Patch prim) C(x y))++revCommuteFLId :: MaybeCommute prim -> (FL (Patch prim) :< Patch prim) C(x y) -> Maybe ((Patch prim :< FL (Patch prim)) C(x y))+revCommuteFLId _ (NilFL :< p) = return (p :< NilFL)+revCommuteFLId commuter ((q :>: qs) :< p) = do+ p' :< q' <- commuter (q :< p)+ p'' :< qs' <- revCommuteFLId commuter (qs :< p')+ return (p'' :< (q' :>: qs'))++elegantMerge :: PrimPatch prim+ => (Patch prim :\/: Patch prim) C(x y)+ -> Maybe ((Patch prim :/\: Patch prim) C(x y))+elegantMerge (p1 :\/: p2) = do+ p1' :> ip2' <- commute (invert p2 :> p1)+ p1o :> _ <- commute (p2 :> p1')+ guard $ unsafeCompare p1o p1 -- should be a redundant check+ return $ invert ip2' :/\: p1'++{-+A note about mergers and type witnesses+---------------------------------------++The merger code predates the introduction of type witnesses, and because+of its complexity has proved the hardest part of the codebase to retrofit.+Attempting to do this has exposed various places where the code behaves+oddly (e.g. 'putBefore' below); these are likely to be bugs but fixing+them would be potentially disruptive and dangerous as it might change+the existing merge behaviour and thus break existing repositories.++As a result the addition of witnesses to this code has required the+liberal use of unsafe operators. In effect, witnesses bring no safety+in this area; the sole purpose of adding them here was to allow this+code to run as part of a codebase that uses witnesses everywhere else.++A key problem point is the type of the 'Merger' and 'Regrem' constructors+of Patch, where the witnesses seem odd. It is likely that some or many+of the unsafe operations could be removed by finding a better type for+these constructors.+-}+++actualMerge :: PrimPatch prim => (Patch prim :\/: Patch prim) C(x y) -> Sealed (Patch prim C(y))++actualMerge (p1 :\/: p2) = case elegantMerge (p1:\/:p2) of+ Just (_ :/\: p1') -> Sealed p1'+ Nothing -> merger "0.0" p2 p1++unwind :: Patch prim C(x y) -> Sealed (RL (Patch prim) C(x)) -- Recreates a patch history in reverse.+unwind (Merger _ unwindings _ _) = Sealed unwindings+unwind p = Sealed (p :<: NilRL)++trueUnwind :: PrimPatch prim => Patch prim C(x y) -> Sealed (RL (Patch prim) C(x)) -- Recreates a patch history in reverse.+trueUnwind p@(Merger _ _ p1 p2) =+ case (unwind p1, unwind p2) of+ (Sealed (_:<:p1s),Sealed (_:<:p2s)) ->+ Sealed (p :<: unsafeCoerceP p1 :<: unsafeUnsealFlipped (reconcileUnwindings p p1s (unsafeCoercePEnd p2s)))+ _ -> impossible+trueUnwind _ = impossible++reconcileUnwindings :: PrimPatch prim+ => Patch prim C(a b) -> RL (Patch prim) C(x z) -> RL (Patch prim) C(y z) -> FlippedSeal (RL (Patch prim)) C(z)+reconcileUnwindings _ NilRL p2s = FlippedSeal p2s+reconcileUnwindings _ p1s NilRL = FlippedSeal p1s+reconcileUnwindings p (p1:<:p1s) p2s@(p2:<:tp2s) =+ case [(p1s', p2s')|+ p1s'@(hp1s':<:_) <- headPermutationsRL (p1:<:p1s),+ p2s'@(hp2s':<:_) <- headPermutationsRL p2s,+ hp1s' `unsafeCompare` hp2s'] of+ ((p1':<:p1s', _:<:p2s'):_) ->+ mapFlipped (p1' :<:) $ reconcileUnwindings p p1s' (unsafeCoercePEnd p2s')+ [] -> case reverseFL `fmap` putBefore p1 (reverseRL p2s) of+ Just p2s' -> mapFlipped (p1 :<:) $ reconcileUnwindings p p1s p2s'+ Nothing ->+ case fmap reverseFL $ putBefore p2 $+ reverseRL (p1:<:p1s) of+ Just p1s' -> mapFlipped (p2 :<:) $+ reconcileUnwindings p p1s' tp2s+ Nothing ->+ bugDoc $ text "in function reconcileUnwindings"+ $$ text "Original patch:"+ $$ showPatch_ p+ _ -> bug "in reconcileUnwindings"++-- This code seems wrong, shouldn't the commute be invert p1 :> p2 ? And why isn't p1' re-inverted?+-- it seems to have been this way forever:+-- Fri May 23 10:27:04 BST 2003 droundy@abridgegame.org+-- * fix bug in unwind and add docs on unwind algorithm.+putBefore :: PrimPatch prim => Patch prim C(y z) -> FL (Patch prim) C(x z) -> Maybe (FL (Patch prim) C(y w))+putBefore p1 (p2:>:p2s) =+ do p1' :> p2' <- commute (unsafeCoerceP p2 :> invert p1)+ _ <- commute (p2' :> p1)+ (unsafeCoerceP p2' :>:) `fmap` putBefore p1' (unsafeCoerceP p2s)+putBefore _ NilFL = Just (unsafeCoerceP NilFL)++instance PrimPatch prim => CommuteNoConflicts (Patch prim) where+ commuteNoConflicts (x:>y) = do x' :< y' <- commuteNoMerger (y :< x)+ return (y':>x')++instance PrimPatch prim => Conflict (Patch prim) where+ resolveConflicts patch = rcs NilFL (patch :<: NilRL)+ where rcs :: FL (Patch prim) C(y w) -> RL (Patch prim) C(x y) -> [[Sealed (FL prim C(w))]]+ rcs _ NilRL = []+ rcs passedby (p@(Merger _ _ _ _):<:ps) =+ case revCommuteFLId commuteNoMerger (passedby:<p) of+ Just (p'@(Merger _ _ p1 p2):<_) ->+ (map Sealed $ nubBy unsafeCompare $+ effect (unsafeCoercePStart $ unsafeUnseal (glump09 p1 p2)) : map (unsafeCoercePStart . unsafeUnseal) (unravel p'))+ : rcs (p :>: passedby) ps+ Nothing -> rcs (p :>: passedby) ps+ _ -> impossible+ rcs passedby (p:<:ps) = seq passedby $+ rcs (p :>: passedby) ps++-- This type seems wrong - the most natural type for the result would seem to be+-- [Sealed (FL Prim C(x))], given the type of unwind.+-- However downstream code in darcs convert assumes the C(y) type, and I was unable+-- to figure out whether this could/should reasonably be changed -- Ganesh 13/4/10+publicUnravel :: PrimPatch prim => Patch prim C(x y) -> [Sealed (FL prim C(y))]+publicUnravel = map (mapSeal unsafeCoercePStart) . unravel++unravel :: PrimPatch prim => Patch prim C(x y) -> [Sealed (FL prim C(x))]+unravel p = nub $ map (mapSeal (sortCoalesceFL . concatFL . mapFL_FL effect)) $+ getSupers $ map (mapSeal reverseRL) $ unseal (newUr p) $ unwind p++getSupers :: PrimPatch prim => [Sealed (FL (Patch prim) C(x))] -> [Sealed (FL (Patch prim) C(x))]+getSupers (x:xs) =+ case filter (not.(x `isSuperpatchOf`)) xs of+ xs' -> if or $ map (`isSuperpatchOf` x) xs'+ then getSupers xs'+ else x : getSupers xs'+getSupers [] = []++isSuperpatchOf :: PrimPatch prim => Sealed (FL (Patch prim) C(x)) -> Sealed (FL (Patch prim) C(x)) -> Bool+Sealed x `isSuperpatchOf` Sealed y | lengthFL y > lengthFL x = False -- should be just an optimisation+Sealed x `isSuperpatchOf` Sealed y = x `iso` y+ where iso :: PrimPatch prim => FL (Patch prim) C(x y) -> FL (Patch prim) C(x z) -> Bool+ _ `iso` NilFL = True+ NilFL `iso` _ = False+ a `iso` (b:>:bs) =+ head $ ([as `iso` bs | (ah :>: as) <- simpleHeadPermutationsFL a, IsEq <- [ah =\/= b]] :: [Bool]) ++ [False]++merger :: PrimPatch prim => String -> Patch prim C(x y) -> Patch prim C(x z) -> Sealed (Patch prim C(y))+merger "0.0" p1 p2 = Sealed $ Merger undoit unwindings p1 p2+ where fake_p = Merger NilFL NilRL p1 p2+ unwindings = unsafeUnseal (trueUnwind fake_p)+ p = Merger NilFL unwindings p1 p2+ undoit =+ case (isMerger p1, isMerger p2) of+ (True ,True ) -> case unwind p of+ Sealed (_:<:t) -> unsafeCoerceP $ invertRL t+ _ -> impossible+ (False,False) -> unsafeCoerceP $ invert p1 :>: NilFL+ (True ,False) -> unsafeCoerceP $ NilFL+ (False,True ) -> unsafeCoerceP $ invert p1 :>: mergerUndo p2+merger g _ _ =+ error $ "Cannot handle mergers other than version 0.0\n"++g+ ++ "\nPlease use darcs optimize --modernize with an older darcs."++glump09 :: PrimPatch prim => Patch prim C(x y) -> Patch prim C(x z) -> Sealed (FL (Patch prim) C(y))+glump09 p1 p2 = mapSeal (mapFL_FL fromPrim) $ mangleUnravelled $ unseal unravel $ merger "0.0" p1 p2++instance PrimPatch prim => Effect (Patch prim) where+ effect p@(Merger _ _ _ _) = sortCoalesceFL $ effect $ mergerUndo p+ effect p@(Regrem _ _ _ _) = invert $ effect $ invert p+ effect (PP p) = p :>: NilFL++instance IsHunk prim => IsHunk (Patch prim) where+ isHunk p = do PP p' <- return p+ isHunk p'++newUr :: PrimPatch prim => Patch prim C(a b) -> RL (Patch prim) C(x y) -> [Sealed (RL (Patch prim) C(x))]+newUr p (Merger _ _ p1 p2 :<: ps) =+ case filter (\(pp:<:_) -> pp `unsafeCompare` p1) $ headPermutationsRL ps of+ ((_:<:ps'):_) -> newUr p (unsafeCoercePStart p1:<:ps') ++ newUr p (unsafeCoercePStart p2:<:ps')+ _ -> bugDoc $ text "in function newUr"+ $$ text "Original patch:"+ $$ showPatch_ p+ $$ text "Unwound:"+ $$ vcat (unseal (mapRL showPatch_) $ unwind p)++newUr op ps =+ case filter (\(p:<:_) -> isMerger p) $ headPermutationsRL ps of+ [] -> [Sealed ps]+ (ps':_) -> newUr op ps'++instance Invert prim => Invert (Patch prim) where+ invert (Merger undo unwindings p1 p2)+ = Regrem undo unwindings p1 p2+ invert (Regrem undo unwindings p1 p2)+ = Merger undo unwindings p1 p2+ invert (PP p) = PP (invert p)++instance MyEq prim => MyEq (Patch prim) where+ unsafeCompare = eqPatches++instance MyEq prim => Eq (Patch prim C(x y)) where+ (==) = unsafeCompare++eqPatches :: MyEq prim => Patch prim C(x y) -> Patch prim C(w z) -> Bool+eqPatches (PP p1) (PP p2) = unsafeCompare p1 p2+eqPatches (Merger _ _ p1a p1b) (Merger _ _ p2a p2b)+ = eqPatches p1a p2a &&+ eqPatches p1b p2b+eqPatches (Regrem _ _ p1a p1b) (Regrem _ _ p2a p2b)+ = eqPatches p1a p2a &&+ eqPatches p1b p2b+eqPatches _ _ = False
+ src/Darcs/Patch/V1/Core.hs view
@@ -0,0 +1,51 @@+module Darcs.Patch.V1.Core+ ( Patch(..),+ isMerger, mergerUndo+ ) where++import Darcs.Patch.Format ( PatchListFormat(..), ListFormat(ListFormatV1) )+import Darcs.Patch.Prim ( FromPrim(..), PrimOf, PrimPatchBase, PrimPatch )+import Darcs.Patch.Repair ( Check )++import Darcs.Witnesses.Ordered ( FL(..), RL )++#include "gadts.h"+#include "impossible.h"++data Patch prim C(x y) where+ PP :: prim C(x y) -> Patch prim C(x y)+ Merger :: FL (Patch prim) C(x y)+ -> RL (Patch prim) C(x b)+ -> Patch prim C(c b)+ -> Patch prim C(c d)+ -> Patch prim C(x y)+ Regrem :: FL (Patch prim) C(x y)+ -> RL (Patch prim) C(x b)+ -> Patch prim C(c b)+ -> Patch prim C(c a)+ -> Patch prim C(y x)++instance PrimPatch prim => PrimPatchBase (Patch prim) where+ type PrimOf (Patch prim) = prim++instance FromPrim (Patch prim) where+ fromPrim = PP++isMerger :: Patch prim C(a b) -> Bool+isMerger (Merger _ _ _ _) = True+isMerger (Regrem _ _ _ _) = True+isMerger _ = False++mergerUndo :: Patch prim C(x y) -> FL (Patch prim) C(x y)+mergerUndo (Merger undo _ _ _) = undo+mergerUndo _ = impossible++instance PatchListFormat (Patch prim) where+ -- In principle we could use ListFormatDefault when prim /= V1 Prim patches,+ -- as those are the only case where we need to support a legacy on-disk+ -- format. In practice we don't expect Patch to be used with any other argument+ -- anyway, so it doesn't matter.+ patchListFormat = ListFormatV1++instance Check (Patch prim)+ -- no checks
+ src/Darcs/Patch/V1/Read.hs view
@@ -0,0 +1,46 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Darcs.Patch.V1.Read () where++import Darcs.Patch.Invert ( invert )+import Darcs.Patch.Prim ( PrimPatch )+import Darcs.Patch.Read ( ReadPatch(..) )+import Darcs.Patch.ReadMonads ( ParserM, choice, string,+ lexChar, myLex', skipSpace )++import Darcs.Patch.V1.Core ( Patch(..) )+import Darcs.Patch.V1.Commute ( merger )++import Darcs.Witnesses.Sealed ( Sealed(..), seal, mapSeal )+import Darcs.Witnesses.Unsafe ( unsafeCoerceP )++import Control.Monad ( liftM )+import qualified Data.ByteString.Char8 as BC ( unpack, pack )+import qualified Data.ByteString as B (ByteString )++#include "gadts.h"++instance PrimPatch prim => ReadPatch (Patch prim) where+ readPatch'+ = choice [ liftM seal $ skipSpace >> readMerger True+ , liftM seal $ skipSpace >> readMerger False+ , liftM (mapSeal PP) $ readPatch'+ ]+readMerger :: (ParserM m, PrimPatch prim) => Bool -> m (Patch prim C(x y))+readMerger b = do string s+ g <- myLex'+ lexChar '('+ Sealed p1 <- readPatch'+ Sealed p2 <- readPatch'+ lexChar ')'+ Sealed m <- return $ merger (BC.unpack g) p1 p2+ return $ if b then unsafeCoerceP m else unsafeCoerceP (invert m)+ where+ s | b = merger'+ | otherwise = regrem++merger' :: B.ByteString+merger' = BC.pack "merger"++regrem :: B.ByteString+regrem = BC.pack "regrem"+
+ src/Darcs/Patch/V1/Show.hs view
@@ -0,0 +1,34 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Darcs.Patch.V1.Show ( showPatch_ ) where++import Darcs.Patch.Format ( FileNameFormat(..) )+import Darcs.Patch.Prim ( showPrim, PrimPatch )++import Darcs.Patch.V1.Core ( Patch(..) )++import Darcs.Witnesses.Show ( Show1(..), Show2(..), ShowDict(..) )++import Printer ( Doc, renderString,+ text, blueText,+ ($$), (<+>) )++#include "gadts.h"++instance PrimPatch prim => Show (Patch prim C(x y)) where+ show p = renderString (showPatch_ p) ++ "\n"+instance PrimPatch prim => Show1 (Patch prim C(x)) where+ showDict1 = ShowDictClass+instance PrimPatch prim => Show2 (Patch prim) where+ showDict2 = ShowDictClass++showPatch_ :: PrimPatch prim => Patch prim C(a b) -> Doc+showPatch_ (PP p) = showPrim OldFormat p+showPatch_ (Merger _ _ p1 p2) = showMerger "merger" p1 p2+showPatch_ (Regrem _ _ p1 p2) = showMerger "regrem" p1 p2++showMerger :: PrimPatch prim => String -> Patch prim C(a b) -> Patch prim C(d e) -> Doc+showMerger merger_name p1 p2 =+ blueText merger_name <+> text "0.0" <+> blueText "("+ $$ showPatch_ p1+ $$ showPatch_ p2+ $$ blueText ")"
+ src/Darcs/Patch/V1/Viewing.hs view
@@ -0,0 +1,26 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE ViewPatterns #-}+module Darcs.Patch.V1.Viewing () where++import Darcs.Patch.FileHunk ( isHunk )+import Darcs.Patch.Prim ( PrimPatch )+import Darcs.Patch.Show ( ShowPatchBasic(..), ShowPatch(..) )+import Darcs.Patch.Summary ( plainSummary )+import Darcs.Patch.Viewing ( showContextHunk )++import Darcs.Patch.V1.Apply ()+import Darcs.Patch.V1.Core ( Patch(..) )+import Darcs.Patch.V1.Show ( showPatch_ )++#include "gadts.h"++instance PrimPatch prim => ShowPatchBasic (Patch prim) where+ showPatch = showPatch_++instance PrimPatch prim => ShowPatch (Patch prim) where+ showContextPatch (PP (isHunk -> Just fh)) = showContextHunk fh+ showContextPatch p = return $ showPatch p+ summary = plainSummary+ summaryFL = plainSummary+ thing _ = "change"+
+ src/Darcs/Patch/V2.hs view
@@ -0,0 +1,9 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Darcs.Patch.V2 ( RealPatch, prim2real ) where++import Darcs.Patch.Prim ( PrimPatch )+import Darcs.Patch.RepoPatch ( RepoPatch )++import Darcs.Patch.V2.Real ( RealPatch, prim2real )++instance PrimPatch prim => RepoPatch (RealPatch prim)
+ src/Darcs/Patch/V2/Non.hs view
@@ -0,0 +1,227 @@+-- Copyright (C) 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.++{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP, FlexibleContexts, UndecidableInstances #-}++#include "gadts.h"++-- |'NonPatch' and 'Non' patches are patches that store a context as a+-- sequence of patches. See "Darcs.Patch.Real" for example usage.+module Darcs.Patch.V2.Non+ ( Non(..), Nonable(..), unNon,+ showNon, readNon, showNons, readNons,+ add, addP, remP, addPs, remPs, remNons,+ (*>), (>*), (*>>), (>>*),+ propAdjustTwice ) where++import Prelude hiding ( rem )+import Data.List ( delete )+import Control.Monad ( liftM, mzero )+import Darcs.Patch.Commute ( commuteFLorComplain )+import Darcs.Patch.Effect ( Effect(..) )+import Darcs.Patch.Format ( PatchListFormat, FileNameFormat(..) )+import Darcs.Patch.Invert ( Invert, invertFL, invertRL )+import Darcs.Patch.Prim ( FromPrim(..), ToFromPrim(..),+ PrimOf, PrimPatchBase,+ showPrim, sortCoalesceFL,+ readPrim )+import Darcs.Patch.Patchy ( Patchy, showPatch, ReadPatch(..),+ Commute(..), invert )+import Darcs.Patch.ReadMonads ( ParserM, lexChar )+import Darcs.Witnesses.Eq ( MyEq(..), EqCheck(..) )+import Darcs.Witnesses.Ordered ( FL(..), RL(..), (+>+), mapRL_RL+ , (:>)(..), reverseFL, reverseRL )+import Darcs.Patch.Read ( peekfor )+import Darcs.Patch.Show ( ShowPatchBasic )+import Darcs.Patch.Viewing ()+import Darcs.Patch.Permutations ( removeFL, commuteWhatWeCanFL )+import Darcs.Witnesses.Show ( ShowDict(..), Show1(..), Show2(..), appPrec+ , showsPrec2 )+import Darcs.Witnesses.Sealed ( Sealed(Sealed) )+import Printer ( Doc, empty, vcat, hiddenPrefix, blueText, redText, ($$) )+import qualified Data.ByteString.Char8 as BC ( pack, singleton, ByteString )++--import Darcs.ColorPrinter ( traceDoc )+--import Printer ( greenText )++showNons :: (ShowPatchBasic p, PatchListFormat p, PrimPatchBase p) => [Non p C(x)] -> Doc+showNons [] = empty+showNons xs = blueText "{{" $$ vcat (map showNon xs) $$ blueText "}}"++oBracket :: BC.ByteString+oBracket = BC.pack "{{"++cBracket :: BC.ByteString+cBracket = BC.pack "}}"++showNon :: (ShowPatchBasic p, PatchListFormat p, PrimPatchBase p) => Non p C(x) -> Doc+showNon (Non c p) = hiddenPrefix "|" (showPatch c)+ $$ hiddenPrefix "|" (blueText ":")+ $$ showPrim NewFormat p++readNons :: (ReadPatch p, PatchListFormat p, PrimPatchBase p, ParserM m) => m [Non p C(x)]+readNons = peekfor oBracket rns (return [])+ where rns = peekfor cBracket (return []) $+ do Sealed ps <- readPatch'+ lexChar ':'+ Sealed p <- readPrim NewFormat+ (Non ps p :) `liftM` rns++readNon :: (ReadPatch p, PatchListFormat p, PrimPatchBase p, ParserM m) => m (Non p C(x))+readNon = do Sealed ps <- readPatch'+ peekfor colon (do Sealed p <- readPrim NewFormat+ return $ Non ps p)+ mzero++colon :: BC.ByteString+colon = BC.singleton ':'++instance (Commute p, MyEq p, MyEq (PrimOf p)) => Eq (Non p C(x)) where+ Non (cx :: FL p C(x y1)) (x :: PrimOf p C(y1 z1))+ == Non (cy :: FL p C(x y2)) (y :: PrimOf p C(y2 z2)) =+ case cx =\/= cy of+ IsEq -> case x =\/= y :: EqCheck C(z1 z2) of+ IsEq -> True+ NotEq -> False+ NotEq -> False++-- | 'Non' stores a context with a 'Prim' patch.+data Non p C(x) where+ Non :: FL p C(a x) -> PrimOf p C(x y) -> Non p C(a)++-- | Return as a list the context followed by the primitive patch.+unNon :: FromPrim p => Non p C(x) -> Sealed (FL p C(x))+unNon (Non c x) = Sealed (c +>+ fromPrim x :>: NilFL)++class Nonable p where+ non :: p C(x y) -> Non p C(x)++-- | 'addP' @x cy@ tries to commute @x@ past @cy@ and always returns some+-- variant @cy'@. -- commutation suceeds, the variant is just+-- straightforwardly the commuted versian. If commutation fails, the variant+-- consists of @x@ prepended to the context of @cy@.+addP :: (Patchy p, ToFromPrim p) => p C(x y) -> Non p C(y) -> Non p C(x)+addP p n | Just n' <- p >* n = n'+addP p (Non c x) = Non (p:>:c) x++-- | 'addPs' @xs cy@ commutes as many patches of @xs@ past @cy@ as+-- possible, stopping at the first patch that fails to commute.+-- Note the fact @xs@ is a 'RL'+--+-- Suppose we have+--+-- > x1 x2 x3 [c1 c2 y]+--+-- and that in our example @c1@ fails to commute past @x1@, this+-- function would commute down to+--+-- > x1 [c1'' c2'' y''] x2' x3'+--+-- and return @[x1 c1'' c2'' y'']@+addPs :: (Patchy p, ToFromPrim p) => RL p C(x y) -> Non p C(y) -> Non p C(x)+addPs NilRL n = n+addPs (p:<:ps) n = addPs ps $ addP p n++add :: (WL l, Patchy p, ToFromPrim p) => l (PrimOf p) C(x y) -> Non p C(y) -> Non p C(x)+add q = addPs (mapRL_RL fromPrim $ toRL q)++-- remNons really only works right if the relevant nons are conflicting...+remNons :: (Nonable p, Effect p, Patchy p, ToFromPrim p, PrimPatchBase p, MyEq (PrimOf p)) => [Non p C(x)] -> Non p C(x) -> Non p C(x)+remNons ns (Non c x) = case remNonHelper ns c of+ NilFL :> c' -> Non c' x+ _ -> Non c x++-- |abstract over 'FL'/'RL'+class WL l where+ toFL :: l p C(x y) -> FL p C(x y)+ toRL :: l p C(x y) -> RL p C(x y)+ invertWL :: Invert p => l p C(x y) -> l p C(y x)++instance WL FL where+ toFL = id+ toRL = reverseFL+ invertWL = reverseRL . invertFL++instance WL RL where+ toFL = reverseRL+ toRL = id+ invertWL = reverseFL . invertRL++remNonHelper :: (Nonable p, Effect p, Patchy p, ToFromPrim p, PrimPatchBase p, MyEq (PrimOf p)) => [Non p C(x)] -> FL p C(x y)+ -> (FL (PrimOf p) :> FL p) C(x y)+remNonHelper [] x = NilFL :> x+remNonHelper ns (c:>:cs)+ | non c `elem` ns = case remNonHelper (map (addP $ invert c) $ delete (non c) ns) cs of+ a :> z -> sortCoalesceFL (effect c+>+a) :> z+ | otherwise = case commuteWhatWeCanFL (c :> cs) of+ b :> c' :> d ->+ case remNonHelper ns b of+ a :> b' -> a :> (b'+>+c':>:d)+remNonHelper _ NilFL = NilFL :> NilFL++remP :: (Patchy p, ToFromPrim p) => p C(x y) -> Non p C(x) -> Maybe (Non p C(y))+remP p n | Just n' <- n *> p = Just n'+remP p (Non pc x) = do c <- removeFL p pc+ return (Non c x)++remPs :: (Patchy p, ToFromPrim p) => FL p C(x y) -> Non p C(x) -> Maybe (Non p C(y))+remPs NilFL n = Just n+remPs (p:>:ps) n = remP p n >>= remPs ps++(*>) :: (Patchy p, ToFromPrim p) => Non p C(x) -> p C(x y) -> Maybe (Non p C(y))+n *> p = invert p >* n++(>*) :: (Patchy p, ToFromPrim p) => p C(x y) -> Non p C(y) -> Maybe (Non p C(x))+y >* (Non c x) = case commuteFLorComplain (y :> c) of+ Right (c' :> y') -> do+ px' :> _ <- commute (y' :> fromPrim x)+ x' <- toPrim px'+ return (Non c' x')+ _ -> Nothing++(*>>) :: (WL l, Patchy p, ToFromPrim p, PrimPatchBase p) => Non p C(x) -> l (PrimOf p) C(x y) -> Maybe (Non p C(y))+n *>> p = invertWL p >>* n++(>>*) :: (WL l, Patchy p, ToFromPrim p) => l (PrimOf p) C(x y) -> Non p C(y) -> Maybe (Non p C(x))+q >>* nn = adj (toRL q) nn+ where adj :: (Patchy p, ToFromPrim p) => RL (PrimOf p) C(x y) -> Non p C(y) -> Maybe (Non p C(x))+ adj NilRL n = Just n+ adj (x:<:xs) n = fromPrim x >* n >>= adj xs++-- TODO why don't any tests run this?+propAdjustTwice :: (Patchy p, ToFromPrim p, MyEq (PrimOf p)) => p C(x y) -> Non p C(y) -> Maybe Doc+propAdjustTwice p n =+ do n' <- p >* n+ case n' *> p of+ Nothing -> Just (redText "prop_adjust_inverse 1")+ Just n'' | n'' /= n -> Just (redText "prop_adjust_inverse 2")+ _ -> case n *> invert p of+ Nothing -> Just (redText "prop_adjust_inverse 3")+ Just n'' | n'' /= n' -> Just (redText "prop_adjust_inverse 4")+ _ -> case invert p >* n' of+ Nothing -> Just (redText "prop_adjust_inverse 5")+ Just n'' | n'' /= n -> Just (redText "prop_adjust_inverse 6")+ _ -> Nothing++instance (Show2 p, Show2 (PrimOf p)) => Show (Non p C(x)) where+ showsPrec d (Non cs p) = showParen (d > appPrec) $ showString "Non " .+ showsPrec2 (appPrec + 1) cs . showString " " .+ showsPrec2 (appPrec + 1) p++instance (Show2 p, Show2 (PrimOf p)) => Show1 (Non p) where+ showDict1 = ShowDictClass
+ src/Darcs/Patch/V2/Real.hs view
@@ -0,0 +1,820 @@+-- Copyright (C) 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.++{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}++#include "gadts.h"++-- | Conflictor patches+module Darcs.Patch.V2.Real+ ( RealPatch(..), prim2real, isConsistent, isForward, isDuplicate,+ mergeUnravelled ) where++import Control.Monad ( mplus, liftM )+import Data.List ( partition, nub )+import Darcs.Patch.Commute ( commuteFLorComplain, commuteRL, commuteRLFL )+import Darcs.Patch.Conflict ( Conflict(..), CommuteNoConflicts(..), IsConflictedPrim(..), ConflictState(..) )+import Darcs.Patch.ConflictMarking ( mangleUnravelled )+import Darcs.Patch.Effect ( Effect(..) )+import Darcs.Patch.FileHunk ( IsHunk(..) )+import Darcs.Patch.Format ( PatchListFormat(..), ListFormat(..), FileNameFormat(NewFormat) )+import Darcs.Patch.Invert ( invertFL, invertRL )+import Darcs.Patch.Merge ( Merge(..) )+import Darcs.Patch.Prim ( FromPrim(..), ToFromPrim(..),+ showPrim, showPrimFL,+ readPrim,+ PrimOf, PrimPatchBase, PrimPatch+ )+import Darcs.Patch.Read ( bracketedFL )+import Darcs.Patch.Repair ( mapMaybeSnd, RepairToFL(..), Check(..) )+import Darcs.Patch.Patchy ( Patchy, Apply(..), Commute(..)+ , PatchInspect(..)+ , ReadPatch(..), ShowPatch(..)+ , Invert(..) )+import Darcs.Patch.Show ( ShowPatchBasic(..) )+import Darcs.Patch.Summary ( plainSummary )+import Darcs.Witnesses.Ordered ( FL(..), RL(..), (:>)(..), (+>+)+ , (+<+), mapFL_FL, reverseFL, (:\/:)(..)+ , (:/\:)(..), reverseRL, lengthFL+ , lengthRL )+import Darcs.Patch.V2.Non ( Non(..), Nonable(..), unNon,+ showNons, showNon, readNons, readNon,+ add, addP, addPs, remP, remPs, remNons,+ (*>), (>*), (*>>), (>>*) )+import Darcs.Patch.Permutations ( commuteWhatWeCanFL, commuteWhatWeCanRL,+ genCommuteWhatWeCanRL,+ removeRL, removeFL, removeSubsequenceFL )+import Darcs.Patch.RepoPatch ()+import qualified Data.ByteString.Char8 as BC ( ByteString, pack )+import Darcs.Patch.ReadMonads ( skipSpace, string, choice )+import Darcs.Utils ( nubsort )+import Darcs.Witnesses.Unsafe ( unsafeCoerceP )+import Darcs.Witnesses.Eq ( MyEq(..), EqCheck(..) )+import Darcs.Witnesses.Sealed ( FlippedSeal(..), Sealed(Sealed), mapSeal )+import Darcs.Witnesses.Show ( Show2(..), ShowDict(..) )+import Printer ( Doc, renderString, blueText, redText, (<+>), ($$) )+import Darcs.ColorPrinter ( errorDoc, assertDoc )+--import Printer ( greenText )+--import Darcs.ColorPrinter ( traceDoc )+#include "impossible.h"++-- |+-- @Duplicate x@: This patch has no effect since @x@ is already present in the repository+--+-- @Etacilpud x: invert (Duplicate x)@+--+-- @Normal prim@: A primitive patch+--+-- @Conflictor ix xx x@:+-- @ix@ is the set of patches:+--+-- * that conflict with @x@ and also conflict with another patch in the repository+--+-- * that conflict with a patch that conflict with @x@+--+-- @xx@ is the sequence of patches that conflict *only* with @x@+--+-- @x@ is the current patch+--+-- @ix@ and @x@ are stored as @Non@ objects, which include any necessary+-- context to uniquely define the patch that is referred to.+--+-- @InvConflictor ix xx x@: like @invert (Conflictor ix xx x)@+data RealPatch prim C(x y) where+ Duplicate :: Non (RealPatch prim) C(x) -> RealPatch prim C(x x)+ Etacilpud :: Non (RealPatch prim) C(x) -> RealPatch prim C(x x)+ Normal :: prim C(x y) -> RealPatch prim C(x y)+ Conflictor :: [Non (RealPatch prim) C(x)] -> FL prim C(x y) -> Non (RealPatch prim) C(x) -> RealPatch prim C(y x)+ InvConflictor :: [Non (RealPatch prim) C(x)] -> FL prim C(x y) -> Non (RealPatch prim) C(x) -> RealPatch prim C(x y)++instance PrimPatch prim => PrimPatchBase (RealPatch prim) where+ type PrimOf (RealPatch prim) = prim++-- | 'isDuplicate' @p@ is ' @True@ if @p@ is either a 'Duplicate' or 'Etacilpud' patch+isDuplicate :: RealPatch prim C(s y) -> Bool+isDuplicate (Duplicate _) = True+isDuplicate (Etacilpud _) = True+isDuplicate _ = False++-- | This is only used for unit testing+isForward :: PrimPatch prim => RealPatch prim C(s y) -> Maybe Doc+isForward p@(InvConflictor _ _ _) =+ Just $ redText "An inverse conflictor" $$ showPatch p+isForward p@(Etacilpud _) =+ Just $ redText "An inverse duplicate" $$ showPatch p+isForward _ = Nothing++mergeUnravelled :: PrimPatch prim => [Sealed ((FL prim) C(x))] -> Maybe (FlippedSeal (RealPatch prim) C(x))+mergeUnravelled [] = Nothing+mergeUnravelled [_] = Nothing+mergeUnravelled ws = case mergeUnravelled_private ws of+ Nothing -> Nothing+ Just NilRL -> bug "found no patches in mergeUnravelled"+ Just (z:<:_) -> Just $ FlippedSeal z+ where notNullS :: PrimPatch prim => Sealed ((FL prim) C(x)) -> Bool+ notNullS (Sealed NilFL) = False+ notNullS _ = True+ mergeUnravelled_private :: PrimPatch prim => [Sealed (FL prim C(x))] -> Maybe (RL (RealPatch prim) C(x x))+ mergeUnravelled_private xs = reverseFL `fmap` mergeConflictingNons+ (map sealed2non $ filter notNullS xs)++-- | 'sealed2non' @(Sealed xs)@ converts @xs@ to a 'Non'.+-- @xs@ must be non-empty since we split this list at the last patch+sealed2non :: Sealed ((FL prim) C(x)) -> Non (RealPatch prim) C(x)+sealed2non (Sealed xs) = case reverseFL xs of+ y:<:ys -> Non (mapFL_FL fromPrim $ reverseRL ys) y+ NilRL -> bug "NilFL encountered in sealed2non"++mergeConflictingNons :: PrimPatch prim => [Non (RealPatch prim) C(x)] -> Maybe (FL (RealPatch prim) C(x x))+mergeConflictingNons ns = mcn $ map unNon ns+ where mcn :: PrimPatch prim => [Sealed (FL (RealPatch prim) C(x))] -> Maybe (FL (RealPatch prim) C(x x))+ mcn [] = Just NilFL+ mcn [Sealed p] = case joinEffects p of -- this is just a safety check, and could+ NilFL -> Just p -- be removed when we're sure of the code.+ _ -> Nothing+ mcn (Sealed p1:Sealed p2:zs) = case pullCommon p1 p2 of+ Common c ps qs ->+ case merge (ps :\/: qs) of+ qs' :/\: _ -> mcn (Sealed (c +>+ ps +>+ qs'):zs)++joinEffects :: forall p C(x y)+ . (Effect p, Invert (PrimOf p), Commute (PrimOf p), MyEq (PrimOf p))+ => p C(x y) -> FL (PrimOf p) C(x y)+joinEffects = joinInverses . effect+ where joinInverses :: FL (PrimOf p) C(a b) -> FL (PrimOf p) C(a b)+ joinInverses NilFL = NilFL+ joinInverses (p:>:ps) = case removeFL (invert p) ps' of+ Just ps'' -> ps''+ Nothing -> p :>: ps'+ where ps' = joinInverses ps++assertConsistent :: PrimPatch prim => RealPatch prim C(x y) -> RealPatch prim C(x y)+assertConsistent x = assertDoc (do e <- isConsistent x+ Just (redText "Inconsistent patch:" $$ showPatch x $$ e)) x++-- | @mergeAfterConflicting@ takes as input a sequence of conflicting+-- patches @xxx@ (which therefore have no effect) and a sequence of+-- primitive patches @yyy@ that follow said sequence of conflicting+-- patches, and may depend upon some of the conflicting patches (as a+-- resolution).++-- The output is two sequences of patches the first consisting of a+-- set of mutually-conflicting patches, and the second having the same+-- effect as the original primitive patch sequence in the input.++-- So far as I can tell, the second output is always identical to+-- @mapFL Normal yyy@++-- The first output is the set of patches from @xxx@ that are depended+-- upon by @yyy@.++mergeAfterConflicting :: PrimPatch prim+ => FL (RealPatch prim) C(x x) -> FL prim C(x y)+ -> Maybe (FL (RealPatch prim) C(x x), FL (RealPatch prim) C(x y))+mergeAfterConflicting xxx yyy = --traceDoc (greenText "mergeAfterConflicting xxx" $$ showPatch xxx $$+ -- greenText "and yyy" $$ showPatch yyy) $+ mac (reverseFL xxx) yyy NilFL+ where mac :: PrimPatch prim+ => RL (RealPatch prim) C(x y) -> FL prim C(y z) -> FL (RealPatch prim) C(z a)+ -> Maybe (FL (RealPatch prim) C(x x), FL (RealPatch prim) C(x a))+ mac NilRL xs goneby = case joinEffects goneby of+ NilFL -> Just (NilFL, mapFL_FL Normal xs)+ _z -> --traceDoc (greenText "mac1 z" $$ showPatch _z) $+ Nothing+ mac (p:<:ps) xs goneby = --traceDoc (greenText "mac ps" $$ showPatch ps $$+ -- greenText "p" $$ showPatch p $$+ -- greenText "xs" $$ showPatch xs $$+ -- greenText "goneby" $$ showPatch goneby) $+ case commuteFLorComplain (p :> mapFL_FL Normal xs) of+ Left _ -> case genCommuteWhatWeCanRL commuteNoConflicts (ps :> p) of+ a:>p':>b ->+ do (b',xs') <- mac b xs goneby+ let pa = joinEffects $ p':<:a+ --traceDoc (greenText "foo1" $$+ -- showPatch pa) $ Just ()+ NilFL <- return pa+ return (reverseRL (p':<:a)+>+b', xs')+ `mplus` do NilFL <- return goneby+ NilFL <- return $ joinEffects (p:<:ps)+ return (reverseRL (p:<:ps),+ mapFL_FL Normal xs)+ Right (l:>p'') ->+ case allNormal l of+ Just xs'' -> mac ps xs'' (p'':>:goneby)+ Nothing ->+ case genCommuteWhatWeCanRL commuteNoConflicts (ps :> p) of+ a:>p':>b ->+ do (b',xs') <- mac b xs goneby+ let pa = joinEffects $ p':<:a+ --traceDoc (greenText "foo2" $$+ -- showPatch pa) $ Just ()+ NilFL <- return pa+ return $ (reverseRL (p':<:a)+>+b', xs')++geteff :: PrimPatch prim => [Non (RealPatch prim) C(x)] -> FL prim C(x y) -> ([Non (RealPatch prim) C(x)], FL (RealPatch prim) C(x y))+geteff _ NilFL = ([],NilFL)+geteff ix (x:>:xs) | Just ix' <- mapM (remP (Normal x)) ix+ = --traceDoc (greenText "I got rid of x" $$ showPatch x) $+ case geteff ix' xs of+ (ns,xs') -> (non (Normal x) : map (addP (Normal x)) ns,+ Normal x :>: xs')+geteff ix xx = case mergeConflictingNons ix of+ Nothing -> errorDoc $ redText "mergeConflictingNons failed in geteff with ix" $$+ showNons ix $$ redText "xx" $$ showPatch xx+ Just rix -> case mergeAfterConflicting rix xx of+ Just (a,x) -> (map (addPs (reverseFL a)) $ toNons x,+ a +>+ x)+ Nothing -> errorDoc $ redText "mergeAfterConflicting failed in geteff"$$+ redText "where ix" $$ showNons ix $$+ redText "and xx" $$ showPatch xx $$+ redText "and rix" $$ showPatch rix++xx2nons :: PrimPatch prim => [Non (RealPatch prim) C(x)] -> FL prim C(x y) -> [Non (RealPatch prim) C(x)]+xx2nons ix xx = fst $ geteff ix xx++xx2patches :: PrimPatch prim => [Non (RealPatch prim) C(x)] -> FL prim C(x y) -> FL (RealPatch prim) C(x y)+xx2patches ix xx = snd $ geteff ix xx++-- | If @xs@ consists only of 'Normal' patches, 'allNormal' @xs@ returns+-- @Just pxs@ those patches (so @lengthFL pxs == lengthFL xs@).+-- Otherwise, it returns 'Nothing'.+allNormal :: FL (RealPatch prim) C(x y) -> Maybe (FL prim C(x y))+allNormal (Normal x:>:xs) = (x :>:) `fmap` allNormal xs+allNormal NilFL = Just NilFL+allNormal _ = Nothing++-- | This is used for unit-testing and for internal sanity checks+isConsistent :: PrimPatch prim => RealPatch prim C(x y) -> Maybe Doc+isConsistent (Normal _) = Nothing+isConsistent (Duplicate _) = Nothing+isConsistent (Etacilpud _) = Nothing+isConsistent (Conflictor im mm m@(Non deps _))+ | not $ everyoneConflicts im = Just $ redText "Someone doesn't conflict in im in isConsistent"+ | Just _ <- remPs rmm m, _:>:_ <- mm = Just $ redText "m doesn't conflict with mm in isConsistent"+ | any (\x -> any (x `conflictsWith`) nmm) im+ = Just $ redText "mm conflicts with im in isConsistent where nmm is" $$+ showNons nmm+ | Nothing <- (nmm ++ im) `minus` toNons deps = Just $ redText "dependencies not in conflict:" $$+ showNons (toNons deps) $$+ redText "compared with deps itself:" $$+ showPatch deps+ | otherwise = case allConflictsWith m im of+ (im1,[]) | im1 `eqSet` im -> Nothing+ (_,imnc) -> Just $ redText "m doesn't conflict with im in isConsistent. unconflicting:"+ $$ showNons imnc+ where (nmm, rmm) = geteff im mm+isConsistent c@(InvConflictor _ _ _) = isConsistent (invert c)++everyoneConflicts :: PrimPatch prim => [Non (RealPatch prim) C(x)] -> Bool+everyoneConflicts [] = True+everyoneConflicts (x:xs) = case allConflictsWith x xs of+ ([],_) -> False+ (_,xs') -> everyoneConflicts xs'++prim2real :: prim C(x y) -> RealPatch prim C(x y)+prim2real = Normal++instance PrimPatch prim => Patchy (RealPatch prim)++mergeWith :: PrimPatch prim => Non (RealPatch prim) C(x) -> [Non (RealPatch prim) C(x)] -> Sealed (FL prim C(x))+mergeWith p [] = effect `mapSeal` unNon p+mergeWith p xs = mergeall $ map unNon $ (p:) $ unconflicting_of $+ filter (\x -> not (p `dependsUpon` x) && not (p `conflictsWith` x)) xs+ where mergeall :: PrimPatch prim => [Sealed (FL (RealPatch prim) C(x))] -> Sealed (FL prim C(x))+ mergeall [Sealed x] = Sealed $ effect x+ mergeall [] = Sealed NilFL+ mergeall (Sealed x:Sealed y:rest) = case merge (x :\/: y) of+ y' :/\: _ -> mergeall (Sealed (x+>+y'):rest)+ unconflicting_of [] = []+ unconflicting_of (q:qs) = case allConflictsWith q qs of+ ([],_) -> q:qs+ (_,nc) -> unconflicting_of nc++instance PrimPatch prim => Conflict (RealPatch prim) where+ conflictedEffect (Duplicate (Non _ x)) = [IsC Duplicated x]+ conflictedEffect (Etacilpud _) = impossible+ conflictedEffect (Conflictor _ _ (Non _ x)) = [IsC Conflicted x]+ conflictedEffect (InvConflictor _ _ _) = impossible+ conflictedEffect (Normal x) = [IsC Okay x]+ resolveConflicts (Conflictor ix xx x) = [mangleUnravelled unravelled : unravelled]+ where unravelled = nub $ filter isn $ map (`mergeWith` (x:ix++nonxx)) (x:ix++nonxx)+ nonxx = nonxx_ (nonxx_aux ix xx)+ nonxx_aux :: [Non (RealPatch prim) C(x)] -> FL prim C(x y) -> RL (RealPatch prim) C(x y)+ nonxx_aux a b = reverseFL $ xx2patches a b+ nonxx_ :: RL (RealPatch prim) C(x y) -> [Non (RealPatch prim) C(x)]+ nonxx_ NilRL = []+ nonxx_ ((Normal q) :<: qs) = [Non (reverseRL qs) q]+ nonxx_ _ = []+ isn :: Sealed (FL p C(x)) -> Bool+ isn (Sealed NilFL) = False+ isn _ = True+ resolveConflicts _ = []++instance PrimPatch prim => CommuteNoConflicts (RealPatch prim) where+ -- cA+ commuteNoConflicts (Duplicate x :> Duplicate y) = Just (Duplicate y :> Duplicate x)+ commuteNoConflicts (Etacilpud x :> Duplicate y) = Just (Duplicate y :> Etacilpud x)+ commuteNoConflicts (Duplicate x :> Etacilpud y) = Just (Etacilpud y :> Duplicate x)+ commuteNoConflicts (Etacilpud x :> Etacilpud y) = Just (Etacilpud y :> Etacilpud x)+ -- cB+ commuteNoConflicts (x :> Duplicate d) = if d == addP (invert x) (non x)+ then Just (x :> Duplicate d)+ else do d' <- remP (invert x) d+ return (Duplicate d' :> x)+ commuteNoConflicts (Duplicate d' :> x) = Just (x :> Duplicate (addP (invert x) d'))+ commuteNoConflicts c@(Etacilpud _ :> _) = invertCommuteNC c+ commuteNoConflicts c@(_ :> Etacilpud _) = invertCommuteNC c+ -- cE+ commuteNoConflicts (Normal x :> Normal y) = do y' :> x' <- commute (x :> y)+ return (Normal y' :> Normal x')+ -- cF -- involves a conflict+ -- cG+ commuteNoConflicts (Normal x :> Conflictor iy yy y) =+ case commuteFLorComplain (x :> invert yy) of+ Right (iyy' :> x') -> do+ y':iy' <- mapM (Normal x' >*) (y:iy)+ return (Conflictor iy' (invert iyy') y' :> Normal x')+ _ -> Nothing+ -- cFi+cGi -- handle with previous two pattern matches+ commuteNoConflicts c@(InvConflictor _ _ _ :> Normal _) = invertCommuteNC c+ -- icG FIXME: where is icF?+ commuteNoConflicts (Conflictor iy' yy' y' :> Normal x') =+ do x :> iyy <- commuteRL (invertFL yy' :> x')+ y:iy <- mapM (*> Normal x') (y':iy')+ return (Normal x :> Conflictor iy (invertRL iyy) y)+ -- icGi -- handle with previous pattern match+ commuteNoConflicts c@(Normal _ :> InvConflictor _ _ _) = invertCommuteNC c+ -- cH -- this involves a conflict commute+ -- cI+ commuteNoConflicts (Conflictor ix xx x :> Conflictor iy yy y) =+ do xx' :> yy' <- commute (yy :> xx)+ x':ix' <- mapM (yy >>*) (x:ix)+ y':iy' <- mapM (*>> xx') (y:iy)+ False <- return $ any (conflictsWith y) (x':ix')+ False <- return $ any (conflictsWith x') iy+ return (Conflictor iy' yy' y' :> Conflictor ix' xx' x')+ -- cHi+cIi uses previous two matches+ commuteNoConflicts c@(InvConflictor _ _ _ :> InvConflictor _ _ _) = invertCommuteNC c+ -- cJ+ commuteNoConflicts (InvConflictor ix xx x :> Conflictor iy yy y) =+ do iyy' :> xx' <- commute (xx :> invert yy)+ y':iy' <- mapM (xx' >>*) (y:iy)+ x':ix' <- mapM (invertFL iyy' >>*) (x:ix)+ False <- return $ any (conflictsWith y') (x':ix')+ False <- return $ any (conflictsWith x') iy'+ return (Conflictor iy' (invert iyy') y' :> InvConflictor ix' xx' x')+ -- icJ+ commuteNoConflicts (Conflictor iy' yy' y' :> InvConflictor ix' xx' x') =+ do xx :> iyy <- commute (invert yy' :> xx')+ y:iy <- mapM (*>> xx') (y':iy')+ x:ix <- mapM (*>> yy') (x':ix')+ False <- return $ any (conflictsWith y') (x':ix')+ False <- return $ any (conflictsWith x') iy'+ return (InvConflictor ix xx x :> Conflictor iy (invert iyy) y)++instance PrimPatch prim => Check (RealPatch prim) where+ isInconsistent = isConsistent++instance FromPrim (RealPatch prim) where+ fromPrim = prim2real+instance ToFromPrim (RealPatch prim) where+ toPrim (Normal p) = Just p+ toPrim _ = Nothing++instance PrimPatch prim => MyEq (RealPatch prim) where+ (Duplicate x) =\/= (Duplicate y) | x == y = IsEq+ (Etacilpud x) =\/= (Etacilpud y) | x == y = IsEq+ (Normal x) =\/= (Normal y) = x =\/= y+ (Conflictor cx xx x) =\/= (Conflictor cy yy y)+ | map (add $ invertFL xx) cx `eqSet`+ map (add $ invertFL yy) cy &&+ add (invert xx) x == add (invert yy) y = xx =/\= yy+ (InvConflictor cx xx x) =\/= (InvConflictor cy yy y)+ | cx `eqSet` cy && x == y = xx =\/= yy+ _ =\/= _ = NotEq++eqSet :: Eq a => [a] -> [a] -> Bool+eqSet [] [] = True+eqSet (x:xs) xys | Just ys <- remove1 x xys = eqSet xs ys+eqSet _ _ = False++remove1 :: Eq a => a -> [a] -> Maybe [a]+remove1 x (y:ys) | x == y = Just ys+ | otherwise = (y :) `fmap` remove1 x ys+remove1 _ [] = Nothing++minus :: Eq a => [a] -> [a] -> Maybe [a]+minus xs [] = Just xs+minus xs (y:ys) = do xs' <- remove1 y xs+ xs' `minus` ys++invertNon :: PrimPatch prim => Non (RealPatch prim) C(x) -> Non (RealPatch prim) C(x)+invertNon (Non c x)+ | Just rc' <- removeRL nix (reverseFL c) = Non (reverseRL rc') (invert x)+ | otherwise = addPs (Normal x :<: reverseFL c) $ non nix+ where nix = Normal $ invert x++nonTouches :: PatchInspect prim => Non (RealPatch prim) C(x) -> [FilePath]+nonTouches (Non c x) = listTouchedFiles (c +>+ fromPrim x :>: NilFL)++nonHunkMatches :: PatchInspect prim => (BC.ByteString -> Bool) -> Non (RealPatch prim) C(x) -> Bool+nonHunkMatches f (Non c x) = hunkMatches f c || hunkMatches f x++toNons :: forall p C(x y)+ . (Conflict p, Patchy p, PatchListFormat p, ToFromPrim p,+ Nonable p, ShowPatchBasic (PrimOf p))+ => FL p C(x y) -> [Non p C(x)]+toNons xs = map lastNon $ initsFL xs+ where lastNon :: Sealed ((p :> FL p) C(x)) -> Non p C(x)+ lastNon (Sealed xxx) = case lastNon_aux xxx of+ deps :> p :> _ -> case non p of+ Non NilFL pp -> Non (reverseRL deps) pp+ Non ds pp -> errorDoc $ redText "Weird case in toNons" $$+ redText "please report this bug!" $$+ (case xxx of+ z:>zs -> showPatch (z:>:zs)) $$+ redText "ds are" $$ showPatch ds $$+ redText "pp is" $$ showPatch pp+ reverseFoo :: (p :> FL p) C(x z) -> (RL p :> p) C(x z)+ reverseFoo (p :> ps) = rf NilRL p ps+ where rf :: RL p C(a b) -> p C(b c) -> FL p C(c d) -> (RL p :> p) C(a d)+ rf rs l NilFL = rs :> l+ rf rs x (y:>:ys) = rf (x:<:rs) y ys+ lastNon_aux :: (p :> FL p) C(x z) -> (RL p :> p :> RL p) C(x z)+ lastNon_aux = commuteWhatWeCanRL . reverseFoo++initsFL :: Patchy p => FL p C(x y) -> [Sealed ((p :> FL p) C(x))]+initsFL NilFL = []+initsFL (x:>:xs) = Sealed (x:>NilFL) : map (\ (Sealed (y:>xs')) -> Sealed (x:>y:>:xs')) (initsFL xs)++filterConflictsFL :: PrimPatch prim => Non (RealPatch prim) C(x) -> FL prim C(x y) -> (FL prim :> FL prim) C(x y)+filterConflictsFL _ NilFL = NilFL :> NilFL+filterConflictsFL n (p:>:ps)+ | Just n' <- remP (fromPrim p) n = case filterConflictsFL n' ps of+ p1 :> p2 -> p:>:p1 :> p2+ | otherwise = case commuteWhatWeCanFL (p :> ps) of+ p1 :> p' :> p2 -> case filterConflictsFL n p1 of+ p1a :> p1b -> p1a :> p1b +>+ p' :>: p2++instance Invert prim => Invert (RealPatch prim) where+ invert (Duplicate d) = Etacilpud d+ invert (Etacilpud d) = Duplicate d+ invert (Normal p) = Normal (invert p)+ invert (Conflictor x c p) = InvConflictor x c p+ invert (InvConflictor x c p) = Conflictor x c p++instance PrimPatch prim => Commute (RealPatch prim) where+-- commute (x :> y) | traceDoc (greenText "commuting x" $$ showPatch x $$+-- greenText "with y" $$ showPatch y) False = undefined+ commute (x :> y) | Just (y' :> x') <- commuteNoConflicts (assertConsistent x :> assertConsistent y) = Just (y' :> x')+ -- cF+ commute (Normal x :> Conflictor a1'nop2 n1'x p1') -- these patches conflicted+ | Just rn1' <- removeRL x (reverseFL n1'x) =+ do let p2:n1nons = reverse $ xx2nons a1'nop2 $ reverseRL (x:<:rn1')+ a2 = p1':a1'nop2++n1nons+ case (a1'nop2, reverseRL rn1', p1') of+ ([], NilFL, Non c y) | NilFL <- joinEffects c ->+ Just (Normal y :> Conflictor a1'nop2 (y:>:NilFL) p2)+ (a1,n1,_) -> Just (Conflictor a1 n1 p1' :> Conflictor a2 NilFL p2)+ -- cFi -- handle with previous pattern match+ commute c@(InvConflictor _ _ _ :> Normal _) = invertCommute c+ -- cH+ commute (Conflictor a1 n1 p1 :> Conflictor a2 n2 p2)+ | Just a2_minus_p1 <- remove1 p1' a2,+ not (p2 `dependsUpon` p1') =+ do let n1nons = map (add n2) $ xx2nons a1 n1+ n2nons = xx2nons a2 n2+ Just a2_minus_p1n1 = a2_minus_p1 `minus` n1nons+ n2n1 = n2 +>+ n1+ a1' = map (add n2) a1+ p2ooo = remNons a1' p2+ n1' :> n2' <- return $ filterConflictsFL p2ooo n2n1+ let n1'n2'nons = xx2nons a2_minus_p1n1 (n1'+>+n2')+ n1'nons = take (lengthFL n1') n1'n2'nons+ n2'nons = drop (lengthFL n1') n1'n2'nons+ Just a1'nop2 = (a2++n2nons) `minus` (p1':n1'nons)+ Just a2'o = --traceDoc (greenText "\n\nConflictor a1 n1 p1 is" $$+ -- showPatch (assertConsistent $ Conflictor a1 n1 p1) $$+ -- greenText "and Conflictor a2 n2 p2 is" $$+ -- showPatch (assertConsistent $ Conflictor a2 n2 p2) $$+ -- greenText "where n2'nons is" $$ showNons n2'nons $$+ -- greenText "and others are" $$+ -- showNons (fst $ allConflictsWith p2 $ a2_minus_p1++n2nons) $$+ -- greenText "These came from" $$+ -- showNons (a2_minus_p1++n2nons) $$+ -- greenText "n1'n2'nons" $$ showNons n1'n2'nons $$+ -- greenText "from n1' :> n2'" $$+ -- showPatch n1' $$ greenText ":>" $$ showPatch n2' $$+ -- greenText "p2" $$ showNon p2 $$+ -- greenText "p2 fixed" $$ showNon p2ooo $$+ -- -- greenText "pren1" $$ showPatch pren1 $$+ -- greenText "n1'" $$ showPatch n1' $$+ -- greenText "p2" $$ showNon p2+ -- )+ (fst $ allConflictsWith p2 $ a2_minus_p1++n2nons) `minus` n2'nons+ Just a2' = mapM (remPs (xx2patches a1'nop2 n1')) $+ a2'o+ Just p2' = remPs (xx2patches a1'nop2 n1') p2+ case (a2', n2', p2') of+ ([], NilFL, Non c x) | NilFL <- joinEffects c ->+ Just (Normal x :> Conflictor a1'nop2 (n1'+>+x:>:NilFL) p1')+ | otherwise -> impossible+ _ -> Just (Conflictor a2' n2' p2' :> Conflictor (p2:a1'nop2) n1' p1')+ where (_,rpn2) = geteff a2 n2+ p1' = addPs (reverseFL rpn2) p1+ -- cHi -- uses previous match+ commute c@(InvConflictor _ _ _ :> InvConflictor _ _ _) = invertCommute c+ commute _ = Nothing++instance PrimPatch prim => Merge (RealPatch prim) where+ merge (InvConflictor _ _ _ :\/: _) = impossible+ merge (_ :\/: InvConflictor _ _ _) = impossible+ merge (Etacilpud _ :\/: _) = impossible+ merge (_ :\/: Etacilpud _) = impossible+-- merge (x :\/: y) | traceDoc (greenText "merging x" $$ showPatch x $$+-- greenText "with y" $$ showPatch y) False = impossible+ -- mA+ merge (Duplicate a :\/: Duplicate b) = Duplicate b :/\: Duplicate a+ -- mB+ merge (Duplicate a :\/: b) = b :/\: Duplicate (addP (invert b) a) -- FIXME ???+ -- smB+ merge m@(_ :\/: Duplicate _) = swapMerge m+ -- mC+-- merge _ | traceDoc (greenText "about to look for conflictingness") False = impossible+ merge (x :\/: y) | Just (y' :> ix') <- commute (invert (assertConsistent x) :> assertConsistent y),+ Just (y'' :> _) <- commute (x :> y'),+ IsEq <- y'' =\/= y = --traceDoc (greenText "These didn't conflict") $+ assertConsistent y' :/\: invert (assertConsistent ix')+ | IsEq <- x =\/= y,+ n <- addP (invert x) $ non x =+ --traceDoc (greenText "Found duplicate") $+ Duplicate n :/\: Duplicate n+-- merge (x :\/: y) | traceDoc (greenText "trying to merging x" $$ showPatch x $$+-- greenText "which conflicts with y" $$ showPatch y) False = impossible+ -- mD+ merge (Normal x :\/: Normal y) =+ Conflictor [] (x:>:NilFL) (non $ Normal y) :/\: Conflictor [] (y:>:NilFL) (non $ Normal x)+ -- mG+ merge (Normal x :\/: Conflictor iy yy y) =+ --traceDoc (greenText "merging Normal x" $$ showPatch x $$+ -- greenText "and Conflictor iy yy y" $$ showPatch (Conflictor iy yy y)) $+ Conflictor iy yyx y :/\: Conflictor (y:iy++nyy) NilFL x'+ where yyx = yy +>+ x:>:NilFL+ (x':nyy) = reverse $ xx2nons iy yyx+ -- smE+smG+ merge m@(Conflictor _ _ _ :\/: Normal _) = swapMerge m+-- merge (x :\/: y) | traceDoc (greenText "still trying to merge x" $$ showPatch x $$+-- greenText "with y" $$ showPatch y) False = impossible+ -- mH see also cH+ merge (Conflictor ix xx x :\/: Conflictor iy yy y) =+ case pullCommonRL (reverseFL xx) (reverseFL yy) of+ CommonRL rxx1 ryy1 c ->+ case commuteRLFL (ryy1 :> invertRL rxx1) of+ Just (ixx' :> ryy') ->+ let xx' = invert ixx'+ yy' = reverseRL ryy'+ y':iy' = map (add $ invertFL ixx') (y:iy)+ x':ix' = map (add ryy') (x:ix)+ nyy' = xx2nons iy' yy'+ nxx' = xx2nons ix' xx'+ icx = drop (lengthRL rxx1) $ xx2nons ix (reverseRL $ c+<+rxx1)+ ic' = map (add ryy') icx+ ixy' = ic' ++ (iy'+++ix')+ -- +++ above is a more efficient version of nub+ -- (iy'++ix') given that we know each element shows up+ -- only once in either list.+ in --traceDoc (greenText "here I am! and so is ixy'" $$ showNons ixy' $$+ -- greenText "and iy" $$ showNons iy $$ greenText (show $ length iy) $$+ -- greenText "and ix" $$ showNons ix $$+ -- greenText "and iy'" $$ showNons iy' $$+ -- greenText "and ix'" $$ showNons ix' $$+ -- greenText "and ic'" $$ showNons ic'+ -- ) $+ Conflictor (x':ixy'++nxx') yy' y' :/\: Conflictor (y':ixy'++nyy') xx' x'+ Nothing -> impossible+-- merge _ = error "haven't finished fixing merge"++instance PatchInspect prim => PatchInspect (RealPatch prim) where+ listTouchedFiles (Duplicate p) = nonTouches p+ listTouchedFiles (Etacilpud p) = nonTouches p+ listTouchedFiles (Normal p) = listTouchedFiles p+ listTouchedFiles (Conflictor x c p) =+ nubsort $ concatMap nonTouches x ++ listTouchedFiles c ++ nonTouches p+ listTouchedFiles (InvConflictor x c p) =+ nubsort $ concatMap nonTouches x ++ listTouchedFiles c ++ nonTouches p++ hunkMatches f (Duplicate p) = nonHunkMatches f p+ hunkMatches f (Etacilpud p) = nonHunkMatches f p+ hunkMatches f (Normal p) = hunkMatches f p+ hunkMatches f (Conflictor x c p) = or [or $ map (nonHunkMatches f) x, hunkMatches f c, nonHunkMatches f p]+ hunkMatches f (InvConflictor x c p) = or [or $ map (nonHunkMatches f) x, hunkMatches f c, nonHunkMatches f p]++{-+allConflictsWithFL :: FL prim C(x y) -> [Non (RealPatch prim) C(x)]+ -> ([Non (RealPatch prim) C(x)], [Non (RealPatch prim) C(x)])+allConflictsWithFL xx ns = case partition f ns of+ ([],nc) -> ([],nc)+ (c,nc) -> case acw c nc of+ (c',nc') -> (c++c',nc')+ where acw (y:ys) zs = case allConflictsWith y zs of+ (c,nc) -> case acw ys nc of+ (c',nc') -> (c++c',nc')+ acw [] zs = ([],zs)+ f (Non c p) = case commuteRLFL (invertFL c :> mapFL_FL Normal xx) of+ Nothing -> True+ Just (xx' :> _) -> case commuteFLorComplain (Normal (invert p) :> xx') of+ Nothing -> True+ Just _ -> False+-}+allConflictsWith :: PrimPatch prim+ => Non (RealPatch prim) C(x) -> [Non (RealPatch prim) C(x)]+ -> ([Non (RealPatch prim) C(x)], [Non (RealPatch prim) C(x)])+allConflictsWith x ys = acw $ partition (conflictsWith x) ys+ where acw ([],nc) = ([],nc)+ acw (c:cs, nc) = case allConflictsWith c nc of+ (c1,nc1) -> case acw (cs, nc1) of+ (xs',nc') -> (c:c1++xs',nc')++conflictsWith :: PrimPatch prim => Non (RealPatch prim) C(x) -> Non (RealPatch prim) C(x) -> Bool+conflictsWith x y | x `dependsUpon` y || y `dependsUpon` x = False+conflictsWith x (Non cy y) =+ case remPs cy x of+ Just (Non cx' x') -> case commuteFLorComplain (fromPrim (invert y) :> cx' +>+ fromPrim x' :>: NilFL) of+ Right _ -> False+ Left _ -> True+ Nothing -> True++dependsUpon :: PrimPatch prim => Non (RealPatch prim) C(x) -> Non (RealPatch prim) C(x) -> Bool+dependsUpon (Non xs _) (Non ys y) =+ case removeSubsequenceFL (ys +>+ fromPrim y :>: NilFL) xs of+ Just _ -> True+ Nothing -> False++(+++) :: Eq a => [a] -> [a] -> [a]+[] +++ x = x+x +++ [] = x+(x:xs) +++ xys | Just ys <- remove1 x xys = x : (xs +++ ys)+ | otherwise = x : (xs +++ xys)++swapMerge :: PrimPatch prim => (RealPatch prim :\/: RealPatch prim) C(x y) -> (RealPatch prim :/\: RealPatch prim) C(x y)+swapMerge (x :\/: y) = case merge (y :\/: x) of x' :/\: y' -> y' :/\: x'++invertCommute :: PrimPatch prim => (RealPatch prim :> RealPatch prim) C(x y) -> Maybe ((RealPatch prim :> RealPatch prim) C(x y))+invertCommute (x :> y) = do ix' :> iy' <- commute (invert y :> invert x)+ return (invert iy' :> invert ix')++invertCommuteNC :: PrimPatch prim => (RealPatch prim :> RealPatch prim) C(x y) -> Maybe ((RealPatch prim :> RealPatch prim) C(x y))+invertCommuteNC (x :> y) = do ix' :> iy' <- commuteNoConflicts (invert y :> invert x)+ return (invert iy' :> invert ix')++-- | 'pullCommon' @xs ys@ returns the set of patches that can be commuted+-- out of both @xs@ and @ys@ along with the remnants of both lists+pullCommon :: Patchy p => FL p C(o x) -> FL p C(o y) -> Common p C(o x y)+pullCommon NilFL ys = Common NilFL NilFL ys+pullCommon xs NilFL = Common NilFL xs NilFL+pullCommon (x:>:xs) xys | Just ys <- removeFL x xys = case pullCommon xs ys of+ Common c xs' ys' -> Common (x:>:c) xs' ys'+pullCommon (x:>:xs) ys = case commuteWhatWeCanFL (x :> xs) of+ xs1:>x':>xs2 -> case pullCommon xs1 ys of+ Common c xs1' ys' -> Common c (xs1'+>+x':>:xs2) ys'++-- | 'Common' @cs xs ys@ represents two sequences of patches that have @cs@ in common,+-- in other words @cs +>+ xs@ and @cs +>+ ys@+data Common p C(o x y) where+ Common :: FL p C(o i) -> FL p C(i x) -> FL p C(i y) -> Common p C(o x y)++-- | 'pullCommonRL' @xs ys@ returns the set of patches that can be commuted+-- out of both @xs@ and @ys@ along with the remnants of both lists+pullCommonRL :: Patchy p => RL p C(x o) -> RL p C(y o) -> CommonRL p C(x y o)+pullCommonRL NilRL ys = CommonRL NilRL ys NilRL+pullCommonRL xs NilRL = CommonRL xs NilRL NilRL+pullCommonRL (x:<:xs) xys+ | Just ys <- removeRL x xys = case pullCommonRL xs ys of+ CommonRL xs' ys' c -> CommonRL xs' ys' (x:<:c)+pullCommonRL (x:<:xs) ys =+ case commuteWhatWeCanRL (xs :> x) of+ xs1:>x':>xs2 -> case pullCommonRL xs2 ys of+ CommonRL xs2' ys' c -> CommonRL (xs2'+<+x':<:xs1) ys' c++-- | 'CommonRL' @xs ys cs@' represents two sequences of patches that have @cs@ in common,+-- in other words @xs +<+ cs@ and @ys +<+ cs@+data CommonRL p C(x y f) where+ CommonRL :: RL p C(x i) -> RL p C(y i) -> RL p C(i f) -> CommonRL p C(x y f)++instance PrimPatch prim => Apply (RealPatch prim) where+ apply p = apply (effect p)++instance PrimPatch prim => RepairToFL (RealPatch prim) where+ applyAndTryToFixFL (Normal p) = mapMaybeSnd (mapFL_FL Normal) `liftM` applyAndTryToFixFL p+ applyAndTryToFixFL x = do apply x; return Nothing++instance PatchListFormat (RealPatch prim) where+ -- In principle we could use ListFormatDefault when prim /= V1 Prim patches,+ -- as those are the only case where we need to support a legacy on-disk+ -- format. In practice we don't expect RealPatch to be used with any other argument+ -- anyway, so it doesn't matter.+ patchListFormat = ListFormatV2++instance PrimPatch prim => ShowPatchBasic (RealPatch prim) where+ showPatch (Duplicate d) = blueText "duplicate" $$ showNon d+ showPatch (Etacilpud d) = blueText "etacilpud" $$ showNon d+ showPatch (Normal p) = showPrim NewFormat p+ showPatch (Conflictor i NilFL p) =+ blueText "conflictor" <+> showNons i <+> blueText "[]" $$ showNon p+ showPatch (Conflictor i cs p) =+ blueText "conflictor" <+> showNons i <+> blueText "[" $$+ showPrimFL NewFormat cs $$+ blueText "]" $$+ showNon p+ showPatch (InvConflictor i NilFL p) =+ blueText "rotcilfnoc" <+> showNons i <+> blueText "[]" $$ showNon p+ showPatch (InvConflictor i cs p) =+ blueText "rotcilfnoc" <+> showNons i <+> blueText "[" $$+ showPrimFL NewFormat cs $$+ blueText "]" $$+ showNon p++instance PrimPatch prim => ShowPatch (RealPatch prim) where+ showContextPatch (Normal p) = showContextPatch p+ showContextPatch c = return $ showPatch c+ summary = plainSummary+ summaryFL = plainSummary+ thing _ = "change"++instance PrimPatch prim => ReadPatch (RealPatch prim) where+ readPatch' = skipSpace >> choice+ [ do string duplicate+ p <- readNon+ return $ Sealed $ Duplicate p+ , do string etacilpud+ p <- readNon+ return $ Sealed $ Etacilpud p+ , do string conflictor+ i <- readNons+ Sealed ps <- bracketedFL (readPrim NewFormat) '[' ']'+ p <- readNon+ return $ Sealed $ Conflictor i (unsafeCoerceP ps) p+ , do string rotcilfnoc+ i <- readNons+ Sealed ps <- bracketedFL (readPrim NewFormat) '[' ']'+ p <- readNon+ return $ Sealed $ InvConflictor i ps p+ , do Sealed p <- readPrim NewFormat+ return $ Sealed $ Normal p+ ]++duplicate :: BC.ByteString+duplicate = BC.pack "duplicate"++etacilpud :: BC.ByteString+etacilpud = BC.pack "etacilpud"++conflictor :: BC.ByteString+conflictor = BC.pack "conflictor"++rotcilfnoc :: BC.ByteString+rotcilfnoc = BC.pack "rotcilfnoc"++instance PrimPatch prim => Show (RealPatch prim C(x y)) where+ show p = renderString $ showPatch p++instance PrimPatch prim => Show2 (RealPatch prim) where+ showDict2 = ShowDictClass++instance PrimPatch prim => Nonable (RealPatch prim) where+ non (Duplicate d) = d+ non (Etacilpud d) = invertNon d -- FIXME !!! ???+ non (Normal p) = Non NilFL p+ non (Conflictor _ xx x) = add (invertFL xx) x+ non (InvConflictor _ _ n) = invertNon n++instance PrimPatch prim => Effect (RealPatch prim) where+ effect (Duplicate _) = NilFL+ effect (Etacilpud _) = NilFL+ effect (Normal p) = p :>: NilFL+ effect (Conflictor _ e _) = invert e+ effect (InvConflictor _ e _) = e+ effectRL (Duplicate _) = NilRL+ effectRL (Etacilpud _) = NilRL+ effectRL (Normal p) = p :<: NilRL+ effectRL (Conflictor _ e _) = invertFL e+ effectRL (InvConflictor _ e _) = reverseFL e++instance IsHunk prim => IsHunk (RealPatch prim) where+ isHunk rp = do Normal p <- return rp+ isHunk p
src/Darcs/Patch/Viewing.hs view
@@ -15,11 +15,13 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE CPP #-} -module Darcs.Patch.Viewing ( xmlSummary, plainSummary )- where+module Darcs.Patch.Viewing+ ( showContextHunk, showContextSeries+ )+ where import Prelude hiding ( pi, readFile ) import Control.Monad.State.Strict ( gets )@@ -30,88 +32,52 @@ import ByteStringUtils (linesPS ) import qualified Data.ByteString as BS (null, concat) import qualified Data.ByteString.Lazy as BL (toChunks)-import Darcs.Patch.FileName ( FileName, fn2fp )+import Darcs.Patch.FileName ( fn2fp ) import Printer ( Doc, empty, vcat, text, blueText, Color(Cyan,Magenta), lineColor,- minus, plus, ($$), (<+>), (<>),- prefix, renderString,+ ($$), (<+>),+ prefix, userchunkPS, )-import Darcs.Patch.Core ( Patch(..), Named(..),- patchcontents )-import Darcs.Patch.Prim ( Prim(..), primIsHunk, isHunk, formatFileName, showPrim, FileNameFormat(..), Conflict(..),- Effect, IsConflictedPrim(IsC), ConflictState(..),- DirPatchType(..), FilePatchType(..) )-import Darcs.Patch.Patchy ( Patchy, Apply, ShowPatch(..), identity )-import Darcs.Patch.Show ( showPatch_, showNamedPrefix )-import Darcs.Patch.Info ( showPatchInfo, humanFriendly )-import Darcs.Patch.Apply ( applyToTree )-#include "impossible.h"+import Darcs.Patch.Format ( PatchListFormat(..), ListFormat(..), FileNameFormat(..) )+import Darcs.Patch.FileHunk ( IsHunk(..), FileHunk(..), showFileHunk )+import Darcs.Patch.Show ( ShowPatchBasic(..), ShowPatch(..), formatFileName )+import Darcs.Patch.Apply ( Apply(..), applyToTree ) #include "gadts.h" import Darcs.Witnesses.Ordered ( RL(..), FL(..),- mapFL, mapFL_FL, reverseRL )+ mapFL, mapFL_FL, reverseRL, concatFL ) -instance ShowPatch Prim where- showPatch = showPrim OldFormat- showContextPatch p@(FP _ (Hunk _ _ _)) = showContextHunk (PP p)- showContextPatch (Split ps) =- do x <- showContextSeries (mapFL_FL PP ps)- return $ blueText "(" $$ x <> blueText ")"- showContextPatch p = return $ showPatch p- summary = vcat . map summChunkToLine . genSummary . (:[]) . IsC Okay- thing _ = "change" -plainSummary :: (Conflict e, Effect e) => e C(x y) -> Doc-plainSummary = vcat . map summChunkToLine . genSummary . conflictedEffect--instance ShowPatch Patch where- showPatch = showPatch_- showContextPatch (PP x) | primIsHunk x = showContextHunk (PP x)- showContextPatch (ComP NilFL) = return $ blueText "{" $$ blueText "}"- showContextPatch (ComP ps) =- do x <- showContextSeries ps- return $ blueText "{" $$ x $$ blueText "}"- showContextPatch p = return $ showPatch p- summary = plainSummary- thing _ = "change"--showContextSeries :: (Apply p, ShowPatch p, Effect p) => FL p C(x y) -> TreeIO Doc-showContextSeries patches = scs identity patches- where scs :: (Apply p, ShowPatch p, Effect p) => Prim C(w x) -> FL p C(x y) -> TreeIO Doc+showContextSeries :: (Apply p, ShowPatch p, IsHunk p) => FL p C(x y) -> TreeIO Doc+showContextSeries patches = scs Nothing patches+ where scs :: (Apply p, ShowPatch p, IsHunk p) => Maybe (FileHunk C(w x)) -> FL p C(x y) -> TreeIO Doc scs pold (p:>:ps) = do s' <- gets tree >>= liftIO . applyToTree p case isHunk p of Nothing -> do a <- showContextPatch p- b <- liftIO $ virtualTreeIO (scs identity ps) s'+ b <- liftIO $ virtualTreeIO (scs Nothing ps) s' return $ a $$ fst b- Just hp ->+ Just fh -> case ps of- NilFL -> coolContextHunk pold hp identity- (p2:>:_) ->- case isHunk p2 of- Nothing -> do a <- coolContextHunk pold hp identity- b <- liftIO $ virtualTreeIO (scs hp ps) s'- return $ a $$ fst b- Just hp2 -> do a <- coolContextHunk pold hp hp2- b <- liftIO $ virtualTreeIO (scs hp ps) s'- return $ a $$ fst b+ NilFL -> coolContextHunk pold fh Nothing+ (p2:>:_) -> do a <- coolContextHunk pold fh (isHunk p2)+ b <- liftIO $ virtualTreeIO (scs (Just fh) ps) s'+ return $ a $$ fst b scs _ NilFL = return empty -showContextHunk :: (Apply p, ShowPatch p, Effect p) => p C(x y) -> TreeIO Doc-showContextHunk p = case isHunk p of- Just h -> coolContextHunk identity h identity- Nothing -> return $ showPatch p+showContextHunk :: FileHunk C(x y) -> TreeIO Doc+showContextHunk h = coolContextHunk Nothing h Nothing -coolContextHunk :: Prim C(a b) -> Prim C(b c) -> Prim C(c d) -> TreeIO Doc-coolContextHunk prev p@(FP f (Hunk l o n)) next = do+coolContextHunk :: Maybe (FileHunk C(a b)) -> FileHunk C(b c) -> Maybe (FileHunk C(c d)) -> TreeIO Doc+coolContextHunk prev fh@(FileHunk f l o n) next = do let path = floatPath $ fn2fp f have <- fileExists path content <- if have then Just `fmap` readFile path else return Nothing case (linesPS . BS.concat . BL.toChunks) `fmap` content of -- sigh- Nothing -> return $ showPatch p -- This is a weird error...+ Nothing -> return $ showFileHunk OldFormat fh -- This is a weird error... Just ls -> let numpre = case prev of- (FP f' (Hunk lprev _ nprev))+ Just (FileHunk f' lprev _ nprev) | f' == f && l - (lprev + length nprev + 3) < 3 && lprev < l ->@@ -119,7 +85,7 @@ _ -> if l >= 4 then 3 else l - 1 pre = take numpre $ drop (l - numpre - 1) ls numpost = case next of- (FP f' (Hunk lnext _ _))+ Just (FileHunk f' lnext _ _) | f' == f && lnext < l+length n+4 && lnext > l -> lnext - (l+length n)@@ -133,169 +99,43 @@ $$ lineColor Magenta (prefix "-" (vcat $ map userchunkPS o)) $$ lineColor Cyan (prefix "+" (vcat $ map userchunkPS n)) $$ prefix " " (vcat $ map userchunkPS post)-coolContextHunk _ _ _ = impossible -xmlSummary :: (Effect p, Patchy p, Conflict p) => Named p C(x y) -> Doc-xmlSummary p = text "<summary>"- $$ (vcat . map summChunkToXML . genSummary . conflictedEffect . patchcontents $ p)- $$ text "</summary>"---- Yuck duplicated code below...-escapeXML :: String -> Doc-escapeXML = text . strReplace '\'' "'" . strReplace '"' """ .- strReplace '>' ">" . strReplace '<' "<" . strReplace '&' "&"--strReplace :: Char -> String -> String -> String-strReplace _ _ [] = []-strReplace x y (z:zs)- | x == z = y ++ (strReplace x y zs)- | otherwise = z : (strReplace x y zs)--- end yuck duplicated code.---- | High-level representation of a piece of patch summary-data SummChunk = SummChunk SummDetail ConflictState- deriving (Ord, Eq)--data SummDetail = SummAddDir FileName- | SummRmDir FileName- | SummFile SummOp FileName Int Int Int- | SummMv FileName FileName- | SummNone- deriving (Ord, Eq)--data SummOp = SummAdd | SummRm | SummMod deriving (Ord, Eq)--genSummary :: [IsConflictedPrim] -> [SummChunk]-genSummary p- = combine $ concatMap s2 p- where s2 :: IsConflictedPrim -> [SummChunk]- s2 (IsC c x) = map (\d -> SummChunk d c) $ s x- s :: Prim C(x y) -> [SummDetail]- s (FP f (Hunk _ o n)) = [SummFile SummMod f (length o) (length n) 0]- s (FP f (Binary _ _)) = [SummFile SummMod f 0 0 0]- s (FP f AddFile) = [SummFile SummAdd f 0 0 0]- s (FP f RmFile) = [SummFile SummRm f 0 0 0]- s (FP f (TokReplace _ _ _)) = [SummFile SummMod f 0 0 1]- s (DP d AddDir) = [SummAddDir d]- s (DP d RmDir) = [SummRmDir d]- s (Split xs) = concat $ mapFL s xs- s (Move f1 f2) = [SummMv f1 f2]- s (ChangePref _ _ _) = [SummNone]- s Identity = [SummNone]- combine (x1@(SummChunk d1 c1) : x2@(SummChunk d2 c2) : ss)- = case combineDetail d1 d2 of- Nothing -> x1 : combine (x2:ss)- Just d3 -> combine $ SummChunk d3 (combineConflitStates c1 c2) : ss- combine (x:ss) = x : combine ss- combine [] = []- --- combineDetail (SummFile o1 f1 r1 a1 x1) (SummFile o2 f2 r2 a2 x2) | f1 == f2 =- do o3 <- combineOp o1 o2- return $ SummFile o3 f1 (r1 + r2) (a1 + a2) (x1 + x2)- combineDetail _ _ = Nothing- --- combineConflitStates Conflicted _ = Conflicted- combineConflitStates _ Conflicted = Conflicted- combineConflitStates Duplicated _ = Duplicated- combineConflitStates _ Duplicated = Duplicated- combineConflitStates Okay Okay = Okay- -- Don't combine AddFile and RmFile: (maybe an old revision of) darcs- -- allows a single patch to add and remove the same file, see issue 185- combineOp SummAdd SummRm = Nothing- combineOp SummRm SummAdd = Nothing- combineOp SummAdd _ = Just SummAdd- combineOp _ SummAdd = Just SummAdd- combineOp SummRm _ = Just SummRm- combineOp _ SummRm = Just SummRm- combineOp SummMod SummMod = Just SummMod--summChunkToXML :: SummChunk -> Doc-summChunkToXML (SummChunk detail c) =- case detail of- SummRmDir f -> xconf c "remove_directory" (xfn f)- SummAddDir f -> xconf c "add_directory" (xfn f)- SummFile SummRm f _ _ _ -> xconf c "remove_file" (xfn f)- SummFile SummAdd f _ _ _ -> xconf c "add_file" (xfn f)- SummFile SummMod f r a x -> xconf c "modify_file" $ xfn f <> xrm r <> xad a <> xrp x- SummMv f1 f2 -> text "<move from=\"" <> xfn f1- <> text "\" to=\"" <> xfn f2 <> text"\"/>"- SummNone -> empty- where- xconf Okay t x = text ('<':t++">") $$ x $$ text ("</"++t++">")- xconf Conflicted t x = text ('<':t++" conflict='true'>") $$ x $$ text ("</"++t++">")- xconf Duplicated t x = text ('<':t++" duplicate='true'>") $$ x $$ text ("</"++t++">")- xfn = escapeXML . dropDotSlash .fn2fp- --- xad 0 = empty- xad a = text "<added_lines num='" <> text (show a) <> text "'/>"- xrm 0 = empty- xrm a = text "<removed_lines num='" <> text (show a) <> text "'/>"- xrp 0 = empty- xrp a = text "<replaced_tokens num='" <> text (show a) <> text "'/>"--summChunkToLine :: SummChunk -> Doc-summChunkToLine (SummChunk detail c) =- case detail of- SummRmDir f -> lconf c "R" $ text (fn2fp f) <> text "/"- SummAddDir f -> lconf c "A" $ text (fn2fp f) <> text "/"- SummFile SummRm f _ _ _ -> lconf c "R" $ text (fn2fp f)- SummFile SummAdd f _ _ _ -> lconf c "A" $ text (fn2fp f)- SummFile SummMod f r a x -> lconf c "M" $ text (fn2fp f) <+> rm r <+> ad a <+> rp x- SummMv f1 f2 -> text " " <> text (fn2fp f1)- <> text " -> " <> text (fn2fp f2)- SummNone -> case c of- Okay -> empty- _ -> lconf c "" empty- where- lconf Okay t x = text t <+> x- lconf Conflicted t x = text (t ++ "!") <+> x- lconf Duplicated t x = text t <+> x <+> text "duplicate"- --- ad 0 = empty- ad a = plus <> text (show a)- rm 0 = empty- rm a = minus <> text (show a)- rp 0 = empty- rp a = text "r" <> text (show a)--dropDotSlash :: FilePath -> FilePath-dropDotSlash ('.':'/':str) = dropDotSlash str-dropDotSlash str = str--instance (Conflict p, ShowPatch p) => ShowPatch (Named p) where- showPatch (NamedP n [] p) = showPatchInfo n <> showPatch p- showPatch (NamedP n d p) = showNamedPrefix n d <+> showPatch p- showContextPatch (NamedP n [] p) = showContextPatch p >>= return . (showPatchInfo n <>)- showContextPatch (NamedP n d p) = showContextPatch p >>= return . (showNamedPrefix n d <+>)- description (NamedP n _ _) = humanFriendly n- summary p = description p $$ text "" $$- prefix " " (plainSummary p) -- this isn't summary because summary does the- -- wrong thing with (Named (FL p)) so that it can- -- get the summary of a sequence of named patches- -- right.- showNicely p@(NamedP _ _ pt) = description p $$- prefix " " (showNicely pt)+instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (FL p) where+ showPatch = showPatchInternal patchListFormat+ where showPatchInternal :: ListFormat p -> FL p C(x y) -> Doc+ showPatchInternal ListFormatV1 (p :>: NilFL) = showPatch p+ showPatchInternal ListFormatV1 NilFL = blueText "{" $$ blueText "}"+ showPatchInternal ListFormatV1 ps = blueText "{" $$ vcat (mapFL showPatch ps) $$ blueText "}"+ showPatchInternal ListFormatV2 ps = vcat (mapFL showPatch ps)+ showPatchInternal ListFormatDefault ps = vcat (mapFL showPatch ps) -instance (Conflict p, ShowPatch p) => Show (Named p C(x y)) where- show = renderString . showPatch+instance (Apply p, IsHunk p, PatchListFormat p, ShowPatch p) => ShowPatch (FL p) where+ showContextPatch = showContextPatchInternal patchListFormat+ where showContextPatchInternal :: ListFormat p -> FL p C(x y) -> TreeIO Doc+ showContextPatchInternal ListFormatV1 (p :>: NilFL) = showContextPatch p+ showContextPatchInternal ListFormatV1 NilFL = return $ blueText "{" $$ blueText "}"+ showContextPatchInternal ListFormatV1 ps = do x <- showContextSeries ps+ return $ blueText "{" $$ x $$ blueText "}"+ showContextPatchInternal ListFormatV2 ps = showContextSeries ps+ showContextPatchInternal ListFormatDefault ps = showContextSeries ps -instance (Conflict p, Apply p, Effect p, ShowPatch p) => ShowPatch (FL p) where- showPatch xs = vcat (mapFL showPatch xs)- showContextPatch = showContextSeries description = vcat . mapFL description- summary = vcat . mapFL summary+ summary = summaryFL+ summaryFL = summaryFL . concatFL thing x = thing (helperx x) ++ "s" where helperx :: FL a C(x y) -> a C(x y) helperx _ = undefined things = thing -instance (Conflict p, Apply p, ShowPatch p) => ShowPatch (RL p) where+instance (PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (RL p) where showPatch = showPatch . reverseRL++instance (Apply p, IsHunk p, PatchListFormat p, ShowPatch p) => ShowPatch (RL p) where showContextPatch = showContextPatch . reverseRL description = description . reverseRL summary = summary . reverseRL+ summaryFL = summaryFL . mapFL_FL reverseRL thing = thing . reverseRL things = things . reverseRL -instance (Conflict p, Patchy p) => Patchy (FL p)-instance (Conflict p, Patchy p) => Patchy (RL p)+
− src/Darcs/Population.hs
@@ -1,147 +0,0 @@-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}---- Copyright (C) 2003-2004 Jan Scheffczyk and 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.--#include "gadts.h"--module Darcs.Population ( Population, patchChanges, applyToPop,- getPopFrom,- setPopState,- DirMark(..),- getRepoPop, getRepoPopVersion,- modifiedToXml,- lookupPop, lookupCreationPop,- ) where--import qualified Data.ByteString.Char8 as BC ( unpack, singleton, pack )-import Data.Maybe ( catMaybes )-import Darcs.Utils ( withCurrentDirectory )--import Darcs.Hopefully ( PatchInfoAnd, hopefully, info )-import Darcs.Patch.FileName ( fn2fp, fp2fn, fn2ps, normPath )-import Darcs.Patch ( RepoPatch, applyToPop, patchcontents, patchChanges,- Effect, effect )-import Darcs.Witnesses.Ordered ( FL(..), RL(..), reverseRL, concatRL, mapRL )-import Darcs.Patch.Info ( PatchInfo, idpatchinfo, toXml )-import Darcs.Patch.Set ( PatchSet(..), newset2FL, newset2RL )-#ifdef GADT_WITNESSES-import Darcs.Patch.Set ( Origin )-#endif-import Darcs.Witnesses.Sealed ( Sealed(..), seal, unseal )-import Darcs.Repository ( withRepositoryDirectory, ($-), readRepo )-import Darcs.Repository.Pristine ( identifyPristine, getPristinePop )-import Darcs.PopulationData ( Population(..), PopTree(..), Info(..), DirMark(..),- setPopState, getPopFrom )-import Printer ( empty, text, ($$), (<>), Doc )-import Control.Monad ( liftM )--#include "impossible.h"---- | population of an empty repository-initPop :: Population-initPop = Pop idpatchinfo (PopDir i [])- where i = Info {nameI = BC.singleton '.',- modifiedByI = idpatchinfo,- modifiedHowI = DullDir,- createdByI = Nothing,- creationNameI = Just (BC.singleton '.')}---- | apply a patchset to a population-applyPatchSetPop :: RepoPatch p => PatchSet p C(Origin x) -> Population -> Population-applyPatchSetPop ps pop = applyPatchesPop (newset2FL ps) pop---- | apply Patches to a population-applyPatchesPop :: Effect p => FL (PatchInfoAnd p) C(x y) -> Population -> Population-applyPatchesPop NilFL = id-applyPatchesPop (hp:>:hps) = applyPatchesPop hps .- applyToPop (info hp) (effect $ patchcontents $ hopefully hp)--- | get the pristine population from a repo-getRepoPop :: FilePath -> IO Population-getRepoPop repobasedir- = withRepositoryDirectory [] repobasedir $- \repository -> do- pinfo <- (head . mapRL info . newset2RL) `liftM` readRepo repository- -- pinfo is the latest patchinfo- mp <- withCurrentDirectory repobasedir $- identifyPristine >>= getPristinePop pinfo- case mp of- (Just pop) -> return pop- (Nothing) -> getRepoPopVersion repobasedir pinfo--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---- Routines for pulling data conveniently out of a Population--lookupPop :: FilePath -> Population -> Maybe Population-lookupPop f p = lookupPop' (BC.unpack $ fn2ps $ fp2fn f) p--lookupPop' :: String -> Population -> Maybe Population-lookupPop' f p@(Pop _ (PopFile i))- | BC.unpack (nameI i) == f = Just p- | otherwise = Nothing-lookupPop' d p@(Pop pinfo (PopDir i c))- | BC.unpack (nameI i) == "." =- case catMaybes $ map (lookupPop' (dropDS d).(Pop pinfo)) c of- [apop] -> Just apop- [] -> Nothing- _ -> impossible- | BC.unpack (nameI i) == takeWhile (/='/') d =- case dropWhile (=='/') $ dropWhile (/='/') d of- "" -> Just p- d' -> case catMaybes $ map (lookupPop' d'.(Pop pinfo)) c of- [apop] -> Just apop- [] -> Nothing- _ -> impossible- | otherwise = Nothing- where dropDS ('.':'/':f) = dropDS f- dropDS f = f--lookupCreationPop :: PatchInfo -> FilePath -> Population -> Maybe Population-lookupCreationPop pinfo f p = lookupCreationPop' pinfo (BC.unpack $ fn2ps $ fp2fn f) p--lookupCreationPop' :: PatchInfo -> String -> Population -> Maybe Population-lookupCreationPop' b a (Pop pinfo pp) = (Pop pinfo) `fmap` lcp pp- where lcp p@(PopFile i)- | fixname `fmap` creationNameI i == f && createdByI i == who = Just p- | otherwise = Nothing- lcp p@(PopDir i c)- | fixname `fmap` creationNameI i == f && createdByI i == who = Just p- | otherwise = case catMaybes $ map lcp c of- [apop] -> Just apop- _ -> Nothing- fixname = BC.pack . fn2fp . normPath . fp2fn . BC.unpack- f = Just $ BC.pack $ fn2fp $ normPath $ fp2fn a- who = Just b--modifiedToXml :: Info -> Doc-modifiedToXml i | modifiedHowI i == DullDir = empty- | modifiedHowI i == DullFile = empty-modifiedToXml i = text "<modified>"- $$ text "<modified_how>" <> text (show (modifiedHowI i)) <>- text "</modified_how>"- $$ toXml (modifiedByI i)- $$ text "</modified>"
− src/Darcs/PopulationData.hs
@@ -1,123 +0,0 @@--- Copyright (C) 2003-2004 Jan Scheffczyk and 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.--module Darcs.PopulationData ( Population(..), PopTree(..), Info(..),- setPopState, notModified, setState,- DirMark(..), getPopFrom- ) where-import Darcs.Patch.Info-import Darcs.Utils ( withCurrentDirectory )-import System.Directory ( doesDirectoryExist, getDirectoryContents )-import qualified Data.ByteString.Char8 as BC-import qualified Data.ByteString as B (ByteString)---- | the population of a darcs repository (simpler Slurpy)-data Population = Pop { popState :: PatchInfo -- ^ the state when last modified- , popTree :: PopTree -- ^ the directory listing- }- deriving (Show, Eq)--setPopState :: PatchInfo -> Population -> Population-setPopState i (Pop _ tr) = Pop i tr---- | directory listing-data PopTree = PopDir !Info ![PopTree]- | PopFile !Info- deriving ( Ord, Eq )---- | info of a directory member-data DirMark = AddedFile | RemovedFile | MovedFile String- | ModifiedFile | DullFile- | AddedDir | RemovedDir | MovedDir !String | DullDir- deriving ( Ord, Eq )-data Info = Info {nameI :: !B.ByteString, -- ^ name of the element- modifiedByI :: !PatchInfo, -- ^ last patch modifying this element- modifiedHowI :: !DirMark, -- ^ how was it modified- createdByI :: !(Maybe PatchInfo), -- ^ this can be unknown when restored backwards!- creationNameI :: !(Maybe B.ByteString) -- ^ the original name of the element- }- deriving ( Ord, Eq )---- | was an Info record not modified?-notModified :: Info -> Bool-notModified i = (modifiedHowI i == DullFile) || (modifiedHowI i == DullDir)---- | set the modifier for an Info record-setState :: Info -> PatchInfo -> Info-setState i pinfo = i { modifiedByI = pinfo }--instance Show PopTree where- show s = showPop "" s--showPop :: String -> PopTree -> String-showPop indent (PopDir i fs)- = indent ++ show i ++ "\n" ++- unlines (map (showPop (' ':indent)) fs)-showPop indent (PopFile i)- = indent ++ show i--instance Show Info where- show i = show (nameI i) ++ " " ++ show (modifiedHowI i) ++- " at state " ++ show (modifiedByI i)--instance Show DirMark where- show AddedFile = "File added"- show RemovedFile = "File removed"- show (MovedFile s) = "File moved to " ++ s- show ModifiedFile = "File modified"- show DullFile = "File old"- show AddedDir = "Dir added"- show RemovedDir = "Dir removed"- show (MovedDir s) = "Dir moved from " ++ s- show DullDir = "Dir old"---- | read the population from a given directory @dirname@--- all folders and documents get the given time @t@------ This needs to be here in order to avoid a circular dependency--- between Population and Pristine.-getPopFrom :: FilePath -> PatchInfo -> IO Population-getPopFrom the_directory pinfo =- withCurrentDirectory the_directory $- do popT <- getPopFrom_helper "."- return (Pop pinfo popT)- where getPopFrom_helper :: FilePath -> IO PopTree- getPopFrom_helper dirname = do- isdir <- doesDirectoryExist dirname- let n = BC.pack dirname- if isdir- then do- fnames <- getDirectoryContents dirname- sl <- withCurrentDirectory dirname- (mapM getPopFrom_helper $ filter notHidden fnames)- let i = Info {nameI = n,- modifiedByI = pinfo,- modifiedHowI = DullDir,- createdByI = Just pinfo,- creationNameI = Just n}- return $ PopDir i sl- else do let i = Info {nameI = n,- modifiedByI = pinfo,- modifiedHowI = DullFile,- createdByI = Just pinfo,- creationNameI = Just n}- return $ PopFile i--notHidden :: FilePath -> Bool-notHidden ('.':_) = False-notHidden ('_':_) = False-notHidden _ = True
src/Darcs/PrintPatch.hs view
@@ -15,7 +15,6 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} #include "gadts.h"
src/Darcs/ProgressPatches.hs view
@@ -4,7 +4,7 @@ module Darcs.ProgressPatches (progressRL, progressFL, progressRLShowTags) where import Darcs.Witnesses.Ordered ( FL(..), RL(..), lengthRL, lengthFL )-import Darcs.Hopefully (PatchInfoAnd,info)+import Darcs.Patch.PatchInfoAnd (PatchInfoAnd,info) import System.IO.Unsafe ( unsafePerformIO ) import Progress (minlist, beginTedious, endTedious, progress, progressKeepLatest,
src/Darcs/RemoteApply.hs view
@@ -5,22 +5,23 @@ import System.Exit ( ExitCode ) -import Darcs.Flags ( DarcsFlag( ApplyAs, Debug ) )+import Darcs.Flags ( DarcsFlag( ApplyAs, Debug ), remoteDarcs ) import Darcs.Utils ( breakCommand )-import Darcs.URL ( isUrl, isSsh )-import Darcs.External-import Printer+import Darcs.URL ( isHttpUrl, isSshUrl, splitSshUrl, SshFilePath(..) )+import Darcs.External ( darcsProgram, pipeDoc, pipeDocSSH, maybeURLCmd )+import qualified Ssh( remoteDarcs )+import Printer ( Doc ) remoteApply :: [DarcsFlag] -> String -> Doc -> IO ExitCode remoteApply opts repodir bundle = case applyAs opts of- Nothing -> if isSsh repodir- then applyViaSsh opts repodir bundle- else if isUrl repodir+ Nothing -> if isSshUrl repodir+ then applyViaSsh opts (splitSshUrl repodir) bundle+ else if isHttpUrl repodir then applyViaUrl opts repodir bundle else applyViaLocal opts repodir bundle- Just un -> if isSsh repodir- then applyViaSshAndSudo opts repodir un bundle+ Just un -> if isSshUrl repodir+ then applyViaSshAndSudo opts (splitSshUrl repodir) un bundle else applyViaSudo un repodir bundle applyAs :: [DarcsFlag] -> Maybe String@@ -45,17 +46,15 @@ do let (cmd, args) = breakCommand apply pipeDoc cmd (args ++ [repo]) bundle -applyViaSsh :: [DarcsFlag] -> String -> Doc -> IO ExitCode+applyViaSsh :: [DarcsFlag] -> SshFilePath -> Doc -> IO ExitCode applyViaSsh opts repo bundle =- pipeDocSSH addr [remoteDarcsCmd opts++" apply --all "++unwords (applyopts opts)++- " --repodir '"++path++"'"] bundle- where (addr,':':path) = break (==':') repo+ pipeDocSSH repo [Ssh.remoteDarcs (remoteDarcs opts) ++" apply --all "++unwords (applyopts opts)+++ " --repodir '"++(sshRepo repo)++"'"] bundle -applyViaSshAndSudo :: [DarcsFlag] -> String -> String -> Doc -> IO ExitCode+applyViaSshAndSudo :: [DarcsFlag] -> SshFilePath -> String -> Doc -> IO ExitCode applyViaSshAndSudo opts repo username bundle =- pipeDocSSH addr ["sudo -u "++username++" "++remoteDarcsCmd opts++- " apply --all --repodir '"++path++"'"] bundle- where (addr,':':path) = break (==':') repo+ pipeDocSSH repo ["sudo -u "++username++" "++Ssh.remoteDarcs (remoteDarcs opts)+++ " apply --all --repodir '"++(sshRepo repo)++"'"] bundle applyopts :: [DarcsFlag] -> [String] applyopts opts = if Debug `elem` opts then ["--debug"] else []
src/Darcs/RepoPath.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} -- Copyright (C) 2007 Eric Kow@@ -47,8 +46,10 @@ setCurrentDirectory ) where +import Control.Applicative ( (<$>) ) import Data.List ( isPrefixOf, isSuffixOf )-import Control.Exception ( bracket )+import Control.Exception ( tryJust, bracket )+import System.IO.Error ( isDoesNotExistError ) import Darcs.URL ( isAbsolute, isRelative, isSshNopath ) import qualified Workaround ( getCurrentDirectory )@@ -57,6 +58,7 @@ import qualified System.FilePath.Posix as FilePath ( normalise ) import qualified System.FilePath as NativeFilePath ( takeFileName, takeDirectory ) import qualified Darcs.Patch.FileName as PatchFileName ( FileName, fp2fn, fn2fp )+import System.Posix.Files ( isDirectory, getSymbolicLinkStatus ) #include "impossible.h" class FilePathOrURL a where@@ -123,10 +125,19 @@ | isRelative x = Just $ SubPath $ FilePath.normalise $ pathToPosix x | otherwise = Nothing +-- | Ensure directory exists and is not a symbolic link.+doesDirectoryReallyExist :: FilePath -> IO Bool+doesDirectoryReallyExist f = do+ x <- tryJust (\x -> if isDoesNotExistError x then Just () else Nothing) $+ isDirectory <$> getSymbolicLinkStatus f+ return $ case x of+ Left () -> False+ Right y -> y+ -- | Interpret a possibly relative path wrt the current working directory. ioAbsolute :: FilePath -> IO AbsolutePath ioAbsolute dir =- do isdir <- doesDirectoryExist dir+ do isdir <- doesDirectoryReallyExist dir here <- getCurrentDirectory if isdir then bracket (setCurrentDirectory dir)
src/Darcs/Repository.hs view
@@ -16,27 +16,28 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP, ScopedTypeVariables #-} #include "gadts.h" module Darcs.Repository- ( Repository, HashedDir(..), Cache(..), CacheLoc(..), WritableOrNot(..), ($-), maybeIdentifyRepository, identifyRepositoryFor+ ( Repository, HashedDir(..), Cache(..), CacheLoc(..), WritableOrNot(..)+ , RepoJob(..), maybeIdentifyRepository, identifyRepositoryFor , withRepoLock, withRepoReadLock, withRepository, withRepositoryDirectory , withGutsOf, makePatchLazy, writePatchSet, findRepository, amInRepository- , amNotInRepository, replacePristine+ , amNotInRepository, amInHashedRepository, replacePristine , withRecorded, readRepo, prefsUrl , addToPending, tentativelyAddPatch, tentativelyRemovePatches , tentativelyAddToPending, tentativelyReplacePatches, readTentativeRepo , tentativelyMergePatches, considerMergeToWorking, revertRepositoryChanges , finalizeRepositoryChanges, createRepository, copyRepository- , copyOldrepoPatches, patchSetToRepository, unrevertUrl, applyToWorking+ , patchSetToRepository, unrevertUrl, applyToWorking , patchSetToPatches, createPristineDirectoryTree , createPartialsPristineDirectoryTree, optimizeInventory, cleanRepository- , getMarkedupFile, PatchSet, SealedPatchSet, PatchInfoAnd- , setScriptsExecutable, checkUnrelatedRepos, testTentative, testRecorded- , extractOptions, modifyCache+ , PatchSet, SealedPatchSet, PatchInfoAnd+ , setScriptsExecutable, setScriptsExecutablePatches+ , checkUnrelatedRepos, testTentative, testRecorded+ , extractOptions, modifyCache, reportBadSources -- * Recorded and unrecorded and pending. , readRecorded, readUnrecorded, unrecordedChanges, readPending , readRecordedAndPending@@ -45,17 +46,18 @@ ) where import System.Exit ( ExitCode(..), exitWith )-import Data.List ( isSuffixOf )-import Data.Maybe( catMaybes )+import Data.List ( isPrefixOf )+import Data.Maybe( catMaybes, isJust ) import Darcs.Repository.State( readRecorded, readUnrecorded, readWorking, unrecordedChanges , readPending, readIndex, invalidateIndex , readRecordedAndPending ) import Darcs.Repository.Internal- (Repository(..), RepoType(..), ($-),- maybeIdentifyRepository, identifyRepositoryFor, IdentifyRepo(..),- findRepository, amInRepository, amNotInRepository,+ (Repository(..), RepoType(..), RepoJob(..),+ maybeIdentifyRepository, identifyRepositoryFor, identifyDarcsRepository,+ IdentifyRepo(..),+ findRepository, amInRepository, amNotInRepository, amInHashedRepository, makePatchLazy, withRecorded, readRepo, readTentativeRepo,@@ -68,69 +70,76 @@ applyToWorking, patchSetToPatches, createPristineDirectoryTree, createPartialsPristineDirectoryTree, optimizeInventory, cleanRepository,- getMarkedupFile,- setScriptsExecutable,+ setScriptsExecutable, setScriptsExecutablePatches, testTentative, testRecorded,- makeNewPending+ makeNewPending, seekRepo ) import Darcs.Repository.Merge( tentativelyMergePatches, considerMergeToWorking ) import Darcs.Repository.Cache ( unionRemoteCaches, fetchFileUsingCache,- speculateFileUsingCache, HashedDir(..), Cache(..), CacheLoc(..), WritableOrNot(..))+ speculateFileUsingCache, HashedDir(..), Cache(..),+ CacheLoc(..), WritableOrNot(..), hashedDir ,+ CacheType(Directory), reportBadSources ) import Darcs.Patch.Set ( PatchSet(..), SealedPatchSet, newset2RL, newset2FL, progressPatchSet ) #ifdef GADT_WITNESSES import Darcs.Patch.Set ( Origin ) #endif import URL ( maxPipelineLength ) -import Control.Applicative ( (<$>) )+import Control.Exception ( finally )+import Control.Concurrent ( forkIO )+import Control.Concurrent.MVar ( MVar, newMVar, putMVar, takeMVar ) import Control.Monad ( unless, when )-import System.Directory ( createDirectory, renameDirectory,- createDirectoryIfMissing, renameFile )+import System.Directory ( createDirectory, createDirectoryIfMissing, renameFile,+ doesFileExist, removeFile, getDirectoryContents,+ getCurrentDirectory, setCurrentDirectory )+import System.IO ( stderr ) import System.IO.Error ( isAlreadyExistsError )+import System.Posix.Files ( createLink ) -import qualified Darcs.Repository.DarcsRepo as DarcsRepo import qualified Darcs.Repository.HashedRepo as HashedRepo -import Darcs.Hopefully ( PatchInfoAnd, info, extractHash )-import Darcs.Repository.Checkpoint ( identifyCheckpoint, writeCheckpointPatch, getCheckpoint )+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, extractHash ) import Darcs.Repository.ApplyPatches ( applyPatches ) import Darcs.Repository.HashedRepo ( applyToTentativePristine, pris2inv, revertTentativeChanges, copySources )-import Darcs.Repository.InternalTypes ( Pristine(..), extractOptions, modifyCache )-import Darcs.Patch ( RepoPatch, Named, Prim, Patch, patch2patchinfo, apply )+import Darcs.Repository.InternalTypes ( extractOptions, modifyCache )+import Darcs.Patch ( RepoPatch, PrimOf )+ import Darcs.Witnesses.Ordered ( FL(..), RL(..), bunchFL, mapFL, mapRL- , reverseRL ,lengthRL, (+>+), (:\/:)(..) )-import Darcs.Patch.Info ( PatchInfo )+ , lengthRL, (+>+), (:\/:)(..) ) import Darcs.Repository.Format ( RepoProperty ( HashedInventory ), RepoFormat,- createRepoFormat, formatHas, writeRepoFormat )+ createRepoFormat, formatHas, writeRepoFormat,+ readfromAndWritetoProblem) import Darcs.Repository.Prefs ( writeDefaultPrefs )-import Darcs.Repository.Pristine ( createPristine, flagsToPristine, createPristineFromWorking )-import Darcs.Patch.Depends ( getPatchesBeyondTag, areUnrelatedRepos, findUncommon )+import Darcs.Patch.Depends ( areUnrelatedRepos, findUncommon ) -import Darcs.Utils ( withCurrentDirectory, catchall, promptYorn, prettyError )+import Darcs.Utils ( withCurrentDirectory, catchall, promptYorn ) import Darcs.External ( copyFileOrUrl, Cachable(..), fetchFileLazyPS ) import Progress ( debugMessage, tediousSize, beginTedious, endTedious ) import Darcs.ProgressPatches (progressRLShowTags, progressFL)-import Darcs.Lock ( writeBinFile, writeDocBinFile, rmRecursive, withTemp )-import Darcs.Witnesses.Sealed ( Sealed(..), FlippedSeal(..), flipSeal, mapFlipped )+import Darcs.Lock ( writeBinFile, writeDocBinFile, withTemp )+import Darcs.Witnesses.Sealed ( Sealed(..) ) -import Darcs.Flags ( DarcsFlag( Quiet, Partial, Lazy, Ephemeral, Complete,- AllowUnrelatedRepos, NoUpdateWorking )- , compression )+import Darcs.Flags ( DarcsFlag( Verbose, Quiet, Lazy, Complete,+ AllowUnrelatedRepos, NoUpdateWorking)+ , compression, UseIndex(..), ScanKnown(..), remoteDarcs+ , usePacks ) import Darcs.Global ( darcsdir ) import Darcs.URL ( isFile )+import Darcs.SignalHandler ( catchInterrupt )+import Printer ( Doc, text, hPutDocLn, putDocLn ) import Storage.Hashed.Tree( Tree, emptyTree ) import Storage.Hashed.Hash( encodeBase16 ) import Storage.Hashed.Darcs( writeDarcsHashed, darcsAddMissingHashes )-import Storage.Hashed( writePlainTree ) import ByteStringUtils( gzReadFilePS ) -import System.FilePath( (</>) )+import System.FilePath( (</>), takeFileName, splitPath, joinPath+ , takeDirectory ) import qualified Codec.Archive.Tar as Tar import Codec.Compression.GZip ( compress, decompress ) import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BL #include "impossible.h" @@ -140,25 +149,19 @@ (\e-> if isAlreadyExistsError e then fail "Tree has already been initialized!" else fail $ "Error creating directory `"++darcsdir++"'.")+ cwd <- getCurrentDirectory+ x <- seekRepo+ when (isJust x) $ do+ setCurrentDirectory cwd+ putStrLn $ "WARNING: creating a nested repository." let rf = createRepoFormat opts- createPristine $ flagsToPristine opts rf+ createDirectory $ darcsdir ++ "/pristine.hashed" createDirectory $ darcsdir ++ "/patches" createDirectory $ darcsdir ++ "/prefs" writeDefaultPrefs writeRepoFormat rf (darcsdir++"/format")- if formatHas HashedInventory rf- then writeBinFile (darcsdir++"/hashed_inventory") ""- else DarcsRepo.writeInventory "." (PatchSet NilRL NilRL :: PatchSet Patch C(Origin Origin)) -- YUCK!--copyRepository :: RepoPatch p => Repository p C(r u t) -> IO ()-copyRepository fromrepository@(Repo _ opts rf _)- | Partial `elem` opts && not (formatHas HashedInventory rf) =- do isPartial <- copyPartialRepository fromrepository- unless (isPartial == IsPartial) $ copyFullRepository fromrepository- | otherwise = copyFullRepository fromrepository--data PorNP = NotPartial | IsPartial- deriving ( Eq )+ writeBinFile (darcsdir++"/hashed_inventory") ""+ writePristine "." emptyTree data RepoSort = Hashed | Old @@ -170,19 +173,18 @@ copyInventory :: forall p C(r u t). RepoPatch p => Repository p C(r u t) -> IO () copyInventory fromRepo@(Repo fromDir opts fromFormat (DarcsRepository _ fromCache)) = do toRepo@(Repo toDir opts' toFormat (DarcsRepository toPristine toCache)) <-- identifyRepositoryFor fromRepo "."+ identifyDarcsRepository opts "."+ let (_ :: Repository p C(r u t)) = toRepo --The witnesses are wrong, but cannot escape+ case readfromAndWritetoProblem fromFormat toFormat of+ Just e -> fail $ "Incompatibility with repository " ++ fromDir ++ ":\n" ++ e+ Nothing -> return () toCache2 <- unionRemoteCaches toCache fromCache fromDir let toRepo2 :: Repository p C(r u t) toRepo2 = Repo toDir opts' toFormat $ DarcsRepository toPristine toCache2- copyHashedHashed = HashedRepo.copyRepo toRepo2 opts fromDir- copyAnyToOld r = withCurrentDirectory toDir $ readRepo r >>=- DarcsRepo.writeInventoryAndPatches opts+ copyHashedHashed = HashedRepo.copyRepo toRepo2 (remoteDarcs opts) fromDir case repoSort fromFormat of- Hashed -> case repoSort toFormat of- Hashed -> copyHashedHashed- Old -> copyAnyToOld fromRepo- Old -> case repoSort toFormat of- Hashed -> withCurrentDirectory toDir $ do+ Hashed -> copyHashedHashed+ Old -> withCurrentDirectory toDir $ do HashedRepo.revertTentativeChanges patches <- readRepo fromRepo let k = "Copying patch"@@ -192,99 +194,64 @@ HashedRepo.writeTentativeInventory toCache (compression opts) patches' endTedious k HashedRepo.finalizeTentativeChanges toRepo $ compression opts- Old -> copyOldrepoPatches opts fromRepo toDir -copyOldrepoPatches :: RepoPatch p => [DarcsFlag] -> Repository p C(r u t) -> FilePath -> IO ()-copyOldrepoPatches opts repository@(Repo dir _ _ _) out = do- Sealed patches <- DarcsRepo.readRepo opts "." :: IO (SealedPatchSet Patch C(Origin))- mpi <- if Partial `elem` opts- -- FIXME this should get last pinfo *before*- -- desired tag...- then identifyCheckpoint repository- else return Nothing- FlippedSeal scp <- return $ since_checkpoint mpi $ newset2RL patches- DarcsRepo.copyPatches opts dir out $ mapRL info $ scp- where since_checkpoint :: Maybe PatchInfo- -> RL (PatchInfoAnd p) C(x y) -> FlippedSeal (RL (PatchInfoAnd p)) C(y)- since_checkpoint Nothing ps = flipSeal ps- since_checkpoint (Just ch) (hp:<:ps)- | ch == info hp = flipSeal $ hp :<: NilRL- | otherwise = (hp :<:) `mapFlipped` since_checkpoint (Just ch) ps- since_checkpoint _ NilRL = flipSeal NilRL--copyPartialRepository :: forall p C(r u t). RepoPatch p => Repository p C(r u t) -> IO PorNP-copyPartialRepository fromrepository@(Repo _ opts _ _) = do- mch <- getCheckpoint fromrepository :: IO (Maybe (Sealed (Named p C(x))))- case mch of- Nothing -> do putStrLn "No checkpoint."- return NotPartial- Just (Sealed ch) ->- do copyInventory fromrepository- withRepoLock opts $- \torepository -> do- writeCheckpointPatch ch- local_patches <- readRepo torepository- let pi_ch = patch2patchinfo ch- FlippedSeal ps <- return $ getPatchesBeyondTag pi_ch local_patches- let needed_patches = reverseRL ps- apply opts ch `catch`- \e -> fail ("Bad checkpoint!\n" ++ prettyError e)- applyPatches opts needed_patches- debugMessage "Writing the pristine"- pristineFromWorking torepository- return IsPartial--copyFullRepository :: forall p C(r u t). RepoPatch p => Repository p C(r u t) -> IO ()-copyFullRepository fromRepo@(Repo fromDir opts _ _) = do+copyRepository :: forall p C(r u t). RepoPatch p => Repository p C(r u t) -> IO ()+copyRepository fromRepo@(Repo fromDir opts _ _) = do debugMessage "Copying prefs"- copyFileOrUrl opts (fromDir ++ "/" ++ darcsdir ++ "/prefs/prefs")+ copyFileOrUrl (remoteDarcs opts) (fromDir ++ "/" ++ darcsdir ++ "/prefs/prefs") (darcsdir ++ "/prefs/prefs") (MaxAge 600) `catchall` return ()- if True -- isFile fromDir -- packs disabled for darcs 2.5- then copyNotPackedRepository fromRepo- else do- b <- (Just <$> fetchFileLazyPS (fromDir ++ "/" ++ darcsdir ++- "/packs/basic.tar.gz") Uncachable) `catchall` return Nothing- case b of- Nothing -> copyNotPackedRepository fromRepo- Just b' -> copyPackedRepository fromRepo b'+ -- try packs for remote repositories+ if (not . isFile) fromDir && usePacks opts+ then copyPackedRepository fromRepo+ else copyNotPackedRepository fromRepo +putInfo :: [DarcsFlag] -> Doc -> IO ()+putInfo opts = unless (Quiet `elem` opts) . hPutDocLn stderr+ copyNotPackedRepository :: forall p C(r u t). RepoPatch p => Repository p C(r u t) -> IO () copyNotPackedRepository fromrepository@(Repo _ opts rffrom _) = do copyInventory fromrepository debugMessage "Grabbing lock in new repository..."- withRepoLock opts $- \torepository@(Repo _ _ rfto _) ->- if formatHas HashedInventory rffrom && formatHas HashedInventory rfto+ withRepoLock opts $ RepoJob $ \torepository ->+ if formatHas HashedInventory rffrom then do debugMessage "Writing working directory contents..." createPristineDirectoryTree torepository "."- fetchPatchesIfNecessary opts torepository- when (Partial `elem` opts) $ putStrLn $- "--partial: hashed or darcs-2 repository detected, using --lazy instead"- else if formatHas HashedInventory rfto- then do local_patches <- readRepo torepository+ fetchPatchesIfNecessary opts torepository `catchInterrupt`+ (putInfo opts $ text "Using lazy repository.")+ else do local_patches <- readRepo torepository replacePristine torepository emptyTree let patchesToApply = progressFL "Applying patch" $ newset2FL local_patches- sequence_ $ mapFL (applyToTentativePristine opts) $ bunchFL 100 patchesToApply+ sequence_ $ mapFL applyToTentativePristine $ bunchFL 100 patchesToApply finalizeRepositoryChanges torepository debugMessage "Writing working directory contents..." createPristineDirectoryTree torepository "."- else do readRepo torepository >>= (applyPatches opts . newset2FL)- debugMessage "Writing the pristine"- pristineFromWorking torepository copyPackedRepository :: forall p C(r u t). RepoPatch p =>- Repository p C(r u t) -> BL.ByteString -> IO ()-copyPackedRepository fromRepo@(Repo fromDir opts _ (DarcsRepository _ fromCache)) b = do+ Repository p C(r u t) -> IO ()+copyPackedRepository r =+ -- fallback to no-packs get in case of error+ copyPackedRepository2 r `catchall` copyNotPackedRepository r++copyPackedRepository2 :: forall p C(r u t). RepoPatch p =>+ Repository p C(r u t) -> IO ()+copyPackedRepository2 fromRepo@(Repo fromDir opts _ (DarcsRepository _ fromCache)) = do+ b <- fetchFileLazyPS (fromDir ++ "/" ++ darcsdir ++ "/packs/basic.tar.gz") Uncachable+ when (Verbose `elem` opts) $ putDocLn $ text "Getting packed repository." Repo toDir _ toFormat (DarcsRepository toPristine toCache) <- identifyRepositoryFor fromRepo "." toCache2 <- unionRemoteCaches toCache fromCache fromDir let toRepo :: Repository p C(r u r) -- In empty repo, t(entative) = r(ecorded) toRepo = Repo toDir opts toFormat $ DarcsRepository toPristine toCache2 fromPacksDir = fromDir ++ "/" ++ darcsdir ++ "/packs/"- createDirectoryIfMissing False $ toDir </> darcsdir </> "inventories"- createDirectoryIfMissing False $ toDir </> darcsdir </> "pristine.hashed"- createDirectoryIfMissing False $ toDir </> darcsdir </> "patches"+ createDirectoryIfMissing False $ darcsdir </> "inventories" copySources toRepo fromDir+ Repo _ _ _ (DarcsRepository _ toCache3) <-+ identifyRepositoryFor toRepo "." -- unpack inventory & pristine cache- writeCompressed . Tar.read $ decompress b+ let isLazy = Lazy `elem` opts+ cleanDir "pristine.hashed"+ removeFile $ darcsdir </> "hashed_inventory"+ unpackBasic toCache3 . Tar.read $ decompress b createPristineDirectoryTree toRepo "." -- pull new patches us <- readRepo toRepo@@ -295,43 +262,145 @@ invalidateIndex toRepo withGutsOf toRepo $ do finalizeRepositoryChanges toRepo- applyToWorking toRepo opts pw+ _ <- applyToWorking toRepo opts pw return () -- get old patches- unless (any (`elem` opts) [Partial, Lazy, Ephemeral]) $ do- putInfo "Copying patches, to get lazy repository hit ctrl-C..."- writeCompressed . Tar.read . decompress =<< fetchFileLazyPS (fromPacksDir +++ unless isLazy $ (do+ cleanDir "patches"+ putInfo opts $ text "Copying patches, to get lazy repository hit ctrl-C..."+ unpackPatches toCache3 (mapFL hashedPatchFileName $ newset2FL us) .+ Tar.read . decompress =<< fetchFileLazyPS (fromPacksDir ++ "patches.tar.gz") Uncachable+ ) `catchInterrupt` (putInfo opts $ text "Using lazy repository.") where- writeCompressed Tar.Done = return ()- writeCompressed (Tar.Next x xs) = case Tar.entryContent x of- Tar.NormalFile x' _ -> do- let p = Tar.entryPath x- withTemp $ \p' -> do- BL.writeFile p' $ if "hashed_inventory" `isSuffixOf` p- then x'- else compress x'- renameFile p' p- writeCompressed xs- _ -> fail "Unexpected non-file tar entry"- writeCompressed (Tar.Fail e) = fail e- putInfo = when (not $ Quiet `elem` opts) . putStrLn+ cleanDir d = mapM_ (\x -> removeFile $ darcsdir </> d </> x) .+ filter (\x -> head x /= '.') =<< getDirectoryContents (darcsdir </> d) +withControlMVar :: (MVar () -> IO ()) -> IO ()+withControlMVar f = do+ mv <- newMVar ()+ f mv+ takeMVar mv++forkWithControlMVar :: MVar () -> IO () -> IO ()+forkWithControlMVar mv f = do+ takeMVar mv+ _ <- forkIO $ flip finally (putMVar mv ()) f+ return ()++removeMetaFiles :: IO ()+removeMetaFiles = mapM_ (removeFile . (darcsdir </>)) .+ filter ("meta-" `isPrefixOf`) =<< getDirectoryContents darcsdir++unpackBasic :: Cache -> Tar.Entries -> IO ()+unpackBasic c x = do+ withControlMVar $ \mv -> unpackTar c (basicMetaHandler c mv) x+ removeMetaFiles++unpackPatches :: Cache -> [String] -> Tar.Entries -> IO ()+unpackPatches c ps x = do+ withControlMVar $ \mv -> unpackTar c (patchesMetaHandler c ps mv) x+ removeMetaFiles++unpackTar :: Cache -> IO () -> Tar.Entries -> IO ()+unpackTar _ _ Tar.Done = return ()+unpackTar _ _ (Tar.Fail e)= fail e+unpackTar c mh (Tar.Next x xs) = case Tar.entryContent x of+ Tar.NormalFile x' _ -> do+ let p = Tar.entryPath x+ if "meta-" `isPrefixOf` takeFileName p+ then do+ BL.writeFile p x'+ mh+ unpackTar c mh xs+ else do+ ex <- doesFileExist p+ if ex+ then debugMessage $ "Tar thread: STOP " ++ p+ else do+ if p == darcsdir </> "hashed_inventory"+ then writeFile' Nothing p x'+ else writeFile' (cacheDir c) p $ compress x'+ debugMessage $ "Tar thread: GET " ++ p+ unpackTar c mh xs+ _ -> fail "Unexpected non-file tar entry"+ where+ writeFile' Nothing z y = withTemp $ \x' -> do+ BL.writeFile x' y+ renameFile x' z+ writeFile' (Just ca) z y = do+ let x' = joinPath . tail $ splitPath z -- drop darcsdir+ ex <- doesFileExist $ ca </> x'+ if ex+ then createLink' (ca </> x') z+ else withTemp $ \x'' -> do+ BL.writeFile x'' y+ createLink' x'' $ ca </> x'+ renameFile x'' z+ createLink' z y = do+ createDirectoryIfMissing True $ takeDirectory y+ createLink z y `catchall` return ()++basicMetaHandler :: Cache -> MVar () -> IO ()+basicMetaHandler ca mv = do+ ex <- doesFileExist $ darcsdir </> "meta-filelist-pristine"+ when ex . forkWithControlMVar mv $+ fetchFilesUsingCache ca HashedPristineDir . lines =<<+ readFile (darcsdir </> "meta-filelist-pristine")+ return ()++patchesMetaHandler :: Cache -> [String] -> MVar () -> IO ()+patchesMetaHandler ca ps mv = do+ ex <- doesFileExist $ darcsdir </> "meta-filelist-inventories"+ when ex $ do+ forkWithControlMVar mv $ fetchFilesUsingCache ca HashedPristineDir .+ lines =<< readFile (darcsdir </> "meta-filelist-inventories")+ forkWithControlMVar mv $ fetchFilesUsingCache ca HashedPatchesDir ps+ return ()++cacheDir :: Cache -> Maybe String+cacheDir (Ca cs) = safeHead . catMaybes .flip map cs $ \x -> case x of+ Cache Directory Writable x' -> Just x'+ _ -> Nothing++safeHead :: [a] -> Maybe a+safeHead [] = Nothing+safeHead (x:_) = Just x++hashedPatchFileName :: PatchInfoAnd p C(a b) -> String+hashedPatchFileName x = case extractHash x of+ Left _ -> fail "unexpected unhashed patch"+ Right h -> h+ +-- | fetchFilesUsingCache is similar to mapM fetchFileUsingCache, exepts+-- it stops execution if file it's going to fetch already exists.+fetchFilesUsingCache :: Cache -> HashedDir -> [FilePath] -> IO ()+fetchFilesUsingCache _ _ [] = return ()+fetchFilesUsingCache c d (f:fs) = do+ ex <- doesFileExist $ darcsdir </> hashedDir d </> f+ if ex+ then debugMessage $ "Cache thread: STOP " +++ (darcsdir </> hashedDir d </> f)+ else do+ debugMessage $ "Cache thread: GET " +++ (darcsdir </> hashedDir d </> f)+-- Warning: A do-notation statement discarded a result of type (String, BS.ByteString).+ _ <- fetchFileUsingCache c d f+ fetchFilesUsingCache c d fs+ -- | writePatchSet is like patchSetToRepository, except that it doesn't -- touch the working directory or pristine cache. writePatchSet :: RepoPatch p => PatchSet p C(Origin x) -> [DarcsFlag] -> IO (Repository p C(r u t)) writePatchSet patchset opts = do maybeRepo <- maybeIdentifyRepository opts "."- let repo@(Repo _ _ rf2 (DarcsRepository _ c)) =+ let repo@(Repo _ _ _ (DarcsRepository _ c)) = case maybeRepo of GoodRepository r -> r BadRepository e -> bug ("Current directory is a bad repository in writePatchSet: " ++ e) NonRepository e -> bug ("Current directory not a repository in writePatchSet: " ++ e) debugMessage "Writing inventory"- if formatHas HashedInventory rf2- then do HashedRepo.writeTentativeInventory c (compression opts) patchset- HashedRepo.finalizeTentativeChanges repo (compression opts)- else DarcsRepo.writeInventoryAndPatches opts patchset+ HashedRepo.writeTentativeInventory c (compression opts) patchset+ HashedRepo.finalizeTentativeChanges repo (compression opts) return repo -- | patchSetToRepository takes a patch set, and writes a new repository in the current directory@@ -345,9 +414,9 @@ when (formatHas HashedInventory rf) $ -- set up sources and all that do writeFile "_darcs/tentative_pristine" "" -- this is hokey repox <- writePatchSet patchset opts- HashedRepo.copyRepo repox opts fromrepo+ HashedRepo.copyRepo repox (remoteDarcs opts) fromrepo repo <- writePatchSet patchset opts- readRepo repo >>= (applyPatches opts . newset2FL)+ readRepo repo >>= (applyPatches . newset2FL) debugMessage "Writing the pristine" pristineFromWorking repo return repo@@ -357,19 +426,19 @@ checkUnrelatedRepos opts _ _ | AllowUnrelatedRepos `elem` opts = return () checkUnrelatedRepos _ us them = if areUnrelatedRepos us them- then do yorn <- promptYorn ("Repositories seem to be unrelated. Proceed?")- when (yorn /= 'y') $ do putStrLn "Cancelled."- exitWith ExitSuccess+ then do confirmed <- promptYorn "Repositories seem to be unrelated. Proceed?"+ unless confirmed $ do putStrLn "Cancelled."+ exitWith ExitSuccess else return () -- | Unless a flag has been given in the first argument that tells darcs not to do so (--lazy,--- --partial or --ephemeral), this function fetches all patches that the given repository has--- with fetchFileUsingCache. This is used as a helper in copyFullRepository.+-- or --partial), this function fetches all patches that the given repository has+-- with fetchFileUsingCache. This is used as a helper in copyRepository. fetchPatchesIfNecessary :: forall p C(r u t). RepoPatch p => [DarcsFlag] -> Repository p C(r u t) -> IO () fetchPatchesIfNecessary opts torepository@(Repo _ _ _ (DarcsRepository _ c)) =- unless (Partial `elem` opts || Lazy `elem` opts || Ephemeral `elem` opts) $+ unless (Lazy `elem` opts) $ do unless (Complete `elem` opts) $- putInfo "Copying patches, to get lazy repository hit ctrl-C..."+ putInfo opts $ text "Copying patches, to get lazy repository hit ctrl-C..." r <- readRepo torepository pipelineLength <- maxPipelineLength let patches = newset2RL r@@ -378,44 +447,34 @@ speculate | pipelineLength > 1 = [] : first : map (:[]) other | otherwise = [] mapM_ fetchAndSpeculate $ zip (hashes ppatches) (speculate ++ repeat [])- where putInfo = when (not $ Quiet `elem` opts) . putStrLn- hashes :: FORALL(x y) RL (PatchInfoAnd p) C(x y) -> [String]+ where hashes :: FORALL(x y) RL (PatchInfoAnd p) C(x y) -> [String] hashes = catMaybes . mapRL ((either (const Nothing) Just) . extractHash) fetchAndSpeculate :: (String, [String]) -> IO () fetchAndSpeculate (f, ss) = do- fetchFileUsingCache c HashedPatchesDir f+-- Warning: A do-notation statement discarded a result of type (String, BS.ByteString).+ _ <- fetchFileUsingCache c HashedPatchesDir f mapM_ (speculateFileUsingCache c HashedPatchesDir) ss -addToPending :: RepoPatch p => Repository p C(r u t) -> FL Prim C(u y) -> IO ()+addToPending :: RepoPatch p => Repository p C(r u t) -> FL (PrimOf p) C(u y) -> IO () addToPending (Repo _ opts _ _) _ | NoUpdateWorking `elem` opts = return ()-addToPending repo@(Repo _ opts _ _) p =- do pend <- unrecordedChanges opts repo []+addToPending repo@(Repo{}) p =+ do pend <- unrecordedChanges (UseIndex, ScanKnown) repo Nothing invalidateIndex repo makeNewPending repo (pend +>+ p) -- | Replace the existing pristine with a new one (loaded up in a Tree object). replacePristine :: Repository p C(r u t) -> Tree IO -> IO ()-replacePristine (Repo r _opts _rf (DarcsRepository pris _c)) tree =- withCurrentDirectory r $ replace pris- where replace HashedPristine =- do let t = darcsdir </> "hashed_inventory"- i <- gzReadFilePS t- tree' <- darcsAddMissingHashes tree- root <- writeDarcsHashed tree' $ darcsdir </> "pristine.hashed"- writeDocBinFile t $ pris2inv (BS.unpack $ encodeBase16 root) i- replace (PlainPristine n) =- do rmRecursive nold `catchall` return ()- writePlainTree tree ntmp- renameDirectory n nold- renameDirectory ntmp n- return ()- replace (NoPristine _) = return ()- nold = darcsdir </> "pristine-old"- ntmp = darcsdir </> "pristine-tmp"+replacePristine (Repo r _ _ _) = writePristine r +writePristine :: FilePath -> Tree IO -> IO ()+writePristine r tree = withCurrentDirectory r $+ do let t = darcsdir </> "hashed_inventory"+ i <- gzReadFilePS t+ tree' <- darcsAddMissingHashes tree+ root <- writeDarcsHashed tree' $ darcsdir </> "pristine.hashed"+ writeDocBinFile t $ pris2inv (BS.unpack $ encodeBase16 root) i+ pristineFromWorking :: RepoPatch p => Repository p C(r u t) -> IO ()-pristineFromWorking repo@(Repo dir _ rf _)- | formatHas HashedInventory rf =- withCurrentDirectory dir $ readWorking >>= replacePristine repo-pristineFromWorking (Repo dir _ _ (DarcsRepository p _)) =- withCurrentDirectory dir $ createPristineFromWorking p+pristineFromWorking repo@(Repo dir _ _ _) =+ withCurrentDirectory dir $ readWorking >>= replacePristine repo+
src/Darcs/Repository/ApplyPatches.hs view
@@ -15,36 +15,24 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} #include "gadts.h" -module Darcs.Repository.ApplyPatches ( applyPatches, applyPatchesWithFeedback ) where+module Darcs.Repository.ApplyPatches ( applyPatches ) where +import Darcs.Patch.ApplyMonad( ApplyMonad )+import Darcs.MonadProgress ( MonadProgress, ProgressAction(..), runProgressActions) import Darcs.Patch ( Patchy, apply )-import Darcs.Hopefully ( PatchInfoAnd, hopefully, info )+import Darcs.IO () -- for ApplyMonad IO+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, hopefully, info ) import Darcs.Patch.Info ( humanFriendly )-import Darcs.Witnesses.Ordered ( FL(..), lengthFL, mapFL )-import Darcs.Flags ( DarcsFlag )-import Darcs.Utils ( putDocLnError )-import Progress ( beginTedious, endTedious, tediousSize, finishedOneIO )-import Printer ( text )--applyPatchesWithFeedback :: Patchy p => [DarcsFlag] -> String -> FL (PatchInfoAnd p) C(x y) -> IO ()-applyPatchesWithFeedback _ _ NilFL = return ()-applyPatchesWithFeedback opts k patches =- do beginTedious k- tediousSize k (lengthFL patches)- sequence_ $ mapFL apply_cautiously patches- endTedious k- where apply_cautiously :: Patchy p => PatchInfoAnd p C(a b) -> IO ()- apply_cautiously hp =- do finishedOneIO k (show $ humanFriendly $ info hp)- apply opts (hopefully hp) `catch` \e ->- do putDocLnError $ text "Unapplicable patch:"- putDocLnError $ humanFriendly (info hp)- ioError e+import Darcs.Witnesses.Ordered ( FL(..), mapFL )+import Printer ( text, ($$) ) -applyPatches :: Patchy p => [DarcsFlag] -> FL (PatchInfoAnd p) C(x y) -> IO ()-applyPatches opts ps = applyPatchesWithFeedback opts "Applying patch" ps+applyPatches :: (MonadProgress m, ApplyMonad m, Patchy p) => FL (PatchInfoAnd p) C(x y) -> m ()+applyPatches ps = runProgressActions "Applying patch" (mapFL doApply ps)+ where doApply hp =+ ProgressAction { paAction = apply (hopefully hp)+ , paMessage = humanFriendly (info hp)+ , paOnError = text "Unapplicable patch:" $$ humanFriendly (info hp) }
src/Darcs/Repository/Cache.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP #-} #include "gadts.h"@@ -12,12 +11,13 @@ writeFileUsingCache, peekInCache, repo2cache,- writable, isthisrepo, hashedFilePath, allHashedDirs, compareByLocality+ writable, isthisrepo, hashedFilePath, allHashedDirs, compareByLocality,+ reportBadSources ) where -import Control.Monad ( liftM, when, guard, unless, filterM, forM_ )-import Data.List ( nub )-import Data.Maybe ( catMaybes, listToMaybe )+import Control.Monad ( liftM, when, guard, unless, filterM, forM_, mplus )+import Data.List ( nub, intercalate )+import Data.Maybe ( catMaybes, listToMaybe, isJust, fromMaybe ) import System.Directory ( removeFile, doesFileExist, doesDirectoryExist, getDirectoryContents, getPermissions ) import qualified System.Directory as SD ( writable )@@ -32,16 +32,22 @@ import SHA1 ( sha1PS ) import System.Posix.Files ( createLink )+import System.FilePath.Posix ( (</>) ) import System.Directory ( createDirectoryIfMissing ) import Darcs.External ( gzFetchFilePS, fetchFilePS, speculateFileOrUrl, copyFileOrUrl, Cachable( Cachable ) )-import Darcs.Flags ( Compression( .. ) )-import Darcs.Global ( darcsdir )-import Darcs.Lock ( writeAtomicFilePS, gzWriteAtomicFilePS )+import Darcs.Flags ( Compression( .. ), RemoteDarcs(..) )+import Darcs.Global ( darcsdir, addBadSource, isBadSource,+ addReachableSource, isReachableSource,+ getBadSourcesList )+import Darcs.Lock ( writeAtomicFilePS, gzWriteAtomicFilePS, withTemp ) import Progress ( progressList, debugMessage, debugFail )-import Darcs.URL ( isFile, isUrl, isSsh )+import English ( englishNum, Noun(..), Pronoun(..) )+import Darcs.URL ( isFile, isHttpUrl, isSshUrl ) import Darcs.Utils ( withCurrentDirectory, catchall )+import Darcs.SignalHandler ( catchNonSignal )+import qualified HTTP ( ConnectionError(..) ) data HashedDir = HashedPristineDir | HashedPatchesDir | HashedInventoriesDir hashedDir :: HashedDir -> String@@ -54,7 +60,7 @@ data WritableOrNot = Writable | NotWritable deriving ( Show ) data CacheType = Repo | Directory deriving ( Eq, Show )-data CacheLoc = Cache !CacheType !WritableOrNot !String+data CacheLoc = Cache { cacheType:: !CacheType, cacheWritable:: !WritableOrNot, cacheSource:: !String } newtype Cache = Ca [CacheLoc] -- abstract type for hiding cache instance Eq CacheLoc where@@ -113,11 +119,11 @@ compareByLocality (Cache _ _ x) (Cache _ _ y) | isLocal x && isRemote y = LT | isRemote x && isLocal y = GT- | isUrl x && isSsh y = LT- | isSsh x && isUrl y = GT+ | isHttpUrl x && isSshUrl y = LT+ | isSshUrl x && isHttpUrl y = GT | otherwise = EQ where- isRemote r= isUrl r || isSsh r+ isRemote r= isHttpUrl r || isSshUrl r isLocal = isFile repo2cache :: String -> Cache@@ -145,7 +151,11 @@ | length h == 75 = B.length s == read (take 10 h) && sha256sum s == drop 11 h | otherwise = False -+-- |@fetchFileUsingCache cache dir hash@ receives a list of caches+-- @cache@, the directory for which that file belongs @dir@ and the+-- @hash@ of the file to fetch. It tries to fetch the file from one+-- of the sources, trying them in order one by one. If the file+-- cannot be fetched from any of the sources, this operation fails. fetchFileUsingCache :: Cache -> HashedDir -> String -> IO (String, B.ByteString) fetchFileUsingCache = fetchFileUsingCachePrivate Anywhere @@ -195,12 +205,15 @@ data OrOnlySpeculate = ActuallyCopy | OnlySpeculate deriving ( Eq ) +-- | @copyFileUsingCache oos cache subdir f@ copy or hardlinks the+-- file @f@ to one of the caches in @cache@,usually the global cache.+-- If a writable cache doesn't exist the function will fail. copyFileUsingCache :: OrOnlySpeculate -> Cache -> HashedDir -> String -> IO () copyFileUsingCache oos (Ca cache) subdir f = do debugMessage $ "I'm doing copyFileUsingCache on "++(hashedDir subdir)++"/"++f Just stickItHere <- cacheLoc cache createDirectoryIfMissing False (reverse $ dropWhile (/='/') $ reverse stickItHere)- sfuc cache stickItHere+ filterBadSources cache >>= (flip sfuc) stickItHere `catchall` return () where cacheLoc [] = return Nothing cacheLoc (c:cs) | not $ writable c = cacheLoc cs@@ -208,14 +221,14 @@ do ex <- doesFileExist $ fn c if ex then fail "Bug in darcs: This exception should be caught in speculateFileUsingCache" else do othercache <- cacheLoc cs- case othercache of Just x -> return $ Just x- Nothing -> return $ Just (fn c)+ return $ othercache `mplus` Just (fn c) sfuc [] _ = return ()- sfuc (c:cs) out | not $ writable c =+ sfuc (c:cs) out+ | not (writable c) = if oos == OnlySpeculate- then speculateFileOrUrl (fn c) out- else copyFileOrUrl [] (fn c) out Cachable- | otherwise = sfuc cs out+ then speculateFileOrUrl (fn c) out `catchNonSignal` (\e -> checkCacheReachability (show e) c)+ else copyFileOrUrl DefaultRemoteDarcs (fn c) out Cachable `catchNonSignal` (\e -> checkCacheReachability (show e) c)+ | otherwise = sfuc cs out fn c = hashedFilePath c subdir f copyFilesUsingCache :: OrOnlySpeculate -> Cache -> HashedDir -> [String] -> IO ()@@ -225,11 +238,75 @@ data FromWhere = LocalOnly | Anywhere deriving ( Eq ) +-- | Checks if a given cache entry is reachable or not.+-- It receives an error caught during execution and the cache entry.+-- If the caches is not reachable it is blacklisted and not longer tried for+-- the rest of the session. If it is reachable it is whitelisted and future errors with such+-- cache get ignore.+-- To determine reachability:+-- * For a local cache, if the given source doesn't exist anymore, it is blacklisted.+-- * For remote sources if the error is timeout, it is blacklisted, if not,+-- it checks if _darcs/hashed_inventory exist, if it does, the entry is whitelisted, if+-- it doesn't, it is blacklisted.+checkCacheReachability :: String -> CacheLoc -> IO ()+checkCacheReachability e cache+ | isFile source = do+ reachable <- isReachableSource+ unless (reachable source) $ do+ exist <- doesDirectoryExist source+ if exist+ then+ addReachableSource source+ else+ addBadSource source+ | isHttpUrl source = do+ reachable <- isReachableSource+ unless (reachable source) $ do+ let string = case dropWhile (/='(') e of+ (_:xs) -> fst (break (==')') xs)+ _ -> e+ let cerror = case reads string ::[(HTTP.ConnectionError,String)] of+ [(ce,_)] -> Just ce+ _ -> Nothing+ if isJust cerror+ then addBadSource source+ else checkFileReachability++ | isSshUrl source = do+ reachable <- isReachableSource+ unless (reachable source) checkFileReachability++ | otherwise = fail $ "unknown transport protocol for: " ++ source+ where source = cacheSource cache+ checkFileReachability = do+ reachable <- checkHashedInventoryReachability cache+ if reachable+ then+ addReachableSource source+ else+ addBadSource source++-- | Returns a list of reachables cache entries,+-- taking out the blacklisted entries+filterBadSources :: [CacheLoc] -> IO [CacheLoc]+filterBadSources cache = do+ badSource <- isBadSource+ return $ filter (not . badSource . cacheSource) cache++-- | Checks if the _darcs/hashed_inventory exist and is reachable+checkHashedInventoryReachability :: CacheLoc -> IO Bool+checkHashedInventoryReachability cache =+ withTemp $ \tempout -> do+ let f = cacheSource cache </> darcsdir </> "hashed_inventory"+ copyFileOrUrl DefaultRemoteDarcs f tempout Cachable+ return True+ `catchNonSignal` (\_ -> return False)+ fetchFileUsingCachePrivate :: FromWhere -> Cache -> HashedDir -> String -> IO (String, B.ByteString) fetchFileUsingCachePrivate fromWhere (Ca cache) subdir f = do when (fromWhere == Anywhere) $ copyFileUsingCache ActuallyCopy (Ca cache) subdir f- ffuc cache- `catchall` debugFail ("Couldn't fetch `"++f++"'\nin subdir "++(hashedDir subdir)+++ filterBadSources cache >>= ffuc+ `catchall` debugFail ("Couldn't fetch `"++f++"'\nin subdir "++ hashedDir subdir ++ " from sources:\n\n"++show (Ca cache)) where ffuc (c:cs) | not (writable c) && (Anywhere == fromWhere || isFile (fn c)) =@@ -244,8 +321,11 @@ fail $ "Hash failure in " ++ fn c return (fn c, x') else return (fn c, x) -- FIXME: create links in caches- `catchall` ffuc cs+ `catchNonSignal` (\e -> do+ checkCacheReachability (show e) c+ filterBadSources cs >>= ffuc) + | writable c = do x1 <- gzFetchFilePS (fn c) Cachable x <- if not $ checkHash f x1@@ -258,13 +338,15 @@ else return x1 mapM_ (tryLinking (fn c)) cs return (fn c, x)- `catchall` do (fname,x) <- ffuc cs- do createCache c subdir- createLink fname (fn c)- return (fn c, x)- `catchall`- do gzWriteFilePS (fn c) x `catchall` return ()- return (fname,x)+ `catchNonSignal` (\ e ->+ do createCache c subdir `catchall` return () -- don't worry+ checkCacheReachability (show e) c+ (fname,x) <- filterBadSources cs >>= ffuc+ do createLink fname (fn c)+ return (fn c, x)+ `catchall`+ do gzWriteFilePS (fn c) x `catchall` return ()+ return (fname,x)) | otherwise = ffuc cs ffuc [] = debugFail $ "No sources from which to fetch file `"++f++"'\n"++ show (Ca cache)@@ -316,12 +398,23 @@ where cleanCache (Cache Directory Writable d) = (withCurrentDirectory (d++"/"++(hashedDir subdir)) $ do fs' <- getDirectoryContents "."- let fs = case hint of- Just h -> h- Nothing -> fs'+ let fs = fromMaybe fs' hint mapM_ clean $ progressList ("Cleaning cache "++d++"/"++(hashedDir subdir)) $ filter okayHash fs) `catchall` return () cleanCache _ = return () clean f = do lc <- linkCount `liftM` getSymbolicLinkStatus f when (lc < 2) $ removeFile f `catchall` return ()++-- | Prints an error message with a list of bad caches.+reportBadSources :: IO ()+reportBadSources = do+ sources <- getBadSourcesList+ let size = length sources+ unless (null sources) $ do+ hPutStrLn stderr $+ concat [ "\nHINT: I could not reach the following ", englishNum size (Noun "repository") ":"+ , "\n", (intercalate "\n" (map (" " ++) sources))+ , "\n If you're not using ", englishNum size It ", you should probably delete"+ , "\n the corresponding ", englishNum size (Noun "entry") " from _darcs/prefs/sources."+ ]
− src/Darcs/Repository/Checkpoint.hs
@@ -1,99 +0,0 @@--- Copyright (C) 2002-2005 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.--{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--#include "gadts.h"--module Darcs.Repository.Checkpoint ( getCheckpoint, getCheckpointByDefault,- identifyCheckpoint,- writeCheckpointPatch,- ) where--import System.Directory ( createDirectoryIfMissing )-import Data.Maybe ( listToMaybe )-import Darcs.Hopefully ( PatchInfoAnd, info )-import qualified Data.ByteString as B ( null, empty, ByteString )--import Darcs.Lock ( writeDocBinFile )-import Darcs.Patch ( RepoPatch, Named, patch2patchinfo,- readPatch, gzWritePatch )-import Darcs.Witnesses.Ordered ( mapRL )-import Darcs.Repository.Internal ( Repository(..), readRepo )-import Darcs.Repository.DarcsRepo ( readCheckpoints )-import Darcs.Patch.Info ( PatchInfo, makeFilename, readPatchInfo,- showPatchInfo )-import Darcs.Patch.Set( PatchSet(..), Tagged(..) )-import Darcs.External ( gzFetchFilePS, fetchFilePS, Cachable(..) )-import Darcs.Flags ( DarcsFlag( Partial, Complete ) )-import Darcs.Utils ( catchall )-import Darcs.Global ( darcsdir )-import Printer ( Doc, ($$), empty )-import Darcs.Witnesses.Sealed ( Sealed, Sealed2(Sealed2), seal2 )-import Control.Monad ( liftM )--readPatchIds :: B.ByteString -> [PatchInfo]-readPatchIds inv | B.null inv = []-readPatchIds inv = case readPatchInfo inv of- Just (pinfo,r) -> pinfo : readPatchIds r- Nothing -> []--getCheckpoint :: RepoPatch p => Repository p C(r u t) -> IO (Maybe (Sealed (Named p C(x))))-getCheckpoint repository@(Repo _ opts _ _) = if Partial `elem` opts- then getCheckInternal repository- else return Nothing--getCheckpointByDefault :: RepoPatch p => Repository p C(r u t) -> IO (Maybe (Sealed (Named p C(x))))-getCheckpointByDefault repository@(Repo _ opts _ _) = if Complete `elem` opts- then return Nothing- else getCheckInternal repository--identifyCheckpoint :: RepoPatch p => Repository p C(r u t) -> IO (Maybe PatchInfo)-identifyCheckpoint repository@(Repo r _ _ _) = do- pis <- (map sp2i . extractTags) `liftM` readRepo repository- pistr <- fetchFilePS (r++"/"++darcsdir++"/checkpoints/inventory") Uncachable- `catchall` return B.empty- return $ listToMaybe $ filter (`elem` pis) $ reverse $ readPatchIds pistr- where extractTags :: PatchSet p C(start end) -> [Sealed2 (PatchInfoAnd p)]- extractTags (PatchSet _ ts) = mapRL (\(Tagged t _ _) -> seal2 t) ts- sp2i :: Sealed2 (PatchInfoAnd p) -> PatchInfo- sp2i (Sealed2 p) = info p--getCheckInternal :: RepoPatch p => Repository p C(r u t) -> IO (Maybe (Sealed (Named p C(x))))-getCheckInternal repository@(Repo r _ _ _) = do- mc <- identifyCheckpoint repository- case mc of- Nothing -> return Nothing- Just pinfo -> do ps <- gzFetchFilePS- (r++"/"++darcsdir++"/checkpoints/"++makeFilename pinfo) Cachable- return $ case readPatch ps of- Just (p, _) -> Just p- Nothing -> Nothing--formatInv :: [PatchInfo] -> Doc-formatInv [] = empty-formatInv (pinfo:ps) = showPatchInfo pinfo- $$ formatInv ps--writeCheckpointPatch :: RepoPatch p => Named p C(x y) -> IO ()-writeCheckpointPatch p =- do createDirectoryIfMissing False (darcsdir++"/checkpoints")- gzWritePatch (darcsdir++"/checkpoints/"++makeFilename (patch2patchinfo p)) p- cpi <- readCheckpoints "."- writeDocBinFile (darcsdir++"/checkpoints/inventory")- $ formatInv $ reverse $ patch2patchinfo p:cpi
− src/Darcs/Repository/DarcsRepo.lhs
@@ -1,362 +0,0 @@-% Copyright (C) 2002-2005,2007-2008 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.--\chapter{DarcsRepo format}--A repository consists of a working directory, which has within it a-directory called \verb!_darcs!. There must also be a subdirectory within-\verb!_darcs! named \verb!patches!. The \verb!patches! directory contains-the actual patches which are in the repository. There must also be a-\emph{pristine tree}, which may either be a directory containing a cache of-the version of the tree which has been recorded, or a stub, and may be-named either ``current'' or ``pristine''.--\emph{WARNING!} Viewing files in the pristine cache is perfectly-acceptable, but if you view them with an editor (e.g.\ vi or Emacs), that-editor may create temporary files in the pristine tree-(\verb|_darcs/pristine/| or \verb|_darcs/current/|), which will temporarily-cause your repository to be inconsistent. So \emph{don't record any-patches while viewing files in \_darcs/current with an editor!} A better-plan would be to restrict yourself to viewing these files with a pager such-as more or less.--Also within \verb!_darcs! is the \verb!inventory! file, which lists all the-patches that are in the repository. Moreover, it also gives the order of the-representation of the patches as they are stored. Given a source of patches,-i.e.\ any other set of repositories which have between them all the patches-contained in a given repository, that repository can be reproduced based on only the-information in the \verb!inventory! file. Under those circumstances, the-order of the patches specified in the \verb!inventory! file would be-unimportant, as this order is only needed to provide context for the-interpretation of the stored patches in this repository.--\begin{code}-{-# OPTIONS_GHC -cpp -fglasgow-exts #-}-{-# LANGUAGE CPP, ScopedTypeVariables #-}--#include "gadts.h"--module Darcs.Repository.DarcsRepo ( writeInventory, writeInventoryAndPatches,- addToInventory, addToTentativePristine,- addToTentativeInventory, removeFromTentativeInventory,- finalizeTentativeChanges, finalizePristineChanges,- revertTentativeChanges,- readRepo, readTentativeRepo, writeAndReadPatch,- copyPatches, readCheckpoints- ) where--import System.Directory ( createDirectoryIfMissing )-import Workaround ( renameFile )-import Darcs.Utils ( clarifyErrors )-import Progress ( debugMessage, beginTedious, endTedious, finishedOneIO )-import Darcs.RepoPath ( ioAbsoluteOrRemote, toPath )-import System.IO ( hPutStrLn, stderr )-import System.IO.Unsafe ( unsafeInterleaveIO )-import System.FilePath.Posix ( (</>) )-import Control.Monad ( when )-import Darcs.Hopefully ( Hopefully, PatchInfoAnd,- patchInfoAndPatch, info,- actually, hopefully, unavailable, n2pia )-import Darcs.SignalHandler ( withSignalsBlocked )--import ByteStringUtils ( gzReadFilePS )-import qualified Data.ByteString as B (ByteString, null, readFile, empty)-import qualified Data.ByteString.Char8 as BC (break, pack)--import Darcs.Patch ( RepoPatch, Effect, Prim, Named, invert,- effect,- patch2patchinfo,- readPatch,- showPatch )-import qualified Darcs.Patch as Patch--import Darcs.Witnesses.Ordered ( FL(..), RL(..), (:>>)(..), (+<+),- reverseFL, mapFL, unsafeCoerceP,- reverseRL, mapRL )-import Darcs.Patch.Info ( PatchInfo, makeFilename, readPatchInfo,- showPatchInfo, isTag- )-import Darcs.Patch.Set ( PatchSet(..), Tagged(..), SealedPatchSet, newset2RL )-#ifdef GADT_WITNESSES-import Darcs.Patch.Set ( Origin )-#endif-import Darcs.External ( gzFetchFilePS, fetchFilePS, copyFilesOrUrls, Cachable(..),- cloneFile )-import Darcs.Lock ( writeBinFile, writeDocBinFile, appendDocBinFile, appendBinFile )-import Darcs.Flags ( DarcsFlag( NoCompress ) )-import Darcs.Patch.Depends ( slightlyOptimizePatchset, commuteToEnd, deepOptimizePatchset )-import Darcs.Repository.Pristine ( identifyPristine, applyPristine )-import Darcs.Global ( darcsdir )-import Darcs.Utils ( catchall )-import Darcs.ProgressPatches ( progressFL )-import Printer ( text, (<>), Doc, ($$), empty )-import Darcs.Witnesses.Sealed ( Sealed(Sealed), seal, unseal, mapSeal )--#include "impossible.h"-\end{code}--There is a very special patch which may be stored in \verb!patches! which-is called `pending'. This patch describes any changes which have not yet-been recorded, and cannot be determined by a simple diff. For example, file-additions or renames are placed in pending until they are recorded.-Similarly, token replaces are stored in pending until they are recorded.--\begin{code}-writePatch :: RepoPatch p => [DarcsFlag] -> Named p C(x y) -> IO FilePath-writePatch opts p =- do let writeFun = if NoCompress `elem` opts- then Patch.writePatch- else Patch.gzWritePatch- pname = darcsdir++"/patches/"++makeFilename (patch2patchinfo p)- writeFun pname p- return pname--writeAndReadPatch :: RepoPatch p => [DarcsFlag] -> PatchInfoAnd p C(x y)- -> IO (PatchInfoAnd p C(x y))-writeAndReadPatch opts p =- do fn <- writePatch opts $ hopefully p- unsafeInterleaveIO $ parse fn- where parse fn = do debugMessage ("Reading patch file: "++ fn)- ps <- gzReadFilePS fn- Sealed pp <- case readPatch ps of- Just (x,_) -> return x- Nothing -> fail ("Couldn't parse patch file "++fn)- return $ n2pia $ unsafeCoerceP pp----formatInventory is not exported for use outside of the DarcsRepo module---itself.-formatInventory :: [PatchInfo] -> Doc-formatInventory [] = empty-formatInventory (pinfo:ps) = showPatchInfo pinfo $$ formatInventory ps--writeInventory :: RepoPatch p => FilePath -> PatchSet p C(Origin x) -> IO ()--- Note that writeInventory optimizes the inventory it writes out by--- checking on tag dependencies.--- FIXME: There is also a problem that writeInventory always writes--- out the entire inventory, including the parts that you haven't--- changed...-writeInventory dir ps = withSignalsBlocked $ do- createDirectoryIfMissing False (dir++"/"++darcsdir++"/inventories")- simplyWriteInventory "inventory" dir $ slightlyOptimizePatchset ps--simplyWriteInventory :: RepoPatch p => String -> FilePath -> PatchSet p C(Origin x) -> IO ()-simplyWriteInventory name dir (PatchSet NilRL NilRL) =- writeBinFile (dir++"/"++darcsdir++"/"++name) ""-simplyWriteInventory name dir (PatchSet ps NilRL) = do- writeDocBinFile (dir++"/"++darcsdir++"/"++name) $ formatInventory $ mapFL info $ reverseRL ps-simplyWriteInventory name dir (PatchSet ps ts@(Tagged t _ _ :<: _)) = do -- nonempty Tagged- simplyWriteTaggedInventory dir ts- writeDocBinFile (dir++"/"++darcsdir++"/"++name) $ text "Starting with tag:"- $$ formatInventory (mapFL info $ t :>: reverseRL ps)--simplyWriteTaggedInventory :: RepoPatch p => FilePath -> RL (Tagged p) C(Origin x) -> IO ()-simplyWriteTaggedInventory _ NilRL = return ()-simplyWriteTaggedInventory dir (Tagged t _ ps :<: NilRL) = do- writeDocBinFile (dir </> "_darcs/inventories" </> makeFilename (info t)) $- formatInventory (mapFL info $ reverseRL ps)-simplyWriteTaggedInventory dir (Tagged t _ ps :<: ts@(Tagged t2 _ _ :<: _)) =- do simplyWriteTaggedInventory dir ts- writeDocBinFile (dir </> "_darcs/inventories" </> makeFilename (info t)) $- text "Starting with tag:" $$- formatInventory (mapFL info $ t2 :>: reverseRL ps)--writeInventoryAndPatches :: RepoPatch p => [DarcsFlag] -> PatchSet p C(Origin x) -> IO ()-writeInventoryAndPatches opts ps = do writeInventory "." ps- sequence_ $ mapRL (writePatch opts . hopefully) $ newset2RL ps--addToInventory :: FilePath -> [PatchInfo] -> IO ()-addToInventory dir pinfos =- appendDocBinFile (dir++"/"++darcsdir++"/inventory") $ text "\n" <> pidocs pinfos- where- pidocs [] = text ""- pidocs (p:ps) = showPatchInfo p $$ pidocs ps--addToTentativeInventory :: forall p C(x y). RepoPatch p => [DarcsFlag] -> Named p C(x y) -> IO FilePath-addToTentativeInventory opts p =- do appendDocBinFile (darcsdir++"/tentative_inventory") $ text "\n"- <> showPatchInfo (patch2patchinfo p)- res <- writePatch opts p- when (isTag $ patch2patchinfo p) $- do debugMessage "Optimizing the tentative inventory, since we're adding a tag."- realdir <- toPath `fmap` ioAbsoluteOrRemote "."- let k = "Reading tentative inventory"- beginTedious k- Sealed ps <- readRepoPrivate k realdir "tentative_inventory"- :: IO (SealedPatchSet p C(Origin) )- simplyWriteInventory "tentative_inventory" "." $ slightlyOptimizePatchset ps- return res--addToTentativePristine :: Effect p => p C(x y) -> IO ()-addToTentativePristine p =- do -- Sealed p <- (fst . fromJust . readPatchCarefully) `fmap` gzReadFilePS fp- appendDocBinFile (darcsdir++"/tentative_pristine") $ showPatch (effect p) -- FIXME: this is inefficient!- appendBinFile (darcsdir++"/tentative_pristine") "\n"--removeFromTentativeInventory :: RepoPatch p => Bool -> [DarcsFlag]- -> FL (PatchInfoAnd p) C(x y) -> IO ()-removeFromTentativeInventory update_pristine opts to_remove =- do finalizeTentativeChanges- Sealed allpatches <- readRepo opts "."- unmodified :>> skipped <- return $ commuteToEnd- (reverseFL $ unsafeCoerceP to_remove) allpatches- sequence_ $ mapRL (writePatch opts . hopefully) skipped- let newpatches = case unmodified of- PatchSet ps ts -> PatchSet (skipped+<+ps) ts- writeInventory "." $ deepOptimizePatchset newpatches- when update_pristine $- do pris <- identifyPristine- repairable $ applyPristine pris- $ progressFL "Applying inverse to pristine" $ invert to_remove- revertTentativeChanges--finalizeTentativeChanges :: IO ()-finalizeTentativeChanges = renameFile (darcsdir++"/tentative_inventory") (darcsdir++"/inventory")--finalizePristineChanges :: IO ()-finalizePristineChanges =- do Sealed ps <- read_patches $ darcsdir++"/tentative_pristine"- pris <- identifyPristine- repairable $ applyPristine pris ps- where- read_patches :: String -> IO (Sealed (FL Prim C(x)))- read_patches f = do ps <- B.readFile f- return $ case readPatch ps of- Just (x, _) -> x- Nothing -> seal $ NilFL--repairable :: IO a -> IO a-repairable x = x `clarifyErrors` unlines- ["Your repository is now in an inconsistent state.",- "This must be fixed by running darcs repair."]--revertTentativeChanges :: IO ()-revertTentativeChanges =- do cloneFile (darcsdir++"/inventory") (darcsdir++"/tentative_inventory")- writeBinFile (darcsdir++"/tentative_pristine") ""--copyPatches :: [DarcsFlag] -> FilePath -> FilePath -> [PatchInfo] -> IO ()-copyPatches opts dir out patches = do- realdir <- toPath `fmap` ioAbsoluteOrRemote dir- copyFilesOrUrls opts (realdir++"/"++darcsdir++"/patches") (map makeFilename patches)- (out++"/"++darcsdir++"/patches") Cachable--readRepo :: RepoPatch p => [DarcsFlag] -> String -> IO (SealedPatchSet p C(Origin))-readRepo _ d = do- realdir <- toPath `fmap` ioAbsoluteOrRemote d- let k = "Reading inventory of repository "++d- beginTedious k- readRepoPrivate k realdir "inventory" `catch`- (\e -> do hPutStrLn stderr ("Invalid repository: " ++ realdir)- ioError e)--readTentativeRepo :: RepoPatch p => [DarcsFlag] -> String -> IO (SealedPatchSet p C(Origin))-readTentativeRepo _ d = do- realdir <- toPath `fmap` ioAbsoluteOrRemote d- let k = "Reading tentative inventory of repository "++d- beginTedious k- readRepoPrivate k realdir "tentative_inventory" `catch`- (\e -> do hPutStrLn stderr ("Invalid repository: " ++ realdir)- ioError e)--readRepoPrivate :: RepoPatch p => String -> FilePath -> FilePath -> IO (SealedPatchSet p C(Origin))-readRepoPrivate k d iname = do- i <- gzFetchFilePS (d </> "_darcs" </> iname) Uncachable- finishedOneIO k iname- let parse inf = parse2 inf $ d </> "_darcs/patches" </> makeFilename inf- (mt, is) = case BC.break ((==) '\n') i of- (swt,pistr) | swt == BC.pack "Starting with tag:" ->- case readPatchIds pistr of- (t:ids) -> (Just t,reverse ids)- [] -> bug "bad inventory in readRepoPrivate"- _ -> (Nothing, reverse $ readPatchIds i)- Sealed ts <- unseal seal `fmap` unsafeInterleaveIO (read_ts parse mt)- Sealed ps <- unseal seal `fmap` unsafeInterleaveIO (read_patches parse is)- return $ seal (PatchSet ps ts)- where read_ts :: RepoPatch p =>- (FORALL(b) PatchInfo -> IO (Sealed (PatchInfoAnd p C(b))))- -> Maybe PatchInfo -> IO (Sealed (RL (Tagged p) C(Origin)))- read_ts _ Nothing = do endTedious k- return $ seal NilRL- read_ts parse (Just tag0) =- do debugMessage $ "Looking for inventory for:\n"++ show tag0- i <- unsafeInterleaveIO $- do x <- gzFetchFilePS (d</>"_darcs/inventories"</>makeFilename tag0) Uncachable- finishedOneIO k (show tag0)- return x- let (mt, is) = case BC.break ((==) '\n') i of- (swt,pistr) | swt == BC.pack "Starting with tag:" ->- case readPatchIds pistr of- (t:ids) -> (Just t,reverse ids)- [] -> bug "bad inventory in readRepoPrivate"- _ -> (Nothing, reverse $ readPatchIds i)- Sealed ts <- fmap (unseal seal) $ unsafeInterleaveIO $ read_ts parse mt- Sealed ps <- unseal seal `fmap` unsafeInterleaveIO (read_patches parse is)- Sealed tag00 <- parse tag0 `catch`- \e -> return $ seal $- patchInfoAndPatch tag0 $ unavailable $ show e- return $ seal $ Tagged tag00 Nothing ps :<: ts- parse2 :: RepoPatch p => PatchInfo -> FilePath- -> IO (Sealed (PatchInfoAnd p C(x)))- parse2 i fn = do ps <- unsafeInterleaveIO $ gzFetchFilePS fn Cachable- return $ patchInfoAndPatch i- `mapSeal` hopefullyNoParseError (toPath fn) (readPatch ps)- hopefullyNoParseError :: String -> Maybe (Sealed (Named a1dr C(x)), b)- -> Sealed (Hopefully (Named a1dr) C(x))- hopefullyNoParseError _ (Just (Sealed x, _)) = seal $ actually x- hopefullyNoParseError s Nothing = seal $ unavailable $ "Couldn't parse file "++s- read_patches :: RepoPatch p =>- (FORALL(b) PatchInfo -> IO (Sealed (PatchInfoAnd p C(b))))- -> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd p) C(x)))- read_patches _ [] = return $ seal NilRL- read_patches parse (i:is) =- lift2Sealed (:<:)- (read_patches parse is)- (parse i `catch` \e ->- return $ seal $ patchInfoAndPatch i $ unavailable $ show e)- lift2Sealed :: (FORALL(y z) q C(y z) -> pp C(y) -> r C(z))- -> IO (Sealed pp) -> (FORALL(b) IO (Sealed (q C(b)))) -> IO (Sealed r)- lift2Sealed f iox ioy = do Sealed x <- unseal seal `fmap` unsafeInterleaveIO iox- Sealed y <- unseal seal `fmap` unsafeInterleaveIO ioy- return $ seal $ f y x--readPatchIds :: B.ByteString -> [PatchInfo]-readPatchIds inv | B.null inv = []-readPatchIds inv = case readPatchInfo inv of- Just (pinfo,r) -> pinfo : readPatchIds r- Nothing -> []--readCheckpoints :: String -> IO [PatchInfo]-readCheckpoints d = do- realdir <- toPath `fmap` ioAbsoluteOrRemote d- pistr <- fetchFilePS (realdir++"/"++darcsdir++"/checkpoints/inventory") Uncachable- `catchall` return B.empty- pis <- return $ reverse $ readPatchIds pistr- return pis-\end{code}--The \verb!_darcs! directory also contains a directory called-``\verb!prefs!'', which is described in Chapter~\ref{configuring}.--\begin{comment}-\section{Getting interesting info on change history}--One can query the repository for the entire markup history of a file. This-provides a data structure which contains a history of \emph{all} the-revisions ever made on a given file.--\end{comment}-
src/Darcs/Repository/Format.hs view
@@ -2,23 +2,21 @@ -- -- This file is licensed under the GPL, version two or later. -{-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} -module Darcs.Repository.Format ( RepoFormat(..), RepoProperty(..), identifyRepoFormat,+module Darcs.Repository.Format ( RepoFormat(..), RepoProperty(..),+ identifyRepoFormat, tryIdentifyRepoFormat, createRepoFormat, writeRepoFormat, writeProblem, readProblem, readfromAndWritetoProblem,- formatHas, formatHasTogether,+ formatHas, ) where -import Data.List ( sort )-import Data.Maybe ( isJust, catMaybes )-import Control.Monad ( msum )+import Data.Maybe ( isJust, mapMaybe )+import Control.Monad ( mplus, (<=<) ) import Darcs.SignalHandler ( catchNonSignal ) import Darcs.External ( fetchFilePS, Cachable( Cachable ) )-import Darcs.Flags ( DarcsFlag ( UseFormat2, UseHashedInventory,- UseOldFashionedInventory ) )+import Darcs.Flags ( DarcsFlag ( UseFormat2, UseHashedInventory) ) import Darcs.Lock ( writeBinFile ) import Darcs.Utils ( catchall, prettyException ) import Progress ( beginTedious, endTedious, finishedOneIO )@@ -43,10 +41,15 @@ df = darcsdir++"/format" -- | @identifyRepoFormat URL@ identifies the format of the repository+-- at the given address. Fails if we weren't able to identify the format.+identifyRepoFormat :: String -> IO RepoFormat+identifyRepoFormat = either fail return <=< tryIdentifyRepoFormat++-- | @tryIdentifyRepoFormat URL@ identifies the format of the repository -- at the given address. Return @Left reason@ if it fails, where -- @reason@ explains why we weren't able to identify the format.-identifyRepoFormat :: String -> IO (Either String RepoFormat)-identifyRepoFormat repo =+tryIdentifyRepoFormat :: String -> IO (Either String RepoFormat)+tryIdentifyRepoFormat repo = do let k = "Identifying repository "++repo beginTedious k finishedOneIO k "format"@@ -55,14 +58,26 @@ rf <- if B.null dff || isJust (BC.elemIndex '<' dff) then do finishedOneIO k "inventory" have_inventory <- doesRemoteFileExist (repo++"/"++darcsdir++"/inventory")- case have_inventory of- Right _ -> return $ Right defaultRepoFormat- Left e -> return $ Left $ "Not a repository: "++repo++" ("++e++")"+ return $+ case have_inventory of+ Right _ -> Right defaultRepoFormat+ Left e -> Left . unlines $+ [ "Not a repository: "++repo++" ("++e++")"+ , ""+ , "HINT: Do you have the right URI for the repository?"+ , ""+ , " If so, check with the repository owner to see if the following files"+ , " are readable:"+ , ""+ , " 1. _darcs/format - might not exist; that's OK"+ , " 2. _darcs/inventory - should exist if #1 is missing"+ , " 3. _darcs/hashed_inventory - should exist if #2 is missing"+ ] else return $ Right $ parseRepoFormat dff endTedious k return rf where drfe x = fetchFilePS x Cachable >> return True- doesRemoteFileExist x = (fmap Right) (drfe x) `catchNonSignal`+ doesRemoteFileExist x = fmap Right (drfe x) `catchNonSignal` (\e -> return (Left (prettyException e))) -- | @writeRepoFormat@ writes the repo format to the given file.@@ -79,50 +94,50 @@ defaultRepoFormat = RF [[rp2ps Darcs1_0]] createRepoFormat :: [DarcsFlag] -> RepoFormat-createRepoFormat fs = RF ([map rp2ps flags2inv] ++ maybe2)- where flags2inv | UseFormat2 `elem` fs = [HashedInventory]- | UseHashedInventory `elem` fs = [HashedInventory]- | UseOldFashionedInventory `elem` fs = [Darcs1_0]- | otherwise = [HashedInventory]- maybe2 = if UseFormat2 `notElem` fs &&- (UseOldFashionedInventory `elem` fs ||- UseHashedInventory `elem` fs)+createRepoFormat fs = RF (map rp2ps [HashedInventory]: maybe2)+ where maybe2 = if UseFormat2 `notElem` fs && (UseHashedInventory `elem` fs) then [] else [[rp2ps Darcs2]] --- | @writeProblem from@ tells if we can write to a repo in format @form@.--- it returns @Nothing@ if there's no problem writing to such a repository.+-- | @writeProblem form@ tells if we can write to a repo in format @form@.+-- It returns @Nothing@ if there's no problem writing to such a repository. writeProblem :: RepoFormat -> Maybe String-writeProblem rf | isJust $ readProblem rf = readProblem rf-writeProblem (RF ks) = unlines `fmap` justsOrNothing (map wp ks)+writeProblem rf = readProblem rf `mplus` allProblems rf wp where wp x | all isKnown x = Nothing wp [] = impossible wp x = Just $ unwords $ "Can't write repository format: " : map BC.unpack (filter (not . isKnown) x) --- | @writeProblem from@ tells if we can read and write to a repo in--- format @form@. it returns @Nothing@ if there's no problem reading+-- | @readfromAndWritetoProblem form@ tells if we can read from and write to a repo in+-- format @form@. It returns @Nothing@ if there's no problem reading -- and writing to such a repository. readfromAndWritetoProblem :: RepoFormat -> RepoFormat -> Maybe String readfromAndWritetoProblem inrf outrf | formatHas Darcs2 inrf /= formatHas Darcs2 outrf = Just "Cannot mix darcs-2 repositories with older formats"- | otherwise = msum [readProblem inrf, writeProblem outrf]+ | otherwise = readProblem inrf `mplus` writeProblem outrf --- | @readProblem from@ tells if we can write to a repo in format @form@.--- it returns @Nothing@ if there's no problem reading from such a repository.+-- | @readProblem form@ tells if we can read from a repo in format @form@.+-- It returns @Nothing@ if there's no problem reading from such a repository. readProblem :: RepoFormat -> Maybe String readProblem rf | formatHas Darcs1_0 rf && formatHas Darcs2 rf = Just "Invalid repositoryformat: format 2 is incompatible with format 1"-readProblem (RF ks) = unlines `fmap` justsOrNothing (map rp ks)+readProblem rf = allProblems rf rp where rp x | any isKnown x = Nothing rp [] = impossible rp x = Just $ unwords $ "Can't understand repository format:" : map BC.unpack x +allProblems :: RepoFormat -> ([B.ByteString] -> Maybe String) -> Maybe String+allProblems (RF ks) repoFormatLineProblem = maybeSingleError $ mapMaybe repoFormatLineProblem ks+ where+ maybeSingleError [] = Nothing+ maybeSingleError xs = Just $ unlines xs++ -- | Does this version of darcs know how to handle this property? isKnown :: B.ByteString -> Bool isKnown p = p `elem` map rp2ps knownProperties@@ -132,20 +147,8 @@ knownProperties :: [RepoProperty] knownProperties = [Darcs1_0, Darcs2, HashedInventory] -justsOrNothing :: [Maybe x] -> Maybe [x]-justsOrNothing mxs =- case catMaybes mxs of- [] -> Nothing- xs -> Just xs- formatHas :: RepoProperty -> RepoFormat -> Bool formatHas f (RF ks) = rp2ps f `elem` concat ks--formatHasTogether :: [RepoProperty] -> RepoFormat -> Bool-formatHasTogether fs (RF ks) = fht (sort $ map rp2ps fs) ks- where fht _ [] = False- fht x (y:ys) | x == sort y = True- | otherwise = fht x ys rp2ps :: RepoProperty -> B.ByteString rp2ps Darcs1_0 = BC.pack "darcs-1.0"
src/Darcs/Repository/HashedIO.hs view
@@ -14,14 +14,15 @@ -- along with this program; if not, write to the Free Software Foundation, -- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -{-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances #-} #include "gadts.h" module Darcs.Repository.HashedIO ( HashedIO, copyHashed, copyPartialsHashed,- cleanHashdir ) where+ cleanHashdir,+ RW(RW) -- only exported to make warning go away+ ) where import Darcs.Global ( darcsdir ) import qualified Data.Set as Set@@ -31,15 +32,13 @@ import Control.Applicative ( (<$>) ) import Data.Maybe ( isJust ) import System.IO.Unsafe ( unsafeInterleaveIO )-import System.IO ( hPutStrLn, stderr ) import Darcs.Repository.Cache ( Cache(..), fetchFileUsingCache, writeFileUsingCache, peekInCache, speculateFileUsingCache, okayHash, cleanCachesWithHint, HashedDir(..), hashedDir )-import Darcs.Patch ( Patchy, apply ) import Darcs.RepoPath ( FilePathLike, toFilePath )-import Darcs.IO ( ReadableDirectory(..), WriteableDirectory(..) )-import Darcs.Flags ( DarcsFlag, Compression( .. ) )+import Darcs.Patch.ApplyMonad ( ApplyMonad(..) )+import Darcs.Flags ( Compression( .. ) ) import Darcs.Lock ( writeAtomicFilePS, removeFileMayNotExist ) import Darcs.Utils ( withCurrentDirectory ) import Progress ( debugMessage, tediousSize, finishedOneIO )@@ -50,11 +49,10 @@ import qualified Data.ByteString as B (ByteString, length, empty) import qualified Data.ByteString.Char8 as BC (unpack, pack) -import Storage.Hashed.Darcs( hashedTreeIO, readDarcsHashedNosize, readDarcsHashed,- writeDarcsHashed, readDarcsHashedDir, darcsLocation,+import Storage.Hashed.Darcs( readDarcsHashedDir, darcsLocation, decodeDarcsHash, decodeDarcsSize )-import Storage.Hashed.Tree( treeHash, ItemType(..) )-import Storage.Hashed.Hash( encodeBase16, Hash(..) )+import Storage.Hashed.Tree( ItemType(..) )+import Darcs.CommandsAux -- | @readHashFile c subdir hash@ reads the file with hash @hash@ in dir subdir, -- fetching it from 'Cache' @c@ if needed.@@ -65,7 +63,7 @@ data HashDir r p = HashDir { permissions :: !r, cache :: !Cache, compress :: !Compression, rootHash :: !String }-type HashedIO r p = StateT (HashDir r p) IO+type HashedIO p = StateT (HashDir RW p) IO data RO = RO data RW = RW@@ -78,56 +76,46 @@ isRO RO = True -} -instance ReadableDirectory (HashedIO r p) where+mWithCurrentDirectory fn j+ | fn' == fp2fn "" = j+ | otherwise =+ case breakOnDir fn' of+ Nothing -> do c <- readroot+ case geta D fn' c of+ Nothing -> fail "dir doesn't exist in mWithCurrentDirectory..."+ Just h -> do (h',x) <- withh h j+ writeroot $ seta D fn' h' c+ return x+ Just (d,fn'') -> do c <- readroot+ case geta D d c of+ Nothing -> fail "dir doesn't exist..."+ Just h -> do (h',x) <- withh h $ mWithCurrentDirectory fn'' j+ writeroot $ seta D d h' c+ return x+ where fn' = normPath fn++mInCurrentDirectory fn j | fn' == fp2fn "" = j+ | otherwise =+ case breakOnDir fn' of+ Nothing -> do c <- readroot+ case geta D fn' c of+ Nothing -> fail "dir doesn't exist mInCurrentDirectory..."+ Just h -> inh h j+ Just (d,fn'') -> do c <- readroot+ case geta D d c of+ Nothing -> fail "dir doesn't exist..."+ Just h -> inh h $ mInCurrentDirectory fn'' j+ where fn' = normPath fn++instance ApplyMonad (HashedIO p) where mDoesDirectoryExist fn = do thing <- identifyThing fn case thing of Just (D,_) -> return True _ -> return False- mDoesFileExist fn = do thing <- identifyThing fn- case thing of Just (F,_) -> return True- _ -> return False- mInCurrentDirectory fn j | fn' == fp2fn "" = j- | otherwise =- case breakOnDir fn' of- Nothing -> do c <- readroot- case geta D fn' c of- Nothing -> fail "dir doesn't exist mInCurrentDirectory..."- Just h -> inh h j- Just (d,fn'') -> do c <- readroot- case geta D d c of- Nothing -> fail "dir doesn't exist..."- Just h -> inh h $ mInCurrentDirectory fn'' j- where fn' = normPath fn- mGetDirectoryContents = map (\ (_,f,_) -> f) `fmap` readroot mReadFilePS fn = mInCurrentDirectory (superName fn) $ do c <- readroot case geta F (ownName fn) c of Nothing -> fail $ " file don't exist... "++ fn2fp fn Just h -> readhash h--instance WriteableDirectory (HashedIO RW p) where- mWithCurrentDirectory fn j- | fn' == fp2fn "" = j- | otherwise =- case breakOnDir fn' of- Nothing -> do c <- readroot- case geta D fn' c of- Nothing -> fail "dir doesn't exist in mWithCurrentDirectory..."- Just h -> do (h',x) <- withh h j- writeroot $ seta D fn' h' c- return x- Just (d,fn'') -> do c <- readroot- case geta D d c of- Nothing -> fail "dir doesn't exist..."- Just h -> do (h',x) <- withh h $ mWithCurrentDirectory fn'' j- writeroot $ seta D d h' c- return x- where fn' = normPath fn- mSetFileExecutable _ _ = return ()- mWriteFilePS fn ps = do mexists <- identifyThing fn- case mexists of- Just (D,_) -> fail "can't write file over directory"- _ -> do h <- writeHashFile ps- makeThing fn (F,h) mCreateDirectory fn = do h <- writeHashFile B.empty exists <- isJust `fmap` identifyThing fn when exists $ fail "can't mCreateDirectory over an existing object."@@ -145,7 +133,7 @@ fail $ "Cannot remove non-empty file "++fn2fp f rmThing f -identifyThing :: FileName -> HashedIO r p (Maybe (ObjType,String))+identifyThing :: FileName -> HashedIO p (Maybe (ObjType,String)) identifyThing fn | fn' == fp2fn "" = do h <- gets rootHash return $ Just (D, h) | otherwise = case breakOnDir fn' of@@ -156,11 +144,11 @@ Just h -> inh h $ identifyThing fn'' where fn' = normPath fn -makeThing :: FileName -> (ObjType,String) -> HashedIO RW p ()+makeThing :: FileName -> (ObjType,String) -> HashedIO p () makeThing fn (o,h) = mWithCurrentDirectory (superName $ normPath fn) $ seta o (ownName $ normPath fn) h `fmap` readroot >>= writeroot -rmThing :: FileName -> HashedIO RW p ()+rmThing :: FileName -> HashedIO p () rmThing fn = mWithCurrentDirectory (superName $ normPath fn) $ do c <- readroot let c' = filter (\(_,x,_)->x/= ownName (normPath fn)) c@@ -168,13 +156,13 @@ then writeroot c' else fail "obj doesn't exist in rmThing" -readhash :: String -> HashedIO r p B.ByteString+readhash :: String -> HashedIO p B.ByteString readhash h = do c <- gets cache z <- lift $ unsafeInterleaveIO $ readHashFile c HashedPristineDir h let (_,out) = z return out -withh :: String -> HashedIO RW p a -> HashedIO RW p (String,a)+withh :: String -> HashedIO p a -> HashedIO p (String,a) withh h j = do hd <- get put $ hd { rootHash = h } x <- j@@ -182,26 +170,26 @@ put hd return (h',x) -inh :: String -> HashedIO r p a -> HashedIO r p a+inh :: String -> HashedIO p a -> HashedIO p a inh h j = do hd <- get put $ hd { rootHash = h } x <- j put hd return x -readroot :: HashedIO r p [(ObjType, FileName, String)]+readroot :: HashedIO p [(ObjType, FileName, String)] readroot = do haveitalready <- peekroot cc <- gets rootHash >>= readdir when (not haveitalready) $ speculate cc return cc- where speculate :: [(a,b,String)] -> HashedIO r q ()+ where speculate :: [(a,b,String)] -> HashedIO q () speculate c = do cac <- gets cache mapM_ (\(_,_,z) -> lift $ speculateFileUsingCache cac HashedPristineDir z) c- peekroot :: HashedIO r p Bool+ peekroot :: HashedIO p Bool peekroot = do HashDir _ c _ h <- get lift $ peekInCache c HashedPristineDir h -writeroot :: [(ObjType, FileName, String)] -> HashedIO r p ()+writeroot :: [(ObjType, FileName, String)] -> HashedIO p () writeroot c = do h <- writedir c modify $ \hd -> hd { rootHash = h } @@ -223,7 +211,7 @@ seta o f h ((_,f',_):r) | f == f' = (o,f,h):r seta o f h (x:xs) = x : seta o f h xs -readdir :: String -> HashedIO r p [(ObjType, FileName, String)]+readdir :: String -> HashedIO p [(ObjType, FileName, String)] readdir hash = (parsed . linesPS) `fmap` readhash hash where parsed (t:n:h:rest) | t == dir = (D, niceps2fn n, BC.unpack h) : parsed rest | t == file = (F, niceps2fn n, BC.unpack h) : parsed rest@@ -234,19 +222,20 @@ file = BC.pack "file:" -writedir :: [(ObjType, FileName, String)] -> HashedIO r p String+writedir :: [(ObjType, FileName, String)] -> HashedIO p String writedir c = writeHashFile cps where cps = unlinesPS $ concatMap (\ (o,d,h) -> [showO o,fn2niceps d,BC.pack h]) c++[B.empty] showO D = dir showO F = file -writeHashFile :: B.ByteString -> HashedIO r p String+writeHashFile :: B.ByteString -> HashedIO p String writeHashFile ps = do c <- gets cache compr <- gets compress lift $ writeFileUsingCache c compr HashedPristineDir ps copyHashed :: String -> Cache -> Compression -> String -> IO ()-copyHashed k c compr z = do runStateT cph $ HashDir { permissions = RO, cache = c,+-- Warning: A do-notation statement discarded a result of type ((), HashDir RO ghc-prim+copyHashed k c compr z = do _ <- runStateT cph $ HashDir { permissions = RW, cache = c, compress = compr, rootHash = z } return () where cph = do cc <- readroot@@ -255,7 +244,10 @@ cp (F,n,h) = do ps <- readhash h lift $ finishedOneIO k (fn2fp n) lift $ writeAtomicFilePS (fn2fp n) ps- cp (D,n,h) = do lift $ createDirectoryIfMissing False (fn2fp n)+ cp (D,n,h) = if isMaliciousSubPath (fn2fp n)+ then fail ("Caught malicious path: " ++ fn2fp n)+ else do+ lift $ createDirectoryIfMissing False (fn2fp n) lift $ finishedOneIO k (fn2fp n) lift $ withCurrentDirectory (fn2fp n) $ copyHashed k c compr h @@ -266,8 +258,9 @@ copyPartialHashed :: FilePathLike fp => Cache -> Compression -> String -> fp -> IO () copyPartialHashed c compr root ff = do createDirectoryIfMissing True (basename $ toFilePath ff)- runStateT (cp $ fp2fn $ toFilePath ff) $- HashDir { permissions = RO, cache = c,+-- Warning: A do-notation statement discarded a result of type ((), HashDir RO ghc-prim+ _ <- runStateT (cp $ fp2fn $ toFilePath ff) $+ HashDir { permissions = RW, cache = c, compress=compr, rootHash = root } return () where basename = reverse . dropWhile ('/' /=) . dropWhile ('/' ==) . reverse@@ -287,8 +280,8 @@ listone h = do let size = decodeDarcsSize $ BC.pack h hash = decodeDarcsHash $ BC.pack h x <- readDarcsHashedDir hashdir (size, hash)- let subs = [ fst $ darcsLocation "" (s, h) | (TreeType, _, s, h) <- x ]- hashes = h : [ fst $ darcsLocation "" (s, h) | (_, _, s, h) <- x ]+ let subs = [ fst $ darcsLocation "" (s, h') | (TreeType, _, s, h') <- x ]+ hashes = h : [ fst $ darcsLocation "" (s, h') | (_, _, s, h') <- x ] (hashes++) . concat <$> mapM listone subs hs <- set . concat <$> mapM listone hashroots fs <- set . filter okayHash <$> getDirectoryContents hashdir
src/Darcs/Repository/HashedRepo.hs view
@@ -14,7 +14,6 @@ -- along with this program; if not, write to the Free Software Foundation, -- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -{-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP, ScopedTypeVariables #-} #include "gadts.h"@@ -26,18 +25,20 @@ addToTentativeInventory, removeFromTentativeInventory, readRepo, readTentativeRepo, writeAndReadPatch, writeTentativeInventory, copyRepo,- readHashedPristineRoot, pris2inv, copySources+ readHashedPristineRoot, pris2inv, copySources,+ listInventories ) where import System.Directory ( createDirectoryIfMissing ) import System.FilePath.Posix( (</>) ) import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO ( stderr, hPutStrLn )-import Data.List ( delete, filter )+import Data.List ( delete ) import Control.Monad ( unless )+import Control.Applicative ( (<$>) ) import Workaround ( renameFile )-import Darcs.Flags ( DarcsFlag, Compression )+import Darcs.Flags ( Compression, RemoteDarcs ) import Darcs.Patch.Set ( PatchSet(..), Tagged(..), SealedPatchSet ) #ifdef GADT_WITNESSES import Darcs.Patch.Set ( Origin )@@ -46,19 +47,21 @@ import Darcs.Repository.Cache ( Cache(..), CacheLoc(..), fetchFileUsingCache, speculateFilesUsingCache, writeFileUsingCache, unionCaches, repo2cache, okayHash, takeHash,- HashedDir(..),WritableOrNot(..), hashedDir,+ HashedDir(..), hashedDir, peekInCache ) import qualified Darcs.Repository.Cache as DarcsCache import Darcs.Repository.HashedIO ( copyHashed, copyPartialsHashed, cleanHashdir ) import Darcs.Repository.InternalTypes ( Repository(..), extractCache, modifyCache )-import Darcs.Repository.Prefs ( globalCacheDir )-import Darcs.Hopefully ( PatchInfoAnd, patchInfoAndPatch, info,+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, patchInfoAndPatch, info, extractHash, createHashed ) import Darcs.Patch ( RepoPatch, Patchy, showPatch, readPatch, apply )+import Darcs.Patch.Patchy ( Apply )+import Darcs.Patch.ReadMonads ( parseStrictly ) import Darcs.Patch.Depends ( commuteToEnd, slightlyOptimizePatchset ) import Darcs.Patch.Info ( PatchInfo, showPatchInfo, humanFriendly, readPatchInfo )-import Darcs.Witnesses.Ordered ( unsafeCoerceP, reverseRL, reverseFL, (+<+) )+import Darcs.Witnesses.Unsafe ( unsafeCoerceP )+import Darcs.Witnesses.Ordered ( reverseRL, reverseFL, (+<+) ) import ByteStringUtils ( gzReadFilePS, dropSpace ) import qualified Data.ByteString as B (null, length, empty@@ -66,32 +69,35 @@ import qualified Data.ByteString.Char8 as BC (unpack, dropWhile, break, pack) import Printer ( Doc, hcat, (<>), ($$), renderString, renderPS, text, invisiblePS )+import Darcs.ColorPrinter () -- for instance Show Doc import Crypt.SHA256 ( sha256sum )-import Darcs.External ( copyFileOrUrl, cloneFile, fetchFilePS, Cachable( Uncachable ) )+import Darcs.External ( copyFileOrUrl, cloneFile, fetchFilePS, gzFetchFilePS,+ Cachable( Uncachable ) ) import Darcs.Lock ( writeBinFile, writeDocBinFile, writeAtomicFilePS, appendBinFile, appendDocBinFile ) import Darcs.Utils ( withCurrentDirectory ) import Progress ( beginTedious, endTedious, debugMessage, finishedOneIO ) #include "impossible.h"-import Darcs.Witnesses.Ordered ( FL(..), RL(..), (:>>)(..), mapRL, mapFL )+import Darcs.Witnesses.Ordered ( FL(..), RL(..), (:>)(..), mapRL, mapFL ) import Darcs.Witnesses.Sealed ( Sealed(..), seal, unseal, mapSeal ) import Darcs.Global ( darcsdir ) import Storage.Hashed.Darcs( hashedTreeIO, readDarcsHashedNosize, readDarcsHashed,- writeDarcsHashed, readDarcsHashedDir, darcsLocation,+ writeDarcsHashed, decodeDarcsHash, decodeDarcsSize )-import Storage.Hashed.Tree( treeHash, ItemType(..) )+import Storage.Hashed.Tree( treeHash ) import Storage.Hashed.Hash( encodeBase16, Hash(..) ) --applyHashed' fs root p = do case root of+applyHashed'+ :: Apply p => Hash -> p C(x y) -> IO String+applyHashed' root p = do case root of (SHA256 _) -> return () _ -> fail $ "Cannot handle hash: " ++ show root- s <- readDarcsHashedNosize "_darcs/pristine.hashed" root- (_, t) <- (hashedTreeIO (apply fs p) s "_darcs/pristine.hashed")- return $ BC.unpack . encodeBase16 $ treeHash t+ s <- readDarcsHashedNosize "_darcs/pristine.hashed" root+ (_, t) <- (hashedTreeIO (apply p) s "_darcs/pristine.hashed")+ return $ BC.unpack . encodeBase16 $ treeHash t -applyHashed :: Patchy q => [DarcsFlag] -> String -> q C(x y) -> IO String-applyHashed fs h p = applyHashed' fs hash p `catch` \_ -> do+applyHashed :: Patchy q => String -> q C(x y) -> IO String+applyHashed h p = applyHashed' hash p `catch` \_ -> do hPutStrLn stderr warn inv <- gzReadFilePS invpath let oldroot = BC.pack $ inv2pris inv@@ -103,7 +109,7 @@ writeDocBinFile invpath $ pris2inv newroot inv cleanHashdir (Ca []) HashedPristineDir [newroot] hPutStrLn stderr "Pristine conversion done..."- applyHashed' fs root p+ applyHashed' root p where invpath = darcsdir ++ "/hashed_inventory" hash = decodeDarcsHash $ BC.pack h warn = "WARNING: Doing a one-time conversion of pristine format.\n" ++@@ -160,7 +166,7 @@ -- patchset. The commutation behavior of PatchInfoAnd should track -- which patches need to be rewritten for us. do allpatches <- readTentativeRepo repo "."- _ :>> skipped <- return $ commuteToEnd (reverseFL to_remove) allpatches+ _ :> skipped <- return $ commuteToEnd (reverseFL to_remove) allpatches okay <- simpleRemoveFromTentativeInventory repo compr (mapFL info to_remove ++ mapRL info skipped) unless okay $ bug "bug in HashedRepo.removeFromTentativeInventory"@@ -234,7 +240,7 @@ parse i h = do debugMessage ("Reading patch file: "++ show (humanFriendly i)) (fn,ps) <- fetchFileUsingCache cache HashedPatchesDir h case readPatch ps of- Just (p,_) -> return p+ Just p -> return p Nothing -> fail $ unlines ["Couldn't parse file "++fn, "which is patch", renderString $ humanFriendly i]@@ -285,23 +291,27 @@ _ -> return (Nothing,i) return (rest, readPatchIds str) -copyRepo :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> String -> IO ()-copyRepo repo@(Repo outr _ _ _) opts inr = do+copyRepo :: RepoPatch p => Repository p C(r u t) -> RemoteDarcs -> String -> IO ()+copyRepo repo@(Repo outr _ _ _) remote inr = do createDirectoryIfMissing False (outr++"/"++darcsdir++"/inventories")- copyFileOrUrl opts (inr++"/"++darcsdir++"/hashed_inventory") (outr++"/"++darcsdir++"/hashed_inventory")+ copyFileOrUrl remote (inr </> darcsdir </> "hashed_inventory")+ (outr </> darcsdir </> "hashed_inventory") Uncachable -- no need to copy anything but hashed_inventory! copySources repo inr debugMessage "Done copying hashed inventory." +-- |'copySources' copies the prefs/sources file to the local repo, from the+-- remote, having first filtered the local filesystem sources. copySources :: RepoPatch p => Repository p C(r u t) -> String -> IO () copySources repo@(Repo outr _ _ _) inr = do- let repoCache = extractCache $ modifyCache repo dropGlobalCaches+ let repoCache = extractCache $ modifyCache repo dropNonRepos appendBinFile (outr++"/"++darcsdir++"/prefs/sources") (show $ repo2cache inr `unionCaches` repoCache ) where- dropGlobalCaches (Ca cache) = Ca $ filter notGlobalCache cache- notGlobalCache xs = case xs of- Cache DarcsCache.Directory _ _ -> False- _ -> True+ dropNonRepos (Ca cache) = Ca $ filter notRepo cache+ notRepo xs = case xs of+ Cache DarcsCache.Directory _ _ -> False+ Cache _ DarcsCache.Writable _ -> False+ _ -> True writeAndReadPatch :: RepoPatch p => Cache -> Compression -> PatchInfoAnd p C(x y) -> IO (PatchInfoAnd p C(x y))@@ -310,7 +320,7 @@ where parse i h = do debugMessage ("Rereading patch file: "++ show (humanFriendly i)) (fn,ps) <- fetchFileUsingCache c HashedPatchesDir h case readPatch ps of- Just (x,_) -> return x+ Just x -> return x Nothing -> fail $ unlines ["Couldn't parse patch file "++fn, "which is", renderString $ humanFriendly i]@@ -373,7 +383,7 @@ readInventoryPrivate :: Cache -> String -> String -> IO (Maybe String, [(PatchInfo, String)]) readInventoryPrivate _ d iname = do- i <- skipPristine `fmap` fetchFilePS (d </> iname) Uncachable+ i <- skipPristine `fmap` gzFetchFilePS (d </> iname) Uncachable (rest,str) <- case BC.break ((==)'\n') i of (swt,pistr) | swt == BC.pack "Starting with inventory:" -> case BC.break ((==)'\n') $ B.tail pistr of@@ -383,24 +393,18 @@ _ -> return (Nothing, i) return (rest, readPatchIds str) -readInventories :: Cache -> String -> IO [[(PatchInfo, String)]]-readInventories cache ihash = do- (fn,i_and_p) <- fetchFileUsingCache cache HashedInventoriesDir ihash- let i = skipPristine i_and_p- (rest,str) <- case BC.break ((==)'\n') i of- (swt,pistr) | swt == BC.pack "Starting with inventory:" ->- case BC.break ((==)'\n') $ B.tail pistr of- (h,thisinv) | okayHash $ BC.unpack h ->- do r <- unsafeInterleaveIO $- readInventories cache (BC.unpack h) -- again. no.- return (r,thisinv)- _ -> fail $ "Bad hash in file " ++ fn- _ -> return ([],i)- return $ reverse (readPatchIds str) : rest+listInventories :: IO [String]+listInventories = do+ x <- fst <$> readInventoryPrivate (Ca []) darcsdir "hashed_inventory"+ maybe (return []) f x+ where+ f i = do+ x <- fst <$> readInventoryPrivate (Ca []) (darcsdir </> "inventories") i+ (i :) <$> maybe (return []) f x readPatchIds :: B.ByteString -> [(PatchInfo, String)] readPatchIds inv | B.null inv = []-readPatchIds inv = case readPatchInfo inv of+readPatchIds inv = case parseStrictly readPatchInfo inv of Nothing -> [] Just (pinfo,r) -> case readHash r of@@ -415,14 +419,14 @@ then Nothing else Just (BC.unpack $ B.tail h,r) -applyPristine :: Patchy q => [DarcsFlag] -> String -> String -> q C(x y) -> IO ()-applyPristine opts d iname p =+applyPristine :: Patchy q => String -> String -> q C(x y) -> IO ()+applyPristine d iname p = do i <- gzReadFilePS (d++"/"++iname)- h <- applyHashed opts (inv2pris i) p+ h <- applyHashed (inv2pris i) p writeDocBinFile (d++"/"++iname) $ pris2inv h i -applyToTentativePristine :: Patchy q => [DarcsFlag] -> q C(x y) -> IO ()-applyToTentativePristine opts p = applyPristine opts "." (darcsdir++"/tentative_pristine") p+applyToTentativePristine :: Patchy q => q C(x y) -> IO ()+applyToTentativePristine p = applyPristine "." (darcsdir++"/tentative_pristine") p copyPristine :: Cache -> Compression -> String -> String -> IO () copyPristine c compr d iname = do
src/Darcs/Repository/Internal.hs view
@@ -16,15 +16,16 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP, ScopedTypeVariables, Rank2Types, RankNTypes, PatternGuards #-} #include "gadts.h" -module Darcs.Repository.Internal ( Repository(..), RepoType(..), RIO(unsafeUnRIO), ($-),- maybeIdentifyRepository, identifyDarcs1Repository, identifyRepositoryFor,+module Darcs.Repository.Internal ( Repository(..), RepoType(..), RIO(unsafeUnRIO), RepoJob(..),++ maybeIdentifyRepository, identifyDarcsRepository, identifyRepositoryFor, IdentifyRepo(..), findRepository, amInRepository, amNotInRepository,+ amInHashedRepository, revertRepositoryChanges, announceMergeConflicts, setTentativePending, checkUnrecordedConflicts,@@ -41,49 +42,53 @@ applyToWorking, patchSetToPatches, createPristineDirectoryTree, createPartialsPristineDirectoryTree, optimizeInventory, cleanRepository,- getMarkedupFile,- PatchSet, SealedPatchSet,- setScriptsExecutable,+ setScriptsExecutable, setScriptsExecutablePatches, getRepository, rIO, testTentative, testRecorded, UpdatePristine(..), MakeChanges(..), applyToTentativePristine,- makeNewPending+ makeNewPending, seekRepo ) where import Printer ( putDocLn, (<+>), text, ($$) ) import Darcs.Repository.Prefs ( getPrefval ) import Darcs.Repository.State ( readRecorded, readWorking )-import Darcs.Repository.LowLevel ( readPending, pendingName, readPrims, readPendingfile )+import Darcs.Repository.LowLevel+ ( readPending, readTentativePending+ , writeTentativePending+ , readNewPending, writeNewPending+ , pendingName ) import System.Exit ( ExitCode(..), exitWith ) import System.Cmd ( system )-import Darcs.External ( clonePartialsTree ) import Darcs.IO ( runTolerantly, runSilently )-import Darcs.Repository.Pristine ( identifyPristine, nopristine,- easyCreatePristineDirectoryTree,- easyCreatePartialsPristineDirectoryTree ) import Darcs.SignalHandler ( withSignalsBlocked ) import Darcs.Repository.Format ( RepoFormat, RepoProperty( Darcs2, HashedInventory ),- identifyRepoFormat, formatHas,+ tryIdentifyRepoFormat, formatHas, writeProblem, readProblem, readfromAndWritetoProblem ) import System.Directory ( doesDirectoryExist, setCurrentDirectory,- createDirectoryIfMissing )-import Control.Monad ( liftM, when, unless )+ createDirectoryIfMissing, doesFileExist )+import Control.Monad ( liftM, when, unless, filterM )+import Control.Applicative ( (<$>) ) import Workaround ( getCurrentDirectory, renameFile, setExecutable ) -import ByteStringUtils ( gzReadFilePS )-import qualified Data.ByteString as B ( empty, readFile, isPrefixOf )+import qualified Data.ByteString as B ( readFile, isPrefixOf ) import qualified Data.ByteString.Char8 as BC (pack) -import Darcs.Patch ( Patch, RealPatch, Effect, primIsHunk, primIsBinary, description,-+import Darcs.Patch ( Effect, primIsHunk, primIsBinary, description, tryToShrink, commuteFLorComplain, commute )-import Darcs.Patch.Prim ( tryShrinkingInverse )++import Darcs.Patch.Dummy ( DummyPatch )++import Darcs.Patch.V1 ( Patch )+import Darcs.Patch.V2 ( RealPatch )+import Darcs.Patch.Prim.V1 ( Prim )++import Darcs.Patch.Inspect ( PatchInspect )+import Darcs.Patch.Prim ( PrimPatchBase, PrimOf, tryShrinkingInverse, PrimPatch ) import Darcs.Patch.Bundle ( scanBundle, makeBundleN )-import Darcs.Hopefully ( PatchInfoAnd, info,+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info, hopefully, hopefullyM )-import Darcs.Repository.ApplyPatches ( applyPatches ) import qualified Darcs.Repository.HashedRepo as HashedRepo ( revertTentativeChanges, finalizeTentativeChanges, removeFromTentativeInventory,@@ -92,28 +97,29 @@ writeTentativeInventory, writeAndReadPatch, addToTentativeInventory, readRepo, readTentativeRepo, cleanPristine )-import qualified Darcs.Repository.DarcsRepo as DarcsRepo+import qualified Darcs.Repository.Old as Old+ ( readOldRepo, revertTentativeChanges, oldRepoFailMsg ) import Darcs.Flags ( DarcsFlag(Verbose, Quiet, MarkConflicts, AllowConflicts, NoUpdateWorking, WorkRepoUrl, WorkRepoDir, UMask, Test, LeaveTestDir, SetScriptsExecutable, DryRun ),- wantExternalMerge, compression )-import Darcs.Witnesses.Ordered ( FL(..), RL(..), EqCheck(..), unsafeCoerceP,+ wantExternalMerge, compression, Compression )+import Darcs.Witnesses.Eq ( EqCheck(..) )+import Darcs.Witnesses.Unsafe ( unsafeCoerceP, unsafeCoercePStart )+import Darcs.Witnesses.Ordered ( FL(..), RL(..), (:\/:)(..), (:/\:)(..), (:>)(..),- (+>+), lengthFL,+ (+>+), lengthFL, dropWhileFL, allFL, filterFLFL, reverseFL, mapFL_FL, concatFL )-import Darcs.Patch ( RepoPatch, Patchy, Prim, merge,- joinPatches,+import Darcs.Patch ( RepoPatch, Patchy, merge, listConflictedFiles, listTouchedFiles, Named, patchcontents, commuteRL, fromPrims, readPatch,- writePatch, effect, invert,+ effect, invert, primIsAddfile, primIsAdddir, primIsSetpref, apply, applyToTree,- emptyMarkedupFile, MarkedUpFile ) import Darcs.Patch.Permutations ( commuteWhatWeCanFL, removeFL ) import Darcs.Patch.Info ( PatchInfo )@@ -121,7 +127,6 @@ #ifdef GADT_WITNESSES import Darcs.Patch.Set ( Origin ) #endif-import Darcs.Patch.Apply ( markupFile, LineMark(None) ) import Darcs.Patch.Depends ( deepOptimizePatchset, removeFromPatchSet, mergeThem ) import Darcs.RepoPath ( FilePathLike, AbsolutePath, toFilePath, ioAbsoluteOrRemote, toPath )@@ -133,7 +138,7 @@ import Darcs.Lock ( withLock, writeDocBinFile, removeFileMayNotExist, withTempDir, withPermDir ) import Darcs.Witnesses.Sealed ( Sealed(Sealed), seal, FlippedSeal(FlippedSeal), flipSeal )-import Darcs.Repository.InternalTypes( Repository(..), RepoType(..) )+import Darcs.Repository.InternalTypes( Repository(..), RepoType(..), Pristine(..) ) import Darcs.Global ( darcsdir ) import System.Mem( performGC )@@ -195,10 +200,11 @@ | NonRepository String -- ^ safest guess | GoodRepository (Repository p C(r u t)) +-- | Tries to identify the repository in a given directory maybeIdentifyRepository :: [DarcsFlag] -> String -> IO (IdentifyRepo p C(r u t)) maybeIdentifyRepository opts "." = do darcs <- doesDirectoryExist darcsdir- rf_or_e <- identifyRepoFormat "."+ rf_or_e <- tryIdentifyRepoFormat "." here <- toPath `fmap` ioAbsoluteOrRemote "." case rf_or_e of Left err -> return $ NonRepository err@@ -211,25 +217,41 @@ else return (NonRepository "Not a repository") maybeIdentifyRepository opts url' = do url <- toPath `fmap` ioAbsoluteOrRemote url'- rf_or_e <- identifyRepoFormat url+ rf_or_e <- tryIdentifyRepoFormat url case rf_or_e of Left e -> return $ NonRepository e Right rf -> case readProblem rf of Just err -> return $ BadRepository err Nothing -> do cs <- getCaches opts url- return $ GoodRepository $ Repo url opts rf (DarcsRepository nopristine cs)+ return $ GoodRepository $ Repo url opts rf (DarcsRepository NoPristine cs) -identifyDarcs1Repository :: [DarcsFlag] -> String -> IO (Repository Patch C(r u t))-identifyDarcs1Repository opts url =+identifyPristine :: IO Pristine+identifyPristine =+ do pristine <- doesDirectoryExist $ darcsdir++"/pristine"+ current <- doesDirectoryExist $ darcsdir++"/current"+ hashinv <- doesFileExist $ darcsdir++"/hashed_inventory"+ case (pristine || current, hashinv) of+ (False, False) -> return NoPristine+ (True, False) -> return PlainPristine+ (False, True ) -> return HashedPristine+ _ -> fail "Multiple pristine trees."++-- | identifyDarcsRepository identifies the repo at 'url'. Warning:+-- you have to know what kind of patches are found in that repo.+identifyDarcsRepository :: forall p C(r u t). [DarcsFlag] -> String+ -> IO (Repository p C(r u t))+identifyDarcsRepository opts url = do er <- maybeIdentifyRepository opts url case er of BadRepository s -> fail s NonRepository s -> fail s GoodRepository r -> return r +-- | @identifyRepositoryFor repo url@ identifies (and returns) the repo at 'url',+-- but fails if it is not compatible for reading from and writing to. identifyRepositoryFor :: forall p C(r u t). RepoPatch p => Repository p C(r u t) -> String -> IO (Repository p C(r u t)) identifyRepositoryFor (Repo _ opts rf _) url =- do Repo absurl _ rf_ t <- identifyDarcs1Repository opts url+ do Repo absurl _ rf_ t <- identifyDarcsRepository opts url let t' = case t of DarcsRepository x c -> DarcsRepository x c case readfromAndWritetoProblem rf_ rf of Just e -> fail $ "Incompatibility with repository " ++ url ++ ":\n" ++ e@@ -244,22 +266,35 @@ BadRepository e -> return (Left $ "While " ++ d ++ " looks like a repository directory, we have a problem with it:\n" ++ e) NonRepository _ -> return (Left "You need to be in a repository directory to run this command.") amInRepository (_:fs) = amInRepository fs-amInRepository [] =- seekRepo (Left "You need to be in a repository directory to run this command.")+amInRepository [] = do+ maybe (Left $ "You need to be in a repository directory " +++ "to run this command.") id <$> seekRepo +amInHashedRepository :: [DarcsFlag] -> IO (Either String ())+amInHashedRepository flags+ = do inrepo <- amInRepository flags+ case inrepo of+ Right _ -> do pristine <- identifyPristine+ case pristine of+ HashedPristine -> return (Right ())+ _ -> return (Left Old.oldRepoFailMsg)+ left -> return left+ -- | hunt upwards for the darcs repository -- This keeps changing up one parent directory, testing at each -- step if the current directory is a repository or not. $+-- The result is:+-- Nothing, if no repository found+-- Just (Left errorMessage), if bad repository found+-- Just (Right ()), if good repository found. -- WARNING this changes the current directory for good if matchFn succeeds-seekRepo :: Either String ()- -- ^ what to return if we don't find a repository- -> IO (Either String ())-seekRepo onFail = getCurrentDirectory >>= helper where+seekRepo :: IO (Maybe (Either String ()))+seekRepo = getCurrentDirectory >>= helper where helper startpwd = do status <- maybeIdentifyRepository [] "." case status of- GoodRepository _ -> return (Right ())- BadRepository e -> return (Left e)+ GoodRepository _ -> return . Just $ Right ()+ BadRepository e -> return . Just $ Left e NonRepository _ -> do cd <- toFilePath `fmap` getCurrentDirectory setCurrentDirectory ".."@@ -267,7 +302,7 @@ if cd' /= cd then helper startpwd else do setCurrentDirectory startpwd- return onFail+ return Nothing -- The performGC in this function is a workaround for a library/GHC bug, -- http://hackage.haskell.org/trac/ghc/ticket/2924 -- (doesn't seem to be a@@ -294,20 +329,21 @@ do setCurrentDirectory d `catchall` (fail $ "can't set directory to "++d) findRepository [] findRepository (_:fs) = findRepository fs-findRepository [] = seekRepo (Right ())+findRepository [] = maybe (Right ()) id <$> seekRepo makeNewPending :: forall p C(r u t y). RepoPatch p- => Repository p C(r u t) -> FL Prim C(t y) -> IO ()+ => Repository p C(r u t) -> FL (PrimOf p) C(t y) -> IO () makeNewPending (Repo _ opts _ _) _ | NoUpdateWorking `elem` opts = return () makeNewPending repo@(Repo r _ _ tp) origp = withCurrentDirectory r $ do let newname = pendingName tp ++ ".new" debugMessage $ "Writing new pending: " ++ newname Sealed sfp <- return $ siftForPending origp- writeSealedPatch newname $ seal $ fromPrims $ sfp+ writeNewPending repo sfp cur <- readRecorded repo- Sealed p <- readPendingfile newname- catch (applyToTree p cur) $ \err -> do+ Sealed p <- readNewPending repo :: IO (Sealed (FL (PrimOf p) C(t)))+-- Warning: A do-notation statement discarded a result of type Tree.Tree IO.+ _ <- catch (applyToTree p cur) $ \err -> do let buggyname = pendingName tp ++ "_buggy" renameFile newname buggyname bugDoc $ text ("There was an attempt to write an invalid pending! " ++ show err)@@ -316,10 +352,8 @@ $$ text "along with a bug report." renameFile newname (pendingName tp) debugMessage $ "Finished writing new pending: " ++ newname- where writeSealedPatch :: FilePath -> Sealed (Patch C(x)) -> IO ()- writeSealedPatch fp (Sealed p) = writePatch fp p -siftForPending :: FL Prim C(x y) -> Sealed (FL Prim C(x))+siftForPending :: forall prim C(x y) . PrimPatch prim => FL prim C(x y) -> Sealed (FL prim C(x)) siftForPending simple_ps = let oldps = maybe simple_ps id $ tryShrinkingInverse $ crudeSift simple_ps in if allFL (\p -> primIsAddfile p || primIsAdddir p) $ oldps@@ -329,7 +363,7 @@ return (case tryToShrink x of ps | lengthFL ps < lengthFL oldps -> siftForPending ps | otherwise -> seal ps)- where sfp :: FL Prim C(a b) -> RL Prim C(c a) -> Sealed (FL Prim C(c))+ where sfp :: FL prim C(a b) -> RL prim C(c a) -> Sealed (FL prim C(c)) sfp sofar NilRL = seal sofar sfp sofar (p:<:ps) | primIsHunk p || primIsBinary p@@ -343,23 +377,20 @@ -- by fixing DarcsRepo to match HashedRepo in the handling of -- Repository state. readRepo :: RepoPatch p => Repository p C(r u t) -> IO (PatchSet p C(Origin r))-readRepo repo@(Repo r opts rf _)- | formatHas HashedInventory rf = do ps <- HashedRepo.readRepo repo r- return ps- | otherwise = do Sealed ps <- DarcsRepo.readRepo opts r+readRepo repo@(Repo r _ rf _)+ | formatHas HashedInventory rf = HashedRepo.readRepo repo r+ | otherwise = do Sealed ps <- Old.readOldRepo r return $ unsafeCoerceP ps readTentativeRepo :: RepoPatch p => Repository p C(r u t) -> IO (PatchSet p C(Origin t))-readTentativeRepo repo@(Repo r opts rf _)- | formatHas HashedInventory rf = do ps <- HashedRepo.readTentativeRepo repo r- return ps- | otherwise = do Sealed ps <- DarcsRepo.readTentativeRepo opts r- return $ unsafeCoerceP ps+readTentativeRepo repo@(Repo r _ rf _)+ | formatHas HashedInventory rf = HashedRepo.readTentativeRepo repo r+ | otherwise = fail Old.oldRepoFailMsg makePatchLazy :: RepoPatch p => Repository p C(r u t) -> PatchInfoAnd p C(x y) -> IO (PatchInfoAnd p C(x y)) makePatchLazy (Repo r opts rf (DarcsRepository _ c)) p | formatHas HashedInventory rf = withCurrentDirectory r $ HashedRepo.writeAndReadPatch c (compression opts) p- | otherwise = withCurrentDirectory r $ DarcsRepo.writeAndReadPatch opts p+ | otherwise = fail Old.oldRepoFailMsg prefsUrl :: Repository p C(r u t) -> String prefsUrl (Repo r _ _ (DarcsRepository _ _)) = r ++ "/"++darcsdir++"/prefs"@@ -367,24 +398,24 @@ unrevertUrl :: Repository p C(r u t) -> String unrevertUrl (Repo r _ _ (DarcsRepository _ _)) = r ++ "/"++darcsdir++"/patches/unrevert" -applyToWorking :: Patchy p => Repository p1 C(r u t) -> [DarcsFlag] -> p C(u y) -> IO (Repository p1 C(r y t))+applyToWorking :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag] -> FL (PrimOf p) C(u y) -> IO (Repository p C(r y t)) applyToWorking (Repo r ropts rf (DarcsRepository t c)) opts patch = do withCurrentDirectory r $ if Quiet `elem` opts- then runSilently $ apply opts patch- else runTolerantly $ apply opts patch+ then runSilently $ apply patch+ else runTolerantly $ apply patch return (Repo r ropts rf (DarcsRepository t c)) -handlePendForAdd :: forall p q C(r u t x y). (RepoPatch p, Effect q)- => Repository p C(r u t) -> q C(x y) -> IO ()+handlePendForAdd :: forall p C(r u t x y). (RepoPatch p)+ => Repository p C(r u t) -> PatchInfoAnd p C(x y) -> IO () handlePendForAdd (Repo _ opts _ _) _ | NoUpdateWorking `elem` opts = return ()-handlePendForAdd (Repo _ _ _ rt) p =- do let pn = pendingName rt ++ ".tentative"- Sealed pend <- (readPrims `fmap` gzReadFilePS pn) `catchall` (return $ Sealed NilFL)+handlePendForAdd repo p =+ do+ Sealed pend <- readTentativePending repo let effectp = if allFL isSimple pend then crudeSift $ effect p else effect p- Sealed newpend <- return $ rmpend (progressFL "Removing from pending:" effectp) pend- writePatch pn $ fromPrims_ newpend- where rmpend :: FL Prim C(a b) -> FL Prim C(a c) -> Sealed (FL Prim C(b))+ Sealed newpend <- return $ rmpend (progressFL "Removing from pending:" effectp) (unsafeCoercePStart pend)+ writeTentativePending repo (unsafeCoercePStart newpend)+ where rmpend :: FL (PrimOf p) C(a b) -> FL (PrimOf p) C(a c) -> Sealed (FL (PrimOf p) C(b)) rmpend NilFL x = Sealed x rmpend _ NilFL = Sealed NilFL rmpend (x:>:xs) xys | Just ys <- removeFL x xys = rmpend xs ys@@ -399,15 +430,13 @@ -- reached, but it also -- shouldn't lead to -- corruption.- fromPrims_ :: FL Prim C(a b) -> Patch C(a b)- fromPrims_ = fromPrims -isSimple :: Prim C(x y) -> Bool+isSimple :: PrimPatch prim => prim C(x y) -> Bool isSimple x = primIsHunk x || primIsBinary x || primIsSetpref x -crudeSift :: FL Prim C(x y) -> FL Prim C(x y)+crudeSift :: forall prim C(x y) . PrimPatch prim => FL prim C(x y) -> FL prim C(x y) crudeSift xs = if allFL isSimple xs then filterFLFL ishunkbinary xs else xs- where ishunkbinary :: Prim C(x y) -> EqCheck C(x y)+ where ishunkbinary :: prim C(a b) -> EqCheck C(a b) ishunkbinary x | primIsHunk x || primIsBinary x = unsafeCoerceP IsEq | otherwise = NotEq @@ -420,9 +449,9 @@ data MakeChanges = MakeChanges | DontMakeChanges deriving ( Eq ) -announceMergeConflicts :: String -> [DarcsFlag] -> FL Prim C(x y) -> IO Bool+announceMergeConflicts :: (PrimPatch p, PatchInspect p) => String -> [DarcsFlag] -> FL p C(x y) -> IO Bool announceMergeConflicts cmd opts resolved_pw =- case nubsort $ listTouchedFiles $ resolved_pw of+ case nubsort $ listTouchedFiles resolved_pw of [] -> return False cfs -> if MarkConflicts `elem` opts || AllowConflicts `elem` opts || wantExternalMerge opts /= Nothing@@ -441,10 +470,10 @@ checkUnrecordedConflicts :: forall p C(t y). RepoPatch p => [DarcsFlag] -> FL (Named p) C(t y) -> IO Bool checkUnrecordedConflicts opts _ | NoUpdateWorking `elem` opts = return False checkUnrecordedConflicts opts pc =- do repository <- identifyDarcs1Repository opts "."+ do repository <- identifyDarcsRepository opts "." cuc repository- where cuc :: Repository Patch C(r u t) -> IO Bool- cuc r = do Sealed mpend <- readPending r :: IO (Sealed (FL Prim C(t)))+ where cuc :: Repository p C(r u t) -> IO Bool+ cuc r = do Sealed (mpend :: FL (PrimOf p) C(t x)) <- readPending r :: IO (Sealed (FL (PrimOf p) C(t))) case mpend of NilFL -> return False pend ->@@ -454,131 +483,121 @@ [] -> return False fs -> do putStrLn ("You have conflicting local changes to:\n" ++ unwords fs)- yorn <- promptYorn "Proceed?"- when (yorn /= 'y') $+ confirmed <- promptYorn "Proceed?"+ unless confirmed $ do putStrLn "Cancelled." exitWith ExitSuccess return True- fromPrims_ :: FL Prim C(a b) -> p C(a b)+ fromPrims_ :: FL (PrimOf p) C(a b) -> FL p C(a b) fromPrims_ = fromPrims tentativelyAddPatch :: RepoPatch p- => Repository p C(r u t) -> [DarcsFlag] -> PatchInfoAnd p C(t y) -> IO (Repository p C(r u y))+ => Repository p C(r u t) -> Compression -> PatchInfoAnd p C(t y) -> IO (Repository p C(r u y)) tentativelyAddPatch = tentativelyAddPatch_ UpdatePristine data UpdatePristine = UpdatePristine | DontUpdatePristine deriving Eq +-- TODO re-add a safety catch for --dry-run? Maybe using a global, like dryRun+-- :: Bool, with dryRun = unsafePerformIO $ readIORef ... tentativelyAddPatch_ :: RepoPatch p- => UpdatePristine -> Repository p C(r u t) -> [DarcsFlag]+ => UpdatePristine -> Repository p C(r u t) -> Compression -> PatchInfoAnd p C(t y) -> IO (Repository p C(r u y))-tentativelyAddPatch_ _ _ opts _- | DryRun `elem` opts = bug "tentativelyAddPatch_ called when --dry-run is specified"-tentativelyAddPatch_ up r@(Repo dir ropts rf (DarcsRepository t c)) opts p =+tentativelyAddPatch_ up r@(Repo dir ropts rf (DarcsRepository t c)) compr p = withCurrentDirectory dir $- do decideHashedOrNormal rf $ HvsO {- hashed = HashedRepo.addToTentativeInventory c (compression opts) p,- old = DarcsRepo.addToTentativeInventory opts (hopefully p) }+-- Warning: A do-notation statement discarded a result of type FilePath.+ do _ <- decideHashedOrNormal rf $ HvsO {+ hashed = HashedRepo.addToTentativeInventory c compr p,+ old = fail Old.oldRepoFailMsg} when (up == UpdatePristine) $ do debugMessage "Applying to pristine cache..." applyToTentativePristine r p debugMessage "Updating pending..." handlePendForAdd r p return (Repo dir ropts rf (DarcsRepository t c)) -applyToTentativePristine :: (Effect q, Patchy q) => Repository p C(r u t) -> q C(t y) -> IO ()-applyToTentativePristine (Repo dir opts rf (DarcsRepository _ c)) p =+applyToTentativePristine :: (Effect q, Patchy q, PrimPatchBase q) => Repository p C(r u t) -> q C(t y) -> IO ()+applyToTentativePristine (Repo dir opts rf (DarcsRepository _ _)) p = withCurrentDirectory dir $ do when (Verbose `elem` opts) $ putDocLn $ text "Applying to pristine..." <+> description p- decideHashedOrNormal rf $ HvsO {hashed = HashedRepo.applyToTentativePristine opts p,- old = DarcsRepo.addToTentativePristine p}+ decideHashedOrNormal rf $ HvsO {hashed = HashedRepo.applyToTentativePristine p,+ old = fail Old.oldRepoFailMsg} -- | This fuction is unsafe because it accepts a patch that works on the tentative -- pending and we don't currently track the state of the tentative pending. tentativelyAddToPending :: forall p C(r u t x y). RepoPatch p- => Repository p C(r u t) -> [DarcsFlag] -> FL Prim C(x y) -> IO ()+ => Repository p C(r u t) -> [DarcsFlag] -> FL (PrimOf p) C(x y) -> IO () tentativelyAddToPending (Repo _ opts _ _) _ _ | NoUpdateWorking `elem` opts = return () | DryRun `elem` opts = bug "tentativelyAddToPending called when --dry-run is specified"-tentativelyAddToPending (Repo dir _ _ rt) _ patch =+tentativelyAddToPending repo@(Repo dir _ _ _) _ patch = withCurrentDirectory dir $ do- let pn = pendingName rt- tpn = pn ++ ".tentative"- Sealed pend <- readPrims `liftM` (gzReadFilePS tpn `catchall` (return B.empty))- FlippedSeal newpend_ <- return $ newpend (unsafeCoerceP pend :: FL Prim C(a x)) patch- writePatch tpn $ fromPrims_ newpend_- where newpend :: FL Prim C(a b) -> FL Prim C(b c) -> FlippedSeal (FL Prim) C(c)+ Sealed pend <- readTentativePending repo+ FlippedSeal newpend_ <- return $ newpend (unsafeCoerceP pend :: FL (PrimOf p) C(a x)) patch+ writeTentativePending repo (unsafeCoercePStart newpend_)+ where newpend :: FL prim C(a b) -> FL prim C(b c) -> FlippedSeal (FL prim) C(c) newpend NilFL patch_ = flipSeal patch_ newpend p patch_ = flipSeal $ p +>+ patch_- fromPrims_ :: FL Prim C(a b) -> Patch C(a b)- fromPrims_ = fromPrims -- | setTentativePending is basically unsafe. It overwrites the pending state with a new one, not related to -- the repository state.-setTentativePending :: forall p C(r u t x y). RepoPatch p => Repository p C(r u t) -> FL Prim C(x y) -> IO ()+setTentativePending :: forall p C(r u t x y). RepoPatch p => Repository p C(r u t) -> FL (PrimOf p) C(x y) -> IO () setTentativePending (Repo _ opts _ _) _ | NoUpdateWorking `elem` opts = return ()-setTentativePending (Repo dir _ _ rt) patch = do+setTentativePending repo@(Repo dir _ _ _) patch = do Sealed prims <- return $ siftForPending patch- withCurrentDirectory dir $- writePatch (pendingName rt ++ ".tentative") $ fromPrims_ prims- where fromPrims_ :: FL Prim C(a b) -> Patch C(a b)- fromPrims_ = fromPrims+ withCurrentDirectory dir $ writeTentativePending repo (unsafeCoercePStart prims) -- | prepend is basically unsafe. It overwrites the pending state -- with a new one, not related to the repository state. prepend :: forall p C(r u t x y). RepoPatch p =>- Repository p C(r u t) -> FL Prim C(x y) -> IO ()+ Repository p C(r u t) -> FL (PrimOf p) C(x y) -> IO () prepend (Repo _ opts _ _) _ | NoUpdateWorking `elem` opts = return ()-prepend (Repo _ _ _ rt) patch =- do let pn = pendingName rt ++ ".tentative"- Sealed pend <- readPrims `liftM` (gzReadFilePS pn `catchall` (return B.empty))- Sealed newpend_ <- return $ newpend pend patch- writePatch pn $ fromPrims_ (crudeSift newpend_)- where newpend :: FL Prim C(b c) -> FL Prim C(a b) -> Sealed (FL Prim C(a))+prepend repo@(Repo _ _ _ _) patch =+ do+ Sealed pend <- readTentativePending repo+ Sealed newpend_ <- return $ newpend (unsafeCoerceP pend) patch+ writeTentativePending repo (unsafeCoercePStart $ crudeSift newpend_)+ where newpend :: FL prim C(b c) -> FL prim C(a b) -> Sealed (FL prim C(a)) newpend NilFL patch_ = seal patch_ newpend p patch_ = seal $ patch_ +>+ p- fromPrims_ :: FL Prim C(a b) -> Patch C(a b)- fromPrims_ = fromPrims -tentativelyRemovePatches :: RepoPatch p => Repository p C(r u t) -> [DarcsFlag]+tentativelyRemovePatches :: RepoPatch p => Repository p C(r u t) -> Compression -> FL (PatchInfoAnd p) C(x t) -> IO (Repository p C(r u x)) tentativelyRemovePatches = tentativelyRemovePatches_ UpdatePristine tentativelyRemovePatches_ :: forall p C(r u t x). RepoPatch p => UpdatePristine- -> Repository p C(r u t) -> [DarcsFlag]+ -> Repository p C(r u t) -> Compression -> FL (PatchInfoAnd p) C(x t) -> IO (Repository p C(r u x))-tentativelyRemovePatches_ up repository@(Repo dir ropts rf (DarcsRepository t c)) opts ps =+tentativelyRemovePatches_ up repository@(Repo dir ropts rf (DarcsRepository t c)) compr ps = withCurrentDirectory dir $ do when (up == UpdatePristine) $ do debugMessage "Adding changes to pending..." prepend repository $ effect ps removeFromUnrevertContext repository ps debugMessage "Removing changes from tentative inventory..." if formatHas HashedInventory rf- then do HashedRepo.removeFromTentativeInventory repository (compression opts) ps+ then do HashedRepo.removeFromTentativeInventory repository compr ps when (up == UpdatePristine) $- HashedRepo.applyToTentativePristine opts $+ HashedRepo.applyToTentativePristine $ progressFL "Applying inverse to pristine" $ invert ps- else DarcsRepo.removeFromTentativeInventory (up==UpdatePristine) opts ps+ else fail Old.oldRepoFailMsg return (Repo dir ropts rf (DarcsRepository t c)) -tentativelyReplacePatches :: forall p C(r u t x). RepoPatch p => Repository p C(r u t) -> [DarcsFlag]+tentativelyReplacePatches :: forall p C(r u t x). RepoPatch p => Repository p C(r u t) -> Compression -> FL (PatchInfoAnd p) C(x t) -> IO (Repository p C(r u t))-tentativelyReplacePatches repository opts ps =- do repository' <- tentativelyRemovePatches_ DontUpdatePristine repository opts ps+tentativelyReplacePatches repository compr ps =+ do repository' <- tentativelyRemovePatches_ DontUpdatePristine repository compr ps mapAdd repository' ps where mapAdd :: Repository p C(m l i) -> FL (PatchInfoAnd p) C(i j) -> IO (Repository p C(m l j)) mapAdd r NilFL = return r mapAdd r (a:>:as) =- do r' <- tentativelyAddPatch_ DontUpdatePristine r opts a+ do r' <- tentativelyAddPatch_ DontUpdatePristine r compr a mapAdd r' as finalizePending :: RepoPatch p => Repository p C(r u t) -> IO () finalizePending (Repo dir opts _ rt) | NoUpdateWorking `elem` opts = withCurrentDirectory dir $ removeFileMayNotExist $ (pendingName rt)-finalizePending repository@(Repo dir _ _ rt) = do- withCurrentDirectory dir $ do let pn = pendingName rt- tpn = pn ++ ".tentative"- tpfile <- gzReadFilePS tpn `catchall` (return B.empty)- Sealed tpend <- return $ readPrims tpfile+finalizePending repository@(Repo dir _ _ _) = do+ withCurrentDirectory dir $ do+ Sealed tpend <- readTentativePending repository Sealed new_pending <- return $ siftForPending tpend makeNewPending repository new_pending @@ -588,36 +607,31 @@ finalizeRepositoryChanges repository@(Repo dir opts rf _) | formatHas HashedInventory rf = withCurrentDirectory dir $ do debugMessage "Considering whether to test..."- testTentative repository+ _ <- testTentative repository debugMessage "Finalizing changes..." withSignalsBlocked $ do HashedRepo.finalizeTentativeChanges repository (compression opts) finalizePending repository debugMessage "Done finalizing changes..."-finalizeRepositoryChanges repository@(Repo dir _ _ (DarcsRepository _ _)) =- withCurrentDirectory dir $ do debugMessage "Considering whether to test..."- testTentative repository- debugMessage "Finalizing changes..."- withSignalsBlocked $ do DarcsRepo.finalizePristineChanges- DarcsRepo.finalizeTentativeChanges- finalizePending repository+ | otherwise = fail Old.oldRepoFailMsg -testTentative :: RepoPatch p => Repository p C(r u t) -> IO ()+testTentative :: RepoPatch p => Repository p C(r u t) -> IO (ExitCode) testTentative = testAny withTentative -testRecorded :: RepoPatch p => Repository p C(r u t) -> IO ()+testRecorded :: RepoPatch p => Repository p C(r u t) -> IO (ExitCode) testRecorded = testAny withRecorded testAny :: RepoPatch p => (Repository p C(r u t)- -> ((AbsolutePath -> IO ()) -> IO ())- -> (AbsolutePath -> IO ()) -> IO ())- -> Repository p C(r u t) -> IO ()+ -> ((AbsolutePath -> IO (ExitCode)) -> IO (ExitCode))+ -> ((AbsolutePath -> IO (ExitCode)) -> IO (ExitCode)))+ -> Repository p C(r u t) -> IO (ExitCode) testAny withD repository@(Repo dir opts _ _) =- when (Test `elem` opts) $ withCurrentDirectory dir $- do let putInfo = if not $ Quiet `elem` opts then putStrLn else const (return ())+ debugMessage "Considering whether to test..." >>+ if not $ Test `elem` opts then return ExitSuccess else withCurrentDirectory dir $+ do let putInfo = if Quiet `elem` opts then const (return ()) else putStrLn debugMessage "About to run test if it exists." testline <- getPrefval "test" case testline of- Nothing -> return ()+ Nothing -> return ExitSuccess Just testcode -> withD repository (wd "testing") $ \_ -> do putInfo "Running test...\n"@@ -625,8 +639,8 @@ ec <- system testcode if ec == ExitSuccess then putInfo "Test ran successfully.\n"- else do putInfo "Test failed!\n"- exitWith ec+ else putInfo "Test failed!\n"+ return ec where wd = if LeaveTestDir `elem` opts then withPermDir else withTempDir revertRepositoryChanges :: RepoPatch p => Repository p C(r u t) -> IO ()@@ -636,10 +650,10 @@ withCurrentDirectory dir $ do removeFileMayNotExist (pendingName dr ++ ".tentative") Sealed x <- readPending r- setTentativePending r $ effect x+ setTentativePending r x when (NoUpdateWorking `elem` opts) $ removeFileMayNotExist $ pendingName dr decideHashedOrNormal rf $ HvsO { hashed = HashedRepo.revertTentativeChanges,- old = DarcsRepo.revertTentativeChanges }+ old = Old.revertTentativeChanges } patchSetToPatches :: RepoPatch p => PatchSet p C(x y) -> FL (Named p) C(x y) patchSetToPatches patchSet = mapFL_FL hopefully $ newset2FL patchSet@@ -649,61 +663,62 @@ getUMask ((UMask u):_) = Just u getUMask (_:l) = getUMask l -withGutsOf :: Repository p C(r u t) -> IO () -> IO ()+withUMaskFromOpts :: [DarcsFlag] -> IO a -> IO a+withUMaskFromOpts = maybe id withUMask . getUMask++withGutsOf :: Repository p C(r u t) -> IO a -> IO a withGutsOf (Repo _ _ rf _) | formatHas HashedInventory rf = id | otherwise = withSignalsBlocked -withRepository :: [DarcsFlag] -> (forall p C(r u). RepoPatch p => Repository p C(r u r) -> IO a) -> IO a+data RepoJob a+ = RepoJob (forall p C(r u) . RepoPatch p => Repository p C(r u r) -> IO a)+ | V1Job (forall C(r u) . Repository (Patch Prim) C(r u r) -> IO a)+ | V2Job (forall C(r u) . Repository (RealPatch Prim) C(r u r) -> IO a)++onRepoJob :: RepoJob a+ -> (forall p C(r u) . RepoPatch p => (Repository p C(r u r) -> IO a) -> (Repository p C(r u r) -> IO a))+ -> RepoJob a+onRepoJob (RepoJob job) f = RepoJob (f job)+onRepoJob (V1Job job) f = V1Job (f job)+onRepoJob (V2Job job) f = V2Job (f job)++withRepository :: [DarcsFlag] -> RepoJob a -> IO a withRepository opts1 = withRepositoryDirectory opts1 "." -withRepositoryDirectory :: forall a. [DarcsFlag] -> String- -> (forall p C(r u). RepoPatch p => Repository p C(r u r) -> IO a) -> IO a-withRepositoryDirectory opts1 url job =- do Repo dir opts rf rt <- identifyDarcs1Repository opts1 url- let rt' = case rt of DarcsRepository t c -> DarcsRepository t c+withRepositoryDirectory :: forall a. [DarcsFlag] -> String -> RepoJob a -> IO a+withRepositoryDirectory opts1 url repojob =+ do Repo dir opts rf (DarcsRepository t c) <- identifyDarcsRepository opts1 url if formatHas Darcs2 rf then do debugMessage $ "Identified darcs-2 repo: " ++ dir- job1_ (Repo dir opts rf rt')+ let therepo = Repo dir opts rf (DarcsRepository t c) :: Repository (RealPatch Prim) C(r u r)+ case repojob of+ RepoJob job -> job therepo+ V2Job job -> job therepo+ V1Job _ -> fail "This repository contains darcs v1 patches, but the command requires darcs v2 patches." else do debugMessage $ "Identified darcs-1 repo: " ++ dir- job2_ (Repo dir opts rf rt)- where job1_ :: Repository (FL RealPatch) C(r u r) -> IO a- job1_ = job- job2_ :: Repository Patch C(r u r) -> IO a- job2_ = job----- RankNTypes--- $- works around the lack of impredicative instantiation in GHC-($-) ::((forall p C(r u). RepoPatch p => Repository p C(r u r) -> IO a) -> IO a)- -> (forall p C(r u). RepoPatch p => Repository p C(r u r) -> IO a) -> IO a-x $- y = x y+ let therepo = Repo dir opts rf (DarcsRepository t c) :: Repository (Patch Prim) C(r u r)+ case repojob of+ RepoJob job -> job therepo+ V1Job job -> job therepo+ V2Job _ -> fail "This repository contains darcs v2 patches, but the command requires darcs v1 patches." -withRepoLock :: [DarcsFlag] -> (forall p C(r u). RepoPatch p => Repository p C(r u r) -> IO a) -> IO a-withRepoLock opts job =- withRepository opts $- \repository@(Repo _ _ rf _) ->- do case writeProblem rf of- Nothing -> return ()- Just err -> fail err+withRepoLock :: [DarcsFlag] -> RepoJob a -> IO a+withRepoLock opts repojob =+ withRepository opts $ onRepoJob repojob $ \job repository@(Repo _ _ rf _) ->+ do maybe (return ()) fail $ writeProblem rf let name = "./"++darcsdir++"/lock"- wu = case (getUMask opts) of- Nothing -> id- Just u -> withUMask u- wu $ if DryRun `elem` opts- then job repository- else withLock name (revertRepositoryChanges repository >> job repository)+ withUMaskFromOpts opts $ if DryRun `elem` opts+ then job repository+ else withLock name (revertRepositoryChanges repository >> job repository) -withRepoReadLock :: [DarcsFlag] -> (forall p C(r u). RepoPatch p => Repository p C(r u r) -> IO a) -> IO a-withRepoReadLock opts job =- withRepository opts $- \repository@(Repo _ _ rf _) ->- do case writeProblem rf of- Nothing -> return ()- Just err -> fail err+withRepoReadLock :: [DarcsFlag] -> RepoJob a -> IO a+withRepoReadLock opts repojob =+ withRepository opts $ onRepoJob repojob $ \job repository@(Repo _ _ rf _) ->+ do maybe (return ()) fail $ writeProblem rf let name = "./"++darcsdir++"/lock"- wu = case (getUMask opts) of Nothing -> id- Just u -> withUMask u- wu $ if formatHas HashedInventory rf || DryRun `elem` opts- then job repository- else withLock name (revertRepositoryChanges repository >> job repository)+ withUMaskFromOpts opts $ if formatHas HashedInventory rf || DryRun `elem` opts+ then job repository+ else withLock name (revertRepositoryChanges repository >> job repository) removeFromUnrevertContext :: forall p C(r u t x). RepoPatch p => Repository p C(r u t) -> FL (PatchInfoAnd p) C(x t) -> IO ()@@ -711,11 +726,9 @@ Sealed bundle <- unrevert_patch_bundle `catchall` (return $ seal (PatchSet NilRL NilRL)) remove_from_unrevert_context_ bundle where unrevert_impossible =- do yorn <- promptYorn "This operation will make unrevert impossible!\nProceed?"- case yorn of- 'n' -> fail "Cancelled."- 'y' -> removeFileMayNotExist (unrevertUrl repository)- _ -> impossible+ do confirmed <- promptYorn "This operation will make unrevert impossible!\nProceed?"+ if confirmed then removeFileMayNotExist (unrevertUrl repository)+ else fail "Cancelled." unrevert_patch_bundle :: IO (SealedPatchSet p C(Origin)) unrevert_patch_bundle = do pf <- B.readFile (unrevertUrl repository) case scanBundle pf of@@ -740,8 +753,8 @@ Nothing -> unrevert_impossible Just common -> do debugMessage "Have now found the new context..."- bundle <- makeBundleN Nothing common (hopefully us':>:NilFL)- writeDocBinFile (unrevertUrl repository) bundle+ bundle' <- makeBundleN Nothing common (hopefully us':>:NilFL)+ writeDocBinFile (unrevertUrl repository) bundle' debugMessage "Done adjusting the context of the unrevert changes!" -- | Writes out a fresh copy of the inventory that minimizes the@@ -756,45 +769,36 @@ -- history traversal is needed. This latter issue can become very -- important in large repositories. optimizeInventory :: RepoPatch p => Repository p C(r u t) -> IO ()-optimizeInventory repository@(Repo r opts rf (DarcsRepository _ c)) =+optimizeInventory repository@(Repo _ opts rf (DarcsRepository _ c)) = do ps <- readRepo repository decideHashedOrNormal rf $ HvsO { hashed = do revertRepositoryChanges repository HashedRepo.writeTentativeInventory c (compression opts) $ deepOptimizePatchset ps finalizeRepositoryChanges repository,- old = DarcsRepo.writeInventory r $ deepOptimizePatchset ps- }+ old = fail Old.oldRepoFailMsg} cleanRepository :: RepoPatch p => Repository p C(r u t) -> IO () cleanRepository repository@(Repo _ _ rf _) = decideHashedOrNormal rf $ HvsO { hashed = HashedRepo.cleanPristine repository,- old = return () }+ old = fail Old.oldRepoFailMsg} createPristineDirectoryTree :: RepoPatch p => Repository p C(r u t) -> FilePath -> IO ()-createPristineDirectoryTree repo@(Repo r opts rf (DarcsRepository pris c)) reldir+createPristineDirectoryTree (Repo r opts rf (DarcsRepository _ c)) reldir | formatHas HashedInventory rf = do createDirectoryIfMissing True reldir withCurrentDirectory reldir $ HashedRepo.copyPristine c (compression opts) r (darcsdir++"/hashed_inventory")- | otherwise =- do dir <- toPath `fmap` ioAbsoluteOrRemote reldir- done <- withCurrentDirectory r $ easyCreatePristineDirectoryTree pris dir- unless done $ do Sealed patches <- (seal . newset2FL) `liftM` readRepo repo- createDirectoryIfMissing True dir- withCurrentDirectory dir $ applyPatches [] patches+ | otherwise = fail Old.oldRepoFailMsg -- fp below really should be FileName+-- | Used by the commands dist and diff createPartialsPristineDirectoryTree :: (FilePathLike fp, RepoPatch p) => Repository p C(r u t) -> [fp] -> FilePath -> IO () createPartialsPristineDirectoryTree (Repo r opts rf (DarcsRepository _ c)) prefs dir | formatHas HashedInventory rf = do createDirectoryIfMissing True dir withCurrentDirectory dir $ HashedRepo.copyPartialsPristine c (compression opts) r (darcsdir++"/hashed_inventory") prefs-createPartialsPristineDirectoryTree r@(Repo rdir _ _ (DarcsRepository pris _)) prefs dir- = withCurrentDirectory rdir $- do done <- easyCreatePartialsPristineDirectoryTree prefs pris dir- unless done $ withRecorded r (withTempDir "recorded") $ \_ -> do- clonePartialsTree "." dir (map toFilePath prefs)+ | otherwise = fail Old.oldRepoFailMsg withRecorded :: RepoPatch p => Repository p C(r u t) -> ((AbsolutePath -> IO a) -> IO a) -> (AbsolutePath -> IO a) -> IO a@@ -809,47 +813,34 @@ | formatHas HashedInventory rf = mk_dir $ \d -> do HashedRepo.copyPristine c (compression opts) dir (darcsdir++"/tentative_pristine") f d-withTentative repository@(Repo dir opts _ _) mk_dir f =+withTentative repository@(Repo dir _ _ _) mk_dir f = withRecorded repository mk_dir $ \d -> do Sealed ps <- read_patches (dir ++ "/"++darcsdir++"/tentative_pristine")- apply opts $ joinPatches ps+ apply ps f d where read_patches :: FilePath -> IO (Sealed (FL p C(x))) read_patches fil = do ps <- B.readFile fil- return $ case readPatch ps of- Just (x, _) -> x- Nothing -> seal NilFL--getMarkedupFile :: RepoPatch p => Repository p C(r u t) -> PatchInfo -> FilePath -> IO MarkedUpFile-getMarkedupFile repository pinfo f = do- Sealed (FlippedSeal patches) <- (seal . dropWhileFL ((/= pinfo) . info)- . newset2FL) `liftM` readRepo repository- return $ snd $ doMarkAll patches (f, emptyMarkedupFile)- where dropWhileFL :: (FORALL(x y) a C(x y) -> Bool) -> FL a C(r v) -> FlippedSeal (FL a) C(v)- dropWhileFL _ NilFL = flipSeal NilFL- dropWhileFL p xs@(x:>:xs')- | p x = dropWhileFL p xs'- | otherwise = flipSeal xs-doMarkAll :: RepoPatch p => FL (PatchInfoAnd p) C(x y)- -> (FilePath, MarkedUpFile) -> (FilePath, MarkedUpFile)-doMarkAll (hp:>:pps) (f, mk) =- case hopefullyM hp of- Just p -> doMarkAll pps $ markupFile (info hp) (patchcontents p) (f, mk)- Nothing -> (f, [(BC.pack "Error reading a patch!",None)])-doMarkAll NilFL (f, mk) = (f, mk)+ return $ maybe (seal NilFL) id $ readPatch ps -- | Sets scripts in or below the current directory executable. A script is any file that starts--- with the bytes '#!'. This is used sometimes for --set-scripts-executable, but at other times--- --set-scripts-executable is handled by the hunk patch case of applyFL.-setScriptsExecutable :: IO ()-setScriptsExecutable = do+-- with the bytes '#!'. This is used for --set-scripts-executable.+setScriptsExecutable_ :: Patchy p => Maybe (p C(x y)) -> IO ()+setScriptsExecutable_ pw = do debugMessage "Making scripts executable"- myname <- getCurrentDirectory tree <- readWorking- let paths = [ anchorPath "." p | (p, Tree.File _) <- Tree.list tree ]- setExecutableIfScript f =+ paths <- case pw of+ Just ps -> filterM doesFileExist $ listTouchedFiles ps+ Nothing -> return [ anchorPath "." p | (p, Tree.File _) <- Tree.list tree ]+ let setExecutableIfScript f = do contents <- B.readFile f when (BC.pack "#!" `B.isPrefixOf` contents) $ do debugMessage ("Making executable: " ++ f) setExecutable f True mapM_ setExecutableIfScript paths+++setScriptsExecutable :: IO ()+setScriptsExecutable = setScriptsExecutable_ (Nothing :: Maybe (FL DummyPatch C(x y)))++setScriptsExecutablePatches :: Patchy p => p C(x y) -> IO ()+setScriptsExecutablePatches = setScriptsExecutable_ . Just
src/Darcs/Repository/InternalTypes.hs view
@@ -14,9 +14,7 @@ -- along with this program; if not, write to the Free Software Foundation, -- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -{-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP #-}--- , KindSignatures #-} #include "gadts.h" @@ -31,10 +29,10 @@ import Darcs.Patch ( RepoPatch ) data Pristine- = NoPristine !String- | PlainPristine !String+ = NoPristine+ | PlainPristine | HashedPristine- deriving ( Show )+ deriving ( Show, Eq ) data Repository (p :: * C(-> * -> *)) C(recordedstate unrecordedstate tentativestate) = Repo !String ![DarcsFlag] !RepoFormat !(RepoType p) deriving ( Show ) @@ -51,4 +49,4 @@ modifyCache :: FORALL(p r u t) (RepoPatch p) => Repository p C(r u t) -> (Cache -> Cache) -> Repository p C(r u t) modifyCache (Repo dir opts rf (DarcsRepository pristine cache)) f = Repo dir opts rf dr where dr = DarcsRepository pristine . cmap ( sortBy compareByLocality . nub ) $ f cache- cmap f (Ca c) = Ca (f c)+ cmap g (Ca c) = Ca (g c)
src/Darcs/Repository/LowLevel.hs view
@@ -16,36 +16,92 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP #-} #include "gadts.h" -module Darcs.Repository.LowLevel ( readPending, readPendingfile, pendingName, readPrims ) where+module Darcs.Repository.LowLevel+ ( readPending, readTentativePending+ , writeTentativePending+ -- deprecated interface:+ , readNewPending, writeNewPending+ , pendingName )+ where import Darcs.Repository.InternalTypes ( RepoType(..), Repository(..) )-import Darcs.Patch ( readPatch, Prim, Patch, RepoPatch, effect )+import Darcs.Patch ( readPatch, writePatch, RepoPatch, PrimOf )+import Darcs.Patch.Read ( ReadPatch(..), bracketedFL )+import Darcs.Patch.ReadMonads ( ParserM )+import Darcs.Patch.Show ( ShowPatchBasic(..) ) import Darcs.Global ( darcsdir )-import Darcs.Witnesses.Sealed ( Sealed(Sealed) )-import Darcs.Witnesses.Ordered ( FL(..) )-import Darcs.Utils ( catchall, withCurrentDirectory )+import Darcs.Witnesses.Sealed ( Sealed(Sealed), mapSeal )+import Darcs.Witnesses.Ordered ( FL(..), mapFL )+import Darcs.Utils ( catchall ) import ByteStringUtils ( gzReadFilePS )+import Printer ( Doc, ($$), text, vcat )++import Control.Applicative import qualified Data.ByteString as BS ( ByteString, empty ) pendingName :: RepoType p -> String pendingName (DarcsRepository _ _) = darcsdir++"/patches/pending" -readPending :: RepoPatch p => Repository p C(r u t) -> IO (Sealed (FL Prim C(t)))-readPending (Repo r _ _ tp) =- withCurrentDirectory r (readPendingfile (pendingName tp))+-- | Read the contents of pending. CWD should be the repository directory.+-- The return type is currently incorrect as it refers to the tentative+-- state rather than the recorded state.+readPending :: RepoPatch p => Repository p C(r u t) -> IO (Sealed (FL (PrimOf p) C(t)))+readPending (Repo _ _ _ tp) =+ readPendingFile (pendingName tp) -readPendingfile :: String -> IO (Sealed (FL Prim C(x)))-readPendingfile name = do+-- |Read the contents of tentative pending. CWD should be the repository directory.+readTentativePending :: RepoPatch p => Repository p C(r u t) -> IO (Sealed (FL (PrimOf p) C(t)))+readTentativePending (Repo _ _ _ tp) =+ readPendingFile (pendingName tp ++ ".tentative")++-- |Read the contents of tentative pending. CWD should be the repository directory.+readNewPending :: RepoPatch p => Repository p C(r u t) -> IO (Sealed (FL (PrimOf p) C(t)))+readNewPending (Repo _ _ _ tp) =+ readPendingFile (pendingName tp ++ ".new")++readPendingFile :: ReadPatch prim => String -> IO (Sealed (FL prim C(x)))+readPendingFile name = do pend <- gzReadFilePS name `catchall` return BS.empty- return $ readPrims pend+ return $ readPendingContents pend -readPrims :: BS.ByteString -> Sealed (FL Prim C(x))-readPrims s = case readPatch s :: Maybe (Sealed (Patch C(x )), BS.ByteString) of- Nothing -> Sealed NilFL- Just (Sealed p,_) -> Sealed (effect p)+-- Wrapper around FL where printed format uses { } except around singletons+-- Now that the Show behaviour of FL p can be customised (using showFLBehavior),+-- we could instead change the general behaviour of FL Prim; but since the pending+-- code can be kept nicely compartmentalised, it's nicer to do it this way.+newtype FLM p C(x y) = FLM { unFLM :: FL p C(x y) } +instance ReadPatch p => ReadPatch (FLM p) where+ readPatch' = mapSeal FLM <$> readMaybeBracketedFL readPatch' '{' '}'++instance ShowPatchBasic p => ShowPatchBasic (FLM p) where+ showPatch = showMaybeBracketedFL showPatch '{' '}' . unFLM++readPendingContents :: ReadPatch prim => BS.ByteString -> Sealed (FL prim C(x))+readPendingContents = maybe (Sealed NilFL) (mapSeal unFLM) . readPatch++writePendingFile :: ShowPatchBasic prim => String -> FL prim C(x y) -> IO ()+writePendingFile name = writePatch name . FLM++readMaybeBracketedFL :: forall m p C(x) . ParserM m =>+ (FORALL(y) m (Sealed (p C(y)))) -> Char -> Char -> m (Sealed (FL p C(x)))+readMaybeBracketedFL parser pre post =+ bracketedFL parser pre post <|> (mapSeal (:>:NilFL) <$> parser)++showMaybeBracketedFL :: (FORALL(x y) p C(x y) -> Doc) -> Char -> Char -> FL p C(a b) -> Doc+showMaybeBracketedFL _ pre post NilFL = text [pre] $$ text [post]+showMaybeBracketedFL printer _ _ (p :>: NilFL) = printer p+showMaybeBracketedFL printer pre post ps = text [pre] $$ vcat (mapFL printer ps) $$ text [post]++-- |Read the contents of tentative pending. CWD should be the repository directory.+writeTentativePending :: RepoPatch p => Repository p C(r u t) -> FL (PrimOf p) C(t y) -> IO ()+writeTentativePending (Repo _ _ _ tp) pend =+ writePendingFile (pendingName tp ++ ".tentative") pend++-- |Read the contents of new pending. CWD should be the repository directory.+writeNewPending :: RepoPatch p => Repository p C(r u t) -> FL (PrimOf p) C(t y) -> IO ()+writeNewPending (Repo _ _ _ tp) pend =+ writePendingFile (pendingName tp ++ ".new") pend
src/Darcs/Repository/Merge.hs view
@@ -19,20 +19,19 @@ #include "gadts.h" -module Darcs.Repository.Merge where+module Darcs.Repository.Merge ( tentativelyMergePatches, considerMergeToWorking ) where import Darcs.Resolution ( standardResolution, externalResolution ) import Darcs.External ( backupByCopying ) import Control.Monad ( when, unless ) -import Darcs.Patch ( Effect )-import Darcs.Hopefully ( PatchInfoAnd, n2pia, hopefully )+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, n2pia, hopefully ) import Darcs.Flags- ( DarcsFlag( AllowConflicts, NoAllowConflicts ), wantExternalMerge )+ ( DarcsFlag( AllowConflicts, NoAllowConflicts ), wantExternalMerge, diffingOpts, compression ) import Darcs.Witnesses.Ordered ( FL(..), (:\/:)(..), (:/\:)(..), (+>+), mapFL_FL ) import Darcs.Patch- ( RepoPatch, Prim, merge, joinPatches, listTouchedFiles+ ( RepoPatch, PrimOf, merge, joinPatches, listTouchedFiles , patchcontents, anonymous, fromPrims, effect ) import Darcs.Patch.Depends( merge2FL ) import Progress( debugMessage )@@ -51,12 +50,12 @@ => MakeChanges -> Repository p C(r u t) -> String -> [DarcsFlag] -> FL (PatchInfoAnd p) C(x t) -> FL (PatchInfoAnd p) C(x y)- -> IO (Sealed (FL Prim C(u)))+ -> IO (Sealed (FL (PrimOf p) C(u))) tentativelyMergePatches_ mc r cmd opts usi themi = do let us = mapFL_FL hopefully usi them = mapFL_FL hopefully themi Sealed pc <- return $ merge2FL (progressFL "Merging us" usi) (progressFL "Merging them" themi)- pend <- unrecordedChanges opts r []+ pend <- unrecordedChanges (diffingOpts opts) r Nothing anonpend <- n2pia `fmap` anonymous (fromPrims pend) pend' :/\: pw <- return $ merge (pc :\/: anonpend :>: NilFL) let pwprim = joinPatches $ progressFL "Examining patches for conflicts" $@@ -70,7 +69,7 @@ debugMessage "Checking for unrecorded conflicts..." have_unrecorded_conflicts <- checkUnrecordedConflicts opts $ mapFL_FL hopefully pc debugMessage "Reading working directory..."- working <- readUnrecorded r []+ working <- readUnrecorded r Nothing debugMessage "Working out conflicts in actual working directory..." Sealed pw_resolution <- case (wantExternalMerge opts, have_conflicts || have_unrecorded_conflicts) of@@ -92,24 +91,25 @@ where mapAdd :: Repository p C(m l i) -> FL (PatchInfoAnd p) C(i j) -> IO (Repository p C(m l j)) mapAdd repo NilFL = return repo mapAdd repo (a:>:as) =- do repo' <- tentativelyAddPatch_ DontUpdatePristine repo opts a+ do repo' <- tentativelyAddPatch_ DontUpdatePristine repo (compression opts) a mapAdd repo' as applyps :: Repository p C(m l i) -> FL (PatchInfoAnd p) C(i j) -> IO () applyps repo ps = do debugMessage "Adding patches to inventory..."- mapAdd repo ps+-- Warning: A do-notation statement discarded a result of type Repository p m l j.+ _ <- mapAdd repo ps debugMessage "Applying patches to pristine..." applyToTentativePristine repo ps tentativelyMergePatches :: RepoPatch p => Repository p C(r u t) -> String -> [DarcsFlag] -> FL (PatchInfoAnd p) C(x t) -> FL (PatchInfoAnd p) C(x y)- -> IO (Sealed (FL Prim C(u)))+ -> IO (Sealed (FL (PrimOf p) C(u))) tentativelyMergePatches = tentativelyMergePatches_ MakeChanges considerMergeToWorking :: RepoPatch p => Repository p C(r u t) -> String -> [DarcsFlag] -> FL (PatchInfoAnd p) C(x t) -> FL (PatchInfoAnd p) C(x y)- -> IO (Sealed (FL Prim C(u)))+ -> IO (Sealed (FL (PrimOf p) C(u))) considerMergeToWorking = tentativelyMergePatches_ DontMakeChanges
+ src/Darcs/Repository/Motd.hs view
@@ -0,0 +1,40 @@+-- Copyright (C) 2002-2004 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.++module Darcs.Repository.Motd (getMotd, showMotd) where++import Control.Monad ( unless )+import Darcs.Flags ( DarcsFlag( Quiet, XMLOutput ) )+import Darcs.External ( fetchFilePS, Cachable(..) )+import Darcs.Global ( darcsdir )+import qualified Data.ByteString as B (null, hPut, empty, ByteString)+import Darcs.Utils ( catchall )+import System.IO ( stdout )++-- | Fetch and return the message of the day for a given repository.+getMotd :: String -> IO B.ByteString+getMotd repo = fetchFilePS (repo++"/"++darcsdir++"/prefs/motd") (MaxAge 600)+ `catchall` return B.empty++-- | Display the message of the day for a given repository,+-- unless either the 'XMLOutput' or the 'Quiet' flags are passed in+showMotd :: [DarcsFlag] -> String -> IO ()+showMotd opts repo = unless (Quiet `elem` opts || XMLOutput `elem` opts) $ do+ motd <- getMotd repo+ unless (B.null motd)+ $ do B.hPut stdout motd+ putStrLn "**********************"
− src/Darcs/Repository/Motd.lhs
@@ -1,49 +0,0 @@-% Copyright (C) 2002-2004 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.---\begin{code}-module Darcs.Repository.Motd (getMotd, showMotd) where-import Control.Monad ( unless )-import Darcs.Flags ( DarcsFlag( Quiet, XMLOutput ) )-import Darcs.External ( fetchFilePS, Cachable(..) )-import Darcs.Global ( darcsdir )-import qualified Data.ByteString as B (null, hPut, empty, ByteString)-import Darcs.Utils ( catchall )-import System.IO ( stdout )-\end{code}--\paragraph{motd}\label{motd}-The \verb!_darcs/prefs/motd! file may contain a ``message of the day''-which will be displayed to users who get or pull from the repository without the-\verb!--quiet! option.--\begin{code}--- | Fetch and return the message of the day for a given repository.-getMotd :: String -> IO B.ByteString-getMotd repo = fetchFilePS (repo++"/"++darcsdir++"/prefs/motd") (MaxAge 600)- `catchall` return B.empty---- | Display the message of the day for a given repository,--- unless either the 'XMLOutput' or the 'Quiet' flags are passed in-showMotd :: [DarcsFlag] -> String -> IO ()-showMotd opts repo = unless (Quiet `elem` opts || XMLOutput `elem` opts) $ do- motd <- getMotd repo- unless (B.null motd)- $ do B.hPut stdout motd- putStrLn "**********************"-\end{code}
+ src/Darcs/Repository/Old.hs view
@@ -0,0 +1,130 @@+-- Copyright (C) 2002-2005,2007-2008 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.++{-# LANGUAGE CPP, ScopedTypeVariables #-}++#include "gadts.h"++module Darcs.Repository.Old ( readOldRepo,+ revertTentativeChanges, oldRepoFailMsg ) where++import Progress ( debugMessage, beginTedious, endTedious, finishedOneIO )+import Darcs.RepoPath ( ioAbsoluteOrRemote, toPath )+import System.IO ( hPutStrLn, stderr )+import System.IO.Unsafe ( unsafeInterleaveIO )+import System.FilePath.Posix ( (</>) )+import Darcs.Patch.PatchInfoAnd ( Hopefully, PatchInfoAnd,+ patchInfoAndPatch,+ actually, unavailable )++import qualified Data.ByteString.Char8 as BC (break, pack)++import Darcs.Patch ( RepoPatch, Named,+ readPatch )++import Darcs.Witnesses.Ordered ( RL(..) )+import Darcs.Patch.Info ( PatchInfo, makeFilename, readPatchInfos )+import Darcs.Patch.Set ( PatchSet(..), Tagged(..), SealedPatchSet )+#ifdef GADT_WITNESSES+import Darcs.Patch.Set ( Origin )+#endif+import Darcs.External ( gzFetchFilePS, Cachable(..),+ cloneFile )+import Darcs.Lock ( writeBinFile )+import Darcs.Global ( darcsdir )+import Darcs.Witnesses.Sealed ( Sealed(Sealed), seal, unseal, mapSeal )++#include "impossible.h"++readOldRepo :: RepoPatch p => String -> IO (SealedPatchSet p C(Origin))+readOldRepo d = do+ realdir <- toPath `fmap` ioAbsoluteOrRemote d+ let k = "Reading inventory of repository "++d+ beginTedious k+ readRepoPrivate k realdir "inventory" `catch`+ (\e -> do hPutStrLn stderr ("Invalid repository: " ++ realdir)+ ioError e)++readRepoPrivate :: RepoPatch p => String -> FilePath -> FilePath -> IO (SealedPatchSet p C(Origin))+readRepoPrivate k d iname = do+ i <- gzFetchFilePS (d </> "_darcs" </> iname) Uncachable+ finishedOneIO k iname+ let parse inf = parse2 inf $ d </> "_darcs/patches" </> makeFilename inf+ (mt, is) = case BC.break ((==) '\n') i of+ (swt,pistr) | swt == BC.pack "Starting with tag:" ->+ case readPatchInfos pistr of+ (t:ids) -> (Just t,reverse ids)+ [] -> bug "bad inventory in readRepoPrivate"+ _ -> (Nothing, reverse $ readPatchInfos i)+ Sealed ts <- unseal seal `fmap` unsafeInterleaveIO (read_ts parse mt)+ Sealed ps <- unseal seal `fmap` unsafeInterleaveIO (read_patches parse is)+ return $ seal (PatchSet ps ts)+ where read_ts :: RepoPatch p =>+ (FORALL(b) PatchInfo -> IO (Sealed (PatchInfoAnd p C(b))))+ -> Maybe PatchInfo -> IO (Sealed (RL (Tagged p) C(Origin)))+ read_ts _ Nothing = do endTedious k+ return $ seal NilRL+ read_ts parse (Just tag0) =+ do debugMessage $ "Looking for inventory for:\n"++ show tag0+ i <- unsafeInterleaveIO $+ do x <- gzFetchFilePS (d</>"_darcs/inventories"</>makeFilename tag0) Uncachable+ finishedOneIO k (show tag0)+ return x+ let (mt, is) = case BC.break ((==) '\n') i of+ (swt,pistr) | swt == BC.pack "Starting with tag:" ->+ case readPatchInfos pistr of+ (t:ids) -> (Just t,reverse ids)+ [] -> bug "bad inventory in readRepoPrivate"+ _ -> (Nothing, reverse $ readPatchInfos i)+ Sealed ts <- fmap (unseal seal) $ unsafeInterleaveIO $ read_ts parse mt+ Sealed ps <- unseal seal `fmap` unsafeInterleaveIO (read_patches parse is)+ Sealed tag00 <- parse tag0 `catch`+ \e -> return $ seal $+ patchInfoAndPatch tag0 $ unavailable $ show e+ return $ seal $ Tagged tag00 Nothing ps :<: ts+ parse2 :: RepoPatch p => PatchInfo -> FilePath+ -> IO (Sealed (PatchInfoAnd p C(x)))+ parse2 i fn = do ps <- unsafeInterleaveIO $ gzFetchFilePS fn Cachable+ return $ patchInfoAndPatch i+ `mapSeal` hopefullyNoParseError (toPath fn) (readPatch ps)+ hopefullyNoParseError :: String -> Maybe (Sealed (Named a1dr C(x)))+ -> Sealed (Hopefully (Named a1dr) C(x))+ hopefullyNoParseError _ (Just (Sealed x)) = seal $ actually x+ hopefullyNoParseError s Nothing = seal $ unavailable $ "Couldn't parse file "++s+ read_patches :: RepoPatch p =>+ (FORALL(b) PatchInfo -> IO (Sealed (PatchInfoAnd p C(b))))+ -> [PatchInfo] -> IO (Sealed (RL (PatchInfoAnd p) C(x)))+ read_patches _ [] = return $ seal NilRL+ read_patches parse (i:is) =+ lift2Sealed (:<:)+ (read_patches parse is)+ (parse i `catch` \e ->+ return $ seal $ patchInfoAndPatch i $ unavailable $ show e)+ lift2Sealed :: (FORALL(y z) q C(y z) -> pp C(y) -> r C(z))+ -> IO (Sealed pp) -> (FORALL(b) IO (Sealed (q C(b)))) -> IO (Sealed r)+ lift2Sealed f iox ioy = do Sealed x <- unseal seal `fmap` unsafeInterleaveIO iox+ Sealed y <- unseal seal `fmap` unsafeInterleaveIO ioy+ return $ seal $ f y x+++revertTentativeChanges :: IO ()+revertTentativeChanges =+ do cloneFile (darcsdir++"/inventory") (darcsdir++"/tentative_inventory")+ writeBinFile (darcsdir++"/tentative_pristine") ""++oldRepoFailMsg :: String+oldRepoFailMsg = "ERROR: repository upgrade required, see http://wiki.darcs.net/OF"
+ src/Darcs/Repository/Prefs.hs view
@@ -0,0 +1,433 @@+-- Copyright (C) 2002-2003 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.+++{-# LANGUAGE CPP #-}++#include "gadts.h"++module Darcs.Repository.Prefs ( addToPreflist, getPreflist, setPreflist,+ getGlobal, environmentHelpHome,+ defaultrepo, setDefaultrepo,+ getPrefval, setPrefval, changePrefval,+ defPrefval,+ writeDefaultPrefs,+ boringRegexps, boringFileFilter, darcsdirFilter,+ FileType(..), filetypeFunction,+ getCaches,+ binariesFileHelp, boringFileHelp,+ globalCacheDir,+ globalPrefsDirDoc+ ) where++import System.IO.Error ( isDoesNotExistError )+import Control.Monad ( unless, when )+import Text.Regex ( Regex, mkRegex, matchRegex, )+import Data.Char ( toUpper )+import Data.Maybe ( isJust, fromMaybe, mapMaybe )+import Data.List ( nub, isPrefixOf, union, sortBy )+import System.Directory ( getAppUserDataDirectory, doesDirectoryExist, createDirectory, doesFileExist )+import Darcs.Lock( readBinFile, writeBinFile )+import System.FilePath.Posix ( (</>) )+import System.Environment ( getEnvironment )++import Darcs.Flags ( DarcsFlag( NoCache, NoSetDefault, DryRun, RemoteRepo ) )+import Darcs.RepoPath ( AbsolutePath, ioAbsolute, toFilePath, getCurrentDirectory )+import Darcs.Utils ( catchall, stripCr )+import Darcs.Patch.ApplyMonad ( ApplyMonad(..) )+import Darcs.External ( gzFetchFilePS, Cachable( Cachable ) )+import qualified Data.ByteString.Char8 as BC ( unpack )+import qualified Data.ByteString as B ( empty )+import Darcs.Global ( darcsdir )+import Darcs.Repository.Cache ( Cache(..), CacheType(..), CacheLoc(..),+ WritableOrNot(..), compareByLocality )+import Darcs.URL ( isFile )+++writeDefaultPrefs :: IO ()+writeDefaultPrefs = do setPreflist "boring" defaultBoring+ setPreflist "binaries" defaultBinaries+ setPreflist "motd" []++{-# NOINLINE defaultBoring #-}+defaultBoring :: [String]+defaultBoring = help +++ [ "",+ "### compiler and interpreter intermediate files",+ "# haskell (ghc) interfaces",+ "\\.hi$", "\\.hi-boot$", "\\.o-boot$",+ "# object files",+ "\\.o$","\\.o\\.cmd$",+ "# profiling haskell",+ "\\.p_hi$", "\\.p_o$",+ "# haskell program coverage resp. profiling info",+ "\\.tix$", "\\.prof$",+ "# fortran module files",+ "\\.mod$",+ "# linux kernel",+ "\\.ko\\.cmd$","\\.mod\\.c$",+ "(^|/)\\.tmp_versions($|/)",+ "# *.ko files aren't boring by default because they might",+ "# be Korean translations rather than kernel modules",+ "# \\.ko$",+ "# python, emacs, java byte code",+ "\\.py[co]$", "\\.elc$","\\.class$",+ "# objects and libraries; lo and la are libtool things",+ "\\.(obj|a|exe|so|lo|la)$",+ "# compiled zsh configuration files",+ "\\.zwc$",+ "# Common LISP output files for CLISP and CMUCL",+ "\\.(fas|fasl|sparcf|x86f)$",+ "",+ "### build and packaging systems",+ "# cabal intermediates",+ "\\.installed-pkg-config",+ "\\.setup-config",+ "# standard cabal build dir, might not be boring for everybody",+ "# ^dist(/|$)",+ "# autotools",+ "(^|/)autom4te\\.cache($|/)", "(^|/)config\\.(log|status)$",+ "# microsoft web expression, visual studio metadata directories",+ "\\_vti_cnf$",+ "\\_vti_pvt$",+ "# gentoo tools",+ "\\.revdep-rebuild.*",+ "# generated dependencies",+ "^\\.depend$",+ "",+ "### version control systems",+ "# cvs",+ "(^|/)CVS($|/)","\\.cvsignore$",+ "# cvs, emacs locks",+ "^\\.#",+ "# rcs",+ "(^|/)RCS($|/)", ",v$",+ "# subversion",+ "(^|/)\\.svn($|/)",+ "# mercurial",+ "(^|/)\\.hg($|/)",+ "# git",+ "(^|/)\\.git($|/)",+ "# bzr",+ "\\.bzr$",+ "# sccs",+ "(^|/)SCCS($|/)",+ "# darcs",+ "(^|/)"++darcsdir++"($|/)", "(^|/)\\.darcsrepo($|/)",+ "^\\.darcs-temp-mail$",+ "-darcs-backup[[:digit:]]+$",+ "# gnu arch",+ "(^|/)(\\+|,)",+ "(^|/)vssver\\.scc$",+ "\\.swp$","(^|/)MT($|/)",+ "(^|/)\\{arch\\}($|/)","(^|/).arch-ids($|/)",+ "# bitkeeper",+ "(^|/)BitKeeper($|/)","(^|/)ChangeSet($|/)",+ "",+ "### miscellaneous",+ "# backup files",+ "~$","\\.bak$","\\.BAK$",+ "# patch originals and rejects",+ "\\.orig$", "\\.rej$",+ "# X server",+ "\\..serverauth.*",+ "# image spam",+ "\\#", "(^|/)Thumbs\\.db$",+ "# vi, emacs tags",+ "(^|/)(tags|TAGS)$",+ "#(^|/)\\.[^/]",+ "# core dumps",+ "(^|/|\\.)core$",+ "# partial broken files (KIO copy operations)",+ "\\.part$",+ "# waf files, see http://code.google.com/p/waf/",+ "(^|/)\\.waf-[[:digit:].]+-[[:digit:]]+($|/)",+ "(^|/)\\.lock-wscript$",+ "# mac os finder",+ "(^|/)\\.DS_Store$" ]+ where+ help = map ("# "++) boringFileHelp++boringFileHelp :: [String]+boringFileHelp =+ [ "This file contains a list of extended regular expressions, one per"+ , "line. A file path matching any of these expressions will be filtered"+ , "out during `darcs add', or when the `--look-for-adds' flag is passed"+ , "to `darcs whatsnew' and `record'. The entries in " ++ globalPrefsDirDoc ++ "boring (if"+ , "it exists) supplement those in this file."+ , ""+ , "Blank lines, and lines beginning with an octothorpe (#) are ignored."+ , "See regex(7) for a description of extended regular expressions."+ ]++darcsdirFilter :: [FilePath] -> [FilePath]+darcsdirFilter = filter (not.isDarcsdir)+isDarcsdir :: FilePath -> Bool+isDarcsdir ('.':'/':f) = isDarcsdir f+isDarcsdir "." = True+isDarcsdir "" = True+isDarcsdir ".." = True+isDarcsdir "../" = True+isDarcsdir "_darcs" = True+isDarcsdir fp = "_darcs/" `isPrefixOf` fp++-- | The path of the global preference directory; @~/.darcs@ on Unix,+-- and @%APPDATA%/darcs@ on Windows.+globalPrefsDir :: IO (Maybe FilePath)+globalPrefsDir = do+ env <- getEnvironment+ case lookup "DARCS_TESTING_PREFS_DIR" env of+ Just d -> return (Just d)+ Nothing -> fmap Just (getAppUserDataDirectory "darcs")+ `catchall` (return Nothing)++-- | The relative path of the global preference directory; @~/.darcs@ on Unix,+-- and @%APPDATA%/darcs@ on Windows. This is used for online documentation.+globalPrefsDirDoc :: String+globalPrefsDirDoc =+#ifndef WIN32+ "~/.darcs/"+#else+ "%APPDATA%\\darcs\\"+#endif++environmentHelpHome :: ([String], [String])+environmentHelpHome = (["HOME", "APPDATA"], [+ "Per-user preferences are set in $HOME/.darcs (on Unix) or",+ "%APPDATA%/darcs (on Windows). This is also the default location of",+ "the cache."])++getGlobal :: String -> IO [String]+getGlobal f = do+ dir <- globalPrefsDir+ case dir of+ (Just d) -> getPreffile $ d </> f+ Nothing -> return []++globalCacheDir :: IO (Maybe FilePath)+globalCacheDir = slash_cache `fmap` globalPrefsDir+ where slash_cache = fmap (</> "cache")++boringRegexps :: IO [Regex]+boringRegexps = do+ borefile <- defPrefval "boringfile" (darcsdir ++ "/prefs/boring")+ bores <- getPrefLines borefile `catchall` return []+ gbs <- getGlobal "boring"+ return $ map mkRegex $ bores ++ gbs++boringFileFilter :: IO ([FilePath] -> [FilePath])+boringFileFilter = fmap actualBoringFileFilter boringRegexps++noncomments :: [String] -> [String]+noncomments ss = filter is_ok ss+ where is_ok "" = False+ is_ok ('#':_) = False+ is_ok _ = True++getPrefLines :: FilePath -> IO [String]+getPrefLines f = (notconflicts . noncomments . map stripCr . lines)+ `fmap` readBinFile f+ where notconflicts = filter nc+ startswith [] _ = True+ startswith (x:xs) (y:ys) | x == y = startswith xs ys+ startswith _ _ = False+ nc l | startswith "v v v v v v v" l = False+ nc l | startswith "*************" l = False+ nc l | startswith "^ ^ ^ ^ ^ ^ ^" l = False+ nc _ = True++-- | From a list of paths, filter out any that are within @_darcs@ or+-- match a boring regexp.+actualBoringFileFilter :: [Regex] -> [FilePath] -> [FilePath]+actualBoringFileFilter regexps files = filter (not . boring . normalize) files+ where boring file = isDarcsdir file ||+ any (\regexp -> isJust $ matchRegex regexp file) regexps++normalize :: FilePath -> FilePath+normalize ('.':'/':f) = normalize f+normalize f = normalize_helper $ reverse f+ where+ normalize_helper ('/':rf) = normalize_helper rf+ normalize_helper rf = reverse rf++data FileType = BinaryFile | TextFile+ deriving (Eq)++{-# NOINLINE defaultBinaries #-}+-- | The lines that will be inserted into @_darcs/prefs/binaries@ when+-- @darcs init@ is run. Hence, a list of comments, blank lines and+-- regular expressions (ERE dialect).+--+-- Note that while this matches .gz and .GZ, it will not match .gZ,+-- i.e. it is not truly case insensitive.+defaultBinaries :: [String]+defaultBinaries = help +++ ["\\.(" ++ e ++ "|" ++ map toUpper e ++ ")$" | e <- extensions ]+ where extensions = ["a","bmp","bz2","doc","elc","exe","gif","gz","iso",+ "jar","jpe?g","mng","mpe?g","p[nbgp]m","pdf","png",+ "pyc","so","tar","tgz","tiff?","z","zip"]+ help = map ("# "++) binariesFileHelp++binariesFileHelp :: [String]+binariesFileHelp =+ ["This file contains a list of extended regular expressions, one per",+ "line. A file path matching any of these expressions is assumed to",+ "contain binary data (not text). The entries in " ++ globalPrefsDirDoc ++ "binaries (if",+ "it exists) supplement those in this file.",+ "",+ "Blank lines, and lines beginning with an octothorpe (#) are ignored.",+ "See regex(7) for a description of extended regular expressions."]++filetypeFunction :: IO (FilePath -> FileType)+filetypeFunction = do+ binsfile <- defPrefval "binariesfile" (darcsdir ++ "/prefs/binaries")+ bins <- getPrefLines binsfile `catch`+ (\e-> if isDoesNotExistError e then return [] else ioError e)+ gbs <- getGlobal "binaries"+ let regexes = map mkRegex (bins ++ gbs)+ let isbin f = any (\r -> isJust $ matchRegex r f) regexes+ ftf f = if isbin $ normalize f then BinaryFile else TextFile+ in+ return ftf++-- this avoids a circular dependency with Repository+prefsDirectory :: IO (Maybe String)+prefsDirectory =+ do darcs <- doesDirectoryExist darcsdir+ return $ if darcs+ then Just $ darcsdir ++ "/prefs/"+ else Nothing++withPrefsDirectory :: (String -> IO ()) -> IO ()+withPrefsDirectory j = prefsDirectory >>= maybe (return ()) j++addToPreflist :: String -> String -> IO ()+addToPreflist p s = withPrefsDirectory $ \prefs -> do+ hasprefs <- doesDirectoryExist prefs+ unless hasprefs $ createDirectory prefs+ pl <- getPreflist p+ writeBinFile (prefs ++ p) $ unlines $ union [s] pl++getPreflist :: String -> IO [String]+getPreflist p = prefsDirectory >>= maybe (return []) (\prefs -> getPreffile $ prefs ++ p)++getPreffile :: FilePath -> IO [String]+getPreffile f = do+ hasprefs <- doesFileExist f+ if hasprefs+ then getPrefLines f+ else return []++setPreflist :: String -> [String] -> IO ()+setPreflist p ls = withPrefsDirectory $ \prefs -> do+ haspref <- doesDirectoryExist prefs+ when haspref $ writeBinFile (prefs ++ p) (unlines ls)++defPrefval :: String -> String -> IO String+defPrefval p d = fromMaybe d `fmap` getPrefval p++getPrefval :: String -> IO (Maybe String)+getPrefval p =+ do pl <- getPreflist "prefs"+ return $+ case map snd $ filter ((==p).fst) $ map (break (==' ')) pl of+ [val] ->+ case words val of+ [] -> Nothing+ _ -> Just $ tail val+ _ -> Nothing++setPrefval :: String -> String -> IO ()+setPrefval p v = do pl <- getPreflist "prefs"+ setPreflist "prefs" $+ filter ((/=p) . fst . break (==' ')) pl ++ [p++" "++v]++changePrefval :: String -> String -> String -> IO ()+changePrefval p f t =+ do pl <- getPreflist "prefs"+ ov <- getPrefval p+ let newval = case ov of+ Nothing -> t+ Just old -> if old == f then t else old+ setPreflist "prefs" $+ filter ((/=p) . fst . break(==' ')) pl ++ [p++" "++newval]++defaultrepo :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]+defaultrepo opts _ [] =+ do let fixR r | isFile r = toFilePath `fmap` ioAbsolute r+ | otherwise = return r+ case [r | RemoteRepo r <- opts] of+ [] -> do defrepo <- getPreflist "defaultrepo"+ case defrepo of+ [r] -> (:[]) `fmap` fixR r+ _ -> return []+ rs -> mapM fixR rs+defaultrepo _ _ r = return r++setDefaultrepo :: String -> [DarcsFlag] -> IO ()+setDefaultrepo r opts = do olddef <- getPreflist "defaultrepo"+ let doit = null noSetDefault && greenLight+ greenLight = wetRun+ && not rIsTmp+ && (olddef /= [r] || olddef == [])+ if doit+ then setPreflist "defaultrepo" [r]+ else when (True `notElem` noSetDefault && greenLight) $ putStr . unlines $+ -- the nuance here is that we should only notify when the+ -- reason we're not setting default is the --no-set-default+ -- flag, not the various automatic show stoppers+ [ "HINT: if you want to change the default remote repository to"+ , " " ++ r ++ ","+ , " quit now and issue the same command with the --set-default flag."+ ]+ addToPreflist "repos" r+ `catchall` return () -- we don't care if this fails!+ where+ wetRun = DryRun `notElem` opts+ rIsTmp = r `elem` [x | RemoteRepo x <- opts]+ noSetDefault = [x | NoSetDefault x <- opts]++getCaches :: [DarcsFlag] -> String -> IO Cache+getCaches opts repodir =+ do here <- parsehs `fmap` getPreffile (darcsdir ++ "/prefs/sources")+ there <- (parsehs . lines . BC.unpack) `fmap`+ (gzFetchFilePS (repodir </> darcsdir </> "prefs/sources") Cachable+ `catchall` return B.empty)+ globalcachedir <- globalCacheDir+ let globalcache = case (nocache,globalcachedir) of+ (True,_) -> []+ (_,Just d) -> [Cache Directory Writable d]+ _ -> []+ globalsources <- parsehs `fmap` getGlobal "sources"+ thisdir <- getCurrentDirectory+ let thisrepo = [Cache Repo Writable $ toFilePath thisdir]+ let tempCache = nub $ thisrepo ++ globalcache ++ globalsources +++ here ++ [Cache Repo NotWritable repodir] ++ filterExternalSources there+ return $ Ca $ sortBy compareByLocality tempCache+ where+ parsehs = mapMaybe readln . noncomments+ readln l | "repo:" `isPrefixOf` l = Just (Cache Repo NotWritable (drop 5 l))+ | nocache = Nothing+ | "cache:" `isPrefixOf` l = Just (Cache Directory Writable (drop 6 l))+ | "readonly:" `isPrefixOf` l = Just (Cache Directory NotWritable (drop 9 l))+ | otherwise = Nothing+ nocache = NoCache `elem` opts+ filterExternalSources there = if isFile repodir+ then+ there+ else+ filter (not . isFile . cacheSource) there
− src/Darcs/Repository/Prefs.lhs
@@ -1,540 +0,0 @@-% Copyright (C) 2002-2003 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.---\begin{code}-{-# OPTIONS_GHC -cpp -fglasgow-exts #-}-{-# LANGUAGE CPP #-}--#include "gadts.h"--module Darcs.Repository.Prefs ( addToPreflist, getPreflist, setPreflist,- getGlobal, environmentHelpHome,- defaultrepo, setDefaultrepo,- getPrefval, setPrefval, changePrefval,- defPrefval,- writeDefaultPrefs,- boringRegexps, boringFileFilter, darcsdirFilter,- FileType(..), filetypeFunction,- getCaches,- binariesFileHelp,- globalCacheDir- ) where--import System.IO.Error ( isDoesNotExistError )-import Control.Monad ( unless, when, mplus )-import Text.Regex ( Regex, mkRegex, matchRegex, )-import Data.Char ( toUpper )-import Data.Maybe ( isJust, catMaybes )-import Data.List ( nub, isPrefixOf, union, sortBy )-import System.Directory ( getAppUserDataDirectory )-import System.FilePath ( (</>) )-import System.Environment ( getEnvironment )--import Darcs.Flags ( DarcsFlag( NoCache, NoSetDefault, DryRun, Ephemeral, RemoteRepo ) )-import Darcs.RepoPath ( AbsolutePath, ioAbsolute, toFilePath, getCurrentDirectory )-import Darcs.Utils ( catchall, stripCr )-import Darcs.IO ( ReadableDirectory(..), WriteableDirectory(..) )-import Darcs.Patch.FileName ( fp2fn )-import Darcs.External ( gzFetchFilePS, Cachable( Cachable ) )-import qualified Data.ByteString.Char8 as BC ( unpack )-import qualified Data.ByteString as B ( empty )-import Darcs.Global ( darcsdir )-import Darcs.Repository.Cache ( Cache(..), CacheType(..), CacheLoc(..),- WritableOrNot(..), compareByLocality )-import Darcs.URL ( isFile )-\end{code}--\section{prefs}--The \verb!_darcs! directory contains a \verb!prefs! directory. This-directory exists simply to hold user configuration settings specific to-this repository. The contents of this directory are intended to be-modifiable by the user, although in some cases a mistake in such a-modification may cause darcs to behave strangely.----\input{Darcs/ArgumentDefaults.lhs}--\begin{code}-writeDefaultPrefs :: IO ()-writeDefaultPrefs = do setPreflist "boring" defaultBoring- setPreflist "binaries" defaultBinaries- setPreflist "motd" []-\end{code}--\paragraph{repos}-The \verb!_darcs/prefs/repos! file contains a list of repositories you have-pulled from or pushed to, and is used for autocompletion of pull and push-commands in bash. Feel free to delete any lines from this list that might-get in there, or to delete the file as a whole.--\paragraph{author}\label{author_prefs}-The \verb!_darcs/prefs/author! file contains the email address (or name) to-be used as the author when patches are recorded in this repository,-e.g.\ \verb!David Roundy <droundy@abridgegame.org>!. This-file overrides the contents of the environment variables-\verb!$DARCS_EMAIL! and \verb!$EMAIL!.--\paragraph{boring}\label{boring}-The \verb!_darcs/prefs/boring! file may contain a list of regular-expressions describing files, such as object files, that you do not expect-to add to your project. As an example, the boring file that I use with-my darcs repository is:-\begin{verbatim}-\.hi$-\.o$-^\.[^/]-^_-~$-(^|/)CVS($|/)-\end{verbatim}-A newly created repository has a longer boring file that-includes many common source control, backup, temporary, and compiled files.--You may want to have the boring file under version-control. To do this you can use darcs setpref to set the value-``boringfile'' to the name of your desired boring file-(e.g.\ \verb-darcs setpref boringfile .boring-, where \verb-.boring--is the repository path of a file-that has been-darcs added to your repository). The boringfile preference overrides-\verb!_darcs/prefs/boring!, so be sure to copy that file to the boringfile.--You can also set up a ``boring'' regexps-file in your home directory, named \verb!~/.darcs/boring!,-on MS Windows~\ref{ms_win}, which will be-used with all of your darcs repositories.--Any file not already managed by darcs and whose repository path (such-as \verb!manual/index.html!) matches any of-the boring regular expressions is considered boring. The boring file is-used to filter the files provided to darcs add, to allow you to use a-simple \verb-darcs add newdir newdir/-\verb-*- % cabal haddock barfs on adjacent / *-without accidentally adding a bunch of-object files. It is also used when the \verb!--look-for-adds! flag is-given to whatsnew or record.-Note that once a file has been added to darcs, it is not considered-boring, even if it matches the boring file filter.--\begin{code}-{-# NOINLINE defaultBoring #-}-defaultBoring :: [String]-defaultBoring = ["# Boring file regexps:",- "",- "### compiler and interpreter intermediate files",- "# haskell (ghc) interfaces",- "\\.hi$", "\\.hi-boot$", "\\.o-boot$",- "# object files",- "\\.o$","\\.o\\.cmd$",- "# profiling haskell",- "\\.p_hi$", "\\.p_o$",- "# haskell program coverage resp. profiling info",- "\\.tix$", "\\.prof$",- "# fortran module files",- "\\.mod$",- "# linux kernel",- "\\.ko\\.cmd$","\\.mod\\.c$",- "(^|/)\\.tmp_versions($|/)",- "# *.ko files aren't boring by default because they might",- "# be Korean translations rather than kernel modules",- "# \\.ko$",- "# python, emacs, java byte code",- "\\.py[co]$", "\\.elc$","\\.class$",- "# objects and libraries; lo and la are libtool things",- "\\.(obj|a|exe|so|lo|la)$",- "# compiled zsh configuration files",- "\\.zwc$",- "# Common LISP output files for CLISP and CMUCL",- "\\.(fas|fasl|sparcf|x86f)$",- "",- "### build and packaging systems",- "# cabal intermediates",- "\\.installed-pkg-config",- "\\.setup-config",- "# standard cabal build dir, might not be boring for everybody",- "# ^dist(/|$)",- "# autotools",- "(^|/)autom4te\\.cache($|/)", "(^|/)config\\.(log|status)$",- "# microsoft web expression, visual studio metadata directories",- "\\_vti_cnf$",- "\\_vti_pvt$",- "# gentoo tools",- "\\.revdep-rebuild.*",- "# generated dependencies",- "^\\.depend$",- "",- "### version control systems",- "# cvs",- "(^|/)CVS($|/)","\\.cvsignore$",- "# cvs, emacs locks",- "^\\.#",- "# rcs",- "(^|/)RCS($|/)", ",v$",- "# subversion",- "(^|/)\\.svn($|/)",- "# mercurial",- "(^|/)\\.hg($|/)",- "# git",- "(^|/)\\.git($|/)",- "# bzr",- "\\.bzr$",- "# sccs",- "(^|/)SCCS($|/)",- "# darcs",- "(^|/)"++darcsdir++"($|/)", "(^|/)\\.darcsrepo($|/)",- "^\\.darcs-temp-mail$",- "-darcs-backup[[:digit:]]+$",- "# gnu arch",- "(^|/)(\\+|,)",- "(^|/)vssver\\.scc$",- "\\.swp$","(^|/)MT($|/)",- "(^|/)\\{arch\\}($|/)","(^|/).arch-ids($|/)",- "# bitkeeper",- "(^|/)BitKeeper($|/)","(^|/)ChangeSet($|/)",- "",- "### miscellaneous",- "# backup files",- "~$","\\.bak$","\\.BAK$",- "# patch originals and rejects",- "\\.orig$", "\\.rej$",- "# X server",- "\\..serverauth.*",- "# image spam",- "\\#", "(^|/)Thumbs\\.db$",- "# vi, emacs tags",- "(^|/)(tags|TAGS)$",- "#(^|/)\\.[^/]",- "# core dumps",- "(^|/|\\.)core$",- "# partial broken files (KIO copy operations)",- "\\.part$",- "# waf files, see http://code.google.com/p/waf/",- "(^|/)\\.waf-[[:digit:].]+-[[:digit:]]+($|/)",- "(^|/)\\.lock-wscript$",- "# mac os finder",- "(^|/)\\.DS_Store$" ]--darcsdirFilter :: [FilePath] -> [FilePath]-darcsdirFilter = filter (not.isDarcsdir)-isDarcsdir :: FilePath -> Bool-isDarcsdir ('.':'/':f) = isDarcsdir f-isDarcsdir "." = True-isDarcsdir "" = True-isDarcsdir ".." = True-isDarcsdir "../" = True-isDarcsdir "_darcs" = True-isDarcsdir fp = "_darcs/" `isPrefixOf` fp---- | The path of the global preference directory; @~/.darcs@ on Unix,--- and @%APPDATA%/darcs@ on Windows.-globalPrefsDir :: IO (Maybe FilePath)-globalPrefsDir = do- env <- getEnvironment- case lookup "DARCS_TESTING_PREFS_DIR" env of- Just d -> return (Just d)- Nothing -> (getAppUserDataDirectory "darcs" >>= return.Just)- `catchall` (return Nothing)--environmentHelpHome :: ([String], [String])-environmentHelpHome = (["HOME", "APPDATA"], [- "Per-user preferences are set in $HOME/.darcs (on Unix) or",- "%APPDATA%/darcs (on Windows). This is also the default location of",- "the cache."])--getGlobal :: String -> IO [String]-getGlobal f = do- dir <- globalPrefsDir- case dir of- (Just d) -> getPreffile $ d </> f- Nothing -> return []--globalCacheDir :: IO (Maybe FilePath)-globalCacheDir = slash_cache `fmap` globalPrefsDir- where slash_cache = fmap (</> "cache")--boringRegexps :: IO [Regex]-boringRegexps = do- borefile <- defPrefval "boringfile" (darcsdir ++ "/prefs/boring")- bores <- getPrefLines borefile `catchall` return []- gbs <- getGlobal "boring"- return $ map mkRegex $ bores ++ gbs--boringFileFilter :: IO ([FilePath] -> [FilePath])-boringFileFilter = boringRegexps >>= return . actualBoringFileFilter--noncomments :: [String] -> [String]-noncomments ss = filter is_ok ss- where is_ok "" = False- is_ok ('#':_) = False- is_ok _ = True--getPrefLines :: ReadableDirectory m => FilePath -> m [String]-getPrefLines f = (notconflicts . noncomments . map stripCr . lines)- `fmap` mReadBinFile (fp2fn f)- where notconflicts = filter nc- startswith [] _ = True- startswith (x:xs) (y:ys) | x == y = startswith xs ys- startswith _ _ = False- nc l | startswith "v v v v v v v" l = False- nc l | startswith "*************" l = False- nc l | startswith "^ ^ ^ ^ ^ ^ ^" l = False- nc _ = True---- | From a list of paths, filter out any that are within @_darcs@ or--- match a boring regexp.-actualBoringFileFilter :: [Regex] -> [FilePath] -> [FilePath]-actualBoringFileFilter regexps files = filter (not . boring . normalize) files- where boring file = isDarcsdir file ||- any (\regexp -> isJust $ matchRegex regexp file) regexps--normalize :: FilePath -> FilePath-normalize ('.':'/':f) = normalize f-normalize f = normalize_helper $ reverse f- where- normalize_helper ('/':rf) = normalize_helper rf- normalize_helper rf = reverse rf-\end{code}--\paragraph{binaries}-The \verb!_darcs/prefs/binaries! file may contain a list of regular-expressions describing files that should be treated as binary files rather-than text files. Darcs automatically treats files containing-\verb!^Z\! or \verb!'\0'! within the first 4096 bytes as being binary files.-You probably will want to have the binaries file under-version control. To do this you can use darcs setpref to set the value-``binariesfile'' to the name of your desired binaries file-(e.g.\ \verb'darcs setpref binariesfile ./.binaries', where-\verb'.binaries' is a file that has been-darcs added to your repository). As with the boring file, you can also set-up a \verb!~/.darcs/binaries! file if you like, on MS Windows~\ref{ms_win}.--\begin{code}-data FileType = BinaryFile | TextFile- deriving (Eq)--{-# NOINLINE defaultBinaries #-}--- | The lines that will be inserted into @_darcs/prefs/binaries@ when--- @darcs init@ is run. Hence, a list of comments, blank lines and--- regular expressions (ERE dialect).------ Note that while this matches .gz and .GZ, it will not match .gZ,--- i.e. it is not truly case insensitive.-defaultBinaries :: [String]-defaultBinaries = help ++- ["\\.(" ++ e ++ "|" ++ map toUpper e ++ ")$" | e <- extensions ]- where extensions = ["a","bmp","bz2","doc","elc","exe","gif","gz","iso",- "jar","jpe?g","mng","mpe?g","p[nbgp]m","pdf","png",- "pyc","so","tar","tgz","tiff?","z","zip"]- help = map ("# "++) binariesFileHelp--binariesFileHelp :: [String]-binariesFileHelp =- ["This file contains a list of extended regular expressions, one per",- "line. A file path matching any of these expressions is assumed to",- "contain binary data (not text). The entries in ~/.darcs/binaries (if",- "it exists) supplement those in this file.",- "",- "Blank lines, and lines beginning with an octothorpe (#) are ignored.",- "See regex(7) for a description of extended regular expressions."]--filetypeFunction :: IO (FilePath -> FileType)-filetypeFunction = do- binsfile <- defPrefval "binariesfile" (darcsdir ++ "/prefs/binaries")- bins <- getPrefLines binsfile `catch`- (\e-> if isDoesNotExistError e then return [] else ioError e)- gbs <- getGlobal "binaries"- regexes <- return (map (\r -> mkRegex r) (bins ++ gbs))- let isbin f = or $ map (\r -> isJust $ matchRegex r f) regexes- ftf f = if isbin $ normalize f then BinaryFile else TextFile- in- return ftf---- this avoids a circular dependency with Repository-prefsDirectory :: ReadableDirectory m => m String-prefsDirectory =- do darcs <- mDoesDirectoryExist $ fp2fn darcsdir- if darcs- then return $ darcsdir ++ "/prefs/"- else fail $ "Directory " ++ darcsdir ++ "/ does not exist!"--withPrefsDirectory :: ReadableDirectory m => (String -> m ()) -> m ()-withPrefsDirectory j = do prefs <- prefsDirectory `mplus` return "x"- when (prefs /= "x") $ j prefs--addToPreflist :: WriteableDirectory m => String -> String -> m ()-addToPreflist p s = withPrefsDirectory $ \prefs -> do- hasprefs <- mDoesDirectoryExist $ fp2fn prefs- unless hasprefs $ mCreateDirectory $ fp2fn prefs- pl <- getPreflist p- mWriteBinFile (fp2fn $ prefs ++ p) $ unlines $ union [s] pl--getPreflist :: ReadableDirectory m => String -> m [String]-getPreflist p = do prefs <- prefsDirectory `mplus` return "x"- if (prefs /= "x") then getPreffile $ prefs ++ p- else return []--getPreffile :: ReadableDirectory m => FilePath -> m [String]-getPreffile f = do- hasprefs <- mDoesFileExist (fp2fn f)- if hasprefs- then getPrefLines f- else return []--setPreflist :: WriteableDirectory m => String -> [String] -> m ()-setPreflist p ls = withPrefsDirectory $ \prefs -> do- haspref <- mDoesDirectoryExist $ fp2fn prefs- if haspref- then mWriteBinFile (fp2fn $ prefs ++ p) (unlines ls)- else return ()--defPrefval :: String -> String -> IO String-defPrefval p d = do- pv <- getPrefval p- case pv of Nothing -> return d- Just v -> return v--getPrefval :: ReadableDirectory m => String -> m (Maybe String)-getPrefval p =- do pl <- getPreflist "prefs"- case map snd $ filter ((==p).fst) $ map (break (==' ')) pl of- [val] -> case words val of- [] -> return Nothing- _ -> return $ Just $ tail val- _ -> return Nothing--setPrefval :: WriteableDirectory m => String -> String -> m ()-setPrefval p v = do pl <- getPreflist "prefs"- setPreflist "prefs" $- filter ((/=p).fst.(break (==' '))) pl ++ [p++" "++v]--changePrefval :: WriteableDirectory m => String -> String -> String -> m ()-changePrefval p f t =- do pl <- getPreflist "prefs"- ov <- getPrefval p- newval <- case ov of- Nothing -> return t- Just old -> if old == f then return t else return old- setPreflist "prefs" $- filter ((/=p).fst.(break(==' '))) pl ++ [p++" "++newval]--defaultrepo :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]-defaultrepo opts _ [] =- do let fixR r | not (isFile r) = return r- | otherwise = do absr <- ioAbsolute r- return $ toFilePath absr- case [r | RemoteRepo r <- opts] of- [] -> do defrepo <- getPreflist "defaultrepo"- case defrepo of- [r] -> (:[]) `fmap` fixR r- _ -> return []- rs -> mapM fixR rs-defaultrepo _ _ r = return r--setDefaultrepo :: String -> [DarcsFlag] -> IO ()-setDefaultrepo r opts = do olddef <- getPreflist "defaultrepo"- let doit = NoSetDefault `notElem` opts && greenLight- greenLight = wetRun- && not rIsTmp- && (olddef /= [r] || olddef == [])- if doit- then setPreflist "defaultrepo" [r]- else when greenLight $ putStr . unlines $- -- the nuance here is that we should only notify when the- -- reason we're not setting default is the --no-set-default- -- flag, not the various automatic show stoppers- [ "Note: if you want to change the default remote repository to"- , r ++ ","- , "quit now and issue the same command with the --set-default flag."- ]- addToPreflist "repos" r- `catchall` return () -- we don't care if this fails!- where- wetRun = DryRun `notElem` opts- rIsTmp = r `elem` [x | RemoteRepo x <- opts]-\end{code}--\paragraph{email}-The \verb!_darcs/prefs/email! file is used to provide the e-mail address for your-repository that others will use when they \verb!darcs send! a patch back to you.-The contents of the file should simply be an e-mail address.---\paragraph{sources}-The \verb!_darcs/prefs/sources! file is used to indicate alternative-locations from which to download patches when using a ``hashed''-repository. This file contains lines such as:-\begin{verbatim}-cache:/home/droundy/.darcs/cache-readonly:/home/otheruser/.darcs/cache-repo:http://darcs.net-\end{verbatim}-This would indicate that darcs should first look in-\verb!/home/droundy/.darcs/cache! for patches that might be missing, and if-the patch isn't there, it should save a copy there for future use. In that-case, darcs will look in \verb!/home/otheruser/.darcs/cache! to see if that-user might have downloaded a copy, but won't try to save a copy there, of-course. Finally, it will look in \verb!http://darcs.net!. Note that the-\verb!sources! file can also exist in \verb!~/.darcs/!. Also note that the-sources mentioned in your \verb!sources! file will be tried \emph{before}-the repository you are pulling from. This can be useful in avoiding-downloading patches multiple times when you pull from a remote repository-to more than one local repository.--A global cache is enabled by default in your home directory. The cache-allows darcs to avoid re-downloading patches (for example, when doing a-second darcs get of the same repository), and also allows darcs to use hard-links to reduce disk usage.--Note that the cache directory should reside on the same filesystem as your-repositories, so you may need to vary this. You can also use multiple-cache directories on different filesystems, if you have several filesystems-on which you use darcs.--\begin{code}-getCaches :: [DarcsFlag] -> String -> IO Cache-getCaches opts repodir =- do here <- parsehs `fmap` getPreffile (darcsdir ++ "/prefs/sources")- there <- (parsehs . lines . BC.unpack) `fmap`- (gzFetchFilePS (repodir ++ "/" ++ darcsdir ++ "/prefs/sources") Cachable- `catchall` return B.empty)- globalcachedir <- globalCacheDir- let globalcache = case (nocache,globalcachedir) of- (True,_) -> []- (_,Just d) -> [Cache Directory Writable d]- _ -> []- globalsources <- parsehs `fmap` getGlobal "sources"- thisdir <- getCurrentDirectory- let thisrepo = if Ephemeral `elem` opts- then [Cache Repo NotWritable $ toFilePath thisdir]- else [Cache Repo Writable $ toFilePath thisdir]- let tempCache = nub $ thisrepo ++ globalcache ++ globalsources ++- here ++ [Cache Repo NotWritable repodir] ++ there- return $ Ca $ sortBy compareByLocality tempCache- where- parsehs = catMaybes . map readln . noncomments- readln l | take 5 l == "repo:" = Just (Cache Repo NotWritable (drop 5 l))- | take 9 l == "thisrepo:" = Just (Cache Repo Writable (drop 9 l))- | nocache = Nothing- | take 6 l == "cache:" = Just (Cache Directory Writable (drop 6 l))- | take 9 l == "readonly:" = Just (Cache Directory NotWritable (drop 9 l))- | otherwise = Nothing- nocache = NoCache `elem` opts--\end{code}-
− src/Darcs/Repository/Pristine.hs
@@ -1,162 +0,0 @@--- Copyright (C) 2002-2005 David Roundy--- Copyright (C) 2004 Juliusz Chroboczek------ 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.--{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--#include "gadts.h"--module Darcs.Repository.Pristine ( Pristine, flagsToPristine, nopristine,- createPristine, removePristine, identifyPristine,- applyPristine, createPristineFromWorking,- getPristinePop,- pristineDirectory, pristineToFlagString,- easyCreatePristineDirectoryTree,- easyCreatePartialsPristineDirectoryTree- ) where--import Data.Maybe ( isJust )-import Control.Monad ( when, liftM )-import System.Directory ( createDirectory, doesDirectoryExist, doesFileExist, removeFile )-import Darcs.Lock ( rmRecursive, writeBinFile )--import Darcs.PopulationData ( Population, getPopFrom )-import Darcs.Flags ( DarcsFlag( PristinePlain, PristineNone ) )-import Darcs.Repository.Format ( RepoFormat, formatHas,- RepoProperty(HashedInventory) )-import Darcs.IO ( WriteableDirectory(mWithCurrentDirectory) )-import Darcs.Patch ( Patchy, apply )-import Darcs.Patch.Info ( PatchInfo )-import Darcs.Patch.FileName ( fp2fn )-import Darcs.RepoPath ( FilePathLike, toFilePath )-import Darcs.External ( cloneTree, cloneTreeExcept, clonePartialsTree )-import Darcs.Repository.InternalTypes ( Pristine(..) )-import Darcs.Global ( darcsdir )-import Storage.Hashed.Darcs( writeDarcsHashed )-import Storage.Hashed.Tree( emptyTree )-#include "impossible.h"--nopristine :: Pristine-nopristine = NoPristine "aack?"--pristineName :: String-pristineName = "pristine"--identifyPristine :: IO (Pristine)-identifyPristine = do mp <- reallyIdentifyPristine- case mp of- Nothing -> fail "Pristine tree doesn't exist."- Just pristine -> return pristine--reallyIdentifyPristine :: IO (Maybe Pristine)-reallyIdentifyPristine =- do dir <- findpristine doesDirectoryExist ""- none <- findpristine doesFileExist ".none"- hashinv <- doesFileExist $ darcsdir++"/hashed_inventory"- hashpris <- doesDirectoryExist hashedPristineDirectory- case (dir, none, hashinv && hashpris) of- (Nothing, Nothing, False) -> return Nothing- (Just n, Nothing, False) ->- return (Just (PlainPristine n))- (Nothing, Just n, False) ->- return (Just (NoPristine n))- (Nothing, Nothing, True) ->- return (Just HashedPristine)- _ -> fail "Multiple pristine trees."- where findpristine fn ext =- do e1 <- fn n1- e2 <- fn n2- case (e1, e2) of- (False, False) -> return Nothing- (True, False) -> return (Just n1)- (False, True) -> return (Just n2)- (True, True) -> fail "Multiple pristine trees."- where n1 = darcsdir++"/pristine" ++ ext- n2 = darcsdir++"/current" ++ ext--flagsToPristine :: [DarcsFlag] -> RepoFormat -> Pristine-flagsToPristine _ rf | formatHas HashedInventory rf = HashedPristine-flagsToPristine (PristineNone : _) _ = NoPristine (darcsdir++"/" ++ pristineName ++ ".none")-flagsToPristine (PristinePlain : _) _ = PlainPristine (darcsdir++"/" ++ pristineName)-flagsToPristine (_ : t) rf = flagsToPristine t rf-flagsToPristine [] rf = flagsToPristine [PristinePlain] rf--createPristine :: Pristine -> IO Pristine-createPristine p =- do oldpristine <- reallyIdentifyPristine- when (isJust oldpristine) $ fail "Pristine tree already exists."- case p of- NoPristine n -> writeBinFile n "Do not delete this file.\n"- PlainPristine n -> createDirectory n- HashedPristine -> do createDirectory hashedPristineDirectory- writeDarcsHashed emptyTree "_darcs/pristine.hashed"- return ()- return p--hashedPristineDirectory :: String-hashedPristineDirectory = darcsdir++"/pristine.hashed"--removePristine :: Pristine -> IO ()-removePristine (NoPristine n) = removeFile n-removePristine (PlainPristine n) = rmRecursive n-removePristine HashedPristine = rmRecursive hashedPristineDirectory--applyPristine :: Patchy p => Pristine -> p C(x y) -> IO ()-applyPristine (NoPristine _) _ = return ()--- We don't need flags for now, since we don't care about--- SetScriptsExecutable for the pristine cache.-applyPristine (PlainPristine n) p =- mWithCurrentDirectory (fp2fn n) $ apply [] p-applyPristine HashedPristine _ =- bug "3 HashedPristine is not implemented yet."--createPristineFromWorking :: Pristine -> IO ()-createPristineFromWorking (NoPristine _) = return ()-createPristineFromWorking (PlainPristine n) = cloneTreeExcept [darcsdir] "." n-createPristineFromWorking HashedPristine =- bug "HashedPristine is not implemented yet."--getPristinePop :: PatchInfo -> Pristine -> IO (Maybe Population)-getPristinePop pinfo (PlainPristine n) =- Just `liftM` getPopFrom n pinfo-getPristinePop _ _ = return Nothing--pristineDirectory :: Pristine -> Maybe String-pristineDirectory (PlainPristine n) = Just n-pristineDirectory _ = Nothing--pristineToFlagString :: Pristine -> String-pristineToFlagString (NoPristine _) = "--no-pristine-tree"-pristineToFlagString (PlainPristine _) = "--plain-pristine-tree"-pristineToFlagString HashedPristine =- bug "HashedPristine is not implemented yet."--easyCreatePristineDirectoryTree :: Pristine -> FilePath -> IO Bool-easyCreatePristineDirectoryTree (NoPristine _) _ = return False-easyCreatePristineDirectoryTree (PlainPristine n) p- = cloneTree n p >> return True-easyCreatePristineDirectoryTree HashedPristine _ =- bug "HashedPristine is not implemented yet."--easyCreatePartialsPristineDirectoryTree :: FilePathLike fp => [fp] -> Pristine- -> FilePath -> IO Bool-easyCreatePartialsPristineDirectoryTree _ (NoPristine _) _ = return False-easyCreatePartialsPristineDirectoryTree prefs (PlainPristine n) p- = clonePartialsTree n p (map toFilePath prefs) >> return True-easyCreatePartialsPristineDirectoryTree _ HashedPristine _ =- bug "HashedPristine is not implemented yet."
src/Darcs/Repository/Repair.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP, PatternGuards #-} module Darcs.Repository.Repair ( replayRepository, checkIndex@@ -14,20 +13,21 @@ import System.Directory ( createDirectoryIfMissing ) import Darcs.Lock( rmRecursive )-import Darcs.Hopefully ( PatchInfoAnd, info, winfo, WPatchInfo, unWPatchInfo, compareWPatchInfo )+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info, winfo, WPatchInfo, unWPatchInfo, compareWPatchInfo ) +import Darcs.Witnesses.Eq ( EqCheck(..) ) import Darcs.Witnesses.Ordered ( FL(..), RL(..), lengthFL, reverseFL,- mapRL, nullFL, (:||:)(..), EqCheck(..) )+ mapRL, nullFL, (:||:)(..) ) import Darcs.Witnesses.Sealed ( Sealed2(..), Sealed(..), unFreeLeft )-import Darcs.Patch.Patchy ( applyAndTryToFix )-import Darcs.Hopefully( hopefully )+import Darcs.Patch.Repair ( Repair(applyAndTryToFix) )+import Darcs.Patch.PatchInfoAnd( hopefully ) import Darcs.Patch.Info ( humanFriendly ) import Darcs.Patch.Set ( PatchSet(..), newset2FL, newset2RL ) #ifdef GADT_WITNESSES import Darcs.Patch.Set ( Origin ) #endif-import Darcs.Patch ( RepoPatch, isInconsistent )-import Darcs.Patch.Core ( patchcontents )+import Darcs.Patch ( RepoPatch, PrimOf, isInconsistent )+import Darcs.Patch.Named ( patchcontents ) import Darcs.Repository.Format ( identifyRepoFormat, RepoProperty ( HashedInventory ), formatHas )@@ -70,7 +70,7 @@ | IsEq <- winfo o `compareWPatchInfo` o' = c:>:replaceInFL orig ch_rest | otherwise = o:>:replaceInFL orig ch -applyAndFix :: forall p C(r u t x y). RepoPatch p => Repository p C(r u t) -> FL (PatchInfoAnd p) C(Origin r) -> TreeIO (FL (PatchInfoAnd p) C(Origin r), Bool)+applyAndFix :: forall p C(r u t). RepoPatch p => Repository p C(r u t) -> FL (PatchInfoAnd p) C(Origin r) -> TreeIO (FL (PatchInfoAnd p) C(Origin r), Bool) applyAndFix _ NilFL = return (NilFL, True) applyAndFix r psin = do liftIO $ beginTedious k@@ -92,9 +92,9 @@ (ps', restok) <- aaf ps case mp' of Nothing -> return (ps', restok)- Just (e,pp) -> do liftIO $ putStrLn e- p' <- liftIO $ makePatchLazy r pp- return (Sealed2 (winfp :||: p'):ps', False)+ Just (e,pp) -> liftIO $ do putStrLn e+ p' <- makePatchLazy r pp+ return (Sealed2 (winfp :||: p'):ps', False) data RepositoryConsistency p C(x) = RepositoryConsistent@@ -117,8 +117,9 @@ hd [] = Nothing hd (x1:x2:xs) | x1 == x2 = Just x1 | otherwise = hd (x2:xs)-replayRepository' :: (RepoPatch p)- => Repository p C(r u t) -> [DarcsFlag] -> IO (RepositoryConsistency p C(r))+replayRepository' ::+ forall p C(r u t) . (RepoPatch p)+ => Repository p C(r u t) -> [DarcsFlag] -> IO (RepositoryConsistency p C(r)) replayRepository' repo opts = do let putVerbose s = when (Verbose `elem` opts) $ putDocLn s putInfo s = when (not $ Quiet `elem` opts) $ putDocLn s@@ -137,7 +138,7 @@ debugMessage "Checking pristine against slurpy" ftf <- filetypeFunction- is_same <- do Sealed diff <- unFreeLeft `fmap` treeDiff ftf pris newpris+ is_same <- do Sealed diff <- unFreeLeft `fmap` treeDiff ftf pris newpris :: IO (Sealed (FL (PrimOf p) C(r))) return $ nullFL diff `catchall` return False -- TODO is the latter condition needed? Does a broken patch imply pristine@@ -151,9 +152,7 @@ cleanupRepositoryReplay :: Repository p C(r u t) -> IO () cleanupRepositoryReplay r = do let c = extractCache r- rf_or_e <- identifyRepoFormat "."- rf <- case rf_or_e of Left e -> fail e- Right x -> return x+ rf <- identifyRepoFormat "." unless (formatHas HashedInventory rf) $ rmRecursive $ darcsdir ++ "/pristine.hashed" when (formatHas HashedInventory rf) $ do
src/Darcs/Repository/State.hs view
@@ -1,5 +1,5 @@+{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans #-} -- Copyright (C) 2009 Petr Rockai --@@ -30,7 +30,7 @@ -- * Trees. , readRecorded, readUnrecorded, readRecordedAndPending, readWorking -- * Index.- , readIndex, invalidateIndex ) where+ , readIndex, invalidateIndex, UseIndex(..), ScanKnown(..) ) where import Prelude hiding ( filter ) import Control.Monad( when )@@ -44,14 +44,14 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC -import Darcs.Patch ( RepoPatch, Prim, invert, applyToTree, applyToFilepaths+import Darcs.Patch ( RepoPatch, PrimOf, applyToTree, applyToFilepaths , sortCoalesceFL )-import Darcs.Patch.TouchesFiles ( chooseTouching ) import Darcs.Witnesses.Ordered ( FL(..), (+>+) )-import Darcs.Witnesses.Ordered ( unsafeCoerceP, EqCheck(IsEq) )+import Darcs.Witnesses.Eq ( EqCheck(IsEq) )+import Darcs.Witnesses.Unsafe ( unsafeCoerceP ) import Darcs.Witnesses.Sealed ( Sealed(Sealed), seal, unFreeLeft ) import Darcs.Diff ( treeDiff )-import Darcs.Flags ( DarcsFlag( LookForAdds ), willIgnoreTimes )+import Darcs.Flags ( UseIndex(..), ScanKnown(..) ) import Darcs.Global ( darcsdir ) import Darcs.Utils ( filterPaths ) @@ -77,9 +77,7 @@ -- | From a repository and a list of SubPath's, construct a filter that can be -- used on a Tree (recorded or unrecorded state) of this repository. This -- constructed filter will take pending into account, so the subpaths will be--- translated correctly relative to pending move patches. As an exception for--- convenience, if the subpath list is empty, the filter constructed is an--- identity.+-- translated correctly relative to pending move patches. restrictSubpaths :: (RepoPatch p) => Repository p C(r u t) -> [SubPath] -> IO (TreeFilter m) restrictSubpaths repo subpaths = do@@ -88,7 +86,7 @@ paths' = paths `union` applyToFilepaths pending paths anchored = map floatPath paths' restrictPaths :: FilterTree t m => t m -> t m- restrictPaths = if null subpaths then id else filter (filterPaths anchored)+ restrictPaths = filter (filterPaths anchored) return (TreeFilter restrictPaths) -- | Construct a Tree filter that removes any boring files the Tree might have@@ -114,11 +112,11 @@ _ -> True return (TreeFilter restrictTree) --- | For a repository and a list of paths (when empty, take everything) compute--- a (forward) list of prims (i.e. a patch) going from the recorded state of--- the repository (pristine) to the unrecorded state of the repository (the--- working copy + pending). When a non-empty list of paths is given, at least--- the files that live under any of these paths in either recorded or+-- | For a repository and an optional list of paths (when Nothing, take+-- everything) compute a (forward) list of prims (i.e. a patch) going from the+-- recorded state of the repository (pristine) to the unrecorded state of the+-- repository (the working copy + pending). When a list of paths is given, at+-- least the files that live under any of these paths in either recorded or -- unrecorded will be included in the resulting patch. NB. More patches may be -- included in this list, eg. the full contents of the pending patch. This is -- usually not a problem, since selectChanges will properly filter the results@@ -134,29 +132,31 @@ -- is very inefficient, although in extremely rare cases, the index could go -- out of sync (file is modified, index is updated and file is modified again -- within a single second).-unrecordedChanges :: FORALL(p r u t) (RepoPatch p)- => [DarcsFlag] -> Repository p C(r u t)- -> [SubPath] -> IO (FL Prim C(t u))-unrecordedChanges opts repo paths = do- (all_current, Sealed (pending :: FL Prim C(t x))) <- readPending repo+unrecordedChanges :: forall p C(r u t) . (RepoPatch p)+ => (UseIndex, ScanKnown) -> Repository p C(r u t)+ -> Maybe [SubPath] -> IO (FL (PrimOf p) C(t u))+unrecordedChanges (useidx, scan) repo mbpaths = do+ (all_current, Sealed (pending :: FL (PrimOf p) C(t x))) <- readPending repo - relevant <- restrictSubpaths repo paths+ relevant <- maybe (return $ TreeFilter id) (restrictSubpaths repo) mbpaths let getIndex = I.updateIndex =<< (applyTreeFilter relevant <$> readIndex repo) current = applyTreeFilter relevant all_current - working <- case (LookForAdds `elem` opts, willIgnoreTimes opts) of- (False, False) -> getIndex- (False, True) -> do+ working <- case (scan, useidx) of+ (ScanKnown, UseIndex) -> getIndex+ (ScanKnown, IgnoreIndex) -> do guide <- expand current applyTreeFilter relevant <$> restrict guide <$> readPlainTree "."- (True, ignoretimes) -> do+ (ScanAll, _) -> do index <- getIndex nonboring <- restrictBoring index plain <- applyTreeFilter relevant <$> applyTreeFilter nonboring <$> readPlainTree "."- return $ if ignoretimes then plain else plain `overlay` index+ return $ case useidx of+ UseIndex -> plain `overlay` index+ IgnoreIndex -> plain ft <- filetypeFunction- Sealed (diff :: FL Prim C(x y)) <- (unFreeLeft `fmap` treeDiff ft current working) :: IO (Sealed (FL Prim C(x)))+ Sealed (diff :: FL (PrimOf p) C(x y)) <- (unFreeLeft `fmap` treeDiff ft current working) :: IO (Sealed (FL (PrimOf p) C(x))) IsEq <- return (unsafeCoerceP IsEq) :: IO (EqCheck C(y u)) return $ sortCoalesceFL (pending +>+ diff) @@ -190,15 +190,15 @@ (_, _) -> fail "No pristine tree is available!" -- | Obtains a Tree corresponding to the "unrecorded" state of the repository:--- the working tree plus the "pending" patch. The optional list of paths (it is--- ignored if empty) allows to restrict the query to a subtree.+-- the working tree plus the "pending" patch. The optional list of paths allows+-- to restrict the query to a subtree. -- -- Limiting the query may be more efficient, since hashes on the uninteresting -- parts of the index do not need to go through an up-to-date check (which -- involves a relatively expensive lstat(2) per file.-readUnrecorded :: (RepoPatch p) => Repository p C(r u t) -> [SubPath] -> IO (Tree IO)-readUnrecorded repo paths = do- relevant <- restrictSubpaths repo paths+readUnrecorded :: (RepoPatch p) => Repository p C(r u t) -> Maybe [SubPath] -> IO (Tree IO)+readUnrecorded repo mbpaths = do+ relevant <- maybe (return $ TreeFilter id) (restrictSubpaths repo) mbpaths readIndex repo >>= I.updateIndex . applyTreeFilter relevant -- | Obtains a Tree corresponding to the working copy of the@@ -215,7 +215,7 @@ Sealed pending <- snd `fmap` readPending repo applyToTree pending pristine -readPending :: (RepoPatch p) => Repository p C(r u t) -> IO (Tree IO, Sealed (FL Prim C(t)))+readPending :: (RepoPatch p) => Repository p C(r u t) -> IO (Tree IO, Sealed (FL (PrimOf p) C(t))) readPending repo = do Sealed pending <- LowLevel.readPending repo pristine <- readRecorded repo
+ src/Darcs/Resolution.hs view
@@ -0,0 +1,149 @@+-- Copyright (C) 2003,2005 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.++{-# LANGUAGE CPP #-}++#include "gadts.h"++module Darcs.Resolution ( standardResolution,+ externalResolution,+ patchsetConflictResolutions,+ ) where++import System.FilePath.Posix ( (</>) )+import System.Exit ( ExitCode( ExitSuccess ) )+import System.Directory ( setCurrentDirectory, getCurrentDirectory )+import Data.List ( zip4 )+import Control.Monad ( when )++import Darcs.Diff( treeDiff )+import Darcs.Patch ( PrimOf, PrimPatch, RepoPatch, joinPatches, resolveConflicts,+ applyToFilepaths, patchcontents,+ invert, listConflictedFiles, commute, applyToTree )+import Darcs.RepoPath ( toFilePath )+import Darcs.Witnesses.Ordered ( FL(..), RL(..), (:>)(..), (+>+),+ mapFL_FL, reverseRL )++import CommandLine ( parseCmd )+import Darcs.Patch.PatchInfoAnd ( hopefully )+import Darcs.Utils ( askUser, filterFilePaths )+import Darcs.Patch.Set ( PatchSet(..) )+#ifdef GADT_WITNESSES+import Darcs.Patch.Set ( Origin )+#endif+import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )+import Darcs.Repository.Prefs ( filetypeFunction )+import Exec ( exec, Redirect(..) )+import Darcs.Lock ( withTempDir )+import Darcs.External ( cloneTree )++import qualified Storage.Hashed.Tree as Tree+import Storage.Hashed ( writePlainTree, readPlainTree )++--import Darcs.ColorPrinter ( traceDoc )+--import Printer ( greenText, ($$), Doc )+--import Darcs.Patch ( showPatch )++standardResolution :: RepoPatch p => FL p C(x y) -> Sealed (FL (PrimOf p) C(y))+standardResolution p = mergeList $ map head $ resolveConflicts p++mergeList :: forall prim C(x) . PrimPatch prim => [Sealed (FL prim C(x))] -> Sealed (FL prim C(x))+mergeList patches = doml NilFL patches+ where doml :: FL prim C(x y) -> [Sealed (FL prim C(x))] -> Sealed (FL prim C(x))+ doml mp (Sealed p:ps) =+ case commute (invert p :> mp) of+ Just (mp' :> _) -> doml (p +>+ mp') ps+ Nothing -> doml mp ps -- This shouldn't happen for "good" resolutions.+ doml mp [] = Sealed mp++externalResolution :: RepoPatch p => Tree.Tree IO -> String -> FL (PrimOf p) C(x y) -> FL (PrimOf p) C(x z)+ -> FL p C(y a)+ -> IO (Sealed (FL (PrimOf p) C(a)))+externalResolution s1 c p1 p2 pmerged = do+ sa <- applyToTree (invert p1) s1+ sm <- applyToTree pmerged s1+ s2 <- applyToTree p2 sa+ let nms = listConflictedFiles pmerged+ nas = applyToFilepaths (invert pmerged) nms+ n1s = applyToFilepaths p1 nas+ n2s = applyToFilepaths p2 nas+ ns = zip4 nas n1s n2s nms+ write_files tree fs = writePlainTree (Tree.filter (filterFilePaths fs) tree) "."+ in do+ former_dir <- getCurrentDirectory+ withTempDir "version1" $ \absd1 -> do+ let d1 = toFilePath absd1+ write_files s1 n1s+ setCurrentDirectory former_dir+ withTempDir "ancestor" $ \absda -> do+ let da = toFilePath absda+ write_files sa nas+ setCurrentDirectory former_dir+ withTempDir "merged" $ \absdm -> do+ let dm = toFilePath absdm+ write_files sm nms+ setCurrentDirectory former_dir+ withTempDir "cleanmerged" $ \absdc -> do+ let dc = toFilePath absdc+ cloneTree dm "."+ setCurrentDirectory former_dir+ withTempDir "version2" $ \absd2 -> do+ let d2 = toFilePath absd2+ write_files s2 n2s+ mapM_ (externallyResolveFile c da d1 d2 dm) ns+ sc <- readPlainTree dc+ sfixed <- readPlainTree dm+ ftf <- filetypeFunction+ unFreeLeft `fmap` treeDiff ftf sc sfixed++externallyResolveFile :: String -> String -> String -> String -> String+ -> (FilePath, FilePath, FilePath, FilePath)+ -> IO ()+externallyResolveFile c da d1 d2 dm (fa, f1, f2, fm) = do+ putStrLn $ "Merging file "++fm++" by hand."+ ec <- run c [('1', d1</>f1), ('2', d2</>f2), ('a', da</>fa), ('o', dm</>fm), ('%', "%")]+ when (ec /= ExitSuccess) $+ putStrLn $ "External merge command exited with " ++ show ec+-- Warning: A do-notation statement discarded a result of type String.+ _ <- askUser "Hit return to move on, ^C to abort the whole operation..."+ return ()++run :: String -> [(Char,String)] -> IO ExitCode+run c replacements =+ case parseCmd replacements c of+ Left err -> fail $ show err+ Right (c2,_) -> rr c2+ where rr (command:args) = do putStrLn $ "Running command '" +++ unwords (command:args) ++ "'"+ exec command args (Null,Null,Null)+ rr [] = return ExitSuccess++patchsetConflictResolutions :: RepoPatch p => PatchSet p C(Origin x) -> Sealed (FL (PrimOf p) C(x))+patchsetConflictResolutions (PatchSet NilRL _) = Sealed NilFL+patchsetConflictResolutions (PatchSet xs _)+ = --traceDoc (greenText "looking at resolutions" $$+ -- (sh $ resolveConflicts $ joinPatches $+ -- mapFL_FL (patchcontents . hopefully) $ reverseRL xs )) $+ mergeList $ map head $ resolveConflicts $ joinPatches $+ mapFL_FL (patchcontents . hopefully) $ reverseRL xs+ --where sh :: [[Sealed (FL Prim)]] -> Doc+ -- sh [] = greenText "no more conflicts"+ -- sh (x:ps) = greenText "one conflict" $$ sh1 x $$ sh ps+ -- sh1 :: [Sealed (FL Prim)] -> Doc+ -- sh1 [] = greenText "end of unravellings"+ -- sh1 (Sealed x:ps) = greenText "one unravelling:" $$ showPatch x $$+ -- sh1 ps
− src/Darcs/Resolution.lhs
@@ -1,239 +0,0 @@-% Copyright (C) 2003,2005 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.--\begin{code}-{-# OPTIONS_GHC -cpp #-}-{-# LANGUAGE CPP #-}--#include "gadts.h"--module Darcs.Resolution ( standardResolution,- externalResolution,- patchsetConflictResolutions,- ) where--import System.FilePath.Posix ( (</>) )-import System.Exit ( ExitCode( ExitSuccess ) )-import System.Directory ( setCurrentDirectory, getCurrentDirectory )-import Data.List ( zip4 )-import Control.Monad ( when )--import Darcs.Diff( treeDiff )-import Darcs.Patch ( RepoPatch, Prim, joinPatches, resolveConflicts,- effect,- applyToFilepaths, patchcontents,- invert, listConflictedFiles, commute, applyToTree )-import Darcs.RepoPath ( toFilePath )-import Darcs.Witnesses.Ordered ( FL(..), RL(..), (:>)(..), (+>+),- mapFL_FL, reverseRL )--import CommandLine ( parseCmd )-import Darcs.Hopefully ( hopefully )-import Darcs.Utils ( askUser, filterFilePaths )-import Darcs.Patch.Set ( PatchSet(..) )-#ifdef GADT_WITNESSES-import Darcs.Patch.Set ( Origin )-#endif-import Darcs.Witnesses.Sealed ( Sealed(..), unFreeLeft )-import Darcs.Repository.Prefs ( filetypeFunction )-import Exec ( exec, Redirect(..) )-import Darcs.Lock ( withTempDir )-import Darcs.External ( cloneTree )--import qualified Storage.Hashed.Tree as Tree-import Storage.Hashed ( writePlainTree, readPlainTree )----import Darcs.ColorPrinter ( traceDoc )---import Printer ( greenText, ($$), Doc )---import Darcs.Patch ( showPatch )--standardResolution :: RepoPatch p => p C(x y) -> Sealed (FL Prim C(y))-standardResolution p = mergeList $ map head $ resolveConflicts p--mergeList :: [Sealed (FL Prim C(x))] -> Sealed (FL Prim C(x))-mergeList patches = doml NilFL patches- where doml :: FL Prim C(x y) -> [Sealed (FL Prim C(x))] -> Sealed (FL Prim C(x))- doml mp (Sealed p:ps) =- case commute (invert p :> mp) of- Just (mp' :> _) -> doml (effect p +>+ effect mp') ps- Nothing -> doml mp ps -- This shouldn't happen for "good" resolutions.- doml mp [] = Sealed mp-\end{code}--\paragraph{Resolution of conflicts}\label{resolution}--To resolve conflicts using an external tool, you need to specify a command-to use, e.g.-\begin{verbatim}---external-merge 'opendiff %1 %2 -ancestor %a -merge %o'-\end{verbatim}-The \verb!%1! and \verb!%2! are replaced with the two versions to be-merged, \verb!%a! is replaced with the common ancestor of the two versions.-Most importantly, \verb!%o! is replaced with the name of the output file-that darcs will require to be created holding the merged version. The-above example works with the FileMerge.app tool that comes with Apple's-developer tools. To use xxdiff, you would use-\begin{verbatim}---external-merge 'xxdiff -m -O -M %o %1 %a %2'-\end{verbatim}-To use \verb!kdiff3!, you can use-\begin{verbatim}---external-merge 'kdiff3 --output %o %a %1 %2'-\end{verbatim}-To use \verb!tortoiseMerge!, you can use-\begin{verbatim}---external-merge 'tortoiseMerge /base:"%a" /mine:"%1" /theirs:"%2" /merged:"%o"'-\end{verbatim}-(\verb!tortoiseMerge! is a nice merge tool that comes with TortoiseSVN and works well-on Windows.)--% Fixme: Is it actually a shell command on MS Windows?-Note that the command is split into space-separated words and the first one is-\verb!exec!ed with the rest as arguments---it is not a shell command. In particular,-on Windows this means that the first command path should not contain spaces and-you should make sure the command is in your \verb!PATH!.--The substitution of the \verb!%! escapes is done everywhere. If you need to prevent-substitution you can use a double percentage sign, i.e. \verb!%%a! is substituted with-\verb!%a!. Here is an example script to use the Emacs' Ediff package for merging.-% This is indented so that the leading #s don't confuse the preprocessor.-\begin{verbatim}- #! /bin/sh- # External merge command for darcs, using Emacs Ediff, via server if possible.- # It needs args %1 %2 %a %o, i.e. the external merge command is, say,- # `emerge3 %1 %2 %a %o'.- test $# -eq 4 || exit 1- form="(ediff-merge-files-with-ancestor"- while test $# -gt 0; do- count=$count.- if [ $count = .... ]; then- form=$form\ nil # Lisp STARTUP-HOOKS arg- fi- case $1 in # Worry about quoting -- escape " and \- *[\"\\]* ) form=$form\ \"$(echo $1 | sed -e's/["\\]/\\\0/g')\" ;;- *) form=$form\ \"$1\" ;;- esac- shift- done- form=$form')'- ( emacsclient --eval "$form" || # Emacs 22 server- gnudoit "$form" || # XEmacs/Emacs 21 server- emacs --eval "$form" || # Relatively slow to start up- xemacs -eval "$form" # Horribly slow to start up- ) 2>/dev/null-\end{verbatim}-It would be invoked like:-\begin{verbatim}---external-merge 'emerge3 %1 %2 %a %o'-\end{verbatim}--If you figure out how to use darcs with another merge tool, please let me-know what flags you used so I can mention it here.--Note that if you do use an external merge tool, most likely you will want-to add to your defaults file-(\verb!_darcs/prefs/defaults! or \verb!~/.darcs/prefs!, see \ref{defaults},-on MS Windows~\ref{ms_win})-a line such as-\begin{verbatim}-ALL external-merge kdiff3 --output %o %a %1 %2-\end{verbatim}-or-\begin{verbatim}-ALL external-merge tortoiseMerge /base:"%a" /mine:"%1" /theirs:"%2" /merged:"%o"-\end{verbatim}--Note that the defaults file does not want quotes around the command.--\begin{code}-externalResolution :: RepoPatch p => Tree.Tree IO -> String -> FL Prim C(x y) -> FL Prim C(x z)- -> p C(y a)- -> IO (Sealed (FL Prim C(a)))-externalResolution s1 c p1 p2 pmerged = do- sa <- applyToTree (invert p1) s1- sm <- applyToTree pmerged s1- s2 <- applyToTree p2 sa- let nms = listConflictedFiles pmerged- nas = applyToFilepaths (invert pmerged) nms- n1s = applyToFilepaths p1 nas- n2s = applyToFilepaths p2 nas- ns = zip4 nas n1s n2s nms- write_files tree fs = writePlainTree (Tree.filter (filterFilePaths fs) tree) "."- in do- former_dir <- getCurrentDirectory- withTempDir "version1" $ \absd1 -> do- let d1 = toFilePath absd1- write_files s1 n1s- setCurrentDirectory former_dir- withTempDir "ancestor" $ \absda -> do- let da = toFilePath absda- write_files sa nas- setCurrentDirectory former_dir- withTempDir "merged" $ \absdm -> do- let dm = toFilePath absdm- write_files sm nms- setCurrentDirectory former_dir- withTempDir "cleanmerged" $ \absdc -> do- let dc = toFilePath absdc- cloneTree dm "."- setCurrentDirectory former_dir- withTempDir "version2" $ \absd2 -> do- let d2 = toFilePath absd2- write_files s2 n2s- mapM_ (externallyResolveFile c da d1 d2 dm) ns- sc <- readPlainTree dc- sfixed <- readPlainTree dm- ftf <- filetypeFunction- unFreeLeft `fmap` treeDiff ftf sc sfixed--externallyResolveFile :: String -> String -> String -> String -> String- -> (FilePath, FilePath, FilePath, FilePath)- -> IO ()-externallyResolveFile c da d1 d2 dm (fa, f1, f2, fm) = do- putStrLn $ "Merging file "++fm++" by hand."- ec <- run c [('1', d1</>f1), ('2', d2</>f2), ('a', da</>fa), ('o', dm</>fm), ('%', "%")]- when (ec /= ExitSuccess) $- putStrLn $ "External merge command exited with " ++ show ec- askUser "Hit return to move on, ^C to abort the whole operation..."- return ()--run :: String -> [(Char,String)] -> IO ExitCode-run c replacements =- case parseCmd replacements c of- Left err -> fail $ show err- Right (c2,_) -> rr c2- where rr (command:args) = do putStrLn $ "Running command '" ++- unwords (command:args) ++ "'"- exec command args (Null,Null,Null)- rr [] = return ExitSuccess--patchsetConflictResolutions :: RepoPatch p => PatchSet p C(Origin x) -> Sealed (FL Prim C(x))-patchsetConflictResolutions (PatchSet NilRL _) = Sealed NilFL-patchsetConflictResolutions (PatchSet xs _)- = --traceDoc (greenText "looking at resolutions" $$- -- (sh $ resolveConflicts $ joinPatches $- -- mapFL_FL (patchcontents . hopefully) $ reverseRL xs )) $- mergeList $ map head $ resolveConflicts $ joinPatches $- mapFL_FL (patchcontents . hopefully) $ reverseRL xs- --where sh :: [[Sealed (FL Prim)]] -> Doc- -- sh [] = greenText "no more conflicts"- -- sh (x:ps) = greenText "one conflict" $$ sh1 x $$ sh ps- -- sh1 :: [Sealed (FL Prim)] -> Doc- -- sh1 [] = greenText "end of unravellings"- -- sh1 (Sealed x:ps) = greenText "one unravelling:" $$ showPatch x $$- -- sh1 ps-\end{code}
src/Darcs/RunCommand.hs view
@@ -51,7 +51,7 @@ import Darcs.Global ( atexit ) import Darcs.External ( viewDoc ) import Darcs.Global ( setDebugMode, setSshControlMasterDisabled,- setTimingsMode, setVerboseMode )+ setTimingsMode ) import Darcs.Match ( checkMatchSyntax ) import Progress ( setProgressMode ) import Darcs.RepoPath ( getCurrentDirectory )@@ -87,7 +87,8 @@ | Help `elem` opts -> viewDoc $ text $ getCommandHelp msuper cmd | ListOptions `elem` opts -> do setProgressMode False- commandPrereq cmd opts+-- Warning: A do-notation statement discarded a result of type Either String ().+ _ <- commandPrereq cmd opts file_args <- commandGetArgPossibilities cmd putStrLn $ unlines $ getOptionsOptions (opts1++opts2) : file_args | otherwise -> considerRunning msuper cmd (addVerboseIfDebug opts) extra@@ -131,7 +132,6 @@ when (Timings `elem` os) setTimingsMode when (Debug `elem` os) setDebugMode when (DebugHTTP `elem` os) setDebugHTTP- when (Verbose `elem` os) setVerboseMode when (Quiet `elem` os) $ setProgressMode False when (NoHTTPPipelining `elem` os) $ disableHTTPPipelining unless (SSHControlMaster `elem` os) setSshControlMasterDisabled
src/Darcs/SelectChanges.hs view
@@ -15,9 +15,7 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -fglasgow-exts #-} {-# LANGUAGE CPP, ForeignFunctionInterface #-}--- , ScopedTypeVariables, TypeOperators, PatternGuards #-} #include "gadts.h" @@ -25,31 +23,31 @@ filterOutConflicts, runSelection, selectionContextPrim, selectionContext ) where-import System.IO import Data.List ( intersperse )-import Data.Maybe ( catMaybes, isJust, fromJust )+import Data.Maybe ( isJust, isNothing ) import Data.Char ( toUpper ) import Control.Monad ( when, (>=>) )+import Control.Monad.Identity ( Identity(..) ) import Control.Monad.Trans ( liftIO ) import Control.Monad.Reader ( ReaderT, Reader, asks, runReader, runReaderT )-import Control.Monad.State ( State(..), StateT, modify, gets, execStateT )+import Control.Monad.State ( StateT, modify, gets, runStateT, execStateT ) import System.Exit ( exitWith, ExitCode(ExitSuccess) ) import English ( Noun(..), englishNum ) import Darcs.Arguments ( showFriendly )-import Darcs.Hopefully ( PatchInfoAnd, hopefully, n2pia )+import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, hopefully, n2pia ) import Darcs.Repository ( Repository, readRepo, unrecordedChanges )-import Darcs.Patch ( RepoPatch, Patchy, Prim, summary,+import Darcs.Patch ( RepoPatch, Patchy, PrimPatch, summary, invert, listTouchedFiles, commuteFLorComplain, fromPrims, anonymous ) import Darcs.Patch.Set ( newset2RL ) import qualified Darcs.Patch ( thing, things ) import Darcs.Patch.Split ( Splitter(..) ) import Darcs.Witnesses.Ordered ( FL(..), RL(..), (:>)(..), (:||:)(..),- (+>+), lengthFL, concatRL, mapFL_FL,+ (+>+), lengthFL, mapFL_FL, spanFL, spanFL_M, reverseFL, (+<+), mapFL, filterFL ) import Darcs.Witnesses.WZipper( FZipper(..), left, right- , rightmost, lengthFZ, focus+ , rightmost , toEnd) import Darcs.Patch.Choices ( PatchChoices, patchChoices, patchChoicesTpsSub,@@ -68,7 +66,9 @@ import qualified Darcs.Patch.TouchesFiles as TouchesFiles import Darcs.PrintPatch ( printFriendly, printPatch, printPatchPager ) import Darcs.Match ( haveNonrangeMatch, matchAPatch, matchAPatchread )-import Darcs.Flags ( DarcsFlag( Summary, DontGrabDeps, Verbose, DontPromptForDependencies, SkipConflicts), isInteractive )+import Darcs.Flags ( DarcsFlag( Summary, DontGrabDeps, Verbose, DontPromptForDependencies+ , SkipConflicts )+ , isInteractive, UseIndex(..), ScanKnown(..) ) import Darcs.Witnesses.Sealed ( FlippedSeal(..), flipSeal, seal2, unseal2, Sealed(..), Sealed2(..) ) import Darcs.Utils ( askUser, promptChar, PromptConfig(..) ) import Darcs.Lock ( editText )@@ -108,13 +108,13 @@ -- patches. See "PatchSelectionM" data PatchSelectionContext p = PSC { opts :: [DarcsFlag] , splitter :: Maybe (Splitter p)- , files :: [FilePath]+ , files :: Maybe [FilePath] , matchCriterion :: MatchCriterion p , jobname :: String } -- | A 'PatchSelectionContext' for selecting 'Prim' patches.-selectionContextPrim :: String -> [DarcsFlag] -> Maybe (Splitter Prim)- -> [FilePath] -> PatchSelectionContext Prim+selectionContextPrim :: PrimPatch prim => String -> [DarcsFlag] -> Maybe (Splitter prim)+ -> Maybe [FilePath] -> PatchSelectionContext prim selectionContextPrim jn o spl fs = PSC { opts = o , splitter = spl@@ -124,7 +124,7 @@ -- | A 'PatchSelectionContext' for selecting full patches ('PatchInfoAnd' patches) selectionContext :: (RepoPatch p) => String -> [DarcsFlag] -> Maybe (Splitter (PatchInfoAnd p))- -> [FilePath] -> PatchSelectionContext (PatchInfoAnd p)+ -> Maybe [FilePath] -> PatchSelectionContext (PatchInfoAnd p) selectionContext jn o spl fs = PSC { opts = o , splitter = spl@@ -162,12 +162,12 @@ -- opts' iswanted :: Patchy p => MatchCriterion (PatchInfoAnd p) iswanted whch opts' =- unseal2 (iw whch opts')+ unseal2 (iw whch) where- iw First o = matchAPatch o . hopefully- iw Last o = matchAPatch o . hopefully- iw LastReversed o = matchAPatch o . hopefully . invert- iw FirstReversed o = matchAPatch o . hopefully . invert+ iw First = matchAPatch opts' . hopefully+ iw Last = matchAPatch opts' . hopefully+ iw LastReversed = matchAPatch opts' . hopefully . invert+ iw FirstReversed = matchAPatch opts' . hopefully . invert liftR :: Monad m => Reader r a -> ReaderT r m a liftR = asks . runReader@@ -214,7 +214,7 @@ -- | The equivalent of 'selectChanges' for the @darcs changes@ command viewChanges :: Patchy p => [DarcsFlag] -> [Sealed2 p] -> IO ()-viewChanges opts ps = textView opts Nothing 0 [] ps+viewChanges opts' ps = textView opts' Nothing 0 [] ps -- | The type of the answers to a "shall I [wiggle] that [foo]?" question -- They are found in a [[KeyPress]] bunch, each list representing a set of@@ -247,7 +247,7 @@ sp <- wspfr jn (matchAPatchread o) (newset2RL p_s) NilFL case sp of- Just (FlippedSeal (skipped :> selected)) -> job (skipped :> selected)+ Just (FlippedSeal (skipped :> selected')) -> job (skipped :> selected') Nothing -> do putStrLn $ "Cancelling "++jn++" since no patch was selected." -- | This ensures that the selected patch commutes freely with the skipped patches, including pending@@ -277,8 +277,8 @@ , KeyPress 'x' "view a summary of this patch" , KeyPress 'q' ("cancel "++jn) ]]- let prompt = "Shall I "++jn++" this patch?"- yorn <- promptChar $ PromptConfig { pPrompt = prompt+ let prompt' = "Shall I "++jn++" this patch?"+ yorn <- promptChar $ PromptConfig { pPrompt = prompt' , pBasicCharacters = keysFor basic_options , pAdvancedCharacters = keysFor advanced_options , pDefault = Just 'n'@@ -299,10 +299,9 @@ -- After selecting with a splitter, the results may not be canonical canonizeAfterSplitter :: (FL p :> FL p) C(x y) -> Reader (PatchSelectionContext p) ((FL p :> FL p) C(x y)) canonizeAfterSplitter (x :> y) =- do spl' <- asks splitter- case spl' of- Nothing -> return (x:>y)- Just spl -> return $ canonizeSplit spl x :> canonizeSplit spl y+ do mspl <- asks splitter+ let canonizeIfNeeded = maybe id canonizeSplit mspl+ return $ canonizeIfNeeded x :> canonizeIfNeeded y realSelectChanges :: forall p C(x y). Patchy p => WhichChanges@@ -313,7 +312,7 @@ o <- asks opts if not $ isInteractive o then return $ promote autoChoices- else flip refineChoices autoChoices $ textSelect whch+ else refineChoices (textSelect whch) autoChoices where forward = not $ backward whch promote = if forward then makeEverythingSooner@@ -327,7 +326,7 @@ deselectUnwanted whichch pc = do o <- asks opts- c <- (asks matchCriterion)+ c <- asks matchCriterion let iswanted_ = c whichch o . seal2 . tpPatch select = if forward then forceMatchingFirst iswanted_@@ -335,12 +334,12 @@ deselect = if forward then forceMatchingLast (not . iswanted_) else forceMatchingFirst (not . iswanted_)- if haveNonrangeMatch o- then if DontGrabDeps `elem` o- then return $ deselect pc- else do- return . demote $ select pc- else return pc+ return $+ if haveNonrangeMatch o+ then if DontGrabDeps `elem` o+ then deselect pc+ else demote $ select pc+ else pc where forward = not $ backward whichch demote = if forward@@ -364,7 +363,7 @@ FirstReversed -> TouchesFiles.selectNotTouching LastReversed -> TouchesFiles.deselectNotTouching everything = patchChoices ps- if null fs && not (haveNonrangeMatch o)+ if isNothing fs && not (haveNonrangeMatch o) then return everything else do notUnwanted <- deselectUnwanted whch everything return $ deselectNotTouching fs notUnwanted@@ -390,12 +389,12 @@ -- | Runs a function on the underlying @PatchChoices@ object liftChoices :: forall p a C(x y) . Patchy p =>- State (PatchChoices p C(x y)) a+ StateT (PatchChoices p C(x y)) Identity a -> InteractiveSelectionM p C(x y) a liftChoices act = do ch <- gets choices- let (result, ch') = runState act ch- modify $ \isc -> isc {choices = ch}+ let (result, _) = runIdentity $ runStateT act ch+ modify $ \isc -> isc {choices = ch} -- Should this be ch or the result of runState? return result -- | @justDone n@ notes that @n@ patches have just been processed@@ -406,13 +405,13 @@ textSelect :: forall p C(x y) . Patchy p => WhichChanges -> FL (TaggedPatch p) C(x y) -> PatchChoices p C(x y) -> PatchSelectionM p IO (PatchChoices p C(x y))-textSelect whch tps pcs = do+textSelect whch tps' pcs = do userSelection <- execStateT (skipMundane whch >> showCur whch >> textSelect' whch) $- ISC { total = lengthFL tps+ ISC { total = lengthFL tps' , current = 0- , tps = FZipper NilRL tps+ , tps = FZipper NilRL tps' , choices = pcs } return $ choices userSelection @@ -682,7 +681,6 @@ do jn <- asks jobname spl <- asks splitter- o <- asks opts let singleFile = isSingleFile (tpPatch tp) reprCur = repr whichch (Sealed2 (tpPatch tp)) (basicOptions,advancedOptions) <- options singleFile@@ -733,7 +731,7 @@ liftIO . (unseal2 (printFriendly o)) $ reprCur -- | The interactive part of @darcs changes@-textView :: forall p C(x y u r s). Patchy p => [DarcsFlag] -> Maybe Int -> Int+textView :: forall p . Patchy p => [DarcsFlag] -> Maybe Int -> Int -> [Sealed2 p] -> [Sealed2 p] -> IO () textView _ _ _ _ [] = return ()@@ -759,26 +757,26 @@ options_yn = [ KeyPress 'y' "view this patch and go to the next" , KeyPress 'n' "skip to the next patch" ]- optionsView =+ optionsView' = [ KeyPress 'v' "view this patch in full" , KeyPress 'p' "view this patch in full with pager" ]- optionsSummary =+ optionsSummary' = [ KeyPress 'x' "view a summary of this patch" ]- optionsNav =+ optionsNav' = [ KeyPress 'q' "quit view changes" , KeyPress 'k' "back up to previous patch" , KeyPress 'j' "skip to next patch" , KeyPress 'c' "count total patch number" ] basicOptions = [ options_yn ] advancedOptions =- [ optionsView ++- if Summary `elem` o then [] else optionsSummary ]- ++ [ optionsNav ]- prompt = "Shall I view this patch? "+ [ optionsView' +++ if Summary `elem` o then [] else optionsSummary' ]+ ++ [ optionsNav' ]+ prompt' = "Shall I view this patch? " ++ "(" ++ show (n+1) ++ "/" ++ maybe "?" show n_max ++ ")" repeat_this :: IO () repeat_this = do- yorn <- promptChar (PromptConfig prompt (keysFor basicOptions) (keysFor advancedOptions) (Just 'n') "?h")+ yorn <- promptChar (PromptConfig prompt' (keysFor basicOptions) (keysFor advancedOptions) (Just 'n') "?h") case yorn of 'y' -> unseal2 printPatch p >> next_patch 'n' -> next_patch@@ -856,7 +854,8 @@ filterOutConflicts o us repository them | SkipConflicts `elem` o = do let commuter = commuterIdRL selfCommuter- unrec <- fmap n2pia . (anonymous . fromPrims) =<< unrecordedChanges [] repository []+ unrec <- fmap n2pia . (anonymous . fromPrims)+ =<< unrecordedChanges (UseIndex, ScanKnown) repository Nothing them' :> rest <- return $ partitionConflictingFL commuter them (unrec :<: us) return (check rest, Sealed them') | otherwise
src/Darcs/SignalHandler.hs view
@@ -15,9 +15,7 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp -fglasgow-exts #-}-{-# LANGUAGE CPP #-}--- , DeriveDataTypeable #-}+{-# LANGUAGE CPP, DeriveDataTypeable #-} module Darcs.SignalHandler ( withSignalsHandled, withSignalsBlocked, catchInterrupt, catchNonSignal,@@ -29,7 +27,7 @@ import System.Exit ( exitWith, ExitCode ( ExitFailure ) ) import Control.Concurrent ( ThreadId, myThreadId ) import Control.Exception.Extensible- ( catch, throw, throwTo, block,+ ( catch, throw, throwTo, block, unblock, Exception(..), SomeException(..), IOException ) import System.Posix.Files ( getFdStatus, isNamedPipe ) import System.Posix.IO ( stdOutput )@@ -88,12 +86,14 @@ #endif resethandler :: Signal -> IO ()-resethandler s = do installHandler s Default Nothing+-- Warning: A do-notation statement discarded a result of type Handler.+resethandler s = do _ <- installHandler s Default Nothing return () ih :: ThreadId -> Signal -> IO () ih thid s =- do installHandler s (Catch $ throwTo thid $ SignalException s) Nothing+-- Warning: A do-notation statement discarded a result of type Handler.+ do _ <- installHandler s (Catch $ throwTo thid $ SignalException s) Nothing return () catchSignal :: IO a -> (Signal -> IO a) -> IO a@@ -127,14 +127,16 @@ | ioeGetFileName ioe == Just "<stdout>" = handler ("STDOUT" ++ ioeGetErrorString ioe) | otherwise = throw ioe -withSignalsBlocked :: IO () -> IO ()-withSignalsBlocked job = (block job) `catchSignal` couldnt_do- where couldnt_do s | s == sigINT = oops "interrupt"- | s == sigHUP = oops "HUP"- | s == sigABRT = oops "ABRT"- | s == sigALRM = oops "ALRM"- | s == sigTERM = oops "TERM"- | s == sigPIPE = return ()- | otherwise = oops "unknown signal"- oops s = hPutStrLn stderr $ "Couldn't handle " ++ s ++- " since darcs was in a sensitive job."+withSignalsBlocked :: IO a -> IO a+withSignalsBlocked job = block (job >>= \r ->+ unblock(return r) `catchSignal` couldnt_do r)+ where couldnt_do r s | s == sigINT = oops "interrupt" r+ | s == sigHUP = oops "HUP" r+ | s == sigABRT = oops "ABRT" r+ | s == sigALRM = oops "ALRM" r+ | s == sigTERM = oops "TERM" r+ | s == sigPIPE = return r+ | otherwise = oops "unknown signal" r+ oops s r = do hPutStrLn stderr $ "Couldn't handle " ++ s +++ " since darcs was in a sensitive job."+ return r
+ src/Darcs/Test.hs view
@@ -0,0 +1,95 @@+-- Copyright (C) 2002-2005 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.++module Darcs.Test ( getTest,+ runPosthook, runPrehook )+where+import Darcs.RepoPath ( AbsolutePath )+import Darcs.Utils ( withCurrentDirectory )+import System.Exit ( ExitCode(..) )+import System.Cmd ( system )+import Control.Monad ( when )++import Darcs.Arguments ( DarcsFlag( Quiet,+ AskPosthook, AskPrehook ),+ getPosthookCmd, getPrehookCmd )+import Darcs.Repository.Prefs ( getPrefval )+import Darcs.Utils ( askUser )+import System.IO ( hPutStrLn, stderr )++getTest :: [DarcsFlag] -> IO (IO ExitCode)+getTest opts =+ let putInfo s = when (not $ Quiet `elem` opts) $ putStr s+ in do+ testline <- getPrefval "test"+ return $+ case testline of+ Nothing -> return ExitSuccess+ Just testcode -> do+ putInfo "Running test...\n"+ ec <- system testcode+ if ec == ExitSuccess+ then putInfo "Test ran successfully.\n"+ else putInfo "Test failed!\n"+ return ec++runPosthook :: [DarcsFlag] -> AbsolutePath -> IO ExitCode+runPosthook opts repodir = do ph <- getPosthook opts+ withCurrentDirectory repodir $ runHook opts "Posthook" ph++getPosthook :: [DarcsFlag] -> IO (Maybe String)+getPosthook opts = case getPosthookCmd opts of+ Nothing -> return Nothing+ Just command ->+ if AskPosthook `elem` opts+ then do putStr ("\nThe following command is set to execute.\n"+++ "Execute the following command now (yes or no)?\n"+++ command++"\n")+ yorn <- askUser ""+ case yorn of ('y':_) -> return $ Just command+ _ -> do putStrLn "Posthook cancelled..."+ return Nothing+ else return $ Just command++runPrehook :: [DarcsFlag] -> AbsolutePath -> IO ExitCode+runPrehook opts repodir = do ph <- getPrehook opts+ withCurrentDirectory repodir $ runHook opts "Prehook" ph++getPrehook :: [DarcsFlag] -> IO (Maybe String)+getPrehook opts = case getPrehookCmd opts of+ Nothing -> return Nothing+ Just command ->+ if AskPrehook `elem` opts+ then do putStr ("\nThe following command is set to execute.\n"+++ "Execute the following command now (yes or no)?\n"+++ command++"\n")+ yorn <- askUser ""+ case yorn of ('y':_) -> return $ Just command+ _ -> do putStrLn "Prehook cancelled..."+ return Nothing+ else return $ Just command++runHook :: [DarcsFlag] -> String -> Maybe String -> IO ExitCode+runHook _ _ Nothing = return ExitSuccess+runHook opts cname (Just command) =+ do ec <- system command+ when (Quiet `notElem` opts) $+ if ec == ExitSuccess+ then putStrLn $ cname++" ran successfully."+ else hPutStrLn stderr $ cname++" failed!"+ return ec+
− src/Darcs/Test.lhs
@@ -1,121 +0,0 @@-% Copyright (C) 2002-2005 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.--\begin{code}-module Darcs.Test ( getTest,- runPosthook, runPrehook )-where-import Darcs.RepoPath ( AbsolutePath )-import Darcs.Utils ( withCurrentDirectory )-import System.Exit ( ExitCode(..) )-import System.Cmd ( system )-import Control.Monad ( when )--import Darcs.Arguments ( DarcsFlag( Quiet,- AskPosthook, AskPrehook ),- getPosthookCmd, getPrehookCmd )-import Darcs.Repository.Prefs ( getPrefval )-import Darcs.Utils ( askUser )-import System.IO ( hPutStrLn, stderr )-\end{code}--If you like, you can configure your repository to be able to run a test-suite of some sort. You can do this by using ``setpref'' to set the-``test'' value to be a command to run, e.g.-\begin{verbatim}-% darcs setpref test "sh configure && make && make test"-\end{verbatim}-Or, if you want to define a test specific to one copy of the repository,-you could do this by editing the file \verb!_darcs/prefs/prefs!.--\begin{options}---leave-test-directory, --remove-test-directory-\end{options}--Normally darcs deletes the directory in which the test was run afterwards.-Sometimes (especially when the test fails) you'd prefer to be able to be-able to examine the test directory after the test is run. You can do this-by specifying the \verb!--leave-test-directory! flag. Alas, there is no-way to make darcs leave the test directory only if the test fails. The-opposite of \verb!--leave-test-directory! is-\verb!--remove-test-directory!, which could come in handy if you choose to-make \verb!--leave-test-directory! the default (see-section~\ref{defaults}).--\begin{code}-getTest :: [DarcsFlag] -> IO (IO ExitCode)-getTest opts =- let putInfo s = when (not $ Quiet `elem` opts) $ putStr s- in do- testline <- getPrefval "test"- return $- case testline of- Nothing -> return ExitSuccess- Just testcode -> do- putInfo "Running test...\n"- ec <- system testcode- if ec == ExitSuccess- then putInfo "Test ran successfully.\n"- else putInfo "Test failed!\n"- return ec--runPosthook :: [DarcsFlag] -> AbsolutePath -> IO ExitCode-runPosthook opts repodir = do ph <- getPosthook opts- withCurrentDirectory repodir $ runHook opts "Posthook" ph--getPosthook :: [DarcsFlag] -> IO (Maybe String)-getPosthook opts = case getPosthookCmd opts of- Nothing -> return Nothing- Just command ->- if AskPosthook `elem` opts- then do putStr ("\nThe following command is set to execute.\n"++- "Execute the following command now (yes or no)?\n"++- command++"\n")- yorn <- askUser ""- case yorn of ('y':_) -> return $ Just command- _ -> do putStrLn "Posthook cancelled..."- return Nothing- else return $ Just command--runPrehook :: [DarcsFlag] -> AbsolutePath -> IO ExitCode-runPrehook opts repodir = do ph <- getPrehook opts- withCurrentDirectory repodir $ runHook opts "Prehook" ph--getPrehook :: [DarcsFlag] -> IO (Maybe String)-getPrehook opts = case getPrehookCmd opts of- Nothing -> return Nothing- Just command ->- if AskPrehook `elem` opts- then do putStr ("\nThe following command is set to execute.\n"++- "Execute the following command now (yes or no)?\n"++- command++"\n")- yorn <- askUser ""- case yorn of ('y':_) -> return $ Just command- _ -> do putStrLn "Prehook cancelled..."- return Nothing- else return $ Just command--runHook :: [DarcsFlag] -> String -> Maybe String -> IO ExitCode-runHook _ _ Nothing = return ExitSuccess-runHook opts cname (Just command) =- do ec <- system command- when (Quiet `notElem` opts) $- if ec == ExitSuccess- then putStrLn $ cname++" ran successfully."- else hPutStrLn stderr $ cname++" failed!"- return ec-\end{code}
src/Darcs/Test/Email.hs view
@@ -21,18 +21,24 @@ -- These tests check whether the emails generated by darcs meet a few criteria. -- We check for line length and non-ASCII characters. We apparently do not have -- to check for CR-LF newlines because that's handled by sendmail.-module Darcs.Test.Email ( emailParsing, emailHeaderNoLongLines,- emailHeaderAsciiChars, emailHeaderLinesStart,- emailHeaderNoEmptyLines- ) where+module Darcs.Test.Email ( testSuite ) where import Data.Char ( isPrint )-import qualified Data.ByteString as B ( length, unpack, null, head, filter,+import qualified Data.ByteString as B ( length, unpack, null, head, cons, empty, foldr, ByteString ) import qualified Data.ByteString.Char8 as BC ( unpack )-import Test.Framework ( Test )+import Test.Framework ( Test, testGroup ) import Test.Framework.Providers.QuickCheck2 ( testProperty ) import Printer ( text, renderPS ) import Darcs.Email ( makeEmail, readEmail, formatHeader )++testSuite :: Test+testSuite = testGroup "Darcs.Email"+ [ emailParsing+ , emailHeaderNoLongLines+ , emailHeaderAsciiChars+ , emailHeaderLinesStart+ , emailHeaderNoEmptyLines+ ] -- | Checks that darcs can read the emails it generates emailParsing :: Test
+ src/Darcs/Test/Misc.hs view
@@ -0,0 +1,107 @@+-- 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.++{-# LANGUAGE CPP #-}++module Darcs.Test.Misc ( testSuite ) where++import ByteStringUtils ( unpackPSFromUTF8, fromHex2PS, fromPS2Hex )+import qualified Data.ByteString.Char8 as BC ( unpack, pack )+import qualified Data.ByteString as B ( concat, empty )+import Lcs ( shiftBoundaries )+import Data.Array.Base+import Control.Monad.ST+import Test.HUnit ( assertBool, assertEqual, assertFailure )+import Test.Framework.Providers.QuickCheck2 ( testProperty )+import Test.Framework.Providers.HUnit ( testCase )+import Test.Framework ( Test, testGroup )++#include "gadts.h"++testSuite :: Test+testSuite = testGroup ""+ [ byteStringUtilsTestSuite+ , lcsTestSuite+ ]+++-- ----------------------------------------------------------------------+-- * ByteStringUtils+-- Here are a few quick tests of the shiftBoundaries function.+-- ----------------------------------------------------------------------++byteStringUtilsTestSuite :: Test+byteStringUtilsTestSuite = testGroup "ByteStringUtils"+ [ testCase "UTF-8 packing and unpacking preserves 'hello world'"+ (assertBool "" (unpackPSFromUTF8 (BC.pack "hello world") == "hello world"))+ , testCase "Checking that hex packing and unpacking preserves 'hello world'"+ (assertEqual "" (BC.unpack (fromHex2PS $ fromPS2Hex $ BC.pack "hello world"))+ "hello world")+ , testProperty "Checking that B.concat works" propConcatPS+ , testProperty "Checking that hex conversion works" propHexConversion+ ]++propHexConversion :: String -> Bool+propHexConversion s =+ fromHex2PS (fromPS2Hex $ BC.pack s) == BC.pack s++propConcatPS :: [String] -> Bool+propConcatPS ss = concat ss == BC.unpack (B.concat $ map BC.pack ss)++-- ----------------------------------------------------------------------+-- * LCS+-- Here are a few quick tests of the shiftBoundaries function.+-- ----------------------------------------------------------------------++lcsTestSuite :: Test+lcsTestSuite = testGroup "LCS"+ [ testCase "lcs code" (mapM_ assertFailure showLcsTests)+ ]++showLcsTests :: [String]+showLcsTests = concatMap checkKnownShifts knownShifts+checkKnownShifts :: ([Int],[Int],String,String,[Int],[Int])+ -> [String]+checkKnownShifts (ca, cb, sa, sb, ca', cb') = runST (+ do ca_arr <- newListArray (0, length ca) $ toBool (0:ca)+ cb_arr <- newListArray (0, length cb) $ toBool (0:cb)+ let p_a = listArray (0, length sa) $ B.empty:(toPS sa)+ p_b = listArray (0, length sb) $ B.empty:(toPS sb)+ shiftBoundaries ca_arr cb_arr p_a 1 1+ shiftBoundaries cb_arr ca_arr p_b 1 1+ ca_res <- fmap (fromBool . tail) $ getElems ca_arr+ cb_res <- fmap (fromBool . tail) $ getElems cb_arr+ return $ if ca_res == ca' && cb_res == cb' then []+ else ["shiftBoundaries failed on "++sa++" and "++sb++" with "+ ++(show (ca,cb))++" expected "++(show (ca', cb'))+ ++" got "++(show (ca_res, cb_res))++"\n"])+ where toPS = map (\c -> if c == ' ' then B.empty else BC.pack [c])+ toBool = map (>0)+ fromBool = map (\b -> if b then 1 else 0)++knownShifts :: [([Int],[Int],String,String,[Int],[Int])]+knownShifts =+ [([0,0,0],[0,1,0,1,0],"aaa","aaaaa",+ [0,0,0],[0,0,0,1,1]),+ ([0,1,0],[0,1,1,0],"cd ","c a ",+ [0,1,0],[0,1,1,0]),+ ([1,0,0,0,0,0,0,0,0],[1,0,0,0,0,0,1,1,1,1,1,0,0,0], "fg{} if{}","dg{} ih{} if{}",+ [1,0,0,0,0,0,0,0,0],[1,0,0,0,0,1,1,1,1,1,0,0,0,0]), -- prefer empty line at end+ ([0,0,0,0,0,0,0,0,0],[0,0,0,0,0,0,1,1,1,1,1,0,0,0], "fg{} if{}","fg{} ih{} if{}",+ [0,0,0,0,0,0,0,0,0],[0,0,0,0,0,1,1,1,1,1,0,0,0,0]), -- prefer empty line at end+ ([],[1,1],"","aa",[],[1,1]),+ ([1,1],[],"aa","",[1,1],[])]
+ src/Darcs/Test/Patch.hs view
@@ -0,0 +1,31 @@+-- 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.++module Darcs.Test.Patch ( testInfo, testSuite ) where++import Darcs.Test.Patch.Examples ( testInfo, patchExampleTests )+import Darcs.Test.Patch.Properties2 ( patchPropertyTests )+import Darcs.Test.Patch.Unit ( patchUnitTests )+import Darcs.Test.Patch.Unit2 ( patchUnitTests2 )+import qualified Darcs.Test.Patch.Info+import Test.Framework ( Test, testGroup )++-- | This is the big list of tests that will be run using testrunner.+testSuite :: Test+testSuite = testGroup "Darcs.Patch" $+ patchUnitTests ++ patchUnitTests2 ++ patchPropertyTests +++ patchExampleTests ++ [Darcs.Test.Patch.Info.testSuite]
src/Darcs/Test/Patch/Check.hs view
@@ -58,6 +58,12 @@ show (NotEx f) = "NotEx"++f show (FileLines f l) = "FileLines "++f++": "++show l +-- TODO the way that the standard way to use PatchCheck is+-- by returning PatchCheck Bool but then often ignoring the+-- result and instead checking again for state consistency+-- is weird. It should be possible to replace it by a more normal+-- error handling mechanism.+ -- | PatchCheck is a state monad with a simulated repository state type PatchCheck = State KnownState @@ -82,7 +88,7 @@ doVerboseCheck :: PatchCheck a -> a doVerboseCheck p = case runState p (P [] []) of- (b, pc) -> unsafePerformIO $ do putStrLn $ show pc+ (b, pc) -> unsafePerformIO $ do print pc return b -- | Returns true if the current repository state is not inconsistent@@ -97,7 +103,7 @@ -> (Maybe FileContents -> Maybe FileContents) -> PatchCheck Bool modifyFile f change = do- fileExists f+ _ <- fileExists f c <- fileContents f case change c of Nothing -> assertNot $ FileEx f -- shorthand for "FAIL"@@ -166,7 +172,7 @@ let empty = case c of Just c' -> fcMaxline c' == 0 && M.null (fcLines c') Nothing -> True- if empty+ _ <- if empty then do setContents f emptyFilecontents isValid -- Crude way to make it inconsistent and return false:@@ -247,58 +253,58 @@ return True assertFileExists :: String -> PatchCheck Bool-assertFileExists f = do assertNot $ NotEx f- assertNot $ DirEx f+assertFileExists f = do _ <- assertNot $ NotEx f+ _ <- assertNot $ DirEx f assert $ FileEx f assertDirExists :: String -> PatchCheck Bool-assertDirExists d = do assertNot $ NotEx d- assertNot $ FileEx d+assertDirExists d = do _ <- assertNot $ NotEx d+ _ <- assertNot $ FileEx d assert $ DirEx d assertExists :: String -> PatchCheck Bool assertExists f = assertNot $ NotEx f assertNoSuch :: String -> PatchCheck Bool-assertNoSuch f = do assertNot $ FileEx f- assertNot $ DirEx f+assertNoSuch f = do _ <- assertNot $ FileEx f+ _ <- assertNot $ DirEx f assert $ NotEx f createFile :: String -> PatchCheck Bool createFile fn = do- superdirsExist fn- assertNoSuch fn- changeToTrue (FileEx fn)+ _ <- superdirsExist fn+ _ <- assertNoSuch fn+ _ <- changeToTrue (FileEx fn) changeToFalse (NotEx fn) createDir :: String -> PatchCheck Bool createDir fn = do- substuffDontExist fn- superdirsExist fn- assertNoSuch fn- changeToTrue (DirEx fn)+ _ <- substuffDontExist fn+ _ <- superdirsExist fn+ _ <- assertNoSuch fn+ _ <- changeToTrue (DirEx fn) changeToFalse (NotEx fn) removeFile :: String -> PatchCheck Bool removeFile fn = do- superdirsExist fn- assertFileExists fn- fileEmpty fn- changeToFalse (FileEx fn)+ _ <- superdirsExist fn+ _ <- assertFileExists fn+ _ <- fileEmpty fn+ _ <- changeToFalse (FileEx fn) changeToTrue (NotEx fn) removeDir :: String -> PatchCheck Bool removeDir fn = do- substuffDontExist fn- superdirsExist fn- assertDirExists fn- changeToFalse (DirEx fn)+ _ <- substuffDontExist fn+ _ <- superdirsExist fn+ _ <- assertDirExists fn+ _ <- changeToFalse (DirEx fn) changeToTrue (NotEx fn) checkMove :: String -> String -> PatchCheck Bool checkMove f f' = do- superdirsExist f- superdirsExist f'- assertExists f- assertNoSuch f'+ _ <- superdirsExist f+ _ <- superdirsExist f'+ _ <- assertExists f+ _ <- assertNoSuch f' doSwap f f' substuffDontExist :: String -> PatchCheck Bool@@ -324,10 +330,10 @@ fileExists :: String -> PatchCheck Bool fileExists fn = do- superdirsExist fn+ _ <- superdirsExist fn assertFileExists fn dirExists :: String -> PatchCheck Bool dirExists fn = do- superdirsExist fn+ _ <- superdirsExist fn assertDirExists fn
+ src/Darcs/Test/Patch/Examples.hs view
@@ -0,0 +1,604 @@+-- 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.++{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-deprecations #-}+{-# LANGUAGE CPP #-}++module Darcs.Test.Patch.Examples ( testInfo, patchExampleTests ) where++import System.IO.Unsafe ( unsafePerformIO )+import qualified Data.ByteString.Char8 as BC ( pack )+import qualified Data.ByteString as B ( empty )+import Darcs.Patch+ ( Patchy, commute, invert, merge, effect+ , Named, namepatch+ , readPatch, showPatch+ , fromPrim, canonize, sortCoalesceFL+ , adddir, addfile, hunk, binary, rmdir, rmfile, tokreplace )+import Darcs.Patch.Prim ( PrimOf, FromPrim )+import Darcs.Patch.Prim.V1 ( Prim )+import qualified Darcs.Patch.V1 as V1 ( Patch )+import Darcs.Test.Patch.Test+ ( checkAPatch )+import Darcs.Test.Patch.Utils ( testStringList )+import Printer ( renderPS )+import Darcs.Witnesses.Eq+import Darcs.Witnesses.Ordered+import Darcs.Witnesses.Show+import Darcs.Witnesses.Sealed ( Sealed(Sealed), unsafeUnseal )+import Darcs.Witnesses.Unsafe ( unsafeCoerceP, unsafeCoercePEnd )+import Test.Framework ( Test )++#include "gadts.h"+#include "impossible.h"++type Patch = V1.Patch Prim++testInfo :: String+testInfo = unlines+ [ "There are a total of "++ show (length primitiveTestPatches) ++" primitive patches."+ , "There are a total of "++ show (length testPatches) ++" patches."+ ]++patchExampleTests :: [Test]+patchExampleTests =+ [+ testStringList "Checking known commutes" commuteTests,+ testStringList "Checking known merges" mergeTests,+ testStringList "Checking known canons" canonizationTests,+ testStringList "Checking merge swaps" mergeSwapTests,+ testStringList "Checking that the patch validation works" testCheck,+ testStringList "Checking commute/recommute" commuteRecommuteTests,+ testStringList "Checking merge properties" genericMergeTests,+ testStringList "Checking primitive patch IO functions" primitiveShowReadTests,+ testStringList "Checking IO functions" showReadTests,+ testStringList "Checking primitive commute/recommute" primitiveCommuteRecommuteTests+ ]++-- The unit tester function is really just a glorified map for functions that+-- return lists, in which the lists get concatenated (where map would end up+-- with a list of lists).++quickmerge :: (FL Patch :\/: FL Patch) C(x y) -> FL Patch C(y z)+quickmerge (p1:\/:p2) = case merge (p1:\/:p2) of+ _ :/\: p1' -> unsafeCoercePEnd p1'++type PatchUnitTest p = FORALL(x y) p C(x y) -> [String]+type ParallelPatchUnitTest = FORALL(x y z) FL Patch C(x y) -> FL Patch C(x z) -> [String]+type SerialPatchUnitTest = FORALL(x y z) FL Patch C(y z) -> FL Patch C(x y) -> [String]++parallelPairUnitTester :: ParallelPatchUnitTest -> [(FL Patch:\/:FL Patch) C(x y)] -> [String]+parallelPairUnitTester _ [] = []+parallelPairUnitTester thetest ((p1:\/:p2):ps)+ = (thetest p1 p2)++(parallelPairUnitTester thetest ps)++pairUnitTester :: SerialPatchUnitTest -> [(FL Patch:<FL Patch) C(x y)] -> [String]+pairUnitTester _ [] = []+pairUnitTester thetest ((p1:<p2):ps)+ = (thetest p1 p2)++(pairUnitTester thetest ps)+++-- ----------------------------------------------------------------------+-- * Show/Read tests+-- ----------------------------------------------------------------------++-- | This test involves calling 'show' to print a string describing a patch,+-- and then using readPatch to read it back in, and making sure the patch we+-- read in is the same as the original. Useful for making sure that I don't+-- have any stupid IO bugs.+showReadTests :: [String]+showReadTests = concatMap (tShowRead eqFLUnsafe) testPatches +++ concatMap (tShowRead unsafeCompare) testPatchesNamed++primitiveShowReadTests :: [String]+primitiveShowReadTests = concatMap (tShowRead eqFLUnsafe) primitiveTestPatches++tShowRead :: (Show2 p, Patchy p) => (FORALL(x y w z) p C(x y) -> p C(w z) -> Bool) -> PatchUnitTest p+tShowRead eq p =+ case readPatch $ renderPS $ showPatch p of+ Just (Sealed p') -> if p' `eq` p then []+ else ["Failed to read shown: "++(show2 p)++"\n"]+ Nothing -> ["Failed to read at all: "++(show2 p)++"\n"]++-- ----------------------------------------------------------------------+-- * Canonization tests+-- ----------------------------------------------------------------------++-- | This is a set of known correct canonizations, to make sure that I'm+-- canonizing as I ought.+canonizationTests :: [String]+canonizationTests = concatMap checkKnownCanon knownCanons+checkKnownCanon :: FORALL(x y) (FL Patch C(x y), FL Patch C(x y)) -> [String]+checkKnownCanon (p1,p2) =+ if isIsEq $ eqFL (mapFL_FL fromPrim $ concatFL $ mapFL_FL canonize $ sortCoalesceFL $ effect p1) p2+ then []+ else ["Canonization failed:\n"++show p1++"canonized is\n"+ ++show (mapFL_FL fromPrim $ concatFL $ mapFL_FL canonize $ sortCoalesceFL $ effect p1 :: FL Patch C(x y))+ ++"which is not\n"++show p2]+knownCanons :: [(FL Patch C(x y),FL Patch C(x y))]+knownCanons =+ [(quickhunk 1 "abcde" "ab" :>: NilFL, quickhunk 3 "cde" "" :>: NilFL),+ (quickhunk 1 "abcde" "bd" :>: NilFL,+ quickhunk 1 "a" "" :>:+ quickhunk 2 "c" "" :>:+ quickhunk 3 "e" "" :>: NilFL),+ (quickhunk 4 "a" "b" :>:+ quickhunk 1 "c" "d" :>: NilFL,+ quickhunk 1 "c" "d" :>:+ quickhunk 4 "a" "b" :>: NilFL),+ (quickhunk 1 "a" "" :>:+ quickhunk 1 "" "b" :>: NilFL,+ quickhunk 1 "a" "b" :>: NilFL),+ (quickhunk 1 "ab" "c" :>:+ quickhunk 1 "cd" "e" :>: NilFL,+ quickhunk 1 "abd" "e" :>: NilFL),+ (quickhunk 1 "abcde" "cde" :>: NilFL, quickhunk 1 "ab" "" :>: NilFL),+ (quickhunk 1 "abcde" "acde" :>: NilFL, quickhunk 2 "b" "" :>: NilFL)]++quickhunk :: (FromPrim p, PrimOf p ~ Prim) => Int -> String -> String -> p C(x y)+quickhunk l o n = fromPrim $ hunk "test" l (map (\c -> BC.pack [c]) o)+ (map (\c -> BC.pack [c]) n)++-- ----------------------------------------------------------------------+-- * Merge/unmgerge tests+-- ----------------------------------------------------------------------++-- | It should always be true that if two patches can be unmerged, then merging+-- the resulting patches should give them back again.+genericMergeTests :: [String]+genericMergeTests =+ case take 400 [(p1:\/:p2)|+ i <- [0..(length testPatches)-1],+ p1<-[testPatches!!i],+ p2<-drop i testPatches,+ checkAPatch (invert p2 :>: p1 :>: NilFL)] of+ merge_pairs -> (parallelPairUnitTester tMergeEitherWayValid merge_pairs) +++ (parallelPairUnitTester tMergeSwapMerge merge_pairs)+tMergeEitherWayValid :: ParallelPatchUnitTest+tMergeEitherWayValid p1 p2 =+ case p2 :>: quickmerge (p1:\/: p2) :>: NilFL of+ combo2 ->+ case p1 :>: quickmerge (p2:\/: p1) :>: NilFL of+ combo1 ->+ if not $ checkAPatch combo1+ then ["oh my combo1 invalid:\n"++show p1++"and...\n"++show p2++show combo1]+ else+ if checkAPatch (invert combo1 :>: combo2 :>: NilFL)+ then []+ else ["merge both ways invalid:\n"++show p1++"and...\n"++show p2+++ show combo1+++ show combo2]+tMergeSwapMerge :: ParallelPatchUnitTest+tMergeSwapMerge p1 p2 =+ if merge (p2 :\/: p1) `eqSwapped` merge (p1 :\/: p2)+ then []+ else ["Failed to swap merges:\n"++show p1++"and...\n"++show p2+ ++"merged:\n"++show (merge (p1:\/:p2))++"\n"+ ++"merged swapped:\n"++show (merge (p2:\/: p1))++"\n"]+ where eqSwapped :: (FL Patch :/\: FL Patch) C(x y) -> (FL Patch :/\: FL Patch) C(y x) -> Bool+ eqSwapped (x1 :/\: y1) (y2 :/\: x2) | IsEq <- eqFL x1 x2, IsEq <- eqFL y1 y2 = True+ eqSwapped _ _ = False++instance Show2 p => Show ((p :/\: p) C(x y)) where+ show (x :/\: y) = show2 x ++ " :/\\: " ++ show2 y+instance MyEq p => Eq ((p :/\: p) C(x y)) where+ (x :/\: y) == (x' :/\: y') = isIsEq (x =\/= x') && isIsEq (y =\/= y')++-- ----------------------------------------------------------------------+-- * Commute/recommute tests+-- ----------------------------------------------------------------------++-- | Here we test to see if commuting patch A and patch B and then commuting+-- the result gives us patch A and patch B again. The set of patches (A,B)+-- is chosen from the set of all pairs of test patches by selecting those which+-- commute with one another.+commuteRecommuteTests :: [String]+commuteRecommuteTests =+ case take 200 [(p2:<p1)|+ p1<-testPatches,+ p2<-filter (\p->checkAPatch (p1:>:p:>:NilFL)) testPatches,+ commute (p1:>p2) /= Nothing] of+ commute_pairs -> pairUnitTester tCommuteRecommute commute_pairs+primitiveCommuteRecommuteTests :: [String]+primitiveCommuteRecommuteTests =+ pairUnitTester tCommuteRecommute+ [(p1:<p2)|+ p1<-primitiveTestPatches,+ p2<-primitiveTestPatches,+ commute (p2:>p1) /= Nothing,+ checkAPatch (p2:>:p1:>:NilFL)]+tCommuteRecommute :: SerialPatchUnitTest+tCommuteRecommute p1 p2 =+ if (commute (p2:>p1) >>= commute) == Just (p2:>p1)+ then []+ else ["Failed to recommute:\n"++(show p2)++(show p1)+++ "we saw it as:\n"++show (commute (p2:>p1))+++ "\nAnd recommute was:\n"++show (commute (p2:>p1) >>= commute)+ ++ "\n"]++-- ----------------------------------------------------------------------+-- * Commute tests+-- ----------------------------------------------------------------------++-- | Here we provide a set of known interesting commutes.+commuteTests :: [String]+commuteTests =+ concatMap checkKnownCommute knownCommutes+++ concatMap checkCantCommute knownCantCommute+checkKnownCommute :: ((FL Patch:< FL Patch) C(x y), (FL Patch:< FL Patch) C(x y)) -> [String]+checkKnownCommute (p1:<p2,p2':<p1') =+ case commute (p2:>p1) of+ Just (p1a:>p2a) ->+ if (p2a:< p1a) == (p2':< p1')+ then []+ else ["Commute gave wrong value!\n"++show p1++"\n"++show p2+ ++"should be\n"++show p2'++"\n"++show p1'+ ++"but is\n"++show p2a++"\n"++show p1a]+ Nothing -> ["Commute failed!\n"++show p1++"\n"++show p2]+ +++ case commute (p1':>p2') of+ Just (p2a:>p1a) ->+ if (p1a:< p2a) == (p1:< p2)+ then []+ else ["Commute gave wrong value!\n"++show p2a++"\n"++show p1a+ ++"should have been\n"++show p2'++"\n"++show p1']+ Nothing -> ["Commute failed!\n"++show p2'++"\n"++show p1']+knownCommutes :: [((FL Patch:<FL Patch) C(x y),(FL Patch:<FL Patch) C(x y))]+knownCommutes = [+ (testhunk 1 [] ["A"]:<+ testhunk 2 [] ["B"],+ testhunk 3 [] ["B"]:<+ testhunk 1 [] ["A"]),+ (fromPrim (tokreplace "test" "A-Za-z_" "old" "new"):<+ testhunk 2+ ["hello world all that is old is good old_"]+ ["I don't like old things"],+ testhunk 2+ ["hello world all that is new is good old_"]+ ["I don't like new things"]:<+ fromPrim (tokreplace "test" "A-Za-z_" "old" "new")),+ (testhunk 1 ["A"] ["B"]:<+ testhunk 2 ["C"] ["D"],+ testhunk 2 ["C"] ["D"]:<+ testhunk 1 ["A"] ["B"]),+ (fromPrim (rmfile "NwNSO"):<+ (quickmerge (fromPrim (addfile "hello"):\/:fromPrim (addfile "hello"))),+ (quickmerge (fromPrim (addfile "hello"):\/:fromPrim (addfile "hello"))):<+ fromPrim (rmfile "NwNSO")),++ (quickmerge (testhunk 3 ["o"] ["n"]:\/:+ testhunk 3 ["o"] ["v"]):<+ testhunk 1 [] ["a"],+ testhunk 1 [] ["a"]:<+ quickmerge (testhunk 2 ["o"] ["n"]:\/:+ testhunk 2 ["o"] ["v"])),++ (testhunk 1 ["A"] []:<+ testhunk 3 ["B"] [],+ testhunk 2 ["B"] []:<+ testhunk 1 ["A"] []),++ (testhunk 1 ["A"] ["B"]:<+ testhunk 2 ["B"] ["C"],+ testhunk 2 ["B"] ["C"]:<+ testhunk 1 ["A"] ["B"]),++ (testhunk 1 ["A"] ["B"]:<+ testhunk 3 ["B"] ["C"],+ testhunk 3 ["B"] ["C"]:<+ testhunk 1 ["A"] ["B"]),++ (testhunk 1 ["A"] ["B","C"]:<+ testhunk 2 ["B"] ["C","D"],+ testhunk 3 ["B"] ["C","D"]:<+ testhunk 1 ["A"] ["B","C"])]+ where testhunk l o n = fromPrim $ hunk "test" l (map BC.pack o) (map BC.pack n)++checkCantCommute :: (FL Patch:< FL Patch) C(x y) -> [String]+checkCantCommute (p1:<p2) =+ case commute (p2:>p1) of+ Nothing -> []+ _ -> [show p1 ++ "\n\n" ++ show p2 +++ "\nArgh, these guys shouldn't commute!\n"]+knownCantCommute :: [(FL Patch:< FL Patch) C(x y)]+knownCantCommute = [+ (testhunk 2 ["o"] ["n"]:<+ testhunk 1 [] ["A"]),+ (testhunk 1 [] ["A"]:<+ testhunk 1 ["o"] ["n"]),+ (quickmerge (testhunk 2 ["o"] ["n"]:\/:+ testhunk 2 ["o"] ["v"]):<+ testhunk 1 [] ["a"]),+ (fromPrim (hunk "test" 1 ([BC.pack "a"]) ([BC.pack "b"])):<+ fromPrim (addfile "test"))]+ where testhunk l o n = fromPrim $ hunk "test" l (map BC.pack o) (map BC.pack n)++-- ----------------------------------------------------------------------+-- * Merge tests+-- ----------------------------------------------------------------------++-- | Here we provide a set of known interesting merges.+mergeTests :: [String]+mergeTests =+ concatMap checkKnownMergeEquiv knownMergeEquivs+++ concatMap checkKnownMerge knownMerges+checkKnownMerge :: ((FL Patch:\/: FL Patch) C(x y), FL Patch C(y z)) -> [String]+checkKnownMerge (p1:\/:p2,p1') =+ case merge (p1:\/:p2) of+ _ :/\: p1a ->+ if isIsEq (p1a `eqFL` p1')+ then []+ else ["Merge gave wrong value!\n"++show p1++show p2+ ++"I expected\n"++show p1'+ ++"but found instead\n"++show p1a]+knownMerges :: [((FL Patch:\/:FL Patch) C(x y),FL Patch C(y z))]+knownMerges = [+ (testhunk 2 [BC.pack "c"] [BC.pack "d",BC.pack "e"]:\/:+ testhunk 1 [BC.pack "x"] [BC.pack "a",BC.pack "b"],+ testhunk 3 [BC.pack "c"] [BC.pack "d",BC.pack "e"]),+ (testhunk 1 [BC.pack "x"] [BC.pack "a",BC.pack "b"]:\/:+ testhunk 2 [BC.pack "c"] [BC.pack "d",BC.pack "e"],+ testhunk 1 [BC.pack "x"] [BC.pack "a",BC.pack "b"]),+ (testhunk 3 [BC.pack "A"] []:\/:+ testhunk 1 [BC.pack "B"] [],+ testhunk 2 [BC.pack "A"] []),+ (fromPrim (rmdir "./test/world"):\/:+ fromPrim (hunk "./world" 3 [BC.pack "A"] []),+ fromPrim (rmdir "./test/world")),++ ((quickhunk 1 "a" "bc" :>:+ quickhunk 6 "d" "ef" :>: NilFL):\/:+ (quickhunk 3 "a" "bc" :>:+ quickhunk 8 "d" "ef" :>: NilFL),+ (quickhunk 1 "a" "bc" :>:+ quickhunk 7 "d" "ef" :>: NilFL)),++ (testhunk 1 [BC.pack "A"] [BC.pack "B"]:\/:+ testhunk 2 [BC.pack "B"] [BC.pack "C"],+ testhunk 1 [BC.pack "A"] [BC.pack "B"]),++ (testhunk 2 [BC.pack "A"] [BC.pack "B",BC.pack "C"]:\/:+ testhunk 1 [BC.pack "B"] [BC.pack "C",BC.pack "D"],+ testhunk 3 [BC.pack "A"] [BC.pack "B",BC.pack "C"])]+ where testhunk l o n = fromPrim $ hunk "test" l o n+checkKnownMergeEquiv :: ((FL Patch:\/:FL Patch) C(x y),FL Patch C(y z)) -> [String]+checkKnownMergeEquiv (p1:\/: p2, pe) =+ case quickmerge (p1:\/:p2) of+ p1' -> if checkAPatch (invert p1 :>: p2 :>: p1' :>: invert pe :>: NilFL)+ then []+ else ["Oh no, merger isn't equivalent...\n"++show p1++"\n"++show p2+ ++"in other words\n" ++ show (p1 :\/: p2)+ ++"merges as\n" ++ show (merge $ p1 :\/: p2)+ ++"merges to\n" ++ show (quickmerge $ p1 :\/: p2)+ ++"which is equivalent to\n" ++ show (effect p1')+ ++ "should all work out to\n"+ ++ show pe]+knownMergeEquivs :: [((FL Patch :\/: FL Patch) C(x y), FL Patch C(y z))]+knownMergeEquivs = [++ -- The following tests are going to be failed by the+ -- Conflictor code as a cleanup.++ --(addfile "test":\/:+ -- adddir "test",+ -- joinPatches (adddir "test" :>:+ -- addfile "test-conflict" :>: NilFL)),+ --(move "silly" "test":\/:+ -- adddir "test",+ -- joinPatches (adddir "test" :>:+ -- move "silly" "test-conflict" :>: NilFL)),+ --(addfile "test":\/:+ -- move "old" "test",+ -- joinPatches (addfile "test" :>:+ -- move "old" "test-conflict" :>: NilFL)),+ --(move "a" "test":\/:+ -- move "old" "test",+ -- joinPatches (move "a" "test" :>:+ -- move "old" "test-conflict" :>: NilFL)),+ (fromPrim (hunk "test" 1 [] [BC.pack "A"]) :\/:+ fromPrim (hunk "test" 1 [] [BC.pack "B"]),+ fromPrim (hunk "test" 1 [] [BC.pack "A", BC.pack "B"])),+ (fromPrim (hunk "test" 1 [] [BC.pack "a"]):\/:+ fromPrim (hunk "test" 1 [BC.pack "b"] []),+ unsafeCoerceP NilFL),+ --hunk "test" 1 [] [BC.pack "v v v v v v v",+ -- BC.pack "*************",+ -- BC.pack "a",+ -- BC.pack "b",+ -- BC.pack "^ ^ ^ ^ ^ ^ ^"]),+ (quickhunk 4 "a" "" :\/:+ quickhunk 3 "a" "",+ quickhunk 3 "aa" ""),+ ((quickhunk 1 "a" "bc" :>:+ quickhunk 6 "d" "ef" :>: NilFL) :\/:+ (quickhunk 3 "a" "bc" :>:+ quickhunk 8 "d" "ef" :>: NilFL),+ quickhunk 3 "a" "bc" :>:+ quickhunk 8 "d" "ef" :>:+ quickhunk 1 "a" "bc" :>:+ quickhunk 7 "d" "ef" :>: NilFL),+ (quickmerge (quickhunk 2 "" "bd":\/:quickhunk 2 "" "a") :\/:+ quickmerge (quickhunk 2 "" "c":\/:quickhunk 2 "" "a"),+ quickhunk 2 "" "abdc")+ ]+++-- | It also is useful to verify that it doesn't matter which order we specify+-- the patches when we merge.+mergeSwapTests :: [String]+mergeSwapTests =+ concat+ [checkMergeSwap p1 p2 |+ p1<-primitiveTestPatches,+ p2<-primitiveTestPatches,+ checkAPatch (invert p1:>:p2:>:NilFL)+ ]+checkMergeSwap :: FL Patch C(x y) -> FL Patch C(x z) -> [String]+checkMergeSwap p1 p2 =+ case merge (p2:\/:p1) of+ _ :/\: p2' ->+ case merge (p1:\/:p2) of+ _ :/\: p1' ->+ case commute (p1:>p2') of+ Just (_:>p1'b) ->+ if not $ p1'b `eqFLUnsafe` p1'+ then ["Merge swapping problem with...\np1 "+++ show p1++"merged with\np2 "+++ show p2++"p1' is\np1' "+++ show p1'++"p1'b is\np1'b "+++ show p1'b+ ]+ else []+ Nothing -> ["Merge commuting problem with...\np1 "+++ show p1++"merged with\np2 "+++ show p2++"gives\np2' "+++ show p2'++"which doesn't commute with p1.\n"+ ]++-- ----------------------------------------------------------------------+-- Patch test data+-- This is where we define the set of patches which we run our tests on. This+-- should be kept up to date with as many interesting permutations of patch+-- types as possible.+-- ----------------------------------------------------------------------++testPatches :: [FL Patch C(x y)]+testPatchesNamed :: [Named Patch C(x y)]+testPatchesAddfile :: [FL Patch C(x y)]+testPatchesRmfile :: [FL Patch C(x y)]+testPatchesHunk :: [FL Patch C(x y)]+primitiveTestPatches :: [FL Patch C(x y)]+testPatchesBinary :: [FL Patch C(x y)]+testPatchesCompositeNocom :: [FL Patch C(x y)]+testPatchesComposite :: [FL Patch C(x y)]+testPatchesTwoCompositeHunks :: [FL Patch C(x y)]+testPatchesCompositeHunks :: [FL Patch C(x y)]+testPatchesCompositeFourHunks :: [FL Patch C(x y)]+testPatchesMerged :: [FL Patch C(x y)]+validPatches :: [FL Patch C(x y)]++testPatchesNamed = [unsafePerformIO $+ namepatch "date is" "patch name" "David Roundy" []+ (fromPrim $ addfile "test"),+ unsafePerformIO $+ namepatch "Sat Oct 19 08:31:13 EDT 2002"+ "This is another patch" "David Roundy"+ ["This log file has","two lines in it"]+ (fromPrim $ rmfile "test")]+testPatchesAddfile = map fromPrim+ [addfile "test",adddir "test",addfile "test/test"]+testPatchesRmfile = map invert testPatchesAddfile+testPatchesHunk =+ [fromPrim (hunk file line old new) |+ file <- ["test"],+ line <- [1,2],+ old <- map (map BC.pack) partials,+ new <- map (map BC.pack) partials,+ old /= new+ ]+ where partials = [["A"],["B"],[],["B","B2"]]++primitiveTestPatches = testPatchesAddfile +++ testPatchesRmfile +++ testPatchesHunk +++ [unsafeUnseal.fromJust.readPatch $+ BC.pack "move ./test/test ./hello",+ unsafeUnseal.fromJust.readPatch $+ BC.pack "move ./test ./hello"] +++ testPatchesBinary++testPatchesBinary =+ [fromPrim $ binary "./hello"+ (BC.pack $ "agadshhdhdsa75745457574asdgg" +++ "a326424677373735753246463gadshhdhdsaasdgg" +++ "a326424677373735753246463gadshhdhdsaasdgg" +++ "a326424677373735753246463gadshhdhdsaasdgg")+ (BC.pack $ "adafjttkykrehhtrththrthrthre" +++ "a326424677373735753246463gadshhdhdsaasdgg" +++ "a326424677373735753246463gadshhdhdsaasdgg" +++ "a326424677373735753246463gadshhdhdsaagg"),+ fromPrim $ binary "./hello"+ B.empty+ (BC.pack "adafjttkykrere")]++testPatchesCompositeNocom =+ take 50 [p1+>+p2|+ p1<-primitiveTestPatches,+ p2<-filter (\p->checkAPatch (p1:>:p:>:NilFL)) primitiveTestPatches,+ commute (p1:>p2) == Nothing]++testPatchesComposite =+ take 100 [p1+>+p2|+ p1<-primitiveTestPatches,+ p2<-filter (\p->checkAPatch (p1:>:p:>:NilFL)) primitiveTestPatches,+ commute (p1:>p2) /= Nothing,+ commute (p1:>p2) /= Just (unsafeCoerceP p2:>unsafeCoerceP p1)]++testPatchesTwoCompositeHunks =+ take 100 [p1+>+p2|+ p1<-testPatchesHunk,+ p2<-filter (\p->checkAPatch (p1:>:p:>:NilFL)) testPatchesHunk]++testPatchesCompositeHunks =+ take 100 [p1+>+p2+>+p3|+ p1<-testPatchesHunk,+ p2<-filter (\p->checkAPatch (p1:>:p:>:NilFL)) testPatchesHunk,+ p3<-filter (\p->checkAPatch (p1:>:p2:>:p:>:NilFL)) testPatchesHunk]++testPatchesCompositeFourHunks =+ take 100 [p1+>+p2+>+p3+>+p4|+ p1<-testPatchesHunk,+ p2<-filter (\p->checkAPatch (p1:>:p:>:NilFL)) testPatchesHunk,+ p3<-filter (\p->checkAPatch (p1:>:p2:>:p:>:NilFL)) testPatchesHunk,+ p4<-filter (\p->checkAPatch (p1:>:p2:>:p3:>:p:>:NilFL)) testPatchesHunk]++testPatchesMerged =+ take 200+ [p2+>+quickmerge (p1:\/:p2) |+ p1<-take 10 (drop 15 testPatchesCompositeHunks)++primitiveTestPatches+ ++take 10 (drop 15 testPatchesTwoCompositeHunks)+ ++ take 2 (drop 4 testPatchesCompositeFourHunks),+ p2<-take 10 testPatchesCompositeHunks++primitiveTestPatches+ ++take 10 testPatchesTwoCompositeHunks+ ++take 2 testPatchesCompositeFourHunks,+ checkAPatch (invert p1 :>: p2 :>: NilFL),+ commute (p2:>p1) /= Just (p1:>p2)+ ]++testPatches = primitiveTestPatches +++ testPatchesComposite +++ testPatchesCompositeNocom +++ testPatchesMerged++-- ----------------------------------------------------------------------+-- * Check patch test+-- ----------------------------------------------------------------------++validPatches = [(quickhunk 4 "a" "b" :>:+ quickhunk 1 "c" "d" :>: NilFL),+ (quickhunk 1 "a" "bc" :>:+ quickhunk 1 "b" "d" :>: NilFL),+ (quickhunk 1 "a" "b" :>:+ quickhunk 1 "b" "d" :>: NilFL)]++testPatches++testCheck :: [String]+testCheck = concatMap tTestCheck validPatches+tTestCheck :: PatchUnitTest (FL Patch)+tTestCheck p = if checkAPatch p+ then []+ else ["Failed the check: "++show p++"\n"]+
+ src/Darcs/Test/Patch/Examples2.hs view
@@ -0,0 +1,274 @@+{-# LANGUAGE CPP #-}++#include "gadts.h"++module Darcs.Test.Patch.Examples2+ ( mergeExamples, commuteExamples, tripleExamples+ , realPatchLoopExamples+ )+ where++import Darcs.Patch.Invert ( Invert )+import Darcs.Patch.Merge ( Merge )+import Darcs.Patch.Prim ( PrimPatchBase(..), FromPrim )+import Darcs.Patch.Prim.V1.Core ( Prim(FP), FilePatchType(Hunk) )+import Darcs.Patch.FileName ( FileName, fp2fn )++import Darcs.Witnesses.Ordered ( (:>), (:\/:) )+import Darcs.Witnesses.Sealed ( Sealed(..), Sealed2, seal2, unseal2 )++import qualified Data.ByteString as B ( ByteString )+import qualified Data.ByteString.Char8 as BC ( pack )++import Darcs.Test.Patch.RepoModel ( RepoModel, Content+ , makeRepo, makeName, makeFile)+import Darcs.Test.Patch.WithState ( WithStartState(..) )++import Darcs.Test.Patch.QuickCheck+ ( Tree(..)+ , TreeWithFlattenPos(..)+ , commutePairFromTree, commuteTripleFromTree+ , mergePairFromCommutePair, commutePairFromTWFP+ , canonizeTree+ )++++makeSimpleRepo :: String -> Content -> RepoModel C(x)+makeSimpleRepo filename content = makeRepo [(makeName filename, makeFile content)]+++tripleExamples :: (FromPrim p, Merge p, Invert p, PrimPatchBase p, PrimOf p ~ Prim) => [Sealed2 (p :> p :> p)]+tripleExamples = [commuteTripleFromTree seal2 $+ WithStartState (makeSimpleRepo "file" [])+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "g"]))+ (SeqTree (FP (fp2fn "./file") (Hunk 2 [] [BC.pack "j"]))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "s"])) NilTree)))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "e"])) NilTree))+ ,commuteTripleFromTree seal2 $+ WithStartState (makeSimpleRepo "file" [BC.pack "j"])+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "s"]))+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 2 [BC.pack "j"] [])) NilTree)+ (SeqTree (FP (fp2fn "./file") (Hunk 2 [BC.pack "j"] [])) NilTree)))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "j"] [])) NilTree))+ ]+++mergeExamples :: (FromPrim p, Merge p, Invert p, PrimPatchBase p, PrimOf p ~ Prim) => [Sealed2 (p :\/: p)]+mergeExamples = map (unseal2 (mergePairFromCommutePair seal2)) commuteExamples++commuteExamples :: (FromPrim p, Merge p, PrimPatchBase p, PrimOf p ~ Prim) => [Sealed2 (p :> p)]+commuteExamples = [+ commutePairFromTWFP seal2 $+ WithStartState (makeSimpleRepo "file" [])+ (TWFP 3+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "h"])) NilTree)+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "b"]))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "f"]))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "v"]))+ (SeqTree (FP (fp2fn "./file") (Hunk 2 [BC.pack "f"] [])) NilTree)))))),+ commutePairFromTWFP seal2 $+ WithStartState+ (makeSimpleRepo "file" [BC.pack "f",BC.pack "s",BC.pack "d"])+ (TWFP 3+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 3 [BC.pack "d"] [])) NilTree)+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "f"] [])) NilTree)+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "f"] []))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "s",BC.pack "d"] []))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "v"])) NilTree)))))),+{- commutePairFromTWFP seal2 $+ WithStartState+ (makeSimpleRepo "file" [BC.pack "f",BC.pack "u",+ BC.pack "s",BC.pack "d"])+ (TWFP 5+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 5 [] [BC.pack "x"]))+ (SeqTree (FP (fp2fn "./file") (Hunk 4 [BC.pack "d"] [])) NilTree))+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "f",BC.pack "u"] [])) NilTree)+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "f"] []))+ (SeqTree (FP(fp2fn "./file") (Hunk 1 [BC.pack "u",BC.pack "s",BC.pack "d"] []))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "a"]))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "a"] [])) NilTree))))))),-}+ commutePairFromTree seal2 $+ WithStartState (makeSimpleRepo "file" [BC.pack "n",BC.pack "t",BC.pack "h"])+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "n",BC.pack "t",BC.pack "h"] []))+ NilTree)+ (SeqTree (FP (fp2fn "./file") (Hunk 3 [BC.pack "h"] []))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "n"] []))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "t"] [])) NilTree)))),+ commutePairFromTree seal2 $+ WithStartState (makeSimpleRepo "file" [])+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "n"])) NilTree)+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "i"]))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "i"])) NilTree))),+ commutePairFromTree seal2 $+ WithStartState (makeSimpleRepo "file" [])+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "c"]))+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "c"] [BC.pack "r"])) NilTree)+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "h"]))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "d"])) NilTree))))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "f"])) NilTree)),+ commutePairFromTWFP seal2 $+ WithStartState (makeSimpleRepo "file" [])+ (TWFP 1+ (ParTree+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "t"])) NilTree)+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "t"])) NilTree))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "f"])) NilTree))),+ commutePairFromTWFP seal2 $+ WithStartState (makeSimpleRepo "file" [BC.pack "f",BC.pack " r",+ BC.pack "c",BC.pack "v"])+ (TWFP 4+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 3 [BC.pack "c",BC.pack "v"] []))+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 2 [BC.pack "r"] []))+ (SeqTree (FP (fp2fn "fi le") (Hunk 1 [BC.pack "f"] [])) NilTree))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "f",BC.pack "r"] []))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "y"])) NilTree))))+ (SeqTree (FP (fp2fn "./file") (Hunk 4 [BC.pack "v"] [])) NilTree))),+ commutePairFromTree seal2 $+ WithStartState (makeSimpleRepo "file" [])+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "z"])) NilTree)+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "f"])) NilTree)+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "r"])) NilTree)+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "d"])) NilTree))))+ , commutePairFromTree seal2 $+ WithStartState (makeSimpleRepo "file" [BC.pack "t",BC.pack "r",BC.pack "h"])+ (ParTree+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "t",BC.pack "r",BC.pack "h"] []))+ NilTree)+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "o"])) NilTree))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "t"] []))+ (SeqTree (FP (fp2fn "./file") (Hunk 2 [BC.pack "h"] [])) NilTree)))+ , commutePairFromTWFP seal2 $+ WithStartState (makeSimpleRepo "file" []) $+ TWFP 2+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "h"])) NilTree)+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "y"]))+ (SeqTree (FP (fp2fn "./file") (Hunk 2 [] [BC.pack "m"]))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "v"])) NilTree))))+ , commutePairFromTree seal2 $+ WithStartState (makeSimpleRepo "file" [])+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "p"]))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "p"] []))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "c"])) NilTree)))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "z"])) NilTree))+ , commutePairFromTree seal2 $+ WithStartState (makeSimpleRepo "file" [])+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "j" ]))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "j"] [])) NilTree))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "v"])) NilTree))+ , commutePairFromTree seal2 $+ WithStartState (makeSimpleRepo "file" [])+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "v"])) NilTree)+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "j" ]))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "j"] [])) NilTree)))+ , commutePairFromTree seal2 $+ WithStartState (makeSimpleRepo "file" [BC.pack "x",BC.pack "c"])+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "h"]))+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 3 [BC.pack "c"] [])) NilTree)+ (SeqTree (FP (fp2fn "./file") (Hunk 2 [BC.pack "x"] []))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "j"])) NilTree))))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "l"])) NilTree))+ , commutePairFromTree seal2 $+ WithStartState (makeSimpleRepo "file" [])+ (ParTree+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] (packStringLetters "s"))) NilTree)+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] (packStringLetters "k")))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 (packStringLetters "k") []))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 [] (packStringLetters "m")))+ (SeqTree (FP (fp2fn "./file") (Hunk 1 (packStringLetters "m") [])) NilTree)))))+ ]++packStringLetters :: String -> [B.ByteString]+packStringLetters = map (BC.pack . (:[]))++realPatchLoopExamples :: [Sealed (WithStartState RepoModel (Tree Prim))]+realPatchLoopExamples =+ [Sealed (WithStartState (makeSimpleRepo fx_name [])+ $ canonizeTree+ (ParTree+ (SeqTree (FP fx (Hunk 1 [] (packStringLetters "pkotufogbvdabnmbzajvolwviqebieonxvcvuvigkfgybmqhzuaaurjspd")))+ (ParTree+ (SeqTree (FP fx (Hunk 47 (packStringLetters "qhzu") (packStringLetters "zafybdcokyjskcgnvhkbzpysaafnjjhcstgrczplxsfwagmh")))+ (ParTree+ (ParTree+ NilTree+ (ParTree+ (ParTree+ (ParTree+ (SeqTree (FP fx (Hunk 15 (packStringLetters "mbzajvolwviqebieonxvcvuvigkfgyb") (packStringLetters "vujnxnhvybvpouyciaabszfmgssezlwwjgnethvrpnfrkubphzvdgymjjoacppqps")))+ (ParTree+ NilTree+ (ParTree+ (SeqTree (FP fx (Hunk 40 (packStringLetters "ssezlwwjgnethvrpnfrkubphzvdgymjjoacppqpsmzafybdcokyjskcgnvhkbz") (packStringLetters "wnesidpccwoiqiichxaaejdsyrhrusqljlcoro")))+ (ParTree+ (ParTree+ (SeqTree (FP fx (Hunk 12 (packStringLetters "abnvujnxnhvybvpouyciaabszfmgwnesidpccwoiqii") (packStringLetters "czfdhqkipdstfjycqaxwnbxrihrufdeyneqiiiafwzlmg"))) NilTree)+ NilTree)+ NilTree))+ (SeqTree (FP fx (Hunk 25 [] (packStringLetters "dihgmsotezucqdgxczvcivijootyvhlwymbiueufnvpwpeukmskqllalfe"))) NilTree))))+ (SeqTree (FP fx (Hunk 56 (packStringLetters "yjskcgnvhkbzpysaafnjjhcstgrczplxsfwagmhaaurjsp") (packStringLetters "xldhrutyhcyaqeezwujiguawfyawjjqlirxshjddvq"))) NilTree))+ (SeqTree (FP fx (Hunk 20 [] (packStringLetters "ooygwiyogqrqnytixqtmvdxx")))+ (SeqTree (FP fx (Hunk 26 (packStringLetters "yogqrqnytixqtmvdxxvolwviqebieonxvcvuvigkfgybmzafybdcokyjskcgnvhkbz") (packStringLetters "akhsmlbkdxnvfoikmiatfbpzdrsyykkpoxvvddeaspzxe")))+ (SeqTree (FP fx (Hunk 39 [] (packStringLetters "ji")))+ (ParTree+ NilTree+ (ParTree+ NilTree+ (ParTree+ (ParTree+ NilTree+ (SeqTree (FP fx (Hunk 26 (packStringLetters "akhsmlbkdxnvfjioikmiatfbpzdrsyykkpoxvvddeaspzxepysaafnjjhcstgrczplxs") (packStringLetters "onjbhddskcj")))+ (SeqTree (FP fx (Hunk 39 [] (packStringLetters "fyscunxxxjjtyqpfxeznhtwvlphmp"))) NilTree)))+ (ParTree+ NilTree+ (SeqTree (FP fx (Hunk 44 [] (packStringLetters "xcchzwmzoezxkmkhcmesplnjpqriypshgiqklgdnbmmkldnydiy")))+ (ParTree+ NilTree+ (SeqTree (FP fx (Hunk 64 (packStringLetters "plnjpqriypshgiqklgdnbmmkldnydiymiatfbpzdrsyykkpoxvvddeaspzxepysaafn") (packStringLetters "anjlzfdqbjqbcplvqvkhwjtkigp"))) NilTree)))))))))))+ (ParTree+ NilTree+ NilTree)))+ NilTree))+ NilTree))+ (ParTree+ NilTree+ (SeqTree (FP fx (Hunk 1 [] (packStringLetters "ti")))+ (SeqTree (FP fx (Hunk 1 (packStringLetters "t") (packStringLetters "ybcop")))+ (SeqTree (FP fx (Hunk 2 [] (packStringLetters "dvlhgwqlpaeweerqrhnjtfolczbqbzoccnvdsyqiefqitrqneralf")))+ (SeqTree (FP fx (Hunk 15 [] (packStringLetters "yairbjphwtnaerccdlfewujvjvmjakbc")))+ (SeqTree (FP fx (Hunk 51 [] (packStringLetters "xayvfuwaiiogginufnhsrmktpmlbvxiakjwllddkiyofyfw")))+ (ParTree+ NilTree+ NilTree)))))))))]+ where+ fx_name :: String+ fx_name = "F"++ fx :: FileName+ fx = fp2fn "./F"+
src/Darcs/Test/Patch/Info.hs view
@@ -17,9 +17,7 @@ -- | This module contains tests for the code in Darcs.Patch.Info. Most of them -- are about the UTF-8-encoding of patch metadata.-module Darcs.Test.Patch.Info ( metadataDecodingTest, metadataEncodingTest,- packUnpackTest- ) where+module Darcs.Test.Patch.Info ( testSuite ) where import Prelude hiding ( pi ) import Data.ByteString ( ByteString )@@ -27,20 +25,27 @@ import qualified Data.ByteString.Char8 as BC ( unpack ) import Data.List ( sort ) import Data.Maybe ( isNothing )-import Data.Text as T ( findBy, any )+import Data.Text as T ( find, any ) import Data.Text.Encoding ( decodeUtf8With ) import Data.Text.Encoding.Error ( lenientDecode ) import Foreign ( unsafePerformIO ) import Test.QuickCheck ( Arbitrary(arbitrary), oneof, listOf, choose, shrink , Gen ) import Test.Framework.Providers.QuickCheck2 ( testProperty )-import Test.Framework (Test)+import Test.Framework (Test, testGroup) import Data.List ( isPrefixOf ) import Darcs.Patch.Info ( PatchInfo(..), patchinfo, piLog, piAuthor, piName ) import ByteStringUtils ( decodeLocale, packStringToUTF8, unpackPSFromUTF8 ) +testSuite :: Test+testSuite = testGroup "Darcs.Patch.Info"+ [ metadataDecodingTest+ , metadataEncodingTest+ , packUnpackTest+ ]+ -- | A newtype wrapping String so we can make our own random generator for it. newtype UnicodeString = UnicodeString { asString :: String } deriving (Show, Eq, Ord)@@ -121,7 +126,7 @@ \patchInfo -> encodingOK (_piAuthor patchInfo) && encodingOK (_piName patchInfo) && all encodingOK (_piLog patchInfo)- where encodingOK = isNothing . T.findBy (=='\xfffd') . decodeUtf8With lenientDecode+ where encodingOK = isNothing . T.find (=='\xfffd') . decodeUtf8With lenientDecode -- | Test that metadata in patches are decoded as UTF-8 or locale depending on -- whether they're valid UTF-8.@@ -146,7 +151,7 @@ superset a b = sorted_superset (sort a) (sort b) where sorted_superset (x:xs) (y:ys) | x == y = sorted_superset xs ys | x < y = sorted_superset xs (y:ys)- | y < x = False+ | otherwise = False sorted_superset [] (_:_) = False sorted_superset _ [] = True
+ src/Darcs/Test/Patch/Prim/V1.hs view
@@ -0,0 +1,305 @@+{-# LANGUAGE CPP, MultiParamTypeClasses #-}++#include "gadts.h"++-- | Testing of primitive V1 patches+module Darcs.Test.Patch.Prim.V1+ ( aHunk, aTokReplace+ , aPrim+ , aPrimPair+ )+ where+++import Darcs.Test.Patch.RepoModel+import Darcs.Test.Patch.WithState+import Darcs.Test.Util.QuickCheck ( alpha, notIn, maybeOf )++import Darcs.Commands.Replace ( defaultToks )+import Darcs.Patch.Prim+import Darcs.Patch.Prim.V1.Core ( Prim(..), FilePatchType(..), DirPatchType(..) )+import Darcs.Witnesses.Ordered ( (:>)(..), FL(..) )+import Darcs.Witnesses.Sealed+import Darcs.Witnesses.Unsafe ( unsafeCoerceP1 )++import Control.Applicative ( (<$>) )+import qualified Data.ByteString.Char8 as BC+import Data.Maybe ( isJust, fromJust )+import Test.QuickCheck+ ( Arbitrary(..)+ , Gen, sized, frequency, choose, elements, vectorOf+ )++++----------------------------------------------------------------------+-- * QuickCheck generators++----------------------------------------------------------------------+-- ** FilePatchType generators++aHunk :: FORALL(x y) Content -> Gen (FilePatchType C(x y))+aHunk content+ = sized $ \n ->+ do pos <- choose (1, contentLen+1)+ let prefixLen = pos-1+ restLen = contentLen-prefixLen+ oldLen <- frequency+ [ (75, choose (0, min restLen n))+ -- produces small hunks common in real editing+ , (25, choose (0, min 10 restLen))+ ]+ -- newLen choice aims to cover all possibilities, that is,+ -- remove less/the same/more than added and empty the file.+ newLen <- frequency+ [ ( 54+ , choose (1,min 1 n)+ )+ , ( if oldLen /= 0 then 42 else 0+ , choose (1,min 1 oldLen)+ )+ , ( if oldLen /= 0 then 2 else 0+ , return oldLen+ )+ , ( if oldLen /= 0 then 2 else 0+ , return 0+ )+ ]+ new <- vectorOf newLen aLine+ let old = take oldLen $ drop prefixLen $ content+ return $ Hunk pos old new+ where+ contentLen = length content++aTokReplace :: FORALL(x y) Content -> Gen (FilePatchType C(x y))+aTokReplace []+ = do w <- vectorOf 1 alpha+ w' <- vectorOf 1 alpha+ return $ TokReplace defaultToks w w'+aTokReplace content+ = do let fileWords = concatMap BC.words content+ wB <- elements fileWords+ w' <- alphaBS `notIn` fileWords+ return $ TokReplace defaultToks (BC.unpack wB) (BC.unpack w')+ where+ alphaBS = do x <- alpha; return $ BC.pack [x]++----------------------------------------------------------------------+-- ** Prim generators++aHunkP :: FORALL(x y) (AnchoredPath,File) -> Gen (Prim C(x y))+aHunkP (path,file)+ = do Hunk pos old new <- aHunk content+ return $ hunk (ap2fp path) pos old new+ where+ content = fileContent file++aTokReplaceP :: FORALL (x y) (AnchoredPath,File) -> Gen (Prim C(x y))+aTokReplaceP (path,file)+ = do TokReplace tokchars old new <- aTokReplace content+ return $ tokreplace (ap2fp path) tokchars old new+ where+ content = fileContent file++anAddFileP :: FORALL (x y) (AnchoredPath,Dir) -> Gen (Prim C(x y))+anAddFileP (path,dir)+ = do newFilename <- aFilename `notIn` existing+ let newPath = path `appendPath` newFilename+ return $ addfile (ap2fp newPath)+ where+ existing = map fst $ filterFiles $ dirContent dir++aRmFileP :: FORALL (x y) AnchoredPath -- ^ Path of an empty file+ -> Prim C(x y)+aRmFileP path = rmfile (ap2fp path)++anAddDirP :: FORALL (x y) (AnchoredPath,Dir) -> Gen (Prim C(x y))+anAddDirP (path,dir)+ = do newDirname <- aDirname `notIn` existing+ let newPath = path `appendPath` newDirname+ return $ adddir (ap2fp newPath)+ where+ existing = map fst $ filterDirs $ dirContent dir++aRmDirP :: FORALL (x y) AnchoredPath -- ^ Path of an empty directory+ -> Prim C(x y)+aRmDirP path = rmdir (ap2fp path)++aMoveP :: FORALL (x y) Gen Name -> AnchoredPath -> (AnchoredPath,Dir) -> Gen (Prim C(x y))+aMoveP nameGen oldPath (dirPath,dir)+ = do newName <- nameGen `notIn` existing+ let newPath = dirPath `appendPath` newName+ return $ move (ap2fp oldPath) (ap2fp newPath)+ where+ existing = map fst $ dirContent dir++-- | Generates any type of 'Prim' patch, except binary and setpref patches.+aPrim :: FORALL(x y) RepoModel C(x) -> Gen (WithEndState RepoModel (Prim C(x)) C(y))+aPrim repo+ = do mbFile <- maybeOf repoFiles+ mbEmptyFile <- maybeOf $ filter (isEmpty . snd) repoFiles+ dir <- elements (rootDir:repoDirs)+ mbOldDir <- maybeOf repoDirs+ mbEmptyDir <- maybeOf $ filter (isEmpty . snd) repoDirs+ patch <- frequency+ [ ( if isJust mbFile then 12 else 0+ , aHunkP $ fromJust mbFile+ )+ , ( if isJust mbFile then 6 else 0+ , aTokReplaceP $ fromJust mbFile+ )+ , ( 2+ , anAddFileP dir+ )+ , ( if isJust mbEmptyFile then 12 else 0+ , return $ aRmFileP $ fst $ fromJust mbEmptyFile+ )+ , ( 2+ , anAddDirP dir+ )+ , ( if isJust mbEmptyDir then 10 else 0+ , return $ aRmDirP $ fst $ fromJust mbEmptyDir+ )+ , ( if isJust mbFile then 3 else 0+ , aMoveP aFilename (fst $ fromJust mbFile) dir+ )+ , let oldPath = fst $ fromJust mbOldDir in+ ( if isJust mbOldDir+ && not (oldPath `isPrefix` fst dir)+ then 4 else 0+ , aMoveP aDirname oldPath dir+ )+ ]+ let Just repo' = applyPatch patch repo+ return $ WithEndState patch repo'+ where+ repoItems = list repo+ repoFiles = filterFiles repoItems+ repoDirs = filterDirs repoItems+ rootDir = (anchoredRoot,root repo)++{- [COVERAGE OF aPrim]++ PLEASE,+ if you change something that may affect the coverage of aPrim then+ a) recalculate it, or if that is not possible;+ b) indicate the need to do it.++ Patch type+ ----------+ 42% hunk+ 22% tokreplace+ 14% move+ 6% rmdir+ 6% addfile+ 6% adddir+ 4% rmfile+-}++----------------------------------------------------------------------+-- *** Pairs of primitive patches++-- Try to generate commutable pairs of hunks+hunkPairP :: FORALL(x y) (AnchoredPath,File) -> Gen ((Prim :> Prim) C(x y))+hunkPairP (path,file)+ = do h1@(Hunk l1 old1 new1) <- aHunk content+ (delta, content') <- selectChunk h1 content+ Hunk l2' old2 new2 <- aHunk content'+ let l2 = l2'+delta+ return (hunk fpPath l1 old1 new1 :> hunk fpPath l2 old2 new2)+ where+ content = fileContent file+ fpPath = ap2fp path+ selectChunk (Hunk l old new) content+ = elements [prefix, suffix]+ where+ start = l - 1+ prefix = (0, take start content)+ suffix = (start + length new, drop (start + length old) content)++aPrimPair :: FORALL(x y) RepoModel C(x) -> Gen (WithEndState RepoModel ((Prim :> Prim) C(x)) C(y))+aPrimPair repo+ = do mbFile <- maybeOf repoFiles+ frequency+ [ ( if isJust mbFile then 1 else 0+ , do p1 :> p2 <- hunkPairP $ fromJust mbFile+ let Just repo' = applyPatch p1 repo+ Just repo'' = applyPatch p2 repo'+ return $ WithEndState (p1 :> p2) repo''+ )+ , ( 1+ , do Sealed wesP <- arbitraryState repo+ return $ unsafeCoerceP1 wesP+ )+ ]+ where+ repoItems = list repo+ repoFiles = filterFiles repoItems++{- [COVERAGE OF aPrimPair]++ PLEASE,+ if you change something that may affect the coverage of aPrimPair then+ a) recalculate it, or if that is not possible;+ b) indicate the need to do it.++ Rate of ommutable pairs+ -----------------------+ 67% commutable++ Commutable coverage (for 1000 tests)+ -------------------+ 21% hunks-B+ 20% hunks-A+ 14% file:>dir+ 12% file:>move+ 8% trivial-FP+ 8% hunk:>tok+ 4% hunks-D+ 3% tok:>tok+ 2% hunks-C+ 1% move:>move+ 1% dir:>move+ 1% dir:>dir+ 0% emptyhunk:>file+-}++----------------------------------------------------------------------+-- Arbitrary instances++instance ArbitraryState RepoModel Prim where+ arbitraryState s = seal <$> aPrim s+++instance Arbitrary (Sealed2 Prim) where+ arbitrary = makeGen aSmallRepo++instance Arbitrary (Sealed2 (Prim :> Prim)) where+ arbitrary = do repo <- aSmallRepo+ WithEndState pp _ <- aPrimPair repo+ return $ seal2 pp++instance Arbitrary (Sealed2 (Prim :> Prim :> Prim)) where+ arbitrary = makeGen aSmallRepo++instance Arbitrary (Sealed2 (FL Prim)) where+ arbitrary = makeGen aSmallRepo++instance Arbitrary (Sealed2 (FL Prim :> FL Prim)) where+ arbitrary = makeGen aSmallRepo+++instance Arbitrary (Sealed2 (WithState RepoModel Prim)) where+ arbitrary = makeWSGen aSmallRepo++instance Arbitrary (Sealed2 (WithState RepoModel (Prim :> Prim))) where+ arbitrary = do repo <- aSmallRepo+ WithEndState pp repo' <- aPrimPair repo+ return $ seal2 $ WithState repo pp repo'+++instance Arbitrary (Sealed2 (WithState RepoModel (FL Prim))) where+ arbitrary = makeWSGen aSmallRepo++instance Arbitrary (Sealed2 (WithState RepoModel (FL Prim :> FL Prim))) where+ arbitrary = makeWSGen aSmallRepo
+ src/Darcs/Test/Patch/Properties.hs view
@@ -0,0 +1,340 @@+-- Copyright (C) 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.++{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-deprecations -fno-warn-orphans #-}++#include "gadts.h"++module Darcs.Test.Patch.Properties+ ( invertSymmetry, invertRollback,+ recommute, commuteInverses, effectPreserving,+ permutivity, partialPermutivity,+ patchAndInverseCommute, mergeEitherWay,+ show_read,+ mergeCommute, mergeConsistent, mergeArgumentsConsistent,+ joinEffectPreserving, joinCommute+ ) where++import Darcs.Test.Util.TestResult ( TestResult, succeeded, failed, rejected,+ (<&&>), fromMaybe )+import Darcs.Test.Patch.RepoModel ( RepoModel, applyPatch )+import Darcs.Test.Patch.WithState ( WithState(..) )++import Control.Monad ( msum )+import Darcs.Witnesses.Show ( Show2(..), show2 )+import Darcs.Patch.Patchy ( Patchy, showPatch, commute, invert )+import Darcs.Patch.Prim.V1 ( Prim )+import Darcs.Patch ()+import Darcs.Patch.Commute ( commuteFLorComplain )+import Darcs.Patch.Merge ( Merge(merge) )+import Darcs.Patch.Read ( readPatch )+import Darcs.Witnesses.Eq ( MyEq(..), EqCheck(..) )+import Darcs.Witnesses.Ordered ( FL(..), (:>)(..), (:\/:)(..), (:/\:)(..) )+import Darcs.Witnesses.Sealed ( Sealed(Sealed) )+import Printer ( Doc, renderPS, redText, greenText, ($$) )+--import Darcs.ColorPrinter ( traceDoc )++++-- | invert symmetry inv(inv(p)) = p+invertSymmetry :: Patchy p => p C(a b) -> TestResult+invertSymmetry p = case invert (invert p) =\/= p of+ IsEq -> succeeded+ NotEq -> failed $ redText "p /= inv(inv(p))"++-- | invert rollback if b = A(a) then a = A'(b)+invertRollback :: Patchy p => WithState RepoModel p C(a b) -> TestResult+invertRollback (WithState a x b)+ = case applyPatch (invert x) b of+ Nothing -> failed $ redText "x' not applicable to b."+ Just a1 -> if a1 == a+ then succeeded+ else failed $ redText "a1 is not equals to a."++-- | recommute AB <--> B'A' iff B'A' <--> AB+recommute :: Patchy p => (FORALL(x y) ((p :> p) C(x y) -> Maybe ((p :> p) C(x y))))+ -> (p :> p) C(a b) -> TestResult+recommute c (x :> y) =+ case c (x :> y) of+ Nothing -> rejected+ Just (y' :> x') ->+ case c (y' :> x') of+ Nothing -> failed (redText "failed" $$ showPatch y' $$ redText ":>" $$ showPatch x')+ Just (x'' :> y'') ->+ case y'' =/\= y of+ NotEq -> failed (redText "y'' =/\\= y failed, where x" $$ showPatch x $$+ redText ":> y" $$ showPatch y $$+ redText "y'" $$ showPatch y' $$+ redText ":> x'" $$ showPatch x' $$+ redText "x''" $$ showPatch x'' $$+ redText ":> y''" $$ showPatch y'')+ IsEq -> case x'' =/\= x of+ NotEq -> failed (redText "x'' /= x" $$ showPatch x'' $$ redText ":>" $$ showPatch y'')+ IsEq -> succeeded++-- | commuteInverses AB <--> B'A' iff inv(B)inv(A) <--> inv(A')inv(B')+commuteInverses :: Patchy p => (FORALL(x y) (p :> p) C(x y) -> Maybe ((p :> p) C(x y)))+ -> (p :> p) C(a b) -> TestResult+commuteInverses c (x :> y) =+ case c (x :> y) of+ Nothing -> rejected+ Just (y' :> x') ->+ case c (invert y :> invert x) of+ Nothing -> failed $ redText "second commute failed" $$+ redText "x" $$ showPatch x $$ redText "y" $$ showPatch y $$+ redText "y'" $$ showPatch y' $$ redText "x'" $$ showPatch x'+ Just (ix' :> iy') ->+ case invert ix' =/\= x' of+ NotEq -> failed $ redText "invert ix' /= x'" $$+ redText "x" $$ showPatch x $$+ redText "y" $$ showPatch y $$+ redText "y'" $$ showPatch y' $$+ redText "x'" $$ showPatch x' $$+ redText "ix'" $$ showPatch ix' $$+ redText "iy'" $$ showPatch iy' $$+ redText "invert ix'" $$ showPatch (invert ix') $$+ redText "invert iy'" $$ showPatch (invert iy')+ IsEq -> case y' =\/= invert iy' of+ NotEq -> failed $ redText "y' /= invert iy'" $$ showPatch iy' $$ showPatch y'+ IsEq -> succeeded++-- | effect preserving AB <--> B'A' then effect(AB) = effect(B'A')+effectPreserving :: Patchy p =>+ (FORALL(x y) (p :> p) C(x y) -> Maybe ((p :> p) C(x y)))+ -> WithState RepoModel (p :> p) C(a b) -> TestResult+effectPreserving c (WithState r (x :> y) r')+ = case c (x :> y) of+ Nothing -> rejected+ Just (y' :> x') ->+ case applyPatch y' r of+ Nothing -> failed $ redText "y' is not applicable to r."+ Just r_y' ->+ case applyPatch x' r_y' of+ Nothing -> failed $ redText "x' is not applicable to r_y'."+ Just r_y'x' -> if r_y'x' == r'+ then succeeded+ else failed $ redText "r_y'x' is not equal to r'."++-- | patchAndInverseCommute if AB <--> B'A' then inv(A)B' <---> Binv(A')+patchAndInverseCommute :: Patchy p =>+ (FORALL(x y) (p :> p) C(x y) -> Maybe ((p :> p) C(x y)))+ -> (p :> p) C(a b) -> TestResult+patchAndInverseCommute c (x :> y) =+ case c (x :> y) of+ Nothing -> rejected+ Just (y' :> x') ->+ case c (invert x :> y') of+ Nothing -> failed (redText "failure in patchAndInverseCommute")+ Just (y'' :> ix') ->+ case y'' =\/= y of+ NotEq -> failed (redText "y'' /= y" $$+ redText "x" $$ showPatch x $$+ redText "y" $$ showPatch y $$+ redText "x'" $$ showPatch x' $$+ redText "y'" $$ showPatch y' $$+ redText "y''" $$ showPatch y'' $$+ redText ":> x'" $$ showPatch x')+ IsEq -> case x' =\/= invert ix' of+ NotEq -> failed (redText "x' /= invert ix'" $$+ redText "y''" $$ showPatch y'' $$+ redText ":> x'" $$ showPatch x' $$+ redText "invert x" $$ showPatch (invert x) $$+ redText ":> y" $$ showPatch y $$+ redText "y'" $$ showPatch y' $$+ redText "ix'" $$ showPatch ix')+ IsEq -> succeeded++permutivity :: Patchy p => (FORALL(x y) (p :> p) C(x y) -> Maybe ((p :> p) C(x y)))+ -> (p :> p :> p) C(a b) -> TestResult+permutivity c (x:>y:>z) =+ case c (x :> y) of+ Nothing -> rejected+ Just (y1 :> x1) ->+ case c (y :> z) of+ Nothing -> rejected+ Just (z2 :> y2) ->+ case c (x :> z2) of+ Nothing -> rejected+ Just (z3 :> x3) ->+ case c (x1 :> z) of+ Nothing -> failed $ redText "permutivity1"+ Just (z4 :> x4) ->+ --traceDoc (greenText "third commuted" $$+ -- greenText "about to commute" $$+ -- greenText "y1" $$ showPatch y1 $$+ -- greenText "z4" $$ showPatch z4) $+ case c (y1 :> z4) of+ Nothing -> failed $ redText "permutivity2"+ Just (z3_ :> y4)+ | IsEq <- z3_ =\/= z3 ->+ --traceDoc (greenText "passed z3") $ error "foobar test" $+ case c (y4 :> x4) of+ Nothing -> failed $ redText "permutivity5: input was" $$+ redText "x" $$ showPatch x $$+ redText "y" $$ showPatch y $$+ redText "z" $$ showPatch z $$+ redText "z3" $$ showPatch z3 $$+ redText "failed commute of" $$+ redText "y4" $$ showPatch y4 $$+ redText "x4" $$ showPatch x4 $$+ redText "whereas commute of x and y give" $$+ redText "y1" $$ showPatch y1 $$+ redText "x1" $$ showPatch x1+ Just (x3_ :> y2_)+ | NotEq <- x3_ =\/= x3 -> failed $ redText "permutivity6"+ | NotEq <- y2_ =/\= y2 -> failed $ redText "permutivity7"+ | otherwise -> succeeded+ | otherwise ->+ failed $ redText "permutivity failed" $$+ redText "z3" $$ showPatch z3 $$+ redText "z3_" $$ showPatch z3_++partialPermutivity :: Patchy p => (FORALL(x y) (p :> p) C(x y) -> Maybe ((p :> p) C(x y)))+ -> (p :> p :> p) C(a b) -> TestResult+partialPermutivity c (xx:>yy:>zz) = pp (xx:>yy:>zz) <&&> pp (invert zz:>invert yy:>invert xx)+ where pp (x:>y:>z) =+ case c (y :> z) of+ Nothing -> rejected+ Just (z1 :> y1) ->+ case c (x :> z1) of+ Nothing -> rejected+ Just (_ :> x1) ->+ case c (x :> y) of+ Just _ -> rejected -- this is covered by full permutivity test above+ Nothing ->+ case c (x1 :> y1) of+ Nothing -> succeeded+ Just _ -> failed $ greenText "partialPermutivity error" $$+ greenText "x" $$ showPatch x $$+ greenText "y" $$ showPatch y $$+ greenText "z" $$ showPatch z++mergeArgumentsConsistent :: Patchy p =>+ (FORALL(x y) p C(x y) -> Maybe Doc)+ -> (p :\/: p) C(a b) -> TestResult+mergeArgumentsConsistent isConsistent (x :\/: y) =+ fromMaybe $+ msum [(\z -> redText "mergeArgumentsConsistent x" $$ showPatch x $$ z) `fmap` isConsistent x,+ (\z -> redText "mergeArgumentsConsistent y" $$ showPatch y $$ z) `fmap` isConsistent y]++mergeConsistent :: (Patchy p, Merge p) =>+ (FORALL(x y) p C(x y) -> Maybe Doc)+ -> (p :\/: p) C(a b) -> TestResult+mergeConsistent isConsistent (x :\/: y) =+ case merge (x :\/: y) of+ y' :/\: x' ->+ fromMaybe $+ msum [(\z -> redText "mergeConsistent x" $$ showPatch x $$ z) `fmap` isConsistent x,+ (\z -> redText "mergeConsistent y" $$ showPatch y $$ z) `fmap` isConsistent y,+ (\z -> redText "mergeConsistent x'" $$ showPatch x' $$ z $$+ redText "where x' comes from x" $$ showPatch x $$+ redText "and y" $$ showPatch y) `fmap` isConsistent x',+ (\z -> redText "mergeConsistent y'" $$ showPatch y' $$ z) `fmap` isConsistent y']++mergeEitherWay :: (Patchy p, Merge p) => (p :\/: p) C(x y) -> TestResult+mergeEitherWay (x :\/: y) =+ case merge (x :\/: y) of+ y' :/\: x' -> case merge (y :\/: x) of+ x'' :/\: y'' | IsEq <- x'' =\/= x',+ IsEq <- y'' =\/= y' -> succeeded+ | otherwise -> failed $ redText "mergeEitherWay bug"++mergeCommute :: (Patchy p, Merge p) => (p :\/: p) C(x y) -> TestResult+mergeCommute (x :\/: y) =+ case merge (x :\/: y) of+ y' :/\: x' ->+ case commute (x :> y') of+ Nothing -> failed $ redText "mergeCommute 1" $$+ redText "x" $$ showPatch x $$+ redText "y" $$ showPatch y $$+ redText "x'" $$ showPatch x' $$+ redText "y'" $$ showPatch y'+ Just (y_ :> x'_)+ | IsEq <- y_ =\/= y,+ IsEq <- x'_ =\/= x' ->+ case commute (y :> x') of+ Nothing -> failed $ redText "mergeCommute 2 failed" $$+ redText "x" $$ showPatch x $$+ redText "y" $$ showPatch y $$+ redText "x'" $$ showPatch x' $$+ redText "y'" $$ showPatch y'+ Just (x_ :> y'_)+ | IsEq <- x_ =\/= x,+ IsEq <- y'_ =\/= y' -> succeeded+ | otherwise -> failed $ redText "mergeCommute 3" $$+ redText "x" $$ showPatch x $$+ redText "y" $$ showPatch y $$+ redText "x'" $$ showPatch x' $$+ redText "y'" $$ showPatch y' $$+ redText "x_" $$ showPatch x_ $$+ redText "y'_" $$ showPatch y'_+ | otherwise -> failed $ redText "mergeCommute 4" $$+ redText "x" $$ showPatch x $$+ redText "y" $$ showPatch y $$+ redText "x'" $$ showPatch x' $$+ redText "y'" $$ showPatch y' $$+ redText "x'_" $$ showPatch x'_ $$+ redText "y_" $$ showPatch y_+++-- | join effect preserving+joinEffectPreserving :: (FORALL(x y) (Prim :> Prim) C(x y) -> Maybe (FL Prim C(x y)))+ -> WithState RepoModel (Prim :> Prim) C(a b) -> TestResult+joinEffectPreserving j (WithState r (a :> b) r') =+ case j (a :> b) of+ Nothing -> rejected+ Just x -> case applyPatch x r of+ Nothing -> failed $ redText "x is not applicable to r."+ Just r_x -> if r_x == r'+ then succeeded+ else failed $ redText "r_x /= r'"++joinCommute :: (FORALL(x y) (Prim :> Prim) C(x y) -> Maybe (FL Prim C(x y)))+ -> (Prim :> Prim :> Prim) C(a b) -> TestResult+joinCommute j (a :> b :> c) =+ case j (b :> c) of+ Nothing -> rejected+ Just x ->+ case commuteFLorComplain (a :> b :>: c :>: NilFL) of+ Right (b' :>: c' :>: NilFL :> a') ->+ case commute (a:>:NilFL :> x) of+ Just (x' :> a'':>:NilFL) ->+ case a'' =/\= a' of+ NotEq -> failed $ greenText "joinCommute 3"+ IsEq -> case j (b' :> c') of+ Nothing -> failed $ greenText "joinCommute 4"+ Just x'' -> case x' =\/= x'' of+ NotEq -> failed $ greenText "joinCommute 5"+ IsEq -> succeeded+ _ -> failed $ greenText "joinCommute 1"+ _ -> rejected++show_read :: (Show2 p, Patchy p) => p C(a b) -> TestResult+show_read p = let ps = renderPS (showPatch p)+ in case readPatch ps of+ Nothing -> failed (redText "unable to read " $$ showPatch p)+ Just (Sealed p' ) | IsEq <- p' =\/= p -> succeeded+ | otherwise -> failed $ redText "trouble reading patch p" $$+ showPatch p $$+ redText "reads as p'" $$+ showPatch p' $$+ redText "aka" $$+ greenText (show2 p) $$+ redText "and" $$+ greenText (show2 p')+
+ src/Darcs/Test/Patch/Properties2.hs view
@@ -0,0 +1,343 @@+-- Copyright (C) 2002-2003,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.++{-# LANGUAGE CPP #-}++#include "gadts.h"++module Darcs.Test.Patch.Properties2+ ( patchPropertyTests+ -- TODO: these are exported temporarily to mark them as used+ -- Figure out whether to enable or remove the tests.+ , propUnravelThreeMerge, propUnravelSeqMerge+ , propUnravelOrderIndependent, propResolveConflictsValid+ ) where++import Prelude hiding ( pi )+import Test.QuickCheck+import Test.Framework.Providers.QuickCheck2 ( testProperty )+import Test.Framework ( Test )+import Data.Maybe ( isJust )++import Darcs.Test.Patch.Test ( Check, checkAPatch )++import Darcs.Patch ( invert, commute, merge,+ readPatch, resolveConflicts,+ fromPrim, showPatch )+import Darcs.Patch.Commute ( Commute )+import Darcs.Patch.Invert ( Invert, invertFL )+import qualified Darcs.Patch.V1 as V1 ( Patch )+import Darcs.Patch.V1.Commute ( unravel, merger )+import Darcs.Patch.Prim.V1 ()+import Darcs.Patch.Prim.V1.Core ( Prim(..) )+import Darcs.Patch.Prim.V1.Commute ( WrappedCommuteFunction(..), Perhaps(..),+ subcommutes )+import Printer ( renderPS )+import Darcs.Witnesses.Eq+import Darcs.Witnesses.Ordered+import Darcs.Witnesses.Sealed ( Sealed(Sealed), unsafeUnseal, unseal, mapSeal, Sealed2(..) )+import Darcs.Witnesses.Unsafe++#include "impossible.h"++type Patch = V1.Patch Prim++patchPropertyTests :: [Test]+patchPropertyTests+ =+ [+ testProperty "Checking that show and read work right" (unseal propReadShow)+ ]+ ++ checkSubcommutes subcommutesInverse "patch and inverse both commute"+ ++ checkSubcommutes subcommutesNontrivialInverse "nontrivial commutes are correct"+ ++ checkSubcommutes subcommutesFailure "inverses fail"+ +++ [testProperty "Checking that commuting by patch and its inverse is ok" propCommuteInverse,+ --putStr "Checking that conflict resolution is valid... "+ --runQuickCheckTest returnval propResolveConflictsValid+ testProperty "Checking that a patch followed by its inverse is identity" propPatchAndInverseIsIdentity,+ testProperty "Checking 'simple smart merge'" propSimpleSmartMergeGoodEnough,+ testProperty "Checking that commutes are equivalent" propCommuteEquivalency,+ testProperty "Checking that merges are valid" propMergeValid,+ testProperty "Checking inverses being valid" propInverseValid,+ testProperty "Checking other inverse being valid" propOtherInverseValid,+ -- The patch generator isn't smart enough to generate correct test+ -- cases for the following: (which will be obsoleted soon, anyhow)+ --putStr "Checking the order dependence of unravel... "+ --runQuickCheckTest returnval propUnravelOrderIndependent+ --putStr "Checking the unravelling of three merges... "+ --runQuickCheckTest returnval propUnravelThreeMerge+ --putStr "Checking the unravelling of a merge of a sequence... "+ --runQuickCheckTest returnval propUnravelSeqMerge+ testProperty "Checking inverse of inverse" propInverseComposition,+ testProperty "Checking the order of commutes" propCommuteEitherOrder,+ testProperty "Checking commute either way" propCommuteEitherWay,+ testProperty "Checking the double commute" propCommuteTwice,+ testProperty "Checking that merges commute and are well behaved" propMergeIsCommutableAndCorrect,+ testProperty "Checking that merges can be swapped" propMergeIsSwapable,+ testProperty "Checking again that merges can be swapped (I'm paranoid) " propMergeIsSwapable]++-- | Groups a set of tests by giving them the same prefix in their description.+-- When this is called as @checkSubcommutes subcoms expl@, the prefix for a+-- test becomes @"Checking " ++ expl ++ " for subcommute "@.+checkSubcommutes :: Testable a => [(String, a)] -> String+ -> [Test]+checkSubcommutes subcoms expl = map check_subcommute subcoms+ where check_subcommute (name, test) =+ let testName = expl ++ " for subcommute " ++ name+ in testProperty testName test++propInverseComposition :: Sealed2 (FL Patch :> FL Patch) -> Bool+propInverseComposition (Sealed2 (p1 :> p2)) =+ isIsEq $ eqFL (reverseRL (invertFL (p1:>:p2:>:NilFL))) (invert p2:>:invert p1:>:NilFL)++propInverseValid :: Sealed2 (FL Patch) -> Bool+propInverseValid (Sealed2 p1) = checkAPatch (invert p1:>:p1:>:NilFL)+propOtherInverseValid :: Sealed2 (FL Patch) -> Bool+propOtherInverseValid (Sealed2 p1) = checkAPatch (p1:>:invert p1:>:NilFL)++propCommuteTwice :: Sealed2 (FL Patch :> FL Patch) -> Property+propCommuteTwice (Sealed2 (p1:>p2)) =+ (doesCommute p1 p2) ==> (Just (p1:>p2) == (commute (p1:>p2) >>= commute))+doesCommute :: (MyEq p, Invert p, Commute p, Check p) => p C(x y) -> p C(y z) -> Bool+doesCommute p1 p2 =+ commute (p1:>p2) /= Nothing && checkAPatch (p1:>:p2:>:NilFL)+propCommuteEquivalency :: Sealed2 (FL Patch :> FL Patch) -> Property+propCommuteEquivalency (Sealed2 (p1:>p2)) =+ (doesCommute p1 p2) ==>+ case commute (p1:>p2) of+ Just (p2':>p1') -> checkAPatch (p1:>:p2:>:invert p1':>:invert p2':>:NilFL)+ _ -> impossible++propCommuteEitherWay :: Sealed2 (FL Patch :> FL Patch) -> Property+propCommuteEitherWay (Sealed2 (p1:>p2)) =+ doesCommute p1 p2 ==> doesCommute (invert p2) (invert p1)++propCommuteEitherOrder :: Sealed2 (FL Patch :> FL Patch :> FL Patch) -> Property+propCommuteEitherOrder (Sealed2 (p1:>p2:>p3)) =+ checkAPatch (p1:>:p2:>:p3:>:NilFL) &&+ doesCommute p1 (p2+>+p3) &&+ doesCommute p2 p3 ==>+ case commute (p1:>p2) of+ Nothing -> False+ Just (p2':>p1') ->+ case commute (p1':>p3) of+ Nothing -> False+ Just (p3':>_) ->+ case commute (p2':>p3') of+ Nothing -> False+ Just (p3'' :> _) ->+ case commute (p2:>p3) of+ Nothing -> False+ Just (p3'a:>_) ->+ case commute (p1:>p3'a) of+ Just (p3''a:>_) -> isIsEq (p3''a =\/= p3'')+ Nothing -> False++propPatchAndInverseIsIdentity :: Sealed2 (FL Patch :> FL Patch) -> Property+propPatchAndInverseIsIdentity (Sealed2 (p1:>p2)) =+ checkAPatch (p1:>:p2:>:NilFL) && (commute (p1:>p2) /= Nothing) ==>+ case commute (p1:>p2) of+ Just (p2':>_) -> case commute (invert p1:>p2') of+ Nothing -> True -- This is a subtle distinction.+ Just (p2'':>_) -> isIsEq (p2'' =\/= p2)+ Nothing -> impossible++propMergeIsCommutableAndCorrect :: Sealed2 (FL Patch :\/: FL Patch) -> Property+propMergeIsCommutableAndCorrect (Sealed2 (p1:\/:p2)) =+ checkAPatch (invert p1:>:p2:>:NilFL) ==>+ case merge (p2:\/:p1) of+ p1' :/\: p2' ->+ case commute (p1:>p2') of+ Nothing -> False+ Just (p2'':>p1'') -> isIsEq (p2'' =\/= p2) && isIsEq (p1' =/\= p1'')+propMergeIsSwapable :: Sealed2 (FL Patch :\/: FL Patch) -> Property+propMergeIsSwapable (Sealed2 (p1:\/:p2)) =+ checkAPatch (invert p1:>:p2:>:NilFL) ==>+ case merge (p2:\/:p1) of+ p1' :/\: p2' ->+ case merge (p1:\/:p2) of+ p2''' :/\: p1''' -> isIsEq (p1' =\/= p1''') && isIsEq (p2' =\/= p2''')++propMergeValid :: Sealed2 (FL Patch :\/: FL Patch) -> Property+propMergeValid (Sealed2 (p1:\/:p2)) =+ checkAPatch (invert p1:>:p2:>:NilFL) ==>+ case merge (p2:\/:p1) of+ _ :/\: p2' ->+ checkAPatch (invert p1:>:p2:>:invert p2:>:p1:>:p2':>:NilFL)++propSimpleSmartMergeGoodEnough :: Sealed2 (FL Patch :\/: FL Patch) -> Property+propSimpleSmartMergeGoodEnough (Sealed2 (p1:\/:p2)) =+ checkAPatch (invert p1:>:p2:>:NilFL) ==>+ case simpleSmartMerge (p1 :\/: p2) of+ Nothing -> True+ Just (Sealed p1'a)+ -> isJust ((do+ p1o :> _ <- commute (p2 :> p1'a)+ IsEq <- return $ p1o =\/= p1+ Sealed p2'a <- simpleSmartMerge (p2 :\/: p1)+ p2b :> p1'b <- commute (p1 :> p2'a)+ IsEq <- return $ p2 =\/= p2b+ IsEq <- return $ p1'a =\/= p1'b+ return ()) :: Maybe ())++simpleSmartMerge :: (Commute p, Invert p) => (p :\/: p) C(x y) -> Maybe (Sealed (p C(y)))+simpleSmartMerge (p1 :\/: p2) =+ case commute (invert p2 :> p1) of+ Just (p1':>_) -> Just (Sealed p1')+ Nothing -> Nothing++-- | The conflict resolution code (glump) begins by "unravelling" the merger+-- into a set of sequences of patches. Each sequence of patches corresponds+-- to one non-conflicted patch that got merged together with the others. The+-- result of the unravelling of a series of merges must obviously be+-- independent of the order in which those merges are performed. This+-- unravelling code (which uses the unwind code mentioned above) uses probably+-- the second most complicated algorithm. Fortunately, if we can successfully+-- unravel the merger, almost any function of the unravelled merger satisfies+-- the two constraints mentioned above that the conflict resolution code must+-- satisfy.+propUnravelThreeMerge :: Patch C(x y) -> Patch C(x z) -> Patch C(x w) -> Property+propUnravelThreeMerge p1 p2 p3 =+ checkAPatch (invert p1:>:p2:>:invert p2:>:p3:>:NilFL) ==>+ (unravel $ unsafeUnseal $ merger "0.0" (unsafeUnseal (merger "0.0" p2 p3)) (unsafeUnseal (merger "0.0" p2 p1))) ==+ (unravel $ unsafeUnseal $ merger "0.0" (unsafeUnseal (merger "0.0" p1 p3)) (unsafeUnseal (merger "0.0" p1 p2)))++propUnravelSeqMerge :: Patch C(x y) -> Patch C(x z) -> Patch C(z w) -> Property+propUnravelSeqMerge p1 p2 p3 =+ checkAPatch (invert p1:>:p2:>:p3:>:NilFL) ==>+ (unravel $ unsafeUnseal $ merger "0.0" p3 $ unsafeUnseal $ merger "0.0" p2 p1) ==+ (unravel $ unsafeUnseal $ merger "0.0" (unsafeUnseal $ merger "0.0" p2 p1) p3)++propUnravelOrderIndependent :: Patch C(x y) -> Patch C(x z) -> Property+propUnravelOrderIndependent p1 p2 =+ checkAPatch (invert p1:>:p2:>:NilFL) ==>+ (unravel $ unsafeCoercePStart $ unsafeUnseal $ merger "0.0" p2 p1) == (unravel $ unsafeUnseal $ merger "0.0" p1 p2)++propResolveConflictsValid :: Patch C(x y) -> Patch C(x z) -> Property+propResolveConflictsValid p1 p2 =+ case merge (p1:\/:p2) of+ _ :/\: p1' ->+ let p = p2:>:p1':>:NilFL in+ checkAPatch (invert p1:>:p2:>:NilFL) ==>+ and $ map (\l -> (\ml -> checkAPatch (p+>+ml)) `unseal` mergeList l)+ $ resolveConflicts p++mergeList :: [Sealed (FL Prim C(x))] -> Sealed (FL Patch C(x))+mergeList patches = mapFL_FL fromPrim `mapSeal` doml NilFL patches+ where doml :: FL Prim C(x y) -> [Sealed (FL Prim C(x))] -> Sealed (FL Prim C(x))+ doml mp (Sealed p:ps) =+ case commute (invert p :> mp) of+ Just (mp' :> _) -> doml (p +>+ mp') ps+ Nothing -> doml mp ps -- This shouldn't happen for "good" resolutions.+ doml mp [] = Sealed mp++propReadShow :: FL Patch C(x y) -> Bool+propReadShow p = case readPatch $ renderPS $ showPatch p of+ Just (Sealed p') -> isIsEq (p' =\/= p)+ Nothing -> False++-- |In order for merges to work right with commuted patches, inverting a patch+-- past a patch and its inverse had golly well better give you the same patch+-- back again.+propCommuteInverse :: Sealed2 (FL Patch :> FL Patch) -> Property+propCommuteInverse (Sealed2 (p1 :> p2)) =+ doesCommute p1 p2 ==> case commute (p1 :> p2) of+ Nothing -> impossible+ Just (_ :> p1') ->+ case commute (p1' :> invert p2) of+ Nothing -> False+ Just (_ :> p1'') -> isIsEq (p1'' =/\= p1)++type CommuteProperty = Sealed2 (Prim :> Prim) -> Property++subcommutesInverse :: [(String, CommuteProperty)]+subcommutesInverse = zip names (map prop_subcommute cs)+ where (names, cs) = unzip subcommutes+ prop_subcommute c (Sealed2 (p1:>p2)) =+ does c p1 p2 ==>+ case runWrappedCommuteFunction c (p2:< p1) of+ Succeeded (p1':<p2') ->+ case runWrappedCommuteFunction c (invert p2:< p1') of+ Succeeded (p1'':<ip2x') -> isIsEq (p1'' =/\= p1) &&+ case runWrappedCommuteFunction c (invert p1:< invert p2) of+ Succeeded (ip2':< ip1') ->+ case runWrappedCommuteFunction c (p2':< invert p1) of+ Succeeded (ip1o':< p2o) -> isJust ((do+ IsEq <- return $ invert ip1' =/\= p1'+ IsEq <- return $ invert ip2' =/\= p2'+ IsEq <- return $ ip1o' =/\= ip1'+ IsEq <- return $ p2o =\/= p2+ IsEq <- return $ p1'' =/\= p1+ IsEq <- return $ ip2x' =\/= ip2'+ return ()) :: Maybe ())+ _ -> False+ _ -> False+ _ -> False+ _ -> False++subcommutesNontrivialInverse :: [(String, CommuteProperty)]+subcommutesNontrivialInverse = zip names (map prop_subcommute cs)+ where (names, cs) = unzip subcommutes+ prop_subcommute c (Sealed2 (p1 :> p2)) =+ nontrivial c p1 p2 ==>+ case runWrappedCommuteFunction c (p2:< p1) of+ Succeeded (p1':<p2') ->+ case runWrappedCommuteFunction c (invert p2:< p1') of+ Succeeded (p1'':<ip2x') -> isIsEq (p1'' =/\= p1) &&+ case runWrappedCommuteFunction c (invert p1:< invert p2) of+ Succeeded (ip2':< ip1') ->+ case runWrappedCommuteFunction c (p2':< invert p1) of+ Succeeded (ip1o':< p2o) -> isJust ((do+ IsEq <- return $ invert ip1' =/\= p1'+ IsEq <- return $ invert ip2' =/\= p2'+ IsEq <- return $ ip1o' =/\= ip1'+ IsEq <- return $ p2o =\/= p2+ IsEq <- return $ p1'' =/\= p1+ IsEq <- return $ ip2x' =\/= ip2'+ return ()) :: Maybe ())+ _ -> False+ _ -> False+ _ -> False+ _ -> False++subcommutesFailure :: [(String, CommuteProperty)]+subcommutesFailure = zip names (map prop cs)+ where (names, cs) = unzip subcommutes+ prop c (Sealed2 (p1 :> p2)) =+ doesFail c p1 p2 ==>+ case runWrappedCommuteFunction c (invert p1 :< invert p2) of+ Failed -> True+ _ -> False++doesFail :: WrappedCommuteFunction -> Prim C(x y) -> Prim C(y z) -> Bool+doesFail c p1 p2 =+ fails (runWrappedCommuteFunction c (p2:<p1)) && checkAPatch (p1 :>: p2 :>: NilFL)+ where fails Failed = True+ fails _ = False++does :: WrappedCommuteFunction -> Prim C(x y) -> Prim C(y z) -> Bool+does c p1 p2 =+ succeeds (runWrappedCommuteFunction c (p2:<p1)) && checkAPatch (p1 :>: p2 :>: NilFL)+ where succeeds (Succeeded _) = True+ succeeds _ = False++nontrivial :: WrappedCommuteFunction -> Prim C(x y) -> Prim C(y z) -> Bool+nontrivial c p1 p2 =+ succeeds (runWrappedCommuteFunction c (p2:<p1)) && checkAPatch (p1 :>: p2 :>: NilFL)+ where succeeds (Succeeded (p1' :< p2')) = not (p1' `unsafeCompare` p1 && p2' `unsafeCompare` p2)+ succeeds _ = False
src/Darcs/Test/Patch/QuickCheck.hs view
@@ -1,287 +1,61 @@-{-# OPTIONS_GHC -fno-warn-deprecations -fno-warn-orphans -fglasgow-exts #-}-{-# LANGUAGE CPP, UndecidableInstances, ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-deprecations -fno-warn-orphans #-}+{-# LANGUAGE CPP, UndecidableInstances, ScopedTypeVariables, MultiParamTypeClasses,+ FlexibleInstances, ViewPatterns #-} #include "gadts.h"-module Darcs.Test.Patch.QuickCheck ( WithStartState, RepoModel, Tree,- mergeExamples, commuteExamples, tripleExamples,+module Darcs.Test.Patch.QuickCheck ( Tree(..), TreeWithFlattenPos(..), propConsistentTreeFlattenings, propFail, propIsMergeable,- flattenOne, testConditional,+ flattenOne, commutePairFromTree, mergePairFromTree,- commuteTripleFromTree,+ commuteTripleFromTree, mergePairFromCommutePair, commutePairFromTWFP, mergePairFromTWFP, getPairs, getTriples, patchFromTree,- quickCheck, realPatchLoopExamples, shrink+ canonizeTree,+ quickCheck ) where -import Control.Arrow ( (***) )-import Control.Monad ( liftM, replicateM, mplus, mzero )-import qualified Data.ByteString.Char8 as BC (pack, head)-import qualified Data.ByteString as B (ByteString, length)+import Control.Monad ( liftM ) import Test.QuickCheck-import Test.Framework ( Test )-import Test.Framework.Providers.QuickCheck2 ( testProperty )+import Darcs.Test.Patch.RepoModel ( RepoModel, applyPatch, aSmallRepo )+import Darcs.Test.Patch.WithState+import Darcs.Test.Patch.Prim.V1 ()+import Darcs.Test.Util.QuickCheck ( bSized ) import Darcs.Witnesses.Sealed-import Darcs.Patch ( Patch )+import Darcs.Witnesses.Eq+import Darcs.Witnesses.Unsafe import Darcs.Witnesses.Ordered-import Darcs.Patch.Patchy (--showPatch,- Invert(..), Commute(..))-import Darcs.Patch.Prim (Prim(..), Effect(..), FilePatchType(..), FromPrim(..), isIdentity )-import Darcs.Patch.Real ( RealPatch, prim2real )+import Darcs.Patch.Merge ( Merge(..) )+import Darcs.Patch.Patchy ( Invert(..), Commute(..) )+import Darcs.Patch.Prim ( PrimOf, PrimPatch, PrimPatchBase, FromPrim(..), move )+import Darcs.Patch.Prim.V1 ()+import Darcs.Patch.Prim.V1.Core ( Prim(..), FilePatchType(..), isIdentity )+import Darcs.Patch.V2 ( RealPatch, prim2real )+#ifdef GADT_WITNESSES import Darcs.Patch.Set ( Origin )+#endif --import Darcs.ColorPrinter ( errorDoc ) --import Darcs.ColorPrinter ( traceDoc ) import Darcs.Witnesses.Show --import Printer ( greenText, ($$) )-import Darcs.Patch.FileName ( FileName, fp2fn ) #include "impossible.h" -tripleExamples :: (FromPrim p, Commute p, Invert p) => [Sealed2 (p :> p :> p)]-tripleExamples = [commuteTripleFromTree seal2 $- WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] })- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "g"]))- (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "j"]))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "s"])) NilTree)))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "e"])) NilTree))- ,commuteTripleFromTree seal2 $- WithStartState (RepoModel { rmFileName = fp2fn "./file",- rmFileContents = [BC.pack "j"] })- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "s"]))- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "j"] [])) NilTree)- (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "j"] [])) NilTree)))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "j"] [])) NilTree))- ] --mergeExamples :: (FromPrim p, Commute p, Invert p) => [Sealed2 (p :\/: p)]-mergeExamples = map (unseal2 (mergePairFromCommutePair seal2)) commuteExamples--commuteExamples :: (FromPrim p, Commute p) => [Sealed2 (p :> p)]-commuteExamples = [- commutePairFromTWFP seal2 $- WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] })- (TWFP 3- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "h"])) NilTree)- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "b"]))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "f"]))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "v"]))- (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "f"] [])) NilTree)))))),- commutePairFromTWFP seal2 $- WithStartState- (RepoModel { rmFileName = fp2fn "./file",- rmFileContents = [BC.pack "f",BC.pack "s",BC.pack "d"] })- (TWFP 3- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 2 [BC.pack "d"] [])) NilTree)- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "f"] [])) NilTree)- (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "f"] []))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "s",BC.pack "d"] []))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "v"])) NilTree)))))),-{- commutePairFromTWFP seal2 $- WithStartState- (RepoModel { rmFileName = fp2fn "./file",- rmFileContents = [BC.pack "f",BC.pack "u",- BC.pack "s",BC.pack "d"] })- (TWFP 5- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 4 [] [BC.pack "x"]))- (SeqTree (FP (fp2fn "./file") (Hunk 3 [BC.pack "d"] [])) NilTree))- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "f",BC.pack "u"] [])) NilTree)- (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "f"] []))- (SeqTree (FP(fp2fn "./file") (Hunk 0 [BC.pack "u",BC.pack "s",BC.pack "d"] []))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "a"]))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "a"] [])) NilTree))))))),-}- commutePairFromTree seal2 $- WithStartState (RepoModel { rmFileName = fp2fn "./file",- rmFileContents = [BC.pack "n",BC.pack "t",BC.pack "h"] })- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "n",BC.pack "t",BC.pack "h"] []))- NilTree)- (SeqTree (FP (fp2fn "./file") (Hunk 2 [BC.pack "h"] []))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "n"] []))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "t"] [])) NilTree)))),- commutePairFromTree seal2 $- WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] })- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "n"])) NilTree)- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "i"]))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "i"])) NilTree))),- commutePairFromTree seal2 $- WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] })- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "c"]))- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "c"] [BC.pack "r"])) NilTree)- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "h"]))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "d"])) NilTree))))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "f"])) NilTree)),- commutePairFromTWFP seal2 $- WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] })- (TWFP 1- (ParTree- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "t"])) NilTree)- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "t"])) NilTree))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "f"])) NilTree))),- commutePairFromTWFP seal2 $- WithStartState (RepoModel { rmFileName = fp2fn "./file",- rmFileContents = [BC.pack "f",BC.pack " r",- BC.pack "c",BC.pack "v"] })- (TWFP 4- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 2 [BC.pack "c",BC.pack "v"] []))- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "r"] []))- (SeqTree (FP (fp2fn "fi le") (Hunk 0 [BC.pack "f"] [])) NilTree))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "f",BC.pack "r"] []))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "y"])) NilTree))))- (SeqTree (FP (fp2fn "./file") (Hunk 3 [BC.pack "v"] [])) NilTree))),- commutePairFromTree seal2 $- WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] })- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "z"])) NilTree)- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "f"])) NilTree)- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "r"])) NilTree)- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "d"])) NilTree))))- , commutePairFromTree seal2 $- WithStartState (RepoModel { rmFileName = fp2fn "./file",- rmFileContents = [BC.pack "t",BC.pack "r",- BC.pack "h"] })- (ParTree- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "t",BC.pack "r",BC.pack "h"] []))- NilTree)- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "o"])) NilTree))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "t"] []))- (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "h"] [])) NilTree)))- , commutePairFromTWFP seal2 $- WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] }) $- TWFP 2- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "h"])) NilTree)- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "y"]))- (SeqTree (FP (fp2fn "./file") (Hunk 1 [] [BC.pack "m"]))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "v"])) NilTree))))- , commutePairFromTree seal2 $- WithStartState (RepoModel {rmFileName = fp2fn "./file",rmFileContents = [] })- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "p"]))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "p"] []))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "c"])) NilTree)))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "z"])) NilTree))- , commutePairFromTree seal2 $- WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] })- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "j" ]))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "j"] [])) NilTree))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "v"])) NilTree))- , commutePairFromTree seal2 $- WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] })- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "v"])) NilTree)- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "j" ]))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [BC.pack "j"] [])) NilTree)))- , commutePairFromTree seal2 $- WithStartState (RepoModel { rmFileName = fp2fn "./file",- rmFileContents = [BC.pack "x",BC.pack "c"] })- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "h"]))- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 2 [BC.pack "c"] [])) NilTree)- (SeqTree (FP (fp2fn "./file") (Hunk 1 [BC.pack "x"] []))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "j"])) NilTree))))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] [BC.pack "l"])) NilTree))- , commutePairFromTree seal2 $- WithStartState (RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] })- (ParTree- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] (packStringLetters "s"))) NilTree)- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] (packStringLetters "k")))- (SeqTree (FP (fp2fn "./file") (Hunk 0 (packStringLetters "k") []))- (SeqTree (FP (fp2fn "./file") (Hunk 0 [] (packStringLetters "m")))- (SeqTree (FP (fp2fn "./file") (Hunk 0 (packStringLetters "m") [])) NilTree)))))- ]---- | Turns a condition and a test function into a conditional quickcheck--- property that can be run by test-framework.-testConditional :: (Arbitrary p, Show p, Show q) => String -- ^ Test name- -> (p -> Bool) -- ^ Condition- -> (p -> Maybe q) -- ^ Test function- -> Test-testConditional name nottrivial t = testProperty name t'- where t' p = nottrivial p ==> case t p of- Nothing -> True- Just q -> error $ show q--data RepoModel C(x)- = RepoModel {- rmFileName :: !FileName,- rmFileContents :: [B.ByteString]- } deriving (Eq)--instance Show (RepoModel C(x)) where- showsPrec d rm = showParen (d > appPrec) $- showString "RepoModel { rmFileName = " . showsPrec 0 (rmFileName rm) .- showString ", rmFileContents = " . showsPrec' 0 (rmFileContents rm) .- showString " }"- where showsPrec' n lines | all ((==1) . B.length) lines = showsPrecC n lines- | otherwise = showsPrec n lines- showsPrecC _ [] = showString "[]"- showsPrecC n ss = showParen (n > 0) $ showString "packStringLetters " . showsPrec (appPrec + 1) (map BC.head ss)--instance Show1 RepoModel where- showDict1 = ShowDictClass---- | The initial repository model. The repository contains a single file named--- @./file@, which is empty.-initRepoModel :: RepoModel C(Origin)-initRepoModel = RepoModel { rmFileName = fp2fn "./file", rmFileContents = [] }-rebuildRepoModel :: RepoModel C(x) -> RepoModel C(y)-rebuildRepoModel rm = RepoModel { rmFileName = rmFileName rm, rmFileContents = rmFileContents rm }---- | A combination of a patch and its final state. The state, in this module, is--- typically represented by a 'RepoModel' value. The @px@ type is typically a--- patch type applied to its pre-state, e.g. @Prim x@.-data WithEndState px s C(y) = WithEndState { wesPatch :: px C(y), _wesState :: s C(y) }---- | A type class to generate arbitrary values, threading a state through the--- arbitrary calls. So this can be used to generate a patch that comes after--- another patch. The post-state of the generated patch is hidden by the--- 'Sealed'.-class ArbitraryState s p where- arbitraryState :: s C(x) -> Gen (Sealed (WithEndState (p C(x)) s))- -- does a coarbitrary make sense?- -- | Generate a patch to a certain state. class ArbitraryStateIn s p where arbitraryStateIn :: s C(x) -> Gen (p C(x)) -instance ArbitraryState RepoModel Prim where- arbitraryState rm = oneof [arbitraryFP rm] -instance Arbitrary (Sealed2 (FL Prim)) where- arbitrary = do Sealed2 ps1 <- liftM (unseal (seal2 . wesPatch)) $ arbitraryState initRepoModel- return $ Sealed2 $ mapFL_FL make_identity_identity ps1- where make_identity_identity :: Prim C(x y) -> Prim C(x y)- make_identity_identity p | IsEq <- isIdentity p = identity- | otherwise = p- instance Arbitrary (Sealed2 (FL (WithState RepoModel Prim))) where- arbitrary = liftM (unseal (seal2 . wesPatch)) $ arbitraryState initRepoModel+ arbitrary = do repo <- aSmallRepo+ liftM (unseal (seal2 . wesPatch)) $ arbitraryState repo propConsistentTreeFlattenings :: Sealed (WithStartState RepoModel (Tree Prim)) -> Bool propConsistentTreeFlattenings (Sealed (WithStartState start t)) = fromJust $ do Sealed (G2 flat) <- return $ flattenTree $ mapTree prim2real t- rms <- return $ map (applyPatch start) flat+ rms <- return $ map (`applyPatch` start) flat return $ and $ zipWith assertEqualFst (zip rms flat) (tail $ zip rms flat) assertEqualFst :: (Eq a, Show a, Show b, Show c) => (a, b) -> (a, c) -> Bool@@ -290,38 +64,12 @@ | otherwise = error ("Not really equal:\n" ++ show x ++ "\nand\n" ++ show y ++ "\ncoming from\n" ++ show bx ++ "\nand\n" ++ show by) --- WithState and propFail are handy for debugging arbitrary code-data WithState s p C(x y) = WithState (s C(x)) (p C(x y)) (s C(y))- deriving Show -data WithStartState s p C(x) = WithStartState (s C(x)) (p C(x))--instance (Show1 s, Show1 p) => Show (WithStartState s p C(x)) where- showsPrec d (WithStartState s p) = showParen (d > appPrec) $ showString "WithStartState " .- showsPrec1 (appPrec + 1) s . showString " " .- showsPrec1 (appPrec + 1) p--instance (Show1 s, Show1 p) => Show1 (WithStartState s p) where- showDict1 = ShowDictClass-+-- WithState and propFail are handy for debugging arbitrary code propFail :: Int -> Tree Prim C(x) -> Bool propFail n xs = sizeTree xs < n -instance ArbitraryState s p => ArbitraryState s (WithState s p) where- arbitraryState rm = do xandrm' <- arbitraryState rm- flip unseal xandrm' $ \(WithEndState x rm') ->- return $ seal $ WithEndState (WithState rm x rm') rm' -instance ArbitraryState s p => ArbitraryState s (FL p) where- arbitraryState rm1 = sized $ \n -> do k <- choose (0, n)- arbitraryList k rm1- where arbitraryList :: FORALL(x) Int -> s C(x) -> Gen (Sealed (WithEndState (FL p C(x)) s))- arbitraryList 0 rm = return $ seal $ WithEndState NilFL rm- arbitraryList (n+1) rm = do Sealed (WithEndState x rm') <- arbitraryState rm- Sealed (WithEndState xs rm'') <- arbitraryList n rm'- return $ seal $ WithEndState (x :>: xs) rm''- arbitraryList _ _ = impossible- data Tree p C(x) where NilTree :: Tree p C(x) SeqTree :: p C(x y) -> Tree p C(y) -> Tree p C(x)@@ -352,12 +100,11 @@ -- newtype G1 l p C(x) = G1 { _unG1 :: l (p C(x)) } newtype G2 l p C(x y) = G2 { unG2 :: l (p C(x y)) } -flattenTree :: (Commute p) => Tree p C(z) -> Sealed (G2 [] (FL p) C(z))+flattenTree :: (Merge p) => Tree p C(z) -> Sealed (G2 [] (FL p) C(z)) flattenTree NilTree = seal $ G2 $ return NilFL flattenTree (SeqTree p t) = mapSeal (G2 . map (p :>:) . unG2) $ flattenTree t-flattenTree (ParTree t1 t2) = flip unseal (flattenTree t1) $ \gpss1 ->- flip unseal (flattenTree t2) $ \gpss2 ->- seal $ G2 $+flattenTree (ParTree (flattenTree -> Sealed gpss1) (flattenTree -> Sealed gpss2))+ = seal $ G2 $ do ps1 <- unG2 gpss1 ps2 <- unG2 gpss2 ps2' :/\: ps1' <- return $ merge (ps1 :\/: ps2)@@ -367,102 +114,49 @@ map unsafeCoerceP [ps1 +>+ ps2', ps2 +>+ ps1'] instance ArbitraryState s p => ArbitraryStateIn s (Tree p) where- -- don't generate trees deeper than 5 with default QuickCheck size- arbitraryStateIn rm = sized $ \s -> arbitraryTree rm (s `div` 17)+ -- Don't generate trees deeper than 6 with default QuickCheck size (0..99).+ -- Note if we don't put a non-zero lower bound the first generated trees will always have depth 0.+ arbitraryStateIn rm = bSized 3 0.035 9 $ \depth -> arbitraryTree rm depth --- | Generate a tree of patches, bounded by the size @maxSize@.+-- | Generate a tree of patches, bounded by the depth @maxDepth@. arbitraryTree :: ArbitraryState s p => s C(x) -> Int -> Gen (Tree p C(x))-arbitraryTree rm maxDepth- | maxDepth == 0 = return NilTree- | otherwise = frequency [(2, return NilTree)- ,(2, do Sealed (WithEndState p rm') <- arbitraryState rm- t <- arbitraryTree rm' maxDepth- return (SeqTree p t))- ,(1, do t1 <- arbitraryTree rm (maxDepth - 1)- t2 <- arbitraryTree rm (maxDepth - 1)- return (ParTree t1 t2))]---shrinkWSSTree :: Sealed (WithStartState RepoModel (Tree Prim))- -> [Sealed (WithStartState RepoModel (Tree Prim))]-shrinkWSSTree = unseal doShrinkWSSTree- where- doShrinkWSSTree wss@(WithStartState rm t)- = shrinkWSSTree' wss -- shrink the tree- `mplus`- do -- shrink the starting context- pos <- [0 .. length (rmFileContents rm) - 1]- let rmFileContents' = take pos (rmFileContents rm) ++ drop (pos+1) (rmFileContents rm)- t' = shrinkPosStart pos (canonizeTree t)- return $ seal $ WithStartState (rm { rmFileContents = rmFileContents' }) (canonizeTree t')+arbitraryTree rm depth+ | depth == 0 = return NilTree+ -- Note a probability of N for NilTree would imply ~(100*N)% of empty trees.+ -- For the purpose of this module empty trees are useless, but even when+ -- NilTree case is omitted there is still a small percentage of empty trees+ -- due to the generation of null-patches (empty-hunks) and the use of canonizeTree.+ | otherwise = frequency [(1, do Sealed (WithEndState p rm') <- arbitraryState rm+ t <- arbitraryTree rm' (depth - 1)+ return (SeqTree p t))+ ,(3, do t1 <- arbitraryTree rm (depth - 1)+ t2 <- arbitraryTree rm (depth - 1)+ return (ParTree t1 t2))] --- If we had a more general repo model, then Int would need to be more general too--class ShrinkablePos p where- shrinkPos :: Int -> p C(x y) -> (p C(x y), Maybe Int)- shrinkPatch :: p C(x y) -> [(p C(x y), Maybe Int)]+class NullPatch p where nullPatch :: p C(x y) -> EqCheck C(x y) -class ShrinkablePosStart p where- shrinkPosStart :: Int -> p C(x) -> p C(x)+class (ArbitraryState RepoModel prim, NullPatch prim, PrimPatch prim) => ArbitraryPrim prim+instance ArbitraryPrim Prim -instance ShrinkablePos p => ShrinkablePosStart (Tree p) where- shrinkPosStart _ NilTree = NilTree- shrinkPosStart pos (SeqTree p t)- = let (p', mpos') = shrinkPos pos p- in case mpos' of- Nothing -> SeqTree p' t- Just pos' -> SeqTree p' (shrinkPosStart pos' t)- shrinkPosStart pos (ParTree t1 t2) = ParTree (shrinkPosStart pos t1) (shrinkPosStart pos t2)+-- a hack introduced after Identity was removed from Prim+-- WARNING: localIdentity does not commute with itself!+localIdentity :: PrimPatch prim => prim C(x x)+localIdentity = let fp = "./dummy" in move fp fp -smartFP :: FileName -> FilePatchType C(x y) -> Prim C(x y)-smartFP _ (Hunk _ [] []) | avoidEmptyHunks = unsafeCoerceP Identity-smartFP fn filepatch = FP fn filepatch -instance ShrinkablePos Prim where- shrinkPos pos (FP fn fp) = (smartFP fn *** id) (shrinkPos pos fp)- shrinkPos pos Identity = (Identity, Just pos)- shrinkPos _ _ = impossible- shrinkPatch (FP fn fp) = map (smartFP fn *** id) (shrinkPatch fp)- shrinkPatch Identity = []- shrinkPatch _ = impossible+instance NullPatch Prim where nullPatch (FP _ fp) = nullPatch fp- nullPatch Identity = IsEq- nullPatch _ = impossible--avoidEmptyHunks :: Bool-avoidEmptyHunks = True+ nullPatch p | IsEq <- isIdentity p = IsEq+ nullPatch _ = NotEq -instance ShrinkablePos FilePatchType where- shrinkPos pos (Hunk n old new)- | pos < n = (Hunk (n-1) old new, Just pos)- | pos >= n + length old = (Hunk n old new, Just (pos + length new - length old))- | otherwise = (Hunk n (take pos' old ++ drop (pos'+1) old) new, Nothing)- where pos' = pos - n- shrinkPos _ _ = bug "foo1 in ShrinkablePos"- shrinkPatch (Hunk (n+1) [] []) = [(Hunk n [] [], Nothing)]- shrinkPatch (Hunk n old new)- = do i <- [0 .. length new - 1]- return (Hunk n old (take i new ++ drop (i+1) new), Just (n + i))- shrinkPatch _ = bug "foo in ShrinkablePos"+instance NullPatch FilePatchType where nullPatch (Hunk _ [] []) = unsafeCoerceP IsEq -- is this safe? nullPatch _ = NotEq -shrinkWSSTree'- -- start a new line here because apparently ' confuses CPP..- :: WithStartState RepoModel (Tree Prim) C(x)- -> [Sealed (WithStartState RepoModel (Tree Prim))]-shrinkWSSTree' (WithStartState _ NilTree) = []-shrinkWSSTree' (WithStartState rm t@(SeqTree p t'))- = return (seal (WithStartState (applyPatch rm p) (canonizeTree t')))- `mplus`- liftM (seal . WithStartState rm) (map canonizeTree $ shrinkTree t)-shrinkWSSTree' (WithStartState rm t@(ParTree _ _))- = liftM (seal . WithStartState rm) (map canonizeTree $ shrinkTree t)- -- canonize a tree, removing any dead branches-canonizeTree :: ShrinkablePos p => Tree p C(x) -> Tree p C(x)+canonizeTree :: NullPatch p => Tree p C(x) -> Tree p C(x) canonizeTree NilTree = NilTree canonizeTree (ParTree t1 t2) | NilTree <- canonizeTree t1 = canonizeTree t2@@ -471,34 +165,15 @@ canonizeTree (SeqTree p t) | IsEq <- nullPatch p = canonizeTree t | otherwise = SeqTree p (canonizeTree t) --- shrink the tree without changing the starting context-shrinkTree :: ShrinkablePos p => Tree p C(x) -> [Tree p C(x)]-shrinkTree NilTree = []-shrinkTree (SeqTree p t) = do case nullPatch p of- IsEq -> return t- NotEq -> mzero- `mplus`- do (p', pos) <- shrinkPatch p- return (SeqTree p' (maybe id shrinkPosStart pos t))- `mplus`- do t' <- shrinkTree t- return (SeqTree p t')-shrinkTree (ParTree t1 t2) = [t1, t2]- `mplus`- do t1' <- shrinkTree t1- return (ParTree t1' t2)- `mplus`- do t2' <- shrinkTree t2- return (ParTree t1 t2') -instance Arbitrary (Sealed (WithStartState RepoModel (Tree Prim))) where- arbitrary = do Sealed (WithStartState rm tree) <-- liftM (seal . WithStartState initRepoModel) (arbitraryStateIn initRepoModel)+instance ArbitraryPrim prim => Arbitrary (Sealed (WithStartState RepoModel (Tree prim))) where+ arbitrary = do repo <- aSmallRepo+ Sealed (WithStartState rm tree) <-+ liftM (seal . WithStartState repo) (arbitraryStateIn repo) return $ Sealed $ WithStartState rm (canonizeTree tree)- shrink = shrinkWSSTree -propIsMergeable :: forall p C(x) . (FromPrim p, Commute p)- => Sealed (WithStartState RepoModel (Tree Prim))+propIsMergeable :: forall p C(x) . (FromPrim p, Merge p)+ => Sealed (WithStartState RepoModel (Tree (PrimOf p))) -> Maybe (Tree p C(x)) propIsMergeable (Sealed (WithStartState _ t)) = case flattenOne t of@@ -506,74 +181,49 @@ in case lengthFL ps of _ -> Nothing -flattenOne :: (FromPrim p, Commute p) => Tree Prim C(x) -> Sealed (FL p C(x))+flattenOne :: (FromPrim p, Merge p) => Tree (PrimOf p) C(x) -> Sealed (FL p C(x)) flattenOne NilTree = seal NilFL-flattenOne (SeqTree p t) = flip unseal (flattenOne t) $ \ps -> seal (fromPrim p :>: ps)-flattenOne (ParTree t1 t2) =- flip unseal (flattenOne t1) $ \ps1 ->- flip unseal (flattenOne t2) $ \ps2 ->+flattenOne (SeqTree p (flattenOne -> Sealed ps)) = seal (fromPrim p :>: ps)+flattenOne (ParTree (flattenOne -> Sealed ps1) (flattenOne -> Sealed ps2)) = --traceDoc (greenText "flattening two parallel series: ps1" $$ showPatch ps1 $$ -- greenText "ps2" $$ showPatch ps2) $ case merge (ps1 :\/: ps2) of ps2' :/\: _ -> seal (ps1 +>+ ps2') -instance Arbitrary (Sealed2 (FL RealPatch)) where- arbitrary = do Sealed (WithStartState _ tree) <- arbitrary :: Gen (Sealed (WithStartState RepoModel (Tree Prim)))+instance ArbitraryPrim prim => Arbitrary (Sealed2 (FL (RealPatch prim))) where+ arbitrary = do Sealed (WithStartState _ tree) <- arbitrary :: Gen (Sealed (WithStartState RepoModel (Tree prim))) return $ unseal seal2 (flattenOne tree) -instance Arbitrary (Sealed2 RealPatch) where- arbitrary = do Sealed (WithStartState _ tree) <- arbitrary :: Gen (Sealed (WithStartState RepoModel (Tree Prim)))+instance ArbitraryPrim prim => Arbitrary (Sealed2 (RealPatch prim)) where+ arbitrary = do Sealed (WithStartState _ tree) <- arbitrary :: Gen (Sealed (WithStartState RepoModel (Tree prim))) case mapFL seal2 `unseal` flattenOne tree of- [] -> return $ seal2 $ fromPrim Identity+ [] -> return $ seal2 $ fromPrim localIdentity ps -> elements ps -instance (Arbitrary (Sealed2 (FL p)), Commute p) => Arbitrary (Sealed2 (p :\/: p)) where- arbitrary = do Sealed2 (a :> b) <- arbitrary- case commute (a :> b) of- Just (b' :> _) -> return (seal2 (a :\/: b'))- Nothing -> arbitrary--instance Arbitrary (Sealed2 (FL p)) => Arbitrary (Sealed2 (p :> p)) where- arbitrary = do Sealed2 ps <- arbitrary- let pairs = getPairs ps- case pairs of- [] -> arbitrary- _ -> elements pairs--instance (Invert p, Arbitrary (Sealed2 (FL p))) => Arbitrary (Sealed2 (p :> p :> p)) where- arbitrary = do Sealed2 ps <- arbitrary- return $ last_triple ps- where last_triple :: FL p C(x y) -> Sealed2 (p :> p :> p)- last_triple NilFL = seal2 $ identity :> identity :> identity- last_triple (a :>: NilFL) = seal2 $ a :> invert a :> identity- last_triple (a :>: b :>: NilFL) = seal2 $ invert a :> a :> b- last_triple (a :>: b :>: c :>: NilFL) = seal2 $ a :> b :> c- last_triple (_ :>: xs) = last_triple xs- data TreeWithFlattenPos p C(x) = TWFP Int (Tree p C(x)) -commutePairFromTWFP :: (FromPrim p, Commute p)+commutePairFromTWFP :: (FromPrim p, Merge p, PrimPatchBase p) => (FORALL (y z) (p :> p) C(y z) -> t)- -> (WithStartState RepoModel (TreeWithFlattenPos Prim) C(x) -> t)+ -> (WithStartState RepoModel (TreeWithFlattenPos (PrimOf p)) C(x) -> t) commutePairFromTWFP handlePair (WithStartState _ (TWFP n t)) = unseal2 handlePair $ let xs = unseal getPairs (flattenOne t)- in if length xs > n && n >= 0 then xs!!n else seal2 (fromPrim Identity :> fromPrim Identity)+ in if length xs > n && n >= 0 then xs!!n else seal2 (fromPrim localIdentity :> fromPrim localIdentity) -commutePairFromTree :: (FromPrim p, Commute p)+commutePairFromTree :: (FromPrim p, Merge p, PrimPatchBase p) => (FORALL (y z) (p :> p) C(y z) -> t)- -> (WithStartState RepoModel (Tree Prim) C(x) -> t)+ -> (WithStartState RepoModel (Tree (PrimOf p)) C(x) -> t) commutePairFromTree handlePair (WithStartState _ t) = unseal2 handlePair $ case flattenOne t of Sealed ps -> let xs = --traceDoc (greenText "I'm flattening one to get:" $$ showPatch ps) $ getPairs ps- in if null xs then seal2 (fromPrim Identity :> fromPrim Identity) else last xs+ in if null xs then seal2 (fromPrim localIdentity :> fromPrim localIdentity) else last xs -commuteTripleFromTree :: (FromPrim p, Commute p)+commuteTripleFromTree :: (FromPrim p, Merge p, PrimPatchBase p) => (FORALL (y z) (p :> p :> p) C(y z) -> t)- -> (WithStartState RepoModel (Tree Prim) C(x) -> t)+ -> (WithStartState RepoModel (Tree (PrimOf p)) C(x) -> t) commuteTripleFromTree handle (WithStartState _ t) = unseal2 handle $ case flattenOne t of@@ -581,7 +231,7 @@ let xs = --traceDoc (greenText "I'm flattening one to get:" $$ showPatch ps) $ getTriples ps in if null xs- then seal2 (fromPrim Identity :> fromPrim Identity :> fromPrim Identity)+ then seal2 (fromPrim localIdentity :> fromPrim localIdentity :> fromPrim localIdentity) else last xs mergePairFromCommutePair :: (Commute p, Invert p)@@ -594,14 +244,14 @@ -- impredicativity problems mean we can't use (.) in the definitions below -mergePairFromTWFP :: (FromPrim p, Commute p, Invert p)+mergePairFromTWFP :: (FromPrim p, Merge p, Invert p, PrimPatchBase p) => (FORALL (y z) (p :\/: p) C(y z) -> t)- -> (WithStartState RepoModel (TreeWithFlattenPos Prim) C(x) -> t)+ -> (WithStartState RepoModel (TreeWithFlattenPos (PrimOf p)) C(x) -> t) mergePairFromTWFP x = commutePairFromTWFP (mergePairFromCommutePair x) -mergePairFromTree :: (FromPrim p, Commute p, Invert p)+mergePairFromTree :: (FromPrim p, Merge p, Invert p, PrimPatchBase p) => (FORALL (y z) (p :\/: p) C(y z) -> t)- -> (WithStartState RepoModel (Tree Prim) C(x) -> t)+ -> (WithStartState RepoModel (Tree (PrimOf p)) C(x) -> t) mergePairFromTree x = commutePairFromTree (mergePairFromCommutePair x) patchFromCommutePair :: (Commute p, Invert p)@@ -609,9 +259,9 @@ -> (FORALL (y z) (p :> p) C(y z) -> t) patchFromCommutePair handle (_ :> b) = handle b -patchFromTree :: (FromPrim p, Commute p, Invert p)+patchFromTree :: (FromPrim p, Merge p, Invert p, PrimPatchBase p) => (FORALL (y z) p C(y z) -> t)- -> (WithStartState RepoModel (Tree Prim) C(x) -> t)+ -> (WithStartState RepoModel (Tree (PrimOf p)) C(x) -> t) patchFromTree x = commutePairFromTree (patchFromCommutePair x) @@ -630,11 +280,8 @@ else do n <- choose (0, num - 1) return $ Sealed $ WithStartState rm $ TWFP n t where -- just used to get the length. In principle this should be independent of the patch type.- flattenOneRP :: Tree Prim C(x) -> Sealed (FL RealPatch C(x))+ flattenOneRP :: Tree Prim C(x) -> Sealed (FL (RealPatch Prim) C(x)) flattenOneRP = flattenOne- shrink (Sealed (WithStartState rm (TWFP n t))) =- [Sealed (WithStartState rm' (TWFP n' t')) | Sealed (WithStartState rm' t') <- shrink (Sealed (WithStartState rm t)),- n' <- [0..n]] getPairs :: FL p C(x y) -> [Sealed2 (p :> p)]@@ -647,122 +294,3 @@ getTriples (_:>:NilFL) = [] getTriples (_:>:_:>:NilFL) = [] getTriples (a:>:b:>:c:>:d) = seal2 (a:>b:>c) : getTriples (b:>:c:>:d)--arbitraryFP :: RepoModel C(x) -> Gen (Sealed (WithEndState (Prim C(x)) RepoModel))-arbitraryFP rm- = do (fp, newcontents) <- arbitraryFilePatchType (rmFileContents rm)- return $ seal $ WithEndState (FP (rmFileName rm) fp) (rebuildRepoModel (rm { rmFileContents = newcontents }))---- Really [B.ByteString] should be parametrised by x y, and the result tuple sealed on y-arbitraryFilePatchType :: [B.ByteString] -> Gen (FilePatchType C(x y), [B.ByteString])-arbitraryFilePatchType contents = oneof [arbitraryHunk contents]--arbitraryHunk :: [B.ByteString] -> Gen (FilePatchType C(x y), [B.ByteString])-arbitraryHunk contents- = sized $ \n ->- do start <- choose (0, min n (length contents))- (removelen, _)- <- frequency $ zip (if start == length contents then [1, 13, 0, 0] else [1, 3, 5, 3])- [return (0, 0)- ,do xa <- choose (0, n)- return (0, xa)- ,do xr <- choose (1, min n (length contents - start))- return (xr, 0)- ,do xr <- choose (1, min n (length contents - start))- xa <- choose (0, n)- return (xr, xa)- ]- addlen <- choose (0, n)- additems <- replicateM addlen (do c <- choose ('a', 'z')- return $ BC.pack [c])- let newcontents = take start contents ++ additems ++ drop (start + removelen) contents- return (Hunk start (take removelen $ drop start $ contents) additems, newcontents)--class Applyable p where- applyPatch :: RepoModel C(x) -> p C(x y) -> RepoModel C(y)--instance Applyable p => Applyable (FL p) where- applyPatch rm NilFL = rm- applyPatch rm (p :>: ps) = applyPatch (applyPatch rm p) ps--instance Applyable RealPatch where- applyPatch rm p = applyPatch rm (effect p)--instance Applyable Prim where- applyPatch (rm@RepoModel { rmFileName = filename, rmFileContents = oldcontents }) (FP filename' fp)- | filename == filename' = rebuildRepoModel (rm { rmFileContents = applyFilePatchType oldcontents fp })- applyPatch rm Identity = rm- applyPatch _ _ = bug "We haven't defined applyPatch on Prim for all patch types."--applyFilePatchType :: [B.ByteString] -> FilePatchType C(x y) -> [B.ByteString]-applyFilePatchType oldcontents (Hunk n old new)- = if take (length old) (drop n oldcontents) == old- then take n oldcontents ++ new ++ drop (n + length old) oldcontents- else error "Bad patch context"-applyFilePatchType _ _ = bug "We haven't defined applyFilePatchType for all patch types."--packStringLetters :: String -> [B.ByteString]-packStringLetters = map (BC.pack . (:[]))--realPatchLoopExamples :: [Sealed (WithStartState RepoModel (Tree Prim))]-realPatchLoopExamples =- [Sealed (WithStartState (RepoModel { rmFileName = fx, rmFileContents = [] })- $ canonizeTree- (ParTree- (SeqTree (FP fx (Hunk 0 [] (packStringLetters "pkotufogbvdabnmbzajvolwviqebieonxvcvuvigkfgybmqhzuaaurjspd")))- (ParTree- (SeqTree (FP fx (Hunk 46 (packStringLetters "qhzu") (packStringLetters "zafybdcokyjskcgnvhkbzpysaafnjjhcstgrczplxsfwagmh")))- (ParTree- (ParTree- NilTree- (ParTree- (ParTree- (ParTree- (SeqTree (FP fx (Hunk 14 (packStringLetters "mbzajvolwviqebieonxvcvuvigkfgyb") (packStringLetters "vujnxnhvybvpouyciaabszfmgssezlwwjgnethvrpnfrkubphzvdgymjjoacppqps")))- (ParTree- NilTree- (ParTree- (SeqTree (FP fx (Hunk 39 (packStringLetters "ssezlwwjgnethvrpnfrkubphzvdgymjjoacppqpsmzafybdcokyjskcgnvhkbz") (packStringLetters "wnesidpccwoiqiichxaaejdsyrhrusqljlcoro")))- (ParTree- (ParTree- (SeqTree (FP fx (Hunk 11 (packStringLetters "abnvujnxnhvybvpouyciaabszfmgwnesidpccwoiqii") (packStringLetters "czfdhqkipdstfjycqaxwnbxrihrufdeyneqiiiafwzlmg"))) NilTree)- NilTree)- NilTree))- (SeqTree (FP fx (Hunk 24 [] (packStringLetters "dihgmsotezucqdgxczvcivijootyvhlwymbiueufnvpwpeukmskqllalfe"))) NilTree))))- (SeqTree (FP fx (Hunk 55 (packStringLetters "yjskcgnvhkbzpysaafnjjhcstgrczplxsfwagmhaaurjsp") (packStringLetters "xldhrutyhcyaqeezwujiguawfyawjjqlirxshjddvq"))) NilTree))- (SeqTree (FP fx (Hunk 19 [] (packStringLetters "ooygwiyogqrqnytixqtmvdxx")))- (SeqTree (FP fx (Hunk 25 (packStringLetters "yogqrqnytixqtmvdxxvolwviqebieonxvcvuvigkfgybmzafybdcokyjskcgnvhkbz") (packStringLetters "akhsmlbkdxnvfoikmiatfbpzdrsyykkpoxvvddeaspzxe")))- (SeqTree (FP fx (Hunk 38 [] (packStringLetters "ji")))- (ParTree- NilTree- (ParTree- NilTree- (ParTree- (ParTree- NilTree- (SeqTree (FP fx (Hunk 25 (packStringLetters "akhsmlbkdxnvfjioikmiatfbpzdrsyykkpoxvvddeaspzxepysaafnjjhcstgrczplxs") (packStringLetters "onjbhddskcj")))- (SeqTree (FP fx (Hunk 38 [] (packStringLetters "fyscunxxxjjtyqpfxeznhtwvlphmp"))) NilTree)))- (ParTree- NilTree- (SeqTree (FP fx (Hunk 43 [] (packStringLetters "xcchzwmzoezxkmkhcmesplnjpqriypshgiqklgdnbmmkldnydiy")))- (ParTree- NilTree- (SeqTree (FP fx (Hunk 63 (packStringLetters "plnjpqriypshgiqklgdnbmmkldnydiymiatfbpzdrsyykkpoxvvddeaspzxepysaafn") (packStringLetters "anjlzfdqbjqbcplvqvkhwjtkigp"))) NilTree)))))))))))- (ParTree- NilTree- NilTree)))- NilTree))- NilTree))- (ParTree- NilTree- (SeqTree (FP fx (Hunk 0 [] (packStringLetters "ti")))- (SeqTree (FP fx (Hunk 0 (packStringLetters "t") (packStringLetters "ybcop")))- (SeqTree (FP fx (Hunk 1 [] (packStringLetters "dvlhgwqlpaeweerqrhnjtfolczbqbzoccnvdsyqiefqitrqneralf")))- (SeqTree (FP fx (Hunk 14 [] (packStringLetters "yairbjphwtnaerccdlfewujvjvmjakbc")))- (SeqTree (FP fx (Hunk 50 [] (packStringLetters "xayvfuwaiiogginufnhsrmktpmlbvxiakjwllddkiyofyfw")))- (ParTree- NilTree- NilTree)))))))))]--fx :: FileName-fx = fp2fn "./F"
+ src/Darcs/Test/Patch/RepoModel.hs view
@@ -0,0 +1,291 @@+{-# LANGUAGE CPP #-}++#include "gadts.h"++-- | Repository model+module Darcs.Test.Patch.RepoModel+ ( module Storage.Hashed.AnchoredPath+ , RepoModel, repoTree+ , RepoItem, File, Dir, Content+ , makeRepo, emptyRepo+ , makeFile, emptyFile+ , emptyDir+ , nullRepo+ , isFile, isDir+ , fileContent, dirContent+ , isEmpty+ , root+ , filterFiles, filterDirs+ , find+ , list+ , ap2fp+ , applyPatch+ , aFilename, aDirname+ , aLine, aContent+ , aFile, aDir+ , aRepo, aSmallRepo+ ) where+++import Darcs.Test.Util.QuickCheck ( alpha, uniques, bSized )++import Darcs.Patch.Apply( Apply(..), applyToTree )+import Darcs.Witnesses.Sealed ( Sealed, seal )+import Darcs.Witnesses.Show++import Storage.Hashed.AnchoredPath+import Storage.Hashed.Tree( Tree, TreeItem )+import Storage.Hashed.Darcs ( darcsUpdateHashes )+import qualified Storage.Hashed.Tree as T++import Control.Applicative ( (<$>) )+import Control.Arrow ( second )+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BLC+import Data.List ( intercalate )+import qualified Data.Map as M+import Data.Maybe ( fromJust )+import Test.QuickCheck+ ( Arbitrary(..)+ , Gen, choose, vectorOf, frequency )++++----------------------------------------------------------------------+-- * Model definition++-- | A repository is an abstraction build in top of a 'Tree'.+-- NB: Repository preferences are not supported yet.+newtype RepoModel C(x) = RepoModel {+ repoTree :: Tree Maybe+ }++-- | Repository items may be text files or directories.+-- NB: Binary files are not supported yet.+newtype RepoItem = RepoItem {+ treeItem :: TreeItem Maybe+ }++type File = RepoItem+type Dir = RepoItem++type Content = [B.ByteString]++----------------------------------------+-- Instances++instance Show (RepoModel C(x)) where+ show repo = "RepoModel{ " + ++ intercalate " " (map showEntry $ list repo)+ ++ " }"+ where+ showPath = show . flatten+ showContent content = "[" ++ intercalate " " (map show content) ++ "]"+ showEntry (path,item)+ | isDir item = showPath path+ | isFile item = showPath path ++ showContent (fileContent item)++instance Show1 RepoModel where+ showDict1 = ShowDictClass++----------------------------------------+-- Utils++bs2lbs :: B.ByteString -> BL.ByteString+bs2lbs bs = BL.fromChunks [bs]++lbs2bs :: BL.ByteString -> B.ByteString+lbs2bs = B.concat . BL.toChunks++content2lbs :: Content -> BL.ByteString+content2lbs = BLC.unlines . map bs2lbs++lbs2content :: BL.ByteString -> Content+lbs2content = map lbs2bs . BLC.lines++----------------------------------------------------------------------+-- ** Path conversion++ap2fp :: AnchoredPath -> FilePath+ap2fp = anchorPath ""++----------------------------------------------------------------------+-- * Constructors++makeRepo :: [(Name, RepoItem)] -> RepoModel C(x)+makeRepo = RepoModel . T.makeTree . map (second treeItem)++emptyRepo :: RepoModel C(x)+emptyRepo = RepoModel T.emptyTree++makeFile :: Content -> File+makeFile = RepoItem . T.File . T.makeBlob . content2lbs++emptyFile :: File+emptyFile = RepoItem $ T.File T.emptyBlob++emptyDir :: Dir+emptyDir = RepoItem $ T.SubTree T.emptyTree++----------------------------------------------------------------------+-- * Queries++nullRepo :: RepoModel C(x) -> Bool+nullRepo = M.null . T.items . repoTree++isFile :: RepoItem -> Bool+isFile (RepoItem (T.File _)) = True+isFile _other = False++isDir :: RepoItem -> Bool+isDir (RepoItem (T.SubTree _)) = True+isDir _other = False++fileContent :: File -> Content+fileContent (RepoItem (T.File blob)) + = case T.readBlob blob of+ Nothing -> error "fileContent: No content."+ Just c -> lbs2content c+fileContent _other+ = error "fileContent: Not a file."++dirContent :: Dir -> [(Name, RepoItem)]+dirContent (RepoItem (T.SubTree subtree)) + = map (second RepoItem) $ M.toList $ T.items subtree+dirContent _other+ = error "dirContent: Not a directory."++-- | @isEmpty file@ <=> file content is empty+-- @isEmpty dir@ <=> dir has no child+isEmpty :: RepoItem -> Bool+isEmpty item+ | isFile item = null $ fileContent item+ | isDir item = null $ dirContent item+ | otherwise = undefined++-- | The root directory of a repository.+root :: RepoModel C(x) -> Dir+root = RepoItem . T.SubTree . repoTree++find :: RepoModel C(x) -> AnchoredPath -> Maybe RepoItem+find (RepoModel tree) path = RepoItem <$> T.find tree path++-- | List repository items.+-- NB: It does not include the root directory.+list :: RepoModel C(x) -> [(AnchoredPath, RepoItem)]+list (RepoModel tree) = map (second RepoItem) $ T.list tree++----------------------------------------------------------------------+-- ** Filtering++filterFiles :: [(n, RepoItem)] -> [(n, File)]+filterFiles = filter (isFile . snd)++filterDirs :: [(n, RepoItem)] -> [(n, Dir)]+filterDirs = filter (isDir . snd)++----------------------------------------------------------------------+-- * Comparing repositories++diffRepos :: RepoModel C(x) -> RepoModel C(y) -> (RepoModel C(u), RepoModel C(v))+diffRepos repo1 repo2 = + let Just (diff1,diff2) = T.diffTrees hashedTree1 hashedTree2+ in (RepoModel diff1, RepoModel diff2)+ where+ hashedTree1 = fromJust $ darcsUpdateHashes $ repoTree repo1+ hashedTree2 = fromJust $ darcsUpdateHashes $ repoTree repo2+++instance Eq (RepoModel C(x)) where+ repo1 == repo2 = let (diff1,diff2) = diffRepos repo1 repo2+ in nullRepo diff1 && nullRepo diff2++----------------------------------------------------------------------+-- * Patch application++applyPatch :: Apply p => p C(x y) -> RepoModel C(x) -> Maybe (RepoModel C(y))+applyPatch patch (RepoModel tree) + = RepoModel <$> applyToTree patch tree++----------------------------------------------------------------------+-- * QuickCheck generators++-- Testing code assumes that aFilename and aDirname generators +-- will always be able to generate a unique name given a list of+-- existing names. This should be OK as long as the number of possible+-- file/dirnames is much bigger than the number of files/dirs per repository.++-- 'Arbitrary' 'RepoModel' instance is based on the 'aSmallRepo' generator.+++-- | Files are distinguish by ending their names with ".txt".+aFilename :: Gen Name+aFilename = do len <- choose (1,maxLength)+ name <- vectorOf len alpha+ return $ makeName (name ++ ".txt")+ where+ maxLength = 3++aDirname :: Gen Name+aDirname = do len <- choose (1,maxLength)+ name <- vectorOf len alpha+ return $ makeName name+ where+ maxLength = 3++aWord :: Gen B.ByteString+aWord = do c <- alpha+ return $ BC.pack[c]++aLine :: Gen B.ByteString+aLine = do wordsNo <- choose (1,2)+ ws <- vectorOf wordsNo aWord+ return $ BC.unwords ws++aContent :: Gen Content+aContent = bSized 0 0.5 80 $ \k ->+ do n <- choose (0,k)+ vectorOf n aLine++aFile :: Gen File+aFile = makeFile <$> aContent++-- | See 'aRepo', the same applies for 'aDir'.+aDir :: Int -- ^ Maximum number of files+ -> Int -- ^ Maximum number of directories+ -> Gen Dir+aDir filesL dirL = root <$> aRepo filesL dirL++-- | @aRepo filesNo dirsNo@ produces repositories with *at most* +-- @filesNo@ files and @dirsNo@ directories. +-- The structure of the repository is aleatory.+aRepo :: Int -- ^ Maximum number of files+ -> Int -- ^ Maximum number of directories+ -> Gen (RepoModel C(x))+aRepo maxFiles maxDirs+ = do let minFiles = if maxDirs == 0 && maxFiles > 0 then 1 else 0+ filesNo <- choose (minFiles,maxFiles)+ let minDirs = if filesNo == 0 && maxDirs > 0 then 1 else 0+ dirsNo <- choose (minDirs,maxDirs)+ -- NB: Thanks to laziness we don't need to care about division by zero+ -- since if dirsNo == 0 then neither filesPerDirL nor subdirsPerDirL will+ -- be evaluated.+ let filesPerDirL = (maxFiles-filesNo) `div` dirsNo+ subdirsPerDirL = (maxDirs-dirsNo) `div` dirsNo+ files <- vectorOf filesNo aFile+ filenames <- uniques filesNo aFilename+ dirs <- vectorOf dirsNo (aDir filesPerDirL subdirsPerDirL)+ dirnames <- uniques dirsNo aDirname+ return $ makeRepo (filenames `zip` files ++ dirnames `zip` dirs)++-- | Generate small repositories.+-- Small repositories help generating (potentially) conflicting patches.+aSmallRepo :: Gen (RepoModel C(x))+aSmallRepo = do filesNo <- frequency [(3, return 1), (1, return 2)]+ dirsNo <- frequency [(3, return 1), (1, return 0)]+ aRepo filesNo dirsNo++instance Arbitrary (Sealed RepoModel) where+ arbitrary = seal <$> aSmallRepo
src/Darcs/Test/Patch/Test.hs view
@@ -15,34 +15,20 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp -fno-warn-deprecations -fglasgow-exts -fno-warn-orphans #-}-{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-} #include "gadts.h" module Darcs.Test.Patch.Test- ( propReadShow,- propInverseComposition, propCommuteTwice,- propInverseValid, propOtherInverseValid,- propCommuteEquivalency, propCommuteEitherOrder,- propCommuteEitherWay, propMergeIsCommutableAndCorrect,- propMergeIsSwapable, propMergeValid,- propUnravelThreeMerge, propUnravelSeqMerge,- propUnravelOrderIndependent,- propSimpleSmartMergeGoodEnough,- propElegantMergeGoodEnough,- propPatchAndInverseIsIdentity,- quickmerge, checkPatch, checkAPatch, verboseCheckAPatch,- propResolveConflictsValid,- testPatch, propCommuteInverse,- subcommutesInverse, subcommutesNontrivialInverse,- subcommutesFailure,- join_patches+ (+ Check, checkPatch, checkAPatch, verboseCheckAPatch ) where import Prelude hiding ( pi ) import System.IO.Unsafe ( unsafePerformIO ) import Test.QuickCheck+import Control.Applicative import Control.Monad ( liftM, liftM2, liftM3, liftM4, replicateM ) import Darcs.Patch.Info ( PatchInfo, patchinfo )@@ -59,102 +45,144 @@ import Darcs.Patch.FileName ( fn2fp ) import qualified Data.Map as M ( mapMaybe ) -import Darcs.Patch.Patchy ( Commute )-import Darcs.Patch ( addfile, adddir, move, showPatch,- hunk, tokreplace, joinPatches, binary,- changepref, isMerger, invert, commute, merge,- readPatch, resolveConflicts,- effect, fromPrims,- elegantMerge )-import Darcs.Patch.Core ( Patch(..) )-import Darcs.Patch.Commute ( unravel, merger )-import Darcs.Patch.Prim ( Prim(..), DirPatchType(..), FilePatchType(..),- CommuteFunction, Perhaps(..),- subcommutes )-import Printer ( renderPS )+import Darcs.Patch ( addfile, adddir, move,+ hunk, tokreplace, binary,+ changepref, invert, merge,+ effect )+import Darcs.Patch.Invert ( Invert )+import Darcs.Patch.V1 ()+import qualified Darcs.Patch.V1.Core as V1 ( Patch(..) )+import Darcs.Patch.V1.Core ( isMerger )+import Darcs.Patch.Prim.V1 ()+import Darcs.Patch.Prim.V1.Core ( Prim(..), DirPatchType(..), FilePatchType(..) ) import Darcs.Witnesses.Ordered-import Darcs.Witnesses.Sealed ( Sealed(Sealed), unsafeUnseal, unseal )+import Darcs.Witnesses.Sealed ( Sealed(Sealed), unseal, mapSeal, Sealed2(..) )+import Darcs.Witnesses.Unsafe #include "impossible.h" -instance Eq Patch where- x == y = IsEq == (x =\/= y)+type Patch = V1.Patch Prim -instance Eq Prim where- x == y = IsEq == (x =\/= y)+class ArbitraryP p where+ arbitraryP :: Gen (Sealed (p C(x))) -instance (Commute a, MyEq a) => Eq (FL a) where- x == y = IsEq == (x =\/= y)+{-+TODO: there is a lot of overlap in testing between between this module+and Darcs.Test.Patch.QuickCheck -instance Arbitrary Patch where- arbitrary = sized arbpatch--- coarbitrary p = coarbitrary (show p)+This module tests Prim and V1 patches, and Darcs.Test.Patch.QuickCheck+tests Prim and V2 patches -instance Arbitrary Prim where- arbitrary = onepatchgen--- coarbitrary = impossible+This module's generator covers a wider set of patch types, but is less+likely to generate conflicts than Darcs.Test.Patch.QuickCheck. -hunkgen :: Gen Prim+Until this is cleaned up, we take some care that the Arbitrary instances+do not overlap and are only used for tests from the respective+modules.++(There are also tests in other modules that probably depend on the+Arbitrary instances in this module.)+-}++instance Arbitrary (Sealed (Prim C(x))) where+ arbitrary = arbitraryP++instance Arbitrary (Sealed (FL Patch C(x))) where+ arbitrary = arbitraryP++instance Arbitrary (Sealed2 (Prim :> Prim)) where+ arbitrary = unseal Sealed2 <$> arbitraryP++instance Arbitrary (Sealed2 (FL Patch)) where+ arbitrary = unseal Sealed2 <$> arbitraryP++instance Arbitrary (Sealed2 (FL Patch :\/: FL Patch)) where+ arbitrary = unseal Sealed2 <$> arbitraryP++instance Arbitrary (Sealed2 (FL Patch :> FL Patch)) where+ arbitrary = unseal Sealed2 <$> arbitraryP++instance Arbitrary (Sealed2 (FL Patch :> FL Patch :> FL Patch)) where+ arbitrary = unseal Sealed2 <$> arbitraryP+++instance (ArbitraryP p1, ArbitraryP p2) => ArbitraryP (p1 :> p2) where+ arbitraryP = do Sealed p1 <- arbitraryP+ Sealed p2 <- arbitraryP+ return (Sealed (p1 :> p2))++instance (ArbitraryP p1, ArbitraryP p2) => ArbitraryP (p1 :\/: p2) where+ arbitraryP = do Sealed p1 <- arbitraryP+ Sealed p2 <- arbitraryP+ return (Sealed (unsafeCoercePEnd p1 :\/: p2))++instance ArbitraryP (FL Patch) where+ arbitraryP = sized arbpatch++instance ArbitraryP Prim where+ arbitraryP = onepatchgen++hunkgen :: Gen (Sealed (Prim C(x))) hunkgen = do i <- frequency [(1,choose (0,5)),(1,choose (0,35)), (2,return 0),(3,return 1),(2,return 2),(1,return 3)] j <- frequency [(1,choose (0,5)),(1,choose (0,35)), (2,return 0),(3,return 1),(2,return 2),(1,return 3)] if i == 0 && j == 0 then hunkgen- else liftM4 hunk filepathgen linenumgen+ else Sealed <$>+ liftM4 hunk filepathgen linenumgen (replicateM i filelinegen) (replicateM j filelinegen) -tokreplacegen :: Gen Prim+tokreplacegen :: Gen (Sealed (Prim C(x))) tokreplacegen = do f <- filepathgen o <- tokengen n <- tokengen if o == n- then return $ tokreplace f "A-Za-z" "old" "new"- else return $ tokreplace f "A-Za-z_" o n+ then return $ Sealed $ tokreplace f "A-Za-z" "old" "new"+ else return $ Sealed $ tokreplace f "A-Za-z_" o n -twofilegen :: (FilePath -> FilePath -> Prim) -> Gen Prim+twofilegen :: (FORALL(y) FilePath -> FilePath -> Prim C(x y)) -> Gen (Sealed (Prim C(x))) twofilegen p = do n1 <- filepathgen n2 <- filepathgen- if n1 /= n2 && (checkAPatch $ fromPrims $ (p n1 n2 :>: NilFL))- then return $ p n1 n2+ if n1 /= n2 && checkAPatch (p n1 n2)+ then return $ Sealed $ p n1 n2 else twofilegen p -chprefgen :: Gen Prim+chprefgen :: Gen (Sealed (Prim C(x))) chprefgen = do f <- oneof [return "color", return "movie"] o <- tokengen n <- tokengen- if o == n then return $ changepref f "old" "new"- else return $ changepref f o n+ if o == n then return $ Sealed $ changepref f "old" "new"+ else return $ Sealed $ changepref f o n -simplepatchgen :: Gen Prim-simplepatchgen = frequency [(1,liftM addfile filepathgen),- (1,liftM adddir filepathgen),- (1,liftM3 binary filepathgen arbitrary arbitrary),+simplepatchgen :: Gen (Sealed (Prim C(x)))+simplepatchgen = frequency [(1,liftM (Sealed . addfile) filepathgen),+ (1,liftM (Sealed . adddir) filepathgen),+ (1,liftM3 (\x y z -> Sealed (binary x y z)) filepathgen arbitrary arbitrary), (1,twofilegen move), (1,tokreplacegen), (1,chprefgen), (7,hunkgen) ] -onepatchgen :: Gen Prim-onepatchgen = oneof [simplepatchgen, (invert) `fmap` simplepatchgen]+onepatchgen :: Gen (Sealed (Prim C(x)))+onepatchgen = oneof [simplepatchgen, mapSeal (invert . unsafeCoerceP) `fmap` simplepatchgen] -norecursgen :: Int -> Gen Patch-norecursgen 0 = PP `fmap` onepatchgen-norecursgen n = oneof [PP `fmap` onepatchgen,flatcompgen n]+norecursgen :: Int -> Gen (Sealed (FL Patch C(x)))+norecursgen 0 = mapSeal (\p -> V1.PP p :>: NilFL) `fmap` onepatchgen+norecursgen n = oneof [mapSeal (\p -> V1.PP p :>: NilFL) `fmap` onepatchgen,flatcompgen n] -arbpatch :: Int -> Gen Patch-arbpatch 0 = PP `fmap` onepatchgen-arbpatch n = frequency [(3,PP `fmap` onepatchgen),- -- (1,compgen n),+arbpatch :: Int -> Gen (Sealed (FL Patch C(x)))+arbpatch 0 = mapSeal (\p -> V1.PP p :>: NilFL) `fmap` onepatchgen+arbpatch n = frequency [(3,mapSeal (\p -> V1.PP p :>: NilFL) `fmap` onepatchgen), (2,flatcompgen n), (0,rawMergeGen n), (0,mergegen n),- (1,PP `fmap` onepatchgen)+ (1,mapSeal (\p -> V1.PP p :>: NilFL) `fmap` onepatchgen) ] -- | Generate an arbitrary list of at least one element@@ -164,36 +192,27 @@ as <- arbitrary return (a:as) -join_patches :: [Patch] -> Patch-join_patches = joinPatches . unsafeFL- where- unsafeFL :: [a] -> FL a- unsafeFL [] = NilFL- unsafeFL (a:as) = a :>: unsafeFL as--rawMergeGen :: Int -> Gen Patch-rawMergeGen n = do p1 <- arbpatch len- p2 <- arbpatch len- if (checkAPatch $ join_patches [invert p1,p2]) &&- (checkAPatch $ join_patches [invert p2,p1])+rawMergeGen :: Int -> Gen (Sealed (FL Patch C(x)))+rawMergeGen n = do Sealed p1 <- arbpatch len+ Sealed p2 <- arbpatch len+ if checkAPatch (invert p1:>:p2:>:NilFL) &&+ checkAPatch (invert p2:>:p1:>:NilFL) then case merge (p2 :\/: p1) of- _ :/\: p2' -> return p2'+ _ :/\: p2' -> return (Sealed (unsafeCoercePStart p2')) else rawMergeGen n where len = if n < 15 then n`div`3 else 3 -mergegen :: Int -> Gen Patch+mergegen :: Int -> Gen (Sealed (FL Patch C(x))) mergegen n = do- p1 <- norecursgen len- p2 <- norecursgen len- if (checkAPatch $ join_patches [invert p1,p2]) &&- (checkAPatch $ join_patches [invert p2,p1])+ Sealed p1 <- norecursgen len+ Sealed p2 <- norecursgen len+ if checkAPatch (invert p1:>:p2:>:NilFL) &&+ checkAPatch (invert p2:>:p1:>:NilFL) then case merge (p2:\/:p1) of- p1' :/\: p2' ->- if checkAPatch $ join_patches [p1,p2']- then return $ join_patches [p1,p2']- else return $ join_patches [PP $ addfile "Error_in_mergegen",- PP $ addfile "Error_in_mergegen",- p1,p2,p1',p2']+ _ :/\: p2' ->+ if checkAPatch (p1+>+p2')+ then return $ Sealed $ p1+>+p2'+ else impossible else mergegen n where len = if n < 15 then n`div`3 else 3 @@ -206,39 +225,22 @@ instance Arbitrary PatchInfo where arbitrary = arbpi--- coarbitrary pi = coarbitrary (show pi) instance Arbitrary B.ByteString where arbitrary = liftM BC.pack arbitrary--- coarbitrary ps = coarbitrary (unpackPS ps) -{--plistgen :: Int -> Int -> Gen [Patch]-plistgen s n- | n <= 0 = return []- | otherwise = do- next <- arbpatch s- rest <- plistgen s (n-1)- return $ next : rest--compgen :: Int -> Gen Patch-compgen n = do- size <- choose (0,n)- myp <- liftM join_patches $ plistgen size ((n+1) `div` (size+1))--- here I assume we only want to consider valid patches...- if checkAPatch myp- then return myp- else compgen n--}--flatlistgen :: Int -> Gen [Patch]-flatlistgen n = replicateM n (PP `fmap` onepatchgen)+flatlistgen :: Int -> Gen (Sealed (FL Patch C(x)))+flatlistgen 0 = return $ Sealed NilFL+flatlistgen n = do Sealed x <- onepatchgen+ Sealed xs <- flatlistgen (n-1)+ return (Sealed (V1.PP x :>: xs)) -flatcompgen :: Int -> Gen Patch+flatcompgen :: Int -> Gen (Sealed (FL Patch C(x))) flatcompgen n = do- myp <- liftM (join_patches . regularizePatches) $ flatlistgen n+ Sealed ps <- flatlistgen n+ let myp = regularizePatches $ ps if checkAPatch myp- then return myp+ then return $ Sealed myp else flatcompgen n -- resize to size 25, that means we'll get line numbers no greater@@ -284,297 +286,63 @@ (1,map fromSafeChar `fmap` arbitrary), (1,liftM2 (\a b-> a++"/"++b) filepathgen filepathgen) ] -{--instance Arbitrary Char where- arbitrary = oneof $ map return- (['a'..'z']++['A'..'Z']++['1'..'9']++['0','~','.',',','-','/'])--}--- coarbitrary c = coarbitrary (ord c)--checkPatch :: Patch -> PatchCheck Bool-checkAPatch :: Patch -> Bool-checkAPatch p = doCheck $ do checkPatch p- checkPatch $ invert p-verboseCheckAPatch :: Patch -> Bool-verboseCheckAPatch p = doVerboseCheck $ do checkPatch p- checkPatch $ invert p--checkPatch p | isMerger p = do- checkPatch $ fromPrims $ effect p-checkPatch (Merger _ _ _ _) = impossible-checkPatch (Regrem _ _ _ _) = impossible-checkPatch (ComP NilFL) = isValid-checkPatch (ComP (p:>:ps)) =- checkPatch p >> checkPatch (ComP ps)-checkPatch (PP Identity) = isValid-checkPatch (PP (Split NilFL)) = isValid-checkPatch (PP (Split (p:>:ps))) =- checkPatch (PP p) >> checkPatch (PP (Split ps))--checkPatch (PP (FP f RmFile)) = removeFile $ fn2fp f-checkPatch (PP (FP f AddFile)) = createFile $ fn2fp f-checkPatch (PP (FP f (Hunk line old new))) = do- fileExists $ fn2fp f- mapM_ (deleteLine (fn2fp f) line) old- mapM_ (insertLine (fn2fp f) line) (reverse new)- isValid-checkPatch (PP (FP f (TokReplace t old new))) =- modifyFile (fn2fp f) (tryTokPossibly t old new)--- note that the above isn't really a sure check, as it leaves PSomethings--- and PNothings which may have contained new...-checkPatch (PP (FP f (Binary o n))) = do- fileExists $ fn2fp f- mapM_ (deleteLine (fn2fp f) 1) (linesPS o)- fileEmpty $ fn2fp f- mapM_ (insertLine (fn2fp f) 1) (reverse $ linesPS n)- isValid--checkPatch (PP (DP d AddDir)) = createDir $ fn2fp d-checkPatch (PP (DP d RmDir)) = removeDir $ fn2fp d--checkPatch (PP (Move f f')) = checkMove (fn2fp f) (fn2fp f')-checkPatch (PP (ChangePref _ _ _)) = return True--regularizePatches :: [Patch] -> [Patch]-regularizePatches patches = rpint [] patches- where rpint ok_ps [] = ok_ps- rpint ok_ps (p:ps) =- if checkAPatch (join_patches $ p:ok_ps)- then rpint (p:ok_ps) ps- else rpint ok_ps ps--propInverseComposition :: Patch -> Patch -> Bool-propInverseComposition p1 p2 =- invert (join_patches [p1,p2]) == join_patches [invert p2, invert p1]-propInverseValid :: Patch -> Bool-propInverseValid p1 = checkAPatch $ join_patches [invert p1,p1]-propOtherInverseValid :: Patch -> Bool-propOtherInverseValid p1 = checkAPatch $ join_patches [p1,invert p1]--propCommuteTwice :: Patch -> Patch -> Property-propCommuteTwice p1 p2 =- (doesCommute p1 p2) ==> (Just (p1:>p2) == (commute (p1:>p2) >>= commute))-doesCommute :: Patch -> Patch -> Bool-doesCommute p1 p2 =- commute (p1:>p2) /= Nothing && (checkAPatch $ join_patches [p1,p2])-propCommuteEquivalency :: Patch -> Patch -> Property-propCommuteEquivalency p1 p2 =- (doesCommute p1 p2) ==>- case commute (p1:>p2) of- Just (p2':>p1') -> checkAPatch $ join_patches [p1,p2,invert p1',invert p2']- _ -> impossible--propCommuteEitherWay :: Patch -> Patch -> Property-propCommuteEitherWay p1 p2 =- doesCommute p1 p2 ==> doesCommute (invert p2) (invert p1)--propCommuteEitherOrder :: Patch -> Patch -> Patch -> Property-propCommuteEitherOrder p1 p2 p3 =- checkAPatch (join_patches [p1,p2,p3]) &&- doesCommute p1 (join_patches [p2,p3]) &&- doesCommute p2 p3 ==>- case commute (p1:>p2) of- Nothing -> False- Just (p2':>p1') ->- case commute (p1':>p3) of- Nothing -> False- Just (p3':>_) ->- case commute (p2':>p3') of- Nothing -> False- Just (p3'' :> _) ->- case commute (p2:>p3) of- Nothing -> False- Just (p3'a:>_) ->- case commute (p1:>p3'a) of- Just (p3''a:>_) -> p3''a == p3''- Nothing -> False--propPatchAndInverseIsIdentity :: Patch -> Patch -> Property-propPatchAndInverseIsIdentity p1 p2 =- (checkAPatch $ join_patches [p1,p2]) && (commute (p1:>p2) /= Nothing) ==>- case commute (p1:>p2) of- Just (p2':>_) -> case commute (invert p1:>p2') of- Nothing -> True -- This is a subtle distinction.- Just (p2'':>_) -> p2'' == p2- Nothing -> impossible--quickmerge :: (Patch :\/: Patch) -> Patch-quickmerge (p1:\/:p2) = case merge (p1:\/:p2) of- _ :/\: p1' -> p1'--propMergeIsCommutableAndCorrect :: Patch -> Patch -> Property-propMergeIsCommutableAndCorrect p1 p2 =- (checkAPatch $ join_patches [invert p1,p2]) ==>- case merge (p2:\/:p1) of- p1' :/\: p2' ->- case commute (p1:>p2') of- Nothing -> False- Just (p2'':>p1'') -> p2'' == p2 && p1' == p1''-propMergeIsSwapable :: Patch -> Patch -> Property-propMergeIsSwapable p1 p2 =- (checkAPatch $ join_patches [invert p1,p2]) ==>- case merge (p2:\/:p1) of- p1' :/\: p2' ->- case merge (p1:\/:p2) of- p2''' :/\: p1''' -> p1' == p1''' && p2' == p2'''--propMergeValid :: Patch -> Patch -> Property-propMergeValid p1 p2 =- (checkAPatch $ join_patches [invert p1,p2]) ==>- case merge (p2:\/:p1) of- _ :/\: p2' ->- checkAPatch $ join_patches [invert p1,p2,invert p2,p1,p2']--propSimpleSmartMergeGoodEnough :: Patch -> Patch -> Property-propSimpleSmartMergeGoodEnough p1 p2 =- (checkAPatch $ join_patches [invert p1,p2]) ==>- smartMerge (p2:\/:p1) == simpleSmartMerge (p2:\/:p1)--smartMerge :: (Patch :\/: Patch) -> Maybe (Patch :< Patch)-smartMerge (p1 :\/: p2) =- case simpleSmartMerge (p1:\/:p2) of- Nothing -> Nothing- Just (p1'a:<p2a) ->- case simpleSmartMerge (p2 :\/: p1) of- Nothing -> Nothing- Just (x:<y) ->- case commute (y:>x) of- Nothing -> Nothing- Just (p2b :> p1'b) ->- if p1'a == p1'b && p2a == p2b && p2a == p2- then Just (p1'a :< p2)- else Nothing-simpleSmartMerge :: (Patch :\/: Patch) -> Maybe (Patch :< Patch)-simpleSmartMerge (p1 :\/: p2) =- case commute (invert p2 :> p1) of- Just (p1':>_) ->- case commute (p2:>p1') of- Just (p1o:>_) ->- if p1o == p1 then Just (p1' :< p2)- else Nothing- Nothing -> Nothing- Nothing -> Nothing--propElegantMergeGoodEnough :: Patch -> Patch -> Property-propElegantMergeGoodEnough p1 p2 =- (checkAPatch $ join_patches [invert p1,p2]) ==>- (fst' `fmap` smartMerge (p2:\/:p1)) ==- (snd'' `fmap` elegantMerge (p2:\/:p1))--fst' :: p :< p -> p-fst' (x:<_) = x--snd'' :: q :/\: p -> p-snd'' (_:/\:x) = x--instance Eq p => Eq (p :< p) where- (x:<y) == (x':<y') = x == x' && y == y'--instance Eq p => Eq (p :> p) where- (x:>y) == (x':>y') = x == x' && y == y'+class Check p where+ checkPatch :: p C(x y) -> PatchCheck Bool -instance Show p => Show (p :< p) where- show (x :< y) = show x ++ " :< " ++ show y+instance Check p => Check (FL p) where+ checkPatch NilFL = isValid+ checkPatch (p :>: ps) = checkPatch p >> checkPatch ps -instance Show p => Show (p :> p) where- show (x :> y) = show x ++ " :> " ++ show y+checkAPatch :: (Invert p, Check p) => p C(x y) -> Bool+checkAPatch p = doCheck $ do _ <- checkPatch p+ checkPatch $ invert p -testPatch :: String-testPatch = testStr ++ testNote-tp1, tp2 :: Patch-tp1 = unsafeUnseal . fst . fromJust . readPatch $ BC.pack "\nmove ./test/test ./hello\n"-tp2 = unsafeUnseal . fst . fromJust . readPatch $ BC.pack "\nmove ./test ./hello\n"-tp1', tp2' :: Patch-tp2' = quickmerge (tp2:\/:tp1)-tp1' = quickmerge (tp1:\/:tp2)-testNote :: String-testNote = (if commute (tp1:>tp2') == Just (tp2:>tp1')- then "At least they commutex right.\n"- else "Argh! they don't even commutex right.\n")- ++(if checkAPatch $ tp2- then "tp2 itself is valid!\n"- else "Oh my! tp2 isn't even valid!\n")- ++(if checkAPatch $ tp2'- then "tp2' itself is valid!\n"- else "Aaack! tp2' itself is invalid!\n")- ++(if checkAPatch $ join_patches [tp1, tp2']- then "Valid merge tp2'!\n"- else "Bad merge tp2'!\n")- ++ (if checkAPatch $ join_patches [tp2, tp1']- then "Valid merge tp1'!\n"- else "Bad merge tp1'!\n")- ++ (if checkAPatch $ join_patches [tp2,tp1',invert tp2',invert tp1]- then "Both agree!\n"- else "The two merges don't agree!\n")- ++ (if checkAPatch $ join_patches [invert tp2, tp1]- then "They should be mergable!\n"- else "Wait a minute, these guys can't be merged!\n")-tp :: Patch-tp = tp1'+verboseCheckAPatch :: (Invert p, Check p) => p C(x y) -> Bool+verboseCheckAPatch p = doVerboseCheck $ do checkPatch p -testStr :: String-testStr = "Patches are:\n"++(show tp)- ++(if checkAPatch tp- then "At least the patch itself is valid.\n"- else "The patch itself is bad!\n")- ++"commute of tp2 and tp1' is "++show (commute (tp2:>tp1'))++"\n"- ++"commute of tp1 and tp2' is "++show (commute (tp1:>tp2'))++"\n"- {-++ "\nSimply flattened, it is:\n"- ++ (show $ mapFL (joinPatches.flattenFL.merger_equivalent) $ flattenFL tp)- ++ "\n\nUnravelled, it gives:\n" ++ (show $ map unravel $ flatten tp)- ++ "\n\nUnwound, it gives:\n" ++ (show $ mapFL unwind $ flattenFL tp)- ++(if checkAPatch (join_patches$ reverse $ unwind tp)- then "Unwinding is valid.\n"- else "Bad unwinding!\n")- ++(if checkAPatch $ join_patches [tp,invert tp]- then "Inverse is valid.\n"- else "Bad inverse!\n")- ++(if checkAPatch $ join_patches [invert tp, tp]- then "Other inverse is valid.\n"- else "Bad other inverse!\n")-}+instance Check Patch where+ checkPatch p | isMerger p = do+ checkPatch $ effect p+ checkPatch (V1.Merger _ _ _ _) = impossible+ checkPatch (V1.Regrem _ _ _ _) = impossible+ checkPatch (V1.PP p) = checkPatch p --- | The conflict resolution code (glump) begins by "unravelling" the merger--- into a set of sequences of patches. Each sequence of patches corresponds--- to one non-conflicted patch that got merged together with the others. The--- result of the unravelling of a series of merges must obviously be--- independent of the order in which those merges are performed. This--- unravelling code (which uses the unwind code mentioned above) uses probably--- the second most complicated algorithm. Fortunately, if we can successfully--- unravel the merger, almost any function of the unravelled merger satisfies--- the two constraints mentioned above that the conflict resolution code must--- satisfy.-propUnravelThreeMerge :: Patch -> Patch -> Patch -> Property-propUnravelThreeMerge p1 p2 p3 =- (checkAPatch $ join_patches [invert p1,p2,invert p2,p3]) ==>- (unravel $ unsafeUnseal $ merger "0.0" (unsafeUnseal (merger "0.0" p2 p3)) (unsafeUnseal (merger "0.0" p2 p1))) ==- (unravel $ unsafeUnseal $ merger "0.0" (unsafeUnseal (merger "0.0" p1 p3)) (unsafeUnseal (merger "0.0" p1 p2)))+instance Check Prim where -propUnravelSeqMerge :: Patch -> Patch -> Patch -> Property-propUnravelSeqMerge p1 p2 p3 =- (checkAPatch $ join_patches [invert p1,p2,p3]) ==>- (unravel $ unsafeUnseal $ merger "0.0" p3 $ unsafeUnseal $ merger "0.0" p2 p1) ==- (unravel $ unsafeUnseal $ merger "0.0" (unsafeUnseal $ merger "0.0" p2 p1) p3)+ checkPatch (FP f RmFile) = removeFile $ fn2fp f+ checkPatch (FP f AddFile) = createFile $ fn2fp f+ checkPatch (FP f (Hunk line old new)) = do+ _ <- fileExists $ fn2fp f+ mapM_ (deleteLine (fn2fp f) line) old+ mapM_ (insertLine (fn2fp f) line) (reverse new)+ isValid+ checkPatch (FP f (TokReplace t old new)) =+ modifyFile (fn2fp f) (tryTokPossibly t old new)+ -- note that the above isn't really a sure check, as it leaves PSomethings+ -- and PNothings which may have contained new...+ checkPatch (FP f (Binary o n)) = do+ _ <- fileExists $ fn2fp f+ mapM_ (deleteLine (fn2fp f) 1) (linesPS o)+ _ <- fileEmpty $ fn2fp f+ mapM_ (insertLine (fn2fp f) 1) (reverse $ linesPS n)+ isValid -propUnravelOrderIndependent :: Patch -> Patch -> Property-propUnravelOrderIndependent p1 p2 =- (checkAPatch $ join_patches [invert p1,p2]) ==>- (unravel $ unsafeUnseal $ merger "0.0" p2 p1) == (unravel $ unsafeUnseal $ merger "0.0" p1 p2)+ checkPatch (DP d AddDir) = createDir $ fn2fp d+ checkPatch (DP d RmDir) = removeDir $ fn2fp d -propResolveConflictsValid :: Patch -> Patch -> Property-propResolveConflictsValid p1 p2 =- (checkAPatch $ join_patches [invert p1,p2]) ==>- and $ map (checkAPatch.(\l-> join_patches [p,mergeList l]))- $ resolveConflicts p- where p = case merge (p1:\/:p2) of- _ :/\: p1' -> join_patches [p2,p1']+ checkPatch (Move f f') = checkMove (fn2fp f) (fn2fp f')+ checkPatch (ChangePref _ _ _) = return True -mergeList :: [Sealed (FL Prim C(x))] -> Patch-mergeList patches = fromPrims `unseal` doml NilFL patches- where doml mp (Sealed p:ps) =- case commute (invert p :> mp) of- Just (mp' :> _) -> doml (effect p +>+ effect mp') ps- Nothing -> doml mp ps -- This shouldn't happen for "good" resolutions.- doml mp [] = Sealed mp+regularizePatches :: FL Patch C(x y) -> FL Patch C(x y)+regularizePatches patches = rpint (unsafeCoerceP NilFL) patches+ where -- this reverses the list, which seems odd and causes+ -- the witness unsafety+ rpint :: FL Patch C(x y) -> FL Patch C(a b) -> FL Patch C(x y)+ rpint ok_ps NilFL = ok_ps+ rpint ok_ps (p:>:ps) =+ if checkAPatch (unsafeCoerceP p:>:ok_ps)+ then rpint (unsafeCoerceP p:>:ok_ps) ps+ else rpint ok_ps ps tryTokPossibly :: String -> String -> String -> (Maybe FileContents) -> (Maybe FileContents)@@ -601,87 +369,3 @@ then Nothing else Just $ before : tok : rest -propReadShow :: Patch -> Bool-propReadShow p = case readPatch $ renderPS $ showPatch p of- Just (Sealed p',_) -> p' == p- Nothing -> False---- |In order for merges to work right with commuted patches, inverting a patch--- past a patch and its inverse had golly well better give you the same patch--- back again.-propCommuteInverse :: Patch -> Patch -> Property-propCommuteInverse p1 p2 =- doesCommute p1 p2 ==> case commute (p1 :> p2) of- Nothing -> impossible- Just (_ :> p1') ->- case commute (p1' :> invert p2) of- Nothing -> False- Just (_ :> p1'') -> p1'' == p1--subcommutesInverse :: [(String, Prim -> Prim -> Property)]-subcommutesInverse = zip names (map prop_subcommute cs)- where (names, cs) = unzip subcommutes- prop_subcommute c p1 p2 =- does c p1 p2 ==>- case c (p2:< p1) of- Succeeded (p1':<p2') ->- case c (invert p2:< p1') of- Succeeded (p1'':<ip2x') -> p1'' == p1 &&- case c (invert p1:< invert p2) of- Succeeded (ip2':< ip1') ->- case c (p2':< invert p1) of- Succeeded (ip1o':< p2o) ->- invert ip1' == p1' && invert ip2' == p2' &&- ip1o' == ip1' && p2o == p2 &&- p1'' == p1 && ip2x' == ip2'- _ -> False- _ -> False- _ -> False- _ -> False--subcommutesNontrivialInverse :: [(String, Prim -> Prim -> Property)]-subcommutesNontrivialInverse = zip names (map prop_subcommute cs)- where (names, cs) = unzip subcommutes- prop_subcommute c p1 p2 =- nontrivial c p1 p2 ==>- case c (p2:< p1) of- Succeeded (p1':<p2') ->- case c (invert p2:< p1') of- Succeeded (p1'':<ip2x') -> p1'' == p1 &&- case c (invert p1:< invert p2) of- Succeeded (ip2':< ip1') ->- case c (p2':< invert p1) of- Succeeded (ip1o':< p2o) ->- invert ip1' == p1' && invert ip2' == p2' &&- ip1o' == ip1' && p2o == p2 &&- p1'' == p1 && ip2x' == ip2'- _ -> False- _ -> False- _ -> False- _ -> False--subcommutesFailure :: [(String, Prim -> Prim -> Property)]-subcommutesFailure = zip names (map prop cs)- where (names, cs) = unzip subcommutes- prop c p1 p2 =- doesFail c p1 p2 ==> case c (invert p1 :< invert p2) of- Failed -> True- _ -> False--doesFail :: CommuteFunction -> Prim -> Prim -> Bool-doesFail c p1 p2 =- fails (c (p2:<p1)) && (checkAPatch $ fromPrims (p1 :>: p2 :>: NilFL))- where fails Failed = True- fails _ = False--does :: CommuteFunction -> Prim -> Prim -> Bool-does c p1 p2 =- succeeds (c (p2:<p1)) && (checkAPatch $ fromPrims (p1 :>: p2 :>: NilFL))- where succeeds (Succeeded _) = True- succeeds _ = False--nontrivial :: CommuteFunction -> Prim -> Prim -> Bool-nontrivial c p1 p2 =- succeeds (c (p2:<p1)) && (checkAPatch $ fromPrims (p1 :>: p2 :>: NilFL))- where succeeds (Succeeded (p1' :< p2')) = p1' /= p1 || p2' /= p2- succeeds _ = False
src/Darcs/Test/Patch/Unit.hs view
@@ -15,28 +15,53 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp -fno-warn-deprecations -fno-warn-orphans -fglasgow-exts #-}-{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-deprecations -fno-warn-orphans #-}+{-# LANGUAGE CPP, MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, NoMonomorphismRestriction #-} #include "gadts.h" module Darcs.Test.Patch.Unit ( patchUnitTests ) where -import Data.Maybe ( catMaybes, isNothing )+import Darcs.Test.Util.TestResult ( TestResult, succeeded, failed, isOk )++import Data.Maybe ( catMaybes ) import qualified Data.ByteString.Char8 as BC ( pack ) import Darcs.Witnesses.Sealed-import Darcs.Patch-import Darcs.Patch.Patchy ( mergeFL, Invert )-import Darcs.Patch.Real ( RealPatch, prim2real, isConsistent, isForward, isDuplicate )-import Darcs.Test.Patch.Test () -- for instance Eq Patch-import Darcs.Witnesses.Ordered-import Darcs.Patch.Properties ( recommute, commuteInverses, permutivity, partialPermutivity,- inverseDoesntCommute, patchAndInverseCommute,- mergeCommute, mergeConsistent, mergeArgumentsConsistent,- mergeEitherWay, show_read,- joinInverses, joinCommute )-import Darcs.Patch.Prim ( join )+import Darcs.Patch ( Patchy, invert, showPatch, hunk )+import qualified Darcs.Patch as W ( commute )+import Darcs.Patch.Merge ( Merge )+import qualified Darcs.Patch.Merge as W ( merge, mergeFL )+import Darcs.Patch.Patchy ( Commute, Invert(..) )+import Darcs.Patch.Prim ( PrimPatch )+import Darcs.Patch.Prim.V1 ( Prim )+import Darcs.Patch.V2 ( RealPatch )+import Darcs.Patch.V2.Real ( prim2real, isConsistent, isForward )+-- import Darcs.Test.Patch.Test () -- for instance Eq Patch+import qualified Darcs.Test.Patch.Properties as W+ ( permutivity, partialPermutivity+ , mergeConsistent, mergeArgumentsConsistent, mergeEitherWay+ , mergeCommute, patchAndInverseCommute, joinCommute, commuteInverses+ , recommute+ , show_read+ )+import qualified Darcs.Test.Patch.QuickCheck as W+ ( getPairs, getTriples )+import qualified Darcs.Test.Patch.Examples2 as W+ ( mergeExamples, commuteExamples, tripleExamples+ , realPatchLoopExamples+ ) import Darcs.Test.Patch.QuickCheck+ ( Tree+ , propConsistentTreeFlattenings+ )+import Darcs.Test.Patch.RepoModel ( RepoModel )+import Darcs.Test.Patch.WithState ( WithStartState )+import Darcs.Witnesses.Eq+import qualified Darcs.Witnesses.Ordered as W+import Darcs.Witnesses.Show+import Darcs.Witnesses.Unsafe ( unsafeCoerceP, unsafeCoercePStart, unsafeCoercePEnd )+import qualified Darcs.Test.Patch.Unit2 as W ( notDuplicatestriple )+import qualified Darcs.Patch.Prim as W ( join ) import Printer ( Doc, redText, ($$) ) --import Printer ( greenText ) --import Darcs.ColorPrinter ( traceDoc )@@ -44,49 +69,206 @@ import Darcs.ColorPrinter () -- for instance Show Doc import Test.HUnit ( assertBool ) import Test.Framework.Providers.HUnit ( testCase )-import Test.Framework.Providers.QuickCheck2 ( testProperty ) import Test.Framework ( Test ) -- import Debug.Trace -- #include "impossible.h" +{-+This module builds a lot of test cases by pattern matching+on the results of merge/commute in where clauses. This would+be very painful to switch to using witnesses properly, because+we'd have to make them use case in series.++So instead we give up on witnesses for this module, but instead+of preprocessor hacks which make incompatible code with the rest+of darcs, we build a fresh set of witnesses constructors (FL etc)+which aren't actually GADTs or existentials. So the pattern matching+works as before, but we need to translate back and forth a lot.++We call the normal darcs constructors the 'W' variants.+-}++infixr 5 :>:+infixr 5 +>++infixr 1 :>+infix 1 :/\:+infix 1 :\/:++data FL p C(x y) where+ NilFL :: FL p C(x y)+ (:>:) :: p C(x y) -> FL p C(x y) -> FL p C(x y)++(+>+) :: FL p C(x y) -> FL p C(x y) -> FL p C(x y)+NilFL +>+ ps = ps+(p :>: ps) +>+ qs = p :>: (ps +>+ qs)++data (p :> q) C(x y) where+ (:>) :: p C(x y) -> q C(x y) -> (p :> q) C(x y)++data (p :\/: q) C(x y) where+ (:\/:) :: p C(x y) -> q C(x y) -> (p :\/: q) C(x y)++data (p :/\: q) C(x y) where+ (:/\:) :: p C(x y) -> q C(x y) -> (p :/\: q) C(x y)++class WSub wp p | p -> wp, wp -> p where+ fromW :: wp C(x y) -> p C(x y)+ toW :: p C(x y) -> wp C(x y)++instance (WSub wp1 p1, WSub wp2 p2) => WSub (wp1 W.:\/: wp2) (p1 :\/: p2) where+ fromW (x W.:\/: y) = unsafeCoerceP (fromW x) :\/: unsafeCoerceP (fromW y)+ toW (x :\/: y) = unsafeCoerceP (toW x) W.:\/: unsafeCoerceP (toW y)++instance (WSub wp1 p1, WSub wp2 p2) => WSub (wp1 W.:/\: wp2) (p1 :/\: p2) where+ fromW (x W.:/\: y) = unsafeCoerceP (fromW x) :/\: unsafeCoerceP (fromW y)+ toW (x :/\: y) = unsafeCoerceP (toW x) W.:/\: unsafeCoerceP (toW y)++instance (WSub wp1 p1, WSub wp2 p2) => WSub (wp1 W.:> wp2) (p1 :> p2) where+ fromW (x W.:> y) = unsafeCoercePEnd (fromW x) :> unsafeCoercePStart (fromW y)+ toW (x :> y) = unsafeCoercePEnd (toW x) W.:> unsafeCoercePStart (toW y)++instance WSub wp p => WSub (W.FL wp) (FL p) where+ fromW W.NilFL = unsafeCoerceP NilFL+ fromW (x W.:>: xs) = unsafeCoercePEnd (fromW x) :>: unsafeCoercePStart (fromW xs)++ toW NilFL = unsafeCoerceP W.NilFL+ toW (x :>: xs) = unsafeCoercePEnd (toW x) W.:>: unsafeCoercePStart (toW xs)++instance WSub prim prim => WSub (RealPatch prim) (RealPatch prim) where+ fromW = id+ toW = id++instance WSub Prim Prim where+ fromW = id+ toW = id++instance (WSub wp p, WSub wq q, Show2 wp, Show2 wq) => Show ((p :> q) C(x y)) where+ show = show . toW++instance (WSub wp p, WSub wq q, Show2 wp, Show2 wq) => Show2 (p :> q) where+ showDict2 = ShowDictClass++instance (WSub wp p, WSub wq q, Show2 wp, Show2 wq) => Show ((p :\/: q) C(x y)) where+ show = show . toW++instance (WSub wp p, WSub wq q, Show2 wp, Show2 wq) => Show2 (p :\/: q) where+ showDict2 = ShowDictClass++instance (WSub wp p, Show2 wp) => Show (FL p C(x y)) where+ show = show . toW++instance (WSub wp p, Show2 wp) => Show2 (FL p) where+ showDict2 = ShowDictClass++instance (WSub wp p, Commute wp, MyEq wp) => MyEq (FL p) where+ unsafeCompare x y = unsafeCompare (toW x) (toW y)++instance (WSub wp p, Commute wp, Invert wp) => Invert (FL p) where+ invert = fromW . invert . toW++instance (WSub wp p, Commute wp) => Commute (FL p) where+ commute (xs W.:> ys) = do ys' W.:> xs' <- W.commute (toW xs W.:> toW ys)+ return (fromW ys' W.:> fromW xs')++mergeFL :: (WSub wp p, Merge wp) => (p :\/: FL p) C(x y) -> (FL p :/\: p) C(x y)+mergeFL = fromW . W.mergeFL . toW++merge :: (WSub wp p, Merge wp) => (p :\/: p) C(x y) -> (p :/\: p) C(x y)+merge = fromW . W.merge . toW++commute :: (WSub wp p, Commute wp) => (p :> p) C(x y) -> Maybe ((p :> p) C(x y))+commute = fmap fromW . W.commute . toW+++getPairs :: FL (RealPatch Prim) C(x y) -> [Sealed2 (RealPatch Prim :> RealPatch Prim)]+getPairs = map (mapSeal2 fromW) . W.getPairs . toW++getTriples :: FL (RealPatch Prim) C(x y) -> [Sealed2 (RealPatch Prim :> RealPatch Prim :> RealPatch Prim)]+getTriples = map (mapSeal2 fromW) . W.getTriples . toW++mergeExamples :: [Sealed2 (RealPatch Prim :\/: RealPatch Prim)]+mergeExamples = map (mapSeal2 fromW) W.mergeExamples++realPatchLoopExamples :: [Sealed (WithStartState RepoModel (Tree Prim))]+realPatchLoopExamples = W.realPatchLoopExamples++commuteExamples :: [Sealed2 (RealPatch Prim :> RealPatch Prim)]+commuteExamples = map (mapSeal2 fromW) W.commuteExamples++tripleExamples :: [Sealed2 (RealPatch Prim :> RealPatch Prim :> RealPatch Prim)]+tripleExamples = map (mapSeal2 fromW) W.tripleExamples++join :: (Prim :> Prim) C(x y) -> Maybe (FL Prim C(x y))+join = fmap fromW . W.join . toW++joinCommute :: (FORALL(x y) (Prim :> Prim) C(x y) -> Maybe (FL Prim C(x y)))+ -> (Prim :> Prim :> Prim) C(a b) -> TestResult+joinCommute f = W.joinCommute (fmap toW . f . fromW) . toW++permutivity :: (Patchy wp, WSub wp p) => (FORALL(x y) (p :> p) C(x y) -> Maybe ((p :> p) C(x y)))+ -> (p :> p :> p) C(a b) -> TestResult+permutivity f = W.permutivity (fmap toW . f . fromW) . toW++partialPermutivity :: (Patchy wp, WSub wp p) => (FORALL(x y) (p :> p) C(x y) -> Maybe ((p :> p) C(x y)))+ -> (p :> p :> p) C(a b) -> TestResult+partialPermutivity f = W.partialPermutivity (fmap toW . f . fromW) . toW++mergeEitherWay :: (Patchy wp, Merge wp, WSub wp p) => (p :\/: p) C(x y) -> TestResult+mergeEitherWay = W.mergeEitherWay . toW++commuteInverses :: (Patchy wp, WSub wp p) => (FORALL(x y) (p :> p) C(x y) -> Maybe ((p :> p) C(x y)))+ -> (p :> p) C(a b) -> TestResult+commuteInverses f = W.commuteInverses (fmap toW . f . fromW) . toW++recommute :: (Patchy wp, WSub wp p) => (FORALL(x y) ((p :> p) C(x y) -> Maybe ((p :> p) C(x y))))+ -> (p :> p) C(a b) -> TestResult+recommute f = W.recommute (fmap toW . f . fromW) . toW++mergeCommute :: (Patchy wp, Merge wp, WSub wp p) => (p :\/: p) C(x y) -> TestResult+mergeCommute = W.mergeCommute . toW++mergeConsistent :: (Patchy wp, Merge wp, WSub wp p) =>+ (FORALL(x y) p C(x y) -> Maybe Doc)+ -> (p :\/: p) C(a b) -> TestResult+mergeConsistent f = W.mergeConsistent (f . fromW) . toW++mergeArgumentsConsistent :: (Patchy wp, WSub wp p) =>+ (FORALL(x y) p C(x y) -> Maybe Doc)+ -> (p :\/: p) C(a b) -> TestResult+mergeArgumentsConsistent f = W.mergeArgumentsConsistent (f . fromW) . toW++show_read :: (Patchy p, Show2 p) => p C(x y) -> TestResult+show_read = W.show_read++patchAndInverseCommute :: (Patchy wp, WSub wp p) =>+ (FORALL(x y) (p :> p) C(x y) -> Maybe ((p :> p) C(x y)))+ -> (p :> p) C(a b) -> TestResult+patchAndInverseCommute f = W.patchAndInverseCommute (fmap toW . f . fromW) . toW++notDuplicatestriple :: (RealPatch Prim :> RealPatch Prim :> RealPatch Prim) C(x y) -> Bool+notDuplicatestriple = W.notDuplicatestriple . toW++{- end of W<->nonW translation code -}+ -- | The unit tests defined about patches patchUnitTests :: [Test]-patchUnitTests = [--do putStr "Checking with quickcheck that real patches have consistent flattenings... "- -- quickCheck (not . isBottomTimeOut (Just 10) . propConsistentTreeFlattenings) >> return 0- runPrimitiveTests "prim join inverses" (\ (a:\/:_) -> joinInverses join a) mergeables,- testProperty "Checking prim join inverses using QuickCheck... " (isNothing . joinInverses join),- runPrimitiveTests "prim inverse doesn't commute" (\ (a:\/:_) -> inverseDoesntCommute a) mergeables,- -- The following fails because of setpref patches...- --,do putStr "Checking prim inverse doesn't commute using QuickCheck... "- -- simpleCheck (inverseDoesntCommute :: Prim -> Maybe Doc)+patchUnitTests = [ runPrimitiveTests "join commute" (joinCommute join) primPermutables,- testProperty "Checking prim join commute using QuickCheck... " (unseal2 (isNothing . joinCommute join)), runPrimitiveTests "prim recommute" (recommute commute) $ map mergeable2commutable mergeables, runPrimitiveTests "prim patch and inverse commute" (patchAndInverseCommute commute) $ map mergeable2commutable mergeables, runPrimitiveTests "prim inverses commute" (commuteInverses commute) $ map mergeable2commutable mergeables,- --,do putStr "Checking prim recommute using QuickCheck... "- -- simpleCheck (recommute- -- (commute :: Prim :> Prim- -- -> Maybe (Prim :> Prim))) runPrimitiveTests "FL prim recommute" (recommute commute) $ map mergeable2commutable mergeablesFL, runPrimitiveTests "FL prim patch and inverse commute" (patchAndInverseCommute commute) $ map mergeable2commutable mergeablesFL, runPrimitiveTests "FL prim inverses commute" (commuteInverses commute) $ map mergeable2commutable mergeablesFL,- runPrimitiveTests "fails" (commuteFails commute) ([] :: [Prim :> Prim]),+ runPrimitiveTests "fails" (commuteFails commute) ([] :: [(Prim :> Prim) C(x y)]), runPrimitiveTests "read and show work on Prim" show_read primPatches, runPrimitiveTests "read and show work on RealPatch" show_read realPatches,- testProperty "Checking that readPatch and showPatch work on RealPatch... "- (isNothing . (unseal $ patchFromTree $ (show_read :: RealPatch -> Maybe Doc))),- testProperty "Checking that readPatch and showPatch work on FL RealPatch... "- (isNothing . (unseal2 $ (show_read :: FL RealPatch -> Maybe Doc))), runPrimitiveTests "example flattenings work" (\x -> if propConsistentTreeFlattenings x- then Nothing- else Just $ redText "oops")+ then succeeded+ else failed $ redText "oops") realPatchLoopExamples,- testProperty "Checking that tree flattenings are consistent... " propConsistentTreeFlattenings,- testProperty "Checking with quickcheck that real patches are consistent... "- (isNothing . (unseal $ patchFromTree $ isConsistent)), runPrimitiveTests "real merge input consistent" (mergeArgumentsConsistent isConsistent) realMergeables, runPrimitiveTests "real merge input is forward" (mergeArgumentsConsistent isForward) realMergeables, runPrimitiveTests "real merge output is forward" (mergeConsistent isForward) realMergeables,@@ -97,146 +279,29 @@ runPrimitiveTests "real recommute" (recommute commute) realCommutables, runPrimitiveTests "real inverses commute" (commuteInverses commute) realCommutables, runPrimitiveTests "real permutivity" (permutivity commute) $ filter (notDuplicatestriple) realTriples,- runPrimitiveTests "real partial permutivity" (partialPermutivity commute) $ filter (notDuplicatestriple) realTriples,-- testProperty "Checking we can do merges using QuickCheck"- (isNothing . (propIsMergeable ::- Sealed (WithStartState RepoModel (Tree Prim))- -> Maybe (Tree RealPatch C(x)))),- testProperty "Checking recommute using QuickCheck Tree generator"- (isNothing. (unseal $ commutePairFromTree $- (recommute- (commute :: RealPatch :> RealPatch- -> Maybe (RealPatch :> RealPatch))))),- testProperty "Checking recommute using QuickCheck TWFP generator"- (isNothing . (unseal $ commutePairFromTWFP $- (recommute- (commute :: RealPatch :> RealPatch- -> Maybe (RealPatch :> RealPatch))))),- testConditional "Checking nontrivial recommute"- (unseal $ commutePairFromTree $ nontrivialReals)- (unseal $ commutePairFromTree $- (recommute- (commute :: RealPatch :> RealPatch- -> Maybe (RealPatch :> RealPatch)))),- testConditional "Checking nontrivial recommute using TWFP"- (unseal $ commutePairFromTWFP $ nontrivialReals)- (unseal $ commutePairFromTWFP $- (recommute- (commute :: RealPatch :> RealPatch- -> Maybe (RealPatch :> RealPatch)))),-- testProperty "Checking inverses commute using QuickCheck Tree generator"- (isNothing . (unseal $ commutePairFromTree $- (commuteInverses- (commute :: RealPatch :> RealPatch- -> Maybe (RealPatch :> RealPatch))))),- testProperty "Checking inverses commute using QuickCheck TWFP generator"- (isNothing . (unseal $ commutePairFromTWFP $- (commuteInverses- (commute :: RealPatch :> RealPatch- -> Maybe (RealPatch :> RealPatch))))),- testConditional "Checking nontrivial inverses commute"- (unseal $ commutePairFromTree $ nontrivialReals)- (unseal $ commutePairFromTree $- (commuteInverses- (commute :: RealPatch :> RealPatch- -> Maybe (RealPatch :> RealPatch)))),- testConditional "Checking nontrivial inverses commute using TWFP"- (unseal $ commutePairFromTWFP $ nontrivialReals)- (unseal $ commutePairFromTWFP $- (commuteInverses- (commute :: RealPatch :> RealPatch- -> Maybe (RealPatch :> RealPatch)))),-- testProperty "Checking merge either way using QuickCheck TWFP generator"- (isNothing . (unseal $ mergePairFromTWFP $- (mergeEitherWay :: RealPatch :\/: RealPatch -> Maybe Doc))),- testProperty "Checking merge either way using QuickCheck Tree generator"- (isNothing . (unseal $ mergePairFromTree $- (mergeEitherWay :: RealPatch :\/: RealPatch -> Maybe Doc))),- testConditional "Checking nontrivial merge either way"- (unseal $ mergePairFromTree $ nontrivialMergeReals)- (unseal $ mergePairFromTree $- (mergeEitherWay :: RealPatch :\/: RealPatch -> Maybe Doc)),- testConditional "Checking nontrivial merge either way using TWFP"- (unseal $ mergePairFromTWFP $ nontrivialMergeReals)- (unseal $ mergePairFromTWFP $- (mergeEitherWay :: RealPatch :\/: RealPatch -> Maybe Doc)),+ runPrimitiveTests "real partial permutivity" (partialPermutivity commute) $ filter (notDuplicatestriple) realTriples - testConditional "Checking permutivity"- (unseal $ commuteTripleFromTree notDuplicatestriple)- (unseal $ commuteTripleFromTree $ permutivity- (commute :: RealPatch :> RealPatch -> Maybe (RealPatch :> RealPatch))),- testConditional "Checking partial permutivity"- (unseal $ commuteTripleFromTree notDuplicatestriple)- (unseal $ commuteTripleFromTree $ partialPermutivity- (commute :: RealPatch :> RealPatch -> Maybe (RealPatch :> RealPatch))),- testConditional "Checking nontrivial permutivity"- (unseal $ commuteTripleFromTree- (\t -> nontrivialTriple t && notDuplicatestriple t))- (unseal $ commuteTripleFromTree $- (permutivity- (commute :: RealPatch :> RealPatch- -> Maybe (RealPatch :> RealPatch)))) ] -notDuplicatestriple :: RealPatch :> RealPatch :> RealPatch -> Bool-notDuplicatestriple (a :> b :> c) = not $ any isDuplicate [a,b,c]----not_duplicates_pair :: RealPatch :> RealPatch -> Bool---not_duplicates_pair (a :> b) = not $ any isDuplicate [a,b]--nontrivialTriple :: RealPatch :> RealPatch :> RealPatch -> Bool-nontrivialTriple (a :> b :> c) =- case commute (a :> b) of- Nothing -> False- Just (b' :> a') ->- case commute (a' :> c) of- Nothing -> False- Just (c'' :> a'') ->- case commute (b :> c) of- Nothing -> False- Just (c' :> b'') -> (not (a `unsafeCompare` a') || not (b `unsafeCompare` b')) &&- (not (c' `unsafeCompare` c) || not (b'' `unsafeCompare` b)) &&- (not (c'' `unsafeCompare` c) || not (a'' `unsafeCompare` a'))--nontrivialReals :: RealPatch :> RealPatch -> Bool-nontrivialReals = nontrivialCommute--nontrivialCommute :: Patchy p => p :> p -> Bool-nontrivialCommute (x :> y) = case commute (x :> y) of- Just (y' :> x') -> not (y' `unsafeCompare` y) ||- not (x' `unsafeCompare` x)- Nothing -> False--nontrivialMergeReals :: RealPatch :\/: RealPatch -> Bool-nontrivialMergeReals = nontrivialMerge--nontrivialMerge :: Patchy p => p :\/: p -> Bool-nontrivialMerge (x :\/: y) = case merge (x :\/: y) of- y' :/\: x' -> not (y' `unsafeCompare` y) ||- not (x' `unsafeCompare` x)- -- | Run a test function on a set of data, using HUnit. The test function should -- return @Nothing@ upon success and a @Just x@ upon failure.-runPrimitiveTests :: (Show a, Show b) => String -- ^ The test name- -> (a -> Maybe b) -- ^ The test function- -> [a] -- ^ The test data- -> Test+runPrimitiveTests :: Show a => String -- ^ The test name+ -> (a -> TestResult) -- ^ The test function+ -> [a] -- ^ The test data+ -> Test runPrimitiveTests name test datas = testCase name (assertBool assertName res) where assertName = "Boolean assertion for \"" ++ name ++ "\""- res = and $ map (isNothing . test) datas+ res = and $ map (isOk . test) datas -quickhunk :: Int -> String -> String -> Prim+quickhunk :: PrimPatch prim => Int -> String -> String -> prim C(x y) quickhunk l o n = hunk "test" l (map (\c -> BC.pack [c]) o) (map (\c -> BC.pack [c]) n) -primPermutables :: [Prim :> Prim :> Prim]+primPermutables :: [(Prim :> Prim :> Prim) C(x y)] primPermutables = [quickhunk 0 "e" "bo" :> quickhunk 3 "" "x" :> quickhunk 2 "f" "qljo"] -mergeables :: [Prim :\/: Prim]+mergeables :: [(Prim :\/: Prim) C(x y)] mergeables = [quickhunk 1 "a" "b" :\/: quickhunk 1 "a" "c", quickhunk 1 "a" "b" :\/: quickhunk 3 "z" "c", quickhunk 0 "" "a" :\/: quickhunk 1 "" "b",@@ -245,25 +310,25 @@ quickhunk 0 "" "a" :\/: quickhunk 1 "b" "" ] -mergeablesFL :: [FL Prim :\/: FL Prim]+mergeablesFL :: [(FL Prim :\/: FL Prim) C(x y)] mergeablesFL = map (\ (x:\/:y) -> (x :>: NilFL) :\/: (y :>: NilFL)) mergeables ++ [] -- [(quickhunk 1 "a" "b" :>: quickhunk 3 "z" "c" :>: NilFL) -- :\/: (quickhunk 1 "a" "z" :>: NilFL), -- (quickhunk 1 "a" "b" :>: quickhunk 1 "b" "c" :>: NilFL) -- :\/: (quickhunk 1 "a" "z" :>: NilFL)] -mergeable2commutable :: Invert p => p :\/: p -> p :> p-mergeable2commutable (x :\/: y) = invert x :> y+mergeable2commutable :: Invert p => (p :\/: p) C(x y) -> (p :> p) C(x y)+mergeable2commutable (x :\/: y) = unsafeCoerceP (invert x) :> y -primPatches :: [Prim]+primPatches :: [Prim C(x y)] primPatches = concatMap mergeable2patches mergeables where mergeable2patches (x:\/:y) = [x,y] -realPatches :: [RealPatch]+realPatches :: [RealPatch Prim C(x y)] realPatches = concatMap commutable2patches realCommutables where commutable2patches (x:>y) = [x,y] -realTriples :: [RealPatch :> RealPatch :> RealPatch]+realTriples :: [(RealPatch Prim :> RealPatch Prim :> RealPatch Prim) C(x y)] realTriples = [ob' :> oa2 :> a2'', oa' :> oa2 :> a2''] ++ map unsafeUnseal2 tripleExamples@@ -276,12 +341,12 @@ a2' :/\: _ = merge (ob' :\/: a2) a2'' :/\: _ = merge (oa2 :\/: a2') -realFLs :: [FL RealPatch]+realFLs :: [FL (RealPatch Prim) C(x y)] realFLs = [oa :>: invert oa :>: oa :>: invert oa :>: ps +>+ oa :>: invert oa :>: NilFL] where oa = prim2real $ quickhunk 1 "o" "a" ps :/\: _ = merge (oa :>: invert oa :>: NilFL :\/: oa :>: invert oa :>: NilFL) -realCommutables :: [RealPatch :> RealPatch]+realCommutables :: [(RealPatch Prim :> RealPatch Prim) C(x y)] realCommutables = map unsafeUnseal2 commuteExamples++ map mergeable2commutable realMergeables++ [invert oa :> ob'] ++ map unsafeUnseal2 (concatMap getPairs realFLs)@@ -289,7 +354,7 @@ ob = prim2real $ quickhunk 1 "o" "b" _ :/\: ob' = mergeFL (ob :\/: oa :>: invert oa :>: NilFL) -realMergeables :: [RealPatch :\/: RealPatch]+realMergeables :: [(RealPatch Prim :\/: RealPatch Prim) C(x y)] realMergeables = map (\ (x :\/: y) -> prim2real x :\/: prim2real y) mergeables ++ realIglooMergeables ++ realQuickcheckMergeables@@ -332,12 +397,12 @@ oc''' :/\: _ = merge (ob' :\/: oc') oe' :/\: _ = merge (od :\/: oe) of' :/\: _ = merge (od :\/: pf)- pair2m :: Sealed2 (RealPatch :> RealPatch)- -> Maybe (RealPatch :\/: RealPatch)+ pair2m :: Sealed2 (RealPatch Prim :> RealPatch Prim)+ -> Maybe ((RealPatch Prim :\/: RealPatch Prim) C(x y)) pair2m (Sealed2 (xx :> y)) = do y' :> _ <- commute (xx :> y)- return (xx :\/: y')+ return $ unsafeCoerceP (xx :\/: y') -realIglooMergeables :: [RealPatch :\/: RealPatch]+realIglooMergeables :: [(RealPatch Prim :\/: RealPatch Prim) C(x y)] realIglooMergeables = [(a :\/: b), (b :\/: c), (a :\/: c),@@ -358,7 +423,7 @@ y' :/\: _ = merge (b :\/: y) z' :/\: _ = merge (c :\/: z) -realQuickcheckMergeables :: [RealPatch :\/: RealPatch]+realQuickcheckMergeables :: [(RealPatch Prim :\/: RealPatch Prim) C(x y)] realQuickcheckMergeables = [-- invert k1 :\/: n1 --, invert k2 :\/: n2 hb :\/: k@@ -379,10 +444,10 @@ -- merge (hb :>: b :>: NilFL :\/: k :>: n :>: NilFL) k' :>: n' :>: NilFL :/\: _ :>: b' :>: _ = merge (hb :>: b :>: d' :>: NilFL :\/: k :>: n :>: NilFL) pairs = getPairs (hb :>: b :>: d' :>: k' :>: n' :>: NilFL)- pair2m :: Sealed2 (RealPatch :> RealPatch)- -> Maybe (RealPatch :\/: RealPatch)+ pair2m :: Sealed2 (RealPatch Prim :> RealPatch Prim)+ -> Maybe ((RealPatch Prim :\/: RealPatch Prim) C(x y)) pair2m (Sealed2 (xx :> y)) = do y' :> _ <- commute (xx :> y)- return (xx :\/: y')+ return $ unsafeCoerceP (xx :\/: y') i = prim2real $ quickhunk 0 "" "i" x = prim2real $ quickhunk 0 "" "x"@@ -390,10 +455,14 @@ d3 :/\: _ = merge (xi :\/: d) _ :/\: k3 = mergeFL (k :\/: i :>: x :>: xi :>: d3 :>: NilFL) -commuteFails :: (MyEq p, Patchy p) => (p :> p -> Maybe (p :> p)) -> p :> p- -> Maybe Doc-commuteFails c (x :> y) = do y' :> x' <- c (x :> y)- return $ redText "x" $$ showPatch x $$+commuteFails :: (MyEq p, Patchy p)+ => ((p :> p) C(x y) -> Maybe ((p :> p) C(x y)))+ -> (p :> p) C(x y)+ -> TestResult+commuteFails c (x :> y) = case c (x :> y) of+ Nothing -> succeeded+ Just (y' :> x') ->+ failed $ redText "x" $$ showPatch x $$ redText ":> y" $$ showPatch y $$ redText "y'" $$ showPatch y' $$ redText ":> x'" $$ showPatch x'
+ src/Darcs/Test/Patch/Unit2.hs view
@@ -0,0 +1,244 @@+-- Copyright (C) 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.++{-# LANGUAGE CPP #-}++#include "gadts.h"++-- This module was split out from Darcs.Test.Patch.Unit to assist with+-- adding witnesses.+module Darcs.Test.Patch.Unit2 ( patchUnitTests2, notDuplicatestriple ) where+++import Darcs.Test.Util.TestResult ( TestResult, fromMaybe )++import Darcs.Patch.FileHunk ( FileHunk(..), IsHunk(..) )+import Darcs.Patch.Prim ( PrimPatch, PrimOf, join )+import Darcs.Patch.Prim.V1 ( Prim )+import Darcs.Patch.Merge ( Merge(..) )+import Darcs.Patch.Patchy ( Patchy, Commute(..) )+import Darcs.Patch.RepoPatch ( RepoPatch )+import Darcs.Patch.V2 ( RealPatch )+import Darcs.Patch.V2.Real ( isConsistent, isDuplicate )+import Darcs.Test.Patch.Prim.V1 () -- Arbitrary instances+import Darcs.Test.Patch.Properties+ ( invertSymmetry, invertRollback+ , recommute, commuteInverses, effectPreserving+ , permutivity, partialPermutivity+ , mergeEitherWay, show_read+ , joinEffectPreserving, joinCommute+ )+import Darcs.Test.Patch.QuickCheck+ ( Tree, TreeWithFlattenPos+ , propIsMergeable, propConsistentTreeFlattenings+ )+import qualified Darcs.Test.Patch.QuickCheck as T+ ( commuteTripleFromTree, commutePairFromTree, commutePairFromTWFP+ , mergePairFromTree, mergePairFromTWFP+ , patchFromTree+ )+import Darcs.Test.Patch.Utils ( testConditional )+import Darcs.Test.Patch.RepoModel ( RepoModel )+import Darcs.Test.Patch.WithState ( WithState(..), WithStartState )+import Darcs.Witnesses.Eq ( unsafeCompare )+import Darcs.Witnesses.Ordered ( (:>)(..), (:/\:)(..), (:\/:)(..), FL, allFL )+import Darcs.Witnesses.Sealed ( Sealed, unseal, Sealed2, unseal2 )++import Data.Maybe ( isNothing )+import Test.Framework ( Test )+import Test.Framework.Providers.QuickCheck2 ( testProperty )++patchFromTree :: (RepoPatch p, PrimOf p ~ Prim) => (FORALL(y z) p C(y z) -> t) -> WithStartState RepoModel (Tree Prim) C(x) -> t+patchFromTree = T.patchFromTree++mergePairFromTree :: (RepoPatch p, PrimOf p ~ Prim) => (FORALL(y z) (p :\/: p) C(y z) -> t) -> WithStartState RepoModel (Tree Prim) C(x) -> t+mergePairFromTree = T.mergePairFromTree++mergePairFromTWFP :: (RepoPatch p, PrimOf p ~ Prim) => (FORALL(y z) (p :\/: p) C(y z) -> t) -> WithStartState RepoModel (TreeWithFlattenPos Prim) C(x) -> t+mergePairFromTWFP = T.mergePairFromTWFP++commutePairFromTWFP :: (RepoPatch p, PrimOf p ~ Prim) => (FORALL(y z) (p :> p) C(y z) -> t) -> WithStartState RepoModel (TreeWithFlattenPos Prim) C(x) -> t+commutePairFromTWFP = T.commutePairFromTWFP++commutePairFromTree :: (RepoPatch p, PrimOf p ~ Prim) => (FORALL(y z) (p :> p) C(y z) -> t) -> WithStartState RepoModel (Tree Prim) C(x) -> t+commutePairFromTree = T.commutePairFromTree++commuteTripleFromTree :: (RepoPatch p, PrimOf p ~ Prim) => (FORALL(y z) (p :> p :> p) C(y z) -> t) -> WithStartState RepoModel (Tree Prim) C(x) -> t+commuteTripleFromTree = T.commuteTripleFromTree+++patchUnitTests2 :: [Test]+patchUnitTests2 = [ testProperty "Checking Prim invert symmetry..."+ (unseal2 $ invertSymmetry :: Sealed2 Prim -> TestResult),+ testProperty "Checking FL Prim invert symmetry..."+ (unseal2 $ invertSymmetry :: Sealed2 (FL Prim) -> TestResult),+ testProperty "Checking Prim invert rollback..."+ (unseal2 $ invertRollback :: Sealed2 (WithState RepoModel Prim) -> TestResult),+ testProperty "Checking FL Prim invert rollback..."+ (unseal2 $ invertRollback :: Sealed2 (WithState RepoModel (FL Prim)) -> TestResult),+ testConditional "Checking Prim effect preserving..."+ (unseal2 $ nonEmptyHunksPair . wsPatch)+ (unseal2 $ effectPreserving commute :: Sealed2 (WithState RepoModel (Prim :> Prim)) -> TestResult),+ testConditional "Checking FL Prim effect preserving..."+ (unseal2 $ nonEmptyHunksFLPair . wsPatch)+ (unseal2 $ effectPreserving commute :: Sealed2 (WithState RepoModel (FL Prim :> FL Prim)) -> TestResult),+ testProperty "Checking Prim recommute..."+ (unseal2 $ recommute commute :: Sealed2 (Prim :> Prim) -> TestResult),+ testProperty "Checking FL Prim recommute..."+ (unseal2 $ recommute commute :: Sealed2 (FL Prim :> FL Prim) -> TestResult),+ testProperty "Checking Prim inverses commute..."+ (unseal2 $ commuteInverses commute :: Sealed2 (Prim :> Prim) -> TestResult),+ testProperty "Checking FL Prim inverses commute..."+ (unseal2 $ commuteInverses commute :: Sealed2 (FL Prim :> FL Prim) -> TestResult),+ --do putStr "Checking with quickcheck that real patches have consistent flattenings... "+ -- quickCheck (not . isBottomTimeOut (Just 10) . propConsistentTreeFlattenings) >> return 0+ -- The following fails because of setpref patches...+ --,do putStr "Checking prim inverse doesn't commute using QuickCheck... "+ -- simpleCheck (inverseDoesntCommute :: Prim -> Maybe Doc)+ testProperty "Checking prim join effect preserving... "+ (unseal2 (joinEffectPreserving join)),+ testConditional "Checking prim join commute using QuickCheck... "+ (unseal2 nonEmptyHunksTriple)+ (unseal2 (joinCommute join)),+ --,do putStr "Checking prim recommute using QuickCheck... "+ -- simpleCheck (recommute+ -- (commute :: Prim :> Prim+ -- -> Maybe (Prim :> Prim)))+ testProperty "Checking that readPatch and showPatch work on RealPatch... "+ (unseal $ patchFromTree $ (show_read :: RealPatch Prim C(x y) -> TestResult)),+ testProperty "Checking that readPatch and showPatch work on FL RealPatch... "+ (unseal2 $ (show_read :: FL (RealPatch Prim) C(x y) -> TestResult)),+ testProperty "Checking that tree flattenings are consistent... " propConsistentTreeFlattenings,+ testProperty "Checking with quickcheck that real patches are consistent... "+ (unseal $ patchFromTree $ fromMaybe . isConsistent),++ testProperty "Checking we can do merges using QuickCheck"+ (isNothing . (propIsMergeable ::+ Sealed (WithStartState RepoModel (Tree Prim))+ -> Maybe (Tree (RealPatch Prim) C(x)))),+ testProperty "Checking recommute using QuickCheck Tree generator"+ (unseal $ commutePairFromTree+ (recommute commuteReals)),+ testProperty "Checking recommute using QuickCheck TWFP generator"+ (unseal $ commutePairFromTWFP+ (recommute commuteReals)),+ testConditional "Checking nontrivial recommute"+ (unseal $ commutePairFromTree $ nontrivialReals)+ (unseal $ commutePairFromTree $+ (recommute commuteReals)),+ testConditional "Checking nontrivial recommute using TWFP"+ (unseal $ commutePairFromTWFP $ nontrivialReals)+ (unseal $ commutePairFromTWFP $+ (recommute commuteReals)),++ testProperty "Checking inverses commute using QuickCheck Tree generator"+ (unseal $ commutePairFromTree $+ (commuteInverses commuteReals)),+ testProperty "Checking inverses commute using QuickCheck TWFP generator"+ (unseal $ commutePairFromTWFP $+ (commuteInverses commuteReals)),+ testConditional "Checking nontrivial inverses commute"+ (unseal $ commutePairFromTree $ nontrivialReals)+ (unseal $ commutePairFromTree $+ (commuteInverses commuteReals)),+ testConditional "Checking nontrivial inverses commute using TWFP"+ (unseal $ commutePairFromTWFP $ nontrivialReals)+ (unseal $ commutePairFromTWFP $+ (commuteInverses commuteReals)),++ testProperty "Checking merge either way using QuickCheck TWFP generator"+ (unseal $ mergePairFromTWFP $ mergeEitherWayReals),+ testProperty "Checking merge either way using QuickCheck Tree generator"+ (unseal $ mergePairFromTree $ mergeEitherWayReals),+ testConditional "Checking nontrivial merge either way"+ (unseal $ mergePairFromTree $ nontrivialMergeReals)+ (unseal $ mergePairFromTree $ mergeEitherWayReals),+ testConditional "Checking nontrivial merge either way using TWFP"+ (unseal $ mergePairFromTWFP $ nontrivialMergeReals)+ (unseal $ mergePairFromTWFP $ mergeEitherWayReals),++ testConditional "Checking permutivity"+ (unseal $ commuteTripleFromTree notDuplicatestriple)+ (unseal $ commuteTripleFromTree $ permutivity commuteReals),+ testConditional "Checking partial permutivity"+ (unseal $ commuteTripleFromTree notDuplicatestriple)+ (unseal $ commuteTripleFromTree $ partialPermutivity commuteReals),+ testConditional "Checking nontrivial permutivity"+ (unseal $ commuteTripleFromTree+ (\t -> nontrivialTriple t && notDuplicatestriple t))+ (unseal $ commuteTripleFromTree $+ (permutivity commuteReals))+ ]++notDuplicatestriple :: (RealPatch prim :> RealPatch prim :> RealPatch prim) C(x y) -> Bool+notDuplicatestriple (a :> b :> c) = not (isDuplicate a || isDuplicate b || isDuplicate c)++--not_duplicates_pair :: RealPatch prim :> RealPatch prim -> Bool+--not_duplicates_pair (a :> b) = not $ any isDuplicate [a,b]++nontrivialTriple :: PrimPatch prim => (RealPatch prim :> RealPatch prim :> RealPatch prim) C(x y) -> Bool+nontrivialTriple (a :> b :> c) =+ case commute (a :> b) of+ Nothing -> False+ Just (b' :> a') ->+ case commute (a' :> c) of+ Nothing -> False+ Just (c'' :> a'') ->+ case commute (b :> c) of+ Nothing -> False+ Just (c' :> b'') -> (not (a `unsafeCompare` a') || not (b `unsafeCompare` b')) &&+ (not (c' `unsafeCompare` c) || not (b'' `unsafeCompare` b)) &&+ (not (c'' `unsafeCompare` c) || not (a'' `unsafeCompare` a'))+++nonEmptyHunk :: (IsHunk p) => p C(x y) -> Bool+nonEmptyHunk p+ | Just (FileHunk _ _ [] []) <- isHunk p = False+ | otherwise = True++nonEmptyHunksPair :: (IsHunk p) => (p :> p) C(x y) -> Bool+nonEmptyHunksPair (p1 :> p2) = nonEmptyHunk p1 && nonEmptyHunk p2++nonEmptyHunksTriple :: (IsHunk p) => (p :> p :> p) C(x y) -> Bool+nonEmptyHunksTriple (p1 :> p2 :> p3) = nonEmptyHunk p1 && nonEmptyHunk p2 && nonEmptyHunk p3++nonEmptyHunksFLPair :: (IsHunk p) => (FL p :> FL p) C(x y) -> Bool+nonEmptyHunksFLPair (ps :> qs) = allFL nonEmptyHunk ps && allFL nonEmptyHunk qs++commuteReals :: PrimPatch prim => (RealPatch prim :> RealPatch prim) C(x y) -> Maybe ((RealPatch prim :> RealPatch prim) C(x y))+commuteReals = commute++mergeEitherWayReals :: PrimPatch prim => (RealPatch prim :\/: RealPatch prim) C(x y) -> TestResult+mergeEitherWayReals = mergeEitherWay++nontrivialReals :: PrimPatch prim => (RealPatch prim :> RealPatch prim) C(x y) -> Bool+nontrivialReals = nontrivialCommute++nontrivialCommute :: Patchy p => (p :> p) C(x y) -> Bool+nontrivialCommute (x :> y) = case commute (x :> y) of+ Just (y' :> x') -> not (y' `unsafeCompare` y) ||+ not (x' `unsafeCompare` x)+ Nothing -> False++nontrivialMergeReals :: PrimPatch prim => (RealPatch prim :\/: RealPatch prim) C(x y) -> Bool+nontrivialMergeReals = nontrivialMerge++nontrivialMerge :: (Patchy p, Merge p) => (p :\/: p) C(x y) -> Bool+nontrivialMerge (x :\/: y) = case merge (x :\/: y) of+ y' :/\: x' -> not (y' `unsafeCompare` y) ||+ not (x' `unsafeCompare` x)+
+ src/Darcs/Test/Patch/Utils.hs view
@@ -0,0 +1,24 @@+module Darcs.Test.Patch.Utils+ ( testConditional, testStringList )+ where++import Test.Framework ( Test, TestName )+import Test.Framework.Providers.HUnit ( testCase )+import Test.Framework.Providers.QuickCheck2 ( testProperty )+import Test.HUnit ( assertFailure )+import Test.QuickCheck ( Arbitrary, Testable, (==>) )++-- | Turns a condition and a test function into a conditional quickcheck+-- property that can be run by test-framework.+testConditional+ :: (Arbitrary a, Show a, Testable prop) => TestName -- ^ Test name+ -> (a -> Bool) -- ^ Condition+ -> (a -> prop) -- ^ Test function+ -> Test+testConditional name cond t = testProperty name t'+ where t' x = cond x ==> t x++-- | Utility function to run old tests that return a list of error messages,+-- with the empty list meaning success.+testStringList :: String -> [String] -> Test+testStringList name test = testCase name $ mapM_ assertFailure test
+ src/Darcs/Test/Patch/WithState.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE CPP, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances #-}++#include "gadts.h"++module Darcs.Test.Patch.WithState+ where+++import Darcs.Witnesses.Ordered+import Darcs.Witnesses.Sealed+import Darcs.Witnesses.Show+import Test.QuickCheck ( Gen, sized, choose )++++----------------------------------------------------------------------+-- * WithState++data WithState s p C(x y) = WithState {+ wsStartState :: s C(x)+ , wsPatch :: p C(x y)+ , wsEndState :: s C(y)+ }+ deriving Eq++instance (Show1 s, Show2 p) => Show (WithState s p C(x y)) where+ showsPrec d (WithState s p s')+ = showParen (d > appPrec) $ showString "WithState "+ . showsPrec1 (appPrec+1) s+ . showString " "+ . showsPrec2 (appPrec+1) p+ . showString " "+ . showsPrec1 (appPrec+1) s'++instance (Show1 s, Show2 p) => Show2 (WithState s p) where+ showDict2 = ShowDictClass++data WithStartState s p C(x) = WithStartState {+ wssStartState :: s C(x)+ , wssPatch :: p C(x)+ }+ deriving Eq++instance (Show1 s, Show1 p) => Show (WithStartState s p C(x)) where+ showsPrec d (WithStartState s p) = showParen (d > appPrec) $ showString "WithStartState " .+ showsPrec1 (appPrec + 1) s . showString " " .+ showsPrec1 (appPrec + 1) p++instance (Show1 s, Show1 p) => Show1 (WithStartState s p) where+ showDict1 = ShowDictClass++-- | A combination of a patch and its final state. The state, in this module, is+-- typically represented by a 'RepoModel' value. The @px@ type is typically a+-- patch type applied to its pre-state, e.g. @Prim x@.+data WithEndState s px C(y) = WithEndState {+ wesPatch :: px C(y)+ , wesEndState :: s C(y)+ }+ deriving Eq++instance (Show1 s, Show1 p) => Show (WithEndState s p C(x)) where+ showsPrec d (WithEndState p s) = showParen (d > appPrec) $ showString "WithEndState " .+ showsPrec1 (appPrec + 1) p . showString " " .+ showsPrec1 (appPrec + 1) s+++instance (Show1 s, Show1 p) => Show1 (WithEndState s p) where+ showDict1 = ShowDictClass+++----------------------------------------------------------------------+-- * ArbitraryState generators++-- | A type class to generate arbitrary values, threading a state through the+-- arbitrary calls. So this can be used to generate a patch that comes after+-- another patch. The post-state of the generated patch is hidden by the+-- 'Sealed'.+class ArbitraryState s p where+ arbitraryState :: s C(x) -> Gen (Sealed (WithEndState s (p C(x))))+ -- does a coarbitrary make sense?+++instance ArbitraryState s p => ArbitraryState s (WithState s p) where+ arbitraryState s = do Sealed (WithEndState x s') <- arbitraryState s+ return $ seal $ WithEndState (WithState s x s') s'+++instance ArbitraryState s p => ArbitraryState s (p :> p) where+ arbitraryState s = do Sealed (WithEndState p1 s') <- arbitraryState s+ Sealed (WithEndState p2 s'') <- arbitraryState s'+ return $ seal $ WithEndState (p1 :> p2) s'' ++instance ArbitraryState s p => ArbitraryState s (p :> p :> p) where+ arbitraryState s0 = do Sealed (WithEndState p1 s1) <- arbitraryState s0+ Sealed (WithEndState p2 s2) <- arbitraryState s1+ Sealed (WithEndState p3 s3) <- arbitraryState s2+ return $ seal $ WithEndState (p1 :> p2 :> p3) s3++arbitraryFL :: ArbitraryState s p => FORALL(x) Int -> s C(x) -> Gen (Sealed (WithEndState s (FL p C(x))))+arbitraryFL 0 s = return $ seal $ WithEndState NilFL s+arbitraryFL n s = do Sealed (WithEndState x s') <- arbitraryState s+ Sealed (WithEndState xs s'') <- arbitraryFL (n-1) s'+ return $ seal $ WithEndState (x :>: xs) s''++instance ArbitraryState s p => ArbitraryState s (FL p) where+ arbitraryState s = sized $ \n -> do k <- choose (0, min 2 (n `div` 5))+ arbitraryFL k s+++makeGen :: ArbitraryState s p => Gen (s C(x)) -> Gen (Sealed2 p)+makeGen stGen = do s <- stGen+ Sealed (WithEndState p _) <- arbitraryState s+ return $ seal2 p++makeWSGen :: ArbitraryState s p => Gen (s C(x)) -> Gen (Sealed2 (WithState s p))+makeWSGen stGen = do s <- stGen+ Sealed (WithEndState wsP _) <- arbitraryState s+ return $ seal2 wsP
− src/Darcs/Test/Unit.lhs
@@ -1,766 +0,0 @@-% 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.--\documentclass{report}-\usepackage{color}--\usepackage{verbatim}-\newenvironment{code}{\color{blue}\verbatim}{\endverbatim}--\begin{document}--% Definition of title page:-\title{- Unit Testing for darcs in Haskell-}-\author{- David Roundy % insert author(s) here-}--\maketitle--\tableofcontents % Table of Contents--\chapter{Introduction}--This is a unit testing program, which is intended to make sure that all the-functions of my darcs code work properly.--\begin{code}-{-# OPTIONS_GHC -cpp -fno-warn-orphans -fno-warn-deprecations -fglasgow-exts #-}-{-# LANGUAGE CPP #-}--module Darcs.Test.Unit (main) where--import System.IO.Unsafe ( unsafePerformIO )-import ByteStringUtils hiding ( intercalate )-import qualified Data.ByteString.Char8 as BC ( unpack, pack )-import qualified Data.ByteString as B ( concat, empty )-import Darcs.Patch-import Darcs.Test.Patch.Test-import Darcs.Test.Patch.Unit ( patchUnitTests )-import Darcs.Test.Email ( emailParsing, emailHeaderNoLongLines,- emailHeaderAsciiChars, emailHeaderLinesStart,- emailHeaderNoEmptyLines )-import Darcs.Test.Patch.Info ( metadataDecodingTest, metadataEncodingTest,- packUnpackTest )-import Lcs ( shiftBoundaries )-import Test.QuickCheck-import Printer ( renderPS )-import Darcs.Patch.Commute-import Data.Array.Base-import Data.Array.Unboxed-import Control.Monad.ST-import Darcs.Witnesses.Ordered-import Darcs.Witnesses.Sealed ( Sealed(Sealed), unsafeUnseal )-import Test.HUnit ( assertBool, assertFailure )-import Test.Framework.Providers.QuickCheck2 ( testProperty )-import Test.Framework.Providers.HUnit ( testCase )-import Test.Framework.Runners.Console ( defaultMain )-import Test.Framework ( Test )--#include "impossible.h"-\end{code}--\chapter{Main body of code}--\begin{code}-main :: IO ()-main = do- putStr ("There are a total of "++(show (length primitiveTestPatches))- ++" primitive patches.\n")- putStr ("There are a total of "++- (show (length testPatches))++" patches.\n")- defaultMain tests---- | Utility function to run bools with test-framework-testBool :: String -> Bool -> Test-testBool name test = testCase name (assertBool assertName test)- where assertName = "boolean test \"" ++ name ++ "\" should return True"---- | Utility function to run old tests that return a list of error messages,--- with the empty list meaning success.-testStringList :: String -> [String] -> Test-testStringList name test = testCase name $ mapM_ assertFailure test---- | This is the big list of tests that will be run using testrunner.-tests :: [Test]-tests = patchUnitTests ++- [testBool "Checking that UTF-8 packing and unpacking preserves 'hello world'"- (unpackPSFromUTF8 (BC.pack "hello world") == "hello world"),- testBool "Checking that hex packing and unpacking preserves 'hello world'"- (BC.unpack (fromHex2PS $ fromPS2Hex $ BC.pack "hello world")- == "hello world"),- emailParsing,- emailHeaderNoLongLines,- emailHeaderAsciiChars,- emailHeaderLinesStart,- emailHeaderNoEmptyLines,- testProperty "Checking that B.concat works" propConcatPS,- testProperty "Checking that hex conversion works" propHexConversion,- testProperty "Checking that show and read work right" propReadShow,- testStringList "Checking known commutes" commuteTests,- testStringList "Checking known merges" mergeTests,- testStringList "Checking known canons" canonizationTests]- ++ checkSubcommutes subcommutesInverse "patch and inverse both commute"- ++ checkSubcommutes subcommutesNontrivialInverse "nontrivial commutes are correct"- ++ checkSubcommutes subcommutesFailure "inverses fail"- ++- [testProperty "Checking that commuting by patch and its inverse is ok" propCommuteInverse,- --putStr "Checking that conflict resolution is valid... "- --runQuickCheckTest returnval propResolveConflictsValid- testProperty "Checking that a patch followed by its inverse is identity" propPatchAndInverseIsIdentity,- -- The following tests are "wrong" with the Conflictor code.- --putStr "Checking that a simple smart_merge is sufficient... "- --runQuickCheckTest returnval propSimpleSmartMergeGoodEnough- --putStr "Checking that an elegant merge is sufficient... "- --runQuickCheckTest returnval propElegantMergeGoodEnough- testProperty "Checking that commutes are equivalent" propCommuteEquivalency,- testProperty "Checking that merges are valid" propMergeValid,- testProperty "Checking inverses being valid" propInverseValid,- testProperty "Checking other inverse being valid" propOtherInverseValid,- testStringList "Checking merge swaps" mergeSwapTests,- -- The patch generator isn't smart enough to generate correct test- -- cases for the following: (which will be obsoleted soon, anyhow)- --putStr "Checking the order dependence of unravel... "- --runQuickCheckTest returnval propUnravelOrderIndependent- --putStr "Checking the unravelling of three merges... "- --runQuickCheckTest returnval propUnravelThreeMerge- --putStr "Checking the unravelling of a merge of a sequence... "- --runQuickCheckTest returnval propUnravelSeqMerge- testProperty "Checking inverse of inverse" propInverseComposition,- testProperty "Checking the order of commutes" propCommuteEitherOrder,- testProperty "Checking commute either way" propCommuteEitherWay,- testProperty "Checking the double commute" propCommuteTwice,- testProperty "Checking that merges commute and are well behaved" propMergeIsCommutableAndCorrect,- testProperty "Checking that merges can be swapped" propMergeIsSwapable,- testProperty "Checking again that merges can be swapped (I'm paranoid) " propMergeIsSwapable,- testStringList "Checking that the patch validation works" testCheck,- testStringList "Checking commute/recommute" commuteRecommuteTests,- testStringList "Checking merge properties" genericMergeTests,- testStringList "Testing the lcs code" showLcsTests,- testStringList "Checking primitive patch IO functions" primitiveShowReadTests,- testStringList "Checking IO functions" showReadTests,- testStringList "Checking primitive commute/recommute" primitiveCommuteRecommuteTests,- metadataDecodingTest,- metadataEncodingTest,- packUnpackTest- ]-\end{code}--\chapter{Unit Tester}--The unit tester function is really just a glorified map for functions that-return lists, in which the lists get concatenated (where map would end up-with a list of lists).--\begin{code}-type PatchUnitTest p = p -> [String]-type TwoPatchUnitTest = Patch -> Patch -> [String]--parallelPairUnitTester :: TwoPatchUnitTest -> [(Patch:\/:Patch)] -> [String]-parallelPairUnitTester _ [] = []-parallelPairUnitTester thetest ((p1:\/:p2):ps)- = (thetest p1 p2)++(parallelPairUnitTester thetest ps)--pairUnitTester :: TwoPatchUnitTest -> [(Patch:<Patch)] -> [String]-pairUnitTester _ [] = []-pairUnitTester thetest ((p1:<p2):ps)- = (thetest p1 p2)++(pairUnitTester thetest ps)-\end{code}--\chapter{LCS}--Here are a few quick tests of the shiftBoundaries function.--\begin{code}-showLcsTests :: [String]-showLcsTests = concatMap checkKnownShifts knownShifts-checkKnownShifts :: ([Int],[Int],String,String,[Int],[Int])- -> [String]-checkKnownShifts (ca, cb, sa, sb, ca', cb') = runST (- do ca_arr <- newListArray (0, length ca) $ toBool (0:ca)- cb_arr <- newListArray (0, length cb) $ toBool (0:cb)- let p_a = listArray (0, length sa) $ B.empty:(toPS sa)- p_b = listArray (0, length sb) $ B.empty:(toPS sb)- shiftBoundaries ca_arr cb_arr p_a 1 1- shiftBoundaries cb_arr ca_arr p_b 1 1- ca_res <- fmap (fromBool . tail) $ getElems ca_arr- cb_res <- fmap (fromBool . tail) $ getElems cb_arr- return $ if ca_res == ca' && cb_res == cb' then []- else ["shiftBoundaries failed on "++sa++" and "++sb++" with "- ++(show (ca,cb))++" expected "++(show (ca', cb'))- ++" got "++(show (ca_res, cb_res))++"\n"])- where toPS = map (\c -> if c == ' ' then B.empty else BC.pack [c])- toBool = map (>0)- fromBool = map (\b -> if b then 1 else 0)--knownShifts :: [([Int],[Int],String,String,[Int],[Int])]-knownShifts =- [([0,0,0],[0,1,0,1,0],"aaa","aaaaa",- [0,0,0],[0,0,0,1,1]),- ([0,1,0],[0,1,1,0],"cd ","c a ",- [0,1,0],[0,1,1,0]),- ([1,0,0,0,0,0,0,0,0],[1,0,0,0,0,0,1,1,1,1,1,0,0,0], "fg{} if{}","dg{} ih{} if{}",- [1,0,0,0,0,0,0,0,0],[1,0,0,0,0,1,1,1,1,1,0,0,0,0]), -- prefer empty line at end- ([0,0,0,0,0,0,0,0,0],[0,0,0,0,0,0,1,1,1,1,1,0,0,0], "fg{} if{}","fg{} ih{} if{}",- [0,0,0,0,0,0,0,0,0],[0,0,0,0,0,1,1,1,1,1,0,0,0,0]), -- prefer empty line at end- ([],[1,1],"","aa",[],[1,1]),- ([1,1],[],"aa","",[1,1],[])]---\end{code}--\chapter{Show/Read tests}--This test involves calling ``show'' to print a string describing a patch,-and then using readPatch to read it back in, and making sure the patch we-read in is the same as the original. Useful for making sure that I don't-have any stupid IO bugs.--\begin{code}-showReadTests :: [String]-showReadTests = concatMap tShowRead testPatches ++- concatMap tShowRead testPatchesNamed-primitiveShowReadTests :: [String]-primitiveShowReadTests = concatMap tShowRead primitiveTestPatches-tShowRead :: (Eq p, Show p, Patchy p) => PatchUnitTest p-tShowRead p =- case readPatch $ renderPS $ showPatch p of- Just (Sealed p',_) -> if p' == p then []- else ["Failed to read shown: "++(show p)++"\n"]- Nothing -> ["Failed to read at all: "++(show p)++"\n"]--instance MyEq p => Eq (Named p) where- (==) = unsafeCompare-\end{code}--\chapter{Canonization tests}--This is a set of known correct canonizations, to make sure that I'm-canonizing as I ought.--\begin{code}-canonizationTests :: [String]-canonizationTests = concatMap checkKnownCanon knownCanons-checkKnownCanon :: (Patch, Patch) -> [String]-checkKnownCanon (p1,p2) =- if (fromPrims $ concatFL $ mapFL_FL canonize $ sortCoalesceFL $ effect p1) == p2- then []- else ["Canonization failed:\n"++show p1++"canonized is\n"- ++show (fromPrims $ concatFL $ mapFL_FL canonize $ sortCoalesceFL $ effect p1 :: Patch)- ++"which is not\n"++show p2]-knownCanons :: [(Patch,Patch)]-knownCanons =- [(quickhunk 1 "abcde" "ab", quickhunk 3 "cde" ""),- (quickhunk 1 "abcde" "bd", join_patches [quickhunk 1 "a" "",- quickhunk 2 "c" "",- quickhunk 3 "e" ""]),- (join_patches [quickhunk 4 "a" "b",- quickhunk 1 "c" "d"],- join_patches [quickhunk 1 "c" "d",- quickhunk 4 "a" "b"]),- (join_patches [quickhunk 1 "a" "",- quickhunk 1 "" "b"],- quickhunk 1 "a" "b"),- (join_patches [quickhunk 1 "ab" "c",- quickhunk 1 "cd" "e"],- quickhunk 1 "abd" "e"),- (quickhunk 1 "abcde" "cde", quickhunk 1 "ab" ""),- (quickhunk 1 "abcde" "acde", quickhunk 2 "b" "")]-quickhunk :: Int -> String -> String -> Patch-quickhunk l o n = fromPrim $ hunk "test" l (map (\c -> BC.pack [c]) o)- (map (\c -> BC.pack [c]) n)-\end{code}--\chapter{Merge/unmgerge tests}--It should always be true that if two patches can be unmerged, then merging-the resulting patches should give them back again.-\begin{code}-genericMergeTests :: [String]-genericMergeTests =- case take 400 [(p1:\/:p2)|- i <- [0..(length testPatches)-1],- p1<-[testPatches!!i],- p2<-drop i testPatches,- checkAPatch $ join_patches [invert p2,p1]] of- merge_pairs -> (parallelPairUnitTester tMergeEitherWayValid merge_pairs) ++- (parallelPairUnitTester tMergeSwapMerge merge_pairs)-tMergeEitherWayValid :: TwoPatchUnitTest-tMergeEitherWayValid p1 p2 =- case join_patches [p2, quickmerge (p1:\/: p2)] of- combo2 ->- case join_patches [p1, quickmerge (p2:\/: p1)] of- combo1 ->- if not $ checkAPatch $ join_patches [combo1]- then ["oh my combo1 invalid:\n"++show p1++"and...\n"++show p2++show combo1]- else- if checkAPatch $ join_patches [invert combo1, combo2]- then []- else ["merge both ways invalid:\n"++show p1++"and...\n"++show p2++- show combo1++- show combo2]-tMergeSwapMerge :: TwoPatchUnitTest-tMergeSwapMerge p1 p2 =- if (swapp $ merge (p2:\/: p1)) == merge (p1:\/:p2)- then []- else ["Failed to swap merges:\n"++show p1++"and...\n"++show p2- ++"merged:\n"++show (merge (p1:\/:p2))++"\n"- ++"merged and swapped:\n"++show (swapp $ merge (p2:\/: p1))++"\n"]- where swapp (x :/\: y) = y :/\: x--instance Show p => Show (p :/\: p) where- show (x :/\: y) = show x ++ " :/\\: " ++ show y-instance Eq p => Eq (p :/\: p) where- (x :/\: y) == (x' :/\: y') = x == x' && y == y'-\end{code}--\chapter{Commute/recommute tests}--Here we test to see if commuting patch A and patch B and then commuting the-result gives us patch A and patch B again. The set of patches (A,B) is-chosen from the set of all pairs of test patches by selecting those which-commute with one another.--\begin{code}-commuteRecommuteTests :: [String]-commuteRecommuteTests =- case take 200 [(p2:<p1)|- p1<-testPatches,- p2<-filter (\p->checkseq [p1,p]) testPatches,- commute (p1:>p2) /= Nothing] of- commute_pairs -> pairUnitTester tCommuteRecommute commute_pairs- where checkseq ps = checkAPatch $ join_patches ps-primitiveCommuteRecommuteTests :: [String]-primitiveCommuteRecommuteTests =- pairUnitTester tCommuteRecommute- [(p1:<p2)|- p1<-primitiveTestPatches,- p2<-primitiveTestPatches,- commute (p2:>p1) /= Nothing,- checkAPatch $ join_patches [p2,p1]]-tCommuteRecommute :: TwoPatchUnitTest-tCommuteRecommute p1 p2 =- if (commute (p2:>p1) >>= commute) == Just (p2:>p1)- then []- else ["Failed to recommute:\n"++(show p2)++(show p1)++- "we saw it as:\n"++show (commute (p2:>p1))++- "\nAnd recommute was:\n"++show (commute (p2:>p1) >>= commute)- ++ "\n"]-\end{code}--\chapter{Commute tests}--Here we provide a set of known interesting commutes.-\begin{code}-commuteTests :: [String]-commuteTests =- concatMap checkKnownCommute knownCommutes++- concatMap checkCantCommute knownCantCommute-checkKnownCommute :: (Patch:< Patch, Patch:< Patch) -> [String]-checkKnownCommute (p1:<p2,p2':<p1') =- case commute (p2:>p1) of- Just (p1a:>p2a) ->- if (p2a:< p1a) == (p2':< p1')- then []- else ["Commute gave wrong value!\n"++show p1++"\n"++show p2- ++"should be\n"++show p2'++"\n"++show p1'- ++"but is\n"++show p2a++"\n"++show p1a]- Nothing -> ["Commute failed!\n"++show p1++"\n"++show p2]- ++- case commute (p1':>p2') of- Just (p2a:>p1a) ->- if (p1a:< p2a) == (p1:< p2)- then []- else ["Commute gave wrong value!\n"++show p2a++"\n"++show p1a- ++"should have been\n"++show p2'++"\n"++show p1']- Nothing -> ["Commute failed!\n"++show p2'++"\n"++show p1']-knownCommutes :: [(Patch:<Patch,Patch:<Patch)]-knownCommutes = [- (testhunk 1 [] ["A"]:<- testhunk 2 [] ["B"],- testhunk 3 [] ["B"]:<- testhunk 1 [] ["A"]),- (fromPrim (tokreplace "test" "A-Za-z_" "old" "new"):<- testhunk 2- ["hello world all that is old is good old_"]- ["I don't like old things"],- testhunk 2- ["hello world all that is new is good old_"]- ["I don't like new things"]:<- fromPrim (tokreplace "test" "A-Za-z_" "old" "new")),- (testhunk 1 ["A"] ["B"]:<- testhunk 2 ["C"] ["D"],- testhunk 2 ["C"] ["D"]:<- testhunk 1 ["A"] ["B"]),- (fromPrim (rmfile "NwNSO"):<- (quickmerge (fromPrim (addfile "hello"):\/:fromPrim (addfile "hello"))),- (quickmerge (fromPrim (addfile "hello"):\/:fromPrim (addfile "hello"))):<- fromPrim (rmfile "NwNSO")),-- (quickmerge (testhunk 3 ["o"] ["n"]:\/:- testhunk 3 ["o"] ["v"]):<- testhunk 1 [] ["a"],- testhunk 1 [] ["a"]:<- quickmerge (testhunk 2 ["o"] ["n"]:\/:- testhunk 2 ["o"] ["v"])),-- (testhunk 1 ["A"] []:<- testhunk 3 ["B"] [],- testhunk 2 ["B"] []:<- testhunk 1 ["A"] []),-- (testhunk 1 ["A"] ["B"]:<- testhunk 2 ["B"] ["C"],- testhunk 2 ["B"] ["C"]:<- testhunk 1 ["A"] ["B"]),-- (testhunk 1 ["A"] ["B"]:<- testhunk 3 ["B"] ["C"],- testhunk 3 ["B"] ["C"]:<- testhunk 1 ["A"] ["B"]),-- (testhunk 1 ["A"] ["B","C"]:<- testhunk 2 ["B"] ["C","D"],- testhunk 3 ["B"] ["C","D"]:<- testhunk 1 ["A"] ["B","C"])]- where testhunk l o n = fromPrim $ hunk "test" l (map BC.pack o) (map BC.pack n)--checkCantCommute :: (Patch:< Patch) -> [String]-checkCantCommute (p1:<p2) =- case commute (p2:>p1) of- Nothing -> []- _ -> [show p1 ++ "\n\n" ++ show p2 ++- "\nArgh, these guys shouldn't commute!\n"]-knownCantCommute :: [(Patch:< Patch)]-knownCantCommute = [- (testhunk 2 ["o"] ["n"]:<- testhunk 1 [] ["A"]),- (testhunk 1 [] ["A"]:<- testhunk 1 ["o"] ["n"]),- (quickmerge (testhunk 2 ["o"] ["n"]:\/:- testhunk 2 ["o"] ["v"]):<- testhunk 1 [] ["a"]),- (fromPrim (hunk "test" 1 ([BC.pack "a"]) ([BC.pack "b"])):<- fromPrim (addfile "test"))]- where testhunk l o n = fromPrim $ hunk "test" l (map BC.pack o) (map BC.pack n)-\end{code}--\chapter{Merge tests}--Here we provide a set of known interesting merges.-\begin{code}-mergeTests :: [String]-mergeTests =- concatMap checkKnownMergeEquiv knownMergeEquivs++- concatMap checkKnownMerge knownMerges-checkKnownMerge :: (Patch:\/: Patch, Patch) -> [String]-checkKnownMerge (p1:\/:p2,p1') =- case merge (p1:\/:p2) of- _ :/\: p1a ->- if p1a == p1'- then []- else ["Merge gave wrong value!\n"++show p1++show p2- ++"I expected\n"++show p1'- ++"but found instead\n"++show p1a]-knownMerges :: [(Patch:\/:Patch,Patch)]-knownMerges = [- (testhunk 2 [BC.pack "c"] [BC.pack "d",BC.pack "e"]:\/:- testhunk 1 [BC.pack "x"] [BC.pack "a",BC.pack "b"],- testhunk 3 [BC.pack "c"] [BC.pack "d",BC.pack "e"]),- (testhunk 1 [BC.pack "x"] [BC.pack "a",BC.pack "b"]:\/:- testhunk 2 [BC.pack "c"] [BC.pack "d",BC.pack "e"],- testhunk 1 [BC.pack "x"] [BC.pack "a",BC.pack "b"]),- (testhunk 3 [BC.pack "A"] []:\/:- testhunk 1 [BC.pack "B"] [],- testhunk 2 [BC.pack "A"] []),- (fromPrim (rmdir "./test/world"):\/:- fromPrim (hunk "./world" 3 [BC.pack "A"] []),- fromPrim (rmdir "./test/world")),-- (join_patches [quickhunk 1 "a" "bc",- quickhunk 6 "d" "ef"]:\/:- join_patches [quickhunk 3 "a" "bc",- quickhunk 8 "d" "ef"],- join_patches [quickhunk 1 "a" "bc",- quickhunk 7 "d" "ef"]),-- (testhunk 1 [BC.pack "A"] [BC.pack "B"]:\/:- testhunk 2 [BC.pack "B"] [BC.pack "C"],- testhunk 1 [BC.pack "A"] [BC.pack "B"]),-- (testhunk 2 [BC.pack "A"] [BC.pack "B",BC.pack "C"]:\/:- testhunk 1 [BC.pack "B"] [BC.pack "C",BC.pack "D"],- testhunk 3 [BC.pack "A"] [BC.pack "B",BC.pack "C"])]- where testhunk l o n = fromPrim $ hunk "test" l o n-checkKnownMergeEquiv :: (Patch:\/:Patch,Patch) -> [String]-checkKnownMergeEquiv (p1:\/: p2, pe) =- case quickmerge (p1:\/:p2) of- p1' -> if checkAPatch $ join_patches [invert p1, p2, p1', invert pe]- then []- else ["Oh no, merger isn't equivalent...\n"++show p1++"\n"++show p2- ++"in other words\n" ++ show (p1 :\/: p2)- ++"merges as\n" ++ show (merge $ p1 :\/: p2)- ++"merges to\n" ++ show (quickmerge $ p1 :\/: p2)- ++"which is equivalent to\n" ++ show (effect p1')- ++ "should all work out to\n"- ++ show pe]-knownMergeEquivs :: [(Patch:\/: Patch, Patch)]-knownMergeEquivs = [-- -- The following tests are going to be failed by the- -- Conflictor code as a cleanup.-- --(addfile "test":\/:- -- adddir "test",- -- join_patches [adddir "test",- -- addfile "test-conflict"]),- --(move "silly" "test":\/:- -- adddir "test",- -- join_patches [adddir "test",- -- move "silly" "test-conflict"]),- --(addfile "test":\/:- -- move "old" "test",- -- join_patches [addfile "test",- -- move "old" "test-conflict"]),- --(move "a" "test":\/:- -- move "old" "test",- -- join_patches [move "a" "test",- -- move "old" "test-conflict"]),- (fromPrim (hunk "test" 1 [] [BC.pack "A"]):\/:- fromPrim (hunk "test" 1 [] [BC.pack "B"]),- fromPrim (hunk "test" 1 [] [BC.pack "A", BC.pack "B"])),- (fromPrim (hunk "test" 1 [] [BC.pack "a"]):\/:- fromPrim (hunk "test" 1 [BC.pack "b"] []),- identity),- --hunk "test" 1 [] [BC.pack "v v v v v v v",- -- BC.pack "*************",- -- BC.pack "a",- -- BC.pack "b",- -- BC.pack "^ ^ ^ ^ ^ ^ ^"]),- (quickhunk 4 "a" "":\/:- quickhunk 3 "a" "",- quickhunk 3 "aa" ""),- (join_patches [quickhunk 1 "a" "bc",- quickhunk 6 "d" "ef"]:\/:- join_patches [quickhunk 3 "a" "bc",- quickhunk 8 "d" "ef"],- join_patches [quickhunk 3 "a" "bc",- quickhunk 8 "d" "ef",- quickhunk 1 "a" "bc",- quickhunk 7 "d" "ef"]),- (quickmerge (quickhunk 2 "" "bd":\/:quickhunk 2 "" "a"):\/:- quickmerge (quickhunk 2 "" "c":\/:quickhunk 2 "" "a"),- quickhunk 2 "" "abdc")- ]-\end{code}--It also is useful to verify that it doesn't matter which order we specify-the patches when we merge.--\begin{code}-mergeSwapTests :: [String]-mergeSwapTests =- concat- [checkMergeSwap p1 p2 |- p1<-primitiveTestPatches,- p2<-primitiveTestPatches,- checkAPatch $ join_patches [invert p1,p2]- ]-checkMergeSwap :: Patch -> Patch -> [String]-checkMergeSwap p1 p2 =- case merge (p2:\/:p1) of- _ :/\: p2' ->- case merge (p1:\/:p2) of- _ :/\: p1' ->- case commute (p1:>p2') of- Just (_:>p1'b) ->- if p1'b /= p1'- then ["Merge swapping problem with...\np1 "++- show p1++"merged with\np2 "++- show p2++"p1' is\np1' "++- show p1'++"p1'b is\np1'b "++- show p1'b- ]- else []- Nothing -> ["Merge commuting problem with...\np1 "++- show p1++"merged with\np2 "++- show p2++"gives\np2' "++- show p2'++"which doesn't commute with p1.\n"- ]-\end{code}--\chapter{Patch test data}--This is where we define the set of patches which we run our tests on. This-should be kept up to date with as many interesting permutations of patch-types as possible.--\begin{code}-testPatches :: [Patch]-testPatchesNamed :: [Named Patch]-testPatchesAddfile :: [Patch]-testPatchesRmfile :: [Patch]-testPatchesHunk :: [Patch]-primitiveTestPatches :: [Patch]-testPatchesBinary :: [Patch]-testPatchesCompositeNocom :: [Patch]-testPatchesComposite :: [Patch]-testPatchesTwoCompositeHunks :: [Patch]-testPatchesCompositeHunks :: [Patch]-testPatchesCompositeFourHunks :: [Patch]-testPatchesMerged :: [Patch]-validPatches :: [Patch]--testPatchesNamed = [unsafePerformIO $- namepatch "date is" "patch name" "David Roundy" []- (fromPrim $ addfile "test"),- unsafePerformIO $- namepatch "Sat Oct 19 08:31:13 EDT 2002"- "This is another patch" "David Roundy"- ["This log file has","two lines in it"]- (fromPrim $ rmfile "test")]-testPatchesAddfile = map fromPrim- [addfile "test",adddir "test",addfile "test/test"]-testPatchesRmfile = map invert testPatchesAddfile-testPatchesHunk =- [fromPrim $ hunk file line old new |- file <- ["test"],- line <- [1,2],- old <- map (map BC.pack) partials,- new <- map (map BC.pack) partials,- old /= new- ]- where partials = [["A"],["B"],[],["B","B2"]]--primitiveTestPatches = testPatchesAddfile ++- testPatchesRmfile ++- testPatchesHunk ++- [unsafeUnseal.fst.fromJust.readPatch $- BC.pack "move ./test/test ./hello",- unsafeUnseal.fst.fromJust.readPatch $- BC.pack "move ./test ./hello"] ++- testPatchesBinary--testPatchesBinary =- [fromPrim $ binary "./hello"- (BC.pack $ "agadshhdhdsa75745457574asdgg" ++- "a326424677373735753246463gadshhdhdsaasdgg" ++- "a326424677373735753246463gadshhdhdsaasdgg" ++- "a326424677373735753246463gadshhdhdsaasdgg")- (BC.pack $ "adafjttkykrehhtrththrthrthre" ++- "a326424677373735753246463gadshhdhdsaasdgg" ++- "a326424677373735753246463gadshhdhdsaasdgg" ++- "a326424677373735753246463gadshhdhdsaagg"),- fromPrim $ binary "./hello"- B.empty- (BC.pack "adafjttkykrere")]--testPatchesCompositeNocom =- take 50 [join_patches [p1,p2]|- p1<-primitiveTestPatches,- p2<-filter (\p->checkseq [p1,p]) primitiveTestPatches,- commute (p1:>p2) == Nothing]- where checkseq ps = checkAPatch $ join_patches ps--testPatchesComposite =- take 100 [join_patches [p1,p2]|- p1<-primitiveTestPatches,- p2<-filter (\p->checkseq [p1,p]) primitiveTestPatches,- commute (p1:>p2) /= Nothing,- commute (p1:>p2) /= Just (p2:>p1)]- where checkseq ps = checkAPatch $ join_patches ps--testPatchesTwoCompositeHunks =- take 100 [join_patches [p1,p2]|- p1<-testPatchesHunk,- p2<-filter (\p->checkseq [p1,p]) testPatchesHunk]- where checkseq ps = checkAPatch $ join_patches ps--testPatchesCompositeHunks =- take 100 [join_patches [p1,p2,p3]|- p1<-testPatchesHunk,- p2<-filter (\p->checkseq [p1,p]) testPatchesHunk,- p3<-filter (\p->checkseq [p1,p2,p]) testPatchesHunk]- where checkseq ps = checkAPatch $ join_patches ps--testPatchesCompositeFourHunks =- take 100 [join_patches [p1,p2,p3,p4]|- p1<-testPatchesHunk,- p2<-filter (\p->checkseq [p1,p]) testPatchesHunk,- p3<-filter (\p->checkseq [p1,p2,p]) testPatchesHunk,- p4<-filter (\p->checkseq [p1,p2,p3,p]) testPatchesHunk]- where checkseq ps = checkAPatch $ join_patches ps--testPatchesMerged =- take 200- [joinPatches $ flattenFL p2+>+flattenFL (quickmerge (p1:\/:p2)) |- p1<-take 10 (drop 15 testPatchesCompositeHunks)++primitiveTestPatches- ++take 10 (drop 15 testPatchesTwoCompositeHunks)- ++ take 2 (drop 4 testPatchesCompositeFourHunks),- p2<-take 10 testPatchesCompositeHunks++primitiveTestPatches- ++take 10 testPatchesTwoCompositeHunks- ++take 2 testPatchesCompositeFourHunks,- checkAPatch $ join_patches [invert p1, p2],- commute (p2:>p1) /= Just (p1:>p2)- ]--testPatches = primitiveTestPatches ++- testPatchesComposite ++- testPatchesCompositeNocom ++- testPatchesMerged-\end{code}--\chapter{Check patch test}-Check patch is supposed to verify that a patch is valid.--\begin{code}-validPatches = [(join_patches [quickhunk 4 "a" "b",- quickhunk 1 "c" "d"]),- (join_patches [quickhunk 1 "a" "bc",- quickhunk 1 "b" "d"]),- (join_patches [quickhunk 1 "a" "b",- quickhunk 1 "b" "d"])]++testPatches--testCheck :: [String]-testCheck = concatMap tTestCheck validPatches-tTestCheck :: PatchUnitTest Patch-tTestCheck p = if checkAPatch p- then []- else ["Failed the check: "++show p++"\n"]--propHexConversion :: String -> Bool-propHexConversion s =- fromHex2PS (fromPS2Hex $ BC.pack s) == BC.pack s-propConcatPS :: [String] -> Bool-propConcatPS ss = concat ss == BC.unpack (B.concat $ map BC.pack ss)---- | Groups a set of tests by giving them the same prefix in their description.--- When this is called as @checkSubcommutes subcoms expl@, the prefix for a--- test becomes @"Checking " ++ expl ++ " for subcommute "@.-checkSubcommutes :: Testable a => [(String, a)] -> String- -> [Test]-checkSubcommutes subcoms expl = map check_subcommute subcoms- where check_subcommute (name, test) =- let testName = "Checking" ++ expl ++ " for subcommute " ++ name- in testProperty testName test-\end{code}--\end{document}--
+ src/Darcs/Test/Util/QuickCheck.hs view
@@ -0,0 +1,58 @@++module Darcs.Test.Util.QuickCheck+ ( upper+ , lower+ , alpha+ , notIn+ , uniques+ , maybeOf+ , bSized+ )+ where+++import Control.Applicative+import Test.QuickCheck.Gen++++-- | An uppercase alphabetic character.+upper :: Gen Char+upper = choose ('A','Z')++-- | A lowercase alphabetic character.+lower :: Gen Char+lower = choose ('a','z')++-- | An alphabetic character.+alpha :: Gen Char+alpha = oneof [upper, lower]++-- | @gen `notIn` xs@ generate a @x@ that is not in @xs@.+notIn :: Eq a => Gen a -> [a] -> Gen a+gen `notIn` xs = gen `suchThat` (`notElem` xs)++-- | @uniques k gen@ generates a list of @k@ unique values.+uniques :: Eq a => Int -> Gen a -> Gen [a]+uniques k gen = go k []+ where+ go 0 xs = return xs+ go n xs = do x <- gen `notIn` xs+ go (n-1) (x:xs)++-- | Try to arbitrarily pick some element of the list.+maybeOf :: [a] -> Gen (Maybe a)+maybeOf [] = return Nothing+maybeOf xs = Just <$> elements xs+++-- | A bounded sized combinator.+bSized :: Int -- ^ Lower bound+ -> Double -- ^ Increment+ -> Int -- ^ Upper bound+ -> (Int -> Gen a) -> Gen a+bSized low inc upp mkGen = sized $ mkGen . resize+ where+ resize :: Int -> Int+ resize n = let x = fromIntegral n+ in min upp (floor(inc*x) + low)
+ src/Darcs/Test/Util/TestResult.hs view
@@ -0,0 +1,63 @@++module Darcs.Test.Util.TestResult+ ( TestResult+ , succeeded+ , failed+ , rejected+ , (<&&>)+ , fromMaybe+ , isOk+ , isFailed+ )+ where+++import Printer ( Doc, renderString )++import qualified Test.QuickCheck.Property as Q++++data TestResult = TestSucceeded+ | TestFailed Doc+ | TestRejected -- ^ Rejects test case+++succeeded :: TestResult+succeeded = TestSucceeded++failed :: Doc -- ^ Error message+ -> TestResult+failed = TestFailed++rejected :: TestResult+rejected = TestRejected++-- | @t <&&> s@ fails <=> t or s fails+-- @t <&&> s@ succeeds <=> none fails and some succeeds+-- @t <&&> s@ is rejected <=> both are rejected+(<&&>) :: TestResult -> TestResult -> TestResult+t@(TestFailed _) <&&> _s = t+_t <&&> s@(TestFailed _) = s+TestRejected <&&> s = s+t <&&> TestRejected = t+TestSucceeded <&&> TestSucceeded = TestSucceeded++-- | 'Nothing' is considered success whilst 'Just' is considered failure.+fromMaybe :: Maybe Doc -> TestResult+fromMaybe Nothing = succeeded+fromMaybe (Just errMsg) = failed errMsg++isFailed :: TestResult -> Bool+isFailed (TestFailed _) = True+isFailed _other = False++-- | A test is considered OK if it does not fail.+isOk :: TestResult -> Bool+isOk = not . isFailed++ -- 'Testable' instance is defined by converting 'TestResult' to 'QuickCheck.Property.Result'+instance Q.Testable TestResult where+ property TestSucceeded = Q.property Q.succeeded+ property (TestFailed errorMsg) = Q.property (Q.failed{Q.reason = renderString errorMsg})+ property TestRejected = Q.property Q.rejected
src/Darcs/TheCommands.hs view
@@ -18,21 +18,21 @@ {-# LANGUAGE CPP #-} module Darcs.TheCommands ( commandControlList ) where -import Prelude hiding ( log )+import Prelude () import Darcs.Commands.Add ( add ) import Darcs.Commands.AmendRecord ( amendrecord ) import Darcs.Commands.Annotate ( annotate ) import Darcs.Commands.Apply ( apply ) import Darcs.Commands.Changes ( changes, log )-import Darcs.Commands.Check ( check )+import Darcs.Commands.Check ( check, repair ) import Darcs.Commands.Convert ( convert )-import Darcs.Commands.Diff+import Darcs.Commands.Diff ( diffCommand ) import Darcs.Commands.Dist ( dist ) import Darcs.Commands.Get ( get, clone ) import Darcs.Commands.GZCRCs ( gzcrcs ) import Darcs.Commands.Init ( initialize ) import Darcs.Commands.Show ( showCommand, list, query )-import Darcs.Commands.MarkConflicts ( markconflicts, resolve )+import Darcs.Commands.MarkConflicts ( markconflicts ) import Darcs.Commands.Move ( move, mv ) import Darcs.Commands.Optimize ( optimize ) import Darcs.Commands.Pull ( pull, fetch )@@ -40,7 +40,6 @@ import Darcs.Commands.Put ( put ) import Darcs.Commands.Record ( record, commit ) import Darcs.Commands.Remove ( remove, rm, unadd )-import Darcs.Commands.Repair ( repair ) import Darcs.Commands.Replace ( replace ) import Darcs.Commands.Revert ( revert ) import Darcs.Commands.Rollback ( rollback )@@ -51,7 +50,7 @@ import Darcs.Commands.TransferMode ( transferMode ) import Darcs.Commands.Unrecord ( unrecord, unpull, obliterate ) import Darcs.Commands.Unrevert ( unrevert )-import Darcs.Commands.WhatsNew ( whatsnew )+import Darcs.Commands.WhatsNew ( whatsnew, status ) import Darcs.Commands ( CommandControl(CommandData,HiddenCommand,GroupName) ) -- | The commands that darcs knows about (e.g. whatsnew, record),@@ -65,12 +64,12 @@ CommandData replace, CommandData revert, CommandData unrevert,- CommandData whatsnew,+ CommandData whatsnew, HiddenCommand status, GroupName "Copying changes between the working copy and the repository:", CommandData record, HiddenCommand commit, CommandData unrecord, CommandData amendrecord,- CommandData markconflicts, HiddenCommand resolve,+ CommandData markconflicts, GroupName "Direct modification of the repository:", CommandData tag, CommandData setpref,
src/Darcs/URL.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} {-@@ -24,12 +23,13 @@ Path resolving: - * A URL contains the sequence @\":\/\/\"@.+ * An http URL contains the sequence @\"http(s):\/\/\"@. * A local filepath does not contain colons, except- as second character (windows drives).+ as second character (windows drives) when this+ filepath is meant to be used as repository name - * A path that is neither a URL nor a local file+ * A path that is neither an http URL nor a local file is an ssh-path. Examples:@@ -48,34 +48,79 @@ -} module Darcs.URL (- isFile, isUrl, isSsh, isRelative, isAbsolute,- isSshNopath+ isFile, isHttpUrl, isSshUrl, isRelative, isAbsolute,+ isSshNopath, SshFilePath, sshRepo, sshUhost, sshFile, urlOf, splitSshUrl ) where +import Darcs.Global(darcsdir)+import Data.List ( isPrefixOf, isInfixOf )+import Data.Char ( isSpace )+import qualified System.FilePath as FP (isRelative, isAbsolute, isValid)+ #include "impossible.h" isRelative :: String -> Bool-isRelative (_:':':_) = False-isRelative f@(c:_) = isFile f && c /= '/' && c /= '~' isRelative "" = bug "Empty filename in isRelative"+isRelative f = FP.isRelative f isAbsolute :: String -> Bool isAbsolute "" = bug "isAbsolute called with empty filename"-isAbsolute f = isFile f && (not $ isRelative f)+isAbsolute f = FP.isAbsolute f isFile :: String -> Bool-isFile (_:_:fou) = ':' `notElem` fou-isFile _ = True+isFile f@(_:_:fou) = ':' `notElem` fou && FP.isValid f+isFile f = FP.isValid f -isUrl :: String -> Bool-isUrl (':':'/':'/':_:_) = True-isUrl (_:x) = isUrl x-isUrl "" = False+isHttpUrl :: String -> Bool+isHttpUrl u =+ let u' = dropWhile isSpace u in+ ("http://" `isPrefixOf` u') || ("https://" `isPrefixOf` u') -isSsh :: String -> Bool-isSsh s = not (isFile s || isUrl s) +isSshUrl :: String -> Bool+isSshUrl s = isu' (dropWhile isSpace s)+ where+ isu' s'+ | "ssh://" `isPrefixOf` s' = True+ | "://" `isInfixOf` s' = False+ | isFile s' = False+ | otherwise = ":" `isInfixOf` s'+ isSshNopath :: String -> Bool isSshNopath s = case reverse s of ':':x@(_:_:_) -> ':' `notElem` x _ -> False++-- | Gives the (user, host, dir) out of an ssh url+splitSshUrl :: String -> SshFilePath+splitSshUrl s | "ssh://" `isPrefixOf` s =+ let s' = drop (length "ssh://") $ dropWhile isSpace s+ (dir, file) = cleanrepodir '/' s'+ in+ SshFP { sshUhost = takeWhile (/= '/') s'+ , sshRepo = dir+ , sshFile = file }+splitSshUrl s =+ let (dir, file) = cleanrepodir ':' s in+ SshFP { sshUhost = dropWhile isSpace $ takeWhile (/= ':') s+ , sshRepo = dir+ , sshFile = file }+++cleanrepourl :: String -> (String, String)+cleanrepourl zzz | dd `isPrefixOf` zzz = ([], drop (length dd) zzz)+ where dd = darcsdir++"/"+cleanrepourl (z:zs) =+ let (repo',file) = cleanrepourl zs in+ (z : repo', file)+cleanrepourl "" = ([],[])++cleanrepodir :: Char -> String -> (String, String)+cleanrepodir sep = cleanrepourl . drop 1 . dropWhile (/= sep)++data SshFilePath = SshFP { sshUhost :: String+ , sshRepo :: String+ , sshFile :: String}++urlOf :: SshFilePath -> String+urlOf (SshFP uhost dir file) = uhost ++ ":" ++ dir ++ "/" ++ darcsdir ++ "/" ++ file
src/Darcs/Utils.hs view
@@ -2,19 +2,28 @@ {-# LANGUAGE CPP, ForeignFunctionInterface #-} -module Darcs.Utils ( catchall, ortryrunning, nubsort, breakCommand,- clarifyErrors, prettyException, prettyError,- putStrLnError, putDocLnError,- withCurrentDirectory,- withUMask, askUser, stripCr,- showHexLen, addToErrorLoc,- maybeGetEnv, firstNotBlank, firstJustM, firstJustIO,- getViewer, editFile, runEditor,- PromptConfig(..), promptYorn, promptChar,- environmentHelpEditor, environmentHelpPager,- formatPath,- isFileReallySymlink, doesDirectoryReallyExist, doesFileReallyExist-+module Darcs.Utils ( ortryrunning, nubsort, breakCommand+ , showHexLen+ , maybeGetEnv+ , formatPath+ -- * Monads+ , firstJustIO+ -- * User prompts+ , askUser, askUserListItem+ , PromptConfig(..), promptYorn, promptChar+ -- * Text+ , getViewer, editFile, runEditor+ , stripCr+ -- * Help+ , environmentHelpEditor, environmentHelpPager+ -- * Errors and exceptions+ , catchall+ , clarifyErrors, prettyException, prettyError+ , addToErrorLoc+ -- * Files and directories+ , isFileReallySymlink, doesDirectoryReallyExist, doesFileReallyExist+ , withCurrentDirectory+ , withUMask -- * Tree filtering. , filterFilePaths, filterPaths -- * Tree lookup.@@ -30,17 +39,15 @@ import Darcs.SignalHandler ( catchNonSignal ) import Numeric ( showHex ) import System.Directory ( doesFileExist )-import System.Exit ( exitWith, ExitCode(..) )+import System.Exit ( ExitCode(..) ) import System.Environment ( getEnv )-import System.IO ( hPutStrLn, stderr )-import Data.Char ( toUpper, toLower )+import Data.Char ( toUpper, toLower, isSpace ) import Darcs.RepoPath ( FilePathLike, getCurrentDirectory, setCurrentDirectory, toFilePath )-import Data.Maybe ( listToMaybe, isJust )+import Data.Maybe ( isJust ) import Data.List ( group, sort ) import Control.Monad ( when, forM )-import Control.Monad.Error( catchError, MonadError )+import Control.Monad.Error( MonadError ) import Exec ( execInteractive )-import Printer ( Doc, hPutDocLn ) import Foreign.C.String ( CString, withCString ) import Foreign.C.Error ( throwErrno ) import Foreign.C.Types ( CInt )@@ -52,14 +59,15 @@ import Progress ( withoutProgress ) import System.Console.Haskeline ( runInputT, defaultSettings, getInputLine,- getInputChar, outputStrLn )+ getInputChar, outputStr, outputStrLn ) import qualified Data.ByteString as B ( readFile ) import Control.Monad.State.Strict( gets ) import Storage.Hashed.AnchoredPath( AnchoredPath(..), Name(..), isPrefix, floatPath )-import Storage.Hashed.Monad( withDirectory, fileExists, exists, directoryExists+import Storage.Hashed.Monad( withDirectory, fileExists, directoryExists , virtualTreeMonad, currentDirectory- , TreeMonad, tree )+ , TreeMonad )+import qualified Storage.Hashed.Monad as HS ( exists, tree ) import Storage.Hashed.Tree( Tree, listImmediate, findTree ) showHexLen :: (Integral a) => Int -> a -> String@@ -73,7 +81,7 @@ a `catchall` b = a `catchNonSignal` (\_ -> b) maybeGetEnv :: String -> IO (Maybe String)-maybeGetEnv s = (getEnv s >>= return.Just) `catchall` return Nothing -- err can only be isDoesNotExist+maybeGetEnv s = fmap Just (getEnv s) `catchall` return Nothing -- err can only be isDoesNotExist -- |The firstJustM returns the first Just entry in a list of monadic operations. This is close to@@ -89,7 +97,7 @@ -- firstJustIO will silently turn any monad call that throws an -- exception into Nothing, basically causing it to be ignored. firstJustIO :: [IO (Maybe a)] -> IO (Maybe a)-firstJustIO = firstJustM . map (\o -> o `catchall` return Nothing)+firstJustIO = firstJustM . map (`catchall` return Nothing) clarifyErrors :: IO a -> String -> IO a@@ -117,12 +125,6 @@ (Right x) -> return x -- legitimate success/failure (Left (_ :: SomeException)) -> b -- an exception -putStrLnError :: String -> IO ()-putStrLnError = hPutStrLn stderr--putDocLnError :: Doc -> IO ()-putDocLnError = hPutDocLn stderr- withCurrentDirectory :: FilePathLike p => p -> IO a -> IO a withCurrentDirectory name m = bracket@@ -139,7 +141,7 @@ withUMask :: String -> IO a -> IO a withUMask umask job =- do rc <-withCString umask set_umask+ do rc <- withCString umask set_umask when (rc < 0) (throwErrno "Couldn't set umask") bracket_ (return ())@@ -153,23 +155,38 @@ getInputLine prompt >>= maybe (error "askUser: unexpected end of input") return +-- | @askUserListItem prompt xs@ enumerates @xs@ on the screen, allowing+-- the user to choose one of the items+askUserListItem :: String -> [String] -> IO String+askUserListItem prompt xs = withoutProgress $ runInputT defaultSettings $ do+ outputStr . unlines $ zipWith (\n x -> show n ++ ". " ++ x) [1::Int ..] xs+ loop+ where+ loop = do+ answer <- getInputLine prompt+ >>= maybe (error "askUser: unexpected end of input") return+ case maybeRead answer of+ Just n | n > 0 && n <= length xs -> return (xs !! (n-1))+ _ -> outputStrLn "Invalid response, try again!" >> loop++maybeRead :: Read a => String -> Maybe a+maybeRead s = case reads s of+ [(x, rest)] | all isSpace rest -> Just x+ _ -> Nothing+ stripCr :: String -> String stripCr "" = "" stripCr "\r" = "" stripCr (c:cs) = c : stripCr cs --- |Returns Just l where l is first non-blank string in input array; Nothing if no non-blank entries-firstNotBlank :: [String] -> Maybe String-firstNotBlank = listToMaybe . filter (not . null) - -- Format a path for screen output, -- so that the user sees where the path begins and ends. -- Could (should?) also warn about unprintable characters here. formatPath :: String -> String formatPath path = "\"" ++ quote path ++ "\"" where quote "" = ""- quote (c:cs) = if c=='\\' || c=='"'+ quote (c:cs) = if c `elem` ['\\', '"'] then '\\':c:quote cs else c:quote cs @@ -182,16 +199,15 @@ nubsort = map head . group . sort -editFile :: FilePathLike p => p -> IO ExitCode+-- | @editFile f@ lets the user edit a file which could but does not need+-- to already exist. This function returns the exit code from the text+-- editor and a flag indicating if the user made any changes.+editFile :: FilePathLike p => p -> IO (ExitCode, Bool) editFile ff = do old_content <- file_content ec <- runEditor f new_content <- file_content- when (new_content == old_content) $ do- yorn <- promptYorn "File content did not change. Continue anyway?"- when (yorn == 'n') $ do putStrLn "Aborted."- exitWith ExitSuccess- return ec+ return (ec, new_content /= old_content) where f = toFilePath ff file_content = do exists <- doesFileExist f@@ -242,12 +258,13 @@ , pHelp :: [Char] } -promptYorn :: [Char] -> IO Char-promptYorn p = promptChar (PromptConfig p "yn" [] Nothing [])+-- | Prompt the user for a yes or no+promptYorn :: [Char] -> IO Bool+promptYorn p = (== 'y') `fmap` promptChar (PromptConfig p "yn" [] Nothing []) promptChar :: PromptConfig -> IO Char promptChar (PromptConfig p basic_chs adv_chs md help_chs) =- withoutProgress $ runInputT defaultSettings $ loopChar+ withoutProgress $ runInputT defaultSettings loopChar where chs = basic_chs ++ adv_chs loopChar = do@@ -257,8 +274,7 @@ return case () of _ | a `elem` chs -> return a- | a == ' ' -> case md of Nothing -> tryAgain- Just d -> return d+ | a == ' ' -> maybe tryAgain return md | a `elem` help_chs -> return a | otherwise -> tryAgain helpStr = case help_chs of@@ -275,8 +291,7 @@ -- that is either a parent or a child of any of the listed paths, and discard -- everything else. filterPaths :: [AnchoredPath] -> AnchoredPath -> t -> Bool-filterPaths files =- \p _ -> any (\x -> x `isPrefix` p || p `isPrefix` x) files+filterPaths files p _ = any (\x -> x `isPrefix` p || p `isPrefix` x) files -- | Same as 'filterPath', but for ordinary 'FilePath's (as opposed to -- AnchoredPath).@@ -303,7 +318,7 @@ existsAnycase (AnchoredPath []) = return True existsAnycase (AnchoredPath (Name x:xs)) = do wd <- currentDirectory- Just tree <- gets (flip findTree wd . tree)+ Just tree <- gets (flip findTree wd . HS.tree) let subs = [ AnchoredPath [Name n] | (Name n, _) <- listImmediate tree, BSC.map toLower n == BSC.map toLower x ] or `fmap` forM subs (\path -> do@@ -312,7 +327,7 @@ else withDirectory path (existsAnycase $ AnchoredPath xs)) treeHas :: (MonadError e m, Functor m, Monad m) => Tree m -> FilePath -> m Bool-treeHas tree path = fst `fmap` virtualTreeMonad (exists $ floatPath path) tree+treeHas tree path = fst `fmap` virtualTreeMonad (HS.exists $ floatPath path) tree treeHasDir :: (MonadError e m, Functor m, Monad m) => Tree m -> FilePath -> m Bool treeHasDir tree path = fst `fmap` virtualTreeMonad (directoryExists $ floatPath path) tree
+ src/Darcs/Witnesses/Eq.hs view
@@ -0,0 +1,54 @@+#include "gadts.h"+module Darcs.Witnesses.Eq (+ EqCheck(..), MyEq(..), isIsEq+) where++import Darcs.Witnesses.Unsafe ( unsafeCoerceP )++-- |'EqCheck' is used to pass around evidence (or lack thereof) of+-- two witness types being equal.+data EqCheck C(a b) where+ IsEq :: EqCheck C(a a)+ NotEq :: EqCheck C(a b)++instance Eq (EqCheck C(a b)) where+ IsEq == IsEq = True+ NotEq == NotEq = True+ _ == _ = False++instance Show (EqCheck C(a b)) where+ show IsEq = "IsEq"+ show NotEq = "NotEq"++-- |An witness aware equality class.+-- A minimal definition defines any one of 'unsafeCompare', '=\/=' and '=/\='.+class MyEq p where+ -- |It is unsafe to define a class instance via this method, because+ -- if it returns True then the default implementations of '=\/=' and '=/\='+ -- will coerce the equality of two witnesses.+ --+ -- Calling this method is safe, although '=\/=' or '=/\=' would be better+ -- choices as it is not usually meaningul to compare two patches that+ -- don't share either a starting or an ending context+ unsafeCompare :: p C(a b) -> p C(c d) -> Bool+ unsafeCompare a b = IsEq == (a =/\= unsafeCoerceP b)++ -- |Compare two things with the same starting witness. If the things+ -- compare equal, evidence of the ending witnesses being equal will+ -- be returned.+ (=\/=) :: p C(a b) -> p C(a c) -> EqCheck C(b c)+ a =\/= b | unsafeCompare a b = unsafeCoerceP IsEq+ | otherwise = NotEq++ -- |Compare two things with the same ending witness. If the things+ -- compare equal, evidence of the starting witnesses being equal will+ -- be returned.+ (=/\=) :: p C(a c) -> p C(b c) -> EqCheck C(a b)+ a =/\= b | IsEq == (a =\/= unsafeCoerceP b) = unsafeCoerceP IsEq+ | otherwise = NotEq++infix 4 =\/=, =/\=++isIsEq :: EqCheck C(a b) -> Bool+isIsEq IsEq = True+isIsEq NotEq = False
src/Darcs/Witnesses/Ordered.hs view
@@ -15,53 +15,31 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP #-}--- , MagicHash, TypeOperators, GADTs #-} #include "gadts.h" -module Darcs.Witnesses.Ordered ( EqCheck(..), isEq, (:>)(..), (:<)(..), (:\/:)(..), (:/\:)(..), (:||:)(..),- FL(..), RL(..),Proof(..),+module Darcs.Witnesses.Ordered ( (:>)(..), (:<)(..), (:\/:)(..), (:/\:)(..), (:||:)(..),+ FL(..), RL(..), lengthFL, mapFL, mapFL_FL, spanFL, foldlFL, allFL, anyFL, filterFL, splitAtFL, splitAtRL, bunchFL, foldlRL, lengthRL, isShorterThanRL, mapRL, mapRL_RL, zipWithFL,- unsafeMap_l2f, filterE, filterFLFL,+ filterFLFL, filterRL, reverseFL, reverseRL, (+>+), (+<+),- nullFL, concatFL, concatRL, concatReverseFL, headRL,- MyEq, unsafeCompare, (=\/=), (=/\=),+ nullFL, concatFL, concatRL, consRLSealed, nullRL, toFL,- (:>>)(..),- unsafeCoercePStart, unsafeCoercePEnd,- unsafeCoerceP, unsafeCoerceP2, spanFL_M+ dropWhileFL, dropWhileRL,+ spanFL_M,+ eqFL, eqFLRev, eqFLUnsafe ) where #include "impossible.h"-import GHC.Base (unsafeCoerce#) import Darcs.Witnesses.Show-import Darcs.Witnesses.Sealed ( FlippedSeal(..), flipSeal, Sealed(..), FreeLeft, unFreeLeft, Sealed2(..) )--data EqCheck C(a b) where- IsEq :: EqCheck C(a a)- NotEq :: EqCheck C(a b)--instance Eq (EqCheck C(a b)) where- IsEq == IsEq = True- NotEq == NotEq = True- _ == _ = False--isEq :: EqCheck C(a b) -> Bool-isEq IsEq = True-isEq NotEq = False--instance Show (EqCheck C(a b)) where- show IsEq = "IsEq"- show NotEq = "NotEq"--data Proof a C(x y) where- Proof :: a -> Proof a C(x x)+import Darcs.Witnesses.Sealed ( FlippedSeal(..), flipSeal, Sealed(..), FreeLeft, unFreeLeft, Sealed2(..),+ seal )+import Darcs.Witnesses.Eq ( MyEq(..), EqCheck(..) ) data (a1 :> a2) C(x y) = FORALL(z) (a1 C(x z)) :> (a2 C(z y)) infixr 1 :>@@ -72,34 +50,6 @@ data (a1 :/\: a2) C(x y) = FORALL(z) (a1 C(x z)) :/\: (a2 C(y z)) data (a1 :||: a2) C(x y) = (a1 C(x y)) :||: (a2 C(x y)) -data (a1 :>> a2) C(y) = FORALL(z) (a1 C(z)) :>> (a2 C(z y))-infixr 1 :>>--class MyEq p where- -- Minimal definition defines any one of unsafeCompare, =\/= and =/\=.- unsafeCompare :: p C(a b) -> p C(c d) -> Bool- unsafeCompare a b = IsEq == (a =/\= unsafeCoerceP b)- (=\/=) :: p C(a b) -> p C(a c) -> EqCheck C(b c)- a =\/= b | unsafeCompare a b = unsafeCoerceP IsEq- | otherwise = NotEq- (=/\=) :: p C(a c) -> p C(b c) -> EqCheck C(a b)- a =/\= b | IsEq == (a =\/= unsafeCoerceP b) = unsafeCoerceP IsEq- | otherwise = NotEq--infix 4 =\/=, =/\=--unsafeCoerceP :: a C(x y) -> a C(b c)-unsafeCoerceP = unsafeCoerce#--unsafeCoercePStart :: a C(x1 y) -> a C(x2 y)-unsafeCoercePStart = unsafeCoerce#--unsafeCoercePEnd :: a C(x y1) -> a C(x y2)-unsafeCoercePEnd = unsafeCoerce#--unsafeCoerceP2 :: t C(w x y z) -> t C(a b c d)-unsafeCoerceP2 = unsafeCoerce#- instance (Show2 a, Show2 b) => Show ( (a :> b) C(x y) ) where showsPrec d (x :> y) = showOp2 1 ":>" d x y @@ -107,10 +57,16 @@ (a1 :> b1) =\/= (a2 :> b2) | IsEq <- a1 =\/= a2 = b1 =\/= b2 | otherwise = NotEq +instance (MyEq a, MyEq b) => Eq ((a :> b) C(x y)) where+ (==) = unsafeCompare+ instance (MyEq a, MyEq b) => MyEq (a :< b) where (a1 :< b1) =\/= (a2 :< b2) | IsEq <- b1 =\/= b2 = a1 =\/= a2 | otherwise = NotEq +instance (MyEq a, MyEq b) => Eq ((a :< b) C(x y)) where+ (==) = unsafeCompare+ instance (Show2 a, Show2 b) => Show2 (a :> b) where showDict2 = ShowDictClass @@ -120,10 +76,6 @@ instance (Show2 a, Show2 b) => Show2 (a :\/: b) where showDict2 = ShowDictClass -instance MyEq a => Eq (Sealed (a C(x))) where- Sealed x == Sealed y | IsEq <- x =\/= y = True- | otherwise = False- infixr 5 :>:, :<:, +>+, +<+ -- forward list@@ -137,9 +89,24 @@ showString " :>: " . showsPrec (prec + 1) xs where prec = 5 +instance Show2 a => Show1 (FL a C(x)) where+ showDict1 = ShowDictClass+ instance Show2 a => Show2 (FL a) where showDict2 = ShowDictClass +instance Show2 a => Show (RL a C(x z)) where+ showsPrec _ NilRL = showString "NilRL"+ showsPrec d (x :<: xs) = showParen (d > prec) $ showsPrec2 (prec + 1) x .+ showString " :<: " . showsPrec (prec + 1) xs+ where prec = 5++instance Show2 a => Show1 (RL a C(x)) where+ showDict1 = ShowDictClass++instance Show2 a => Show2 (RL a) where+ showDict2 = ShowDictClass+ -- reverse list data RL a C(x z) where (:<:) :: a C(y z) -> RL a C(x y) -> RL a C(x z)@@ -158,17 +125,11 @@ filterFLFL f (x:>:xs) | IsEq <- f x = filterFLFL f xs | otherwise = x :>: filterFLFL f xs -filterRL :: (FORALL(x y) p C(x y) -> Bool) -> RL p C(x y) -> [Sealed2 p]+filterRL :: (FORALL(x y) p C(x y) -> Bool) -> RL p C(a b) -> [Sealed2 p] filterRL _ NilRL = [] filterRL f (x :<: xs) | f x = Sealed2 x : (filterRL f xs) | otherwise = filterRL f xs -filterE :: (a -> EqCheck C(x y)) -> [a] -> [Proof a C(x y)]-filterE _ [] = []-filterE p (x:xs)- | IsEq <- p x = Proof x : filterE p xs- | otherwise = filterE p xs- (+>+) :: FL a C(x y) -> FL a C(y z) -> FL a C(x z) NilFL +>+ ys = ys (x:>:xs) +>+ ys = x :>: xs +>+ ys@@ -272,7 +233,7 @@ mapFL _ NilFL = [] mapFL f (a :>: b) = f a : mapFL f b -filterFL :: (FORALL(x y) a C(x y) -> Bool) -> FL a C(x y) -> [Sealed2 a]+filterFL :: (FORALL(x y) a C(x y) -> Bool) -> FL a C(w z) -> [Sealed2 a] filterFL _ NilFL = [] filterFL f (a :>: b) = if f a then (Sealed2 a):(filterFL f b)@@ -282,10 +243,6 @@ mapRL _ NilRL = [] mapRL f (a :<: b) = f a : mapRL f b -unsafeMap_l2f :: (FORALL(w z) a -> b C(w z)) -> [a] -> FL b C(x y)-unsafeMap_l2f _ [] = unsafeCoerceP NilFL-unsafeMap_l2f f (x:xs) = f x :>: unsafeMap_l2f f xs- lengthFL :: FL a C(x z) -> Int lengthFL xs = l xs 0 where l :: FL a C(x z) -> Int -> Int@@ -303,13 +260,6 @@ isShorterThanRL NilRL _ = True isShorterThanRL (_:<:xs) n = isShorterThanRL xs (n-1) -concatReverseFL :: FL (RL a) C(x y) -> RL a C(x y)-concatReverseFL = concatRL . reverseFL--headRL :: RL a C(x y) -> FlippedSeal a C(y)-headRL (x:<:_) = flipSeal x-headRL _ = impossible- consRLSealed :: a C(y z) -> FlippedSeal (RL a) C(y) -> FlippedSeal (RL a) C(z) consRLSealed a (FlippedSeal as) = flipSeal $ a :<: as @@ -317,3 +267,32 @@ toFL [] = Sealed NilFL toFL (x:xs) = case unFreeLeft x of Sealed y -> case toFL xs of Sealed ys -> Sealed (y :>: ys) +dropWhileFL :: (FORALL(x y) a C(x y) -> Bool) -> FL a C(r v) -> FlippedSeal (FL a) C(v)+dropWhileFL _ NilFL = flipSeal NilFL+dropWhileFL p xs@(x:>:xs')+ | p x = dropWhileFL p xs'+ | otherwise = flipSeal xs++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++-- |Check that two 'FL's are equal element by element.+-- This differs from the 'MyEq' instance for 'FL' which+-- uses commutation.+eqFL :: MyEq a => FL a C(x y) -> FL a C(x z) -> EqCheck C(y z)+eqFL NilFL NilFL = IsEq+eqFL (x:>:xs) (y:>:ys) | IsEq <- x =\/= y, IsEq <- eqFL xs ys = IsEq+eqFL _ _ = NotEq++eqFLRev :: MyEq a => FL a C(x z) -> FL a C(y z) -> EqCheck C(x y)+eqFLRev NilFL NilFL = IsEq+eqFLRev (x:>:xs) (y:>:ys) | IsEq <- eqFLRev xs ys, IsEq <- x =/\= y = IsEq+eqFLRev _ _ = NotEq++eqFLUnsafe :: MyEq a => FL a C(x y) -> FL a C(z w) -> Bool+eqFLUnsafe NilFL NilFL = True+eqFLUnsafe (x:>:xs) (y:>:ys) = unsafeCompare x y && eqFLUnsafe xs ys+eqFLUnsafe _ _ = False
src/Darcs/Witnesses/Sealed.hs view
@@ -15,9 +15,7 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp -fglasgow-exts #-}-{-# LANGUAGE CPP #-}--- , MagicHash, GADTs #-}+{-# LANGUAGE CPP, FlexibleInstances #-} #include "gadts.h" @@ -28,9 +26,10 @@ unsealM, liftSM, Gap(..), FreeLeft, unFreeLeft, FreeRight, unFreeRight ) where--import GHC.Base ( unsafeCoerce# )+import Darcs.Witnesses.Eq ( MyEq, EqCheck(..) ) import Darcs.Witnesses.Show+import Darcs.Witnesses.Eq ( (=\/=) )+import Darcs.Witnesses.Unsafe ( unsafeCoerceP1, unsafeCoerceP ) data Sealed a where Sealed :: a C(x ) -> Sealed a@@ -38,6 +37,10 @@ seal :: a C(x ) -> Sealed a seal = Sealed +instance MyEq a => Eq (Sealed (a C(x ))) where+ Sealed x == Sealed y | IsEq <- x =\/= y = True+ | otherwise = False+ data Sealed2 a where Sealed2 :: !(a C(x y )) -> Sealed2 a @@ -51,13 +54,13 @@ flipSeal = FlippedSeal unsafeUnseal :: Sealed a -> a C(x)-unsafeUnseal (Sealed a) = unsafeCoerce# a+unsafeUnseal (Sealed a) = unsafeCoerceP1 a unsafeUnsealFlipped :: FlippedSeal a C(y) -> a C(x y)-unsafeUnsealFlipped (FlippedSeal a) = unsafeCoerce# a+unsafeUnsealFlipped (FlippedSeal a) = unsafeCoerceP a unsafeUnseal2 :: Sealed2 a -> a C(x y)-unsafeUnseal2 (Sealed2 a) = unsafeCoerce# a+unsafeUnseal2 (Sealed2 a) = unsafeCoerceP a unseal :: (FORALL(x) a C(x ) -> b) -> Sealed a -> b unseal f x = f (unsafeUnseal x)@@ -133,7 +136,8 @@ -- |A 'Gap' constructed from a completely polymorphic value, for example the constructors -- for primitive patches freeGap :: (FORALL(x y) p C(x y)) -> w p- -- |Compose two 'Gap' values together, e.g. 'joinGap (+>+)' or 'joinGap (:>:)'++ -- |Compose two 'Gap' values together in series, e.g. 'joinGap (+>+)' or 'joinGap (:>:)' joinGap :: (FORALL(x y z) p C(x y) -> q C(y z) -> r C(x z)) -> w p -> w q -> w r instance Gap FreeLeft where
src/Darcs/Witnesses/Show.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP #-} module Darcs.Witnesses.Show(ShowDict(..), showD, showListD, showsPrecD,
+ src/Darcs/Witnesses/Unsafe.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE MagicHash #-}+#include "gadts.h"+module Darcs.Witnesses.Unsafe (+ unsafeCoerceP, unsafeCoercePStart,+ unsafeCoercePEnd, unsafeCoerceP2,+ unsafeCoerceP1+) where++import GHC.Base (unsafeCoerce#)++unsafeCoerceP :: a C(x y) -> a C(b c)+unsafeCoerceP = unsafeCoerce#++unsafeCoercePStart :: a C(x1 y) -> a C(x2 y)+unsafeCoercePStart = unsafeCoerce#++unsafeCoercePEnd :: a C(x y1) -> a C(x y2)+unsafeCoercePEnd = unsafeCoerce#++unsafeCoerceP2 :: t C(w x y z) -> t C(a b c d)+unsafeCoerceP2 = unsafeCoerce#++unsafeCoerceP1 :: a C(x) -> a C(y)+unsafeCoerceP1 = unsafeCoerce#
src/Darcs/Witnesses/WZipper.hs view
@@ -15,7 +15,6 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP #-} #include "gadts.h"@@ -50,9 +49,13 @@ focus (FZipper _ (x :>: _)) = Just $ Sealed2 x focus _ = Nothing +-- | \"Clowns to the left of me, jokers to the right. Here I am, stuck+-- in the middle of you\"+-- <http://en.wikipedia.org/wiki/Stuck_in_the_Middle> clowns :: FZipper a C(x y) -> Sealed ((RL a) C(x)) clowns (FZipper l _) = Sealed l +-- | See 'clowns' jokers :: FZipper a C(x y) -> FlippedSeal (FL a) C(y) jokers (FZipper _ r) = FlippedSeal r
src/DateMatcher.hs view
@@ -16,7 +16,6 @@ -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -fglasgow-exts #-} {-# LANGUAGE ExistentialQuantification #-} module DateMatcher ( parseDateMatcher
src/English.hs view
@@ -45,12 +45,20 @@ -- > plural (Noun "bat") "" == "bats" -- > plural (Noun "mouse") "" == "mouses" -- :-( newtype Noun = Noun String+data Pronoun = It instance Countable Noun where -- more irregular nouns will just need to have their own type plural (Noun s) | "ch" `isSuffixOf` s = showString s . showString "es"+ plural (Noun s) | "y" `isSuffixOf` s+ && length s > 1+ && last (init s) `notElem` "aeiou" = showString (init s) . showString "ies" plural (Noun s) = showString s . showChar 's' singular (Noun s) = showString s++instance Countable Pronoun where+ plural It = showString "them"+ singular It = showString "it" -- | > singular This (Noun "batch") "" == "this batch" -- > plural This (Noun "batch") "" == "these batches"
src/Exec.hs view
@@ -16,9 +16,7 @@ -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -fglasgow-exts #-}-{-# LANGUAGE CPP, ForeignFunctionInterface #-}--- , DeriveDataTypeable #-}+{-# LANGUAGE CPP, ForeignFunctionInterface, DeriveDataTypeable #-} module Exec ( exec, execInteractive, withoutNonBlock,@@ -42,8 +40,11 @@ import System.Cmd ( system ) import System.IO ( IOMode(..), openBinaryFile, stdout ) import System.Process ( runProcess, terminateProcess, waitForProcess )+#if __GLASGOW_HASKELL__ >= 612+import GHC.IO.Handle ( hDuplicate )+#else import GHC.Handle ( hDuplicate )- -- urgh. hDuplicate isn't available from a standard place.+#endif import Control.Exception.Extensible ( bracketOnError, Exception(..), SomeException(..) ) import Darcs.Global ( whenDebugMode )
src/HTTP.hs view
@@ -1,23 +1,31 @@-{-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} -module HTTP( fetchUrl, postUrl, requestUrl, waitNextUrl ) where+module HTTP( fetchUrl, postUrl, requestUrl, waitNextUrl, ConnectionError(..) ) where import Darcs.Global ( debugFail ) import Version ( version ) #ifdef HAVE_HTTP-import Control.Monad ( when ) import Data.IORef ( newIORef, readIORef, writeIORef, IORef ) import Network.HTTP+import Network.Browser ( browse, request, setCheckForProxy, setErrHandler, setOutHandler ) import Network.URI-import System.Environment ( getEnv ) import System.IO.Error ( ioeGetErrorString ) import System.IO.Unsafe ( unsafePerformIO ) import Darcs.Global ( debugMessage ) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC #endif+-- | Data type to represent a connection error.+-- The following are the codes from libcurl+-- which map to each of the constructors:+-- * 6 -> CouldNotResolveHost : The remote host was not resolved.+-- * 7 -> CouldNotConnectToServer : Failed to connect() to host or proxy.+-- * 28 -> OperationTimeout: the specified time-out period was reached.+data ConnectionError = CouldNotResolveHost |+ CouldNotConnectToServer |+ OperationTimeout+ deriving (Eq, Read, Show) fetchUrl :: String -> IO String postUrl@@ -27,7 +35,7 @@ -> IO () -- ^ result requestUrl :: String -> FilePath -> a -> IO String-waitNextUrl :: IO (String, String)+waitNextUrl :: IO (String, String, Maybe ConnectionError) #ifdef HAVE_HTTP @@ -37,41 +45,43 @@ fetchUrl url = case parseURI url of Nothing -> fail $ "Invalid URI: " ++ url Just uri -> do debugMessage $ "Fetching over HTTP: "++url- proxy <- getProxy- when (not $ null proxy) $- debugFail "No proxy support for HTTP package yet (try libcurl)!"- resp <- simpleHTTP $ Request { rqURI = uri,- rqMethod = GET,- rqHeaders = headers,- rqBody = "" }+ resp <- catch (browse $ do+ setCheckForProxy True+ setOutHandler debugMessage+ setErrHandler debugMessage+ request Request { rqURI = uri,+ rqMethod = GET,+ rqHeaders = headers,+ rqBody = "" })+ (\err -> debugFail $ show err) case resp of- Right res@Response { rspCode = (2,0,0) } -> return (rspBody res)- Right Response { rspCode = (x,y,z) } ->+ (_, res@Response { rspCode = (2,0,0) }) -> return (rspBody res)+ (_, Response { rspCode = (x,y,z) }) -> debugFail $ "HTTP " ++ show x ++ show y ++ show z ++ " error getting " ++ show uri- Left err -> debugFail $ show err postUrl url body mime = case parseURI url of Nothing -> fail $ "Invalid URI: " ++ url Just uri -> do debugMessage $ "Posting to HTTP: "++url- proxy <- getProxy- when (not $ null proxy) $- debugFail "No proxy support for HTTP package yet (try libcurl)!"- resp <- simpleHTTP $ Request { rqURI = uri,- rqMethod = POST,- rqHeaders = headers ++ [Header HdrContentType mime,- Header HdrAccept "text/plain",- Header HdrContentLength- (show $ length body) ],- rqBody = body }+ resp <- catch (browse $ do+ setCheckForProxy True+ setOutHandler debugMessage+ setErrHandler debugMessage+ request Request { rqURI = uri,+ rqMethod = POST,+ rqHeaders = headers ++ [Header HdrContentType mime,+ Header HdrAccept "text/plain",+ Header HdrContentLength+ (show $ length body) ],+ rqBody = body })+ (\err -> debugFail $ show err) case resp of- Right res@Response { rspCode = (2,y,z) } -> do+ (_, res@Response { rspCode = (2,y,z) }) -> do putStrLn $ "Success 2" ++ show y ++ show z putStrLn (rspBody res) return ()- Right res@Response { rspCode = (x,y,z) } -> do+ (_, res@Response { rspCode = (x,y,z) }) -> do putStrLn $ rspBody res debugFail $ "HTTP " ++ show x ++ show y ++ show z ++ " error posting to " ++ show uri- Left err -> debugFail $ show err requestedUrl :: IORef (String, FilePath) requestedUrl = unsafePerformIO $ newIORef ("", "")@@ -86,17 +96,15 @@ waitNextUrl = do (u, f) <- readIORef requestedUrl if null u- then return ("", "No URL requested")+ then return ("", "No URL requested", Nothing) else do writeIORef requestedUrl ("", "") e <- (fetchUrl u >>= \s -> B.writeFile f (BC.pack s) >> return "") `catch` h- return (u, e)+ let ce = case e of+ "timeout" -> Just OperationTimeout+ _ -> Nothing+ return (u, e, ce) where h = return . ioeGetErrorString -getProxy :: IO String-getProxy =- getEnv "http_proxy"- `catch` \_ -> getEnv "HTTP_PROXY"- `catch` \_ -> return "" #else fetchUrl _ = debugFail "Network.HTTP does not exist"
src/IsoDate.hs view
@@ -155,15 +155,15 @@ cvsDateTime :: Int -> CharParser a CalendarTime cvsDateTime tz = do y <- year- char '/'+ _ <- char '/' mon <- monthNum- char '/'+ _ <- char '/' d <- day- mySpaces+ _ <- mySpaces h <- hour- char ':'+ _ <- char ':' m <- minute- char ':'+ _ <- char ':' s <- second z <- option tz $ mySpaces >> zone return (CalendarTime y mon d h m s 0 Monday 0 "" z False)@@ -173,19 +173,19 @@ -- darcs-doc: Question (what does the "old" stand for really?) oldDateTime :: CharParser a CalendarTime oldDateTime = do wd <- dayName- mySpaces+ _ <- mySpaces mon <- monthName- mySpaces+ _ <- mySpaces d <- day- mySpaces+ _ <- mySpaces h <- hour- char ':'+ _ <- char ':' m <- minute- char ':'+ _ <- char ':' s <- second- mySpaces+ _ <- mySpaces z <- zone- mySpaces+ _ <- mySpaces y <- year return (CalendarTime y mon d h m s 0 wd 0 "" z False) @@ -242,7 +242,7 @@ week_date = --yyyy-Www-d try $ do yfn <- year_ optional dash- char 'W'+ _ <- char 'W' -- offset human 'week 1' -> computer 'week 0' w' <- (\x -> x-1) `liftM` twoDigits mwd <- option Nothing $ do { optional dash; Just `fmap` nDigits 1 }@@ -298,7 +298,7 @@ | digsExp > picoExp = read $ take picoExp digs | otherwise = 10 ^ (picoExp - digsExp) * (read digs) return $ \c -> c { mctPicosec = Just $ frac }- zulu = do { char 'Z'; return (\c -> c { mctTZ = Just 0 }) }+ zulu = do { _ <- char 'Z'; return (\c -> c { mctTZ = Just 0 }) } offset = do sign <- choice [ do { char '+' >> return 1 } , do { char '-' >> return (-1) } ] h <- twoDigits@@ -319,13 +319,13 @@ iso8601Interval localTz = leftDur <|> rightDur where leftDur = do dur <- iso8601Duration- end <- option Nothing $ do { char '/'; Just `liftM` isoDt }+ end <- option Nothing $ do { _ <- char '/'; Just `liftM` isoDt } return $ case end of Nothing -> Left dur Just e -> Right (dur `subtractFromMCal` e, e) rightDur = do start <- isoDt- char '/'+ _ <- char '/' durOrEnd <- Left `liftM` iso8601Duration <|> Right `liftM` isoDt return $ case durOrEnd of Left dur -> Right (start, dur `addToMCal` start)@@ -343,12 +343,12 @@ -- * P4YT3H6S (four years, three hours and six seconds) iso8601Duration :: CharParser a TimeDiff iso8601Duration =- do char 'P'+ do _ <- char 'P' y <- block 0 'Y' mon <- block 0 'M' d <- block 0 'D' (h,m,s) <- option (0,0,0) $- do char 'T'+ do _ <- char 'T' h' <- block (-1) 'H' m' <- block (-1) 'M' s' <- block (-1) 'S'@@ -361,7 +361,7 @@ return $ TimeDiff y mon d h m s 0 where block d c = option d $ try $ do n <- many1 digit- char c+ _ <- char c return $ read n -- | 'optchain' @p xs@ parses a string with the obligatory@@ -481,8 +481,8 @@ -- * any sequence of alphabetic characters (WARNING! treated as 0!) zone :: CharParser a Int zone = choice- [ do { char '+'; h <- hour; m <- minute; return (((h*60)+m)*60) }- , do { char '-'; h <- hour; m <- minute; return (-((h*60)+m)*60) }+ [ do { _ <- char '+'; h <- hour; m <- minute; return (((h*60)+m)*60) }+ , do { _ <- char '-'; h <- hour; m <- minute; return (-((h*60)+m)*60) } , mkZone "UTC" 0 , mkZone "UT" 0 , mkZone "GMT" 0@@ -531,12 +531,12 @@ , mkZone "NZST" 12 , mkZone "NZDT" 13 -- if we don't understand it, just give a GMT answer...- , do { manyTill (oneOf $ ['a'..'z']++['A'..'Z']++[' '])+ , do { _ <- manyTill (oneOf $ ['a'..'z']++['A'..'Z']++[' ']) (lookAhead space_digit); return 0 } ] where mkZone n o = try $ do { caseString n; return (o*60*60) }- space_digit = try $ do { char ' '; oneOf ['0'..'9'] }+ space_digit = try $ do { _ <- char ' '; oneOf ['0'..'9'] } ----- English dates and intervals ----------------------------------------------- @@ -559,13 +559,13 @@ dateMaybeAtTime = try $ do ed <- englishDate now t <- option Nothing $ try $- do { space; optional $ caseString "at "; Just `liftM` englishTime }+ do { _ <- space; optional $ caseString "at "; Just `liftM` englishTime } return $ fromMaybe id t $ ed -- tea time 2005-12-04 timeThenDate = try $ do t <- englishTime optional $ char ','- space+ _ <- space ed <- englishDate now return $ t $ unsetTime $ ed @@ -600,10 +600,10 @@ englishAgo :: CalendarTime -> CharParser a CalendarTime englishAgo now = try $ do p <- englishDuration- try $ do space+ _ <- try $ do space (m,ref) <- (try $ caseString "ago" >> return ((-1), now)) <|> do m <- beforeMod <|> afterMod- space+ _ <- space d <- englishDate now <|> fst `fmap` englishLast now <|> unsafeToCalendarTime `fmap` iso8601DateTime (ctTZ now)@@ -631,26 +631,26 @@ <|> englishDateTime now) before = try $ do caseString "before"- space+ _ <- space end <- englishDT return (Just theBeginning, Just end) after = try $ do caseString "after"- space+ _ <- space start <- englishDT return (Just start, Nothing) twixt = try $ do caseString "between"- space+ _ <- space start <- englishDT- space+ _ <- space caseString "and"- space+ _ <- space end <- englishDT return (Just start, Just end) inTheLast = try $ do caseString "in the last"- space+ _ <- space dur <- englishDuration return (Just $ dur `subtractFromCal` now, Just now) lastetc =@@ -664,7 +664,7 @@ englishLast now = -- last year, last week, last 3 years, etc try $ do caseString "last"- space+ _ <- space d <- englishDuration return (d `subtractFromCal` now, now) @@ -698,12 +698,12 @@ -- just fine. englishDuration :: CharParser a TimeDiff englishDuration = try $- do n <- option 1 $ do { x <- many1 digit; space; (return $ read x) }+ do n <- option 1 $ do { x <- many1 digit; _ <- space; (return $ read x) } b <- base optional (caseString "es" <|> caseString "s") let current = multiplyDiff n b next <- option noTimeDiff $ try $ do- { optional space; char ',' ; optional space ; englishDuration }+ { optional space; _ <- char ',' ; optional space ; englishDuration } return $ addDiff current next where base = choice
src/Lcs.hs view
@@ -16,7 +16,6 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} -- | LCS stands for Longest Common Subsequence, and it is a relatively@@ -42,8 +41,7 @@ -- The last step tries to create longer changed regions and line up deletions -- in the first file to insertions in the second by shifting changed lines -- forward and backward.-module Lcs ( getChanges, aLen,- BArray, PArray, BSTArray,+module Lcs ( getChanges, shiftBoundaries ) where import Control.Monad@@ -67,8 +65,8 @@ dropStart :: PArray -> PArray -> Int -> [(Int,[B.ByteString],[B.ByteString])] dropStart a b off- | off > (aLen a) = [(off - 1, [], getSlice b off (aLen b))]- | off > (aLen b) = [(off - 1, getSlice a off (aLen a), [])]+ | off > aLen a = [(off - 1, [], getSlice b off (aLen b))]+ | off > aLen b = [(off - 1, getSlice a off (aLen a), [])] | a!off == b!off = dropStart a b (off + 1) | otherwise = dropEnd a b off 0 @@ -85,7 +83,7 @@ getSlice :: PArray -> Int -> Int -> [B.ByteString] getSlice a from to | from > to = []- | otherwise = (a!(from)):(getSlice a (from + 1) to)+ | otherwise = (a ! from) : (getSlice a (from + 1) to) getChanges' :: (PArray, (Int, Int)) -> (PArray, (Int, Int)) -> [(Int,[B.ByteString],[B.ByteString])]@@ -98,7 +96,7 @@ ah = toHash a abounds :: HArray mkAMap m (i:is) = let ins (_,_,_,new) (collision,_,_,old) =- (collision || not (new == old), True, False, old)+ (collision || (new /= old), True, False, old) m' = Map.insertWith ins (ah!i) (False, True, False, a!i) m in mkAMap m' is mkAMap m _ = m@@ -107,7 +105,7 @@ bh = toHash b bbounds :: HArray mkBMap m (i:is) = let ins (_,_,_,new) (collision,in_a,_,old) =- (collision || not (new == old), in_a, True, old)+ (collision || (new /= old), in_a, True, old) m' = Map.insertWith ins (bh!i) (False, False, True, b!i) m in mkBMap m' is mkBMap m _ = m@@ -122,8 +120,8 @@ Just (True,True,True,_) -> Just (i, markColl) Nothing -> impossible - a' = catMaybes $ map get [(i, ah!i) | i <- range (bounds ah)]- b' = catMaybes $ map get [(i, bh!i) | i <- range (bounds bh)]+ a' = mapMaybe get [(i, ah!i) | i <- range (bounds ah)]+ b' = mapMaybe get [(i, bh!i) | i <- range (bounds bh)] (c_a, c_b) = diffArr a' b' (a, abounds) (b, bbounds) @@ -144,21 +142,21 @@ end_b = (aLen p_b) c_a <- initVChanged end_a c_b <- initVChanged end_b- mapM_ (\ (l,_) -> writeArray c_a l False) $ a- mapM_ (\ (l,_) -> writeArray c_b l False) $ b+ mapM_ (\ (l,_) -> writeArray c_a l False) a+ mapM_ (\ (l,_) -> writeArray c_b l False) b _ <- cmpseq h_a h_b p_a p_b m_a m_b c_a c_b 0 0 (aLen h_a) (aLen h_b)- let unchanged ar = do {xs <- getElems ar; return $ (length $ filter not $ xs) -1}+ let unchanged ar = do {xs <- getElems ar; return $ length (filter not xs) -1} err <- liftM2 (/=) (unchanged c_a) (unchanged c_b)- when (err) impossible+ when err impossible -- Mark common lines at beginning and end- mapM_ (\ i -> writeArray c_a i False ) $ [1..(off_a - 1)]- mapM_ (\ i -> writeArray c_b i False ) $ [1..(off_b - 1)]- mapM_ (\ i -> writeArray c_a i False ) $ [(l_a + 1) .. (end_a)]- mapM_ (\ i -> writeArray c_b i False ) $ [(l_b + 1) .. (end_b)]+ mapM_ (\ i -> writeArray c_a i False ) [1..(off_a - 1)]+ mapM_ (\ i -> writeArray c_b i False ) [1..(off_b - 1)]+ mapM_ (\ i -> writeArray c_a i False ) [(l_a + 1) .. end_a]+ mapM_ (\ i -> writeArray c_b i False ) [(l_b + 1) .. end_b] shiftBoundaries c_a c_b p_a 1 1 shiftBoundaries c_b c_a p_b 1 1 err1 <- liftM2 (/=) (unchanged c_a) (unchanged c_b)- when (err1) impossible+ when err1 impossible c_a' <- unsafeFreeze c_a c_b' <- unsafeFreeze c_b return (c_a', c_b'))@@ -166,7 +164,7 @@ -- | set changes array for a and b and return number of changed lines cmpseq :: HArray -> HArray -> PArray -> PArray -> MapArray -> MapArray -> BSTArray s -> BSTArray s -> Int -> Int -> Int -> Int -> ST s Int-cmpseq _ _ _ _ _ _ _ _ _ _ 0 0 = do return 0+cmpseq _ _ _ _ _ _ _ _ _ _ 0 0 = return 0 cmpseq h_a h_b p_a p_b m_a m_b c_a c_b off_a off_b l_a l_b = do let lim_a = off_a+l_a lim_b = off_b+l_b@@ -188,7 +186,7 @@ return l_a' else do let m = l_a' + l_b' del = l_a' - l_b'- dodd = odd $ del+ dodd = odd del v <- initV m vrev <- initVRev m l_a' writeArray vrev 0 l_a'@@ -211,7 +209,7 @@ -> VSTArray s -> VSTArray s -> Int -> Int -> Int -> Int -> Int -> Bool -> ST s (Int, Int, Int) findDiag c h_a h_b p_a p_b m_a m_b v vrev off_a off_b l_a l_b del dodd = do- if c > l_a + l_b then error "findDiag failed" else return ()+ when (c > l_a + l_b) $ error "findDiag failed" r <- findF case r of Just (xmid, ymid) -> return (xmid, ymid, (c*2 - 1))@@ -223,7 +221,7 @@ off_a off_b l_a l_b del dodd where fdmax = if c <= l_a then c else l_a - ((l_a + c) `mod` 2) rdmax = if c <= l_b then c else l_b - ((l_b + c) `mod` 2)- lastrdmax = if (c-1) <= l_b then c-1 else l_b-((l_b + (c-1) `mod` 2))+ lastrdmax = if (c-1) <= l_b then c-1 else l_b-(l_b + (c-1) `mod` 2) lastrdmin = -(if (c-1) <= l_a then c-1 else l_a-((l_a + (c-1)) `mod` 2)) fdmin = -rdmax rdmin = -fdmax@@ -322,7 +320,7 @@ then do when (i == start) impossible b1 <- readArray c_a (i-1) b2 <- readArray c_a (start-1)- when ((not b1) || b2) impossible+ when (not b1 || b2) impossible writeArray c_a (i-1) False writeArray c_a (start-1) True b <- if start > 2 then readArray c_a (start-2)@@ -331,7 +329,7 @@ else return (start-1) j' <- prevUnchanged c_b (j-1) shiftBackward start' (i-1) j'- else do return (start,i,j)+ else return (start,i,j) shiftForward start i j corr blank = if i <= aLen p_a && p_a!i == p_a!start && -- B.empty at the end of file marks empty line after final newline@@ -339,7 +337,7 @@ then do when (i == start) impossible b1 <- readArray c_a i b2 <- readArray c_a start- when ((not b2) || b1) impossible+ when (not b2 || b1) impossible writeArray c_a i True writeArray c_a start False i0 <- nextUnchanged c_a (i+1)@@ -350,13 +348,13 @@ else if p_a!(i0-1) == B.empty then i0 else blank shiftForward (start+1) i0 j0 corr0 blank0- else do return (start,i,j,corr,blank)+ else return (start,i,j,corr,blank) moveCorr start i j corr = if corr >= i then return (start,i,j) else do b1 <- readArray c_a (i-1) b2 <- readArray c_a (start-1)- when ((not b1) || b2) impossible+ when (not b1 || b2) impossible when (p_a!(i-1) /= p_a!(start-1)) impossible writeArray c_a (i-1) False writeArray c_a (start-1) True@@ -385,7 +383,7 @@ -- | goto n-th next unchanged line nextUnchangedN :: BSTArray s -> Int -> Int -> ST s Int-nextUnchangedN c n i = do+nextUnchangedN c n i = if n == 0 then return i else do i' <- skipOneUnChanged c i nextUnchangedN c (n-1) i'@@ -415,12 +413,10 @@ type BSTArray s = STUArray s Int Bool initV :: Int -> ST s (VSTArray s)-initV dmax = do- newArray (-(dmax + 1), dmax + 1) (-1)+initV dmax = newArray (-(dmax + 1), dmax + 1) (-1) initVRev :: Int -> Int -> ST s (VSTArray s)-initVRev dmax xmax = do- newArray (-(dmax + 1), dmax + 1) (xmax + 1)+initVRev dmax xmax = newArray (-(dmax + 1), dmax + 1) (xmax + 1) -- 1 indexed, v[0] is used as a guard element initVChanged :: Int -> ST s (BSTArray s)
src/Preproc.hs view
@@ -17,6 +17,8 @@ import System.FilePath ( (</>) ) import System.Environment ( getArgs ) import System.Exit ( exitWith, ExitCode(..) )+import Control.Monad ( when )+import Data.List ( stripPrefix ) import Text.Regex ( matchRegex, mkRegex ) import Darcs.Commands ( DarcsCommand(SuperCommand, commandSubCommands, commandName,@@ -38,9 +40,7 @@ -- contains a single input (include) line. preprocMain :: [String] -> IO () preprocMain args = do- if length args < 1- then exitWith $ ExitFailure 1- else return ()+ when (length args < 1) $ exitWith $ ExitFailure 1 putStrLn "%% This file was automatically generated by preproc." c <- preproc ["\\input{"++head args++"}"] mapM_ putStrLn c@@ -60,8 +60,9 @@ preproc ("\\usepackage{html}":ss) = -- only use html package with latex2html do rest <- preproc ss ah <- amHtml- if ah then return $ "\\usepackage{html}" : rest- else return $ "\\usepackage{hyperref}" : rest+ return $ if ah+ then "\\usepackage{html}" : rest+ else "\\usepackage{hyperref}" : rest preproc ("\\begin{code}":ss) = ignore ss where ignore :: [String] -> IO [String] ignore ("\\end{code}":ss') = preproc ss'@@ -70,28 +71,30 @@ preproc ("\\begin{options}":ss) = do rest <- preproc ss ah <- amHtml- if ah then return $ "\\begin{rawhtml}" : "<div class=\"cmd-opt-hdr\">" : rest- else return $ ("\\begin{Verbatim}[frame=lines,xleftmargin=1cm," +++ return $ if ah+ then "\\begin{rawhtml}" : "<div class=\"cmd-opt-hdr\">" : rest+ else ("\\begin{Verbatim}[frame=lines,xleftmargin=1cm," ++ "xrightmargin=1cm]") : rest preproc ("\\end{options}":ss) = do rest <- preproc ss ah <- amHtml- if ah then return $ "</div>" : "\\end{rawhtml}" : rest- else return $ "\\end{Verbatim}" : rest+ return $ if ah+ then "</div>" : "\\end{rawhtml}" : rest+ else "\\end{Verbatim}" : rest preproc ("\\darcsVersion":ss) = do rest <- preproc ss return $ version:rest preproc (s:ss) = do rest <- preproc ss- let rx = mkRegex "^\\\\(input|darcs(Command|Env))\\{(.+)\\}$"+ let rx = mkRegex "^\\\\(input|darcsCommand|darcsEnv)\\{(.+)\\}$" case matchRegex rx s of- Just ["input", _, path] ->- do cs <- Ratified.readFile $ "src" </> path -- not part of normal darcs operation+ Just ["input", path] ->+ do cs <- Ratified.readFile $ "doc" </> "src" </> path -- not part of normal darcs operation this <- preproc $ lines cs return $ this ++ rest- Just ["darcsCommand", _, command] ->+ Just ["darcsCommand", command] -> return $ latexCommandHelp command : rest- Just ["darcsEnv", _, variable] ->+ Just ["darcsEnv", variable] -> return $ envHelp variable : rest -- The base case for the whole preproc function. Nothing to -- mangle, so this is an ordinary line of TeX, and we append it to@@ -101,7 +104,7 @@ latexCommandHelp :: String -> String latexCommandHelp command = section ++ "{darcs " ++ command ++ "}\n" ++ "\\label{" ++ command ++ "}\n" ++- gh ++ getOptions command ++ gd+ gh ++ getOptions command ++ "\n" ++ gd where section = if ' ' `elem` command then "\\subsubsection" else "\\subsection" -- | Given a Darcs command name as a string, return that command's (multi-line) help string.@@ -121,7 +124,7 @@ [] -> [get name commands] _ -> case get name commands of c@SuperCommand { } ->- c:(getC ns $ extractCommands $ commandSubCommands c)+ c : getC ns (extractCommands $ commandSubCommands c) _ -> error $ "Not a supercommand: " ++ name where get n (c:cs) | commandName c == n = c@@ -164,7 +167,7 @@ escapeLatexSpecials :: String -> String -- Order is important escapeLatexSpecials =- (bs2 . amp . percent . carrot . dollar . underscore . rbrace . lbrace . bs1)+ bs2 . amp . percent . carrot . dollar . underscore . rbrace . lbrace . bs1 where amp = replace "&" "\\&" bs1 = replace "\\" "\001"@@ -179,6 +182,6 @@ replace :: Eq a => [a] -> [a] -> [a] -> [a] replace _ _ [] = [] replace find repl s =- if take (length find) s == find- then repl ++ (replace find repl (drop (length find) s))- else [head s] ++ replace find repl (tail s)+ case stripPrefix find s of+ Just rest -> repl ++ replace find repl rest+ Nothing -> head s : replace find repl (tail s)
src/Progress.hs view
@@ -1,6 +1,5 @@--- Various utility functions that do not belong anywhere else.+-- Utility functions for tracking progress of long-running actions. -{-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} #include "gadts.h"@@ -61,8 +60,8 @@ then putTiming >> hPutStrLn stderr l else if '\n' `elem` l then myput (takeWhile (/= '\n') l) s- else if length l < 80 then putTiming >> simpleput l- else putTiming >> simpleput (take 80 s)+ else putTiming >> if length l < 80 then simpleput l+ else simpleput (take 80 s) {-# NOINLINE simpleput #-} simpleput :: String -> IO ()@@ -151,7 +150,8 @@ {-# NOINLINE _progressData #-} _progressData :: IORef (String, Map String ProgressData)-_progressData = unsafePerformIO $ do forkIO handleProgress+-- Warning: A do-notation statement discarded a result of type GHC.Conc.ThreadId.+_progressData = unsafePerformIO $ do _ <- forkIO handleProgress newIORef ("", empty) mkhPutCr :: Handle -> IO (String -> IO ())
src/SHA1.hs view
@@ -15,13 +15,9 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. +-- name shadowing disabled because a,b,c,d,e are shadowed loads in step 4 {-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# LANGUAGE CPP #-}----- {-# OPTIONS_GHC -fglasgow-exts -fno-warn-name-shadowing #-}--- -fglasgow-exts needed for nasty hack below--- name shadowing disabled because a,b,c,d,e are shadowed loads in step 4 module SHA1 (sha1PS) where import ByteStringUtils (unsafeWithInternals)
src/Ssh.hs view
@@ -1,8 +1,10 @@ {-# LANGUAGE CPP, ForeignFunctionInterface #-} -module Ssh ( grabSSH, runSSH, getSSH, copySSH, copySSHs, SSHCmd(..),- environmentHelpSsh, environmentHelpScp, environmentHelpSshPort- ) where+module Ssh (+ copySSH, SSHCmd(..), runSSH, getSSH,+ environmentHelpSsh, environmentHelpScp, environmentHelpSshPort,+ remoteDarcs+ ) where import Prelude hiding ( lookup, catch ) import qualified Ratified( hGetContents )@@ -16,27 +18,25 @@ import Data.Bits ( (.&.) ) import System.Random ( randomIO ) #endif-import System.IO ( Handle, hSetBinaryMode, hPutStr, hPutStrLn, hGetLine, hClose, hFlush )+import System.IO ( Handle, hSetBinaryMode, hPutStrLn, hGetLine, hFlush ) import System.IO.Unsafe ( unsafePerformIO ) import System.Directory ( doesFileExist, createDirectoryIfMissing ) import Control.Monad ( when ) import System.Process ( runInteractiveProcess ) -import Data.List ( isPrefixOf ) import Data.Map ( Map, empty, insert, lookup ) import Data.IORef ( IORef, newIORef, readIORef, modifyIORef ) import Darcs.SignalHandler ( catchNonSignal )-import Darcs.Utils ( withCurrentDirectory, breakCommand, prettyException, catchall )-import Darcs.Global ( atexit, sshControlMasterDisabled, darcsdir, withDebugMode )-import Darcs.Lock ( withTemp, withOpenTemp, tempdirLoc, removeFileMayNotExist )+import Darcs.Utils ( breakCommand, prettyException, catchall )+import Darcs.Global ( atexit, sshControlMasterDisabled, withDebugMode )+import Darcs.Lock ( tempdirLoc, removeFileMayNotExist )+import Darcs.URL (SshFilePath(..), urlOf) import Exec ( exec, Redirects, Redirect(..), )-import Progress ( withoutProgress, debugMessage, debugFail, progressList )--import qualified Data.ByteString as B (ByteString, hGet, writeFile, readFile)-import qualified Data.ByteString.Char8 as BC (unpack)+import Progress ( withoutProgress, debugMessage, debugFail )+import Darcs.Flags( RemoteDarcs(..) ) -#include "impossible.h"+import qualified Data.ByteString as B (ByteString, hGet, writeFile ) {-# NOINLINE sshConnections #-} sshConnections :: IORef (Map String (Maybe Connection))@@ -44,19 +44,20 @@ data Connection = C { inp :: !Handle, out :: !Handle, err :: !Handle, deb :: String -> IO () } -withSSHConnection :: String -> String -> (Connection -> IO a) -> IO a -> IO a+-- | @withSSHConnection rdarcs destination withconnection withoutconnection@+-- performs an action on a remote host. If we are already connected to @destination@,+-- then it does @withconnection@, else @withoutconnection@.+withSSHConnection :: String -> SshFilePath -> (Connection -> IO a) -> IO a -> IO a withSSHConnection rdarcs repoid withconnection withoutconnection = withoutProgress $ do cs <- readIORef sshConnections- let uhost = takeWhile (/= ':') repoid- url = cleanrepourl repoid- case lookup url (cs :: Map String (Maybe Connection)) of+ case lookup (urlOf repoid) (cs :: Map String (Maybe Connection)) of Just Nothing -> withoutconnection Just (Just c) -> withconnection c Nothing -> do mc <- do (ssh,sshargs_) <- getSSHOnly SSH- let sshargs = sshargs_ ++ [uhost,rdarcs,- "transfer-mode","--repodir",cleanrepodir repoid]+ let sshargs = sshargs_ ++ [sshUhost repoid, rdarcs,+ "transfer-mode","--repodir",sshRepo repoid] debugMessage $ "ssh "++unwords sshargs (i,o,e,_) <- runInteractiveProcess ssh sshargs Nothing Nothing hSetBinaryMode i True@@ -66,8 +67,8 @@ then return () else debugFail "Couldn't start darcs transfer-mode on server" let c = C { inp = i, out = o, err = e,- deb = \s -> debugMessage ("with ssh (transfer-mode) "++uhost++": "++s) }- modifyIORef sshConnections (insert url (Just c))+ deb = \s -> debugMessage ("with ssh (transfer-mode) "++sshUhost repoid++s) }+ modifyIORef sshConnections (insert (urlOf repoid) (Just c)) return $ Just c `catchNonSignal` \e -> do debugMessage $ "Failed to start ssh connection:\n "++@@ -81,58 +82,52 @@ return Nothing maybe withoutconnection withconnection mc -severSSHConnection :: String -> IO ()-severSSHConnection x = do debugMessage $ "Severing ssh failed connection to "++x- modifyIORef sshConnections (insert (cleanrepourl x) Nothing)--cleanrepourl :: String -> String-cleanrepourl zzz | dd `isPrefixOf` zzz = ""- where dd = darcsdir++"/"-cleanrepourl (z:zs) = z : cleanrepourl zs-cleanrepourl "" = ""--cleanrepodir :: String -> String-cleanrepodir = cleanrepourl . drop 1 . dropWhile (/= ':')+severSSHConnection :: SshFilePath -> IO ()+severSSHConnection x = do debugMessage $ "Severing ssh failed connection to "++(sshUhost x)+ modifyIORef sshConnections (insert (urlOf x) Nothing) -grabSSH :: String -> Connection -> IO B.ByteString-grabSSH x c = do- let dir = drop 1 $ dropWhile (/= ':') x- dd = darcsdir++"/"- clean zzz | dd `isPrefixOf` zzz = drop (length dd) zzz- clean (_:zs) = clean zs- clean "" = bug $ "Buggy path in grabSSH: "++x- file = clean dir- failwith e = do severSSHConnection x- -- hGetContents is ok here because we're- -- only grabbing stderr, and we're also- -- about to throw the contents.- eee <- Ratified.hGetContents (err c)- debugFail $ e ++ " grabbing ssh file "++x++"\n"++eee- deb c $ "get "++file- hPutStrLn (inp c) $ "get " ++ file- hFlush (inp c)- l2 <- hGetLine (out c)- if l2 == "got "++file- then do showlen <- hGetLine (out c)- case reads showlen of- [(len,"")] -> B.hGet (out c) len- _ -> failwith "Couldn't get length"- else if l2 == "error "++file- then do e <- hGetLine (out c)- case reads e of- (msg,_):_ -> debugFail $ "Error reading file remotely:\n"++msg- [] -> failwith "An error occurred"- else failwith "Error"+grabSSH :: SshFilePath -> Connection -> IO B.ByteString+grabSSH dest c = do+ debugMessage $ "grabSSH dest=" ++ urlOf dest+ let failwith e = do severSSHConnection dest+ -- hGetContents is ok here because we're+ -- only grabbing stderr, and we're also+ -- about to throw the contents.+ eee <- Ratified.hGetContents (err c)+ debugFail $ e ++ " grabbing ssh file "+++ urlOf dest++"/"++ file ++"\n"++eee+ file = sshFile dest+ deb c $ "get "++ file+ hPutStrLn (inp c) $ "get " ++ file+ hFlush (inp c)+ l2 <- hGetLine (out c)+ if l2 == "got "++file+ then do showlen <- hGetLine (out c)+ case reads showlen of+ [(len,"")] -> B.hGet (out c) len+ _ -> failwith "Couldn't get length"+ else if l2 == "error "++file+ then do e <- hGetLine (out c)+ case reads e of+ (msg,_):_ -> debugFail $ "Error reading file remotely:\n"++msg+ [] -> failwith "An error occurred"+ else failwith "Error" sshStdErrMode :: IO Redirect sshStdErrMode = withDebugMode $ \amdebugging -> return $ if amdebugging then AsIs else Null -copySSH :: String -> String -> FilePath -> IO ()-copySSH rdarcs uRaw f = withSSHConnection rdarcs uRaw (\c -> grabSSH uRaw c >>= B.writeFile f) $- do let u = escape_dollar uRaw+remoteDarcs :: RemoteDarcs -> String+remoteDarcs DefaultRemoteDarcs = "darcs"+remoteDarcs (RemoteDarcs x) = x++copySSH :: RemoteDarcs -> SshFilePath -> FilePath -> IO ()+copySSH remote dest to | rdarcs <- remoteDarcs remote = do+ debugMessage $ "copySSH file: " ++ urlOf dest+ withSSHConnection rdarcs dest (\c -> grabSSH dest c >>= B.writeFile to) $+ do let u = escape_dollar $ urlOf dest stderr_behavior <- sshStdErrMode- r <- runSSH SCP u [] [u,f] (AsIs,AsIs,stderr_behavior)+ r <- runSSH SCP dest [u,to] (AsIs,AsIs,stderr_behavior) when (r /= ExitSuccess) $ debugFail $ "(scp) failed to fetch: " ++ u where {- '$' in filenames is troublesome for scp, for some reason.. -}@@ -141,37 +136,6 @@ where tr '$' = "\\$" tr c = [c] -copySSHs :: String -> String -> [String] -> FilePath -> IO ()-copySSHs rdarcs u ns d =- withSSHConnection rdarcs u (\c -> withCurrentDirectory d $- mapM_ (\n -> grabSSH (u++"/"++n) c >>= B.writeFile n) $- progressList "Copying via ssh" ns) $- do let path = drop 1 $ dropWhile (/= ':') u- host = takeWhile (/= ':') u- cd = "cd "++path++"\n"- input = cd++(unlines $ map ("get "++) ns)- withCurrentDirectory d $ withOpenTemp $ \(th,tn) ->- withTemp $ \sftpoutput ->- do hPutStr th input- hClose th- stderr_behavior <- sshStdErrMode- r <- runSSH SFTP u [] [host] (File tn, File sftpoutput, stderr_behavior)- let files = if length ns > 5- then (take 5 ns) ++ ["and "- ++ (show (length ns - 5)) ++ " more"]- else ns- hint = if "~" `isPrefixOf` path- then ["sftp doesn't expand ~, use path/ instead of ~/path/"]- else []- when (r /= ExitSuccess) $ do- outputPS <- B.readFile sftpoutput- debugFail $ unlines $- ["(sftp) failed to fetch files.",- "source directory: " ++ path,- "source files:"] ++ files ++- ["sftp output:",BC.unpack outputPS] ++- hint- -- --------------------------------------------------------------------- -- older ssh helper functions -- ---------------------------------------------------------------------@@ -183,15 +147,15 @@ show SCP = "scp" show SFTP = "sftp" -runSSH :: SSHCmd -> String -> [String] -> [String] -> Redirects -> IO ExitCode-runSSH cmd remoteAddr preArgs postArgs redirs =+runSSH :: SSHCmd -> SshFilePath -> [String] -> Redirects -> IO ExitCode+runSSH cmd remoteAddr postArgs redirs = do (ssh, args) <- getSSH cmd remoteAddr- exec ssh (preArgs ++ args ++ postArgs) redirs+ exec ssh (args ++ [sshUhost remoteAddr] ++ postArgs) redirs -- | Return the command and arguments needed to run an ssh command -- along with any extra features like use of the control master. -- See 'getSSHOnly'-getSSH :: SSHCmd -> String -- ^ remote path+getSSH :: SSHCmd -> SshFilePath -- ^ remote path -> IO (String, [String]) getSSH cmd remoteAddr = do (ssh, ssh_args) <- getSSHOnly cmd@@ -263,13 +227,8 @@ -- | Return True if this version of ssh has a ControlMaster feature -- The ControlMaster functionality allows for ssh multiplexing-hasSSHControlMaster :: Bool-hasSSHControlMaster = unsafePerformIO hasSSHControlMasterIO---- Because of the unsafePerformIO above, this can be called at any--- point. It cannot rely on any state, not even the current directory.-hasSSHControlMasterIO :: IO Bool-hasSSHControlMasterIO = do+hasSSHControlMaster :: IO Bool+hasSSHControlMaster = do (ssh, _) <- getSSHOnly SSH -- If ssh has the ControlMaster feature, it will recognise the -- the -O flag, but exit with status 255 because of the nonsense@@ -283,34 +242,36 @@ -- | Launch an SSH control master in the background, if available. -- We don't have to wait for it or anything. -- Note also that this will cleanup after itself when darcs exits-launchSSHControlMaster :: String -> IO ()-launchSSHControlMaster rawAddr =- when hasSSHControlMaster $ do- let addr = takeWhile (/= ':') rawAddr- (ssh, ssh_args) <- getSSHOnly SSH- cmPath <- controlMasterPath addr- removeFileMayNotExist cmPath- -- -f : put ssh in the background once it succeeds in logging you in- -- -M : launch as the control master for addr- -- -N : don't run any commands- -- -S : use cmPath as the ControlPath. Equivalent to -oControlPath=- exec ssh (ssh_args ++ [addr, "-S", cmPath, "-N", "-f", "-M"]) (Null,Null,AsIs)- atexit $ exitSSHControlMaster addr- return ()+launchSSHControlMaster :: SshFilePath -> IO ()+launchSSHControlMaster dest = do+ hasMaster <- hasSSHControlMaster+ when hasMaster $ do+ (ssh, ssh_args) <- getSSHOnly SSH+ cmPath <- controlMasterPath dest+ removeFileMayNotExist cmPath+ -- -f : put ssh in the background once it succeeds in logging you in+ -- -M : launch as the control master for addr+ -- -N : don't run any commands+ -- -S : use cmPath as the ControlPath. Equivalent to -oControlPath=+-- Warning: A do-notation statement discarded a result of type ExitCode.+ _ <- exec ssh (ssh_args ++ [sshUhost dest, "-S", cmPath, "-N", "-f", "-M"]) (Null,Null,AsIs)+ atexit $ exitSSHControlMaster dest+ return () -- | Tell the SSH control master for a given path to exit.-exitSSHControlMaster :: String -> IO ()+exitSSHControlMaster :: SshFilePath -> IO () exitSSHControlMaster addr = do (ssh, ssh_args) <- getSSHOnly SSH cmPath <- controlMasterPath addr- exec ssh (ssh_args ++ [addr, "-S", cmPath, "-O", "exit"]) (Null,Null,Null)+-- Warning: A do-notation statement discarded a result of type ExitCode.+ _ <- exec ssh (ssh_args ++ [sshUhost addr, "-S", cmPath, "-O", "exit"]) (Null,Null,Null) return () -- | Create the directory ssh control master path for a given address-controlMasterPath :: String -- ^ remote path (foo\@bar.com:file is ok; the file part with be stripped)+controlMasterPath :: SshFilePath -- ^ remote path (foo\@bar.com:file is ok; the file part with be stripped) -> IO FilePath-controlMasterPath rawAddr = do- let addr = takeWhile (/= ':') rawAddr+controlMasterPath dest = do+ let addr = sshUhost dest tmp <- (fmap (/// ".darcs") $ getEnv "HOME") `catchall` tempdirLoc #ifdef WIN32 r <- randomIO
src/URL.hs view
@@ -3,13 +3,17 @@ module URL ( copyUrl, copyUrlFirst, setDebugHTTP, disableHTTPPipelining, maxPipelineLength, waitUrl, Cachable(Cachable, Uncachable, MaxAge),- environmentHelpProxy, environmentHelpProxyPassword+ environmentHelpProxy, environmentHelpProxyPassword,+ ConnectionError ) where import Data.IORef ( newIORef, readIORef, writeIORef, IORef ) import Data.Map ( Map ) import Data.List ( delete ) import qualified Data.Map as Map+#ifdef HAVE_CURL+import Control.Exception.Extensible ( bracket )+#endif import System.Directory ( copyFile ) import System.IO.Unsafe ( unsafePerformIO ) import Control.Concurrent ( forkIO )@@ -19,18 +23,28 @@ import Control.Monad.Trans ( liftIO ) import Control.Monad.State ( evalStateT, get, modify, put, StateT ) import Foreign.C.Types ( CInt )+#ifdef HAVE_CURL+import Foreign.C.Types ( CLong )+#endif import Workaround ( renameFile ) import Darcs.Global ( atexit )-import Progress ( debugFail, debugMessage )+import Progress ( debugMessage ) import Darcs.Lock ( removeFileMayNotExist ) import Numeric ( showHex ) import System.Random ( randomRIO )+import HTTP ( ConnectionError(..)) #ifdef HAVE_CURL import Foreign.C.String ( withCString, peekCString, CString )+import Foreign.Ptr+import Foreign.Marshal.Alloc+import Foreign.Storable+#elif defined(HAVE_HTTP)+import qualified HTTP ( requestUrl, waitNextUrl ) #else+import Progress ( debugFail ) import qualified HTTP ( requestUrl, waitNextUrl ) #endif #include "impossible.h"@@ -100,7 +114,8 @@ urlChan :: Chan UrlRequest urlChan = unsafePerformIO $ do ch <- newChan- forkIO (urlThread ch)+-- Warning: A do-notation statement discarded a result of type GHC.Conc.ThreadId.+ _ <- forkIO (urlThread ch) return ch urlThread :: Chan UrlRequest -> IO ()@@ -182,8 +197,7 @@ let f_new = f++"-new_"++randomJunk st err <- liftIO $ requestUrl u f_new c if null err- then do dbg "URL.requestUrl succeeded"- liftIO $ atexit (removeFileMayNotExist f_new)+ then do liftIO $ atexit (removeFileMayNotExist f_new) put $ st { waitToStart = rest , pipeLength = l + 1 } else do dbg $ "Failed to start download URL "++u++": "++err@@ -216,7 +230,7 @@ let l = pipeLength st when (l > 0) $ do dbg "URL.waitNextUrl start"- (u, e) <- liftIO $ waitNextUrl'+ (u, e, ce) <- liftIO $ waitNextUrl' let p = inProgress st new_st = st { inProgress = Map.delete u p , pipeLength = l - 1 }@@ -231,7 +245,9 @@ else case Map.lookup u p of Just (f, _, _) -> do removeFileMayNotExist (f++"-new_"++randomJunk st)- downloadComplete u e+ case ce of+ Just httpError -> downloadComplete u (show httpError)+ Nothing -> downloadComplete u e debugMessage $ "URL.waitNextUrl failed: "++ u++" "++f++" "++e Nothing -> bug $ "Another possible bug in URL.waitNextUrl: "++u++" "++e@@ -254,7 +270,9 @@ Just var -> do e <- readMVar var modifyMVar_ urlNotifications (return . (Map.delete u))- unless (null e) (debugFail $ "Failed to download URL "++u++": "++e)+ unless (null e) $ do+ debugMessage $ "Failed to download URL "++u++": "++e+ fail e Nothing -> return () -- file was already downloaded dbg :: String -> StateT a IO ()@@ -280,7 +298,7 @@ setDebugHTTP :: IO () requestUrl :: String -> FilePath -> Cachable -> IO String-waitNextUrl' :: IO (String, String)+waitNextUrl' :: IO (String, String, Maybe ConnectionError) pipeliningEnabled :: IO Bool #ifdef HAVE_CURL@@ -293,10 +311,28 @@ err <- curl_request_url ustr fstr (cachableToInt cache) >>= peekCString return err -waitNextUrl' = do- e <- curl_wait_next_url >>= peekCString- u <- curl_last_url >>= peekCString- return (u, e)+waitNextUrl' =+ bracket malloc free $ \ errorPointer ->+ bracket malloc free $ \ httpErrorPointer -> do+ e <- curl_wait_next_url errorPointer httpErrorPointer >>= peekCString+ ce <- do+ errorNum <- peek errorPointer+ if not (null e)+ then return $+ case errorNum of+ 6 -> Just CouldNotResolveHost+ 7 -> Just CouldNotConnectToServer+ 28 -> Just OperationTimeout+ _ -> Nothing+ else do+ when (errorNum == 90 ) $ debugMessage "The environment variable DARCS_CONNECTION_TIMEOUT is not a number"+ return Nothing+ u <- curl_last_url >>= peekCString+ httpErrorCode <- peek httpErrorPointer+ let detailedErrorMessage = if httpErrorCode > 0+ then e ++ " " ++ show httpErrorCode+ else e+ return (u, detailedErrorMessage, ce) pipeliningEnabled = do r <- curl_pipelining_enabled@@ -306,7 +342,7 @@ curl_request_url :: CString -> CString -> CInt -> IO CString foreign import ccall "hscurl.h curl_wait_next_url"- curl_wait_next_url :: IO CString+ curl_wait_next_url :: Ptr CInt -> Ptr CLong-> IO CString foreign import ccall "hscurl.h curl_last_url" curl_last_url :: IO CString
src/Workaround.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} module Workaround ( renameFile, setExecutable, getCurrentDirectory,@@ -80,7 +79,8 @@ setExecutable f ex = do st <- getFileStatus f umask <- setFileCreationMask 0- setFileCreationMask umask+-- Warning: A do-notation statement discarded a result of type System.Posix.Types.FileMode.+ _ <- setFileCreationMask umask let rw = fileMode st .&. (ownerReadMode .|. ownerWriteMode .|. groupReadMode .|. groupWriteMode .|.
− src/best_practices.tex
@@ -1,611 +0,0 @@-% This file (unlike the rest of darcs) is in the public domain.- --\chapter{Best practices}--This chapter is intended to review various scenarios and describe in each-case effective ways of using darcs. There is no one ``best practice'', and-darcs is a sufficiently low-level tool that there are many high-level ways-one can use it, which can be confusing to new users. The plan (and hope)-is that various users will contribute here describing how they use darcs in-different environments. However, this is not a wiki, and contributions-will be edited and reviewed for consistency and wisdom.---\section{Creating patches}--This section will lay down the concepts around patch creation.-The aim is to develop a way of thinking-that corresponds well to how darcs is behaving---- even in complicated situations.-- In a single darcs repository you can think of two ``versions'' of the source tree.- They are called the \emph{working} and \emph{pristine} trees.- \emph{Working} is your normal source tree, with or without darcs alongside.- The only thing that makes it part of a darcs repository- is the \verb!_darcs! directory in its root.- \emph{Pristine} is the recorded state of the source tree.- The pristine tree is constructed from groups of changes,- called {\em patches\/} (some other version control systems use the- term {\em changeset\/} instead of {\em patch\/}).\footnote{If- you look inside \_darcs you will find files or directories named- {\tt patches} and {\tt inventories}, which store all the patches- ever recorded. If the repository holds a cached pristine tree, it- is stored in a directory called {\tt pristine} or {\tt current\/};- otherwise, the fact that there is no pristine tree is marked- by the presence of a file called {\tt pristine.none} or {\tt- current.none}.}- Darcs will create and store these patches- based on the changes you make in \emph{working}.---\subsection{Changes}- If \emph{working} and \emph{pristine} are the same,- there are ``no changes'' in the repository.- Changes can be introduced (or removed) by editing the files in \emph{working}.- They can also be caused by darcs commands,- which can modify \emph{both} \emph{working} and \emph{pristine}.- It is important to understand for each darcs command- how it modifies \emph{working}, \emph{pristine} or both of them.-- \verb!whatsnew! (as well as \verb!diff!) can show- the difference between \emph{working} and \emph{pristine} to you.- It will be shown as a difference in \emph{working}.- In advanced cases it need \emph{not} be \emph{working} that has changed;- it can just as well have been \emph{pristine}, or both.- The important thing is the difference and what darcs can do with it.--\subsection{Keeping or discarding changes}- If you have a difference in \emph{working}, you do two things- with it: \verb!record! it to keep it, or \verb!revert! it to lose the changes.%- \footnote{%- Revert can undo precious work in a blink.- To protect you from great grief,- the discarded changes are saved temporarily- so the latest revert can be undone with unrevert.}-- If you have a difference between \emph{working} and \emph{pristine}%- ---for example after editing some files in \emph{working}---%- \verb!whatsnew! will show some ``unrecorded changes''.- To save these changes, use \verb!record!.- It will create a new patch in \emph{pristine} with the same changes,- so \emph{working} and \emph{pristine} are no longer different.- To instead undo the changes in \emph{working}, use \verb!revert!.- It will modify the files in \emph{working} to be the same as in \emph{pristine}- (where the changes do not exist).---\subsection{Unrecording changes}- \verb!unrecord! is a command meant to be run only in private- repositories. Its intended purpose is to allow developers the flexibility- to undo patches that haven't been distributed yet.-- However, darcs does not prevent you from unrecording a patch that- has been copied to another repository. Be aware of this danger!-- If you \verb!unrecord! a patch, that patch will be deleted from \emph{pristine}.- This will cause \emph{working} to be different from \emph{pristine},- and \verb!whatsnew! to report unrecorded changes.- The difference will be the same as just before that patch was \verb!record!ed.- Think about it.- \verb!record! examines what's different with \emph{working}- and constructs a patch with the same changes in \emph{pristine}- so they are no longer different.- \verb!unrecord! deletes this patch;- the changes in \emph{pristine} disappear and the difference is back.-- If the recorded changes included an error,- the resulting flawed patch can be unrecorded.- When the changes have been fixed,- they can be recorded again as a new---hopefully flawless---patch.-- If the whole change was wrong it can be discarded from \emph{working} too,- with \verb!revert!.- \verb!revert! will update \emph{working} to the state of \emph{pristine},- in which the changes do no longer exist after the patch was deleted.-- Keep in mind that the patches are your history,- so deleting them with \verb!unrecord! makes it impossible to track- what changes you \emph{really} made.- Redoing the patches is how you ``cover the tracks''.- On the other hand,- it can be a very convenient way to manage and organize changes- while you try them out in your private repository.- When all is ready for shipping,- the changes can be reorganized in what seems as useful and impressive patches.- Use it with care.-- All patches are global,- so don't \emph{ever} replace an already ``shipped'' patch in this way!- If an erroneous patch is deleted and replaced with a better one,- you have to replace it in \emph{all} repositories that have a copy of it.- This may not be feasible, unless it's all private repositories.- If other developers have already made patches or tags in their repositories- that depend on the old patch, things will get complicated.---\subsection{Special patches and pending}--The patches described in the previous sections have mostly been hunks.-A \emph{hunk} is one of darcs' primitive patch types,-and it is used to remove old lines and/or insert new lines.-There are other types of primitive patches,-such as \emph{adddir} and \emph{addfile}-which add new directories and files,-and \emph{replace}-which does a search-and-replace on tokens in files.--Hunks are always calculated in place with a diff algorithm-just before \verb!whatsnew! or \verb!record!.-But other types of primitive patches need to be explicitly created-with a darcs command.-They are kept in \emph{pending}%-\footnote{In the file {\tt\_darcs/patches/pending}.}-until they are either recorded or reverted.--\emph{Pending} can be thought of as a special extension of \emph{working}.-When you issue, e.g., a darcs \verb!replace! command,-the replace is performed on the files in \emph{working}-and at the same time a replace patch is put in \emph{pending}.-Patches in \emph{pending} describe special changes made in \emph{working}.-The diff algorithm will fictively apply these changes to \emph{pristine}-before it compares it to \emph{working},-so all lines in \emph{working} that are changed by a \verb!replace! command-will also be changed in \emph{pending}$+$\emph{pristine}-when the hunks are calculated.-That's why no hunks with the replaced lines will be shown by \verb!whatsnew!;-it only shows the replace patch in \emph{pending} responsible for the change.--If a special patch is recorded, it will simply be moved to \emph{pristine}.-If it is instead reverted, it will be deleted from \emph{pending}-and the accompanying change will be removed from \emph{working}.--Note that reverting a patch in pending is \emph{not} the same as-simply removing it from pending.-It actually applies the inverse of the change to \emph{working}.-Most notable is that reverting an addfile patch-will delete the file in \emph{working} (the inverse of adding it).-So if you add the wrong file to darcs by mistake,-\emph{don't} \verb!revert! the addfile.-Instead use \verb!remove!, which cancels out the addfile in pending.---\section{Using patches} % still basics--This section will lay down the concepts around patch distribution and branches.-The aim is to develop a way of thinking-that corresponds well to how darcs is behaving---- even in complicated situations.--A repository is a collection of patches.-Patches have no defined order,-but patches can have dependencies on other patches.-Patches can be added to a repository in any order-as long as all patches depended upon are there.-Patches can be removed from a repository in any order,-as long as no remaining patches depend on them.--Repositories can be cloned to create branches.-Patches created in different branches may conflict.-A conflict is a valid state of a repository.-A conflict makes the working tree ambiguous until the conflict is resolved.---\subsection{Dependencies}--There are two kinds of dependencies:-implicit dependencies and explicit dependencies.--Implicit dependencies is the far most common kind.-These are calculated automatically by darcs.-If a patch removes a file or a line of code,-it will have to depend on the patch that added that file or line of code.\footnote{%-Actually it doesn't have to---in theory---,-but in practice it's hard to create ``negative'' files or lines in the working tree.-See the chapter about Theory of patches for other constraints.}-If a patch adds a line of code,-it will usually have to depend on the patch or patches that added the adjacent lines.--Explicit dependencies can be created if you give the \verb|--ask-deps| option to \verb|darcs record|.-This is good for assuring that logical dependencies hold between patches.-It can also be used to group patches---%-a patch with explicit dependencies doesn't need to change anything---%-and pulling the patch also pulls all patches it was made to depend on.---\subsection{Branches: just normal repositories}--Darcs does not have branches---it doesn't need to.-Every repository can be used as a branch.-This means that any two repositories are ``branches'' in darcs,-but it is not of much use unless they have a large portion of patches in common.-If they are different projects they will have nothing in common,-but darcs may still very well be able to merge them,-although the result probably is nonsense.-Therefore the word ``branch'' isn't a technical term in darcs;-it's just the way we think of one repository in relation to another.--Branches are \emph{very} useful in darcs.-They are in fact \emph{necessary} if you want to do more than only simple work.-When you \verb|get| someone's repository from the Internet,-you are actually creating a branch of it.-It may first seem inefficient (or if you come from CVS---frightening),-not to say plain awkward.-But darcs is designed this way, and it has means to make it efficient.-The answer to many questions about how to do a thing with darcs is: ``use a branch''.-It is a simple and elegant solution with great power and flexibility,-which contributes to darcs' uncomplicated user interface.--You create new branches (i.e., clone repositories)-with the \verb|get| and \verb|put| commands.---\subsection{Moving patches around---no versions}--Patches are global, and a copy of a patch either is or is not present in a branch.-This way you can rig a branch almost any way you like,-as long as dependencies are fulfilled---%-darcs \emph{won't} let you break dependencies.-If you suspect a certain feature from some time ago introduced a bug,-you can remove the patch/patches that adds the feature,-and try without it.\footnote{%-darcs even has a special command, {\tt trackdown}-that automatically removes patches-until a specified test no longer fails.}--Patches are added to a repository with \verb|pull|-and removed from the repositories with \verb|obliterate|.-Don't confuse these two commands with \verb|record| and \verb|unrecord|,-which constructs and deconstructs patches.--It is important not to lose patches when (re)moving them around.-\verb|pull| needs a source repository to copy the patch from,-whereas \verb|obliterate| just erases the patch.-Beware that if you obliterate \emph{all} copies of a patch-it is completely lost---forever.-Therefore you should work with branches when you obliterate patches.-The \verb|obliterate| command can wisely be disabled in a dedicated main repository-by adding \verb|obliterate disable| to the repository's defaults file.--For convenience, there is a \verb|push| command.-It works like \verb|pull| but in the other direction.-It also differs from \verb|pull| in an important way:-it starts a second instance of darcs to apply the patch in the target repository,-even if it's on the same computer.-It can cause surprises if you have a ``wrong'' darcs in your PATH.---\subsection{Tags---versions}--While \verb|pull| and \verb|obliterate| can be used to-construct different ``versions'' in a repository,-it is often desirable to name specific configurations of patches-so they can be identified and retrieved easily later.-This is how darcs implements what is usually known as versions.-The command for this is \verb|tag|,-and it records a tag in the current repository.--A tag is just a patch, but it only contains explicit dependencies.-It will depend on all the patches in the current repository.\footnote{%-It will omit patches already depended upon by other patches,-since they will be indirectly depended upon anyway.}-Darcs can recognize if a patch is as a tag;-tags are sometimes treated specially by darcs commands.--While traditional revision control systems tag versions in the time line history,-darcs lets you tag any configuration of patches at any time,-and pass the tags around between branches.--With the option \verb|--tag| to \verb|get| you can easily get-a named version in the repository-as a new branch.---\subsection{Conflicts}--This part of darcs becomes a bit complicated,-and the description given here is slightly simplified.--Conflicting patches are created when-you record changes to the same line in two different repositories.-Same line does \emph{not} mean the same line number and file name,-but the same line added by a common depended-upon patch.--If you are using a darcs-2 repository (Section \ref{initialize}),-darcs does \emph{not} consider two patches making the \emph{same} change to be a-conflict, much in the same fashion as other version control systems.-(The caveat here is two non-identical patches with some identical-changes may conflict. For the most part, darcs should just do what you-expect).--A conflict \emph{happens} when two conflicting patches meet in the same repository.-This is no problem for darcs; it can happily pull together just any patches.-But it is a problem for the files in \emph{working} (and \emph{pristine}).-The conflict can be thought of as-two patches telling darcs different things about what a file should look like.--Darcs escapes this problem-by ignoring those parts\footnote{%-The primitive patches making up the total patch.}-of the patches that conflict.-They are ignored in \emph{both} patches.-If patch~A changes the line ``FIXME'' to ``FIXED'',-and patch~B changes the same line to ``DONE'',-the two patches together will produce the line ``FIXME''.-Darcs doesn't care which one you pulled into the repository first,-you still get the same result when the conflicting patches meet.-All other changes made by A and B are performed as normal.--Darcs can mark a conflict for you in \emph{working}.-This is done with \verb|mark-conflicts|.-Conflicts are marked such that both conflicting changes-are inserted with special delimiter lines around them.-Then you can merge the two changes by hand,-and remove the delimiters.--When you pull patches,-darcs automatically performs a \verb|mark-conflicts| for you if a conflict happens.-You can remove the markup with \verb|revert|,-Remember that the result will be the lines from-the previous version common to both conflicting patches.-The conflict marking can be redone again with \verb|mark-conflicts|.--A special case is when a pulled patch conflicts with unrecorded changes in the repository.-The conflict will be automatically marked as usual,-but since the markup is \emph{also} an unrecorded change,-it will get mixed in with your unrecorded changes.-There is no guarantee you can revert \emph{only} the markup after this,-and \verb|resolve| will not be able to redo this markup later if you remove it.-It is good practice to record important changes before pulling.--\verb|mark-conflicts| can't mark complicated conflicts.-In that case you'll have to use \verb|darcs diff| and other commands-to understand what the conflict is all about.-If for example two conflicting patches create the same file,-\verb|mark-conflicts| will pick just one of them,-and no delimiters are inserted.-So watch out if darcs tells you about a conflict.--\verb|mark-conflicts| can also be used to check for unresolved conflicts.-If there are none, darcs replies ``No conflicts to resolve''.-While \verb|pull| reports when a conflict happens,-\verb|obliterate| and \verb|get| don't.---\subsection{Resolving conflicts}--A conflict is resolved-(not marked, as with the command \verb|mark-conflicts|)-as soon as some new patch depends on the conflicting patches.-This will usually be the resolve patch you record after manually putting together the pieces-from the conflict markup produced by \verb|mark-conflicts| (or \verb|pull|).-But it can just as well be a tag.-So don't forget to fix conflicts before you accidently ``resolve'' them by recording other patches.--If the conflict is with one of your not-yet-published patches,-you may choose to amend that patch rather than creating a resolve patch.--If you want to back out and wait with the conflict,-you can \verb|obliterate| the conflicting patch you just pulled.-Before you can do that you have to \verb|revert| the conflict markups-that \verb|pull| inserted when the conflict happened.--\section{Use a Global Cache}--When working with darcs 2 it is recommended to use a global cache, as this-is one of the biggest performance enhancing tools of darcs 2. The global-cache acts as a giant patch pool where darcs first looks for a patch when-grabbing new patches. This saves time by not downloading the same patch-twice from a remote server. It also saves space by storing the patch only-once, if you ensure your cache and your repositories are on the same-hardlink-supporting filesystem. --Darcs now enables a global patch cache under your home directory by default.-Older darcs 2.x versions required this manual step:--\begin{verbatim}-$ mkdir -p $HOME/.darcs/cache-$ echo cache:$HOME/.darcs/cache > $HOME/.darcs/sources-\end{verbatim}--On MS Windows~\ref{ms_win}, using \verb|cmd.exe| (Command Prompt under Accessories):--\begin{verbatim}-> md "%UserProfile%\Application Data\darcs\cache" (notice double quotes!)-> echo cache:%UserProfile%\Application Data\darcs\cache > "%UserProfile%\Application Data\darcs\sources"-\end{verbatim}--There are some other advanced things you can do in \verb!_darcs/prefs/sources!,-such as create per-repository caches, read-only caches and even set a-primary source repository above any used in a \verb|darcs get| or -\verb|darcs pull| command.--\section{Distributed development with one primary developer}-\label{darcs-development-practices}--This is how darcs itself is developed. There are many contributors to-darcs, but every contribution is reviewed and manually applied by myself.-For this sort of a situation, \verb|darcs send| is ideal, since the barrier for-contributions is very low, which helps encourage contributors.--One could simply set the \verb!_darcs/prefs/email! value to the project-mailing list, but I also use darcs send to send my changes to the main-server, so instead the email address is set to-``\verb!Davids Darcs Repo <droundy@abridgegame.org>!''. My-\verb-.procmailrc--file on the server has the following rule:-\begin{verbatim}-:0-* ^TODavids Darcs Repo-|(umask 022; darcs apply --reply darcs-devel@abridgegame.org \- --repodir /path/to/repo --verify /path/to/allowed_keys)-\end{verbatim}-This causes darcs apply to be run on any email sent to ``Davids Darcs-Repo''.-\verb'apply' actually applies them only if they are signed by an-authorized key. Currently, the only authorized key is mine, but of course-this could be extended easily enough.--The central darcs repository contains the following values in its-\verb!_darcs/prefs/defaults!:-\begin{verbatim}-apply test-apply verbose-apply happy-forwarding-\end{verbatim}-The first line tells apply to always run the test suite. The test suite is-in fact the main reason I use send rather than push, since it allows me to-easily continue working (or put my computer to sleep) while the tests are-being run on the main server. The second line is just there to improve the-email response that I get when a patch has either been applied or failed-the tests. The third line makes darcs not complain about unsigned patches,-but just to forward them to \verb!darcs-devel!.--On my development computer, I have in my \verb!.muttrc! the following-alias, which allows me to easily apply patches that I get via email-directly to my darcs working directory:-\begin{verbatim}-macro pager A "<pipe-entry>(umask 022; darcs apply --no-test -v \- --repodir ~/darcs)"-\end{verbatim}---\section{Development by a small group of developers in one office}-\label{dft-development-practices}--This section describes the development method used for the density-functional theory code DFT++, which is available at-\verb!http://dft.physics.cornell.edu/dft!.--We have a number of workstations which all mount the same \verb!/home! via NFS.-We created a special ``dft'' user, with the central repository living in that-user's home directory. The ssh public keys of authorized persons are added to-the ``dft'' user's \verb!.ssh/allowed_keys!, and we commit patches to this-repository using-\verb'darcs push'. As in Section~\ref{darcs-development-practices},-we have the central repository set to run the test suite before the push goes-through.--Note that no one ever runs as the dft user.--A subtlety that we ran into showed up in the running of the test suite.-Since our test suite includes the running of MPI programs, it must be run-in a directory that is mounted across our cluster. To achieve this, we set-the \verb!$DARCS_TMPDIR! % following is added to make emacs color right:$-environment variable to \verb!~/tmp!.--Note that even though there are only four active developers at the moment,-the distributed nature of darcs still plays a large role. Each developer-works on a feature until it is stable, a process that often takes quite a-few patches, and only once it is stable does he-\verb'push' to the central repository.--\section{Personal development}--It's easy to have several personal development trees using darcs, even-when working on a team or with shared code. The number and method of-using each personal tree is limited only by such grand limitations as:-your disk space, your imagination, available time, etc.--For example, if the central darcs repository for your development team-is $R_{c}$, you can create a local working directory for feature-$f_1$. This local working directory contains a full copy of $R_c$-(as of the time of the ``darcs get'' operation) and can be denoted-$R_1$. In the midst of working on feature $f_1$, you realize it-requires the development of a separate feature $f_2$. Rather than-intermingling $f_1$ and $f_2$ in the same working tree, you can create-a new working tree for working on $f_2$, where that working tree-contains the repository $R_2$.--While working on $f_2$, other developers may have made other changes;-these changes can be retrieved on a per-patch selection basis by-periodic ``darcs pull'' operations.--When your work on $f_2$ is completed, you can publish it for the use-of other developers by a ``darcs push'' (or ``darcs send'') from $R_2$-to $R_c$. Independently of the publishing of $f_2$, you can merge-your $f_2$ work into your $f_1$ working tree by a ``darcs pull $R_2$''-in the $R_1$ development tree (or ``darcs push'' from $R_2$ to $R_1$).--When your work on $f_1$ is completed, you publish it as well by a-``darcs push'' from $R_1$ to $R_c$. --Your local feature development efforts for $f_1$ or $f_2$ can each-consist of multiple patches. When pushing or pulling to other trees,-these patches can either all be selected or specific patches can be-selected. Thus, if you introduce a set of debugging calls into the-code, you can commit the debugging code in a distictly separate patch-(or patches) that you will not push to $R_c$.--\subsection{Private patches}--As discussed in the section above, a developer may have various-changes to their local development repositories that they do not ever-wish to publish to a group repository (e.g. personal debugging code),-but which they would like to keep in their local repository, and-perhaps even share amongst their local repositories.--This is easily done via darcs, since those private changes can be-committed in patches that are separate from other patches; during the-process of pushing patches to the common repository ($R_c$), the-developer is queried for which patches should be moved to ($R_c$) on a-patch-by-patch basis.--The \verb!--complement! flag for the ``darcs pull'' operation can-further simplify this effort. If the developer copies (via ``darcs-push'' or ``darcs pull'') all private patches into a special-repository/working tree ($R_p$), then those patches are easily-disregarded for pulling by adding \verb!--complement! to the ``darcs-pull'' line and listing $R_p$ after the primary source repository.--The \verb!--complement! flag is only available for ``darcs pull'', and-not ``darcs push'' or ``darcs send'', requiring the user to have pull-access to the target repository. While the actual public repository-is often not shared in this manner, it's simple to create a local-version of the public repository to act as the staging area for that-public repository.--The following example extends the two feature addition example in the-previous section using a local staging repository ($R_l$) and a-private patch repository:--\begin{verbatim}-$ cd working-dir-$ darcs get http://server/repos/Rc Rl--$ darcs get Rl R1-$ cd R1-...development of f1-$ darcs record -m'p1: f1 initial work'-...-$ darcs record -m'p2: my debugging tracepoints'-...--$ cd ..-$ darcs get http://server/repos/Rc R2-$ cd R2-$ darcs pull -p p2 ../R1-... development of f2-$ darcs record -m'p3: f2 finished'--$ cd ..-$ darcs get Rl Rp-$ cd Rp-$ darcs pull -p p2 ../R2--$ cd ../Rl-$ darcs pull --complement ../R2 ../Rp-$ darcs send-... for publishing f2 patches to Rc--$ cd ../R1-$ darcs pull ../R2-... updates R1 with f2 changes from R2-... more development of f1-$ darcs record -m'p4: f1 feature finished.'--$ cd ../Rl-$ darcs pull --complement ../R1 ../Rp-$ darcs send-\end{verbatim}-
− src/building_darcs.tex
@@ -1,76 +0,0 @@-\chapter{Building darcs}-\section{The Easy Way}-If your distribution provides a pre-built binary package of a recent-Darcs release, you are strongly encouraged to use that rather than-building Darcs yourself.--If you have (or can install) the \texttt{cabal-install} package, this-is the next best option, as this will resolve build dependencies-automatically. To download, compile and install Darcs and its-dependencies via cabal-install, simply run-\begin{verbatim}-cabal update-cabal install darcs-\end{verbatim}--\section{The Hard Way}-If you cannot install \texttt{cabal-install}, you need to run-\begin{verbatim}-ghc --make Setup-./Setup configure-./Setup build-./Setup install-\end{verbatim}--This will require the following build dependencies:-\begin{itemize}-\item GHC 6.10 or higher; and-\item Cabal 1.6 or higher.-\end{itemize}--%% Note: darcs.cabal tends to have build dependencies [x,y), but I-%% couldn't work out a way to describe this concisely (and-%% intelligibly to non-mathematicians). So I have lied and simply-%% said `or higher', since the upper bounds usually only declare-%% incompatibility with versions that don't exist yet. --twb, 2009--Additional build dependencies are declared in the \texttt{darcs.cabal}-file, and \texttt{./Setup configure} will tell you if any required-build dependencies aren't found. The build dependencies at time of-writing (Darcs 2.3) are as follows:-\begin{itemize}-\item the C library zlib;-\item the Haskell packages- \begin{itemize}- \item array 1.1 or 1.2;- \item containers 1.1 or 1.2;- \item directory 1.0;- \item filepath 1.1;- \item hashed-storage 0.3;- \item haskeline 0.6.1 or higher;- \item html 1.0;- \item mtl 1.0 or 1.1;- \item old-time 1.0;- \item parsec 2.1 or higher;- \item process 1.0;- \item random 1.0; and- \item regex-compat 0.71 or higher.- \end{itemize}-\end{itemize}--Missing \emph{optional} build dependencies are only listed if-\texttt{./Setup configure} is passed the \texttt{--verbose} argument.-At time of writing they are:-\begin{itemize}-\item the C library libcurl (7.19.1 or higher recommended);-\item the Haskell packages- \begin{itemize}- \item bytestring 0.9;- \item bytestring-mmap 0.2 or higher;- \item http 3000 or 3001.1;- \item network 2.2;- \item terminfo 0.3.- \item text 0.3; and- \item zlib 0.5.- \end{itemize}-\end{itemize}
− src/configuring_darcs.tex
@@ -1,264 +0,0 @@-% Copyright (C) 2004 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; if not, write to the Free Software Foundation,-% Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.--\chapter{Configuring darcs}\label{configuring}--There are several ways you can adjust darcs' behavior to suit your needs.-The first is to edit files in the \verb!_darcs/prefs/! directory of a-repository. Such configuration only applies when working with that-repository. To configure darcs on a per-user rather than per-repository-basis (but with essentially the same methods), you can edit (or create)-files in the \verb!~/.darcs/! directory.-Finally, the behavior of some darcs commands can be modified by setting-appropriate environment variables.--\paragraph{Microsoft Windows}\label{ms_win}--The global darcs directory is \verb!%APPDATA%\darcs\!. This typically expands to-\texttt{C:\textbackslash{}Documents And Settings\textbackslash{}\emph{user}\textbackslash{}Application Data\textbackslash{}darcs\textbackslash{}}.-This folder contains the cache, as well as all the per-user-settings files: preferences, boring etc... These will became the new defaults-that can be overridden on per-repository basis.--\input{Darcs/Repository/Prefs.lhs}--\input{Darcs/Repository/Motd.lhs}--\section{Environment variables}--There are a few environment variables whose contents affect darcs'-behavior. Here is a quick list of all the variables and their-documentation in the rest of the manual:--\begin{tabular}{|l|r|}-\hline-\textbf{Variable} & \textbf{Section} \\-\hline-DARCS\_EDITOR, EDITOR, VISUAL & \ref{env:DARCS_EDITOR} \\-DARCS\_PAGER, PAGER & \ref{env:DARCS_PAGER} \\-HOME & \ref{env:HOME} \\-TERM & \ref{env:TERM} \\-\hline-DARCS\_EMAIL, EMAIL & \ref{env:DARCS_EMAIL} \\-\hline-DARCS\_APPLY\_FOO & \ref{env:DARCS_X_FOO} \\-DARCS\_GET\_FOO & \ref{env:DARCS_X_FOO} \\-DARCS\_MGET\_FOO & \ref{env:DARCS_X_FOO} \\-DARCS\_MGETMAX & \ref{env:DARCS_MGETMAX} \\-DARCS\_PROXYUSERPWD & \ref{env:DARCS_PROXYUSERPWD} \\-DARCS\_SSH & \ref{env:DARCS_SSH} \\-DARCS\_SCP & \ref{env:DARCS_SCP} \\-DARCS\_SFTP & \ref{env:DARCS_SFTP} \\-SSH\_PORT & \ref{env:SSH_PORT} \\-\hline-DARCS\_ALTERNATIVE\_COLOR & \ref{env:DARCS_ALWAYS_COLOR}\\-DARCS\_ALWAYS\_COLOR & \ref{env:DARCS_ALWAYS_COLOR}\\-DARCS\_DO\_COLOR\_LINES & \ref{env:DARCS_DO_COLOR_LINES}\\-DARCS\_DONT\_COLOR & \ref{env:DARCS_ALWAYS_COLOR} \\-DARCS\_DONT\_ESCAPE\_TRAILING\_CR & \ref{env:DARCS_DONT_ESCAPE_white}\\-DARCS\_DONT\_ESCAPE\_TRAILING\_SPACES & \ref{env:DARCS_DONT_ESCAPE_white} \\-DARCS\_DONT\_ESCAPE\_8BIT & \ref{env:DARCS_DONT_ESCAPE_nonascii}\\-DARCS\_DONT\_ESCAPE\_ANYTHING & \ref{env:DARCS_DONT_ESCAPE_nonascii}\\-DARCS\_DONT\_ESCAPE\_ISPRINT & \ref{env:DARCS_DONT_ESCAPE_nonascii}\\-DARCS\_ESCAPE\_EXTRA & \ref{env:DARCS_DONT_ESCAPE_nonascii}\\-DARCS\_DONT\_ESCAPE\_EXTRA & \ref{env:DARCS_DONT_ESCAPE_nonascii}\\-\hline-\end{tabular}--\section{General-purpose variables}--\darcsEnv{DARCS_EDITOR}-\darcsEnv{DARCS_PAGER}-\darcsEnv{DARCS_TMPDIR}-\darcsEnv{DARCS_KEEP_TMPDIR}-\darcsEnv{HOME}--\section{Remote repositories}-\darcsEnv{DARCS_SSH}-\darcsEnv{DARCS_SCP}-\darcsEnv{SSH_PORT}-\darcsEnv{HTTP_PROXY}-\darcsEnv{DARCS_PROXYUSERPWD}--\paragraph{DARCS\_GET\_FOO, DARCS\_MGET\_FOO and DARCS\_APPLY\_FOO}-\label{env:DARCS_X_FOO}-When trying to access a repository with a URL beginning foo://,-darcs will invoke the program specified by the DARCS\_GET\_FOO-environment variable (if defined) to download each file, and the-command specified by the DARCS\_APPLY\_FOO environment variable (if-defined) when pushing to a foo:// URL. --This method overrides all other ways of getting \verb!foo://xxx! URLs.--Note that each command should be constructed so that it sends the downloaded-content to STDOUT, and the next argument to it should be the URL\@. Here are some-examples that should work for DARCS\_GET\_HTTP:--\begin{verbatim}-fetch -q -o - -curl -s -f-lynx -source -wget -q -O --\end{verbatim}--Apart from such toy examples, it is likely that you will need to-manipulate the argument before passing it to the actual fetcher-program. For example, consider the problem of getting read access to-a repository on a CIFS (SMB) share without mount privileges:--\begin{verbatim}-export DARCS_GET_SMB="smbclient -c get"-darcs get smb://fs/twb/Desktop/hello-world-\end{verbatim}--The above command will not work for several reasons. Firstly, Darcs-will pass it an argument beginning with `smb:', which smbclient does-not understand. Secondly, the host and share `//fs/twb' must be-presented as a separate argument to the path `Desktop/hello-world'.-Thirdly, smbclient requires that `get' and the path be a single-argument (including a space), rather than two separate arguments.-Finally, smbclient's `get' command writes the file to disk, while-Darcs expects it to be printed to standard output.--In principle, we could get around such problems by making the variable-contain a shell script, e.g.--\begin{verbatim}-export DARCS_GET_SMB='sh -c "...; smbclient $x -c \"get $y\""'-\end{verbatim}--Unfortunately, Darcs splits the command on whitespace and does not-understand that quotation or escaping, so there is no way to make-Darcs pass the text after `-c' to sh as a single argument. Therefore,-we instead need to put such one-liners in separate, executable scripts.--Continuing our smbclient example, we create an executable script-\verb|~/.darcs/libexec/get_smb| with the following contents:--\begin{verbatim}-#!/bin/bash -e-IFS=/ read host share file <<<"${1#smb://}"-smbclient //$host/$share -c "get $file -"-\end{verbatim}--And at last we can say--\begin{verbatim}-export DARCS_GET_SMB=~/.darcs/libexec/get_smb-darcs get smb://fs/twb/Desktop/hello-world-\end{verbatim}---If set, DARCS\_MGET\_FOO-will be used to fetch many files from a single repository simultaneously.-Replace FOO and foo as appropriate to handle other URL schemes.-These commands are \emph{not} interpreted by a shell, so you cannot-use shell metacharacters, and the first word in the command must-be the name of an executable located in your path. The GET command-will be called with a URL for each file. The MGET command will be-invoked with a number of URLs and is expected to download the files-to the current directory, preserving the file name but not the path.-The APPLY command will be called with a darcs patchfile piped into-its standard input. Example:--\begin{verbatim}-wget -q -\end{verbatim}--\paragraph{DARCS\_MGETMAX}-\label{env:DARCS_MGETMAX}-When invoking a DARCS\_MGET\_FOO command, darcs will limit the-number of URLs presented to the command to the value of this variable,-if set, or 200.--These commands are \emph{not} interpreted by a shell, so you cannot use shell-meta-characters.--\section{Highlighted output}-\label{env:DARCS_ALWAYS_COLOR}-\label{env:DARCS_DO_COLOR_LINES}-\label{env:DARCS_DONT_ESCAPE_white}--If the terminal understands ANSI color escape sequences,-darcs will highlight certain keywords and delimiters when printing patches.-This can be turned off by setting the environment variable DARCS\_DONT\_COLOR to 1.-If you use a pager that happens to understand ANSI colors, like \verb!less -R!,-darcs can be forced always to highlight the output-by setting DARCS\_ALWAYS\_COLOR to 1.-If you can't see colors you can set DARCS\_ALTERNATIVE\_COLOR to 1,-and darcs will use ANSI codes for bold and reverse video instead of colors.-In addition, there is an extra-colorful mode, which is not enabled by-default, which can be activated with DARCS\_DO\_COLOR\_LINES.--By default darcs will escape (by highlighting if possible) any kind of spaces at the end of lines-when showing patch contents.-If you don't want this you can turn it off by setting-DARCS\_DONT\_ESCAPE\_TRAILING\_SPACES to 1.-A special case exists for only carriage returns:-DARCS\_DONT\_ESCAPE\_TRAILING\_CR.---\section{Character escaping and non-ASCII character encodings}-\label{env:DARCS_DONT_ESCAPE_nonascii}--Darcs needs to escape certain characters when printing patch contents to a terminal.-Characters like \emph{backspace} can otherwise hide patch content from the user,-and other character sequences can even in some cases redirect commands to the shell-if the terminal allows it.--By default darcs will only allow printable 7-bit ASCII characters (including space),-and the two control characters \emph{tab} and \emph{newline}.-(See the last paragraph in this section for a way to tailor this behavior.)-All other octets are printed in quoted form (as \verb!^<control letter>! or-\verb!\!\verb!<hex code>!).--Darcs has some limited support for locales.-If the system's locale is a single-byte character encoding,-like the Latin encodings,-you can set the environment variable DARCS\_DONT\_ESCAPE\_ISPRINT to 1-and darcs will display all the printables in the current system locale-instead of just the ASCII ones.-NOTE: This curently does not work on some architectures if darcs is-compiled with GHC~6.4 or later. Some non-ASCII control characters might be printed-and can possibly spoof the terminal.--For multi-byte character encodings things are less smooth.-UTF-8 will work if you set DARCS\_DONT\_ESCAPE\_8BIT to 1,-but non-printables outside the 7-bit ASCII range are no longer escaped.-E.g., the extra control characters from Latin-1-might leave your terminal at the mercy of the patch contents.-Space characters outside the 7-bit ASCII range are no longer recognized-and will not be properly escaped at line endings.--As a last resort you can set DARCS\_DONT\_ESCAPE\_ANYTHING to 1.-Then everything that doesn't flip code sets should work,-and so will all the bells and whistles in your terminal.-This environment variable can also be handy-if you pipe the output to a pager or external filter-that knows better than darcs how to handle your encoding.-Note that \emph{all} escaping,-including the special escaping of any line ending spaces,-will be turned off by this setting.--There are two environment variables you can set-to explicitly tell darcs to not escape or escape octets.-They are-DARCS\_DONT\_ESCAPE\_EXTRA and DARCS\_ESCAPE\_EXTRA.-Their values should be strings consisting of the verbatim octets in question.-The do-escapes take precedence over the dont-escapes.-Space characters are still escaped at line endings though.-The special environment variable DARCS\_DONT\_ESCAPE\_TRAILING\_CR-turns off escaping of carriage return last on the line (DOS style).
src/darcs.hs view
@@ -15,25 +15,25 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} module Main (main) where -import Prelude hiding ( catch )+import Prelude import System.IO ( stdin, stdout, stderr, hSetBinaryMode ) import Control.Monad ( forM_ ) import System.Exit ( exitWith, ExitCode(..) ) import System.Environment ( getArgs )-import Control.Exception.Extensible ( AssertionFailed(..), handle, catch )+import Control.Exception.Extensible ( AssertionFailed(..), handle ) import Darcs.RunCommand ( runTheCommand ) import Darcs.Flags ( DarcsFlag(Verbose) ) import Darcs.Commands.Help ( helpCmd, listAvailableCommands, printVersion, commandControlList ) import Darcs.SignalHandler ( withSignalsHandled ) import Version ( version, context, builddeps )-import Darcs.Global ( withAtexit )+import Darcs.Global ( withAtexit, atexit )+import Darcs.Repository( reportBadSources ) import Preproc( preprocMain ) import Exec ( ExecException(..) ) #include "impossible.h"@@ -47,8 +47,9 @@ main :: IO () main = withAtexit $ withSignalsHandled $- flip catch execExceptionHandler $+ handle execExceptionHandler $ handle (\(AssertionFailed e) -> bug e) $ do+ atexit reportBadSources argv <- getArgs case argv of -- User called "darcs" without arguments.
− src/darcs.tex
@@ -1,674 +0,0 @@-% Copyright (C) 2002-2003 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.--\documentclass{book}-%\usepackage{color}--\usepackage{verbatim}-\usepackage{html}-\usepackage{fancyvrb}-\newenvironment{code}{\comment}{\endcomment}-% \newenvironment{code}{\color{blue}\verbatim}{\endverbatim}--\begin{document}---% Definition of title page:-\title{Darcs User Manual}-\date{-\darcsVersion-} % icky newline before closing brace is to appease preproc.hs.-\author{David Roundy}--\maketitle--\tableofcontents--\chapter{Introduction}--%% FIXME: DVCS is no longer distinctive; it is the norm.--Darcs is a revision control system, along the lines of CVS or arch. That-means that it keeps track of various revisions and branches of your-project, allows for changes to propagate from one branch to another. Darcs-is intended to be an ``advanced'' revision control system. Darcs has two-particularly distinctive features which differ from other revision control-systems: 1) each copy of the source is a fully functional branch, and 2)-underlying darcs is a consistent and powerful theory of patches.--%% FIXME: don't talk about CVS and arch as if they are our-%% contemporaries, it makes us sound as dated as they are. Our key-%% competitors are git, hg, bzr and svn.--\paragraph{Every source tree a branch}-The primary simplifying notion of darcs is that \emph{every} copy of your-source code is a full repository. This is dramatically different from CVS,-in which the normal usage is for there to be one central repository from-which source code will be checked out. It is closer to the notion of arch,-since the `normal' use of arch is for each developer to create his own-repository. However, darcs makes it even easier, since simply checking out-the code is all it takes to create a new repository. This has several-advantages, since you can harness the full power of darcs in any scratch-copy of your code, without committing your possibly destabilizing changes to-a central repository.--%% FIXME: unbound personal pronoun (me). Use third person, passive voice.--\paragraph{Theory of patches}-The development of a simplified theory of patches is what originally-motivated me to create darcs. This patch formalism means that darcs patches-have a set of properties, which make possible manipulations that couldn't be-done in other revision control systems. First, every patch is invertible.-Secondly, sequential patches (i.e.\ patches that are created in sequence, one-after the other) can be reordered, although this reordering can fail, which-means the second patch is dependent on the first. Thirdly, patches which are-in parallel (i.e.\ both patches were created by modifying identical trees)-can be merged, and the result of a set of merges is independent of the order-in which the merges are performed. This last property is critical to darcs'-philosophy, as it means that a particular version of a source tree is fully-defined by the list of patches that are in it, i.e.\ there is no issue-regarding the order in which merges are performed. For a more thorough-discussion of darcs' theory of patches, see Appendix~\ref{Patch}.--%% FIXME: clarify - the theory is advanced, the UI is simple.--\paragraph{A simple advanced tool}-Besides being ``advanced'' as discussed above, darcs is actually also quite-simple. Versioning tools can be seen as three layers. At the foundation is-the ability to manipulate changes. On top of that must be placed some kind-of database system to keep track of the changes. Finally, at the very top is-some sort of distribution system for getting changes from one place to-another.--Really, only the first of these three layers is of particular interest to-me, so the other two are done as simply as possible. At the database-layer, darcs just has an ordered list of patches along with the patches-themselves, each stored as an individual file. Darcs' distribution system-is strongly inspired by that of arch. Like arch, darcs uses a dumb server,-typically apache or just a local or network file system when pulling-patches. darcs has built-in support for using \verb!ssh! to write to a remote file-system. A darcs executable is called on the remote system to apply the patches.-Arbitrary other transport protocols are supported, through an environment-variable describing a command that will run darcs on the remote system.-See the documentation for DARCS\_APPLY\_FOO in Chapter~\ref{configuring}-for details.--The recommended method is to send patches through gpg-signed email-messages, which has the advantage of being mostly asynchronous.--\paragraph{Keeping track of changes rather than versions}--In the last paragraph, I explained revision control systems in terms of-three layers. One can also look at them as having two distinct uses. One-is to provide a history of previous versions. The other is to keep track-of changes that are made to the repository, and to allow these changes to-be merged and moved from one repository to another. These two uses are-distinct, and almost orthogonal, in the sense that a tool can support one-of the two uses optimally while providing no support for the other. Darcs-is not intended to maintain a history of versions, although it is possible-to kludge together such a revision history, either by making each new patch-depend on all previous patches, or by tagging regularly. In a sense, this-is what the tag feature is for, but the intention is that tagging will be-used only to mark particularly notable versions (e.g.\ released versions, or-perhaps versions that pass a time consuming test suite).--Other revision control systems are centered upon the job of keeping track-of a history of versions, with the ability to merge changes being added as-it was seen that this would be desirable. But the fundamental object-remained the versions themselves.--In such a system, a patch (I am using patch here to mean an encapsulated-set of changes) is uniquely determined by two trees. Merging changes that-are in two trees consists of finding a common parent tree, computing the-diffs of each tree with their parent, and then cleverly combining those two-diffs and applying the combined diff to the parent tree, possibly at some-point in the process allowing human intervention, to allow for fixing up-problems in the merge such as conflicts.--In the world of darcs, the source tree is \emph{not} the fundamental-object, but rather the patch is the fundamental object. Rather than a-patch being defined in terms of the difference between two trees, a tree is-defined as the result of applying a given set of patches to an empty tree.-Moreover, these patches may be reordered (unless there are dependencies-between the patches involved) without changing the tree. As a result,-there is no need to find a common parent when performing a merge. Or, if-you like, their common parent is defined by the set of common patches, and-may not correspond to any version in the version history.--One useful consequence of darcs' patch-oriented philosophy is that since a-patch need not be uniquely defined by a pair of trees (old and new), we can-have several ways of representing the same change, which differ only in how-they commute and what the result of merging them is. Of course, creating-such a patch will require some sort of user input. This is a Good Thing,-since the user \emph{creating} the patch should be the one forced to think-about what he really wants to change, rather than the users merging the-patch. An example of this is the token replace patch (See-Section~\ref{token_replace}). This feature makes it possible to create a-patch, for example, which changes every instance of the variable-``stupidly\_named\_var'' to ``better\_var\_name'', while leaving-``other\_stupidly\_named\_var'' untouched. When this patch is merged with-any other patch involving the ``stupidly\_named\_var'', that instance will-also be modified to ``better\_var\_name''. This is in contrast to a more-conventional merging method which would not only fail to change new-instances of the variable, but would also involve conflicts when merging-with any patch that modifies lines containing the variable. By more using-additional information about the programmer's intent, darcs is thus able to-make the process of changing a variable name the trivial task that it-really is, which is really just a trivial search and replace, modulo-tokenizing the code appropriately.--The patch formalism discussed in Appendix~\ref{Patch} is what makes darcs'-approach possible. In order for a tree to consist of a set of patches,-there must be a deterministic merge of any set of patches, regardless of the-order in which they must be merged. This requires that one be able to-reorder patches. While I don't know that the patches are required to be-invertible as well, my implementation certainly requires invertibility. In-particular, invertibility is required to make use of-Theorem~\ref{merge_thm}, which is used extensively in the manipulation of-merges.--\input{features.tex}--\chapter{Getting started}--This chapter will lead you through an example use of darcs, which hopefully-will allow you to get started using darcs with your project.--\section{Creating your repository}--Creating your repository in the first place just involves telling darcs to-create the special directory (called {\tt \_darcs}) in your project tree,-which will hold the revision information. This is done by simply calling-from the root directory of your project:-\begin{verbatim}-$ cd my_project/-$ darcs initialize-\end{verbatim}-This creates the \verb|_darcs| directory and populates it with whatever-files and directories are needed to describe an empty project. You now-need to tell darcs what files and directories in your project should be-under revision control. You do this using the command \verb|darcs add|%-\footnote{Note that darcs does not do wildcard expansion, instead relying-on the command shell. The Windows port of darcs has a limited form of-expansion provided by the C runtime}:-\begin{verbatim}-$ darcs add *.c Makefile.am configure.ac-\end{verbatim}-When you have added all your files (or at least, think you have), you will-want to record your changes. ``Recording'' always includes adding a note-as to why the change was made, or what it does. In this case, we'll just-note that this is the initial version.-\begin{verbatim}-$ darcs record --all-What is the patch name? Initial revision.-\end{verbatim}-Note that since we didn't specify a patch name on the command line we were-prompted for one. If the environment variable `EMAIL' isn't set, you will-also be prompted for your email address. Each patch that is recorded is-given a unique identifier consisting of the patch name, its creator's email-address, and the date when it was created.--\section{Making changes}--Now that we have created our repository, make a change to one or more of-your files. After making the modification run:-\begin{verbatim}-$ darcs whatsnew-\end{verbatim}-This should show you the modifications that you just made, in the darcs-patch format. If you prefer to see your changes in a different format,-read Section~\ref{whatsnew}, which describes the whatsnew command in-detail.--Let's say you have now made a change to your project. The next thing to do-is to record a patch. Recording a patch consists of grouping together a-set of related changes, and giving them a name. It also tags the patch-with the date it was recorded and your email address.--To record a patch simply type:-\begin{verbatim}-$ darcs record-\end{verbatim}-darcs will then prompt you with all the changes that you have made that-have not yet been recorded, asking you which ones you want to include in-the new patch. Finally, darcs will ask you for a name for the patch.--You can now rerun whatsnew, and see that indeed the changes you have-recorded are no longer marked as new.--\section{Making your repository visible to others}-How do you let the world know about these wonderful changes? Obviously,-they must be able to see your repository. Currently the easiest way to do-this is typically by http using any web server. The recommended way to do-this (using apache in a UNIX environment) is to create a directory called-{\tt /var/www/repos}, and then put a symlink to your repository there:-\begin{verbatim}-$ cd /var/www/repos-$ ln -s /home/username/myproject .-\end{verbatim}--\section{Getting changes made to another repository}-Ok, so I can now browse your repository using my web browser\ldots\ so-what? How do I get your changes into \emph{my} repository, where they can-do some good? It couldn't be easier. I just \verb|cd| into my repository,-and there type:-\begin{verbatim}-$ darcs pull http://your.server.org/repos/yourproject-\end{verbatim}-Darcs will check to see if you have recorded any changes that aren't in my-current repository. If so, it'll prompt me for each one, to see which ones-I want to add to my repository. Note that you may see a different series-of prompts depending on your answers, since sometimes one patch depends on-another, so if you answer yes to the first one, you won't be prompted for-the second if the first depends on it.--Of course, maybe I don't even have a copy of your repository. In that case-I'd want to do a-\begin{verbatim}-$ darcs get http://your.server.org/repos/yourproject-\end{verbatim}-which gets the whole repository.--I could instead create an empty repository and fetch all of your patches-with pull. Get is just a more efficient way to clone a whole repository.--Get, pull and push also work over ssh. Ssh-paths are of the same form-accepted by scp, namely \verb|[username@]host:/path/to/repository|.--\section{Moving patches from one repository to another}--Darcs is flexible as to how you move patches from one repository to another.-This section will introduce all the ways you can get patches from one place-to another, starting with the simplest and moving to the most complicated.--\subsection{All pulls}--The simplest method is the ``all-pull'' method. This involves making each-repository readable (by http, ftp, nfs-mounted disk, whatever), and you-run \verb|darcs pull| in the repository you want to move the patch to. This is nice,-as it doesn't require you to give write access to anyone else, and is-reasonably simple.--\subsection{Send and apply manually}--Sometimes you have a machine on which it is not convenient to set up a web-server, perhaps because it's behind a firewall or perhaps for security-reasons, or because it is often turned off. In this case you can use-\verb|darcs send|-from that computer to generate a patch bundle destined for another-repository. You can either let darcs email the patch for you, or save it-as a file and transfer it by hand. Then in the destination repository you-(or the owner of that repository) run \verb|darcs apply| to apply the patches contained-in the bundle. This is also quite a simple method since, like the all-pull-method, it doesn't require that you give anyone write access to your-repository. But it's less convenient, since you have to keep track of the-patch bundle (in the email, or whatever).--If you use the send and apply method with email, you'll probably want to-create a \verb!_darcs/prefs/email! file containing your email address.-This way anyone who sends to your repository will automatically send the-patch bundle to your email address.--If you receive many patches by email, you probably will benefit by running-darcs apply directly from your mail program. I have in my \verb!.muttrc!-the following:-\begin{verbatim}-auto_view text/x-patch text/x-darcs-patch-macro pager A "<pipe-entry>darcs apply --verbose --mark-conflicts \- --reply droundy@abridgegame.org --repodir ~/darcs"-\end{verbatim}-which allows me to view a sent patch, and then apply the patch directly from \verb!mutt!, sending a-confirmation email to the person who sent me the patch. The autoview line relies on on the following-lines, or something like them, being present in one's \verb!.mailcap!:-\begin{verbatim}-text/x-patch; cat; copiousoutput-text/x-darcs-patch; cat; copiousoutput-\end{verbatim}--\subsection{Push}--If you use ssh (and preferably also ssh-agent, so you won't have to keep-retyping your password), you can use the push method to transfer changes-(using the scp protocol for communication). This method is again not very-complicated, since you presumably already have the ssh permissions set up.-Push can also be used when the target repository is local, in which case-ssh isn't needed. On the other hand, in this situation you could as easily-run a pull, so there isn't much benefit.--Note that you can use push to administer a multiple-user repository. You-just need to create a user for the repository (or repositories), and give-everyone with write access ssh access, perhaps using-\verb!.ssh/authorized_keys!. Then they run-\begin{verbatim}-$ darcs push repouser@repo.server:repo/directory-\end{verbatim}--\subsection{Push ---apply-as}--Now we get more subtle. If you like the idea in the previous paragraph-about creating a repository user to own a repository which is writable by-a number of users, you have one other option.--Push \verb!--apply-as! can run on either a local repository or one accessed-with ssh, but uses \verb!sudo! to run a darcs apply command (having created-a patch bundle as in send) as another user. You can add the following line-in your \verb|sudoers| file to allow the users to apply their patches to a-centralized repository:-{\small-\begin{verbatim}-ALL ALL = (repo-user) NOPASSWD: /usr/bin/darcs apply --all --repodir /repo/path*-\end{verbatim}-}-This method is ideal for a centralized repository when all the users have-accounts on the same computer, if you don't want your users to be able to-run arbitrary commands as repo-user.--\subsection{Sending signed patches by email}--Most of the previous methods are a bit clumsy if you don't want to give-each person with write access to a repository an account on your server. Darcs-send can be configured to send a cryptographically signed patch by email.-You can then set up your mail system to have darcs verify that patches were-signed by an authorized user and apply them when a patch is received by-email. The results of the apply can be returned to the user by email.-Unsigned patches (or patches signed by unauthorized users) will be-forwarded to the repository owner (or whoever you configure them to be-forwarded to\ldots).--This method is especially nice when combined with the \verb!--test! option-of darcs apply, since it allows you to run the test suite (assuming you-have one) and reject patches that fail---and it's all done on the server,-so you can happily go on working on your development machine without-slowdown while the server runs the tests.--Setting up darcs to run automatically in response to email is by far the-most complicated way to get patches from one repository to another\ldots\ so it'll-take a few sections to explain how to go about it.--\paragraph{Security considerations}--When you set up darcs to run apply on signed patches, you should assume-that a user with write access can write to any file or directory that is-writable by the user under which the apply process runs. Unless you-specify the \verb!--no-test! flag to darcs apply (and this is \emph{not}-the default), you are also allowing anyone with write access to that-repository to run arbitrary code on your machine (since they can run a test-suite---which they can modify however they like). This is quite a-potential security hole.--For these reasons, if you don't implicitly trust your users, it is-recommended that you create a user for each repository to limit the damage-an attacker can do with access to your repository. When considering who to-trust, keep in mind that a security breach on any developer's machine could-give an attacker access to their private key and passphrase, and thus to-your repository.--\paragraph{Installing necessary programs}--You also must install the following programs: gnupg, a mailer configured to-receive mail (e.g.\ exim, sendmail or postfix), and a web server (usually-apache).--\paragraph{Granting access to a repository}--You create your gpg key by running (as your normal user):-\begin{verbatim}-$ gpg --gen-key-\end{verbatim}-You will be prompted for your name and email address, among other options.-%%To add your public key to the allowed keys keyring.-Of course, you can-skip this step if you already have a gpg key you wish to use.--You now need to export the public key so we can tell the patcher about it.-You can do this with the following command (again as your normal user):-\begin{verbatim}-$ gpg --export "email@address" > /tmp/exported_key-\end{verbatim}-And now we can add your key to the \verb!allowed_keys!:-\begin{verbatim}-(as root)> gpg --keyring /var/lib/darcs/repos/myproject/allowed_keys \- --no-default-keyring --import /tmp/exported_key-\end{verbatim}-You can repeat this process any number of times to authorize multiple users-to send patches to the repository.--You should now be able to send a patch to the repository by running as your-normal user, in a working copy of the repository:-\begin{verbatim}-$ darcs send --sign http://your.computer/repos/myproject-\end{verbatim}-You may want to add ``send sign'' to the file \verb!_darcs/prefs/defaults!-so that you won't need to type \verb!--sign! every time you want to-send\ldots--If your gpg key is protected by a passphrase, then executing \verb!send!-with the \verb!--sign! option might give you the following error:-\begin{verbatim}-darcs failed: Error running external program 'gpg'-\end{verbatim}-The most likely cause of this error is that you have a misconfigured-gpg that tries to automatically use a non-existent gpg-agent-program. GnuPG will still work without gpg-agent when you try to sign-or encrypt your data with a passphrase protected key. However, it will-exit with an error code 2 (\verb!ENOENT!) causing \verb!darcs! to-fail. To fix this, you will need to edit your \verb!~/.gnupg/gpg.conf!-file and comment out or remove the line that says:-\begin{verbatim}-use-agent-\end{verbatim}-If after commenting out or removing the \verb!use-agent! line in your-gpg configuration file you still get the same error, then you probably-have a modified GnuPG with use-agent as a hard-coded option. In that-case, you should change \verb!use-agent! to \verb!no-use-agent! to-disable it explicitly.--\paragraph{Setting up a sendable repository using procmail}-If you don't have root access on your machine, or perhaps simply don't want-to bother creating a separate user, you can set up a darcs repository using-procmail to filter your mail. I will assume that you already use procmail-to filter your email. If not, you will need to read up on it, or perhaps-should use a different method for routing the email to darcs.--To begin with, you must configure your repository so that a darcs send to-your repository will know where to send the email. Do this by creating a-file in \verb!/path/to/your/repo/_darcs/prefs! called \verb!email!-containing your email address. As a trick (to be explained below), we will-create the email address with ``darcs repo'' as your name, in an email-address of the form ``David Roundy $<$droundy@abridgegame.org$>$.''-\begin{verbatim}-$ echo 'my darcs repo <user@host.com>' \- > /path/to/your/repo/_darcs/prefs/email-\end{verbatim}--The next step is to set up a gnupg keyring containing the public keys of-people authorized to send to your repository. Here I'll give a second way of-going about this (see above for the first). This time I'll assume you-want to give me write access to your repository. You can do this by:-\begin{verbatim}-gpg --no-default-keyring \- --keyring /path/to/the/allowed_keys --recv-keys D3D5BCEC-\end{verbatim}-This works because ``D3D5BCEC'' is the ID of my gpg key, and I have-uploaded my key to the gpg keyservers. Actually, this also requires that-you have configured gpg to access a valid keyserver. You can, of course,-repeat this command for all keys you want to allow access to.--Finally, we add a few lines to your \verb!.procmailrc!:-\begin{verbatim}-:0-* ^TOmy darcs repo-|(umask 022; darcs apply --reply user@host.com \- --repodir /path/to/your/repo --verify /path/to/the/allowed_keys)-\end{verbatim}-The purpose for the ``my darcs repo'' trick is partially to make it easier-to recognize patches sent to the repository, but is even more crucial to-avoid nasty bounce loops by making the \verb!--reply! option have an email-address that won't go back to the repository. This means that unsigned-patches that are sent to your repository will be forwarded to your ordinary-email.--Like most mail-processing programs, Procmail by default sets a tight umask.-However, this will prevent the repository from remaining world-readable;-thus, the ``umask 022'' is required to relax the umask.-(Alternatively, you could set Procmail's global \verb!UMASK! variable-to a more suitable value.)--\paragraph{Checking if your e-mail patch was applied}--After sending a patch with \verb!darcs send!, you may not receive any feedback,-even if the patch is applied. You can confirm whether or not your patch was applied-to the remote repository by pointing \verb!darcs changes! at a remote repository:-\begin{verbatim}-darcs changes --last=10 --repo=http://darcs.net/-\end{verbatim}--That shows you the last 10 changes in the remote repository. You can adjust the options given-to \verb!changes! if a more advanced query is needed.--\input{configuring_darcs.tex}--\input{best_practices.tex}--\input{formats.tex}--\chapter{Darcs commands}--\input{Darcs/Commands.lhs}--\section{Options apart from darcs commands}-\begin{options}---help-\end{options}-Calling darcs with just \verb|--help| as an argument gives a brief-summary of what commands are available.-\begin{options}---version, --exact-version-\end{options}-Calling darcs with the flag \verb|--version| tells you the version of-darcs you are using. Calling darcs with the flag \verb|--exact-version|-gives the precise version of darcs, even if that version doesn't correspond-to a released version number. This is helpful with bug reports, especially-when running with a ``latest'' version of darcs.-\begin{options}---commands-\end{options}-Similarly calling darcs with only \verb|--commands| gives a simple list-of available commands. This latter arrangement is primarily intended for-the use of command-line autocompletion facilities, as are available in-bash.--\section{Getting help}--\input{Darcs/Commands/Help.lhs}--\section{Creating repositories}--\input{Darcs/Commands/Init.lhs}--\input{Darcs/Commands/Get.lhs}--\input{Darcs/Commands/Put.lhs}--\section{Modifying the contents of a repository}--\input{Darcs/Commands/Add.lhs}--\input{Darcs/Commands/Remove.lhs}--\input{Darcs/Commands/Move.lhs}--\input{Darcs/Commands/Replace.lhs}--\section{Working with changes}--\input{Darcs/Commands/Record.lhs}--\input{Darcs/Commands/Pull.lhs}--\input{Darcs/Commands/Push.lhs}--\input{Darcs/Commands/Send.lhs}--\input{Darcs/Commands/Apply.lhs}--\section{Seeing what you've done}--\input{Darcs/Commands/WhatsNew.lhs}--\input{Darcs/Commands/Changes.lhs}--\input{Darcs/Commands/Show.lhs}--\section{More advanced commands}--\input{Darcs/Commands/Tag.lhs}--\input{Darcs/Commands/SetPref.lhs}--\input{Darcs/Commands/Check.lhs}--\input{Darcs/Commands/Optimize.lhs}--\section{Undoing, redoing and running in circles}--\input{Darcs/Commands/AmendRecord.lhs}--\input{Darcs/Commands/Rollback.lhs}--\input{Darcs/Commands/Unrecord.lhs}--\input{Darcs/Commands/Revert.lhs}--\input{Darcs/Commands/Unrevert.lhs}--\section{Advanced examination of the repository}--\input{Darcs/Commands/Diff.lhs}--\input{Darcs/Commands/Annotate.lhs}--% Includes the show commands.-\input{Darcs/Commands/Show.lhs}--\section{Rarely needed and obscure commands}--\input{Darcs/Commands/Convert.lhs}--\input{Darcs/Commands/MarkConflicts.lhs}--\input{Darcs/Commands/Dist.lhs}--\input{Darcs/Commands/TrackDown.lhs}--\input{Darcs/Commands/Repair.lhs}--\appendix--\input{switching.tex}--\input{building_darcs.tex}--\input{Darcs/Patch.lhs}--\input{Darcs/Repository/DarcsRepo.lhs}--\input{gpl.tex}--\end{document}--
− src/features.tex
@@ -1,88 +0,0 @@-\section{Features}--\paragraph{Record changes locally}-In darcs, the equivalent of a cvs ``commit'' is called record, because it-doesn't put the change into any remote or centralized repository. Changes-are always recorded locally, meaning no net access is required in order to-work on your project and record changes as you make them. Moreover, this-means that there is no need for a separate ``disconnected operation'' mode.--\paragraph{Interactive records}-You can choose to perform an interactive record, in which case darcs will-prompt you for each change you have made and ask if you wish to record it.-Of course, you can tell darcs to record all the changes in a given file, or-to skip all the changes in a given file, or go back to a previous change,-or whatever. There is also an experimental graphical interface, which-allows you to view and choose changes even more easily, and in whichever-order you like.--\paragraph{Unrecord local changes}-As a corollary to the ``local'' nature of the record operation, if a change-hasn't yet been published to the world---that is, if the local repository-isn't accessible by others---you can safely unrecord a change (even if it-wasn't the most recently recorded change) and then re-record it-differently, for example if you forgot to add a file, introduced a bug or-realized that what you recorded as a single change was really two separate-changes.--\paragraph{Interactive everything else}-Most darcs commands support an interactive interface. The ``revert''-command, for example, which undoes unrecorded changes has the same-interface as record, so you can easily revert just a single change. Pull,-push, send and apply all allow you to view and interactively select which-changes you wish to pull, push, send or apply.--\paragraph{Test suites}-Darcs has support for integrating a test suite with a repository. If you-choose to use this, you can define a test command (e.g.\ ``make check'') and-have darcs run that command on a clean copy of the project either prior to-recording a change or prior to applying changes---and to reject changes-that cause the test to fail.--\paragraph{Any old server}-Darcs does not require a specialized server in order to make a repository-available for read access. You can use http, ftp, or even just a plain old-ssh server to access your darcs repository.--\paragraph{You decide write permissions}-Darcs doesn't try to manage write access. That's your business. Supported-push methods include direct ssh access (if you're willing to \emph{give}-direct ssh access away), using sudo to allow users who already have shell-access to only apply changes to the repository, or verification of-gpg-signed changes sent by email against a list of allowed keys. In-addition, there is good support for submission of patches by email that-are not automatically applied, but can easily be applied with a shell escape-from a mail reader (this is how I deal with contributions to darcs).--\paragraph{Symmetric repositories}-Every darcs repository is created equal (well, with the exception of a-``partial'' repository, which doesn't contain a full history\ldots), and every-working directory has an associated repository. As a result, there is a-symmetry between ``uploading'' and ``downloading'' changes---you can use-the same commands (push or pull) for either purpose.--\paragraph{CGI script}-Darcs has a CGI script that allows browsing of the repositories.--\paragraph{Portable}-Darcs runs on UNIX (or UNIX-like) systems (which includes Mac~OS~X) as well-as on Microsoft Windows.--\paragraph{File and directory moves}-Renames or moves of files and directories, of course are handled properly,-so when you rename a file or move it to a different directory, its history-is unbroken, and merges with repositories that don't have the file renamed-will work as expected.--\paragraph{Token replace}-You can use the ``darcs replace'' command to modify all occurrences of a-particular token (defined by a configurable set of characters that are-allowed in ``tokens'') in a file. This has the advantage that merges with-changes that introduce new copies of the old token will have the effect of-changing it to the new token---which comes in handy when changing a-variable or function name that is used throughout a project.--\paragraph{Configurable defaults}-You can easily configure the default flags passed to any command on either-a per-repository or a per-user basis or a combination thereof.-
− src/formats.tex
@@ -1,69 +0,0 @@-\chapter{Repository Formats}--Darcs 2 supports three repository formats:--\begin{itemize}-\item The current format, called `darcs-2'. It has the most features.-\item The original format, called `darcs-1' or `old-fashioned inventory'.- It is the only format supported by Darcs releases prior to 2.0.- Patches cannot be shared between darcs-2 and darcs-1 repositories.-\item An intermediary format, called `hashed'. It provides some of- the features of darcs-2, while retaining the ability to exchange- patches with darcs-1. Patches cannot be shared between darcs-2 and- hashed repositories.-\end{itemize}--Note that references to the hashed format refer to hashed darcs-1-repositories. All darcs-2 repositories are also hashed, and `darcs-show repo' in a darcs-2 repository will report the format as `hashed,-darcs-2'.--The hashed (and darcs-2) format improves on the darcs-1 format in the-following ways:--\begin{itemize}-\item Improved atomicity of operations. This improves the safety and- efficiency of those operations.-\item File names in the `pristine' copy of the working tree are- hashed. This greatly reduces the chance of a program accidentally- treating files in \_darcs/pristine as part of the working tree.-- For example, in darcs-1 running \verb|find -name "*.gif" -delete|- instead of \verb|find -name _darcs -prune -o -name "*.gif" -delete|- would result in GIF files in pristine files being deleted.--\item Support for `lazy' repositories. This causes patches to be- copied from the parent repository on demand, rather than during the- initial `darcs get'. For repositories that only operate on recent- patches (such as feature branches), this reduces the repository's- size, and the time and bandwidth taken to create it.-- Lazy repositories are first-class repositories, and all operations- are supported as long as the parent repository remains accessible.- This isn't the case for the `partial' feature of the darcs-1 format.--\item Support for caches that are shared by all repositories. When- operating on many similar repositories, the patches and pristine- files they have in common are hard links to the cache. This greatly- reduces storage requirements, and the time and bandwidth needed to- make similar repositories.-\end{itemize}--The darcs-2 format improves on the hashed format in the following-ways:--\begin{itemize}-\item The `exponential merge' problem is \emph{far} less likely to- occur (it can still be produced in deliberately pathological cases).-\item Identical primitive changes no longer conflict. For example, if- two patches both attempt to add a directory `tests', these patches- will not conflict.-\end{itemize}--% The following reference is particularly important because init-% explains *when* to use each format, which I don't want to-% copy-and-paste here because then the two copies will get out of-% sync.--See also `darcs initialize' (\ref{initialize}), `darcs convert'-(\ref{convert}) and `darcs get' (\ref{get}).
src/gadts.h view
@@ -2,10 +2,12 @@ #define C(contexts) contexts #define FORALL(types) forall types.+#define PATCHKIND * -> * -> * #else #define C(contexts) #define FORALL(types)+#define PATCHKIND * #endif
− src/gpl.tex
@@ -1,414 +0,0 @@-% This is the FSF GPL, reformatted as an appendix by David Roundy--% This file is intended to be included in another file.--\chapter{The GNU General Public License}-\label{gpl}-\section*{Version 2, June 1991}--\begin{center}-Version 2, June 1991--Copyright \copyright\ 1989, 1991 Free Software Foundation, Inc.--\bigskip--51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA--\bigskip--Everyone is permitted to copy and distribute verbatim copies-of this license document, but changing it is not allowed.--\end{center}--\section*{Preamble}-\begin{quote}-The licenses for most software are designed to take away your freedom to-share and change it. By contrast, the GNU General Public License is-intended to guarantee your freedom to share and change free software---to-make sure the software is free for all its users. This General Public-License applies to most of the Free Software Foundation's software and to-any other program whose authors commit to using it. (Some other Free-Software Foundation software is covered by the GNU Library General Public-License instead.) You can apply it to your programs, too.--When we speak of free software, we are referring to freedom, not price.-Our General Public Licenses are designed to make sure that you have the-freedom to distribute copies of free software (and charge for this service-if you wish), that you receive source code or can get it if you want it,-that you can change the software or use pieces of it in new free programs;-and that you know you can do these things.--To protect your rights, we need to make restrictions that forbid anyone to-deny you these rights or to ask you to surrender the rights. These-restrictions translate to certain responsibilities for you if you-distribute copies of the software, or if you modify it.--For example, if you distribute copies of such a program, whether gratis or-for a fee, you must give the recipients all the rights that you have. You-must make sure that they, too, receive or can get the source code. And-you must show them these terms so they know their rights.--We protect your rights with two steps: (1) copyright the software, and (2)-offer you this license which gives you legal permission to copy,-distribute and/or modify the software.--Also, for each author's protection and ours, we want to make certain that-everyone understands that there is no warranty for this free software. If-the software is modified by someone else and passed on, we want its-recipients to know that what they have is not the original, so that any-problems introduced by others will not reflect on the original authors'-reputations.--Finally, any free program is threatened constantly by software patents.-We wish to avoid the danger that redistributors of a free program will-individually obtain patent licenses, in effect making the program-proprietary. To prevent this, we have made it clear that any patent must-be licensed for everyone's free use or not licensed at all.--The precise terms and conditions for copying, distribution and-modification follow.-\end{quote}--\begin{center}-{\Large \sc GNU General Public License-\\\vspace{3mm}Terms and Conditions For Copying, Distribution and Modification}-\end{center}---\begin{enumerate}--\addtocounter{enumi}{-1}--\item --This License applies to any program or other work which contains a notice-placed by the copyright holder saying it may be distributed under the-terms of this General Public License. The ``Program'', below, refers to-any such program or work, and a ``work based on the Program'' means either-the Program or any derivative work under copyright law: that is to say, a-work containing the Program or a portion of it, either verbatim or with-modifications and/or translated into another language. (Hereinafter,-translation is included without limitation in the term ``modification''.)-Each licensee is addressed as ``you''.--Activities other than copying, distribution and modification are not-covered by this License; they are outside its scope. The act of-running the Program is not restricted, and the output from the Program-is covered only if its contents constitute a work based on the-Program (independent of having been made by running the Program).-Whether that is true depends on what the Program does.--\item You may copy and distribute verbatim copies of the Program's source- code as you receive it, in any medium, provided that you conspicuously- and appropriately publish on each copy an appropriate copyright notice- and disclaimer of warranty; keep intact all the notices that refer to- this License and to the absence of any warranty; and give any other- recipients of the Program a copy of this License along with the Program.--You may charge a fee for the physical act of transferring a copy, and you-may at your option offer warranty protection in exchange for a fee.--\item--You may modify your copy or copies of the Program or any portion-of it, thus forming a work based on the Program, and copy and-distribute such modifications or work under the terms of Section 1-above, provided that you also meet all of these conditions:--\begin{enumerate}--\item --You must cause the modified files to carry prominent notices stating that-you changed the files and the date of any change.--\item--You must cause any work that you distribute or publish, that in-whole or in part contains or is derived from the Program or any-part thereof, to be licensed as a whole at no charge to all third-parties under the terms of this License.--\item-If the modified program normally reads commands interactively-when run, you must cause it, when started running for such-interactive use in the most ordinary way, to print or display an-announcement including an appropriate copyright notice and a-notice that there is no warranty (or else, saying that you provide-a warranty) and that users may redistribute the program under-these conditions, and telling the user how to view a copy of this-License. (Exception: if the Program itself is interactive but-does not normally print such an announcement, your work based on-the Program is not required to print an announcement.)--\end{enumerate}---These requirements apply to the modified work as a whole. If-identifiable sections of that work are not derived from the Program,-and can be reasonably considered independent and separate works in-themselves, then this License, and its terms, do not apply to those-sections when you distribute them as separate works. But when you-distribute the same sections as part of a whole which is a work based-on the Program, the distribution of the whole must be on the terms of-this License, whose permissions for other licensees extend to the-entire whole, and thus to each and every part regardless of who wrote it.--Thus, it is not the intent of this section to claim rights or contest-your rights to work written entirely by you; rather, the intent is to-exercise the right to control the distribution of derivative or-collective works based on the Program.--In addition, mere aggregation of another work not based on the Program-with the Program (or with a work based on the Program) on a volume of-a storage or distribution medium does not bring the other work under-the scope of this License.--\item-You may copy and distribute the Program (or a work based on it,-under Section 2) in object code or executable form under the terms of-Sections 1 and 2 above provided that you also do one of the following:--\begin{enumerate}--\item--Accompany it with the complete corresponding machine-readable-source code, which must be distributed under the terms of Sections-1 and 2 above on a medium customarily used for software interchange; or,--\item--Accompany it with a written offer, valid for at least three-years, to give any third party, for a charge no more than your-cost of physically performing source distribution, a complete-machine-readable copy of the corresponding source code, to be-distributed under the terms of Sections 1 and 2 above on a medium-customarily used for software interchange; or,--\item--Accompany it with the information you received as to the offer-to distribute corresponding source code. (This alternative is-allowed only for noncommercial distribution and only if you-received the program in object code or executable form with such-an offer, in accord with Subsection b above.)--\end{enumerate}---The source code for a work means the preferred form of the work for-making modifications to it. For an executable work, complete source-code means all the source code for all modules it contains, plus any-associated interface definition files, plus the scripts used to-control compilation and installation of the executable. However, as a-special exception, the source code distributed need not include-anything that is normally distributed (in either source or binary-form) with the major components (compiler, kernel, and so on) of the-operating system on which the executable runs, unless that component-itself accompanies the executable.--If distribution of executable or object code is made by offering-access to copy from a designated place, then offering equivalent-access to copy the source code from the same place counts as-distribution of the source code, even though third parties are not-compelled to copy the source along with the object code.--\item-You may not copy, modify, sublicense, or distribute the Program-except as expressly provided under this License. Any attempt-otherwise to copy, modify, sublicense or distribute the Program is-void, and will automatically terminate your rights under this License.-However, parties who have received copies, or rights, from you under-this License will not have their licenses terminated so long as such-parties remain in full compliance.--\item-You are not required to accept this License, since you have not-signed it. However, nothing else grants you permission to modify or-distribute the Program or its derivative works. These actions are-prohibited by law if you do not accept this License. Therefore, by-modifying or distributing the Program (or any work based on the-Program), you indicate your acceptance of this License to do so, and-all its terms and conditions for copying, distributing or modifying-the Program or works based on it.--\item-Each time you redistribute the Program (or any work based on the-Program), the recipient automatically receives a license from the-original licensor to copy, distribute or modify the Program subject to-these terms and conditions. You may not impose any further-restrictions on the recipients' exercise of the rights granted herein.-You are not responsible for enforcing compliance by third parties to-this License.--\item-If, as a consequence of a court judgment or allegation of patent-infringement or for any other reason (not limited to patent issues),-conditions are imposed on you (whether by court order, agreement or-otherwise) that contradict the conditions of this License, they do not-excuse you from the conditions of this License. If you cannot-distribute so as to satisfy simultaneously your obligations under this-License and any other pertinent obligations, then as a consequence you-may not distribute the Program at all. For example, if a patent-license would not permit royalty-free redistribution of the Program by-all those who receive copies directly or indirectly through you, then-the only way you could satisfy both it and this License would be to-refrain entirely from distribution of the Program.--If any portion of this section is held invalid or unenforceable under-any particular circumstance, the balance of the section is intended to-apply and the section as a whole is intended to apply in other-circumstances.--It is not the purpose of this section to induce you to infringe any-patents or other property right claims or to contest validity of any-such claims; this section has the sole purpose of protecting the-integrity of the free software distribution system, which is-implemented by public license practices. Many people have made-generous contributions to the wide range of software distributed-through that system in reliance on consistent application of that-system; it is up to the author/donor to decide if he or she is willing-to distribute software through any other system and a licensee cannot-impose that choice.--This section is intended to make thoroughly clear what is believed to-be a consequence of the rest of this License.--\item-If the distribution and/or use of the Program is restricted in-certain countries either by patents or by copyrighted interfaces, the-original copyright holder who places the Program under this License-may add an explicit geographical distribution limitation excluding-those countries, so that distribution is permitted only in or among-countries not thus excluded. In such case, this License incorporates-the limitation as if written in the body of this License.--\item-The Free Software Foundation may publish revised and/or new versions-of the General Public License from time to time. Such new versions will-be similar in spirit to the present version, but may differ in detail to-address new problems or concerns.--Each version is given a distinguishing version number. If the Program-specifies a version number of this License which applies to it and ``any-later version'', you have the option of following the terms and conditions-either of that version or of any later version published by the Free-Software Foundation. If the Program does not specify a version number of-this License, you may choose any version ever published by the Free Software-Foundation.--\item-If you wish to incorporate parts of the Program into other free-programs whose distribution conditions are different, write to the author-to ask for permission. For software which is copyrighted by the Free-Software Foundation, write to the Free Software Foundation; we sometimes-make exceptions for this. Our decision will be guided by the two goals-of preserving the free status of all derivatives of our free software and-of promoting the sharing and reuse of software generally.--\begin{center}-{\Large\sc-No Warranty-}-\end{center}--\item-{\sc Because the program is licensed free of charge, there is no warranty-for the program, to the extent permitted by applicable law. Except when-otherwise stated in writing the copyright holders and/or other parties-provide the program ``as is'' without warranty of any kind, either expressed-or implied, including, but not limited to, the implied warranties of-merchantability and fitness for a particular purpose. The entire risk as-to the quality and performance of the program is with you. Should the-program prove defective, you assume the cost of all necessary servicing,-repair or correction.}--\item-{\sc In no event unless required by applicable law or agreed to in writing-will any copyright holder, or any other party who may modify and/or-redistribute the program as permitted above, be liable to you for damages,-including any general, special, incidental or consequential damages arising-out of the use or inability to use the program (including but not limited-to loss of data or data being rendered inaccurate or losses sustained by-you or third parties or a failure of the program to operate with any other-programs), even if such holder or other party has been advised of the-possibility of such damages.}--\end{enumerate}---\begin{center}-{\Large\sc End of Terms and Conditions}-\end{center}--\section{Appendix: How to Apply These Terms to Your New Programs}--If you develop a new program, and you want it to be of the greatest-possible use to the public, the best way to achieve this is to make it-free software which everyone can redistribute and change under these-terms.-- To do so, attach the following notices to the program. It is safest to- attach them to the start of each source file to most effectively convey- the exclusion of warranty; and each file should have at least the- ``copyright'' line and a pointer to where the full notice is found.--\begin{quote}-$<$one line to give the program's name and a brief idea of what it does.$>$ \\-Copyright (C) $<$year$>$ $<$name of author$>$ \\--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 of the License, 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; if not, write to the Free Software-Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.-\end{quote}--Also add information on how to contact you by electronic and paper mail.--If the program is interactive, make it output a short notice like this-when it starts in an interactive mode:--\begin{quote}-Gnomovision version 69, Copyright (C) $<$year$>$ $<$name of author$>$ \\-Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. \\-This is free software, and you are welcome to redistribute it-under certain conditions; type `show c' for details.-\end{quote}---The hypothetical commands {\tt show w} and {\tt show c} should show the-appropriate parts of the General Public License. Of course, the commands-you use may be called something other than {\tt show w} and {\tt show c};-they could even be mouse-clicks or menu items---whatever suits your-program.--You should also get your employer (if you work as a programmer) or your-school, if any, to sign a ``copyright disclaimer'' for the program, if-necessary. Here is a sample; alter the names:--\begin{quote}-Yoyodyne, Inc., hereby disclaims all copyright interest in the program \\-`Gnomovision' (which makes passes at compilers) written by James Hacker. \\--$<$signature of Ty Coon$>$, 1 April 1989 \\-Ty Coon, President of Vice-\end{quote}---This General Public License does not permit incorporating your program-into proprietary programs. If your program is a subroutine library, you-may consider it more useful to permit linking proprietary applications-with the library. If this is what you want to do, use the GNU Library-General Public License instead of this License.
src/hscurl.c view
@@ -250,8 +250,11 @@ return error_strings[RESULT_OK]; } -const char *curl_wait_next_url()+const char *curl_wait_next_url(int* errorCode, long* httpErrorCode) {+ *errorCode = -1;+ *httpErrorCode = -1;+ if (last_url != NULL) { free(last_url);@@ -274,10 +277,19 @@ CURL *easy = msg->easy_handle; CURLcode result = msg->data.result; struct UrlData *url_data;- int error = curl_easy_getinfo(easy, CURLINFO_PRIVATE, (char **)&url_data);- if (error != CURLE_OK)++ int error = set_time_out(easy, errorCode);+ if (error != CURLE_OK ){+ *errorCode = error; return curl_easy_strerror(error);+ } + error = curl_easy_getinfo(easy, CURLINFO_PRIVATE, (char **)&url_data);+ if (error != CURLE_OK){+ *errorCode = error;+ return curl_easy_strerror(error);+ }+ last_url = url_data->url; fclose(url_data->file); curl_slist_free_all(url_data->headers);@@ -288,8 +300,14 @@ return curl_multi_strerror(error); curl_easy_cleanup(easy); - if (result != CURLE_OK)+ if (result != CURLE_OK){+ *errorCode = result;++ if (result == CURLE_HTTP_RETURNED_ERROR)+ curl_easy_getinfo(easy, CURLINFO_RESPONSE_CODE, httpErrorCode);+ return curl_easy_strerror(result);+ } } else return error_strings[RESULT_UNKNOWN_MESSAGE];@@ -314,4 +332,24 @@ #else return 0; #endif+}++int set_time_out(CURL *handle, int* errorCode)+{+ int error;+ long time_out = DEFAULT_CONNECTION_TIMEOUT;+ const char *stime_out;++ stime_out = getenv("DARCS_CONNECTION_TIMEOUT");+ if (stime_out != NULL){+ long result = atol (stime_out);+ if ( result > 0 )+ time_out = result;+ else+ *errorCode = 90 ;+ }++ error = curl_easy_setopt(handle, CURLOPT_TIMEOUT, time_out);++ return error; }
src/hscurl.h view
@@ -1,11 +1,15 @@+#define DEFAULT_CONNECTION_TIMEOUT 30+ const char *curl_request_url(const char *url, const char *filename, int cache_time); -const char *curl_wait_next_url();+const char *curl_wait_next_url(int *errorCode, long* httpErrorCode); const char *curl_last_url(); void curl_enable_debug(); int curl_pipelining_enabled();++int set_time_out();
− src/switching.tex
@@ -1,147 +0,0 @@-\section{Switching from CVS}--Darcs is refreshingly different from CVS.--CVS keeps version controlled data in a central repository, and-requires that users check out a working directory whenever they wish-to access the version-controlled sources. In order to modify the-central repository, a user needs to have write access to the central-repository; if he doesn't, CVS merely becomes a tool to get the latest-sources.--In darcs there is no distinction between working directories and-repositories. In order to work on a project, a user makes a local-copy of the repository he wants to work in; he may then harness the-full power of version control locally. In order to distribute his-changes, a user who has write access can \emph{push} them to the-remote repository; one who doesn't can simply send them by e-mail in a-format that makes them easy to apply on the remote system.--\paragraph{Darcs commands for CVS users}-Because of the different models used by cvs and darcs, it is-difficult to provide a complete equivalence between cvs and darcs.-A rough correspondence for the everyday commands follows:\\-% The \hspace commands force a line break in the postscript output,-% but they are effectively ignored in the html output.-\begin{description}\addtolength{\itemsep}{-0.5\baselineskip}-\item[{\tt cvs checkout}\hspace*{100em}]- {\tt darcs get}-\item[{\tt cvs update}\hspace*{100em}]- {\tt darcs pull}-\item[{\tt cvs -n update}\hspace*{100em}]- {\tt darcs pull \verb!--dry-run!}- (summarize remote changes)-\item[{\tt cvs -n update}\hspace*{100em}]- {\tt darcs whatsnew \verb!--summary!}- (summarize local changes)-\item[{\tt cvs -n update | grep '?'}\hspace*{100em}]- {\tt darcs whatsnew -ls | grep \verb!^a! }- (list potential files to add)-\item[{\tt rm foo.txt; cvs update foo.txt}\hspace*{100em}]- {\tt darcs revert foo.txt}- (revert to foo.txt from repo)-\item[{\tt cvs diff}\hspace*{100em}]- {\tt darcs whatsnew}- (if checking local changes)-\item[{\tt cvs diff}\hspace*{100em}]- {\tt darcs diff}- (if checking recorded changes)-\item[{\tt cvs commit}\hspace*{100em}]- {\tt darcs record}- (if committing locally)-\item[{\tt cvs commit}\hspace*{100em}]- {\tt darcs tag}- (if marking a version for later use)-\item[{\tt cvs commit}\hspace*{100em}]- {\tt darcs push} or {\tt darcs send}- (if committing remotely)-\item[{\tt cvs diff | mail}\hspace*{100em}]- {\tt darcs send}-\item[{\tt cvs add}\hspace*{100em}]- {\tt darcs add}-\item[{\tt cvs tag -b}\hspace*{100em}]- {\tt darcs get}-\item[{\tt cvs tag}\hspace*{100em}]- {\tt darcs tag}-\end{description}--\paragraph{Migrating CVS repositories to darcs}--Tools and instructions for migrating CVS repositories to darcs are provided-on the darcs community website: -\htmladdnormallinkfoot{http://wiki.darcs.net/DarcsWiki/ConvertingFromCvs}{http://wiki.darcs.net/DarcsWiki/ConvertingFromCvs}---\section{Switching from arch}--Although arch, like darcs, is a distributed system, and the two systems-have many similarities (both require no special server, for example), their-essential organization is very different.--Like CVS, arch keeps data in two types of data structures:-repositories (called ``archives'') and working directories. In order-to modify a repository, one must first check out a corresponding-working directory. This requires that users remember a number of-different ways of pushing data around --- \verb|tla| \verb|get|,-\verb|update|, \verb|commit|, \verb|archive-mirror| and so on.--In darcs, on the other hand, there is no distinction between working-directories and repositories, and just checking out your sources-creates a local copy of a repository. This allows you to harness the-full power of version control in any scratch copy of your sources, and-also means that there are just two ways to push data around:-\verb|darcs| \verb|record|, which stores edits into your local-repository, and \verb|pull|, which moves data between repositories.-(\verb|darcs| \verb|push| is merely the opposite of \verb|pull|;-\verb|send| and \verb|apply| are just the two halves of \verb|push|).--\paragraph{Darcs commands for arch users}--Because of the different models used by arch and darcs, it is-difficult to provide a complete equivalence between arch and darcs.-A rough correspondence for the everyday commands follows:\\-\begin{description}\addtolength{\itemsep}{-0.5\baselineskip}-\item[{\tt tla init-tree}\hspace*{100em}]- {\tt darcs initialize}-\item[{\tt tla get}\hspace*{100em}]- {\tt darcs get}-\item[{\tt tla update}\hspace*{100em}]- {\tt darcs pull}-\item[{\tt tla file-diffs f | patch -R }\hspace*{100em}]- {\tt darcs revert}-\item[{\tt tla changes --diffs}\hspace*{100em}]- {\tt darcs whatsnew}-\item[{\tt tla logs}\hspace*{100em}]- {\tt darcs changes}-\item[{\tt tla file-diffs}\hspace*{100em}]- {\tt darcs diff -u}-\item[{\tt tla add}\hspace*{100em}]- {\tt darcs add}-\item[{\tt tla mv}\hspace*{100em}]- {\tt darcs move}- (not {\tt tla move})-\item[{\tt tla commit}\hspace*{100em}]- {\tt darcs record}- (if committing locally)-\item[{\tt tla commit}\hspace*{100em}]- {\tt darcs tag}- (if marking a version for later use)-\item[{\tt tla commit}\hspace*{100em}]- {\tt darcs push} or {\tt darcs send}- (if committing remotely)-\item[{\tt tla archive-mirror}\hspace*{100em}]- {\tt darcs pull} or {\tt darcs push}-\item[{\tt tla tag}\hspace*{100em}]- {\tt darcs get}- (if creating a branch)-\item[{\tt tla tag}\hspace*{100em}]- {\tt darcs tag}- (if creating a tag).-\end{description}--\paragraph{Migrating arch repositories to darcs}--Tools and instructions for migrating arch repositories to darcs are provided-on the darcs community website: -\htmladdnormallinkfoot{http://wiki.darcs.net/DarcsWiki/ConvertingFromArch}{http://wiki.darcs.net/DarcsWiki/ConvertingFromArch}-
+ src/test.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE CPP, MultiParamTypeClasses, DeriveDataTypeable #-}+module Main ( main ) where++import qualified Darcs.Test.Misc+import qualified Darcs.Test.Patch+import qualified Darcs.Test.Email++import Control.Monad (when)+import Data.List ( isPrefixOf, isSuffixOf, sort )+import qualified Data.ByteString.Char8 as B+import System.Console.CmdLib+import System.FilePath( takeDirectory, takeBaseName, isAbsolute )+import System.IO( hSetBinaryMode, stdin, stdout, stderr )+import Test.Framework.Providers.API+import Test.Framework+import Shellish hiding ( liftIO, run )+import qualified Shellish++doUnit :: IO [Test]+doUnit = do+ putStr Darcs.Test.Patch.testInfo+ return unitTests++-- | This is the big list of tests that will be run using testrunner.+unitTests :: [Test]+unitTests =+ [ Darcs.Test.Email.testSuite+ , Darcs.Test.Misc.testSuite+ , Darcs.Test.Patch.testSuite+ ]++-- ----------------------------------------------------------------------+-- shell tests+-- ----------------------------------------------------------------------++data Format = Hashed | Darcs2 deriving Show+data Running = Running deriving Show+data Result = Success | Skipped | Failed String++instance Show Result where+ show Success = "Success"+ show Skipped = "Skipped"+ show (Failed f) = unlines (map ("| " ++) $ lines f)++instance TestResultlike Running Result where+ testSucceeded Success = True+ testSucceeded Skipped = True+ testSucceeded _ = False++data ShellTest = ShellTest { format :: Format+ , testfile :: FilePath+ , testdir :: Maybe FilePath -- ^ only if you want to set it explicitly+ , _darcspath :: FilePath+ }++runtest' :: ShellTest -> FilePath -> ShIO Result+runtest' (ShellTest fmt _ _ dp) srcdir =+ do wd <- pwd+ setenv "HOME" wd+ setenv "TESTDATA" (srcdir </> "tests" </> "data")+ setenv "TESTBIN" (srcdir </> "tests" </> "bin")+ setenv "DARCS_TESTING_PREFS_DIR" $ wd </> ".darcs"+ setenv "EMAIL" "tester"+ setenv "DARCS_DONT_COLOR" "1"+ setenv "DARCS_DONT_ESCAPE_ANYTHING" "1"+ getenv "PATH" >>= setenv "PATH" . ((takeDirectory dp ++ ":") ++)+ setenv "DARCS" dp+ mkdir ".darcs"+ writefile ".darcs/defaults" defaults+-- Warning: A do-notation statement discarded a result of type String.+ _ <- Shellish.run "bash" [ "test" ]+ return Success+ `catch_sh` \e -> case e of+ RunFailed _ 200 _ -> return Skipped+ RunFailed _ _ _ -> Failed <$> B.unpack <$> lastOutput+ where defaults = unlines ["ALL " ++ fmtstr, "send no-edit-description", "ALL ignore-times"]+ fmtstr = case fmt of+ Darcs2 -> "darcs-2"+ Hashed -> "hashed"++runtest :: ShellTest -> ShIO Result+runtest t =+ withTmp $ \dir -> do+ cp "tests/lib" dir+ cp ("tests" </> testfile t) (dir </> "test")+ srcdir <- pwd+ silently $ sub $ cd dir >> runtest' t srcdir+ where+ withTmp =+ case testdir t of+ Just dir -> \job -> do+ let d = (dir </> show (format t) </> takeBaseName (testfile t))+ mkdir_p d+ job d+ Nothing -> withTmpDir++instance Testlike Running Result ShellTest where+ testTypeName _ = "Shell"+ runTest _ test = runImprovingIO $ do yieldImprovement Running+ liftIO (shellish $ runtest test)++shellTest :: FilePath -> Format -> Maybe FilePath -> String -> Test+shellTest dp fmt tdir file = Test (file ++ " (" ++ show fmt ++ ")") $ ShellTest fmt file tdir dp++findShell :: FilePath -> Maybe FilePath -> Bool -> ShIO [Test]+findShell dp tdir isFailing =+ do files <- sort <$> grep relevant <$> grep (".sh" `isSuffixOf`) <$> ls "tests"+ return [ shellTest dp fmt tdir file+ | fmt <- [ Darcs2, Hashed ]+ , file <- files ]+ where relevant = (if isFailing then id else not) . ("failing-" `isPrefixOf`)++findNetwork :: FilePath -> Maybe FilePath -> ShIO [Test]+findNetwork dp tdir =+ do files <- sort <$> grep (".sh" `isSuffixOf`) <$> ls "tests/network"+ return [ shellTest dp Darcs2 tdir ("network" </> file) | file <- files ]++-- ----------------------------------------------------------------------+-- harness+-- ----------------------------------------------------------------------++data Config = Config { failing :: Bool+ , shell :: Bool+ , network :: Bool+ , unit :: Bool+ , darcs :: String+ , tests :: [String]+ , testDir :: Maybe FilePath+ , plain :: Bool+ , threads :: Int }+ deriving (Data, Typeable, Eq)++instance Attributes Config where+ attributes _ = group "Options"+ [ failing %> Help "Run the failing (shell) tests."+ , shell %> Help "Run the passing, non-network shell tests." %+ Default True+ , network %> Help "Run the network shell tests."+ , unit %> Help "Run the unit tests." %+ Default True+ , tests %> Help "Pattern to limit the tests to run." %+ short 't'+ , testDir %> Help "Directory to run tests in" %+ Default (Nothing :: Maybe FilePath)+ , plain %> Help "Use plain-text output."+ , threads %> Default (1 :: Int) %+ short 'j' ]++data DarcsTest = DarcsTest deriving Typeable+instance Command DarcsTest (Record Config) where+ run _ conf _ = do+ let args = [ "-j", show $ threads conf ] + ++ concat [ ["-t", x ] | x <- tests conf ]+ ++ [ "--plain" | True <- [plain conf] ]+ ++ [ "--maximum-unsuitable-generated-tests", "700" ]+ case testDir conf of+ Nothing -> return ()+ Just d -> do e <- shellish (test_e d)+ when e $ fail ("Directory " ++ d ++ " already exists. Cowardly exiting")+ when (shell conf || network conf || failing conf) $ do+ when (null $ darcs conf) $+ fail ("No darcs specified. Perhaps --darcs `pwd`/dist/build/darcs/darcs" ++ exeSuffix ++ "?")+ when (not (isAbsolute (darcs conf))) $+ fail ("Argument to --darcs should be an absolute path")+ when (not (exeSuffix `isSuffixOf` darcs conf)) $+ putStrLn $ "Warning: --darcs flag does not end with " ++ exeSuffix ++ " - some tests may fail (case does matter)"+ ftests <- shellish $ if failing conf then findShell (darcs conf) (testDir conf) True else return []+ stests <- shellish $ if shell conf then findShell (darcs conf) (testDir conf) False else return []+ utests <- if unit conf then doUnit else return []+ ntests <- shellish $ if network conf then findNetwork (darcs conf) (testDir conf) else return []+ defaultMainWithArgs (ftests ++ stests ++ utests ++ ntests) args+ where+ exeSuffix :: String+#ifdef WIN32+ exeSuffix = ".exe"+#else+ exeSuffix = ""+#endif++main :: IO ()+main = do hSetBinaryMode stdout True+ hSetBinaryMode stderr True+ hSetBinaryMode stdin True+ getArgs >>= execute DarcsTest
− src/unit.hs
@@ -1,3 +0,0 @@-module Main ( main ) where--import Darcs.Test.Unit ( main )
src/win32/System/Posix.hs view
@@ -1,39 +1,10 @@-{-# OPTIONS_GHC -fglasgow-exts #-} {-# LANGUAGE ForeignFunctionInterface #-} -module System.Posix where--import Foreign.Ptr ( Ptr )-import Foreign.Storable ( peek )-import Foreign.C.Types ( CInt, CUInt, CULong, CTime )-import Foreign.C.String ( CString, withCString )-import Foreign.Marshal.Array ( withArray )-import Foreign.Marshal.Alloc ( alloca )--import System.Posix.Types ( EpochTime )-import System.IO ( Handle )--foreign import ccall "sys/utime.h _utime" c_utime :: CString -> Ptr CTime -> IO CInt--setFileTimes :: FilePath -> EpochTime -> EpochTime -> IO ()-setFileTimes path atime mtime = path `withCString` \s -> do- withArray [atime,mtime] $ \p -> do c_utime s p- return ()---foreign import ccall "time" c_ctime :: Ptr CTime -> IO CInt+module System.Posix ( sleep ) where -epochTime :: IO EpochTime-epochTime = do- alloca $ \p -> do c_ctime p- t <- peek p :: IO CTime- return t+import Foreign.C.Types ( CInt, CUInt, CULong ) foreign import stdcall "winbase.h SleepEx" c_SleepEx :: CULong -> CUInt -> IO CInt sleep :: Integer -> IO CInt sleep n = c_SleepEx (1000 * fromIntegral n) 1--handleToFd :: Handle -> IO Int-handleToFd _ = fail "handleToFd not supported!"-
src/win32/System/Posix/Files.hsc view
@@ -1,8 +1,10 @@-{-# OPTIONS_GHC -cpp #-}+{-# LANGUAGE CPP, ForeignFunctionInterface #-} module System.Posix.Files( isNamedPipe, isDirectory, isRegularFile, isSymbolicLink , getFdStatus, getFileStatus, getSymbolicLinkStatus , modificationTime, setFileMode, fileSize, fileMode- , stdFileMode, linkCount, createLink ) where+ , stdFileMode, linkCount, createLink+ , FileStatus+ ) where import System.PosixCompat.Files( isNamedPipe, isDirectory, isRegularFile, isSymbolicLink , getFdStatus, getFileStatus, getSymbolicLinkStatus@@ -22,5 +24,5 @@ createLink :: FilePath -> FilePath -> IO () createLink old new = withCWString old $ \c_old -> withCWString new $ \c_new ->- throwErrnoPathIf_ (==0) "createLink" new $- c_CreateHardLink c_new c_old nullPtr+ throwErrnoPathIf_ (==0) "createLink" new $+ c_CreateHardLink c_new c_old nullPtr
src/win32/System/Posix/IO.hsc view
@@ -1,3 +1,4 @@+{-# LANGUAGE ForeignFunctionInterface #-} module System.Posix.IO where #if mingw32_HOST_OS && __GLASGOW_HASKELL__ >= 612
− src/witnesses.hs
@@ -1,55 +0,0 @@-import Version-import Preproc-import Darcs.ArgumentDefaults-import Darcs.Patch.Real-import Darcs.Patch.Properties-import Darcs.Patch.Bundle-import Darcs.Patch-import Darcs.Repository.ApplyPatches-import Darcs.Patch.Match-import Darcs.Repository.HashedRepo-import Darcs.Resolution-import Darcs.Test.Patch.Check-import Darcs.Test.Patch.QuickCheck-import Darcs.Repository.Pristine-import Darcs.Repository.DarcsRepo-import Darcs.Repository.Internal-import Darcs.Commands.Add-import Darcs.Commands.Annotate-import Darcs.Commands.AmendRecord-import Darcs.Commands.Apply-import Darcs.Commands.Changes-import Darcs.Commands.Check-import Darcs.Commands.Convert-import Darcs.Commands.Diff-import Darcs.Commands.Dist-import Darcs.Commands.Get-import Darcs.Commands.GZCRCs-import Darcs.Commands.Help-import Darcs.Commands.Init-import Darcs.Commands.MarkConflicts-import Darcs.Commands.Move-import Darcs.Commands.Optimize-import Darcs.Commands.Pull-import Darcs.Commands.Push-import Darcs.Commands.Put-import Darcs.Commands.Record-import Darcs.Commands.Remove-import Darcs.Commands.Repair-import Darcs.Commands.Replace-import Darcs.Commands.Revert-import Darcs.Commands.Rollback-import Darcs.Commands.Send-import Darcs.Commands.SetPref-import Darcs.Commands.Show-import Darcs.Commands.Tag-import Darcs.Commands.TrackDown-import Darcs.Commands.TransferMode-import Darcs.Commands.Unrevert-import Darcs.Commands.Unrecord-import Darcs.Commands.WhatsNew--import Darcs.RunCommand-import Darcs.TheCommands--main = return ()
tests/EXAMPLE.sh view
@@ -25,7 +25,6 @@ ## SOFTWARE. . lib # Load some portability helpers.-rm -rf R S # Another script may have left a mess. darcs init --repo R # Create our test repos. darcs init --repo S
tests/README.test_maintainers.txt view
@@ -18,7 +18,7 @@ hierarchy. They are called from src/unit.lhs using the test-framework package from Hackage. -More about the Haskell tests can be found on http://wiki.darcs.net/UnitTests.+More about the Haskell tests can be found on http://wiki.darcs.net/Development/UnitTests. Shell tests ---------------------------@@ -67,7 +67,8 @@ Tips for writing tests ---------------------- -- Copy an existing test, which will already have the following properties:+- Copy EXAMPLE.sh as a template to start from (don't forget to customise+ the headers!). - Simply call darcs using "darcs" as you would in the shell. It is the responsibility of the test harness to ensure that the darcs we are@@ -98,3 +99,14 @@ your shell script. lib provides 'set -ev', a common definition of 'not', and 'abort_windows' for use in scripts which shouldn't run under Windows. You don't have to use lib if you don't want to, or if it causes problems.++- If you need to skip a test for any reason, the darcs-specific+ convention is to "exit 200". This alerts the shell harness that the+ test was explicitly skipped and not passed.++- You can use the trap feature from bash to make ensure that darcs executes+ some command even if the test fails. Trapping ERR lets you have your+ last word just before a test fails. Trapping EXIT lets you do the+ same before any sort of explicit exit (such as the explicit 'exit 1'+ in the 'not' helper function). For more details, see the bash man+ page or just grep trap in the test suite.
tests/annotate.sh view
@@ -1,19 +1,16 @@ #!/usr/bin/env bash-set -ev+. lib -rm -rf temp-mkdir temp-cd temp darcs init mkdir a b touch a/a b/b darcs add --rec . darcs record -a -m ab -A test darcs annotate a/a-# annotate --xml should encode angle brackets in user name-touch c+echo x > c darcs add c darcs record -a -m foo -A 'Mark Stosberg <a@b.com>'-darcs annotate --xml c | grep "<a\@b.com>"+darcs annotate c+darcs annotate c | grep "a@b.com" cd .. rm -rf temp
tests/bad-format.sh view
@@ -3,14 +3,11 @@ . lib rm -rf temp1 temp2-mkdir temp1-cd temp1-darcs initialize --old-fashioned-echo A > foo-darcs add foo-darcs record -a -m AA -A x-echo '<UGLY HTML-LIKE GARBAGE RETURNED BY BAD HTTP SERVER>' > _darcs/format-cd ..++gunzip -c $TESTDATA/many-files--old-fashioned-inventory.tgz | tar xf -+mv many-files--old-fashioned-inventory temp1++echo '<UGLY HTML-LIKE GARBAGE RETURNED BY BAD HTTP SERVER>' > temp1/_darcs/format # ensure that we successfully get repositories even if they have a bogus # format file, as can happen if no _darcs/format is present (i.e. it's
tests/bad_pending_after_pull.sh view
@@ -12,11 +12,11 @@ darcs add A echo def > B1 darcs add B1-# darcs record -all --patch-name patch1 # this way it doesn't trigger the bug-for i in 1 2 3 4 5 6 7 8 9 11; do echo y; done | darcs record --patch-name patch1+# darcs record -all --name patch1 # this way it doesn't trigger the bug+for i in 1 2 3 4 5 6 7 8 9 11; do echo y; done | darcs record --name patch1 darcs mv B1 B2-darcs record --all --patch-name patch2+darcs record --all --name patch2 cd .. mkdir temp2
+ tests/bin/hspwd.hi view
binary file changed (absent → 772 bytes)
+ tests/bin/hspwd.hs view
@@ -0,0 +1,5 @@+module Main where++import Directory ( getCurrentDirectory )++main = getCurrentDirectory >>= putStr
+ tests/bin/hspwd.o view
binary file changed (absent → 3424 bytes)
+ tests/bin/trackdown-bisect-helper.hi view
binary file changed (absent → 1408 bytes)
+ tests/bin/trackdown-bisect-helper.hs view
@@ -0,0 +1,38 @@+{-++Tool for construction of testing repository for trackdown testing+with bisect option. Written by Matthias Fischmann.++Usage:++./trackdown-bisect-helper '[0,1,1,1,0,0,0]'++This will generate a repository in which `grep -q 1 j` will first fail+three times, then succeed three times, then fail once if you unapply+patches with the linear implementation.++-}+++import Control.Monad+import System.IO+import System+import System.Random+import Data.List+import Control.Exception+++stamp i j = system ("echo " ++ show i ++ " > ./i") >>+ system ("echo " ++ show j ++ " > ./j") >>+ -- system ("sleep 1") >>+ hFlush stdout >>+ system ("darcs record --ignore-times -am '" ++ show i ++ "'")++generate :: [Int] -> IO ()+generate = mapM_ (uncurry stamp) . zip [1..]++main :: IO ()+main = do+ args <- getArgs+ let js = (read (head args)) :: [Int]+ generate js
+ tests/bin/trackdown-bisect-helper.o view
binary file changed (absent → 15808 bytes)
tests/binary.sh view
@@ -8,7 +8,7 @@ mkdir temp1 temp2 cd temp1 darcs init-cp ../$binary .+cp $TESTDATA/$binary . darcs add $binary darcs record -am P1 cd ../temp2
tests/changes_with_move.sh view
@@ -4,10 +4,6 @@ . lib -rm -rf temp1--mkdir temp1-cd temp1 darcs init date > foo darcs add foo@@ -32,9 +28,7 @@ echo 'That has such people in it' > directory/foo darcs add directory/foo darcs record -m 'mv foo then add new foo' -a-darcs annotate directory/bar > log-grep 'How beauteous mankind is' log+darcs annotate directory/bar | tee log grep 'O brave new world' log-cd ..--rm -rf temp1+grep "mv foo then add new foo" log+not grep "unknown" log
− tests/checkpoint.sh
@@ -1,45 +0,0 @@-#!/usr/bin/env bash--# A test for unrecording checkpoint tags, inspired by issue517--exit 200 # checkpoint creation is not supported by current darcs- # we would need a testdata tarball for this test--set -ev--darcs --version--rm -rf temp temp1 temp2-mkdir temp--# This the last commands would blow up if the "--darcs-2" format wasn't used.-darcs init --darcs-2 --repodir temp-touch temp/x-darcs rec -lam xx --repodir temp-darcs tag -m yy --repodir temp-touch temp/z-darcs rec -lam zz --repodir temp-darcs optimize --checkpoint --repodir temp-darcs get --partial temp temp1-echo 'y' | darcs unrec -p TAG --repodir temp1--# Now, the real tests. Do they return sensible results? -darcs get --partial temp1 temp2;-echo 'n' | darcs unrec --repodir temp1 -p 'zz'--rm -rf temp temp1 temp2;-darcs init --darcs-2 --repodir temp-touch temp/x-darcs rec -lam xx --repodir temp-darcs tag -m yy --repodir temp-touch temp/z-darcs rec -lam zz --repodir temp-darcs optimize --checkpoint --repodir temp-darcs get --partial temp temp1-echo 'y' | darcs unrec -p TAG --repodir temp1--# Now, the real tests. Do they return sensible results? -darcs get --partial temp1 temp2;-echo 'n' | darcs unrec --repodir temp1 -p 'zz'--rm -rf temp temp1 temp2;
tests/conflict-doppleganger.sh view
@@ -7,45 +7,21 @@ # For Zooko, with love # Also, for issue81. -rm -rf temp-mkdir temp-cd temp--# check that dopplegangers conflict in --old-fashioned-rm -rf tmp_dopple tmp_ganger-mkdir tmp_dopple-cd tmp_dopple-darcs init --old-fashioned--darcs show repo | grep darcs-1.0-touch a.txt-darcs add a.txt-darcs record -A base -am 'adding a.txt'-cd ..--darcs get tmp_dopple tmp_ganger--for repo in tmp_dopple tmp_ganger; do- echo working on $repo- cd $repo- echo "text which appears in both places at once" > a.txt- darcs record -A $repo -am "recording an identical change in $repo"- cd ..-done--# Now that the conflict has been set up, try pull one patch from the other.-cd tmp_ganger-darcs pull -a ../tmp_dopple > out+check_conflict() { cat out-grep 'conflict' out+if test "$format" = darcs-2; then+ not grep 'conflict' out+else+ grep 'conflict' out+fi+} -# check that dopplegangers conflict in --hashed+# check doppleganger conflicts rm -rf tmp_dopple tmp_ganger mkdir tmp_dopple cd tmp_dopple-darcs init --hashed+darcs init -darcs show repo | grep hashed touch a.txt darcs add a.txt darcs record -A base -am 'adding a.txt'@@ -64,134 +40,20 @@ # Now that the conflict has been set up, try pull one patch from the other. cd tmp_ganger darcs pull -a ../tmp_dopple > out-cat out-grep 'conflict' out-cd ..--# check that dopplegangers do not conflict in --darcs-2-rm -rf tmp_dopple tmp_ganger-mkdir tmp_dopple-cd tmp_dopple-darcs init --darcs-2--darcs show repo | grep darcs-2-touch a.txt-darcs add a.txt-darcs record -A base -am 'adding a.txt'-cd ..--darcs get tmp_dopple tmp_ganger--for repo in tmp_dopple tmp_ganger; do- echo working on $repo- cd $repo- echo "text which appears in both places at once" > a.txt- darcs record -A $repo -am "recording an identical change in $repo"- cd ..-done--# Now that the conflict has been set up, try pull one patch from the other.-cd tmp_ganger-darcs pull -a ../tmp_dopple > out-cat out-not grep 'conflict' out-cd ..--# Checking that resolution dopplegangers conflict in --old-fashioned-inventory-rm -rf temp0 temp1 temp2 tmp_dopple tmp_ganger-mkdir temp0-cd temp0-darcs init --old-fashioned-inventory-darcs show repo | grep darcs-1.0-cd ..--# Create a conflict-darcs get --old-fashioned-inventory temp0 temp1-cd temp1-darcs show repo-darcs show repo | grep darcs-1.0-echo temp1 > a.txt-darcs add a.txt-darcs record -A base -am 'adding temp1 a.txt'-cd ..-darcs get temp0 temp2-cd temp2-echo temp2 > a.txt-darcs add a.txt-darcs record -A base -am 'adding temp2 a.txt'-cd ..--# Resolve the conflict the same way on both sides-for repo in tmp_dopple tmp_ganger; do- echo working on $repo- darcs get temp1 $repo- cd $repo- darcs pull -a ../temp2- echo "text which appears in both places at once" > a.txt- darcs record -A $repo -am "recording an identical change in $repo"- cd ..-done--# Now that the conflict has been set up, try pull one patch from the other.-cd tmp_ganger-darcs pull -a ../tmp_dopple > out-cat out-grep conflict out-cd ..--# Checking that resolution dopplegangers conflict in --hashed-rm -rf temp0 temp1 temp2 tmp_dopple tmp_ganger-mkdir temp0-cd temp0-darcs init --hashed-darcs show repo | grep hashed-cd ..--# Create a conflict-darcs get temp0 temp1-cd temp1-echo temp1 > a.txt-darcs add a.txt-darcs record -A base -am 'adding temp1 a.txt'-cd ..-darcs get temp0 temp2-cd temp2-echo temp2 > a.txt-darcs add a.txt-darcs record -A base -am 'adding temp2 a.txt'-cd ..--# Resolve the conflict the same way on both sides-for repo in tmp_dopple tmp_ganger; do- echo working on $repo- darcs get temp1 $repo- cd $repo- darcs pull -a ../temp2- echo "text which appears in both places at once" > a.txt- darcs record -A $repo -am "recording an identical change in $repo"- cd ..-done--# Now that the conflict has been set up, try pull one patch from the other.-cd tmp_ganger-darcs pull -a ../tmp_dopple > out-cat out-grep conflict out+check_conflict cd .. --# Checking that resolution dopplegangers do not conflict in --darcs-2+# Checking resolution dopplegangers conflicts rm -rf temp0 temp1 temp2 tmp_dopple tmp_ganger mkdir temp0 cd temp0-darcs init --darcs-2-darcs show repo | grep darcs-2+darcs init cd .. # Create a conflict darcs get temp0 temp1 cd temp1-darcs show repo | grep darcs-2+darcs show repo echo temp1 > a.txt darcs add a.txt darcs record -A base -am 'adding temp1 a.txt'@@ -217,9 +79,4 @@ # Now that the conflict has been set up, try pull one patch from the other. cd tmp_ganger darcs pull -a ../tmp_dopple > out-cat out-not grep conflict out-cd ..--cd ..-rm -rf temp+check_conflict
+ tests/convert.sh view
@@ -0,0 +1,60 @@+#!/usr/bin/env bash++## Tests for convert command based on previously checked results+## to generate new test material for this test,+## see bin/convert-writer.sh+##+## Copyright (C) 2009 Ganesh Sittampalam+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib++grep old-fashioned $HOME/.darcs/defaults || grep hashed $HOME/.darcs/defaults || exit 200++runtest() {+ rm -rf temp+ mkdir temp+ cd temp++ mkdir repo+ cd repo+ darcs init+ darcs apply --allow-conflicts $TESTDATA/convert/darcs1/$1.dpatch+ cd ..+ echo 'I understand the consequences of my action' | darcs convert repo repo2+ mkdir empty-darcs2+ cd empty-darcs2+ darcs init --darcs-2+ cd ..+ cd repo2+ darcs send -a -o ../$1-darcs2.dpatch ../empty-darcs2+ cd ..+ diff -I'1 patch for repository ' -I'patches for repository ' -I'Oct 1' -u $TESTDATA/convert/darcs2/$1.dpatch $1-darcs2.dpatch+}++runtest simple+runtest twowayconflict+runtest threewayconflict+runtest threewayanddep+runtest threewayandmultideps+runtest resolution+runtest tworesolutions
+ tests/data/README view
@@ -0,0 +1,4 @@++Larger or more complex pre-built repos are stored here for testing. They are+stored as archives for space efficiency, and to emphasize that they are meant+to be read-only.
+ tests/data/badrepo.tgz view
binary file changed (absent → 3537 bytes)
+ tests/data/braced.dpatch view
@@ -0,0 +1,25 @@+1 patch for repository /home/ganesh/temp/empty:++Mon Oct 18 18:27:21 BST 2010 Ganesh Sittampalam <ganesh@earth.li>+ * foo++New patches:++[foo+Ganesh Sittampalam <ganesh@earth.li>**20101018172721+ Ignore-this: 5e9ee20eb359c030581f54a73186405c+] {+addfile ./wibble+hunk ./wibble 1++wibble+{+addfile ./wobble+hunk ./wobble 1++wobble+}+}++Context:++Patch bundle hash:+f427e3af1c3f5486cf570a5c7bdb826a0a2eb3f8
+ tests/data/braced.tgz view
binary file changed (absent → 3311 bytes)
+ tests/data/context-v1.dpatch view
@@ -0,0 +1,48 @@+2 patches for repository /home/ganesh/darcs-comp/temp/empty:++Thu Oct 21 18:28:18 BST 2010 Ganesh Sittampalam <ganesh@earth.li>+ * init++Thu Oct 21 18:28:31 BST 2010 Ganesh Sittampalam <ganesh@earth.li>+ * ABC++New patches:++[init+Ganesh Sittampalam <ganesh@earth.li>**20101021172818+ Ignore-this: 6a770d5966ed23f56e94c08977507388+] {+addfile ./wibble+hunk ./wibble 1++1++2++3++4++5++6++7++8++9++10+}+[ABC+Ganesh Sittampalam <ganesh@earth.li>**20101021172831+ Ignore-this: 157403967fc6753e0f2540535937da5b+] hunk ./wibble 4+ 1+ 2+ 3+-4+-5+-6++4A++5B++6C+ 7+ 8+ 9++Context:++Patch bundle hash:+0a20411489222e188722666cf0db4c5de2539aee
+ tests/data/context-v1.tgz view
binary file changed (absent → 4166 bytes)
+ tests/data/context-v2.dpatch view
@@ -0,0 +1,46 @@+2 patches for repository /home/ganesh/darcs-comp/temp/empty:++Thu Oct 21 18:28:18 BST 2010 Ganesh Sittampalam <ganesh@earth.li>+ * init++Thu Oct 21 18:28:31 BST 2010 Ganesh Sittampalam <ganesh@earth.li>+ * ABC++New patches:++[init+Ganesh Sittampalam <ganesh@earth.li>**20101021172818+ Ignore-this: 6a770d5966ed23f56e94c08977507388+] addfile ./wibble+hunk ./wibble 1++1++2++3++4++5++6++7++8++9++10+[ABC+Ganesh Sittampalam <ganesh@earth.li>**20101021172831+ Ignore-this: 157403967fc6753e0f2540535937da5b+] hunk ./wibble 4+ 1+ 2+ 3+-4+-5+-6++4A++5B++6C+ 7+ 8+ 9++Context:++Patch bundle hash:+846f06469d8639ad0762c33e2030e5c24ebb1832
+ tests/data/context-v2.tgz view
binary file changed (absent → 3226 bytes)
+ tests/data/convert/darcs1/resolution.dpatch view
@@ -0,0 +1,74 @@+5 patches for repository /tmp/tmp6648/temp/empty-hashed:++Sat Oct 16 23:32:07 BST 2010 tester+ * wibble++Sat Oct 16 23:32:07 BST 2010 tester+ * A++Sat Oct 16 23:32:07 BST 2010 tester+ * B++Sat Oct 16 23:32:07 BST 2010 tester+ * AB++Sat Oct 16 23:32:07 BST 2010 tester+ * C++New patches:++[wibble+tester**20101016223207+ Ignore-this: 64b5a1e603ddf61e59421bdde45b3bc+] {+addfile ./wibble+hunk ./wibble 1++wibble+}+[A+tester**20101016223207+ Ignore-this: bc0d30ac5170e1a25ccb20e6cb06ac86+] hunk ./wibble 2+ wibble++A+[B+tester**20101016223207+ Ignore-this: 3bbebcf8fa444bdcb31ab799c6754067+] merger 0.0 (+hunk ./wibble 2++A+hunk ./wibble 2++B+)+[AB+tester**20101016223207+ Ignore-this: 8fa03d26b9dbbcdb50a323e5c58b16dd+] hunk ./wibble 2+ wibble++AB+[C+tester**20101016223207+ Ignore-this: e7c0716361e411645066f8a3c2eff769+] merger 0.0 (+hunk ./wibble 2++AB+merger 0.0 (+merger 0.0 (+hunk ./wibble 2++A+hunk ./wibble 2++B+)+merger 0.0 (+hunk ./wibble 2++A+hunk ./wibble 2++C+)+)+)++Context:++Patch bundle hash:+b23d175b10d6fdaee3bb25ac92b55723de2822cd
+ tests/data/convert/darcs1/simple.dpatch view
@@ -0,0 +1,20 @@+1 patch for repository /tmp/tmp5746/temp/empty-hashed:++Sat Oct 16 23:28:30 BST 2010 tester+ * wibble++New patches:++[wibble+tester**20101016222830+ Ignore-this: f155bc27211e0233c23b8c0a757b8071+] {+addfile ./wibble+hunk ./wibble 1++wibble+}++Context:++Patch bundle hash:+1bfa82f0941e1dcc13f9f94179dd6a7426ca0b6f
+ tests/data/convert/darcs1/threewayanddep.dpatch view
@@ -0,0 +1,83 @@+5 patches for repository /tmp/tmp5530/temp/empty-hashed:++Sat Oct 16 23:27:54 BST 2010 tester+ * wibble++Sat Oct 16 23:27:54 BST 2010 tester+ * A1++Sat Oct 16 23:27:54 BST 2010 tester+ * A2++Sat Oct 16 23:27:54 BST 2010 tester+ * B++Sat Oct 16 23:27:54 BST 2010 tester+ * C++New patches:++[wibble+tester**20101016222754+ Ignore-this: 355914edd0f88f0ea7c2ef60aec9c2a1+] {+addfile ./wibble+hunk ./wibble 1++wibble+}+[A1+tester**20101016222754+ Ignore-this: 54df34ebd488b772c37c3d43a38b0bfa+] hunk ./wibble 2+ wibble++A1+[A2+tester**20101016222754+ Ignore-this: 4d1b08c7274743e7d0d2f210518d5a19+] hunk ./wibble 3+ wibble+ A1++A2+[B+tester**20101016222754+ Ignore-this: 9ba51da6bb1506afa2104326cd5df54b+] merger 0.0 (+hunk ./wibble 3++A2+merger 0.0 (+hunk ./wibble 2++A1+hunk ./wibble 2++B+)+)+[C+tester**20101016222754+ Ignore-this: 295e8a851b7a936b3d08b0ce7eaaf2ac+] merger 0.0 (+merger 0.0 (+hunk ./wibble 3++A2+merger 0.0 (+hunk ./wibble 2++A1+hunk ./wibble 2++B+)+)+merger 0.0 (+hunk ./wibble 3++A2+merger 0.0 (+hunk ./wibble 2++A1+hunk ./wibble 2++C+)+)+)++Context:++Patch bundle hash:+3c77da1c02a49215134a9607493af93d55608f56
+ tests/data/convert/darcs1/threewayandmultideps.dpatch view
@@ -0,0 +1,235 @@+7 patches for repository /tmp/tmp5411/temp/empty-hashed:++Sat Oct 16 23:27:21 BST 2010 tester+ * wibble++Sat Oct 16 23:27:21 BST 2010 tester+ * A1++Sat Oct 16 23:27:21 BST 2010 tester+ * A2++Sat Oct 16 23:27:21 BST 2010 tester+ * B1++Sat Oct 16 23:27:21 BST 2010 tester+ * B2++Sat Oct 16 23:27:21 BST 2010 tester+ * C1++Sat Oct 16 23:27:21 BST 2010 tester+ * C2++New patches:++[wibble+tester**20101016222721+ Ignore-this: 64432ba123d81c8f0e688b44feb8f587+] {+addfile ./wibble+hunk ./wibble 1++wibble+}+[A1+tester**20101016222721+ Ignore-this: d749f48333e6ff2e994b1df71e76933b+] hunk ./wibble 2+ wibble++A1+[A2+tester**20101016222721+ Ignore-this: 6f006a52975a708a8038d52e5e39ef0f+] hunk ./wibble 3+ wibble+ A1++A2+[B1+tester**20101016222721+ Ignore-this: f4d4b5b1c73bd6fa8abe6e5e680d66a7+] merger 0.0 (+hunk ./wibble 3++A2+merger 0.0 (+hunk ./wibble 2++A1+hunk ./wibble 2++B1+)+)+[B2+tester**20101016222721+ Ignore-this: 1d60b6c0ba913fff4d1e32ad26ae07bb+] merger 0.0 (+merger 0.0 (+merger 0.0 (+hunk ./wibble 2++A1+hunk ./wibble 2++B1+)+hunk ./wibble 3++A2+)+merger 0.0 (+merger 0.0 (+hunk ./wibble 2++B1+hunk ./wibble 2++A1+)+hunk ./wibble 3++B2+)+)+[C1+tester**20101016222721+ Ignore-this: 25b6a6959d19980ad16983a542c6825+] merger 0.0 (+merger 0.0 (+merger 0.0 (+merger 0.0 (+hunk ./wibble 2++A1+hunk ./wibble 2++B1+)+hunk ./wibble 3++A2+)+merger 0.0 (+merger 0.0 (+hunk ./wibble 2++B1+hunk ./wibble 2++A1+)+hunk ./wibble 3++B2+)+)+merger 0.0 (+merger 0.0 (+hunk ./wibble 3++A2+merger 0.0 (+hunk ./wibble 2++A1+hunk ./wibble 2++B1+)+)+merger 0.0 (+hunk ./wibble 3++A2+merger 0.0 (+hunk ./wibble 2++A1+hunk ./wibble 2++C1+)+)+)+)+[C2+tester**20101016222721+ Ignore-this: c16d607216c36d5f7727c64d2ec103d4+] merger 0.0 (+merger 0.0 (+merger 0.0 (+merger 0.0 (+hunk ./wibble 3++A2+merger 0.0 (+hunk ./wibble 2++A1+hunk ./wibble 2++B1+)+)+merger 0.0 (+hunk ./wibble 3++A2+merger 0.0 (+hunk ./wibble 2++A1+hunk ./wibble 2++C1+)+)+)+merger 0.0 (+merger 0.0 (+merger 0.0 (+hunk ./wibble 2++A1+hunk ./wibble 2++B1+)+hunk ./wibble 3++A2+)+merger 0.0 (+merger 0.0 (+hunk ./wibble 2++B1+hunk ./wibble 2++A1+)+hunk ./wibble 3++B2+)+)+)+merger 0.0 (+merger 0.0 (+merger 0.0 (+hunk ./wibble 3++A2+merger 0.0 (+hunk ./wibble 2++A1+hunk ./wibble 2++C1+)+)+merger 0.0 (+hunk ./wibble 3++A2+merger 0.0 (+hunk ./wibble 2++A1+hunk ./wibble 2++B1+)+)+)+merger 0.0 (+merger 0.0 (+merger 0.0 (+hunk ./wibble 2++A1+hunk ./wibble 2++C1+)+hunk ./wibble 3++A2+)+merger 0.0 (+merger 0.0 (+hunk ./wibble 2++C1+hunk ./wibble 2++A1+)+hunk ./wibble 3++C2+)+)+)+)++Context:++Patch bundle hash:+1069761dac242f9583871b27db2fabbd00d6f805
+ tests/data/convert/darcs1/threewayconflict.dpatch view
@@ -0,0 +1,61 @@+4 patches for repository /tmp/tmp5605/temp/empty-hashed:++Sat Oct 16 23:28:14 BST 2010 tester+ * wibble++Sat Oct 16 23:28:14 BST 2010 tester+ * A++Sat Oct 16 23:28:14 BST 2010 tester+ * B++Sat Oct 16 23:28:14 BST 2010 tester+ * C++New patches:++[wibble+tester**20101016222814+ Ignore-this: c125275c671c210086eccb12de9f6c1c+] {+addfile ./wibble+hunk ./wibble 1++wibble+}+[A+tester**20101016222814+ Ignore-this: 653be63c1f8a6f4bc1de1e45c0ae9084+] hunk ./wibble 2+ wibble++A+[B+tester**20101016222814+ Ignore-this: 1a8e3f57d2baeca09f2dda003e4df58d+] merger 0.0 (+hunk ./wibble 2++A+hunk ./wibble 2++B+)+[C+tester**20101016222814+ Ignore-this: 9d40b33ef1b73b9a950f39c4e8a75dfe+] merger 0.0 (+merger 0.0 (+hunk ./wibble 2++A+hunk ./wibble 2++B+)+merger 0.0 (+hunk ./wibble 2++A+hunk ./wibble 2++C+)+)++Context:++Patch bundle hash:+c189b5635aed28be92cfbcf0de65c0f40c79da7a
+ tests/data/convert/darcs1/tworesolutions.dpatch view
@@ -0,0 +1,131 @@+7 patches for repository /tmp/tmp6805/temp/empty-hashed:++Sat Oct 16 23:34:33 BST 2010 tester+ * wibble++Sat Oct 16 23:34:33 BST 2010 tester+ * A++Sat Oct 16 23:34:33 BST 2010 tester+ * B++Sat Oct 16 23:34:33 BST 2010 tester+ * AB++Sat Oct 16 23:34:33 BST 2010 tester+ * C++Sat Oct 16 23:34:33 BST 2010 tester+ * ABC++Sat Oct 16 23:34:33 BST 2010 tester+ * D++New patches:++[wibble+tester**20101016223433+ Ignore-this: 577185c51e4839dd1041372fbfa8515b+] {+addfile ./wibble+hunk ./wibble 1++wibble+}+[A+tester**20101016223433+ Ignore-this: 580c4417986d5c56590bf36f5a125f38+] hunk ./wibble 2+ wibble++A+[B+tester**20101016223433+ Ignore-this: a9f2335fe2dc972fd0bc09edc6252256+] merger 0.0 (+hunk ./wibble 2++A+hunk ./wibble 2++B+)+[AB+tester**20101016223433+ Ignore-this: cba095e78e2bdfe15dbdf2cb5c69cc6d+] hunk ./wibble 2+ wibble++AB+[C+tester**20101016223433+ Ignore-this: da2a7e05abed8dba0077e69e55bd926+] merger 0.0 (+hunk ./wibble 2++AB+merger 0.0 (+merger 0.0 (+hunk ./wibble 2++A+hunk ./wibble 2++B+)+merger 0.0 (+hunk ./wibble 2++A+hunk ./wibble 2++C+)+)+)+[ABC+tester**20101016223433+ Ignore-this: db94de3935df87d0a991c0ab6a58e5b1+] hunk ./wibble 2+ wibble++ABC+[D+tester**20101016223433+ Ignore-this: 829adb4326b290aa6f741b3a15fbabfc+] merger 0.0 (+hunk ./wibble 2++ABC+merger 0.0 (+merger 0.0 (+hunk ./wibble 2++AB+merger 0.0 (+merger 0.0 (+hunk ./wibble 2++A+hunk ./wibble 2++B+)+merger 0.0 (+hunk ./wibble 2++A+hunk ./wibble 2++C+)+)+)+merger 0.0 (+hunk ./wibble 2++AB+merger 0.0 (+merger 0.0 (+hunk ./wibble 2++A+hunk ./wibble 2++B+)+merger 0.0 (+hunk ./wibble 2++A+hunk ./wibble 2++D+)+)+)+)+)++Context:++Patch bundle hash:+5fc1d0ff89472d10a0b19ae4f7849b1b99d500b4
+ tests/data/convert/darcs1/twowayconflict.dpatch view
@@ -0,0 +1,41 @@+3 patches for repository /tmp/tmp5677/temp/empty-hashed:++Sat Oct 16 23:28:22 BST 2010 tester+ * wibble++Sat Oct 16 23:28:22 BST 2010 tester+ * A++Sat Oct 16 23:28:22 BST 2010 tester+ * B++New patches:++[wibble+tester**20101016222822+ Ignore-this: 88662d08dd524d92ad4cca6df0d643e4+] {+addfile ./wibble+hunk ./wibble 1++wibble+}+[A+tester**20101016222822+ Ignore-this: 2d69de402438481946682efcad5e20cd+] hunk ./wibble 2+ wibble++A+[B+tester**20101016222822+ Ignore-this: 9c8daaedcb674c022ddbcef19752d694+] merger 0.0 (+hunk ./wibble 2++A+hunk ./wibble 2++B+)++Context:++Patch bundle hash:+1e2ce71b56e4666c1b086b09ae351a6c3c768b8c
+ tests/data/convert/darcs2/resolution.dpatch view
@@ -0,0 +1,62 @@+5 patches for repository /tmp/tmp6648/temp/empty-darcs2:++Sat Oct 16 23:32:07 BST 2010 tester+ * wibble++Sat Oct 16 23:32:07 BST 2010 tester+ * A++Sat Oct 16 23:32:07 BST 2010 tester+ * B++Sat Oct 16 23:32:07 BST 2010 tester+ * AB++Sat Oct 16 23:32:07 BST 2010 tester+ * C++New patches:++[wibble+tester**20101016223207+ Ignore-this: 64b5a1e603ddf61e59421bdde45b3bc+] addfile ./wibble+hunk ./wibble 1++wibble+[A+tester**20101016223207+ Ignore-this: bc0d30ac5170e1a25ccb20e6cb06ac86+] hunk ./wibble 2+ wibble++A+[B+tester**20101016223207+ Ignore-this: 3bbebcf8fa444bdcb31ab799c6754067+] conflictor [+hunk ./wibble 2++A+]+:+hunk ./wibble 2++B+[AB+tester**20101016223207+ Ignore-this: 8fa03d26b9dbbcdb50a323e5c58b16dd+] hunk ./wibble 2+ wibble++AB+[C+tester**20101016223207+ Ignore-this: e7c0716361e411645066f8a3c2eff769+] conflictor [+hunk ./wibble 2++AB+]+:+hunk ./wibble 2++C++Context:++Patch bundle hash:+cc43b921f6010f451b2dbe275b7fcd04c3862335
+ tests/data/convert/darcs2/simple.dpatch view
@@ -0,0 +1,18 @@+1 patch for repository /tmp/tmp5746/temp/empty-darcs2:++Sat Oct 16 23:28:30 BST 2010 tester+ * wibble++New patches:++[wibble+tester**20101016222830+ Ignore-this: f155bc27211e0233c23b8c0a757b8071+] addfile ./wibble+hunk ./wibble 1++wibble++Context:++Patch bundle hash:+75ced55c52362a8b2ff171b48751d19000fe1790
+ tests/data/convert/darcs2/threewayanddep.dpatch view
@@ -0,0 +1,69 @@+5 patches for repository /tmp/tmp5530/temp/empty-darcs2:++Sat Oct 16 23:27:54 BST 2010 tester+ * wibble++Sat Oct 16 23:27:54 BST 2010 tester+ * A1++Sat Oct 16 23:27:54 BST 2010 tester+ * A2++Sat Oct 16 23:27:54 BST 2010 tester+ * B++Sat Oct 16 23:27:54 BST 2010 tester+ * C++New patches:++[wibble+tester**20101016222754+ Ignore-this: 355914edd0f88f0ea7c2ef60aec9c2a1+] addfile ./wibble+hunk ./wibble 1++wibble+[A1+tester**20101016222754+ Ignore-this: 54df34ebd488b772c37c3d43a38b0bfa+] hunk ./wibble 2+ wibble++A1+[A2+tester**20101016222754+ Ignore-this: 4d1b08c7274743e7d0d2f210518d5a19+] hunk ./wibble 3+ wibble+ A1++A2+[B+tester**20101016222754+ Ignore-this: 9ba51da6bb1506afa2104326cd5df54b+] conflictor [+hunk ./wibble 2++A1++A2+]+:+hunk ./wibble 2++B+[C+tester**20101016222754+ Ignore-this: 295e8a851b7a936b3d08b0ce7eaaf2ac+] conflictor {{+:+hunk ./wibble 2++A1++A2+:+hunk ./wibble 2++B+}} []+:+hunk ./wibble 2++C++Context:++Patch bundle hash:+f9974a2fdbdea580b1be0eaba951e6285f9bfb5d
+ tests/data/convert/darcs2/threewayandmultideps.dpatch view
@@ -0,0 +1,97 @@+7 patches for repository /tmp/tmp5411/temp/empty-darcs2:++Sat Oct 16 23:27:21 BST 2010 tester+ * wibble++Sat Oct 16 23:27:21 BST 2010 tester+ * A1++Sat Oct 16 23:27:21 BST 2010 tester+ * A2++Sat Oct 16 23:27:21 BST 2010 tester+ * B1++Sat Oct 16 23:27:21 BST 2010 tester+ * B2++Sat Oct 16 23:27:21 BST 2010 tester+ * C1++Sat Oct 16 23:27:21 BST 2010 tester+ * C2++New patches:++[wibble+tester**20101016222721+ Ignore-this: 64432ba123d81c8f0e688b44feb8f587+] addfile ./wibble+hunk ./wibble 1++wibble+[A1+tester**20101016222721+ Ignore-this: d749f48333e6ff2e994b1df71e76933b+] hunk ./wibble 2+ wibble++A1+[A2+tester**20101016222721+ Ignore-this: 6f006a52975a708a8038d52e5e39ef0f+] hunk ./wibble 3+ wibble+ A1++A2+[B1+tester**20101016222721+ Ignore-this: f4d4b5b1c73bd6fa8abe6e5e680d66a7+] conflictor [+hunk ./wibble 2++A1++A2+]+:+hunk ./wibble 2++B1+[B2+tester**20101016222721+ Ignore-this: 1d60b6c0ba913fff4d1e32ad26ae07bb+] +[C1+tester**20101016222721+ Ignore-this: 25b6a6959d19980ad16983a542c6825+] conflictor {{+:+hunk ./wibble 2++A1++A2+:+hunk ./wibble 2++B1++B2+}} []+:+hunk ./wibble 2++C1+[C2+tester**20101016222721+ Ignore-this: c16d607216c36d5f7727c64d2ec103d4+] conflictor {{+:+hunk ./wibble 2++A1++A2+:+hunk ./wibble 2++B1++B2+}} []+:+hunk ./wibble 2++C1++C2++Context:++Patch bundle hash:+7f2bd6324e6e1f2d4efe67f98696ca0ead048fe5
+ tests/data/convert/darcs2/threewayconflict.dpatch view
@@ -0,0 +1,57 @@+4 patches for repository /tmp/tmp5605/temp/empty-darcs2:++Sat Oct 16 23:28:14 BST 2010 tester+ * wibble++Sat Oct 16 23:28:14 BST 2010 tester+ * A++Sat Oct 16 23:28:14 BST 2010 tester+ * B++Sat Oct 16 23:28:14 BST 2010 tester+ * C++New patches:++[wibble+tester**20101016222814+ Ignore-this: c125275c671c210086eccb12de9f6c1c+] addfile ./wibble+hunk ./wibble 1++wibble+[A+tester**20101016222814+ Ignore-this: 653be63c1f8a6f4bc1de1e45c0ae9084+] hunk ./wibble 2+ wibble++A+[B+tester**20101016222814+ Ignore-this: 1a8e3f57d2baeca09f2dda003e4df58d+] conflictor [+hunk ./wibble 2++A+]+:+hunk ./wibble 2++B+[C+tester**20101016222814+ Ignore-this: 9d40b33ef1b73b9a950f39c4e8a75dfe+] conflictor {{+:+hunk ./wibble 2++A+:+hunk ./wibble 2++B+}} []+:+hunk ./wibble 2++C++Context:++Patch bundle hash:+ba3e1ce15840fd37358fcd43c4c03273d1779153
+ tests/data/convert/darcs2/tworesolutions.dpatch view
@@ -0,0 +1,84 @@+7 patches for repository /tmp/tmp6805/temp/empty-darcs2:++Sat Oct 16 23:34:33 BST 2010 tester+ * wibble++Sat Oct 16 23:34:33 BST 2010 tester+ * A++Sat Oct 16 23:34:33 BST 2010 tester+ * B++Sat Oct 16 23:34:33 BST 2010 tester+ * AB++Sat Oct 16 23:34:33 BST 2010 tester+ * C++Sat Oct 16 23:34:33 BST 2010 tester+ * ABC++Sat Oct 16 23:34:33 BST 2010 tester+ * D++New patches:++[wibble+tester**20101016223433+ Ignore-this: 577185c51e4839dd1041372fbfa8515b+] addfile ./wibble+hunk ./wibble 1++wibble+[A+tester**20101016223433+ Ignore-this: 580c4417986d5c56590bf36f5a125f38+] hunk ./wibble 2+ wibble++A+[B+tester**20101016223433+ Ignore-this: a9f2335fe2dc972fd0bc09edc6252256+] conflictor [+hunk ./wibble 2++A+]+:+hunk ./wibble 2++B+[AB+tester**20101016223433+ Ignore-this: cba095e78e2bdfe15dbdf2cb5c69cc6d+] hunk ./wibble 2+ wibble++AB+[C+tester**20101016223433+ Ignore-this: da2a7e05abed8dba0077e69e55bd926+] conflictor [+hunk ./wibble 2++AB+]+:+hunk ./wibble 2++C+[ABC+tester**20101016223433+ Ignore-this: db94de3935df87d0a991c0ab6a58e5b1+] hunk ./wibble 2+ wibble++ABC+[D+tester**20101016223433+ Ignore-this: 829adb4326b290aa6f741b3a15fbabfc+] conflictor [+hunk ./wibble 2++ABC+]+:+hunk ./wibble 2++D++Context:++Patch bundle hash:+b0ac3265aeb09b15b7dbc1dcf9447dae35d00a86
+ tests/data/convert/darcs2/twowayconflict.dpatch view
@@ -0,0 +1,40 @@+3 patches for repository /tmp/tmp5677/temp/empty-darcs2:++Sat Oct 16 23:28:22 BST 2010 tester+ * wibble++Sat Oct 16 23:28:22 BST 2010 tester+ * A++Sat Oct 16 23:28:22 BST 2010 tester+ * B++New patches:++[wibble+tester**20101016222822+ Ignore-this: 88662d08dd524d92ad4cca6df0d643e4+] addfile ./wibble+hunk ./wibble 1++wibble+[A+tester**20101016222822+ Ignore-this: 2d69de402438481946682efcad5e20cd+] hunk ./wibble 2+ wibble++A+[B+tester**20101016222822+ Ignore-this: 9c8daaedcb674c022ddbcef19752d694+] conflictor [+hunk ./wibble 2++A+]+:+hunk ./wibble 2++B++Context:++Patch bundle hash:+33bebb546403626fc8539d4709fbcdb99e47e94c
+ tests/data/example_binary.png view
binary file changed (absent → 6742 bytes)
+ tests/data/many-files--darcs-2.tgz view
binary file changed (absent → 250790 bytes)
+ tests/data/many-files--hashed.tgz view
binary file changed (absent → 169112 bytes)
+ tests/data/many-files--old-fashioned-inventory.tgz view
binary file changed (absent → 87207 bytes)
+ tests/data/maybench-crc.tgz view
binary file changed (absent → 114197 bytes)
+ tests/data/minimal-darcs-2_4.tgz view
binary file changed (absent → 3443 bytes)
+ tests/data/old-with-checkpoint.tgz view
binary file changed (absent → 3053 bytes)
+ tests/data/oldfashioned-compressed.tgz view
binary file changed (absent → 4153 bytes)
+ tests/data/oldfashioned.tgz view
binary file changed (absent → 3401 bytes)
+ tests/data/simple-v1.dpatch view
@@ -0,0 +1,20 @@+1 patch for repository /home/ganesh/darcs-comp/temp/empty:++Wed Oct 20 07:12:31 BST 2010 Ganesh Sittampalam <ganesh@earth.li>+ * wibble++New patches:++[wibble+Ganesh Sittampalam <ganesh@earth.li>**20101020061231+ Ignore-this: f4ff110805aca7a2d8805acf18605523+] {+addfile ./wibble+hunk ./wibble 1++wibble+}++Context:++Patch bundle hash:+3c6e5041f7e4b286c8884247a155a5d80d0dd77b
+ tests/data/simple-v1.tgz view
binary file changed (absent → 3126 bytes)
+ tests/data/simple-v2.dpatch view
@@ -0,0 +1,18 @@+1 patch for repository /home/ganesh/darcs-comp/temp/empty:++Wed Oct 20 07:12:31 BST 2010 Ganesh Sittampalam <ganesh@earth.li>+ * wibble++New patches:++[wibble+Ganesh Sittampalam <ganesh@earth.li>**20101020061231+ Ignore-this: f4ff110805aca7a2d8805acf18605523+] addfile ./wibble+hunk ./wibble 1++wibble++Context:++Patch bundle hash:+497c8eb610ad9a25b30ceafd3b4f5c1ff744d21d
+ tests/data/simple-v2.tgz view
binary file changed (absent → 2870 bytes)
+ tests/data/split--darcs-1.dpatch view
@@ -0,0 +1,23 @@+1 patch for repository /home/ganesh/temp/empty-old:++Tue Nov 16 07:15:41 GMT 2010 Ganesh Sittampalam <ganesh@earth.li>+ * add files++New patches:++[add files+Ganesh Sittampalam <ganesh@earth.li>**20101116071541+ Ignore-this: 2a86fa7deae02f1c98d578077ee5f8a9+] {+addfile ./file1+(+addfile ./file2+addfile ./file3+)+addfile ./file4+}++Context:++Patch bundle hash:+947100f54fce0fb3cb5debeca8702b119ee17d8a
+ tests/data/split--darcs-2.tgz view
binary file changed (absent → 2903 bytes)
+ tests/data/split--hashed.tgz view
binary file changed (absent → 3150 bytes)
+ tests/data/split--old-fashioned-inventory.tgz view
binary file changed (absent → 2827 bytes)
+ tests/data/split2--darcs-1.dpatch view
@@ -0,0 +1,51 @@+2 patches for repository /home/ganesh/temp/empty-old:++Tue Nov 16 18:32:25 GMT 2010 Ganesh Sittampalam <ganesh@earth.li>+ * wibble++Tue Nov 16 18:32:38 GMT 2010 Ganesh Sittampalam <ganesh@earth.li>+ * 'nums'+++New patches:++[wibble+Ganesh Sittampalam <ganesh@earth.li>**20101116183225+ Ignore-this: 5e5df9907f191511650c2ed66754d17+] {+addfile ./wibble+hunk ./wibble 1++A++B++C++D+}+['nums'+Ganesh Sittampalam <ganesh@earth.li>**20101116183238+ Ignore-this: e865de7aa7e896c759dabccf510c59bf+] {+hunk ./wibble 1++1+ A+ B+ C+(+hunk ./wibble 3++2+hunk ./wibble 5++3+)+hunk ./wibble 7+ B+ 3+ C++4+ D+hunk ./wibble 9++5+}++Context:++Patch bundle hash:+cdfc4f7087525b0298d4f08e6e497f925f85e406
+ tests/devnull.sh view
@@ -0,0 +1,31 @@+#!/usr/bin/env bash+## Test that non-interactive darcs commands work when stdin is /dev/null+##+## Copyright (C) 2011 Ganesh Sittampalam+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+darcs init --repo R # Create our test repo.++cd R+touch wibble+darcs rec -lam"wibble" < /dev/null
tests/diff.sh view
@@ -8,10 +8,10 @@ darcs initialize echo text > afile.txt darcs add afile.txt-darcs record --author me --all --no-test --patch-name init+darcs record --author me --all --no-test --name init darcs diff-darcs diff -p . --store-in-mem > diffinmem-darcs diff -p . --no-store-in-mem > diffondisk+darcs diff --no-unified -p . --store-in-mem > diffinmem+darcs diff --no-unified -p . --no-store-in-mem > diffondisk diff diffinmem diffondisk cd ..
tests/directory_confusion.sh view
@@ -10,14 +10,14 @@ darcs initialize echo text > afile.txt darcs add afile.txt-darcs record --author me --all --no-test --patch-name init+darcs record --author me --all --no-test --name init mkdir d darcs add d mkdir d/e darcs add d/e darcs mv afile.txt d/e/afile.txt echo altered_text > d/e/afile.txt-darcs record --author me --all --no-test --patch-name confusion+darcs record --author me --all --no-test --name confusion test ! -f _darcs/pristine/afile.txt echo y/d/y | tr / \\012 | darcs unrecord rm -rf "$T"
tests/emailformat.sh view
@@ -1,13 +1,15 @@ #!/usr/bin/env bash -. ../tests/lib+. lib set -ev switch_to_latin9_locale rm -rf temp1 rm -rf temp2+rm -rf temp3 mkdir temp1 mkdir temp2+mkdir temp3 cd temp1 seventysevenaddy="<aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa@bbbbbbbbbb.cccccccccc.abrasoft.com>"@@ -34,10 +36,17 @@ grep $seventysevenaddy mail_as_file # Check that there are no non-ASCII characters in the mail-ghc -e 'getContents >>= return . not . any (> Data.Char.chr 127)' < mail_as_file | grep '^True$'+cd ../temp3+cat > is_ascii.hs <<EOF+import Data.Char (chr) +main = getContents >>= print . not . any (> Data.Char.chr 127)+EOF +ghc --make is_ascii.hs -o is_ascii+./is_ascii < ../temp1/mail_as_file | grep '^True$'+ cd .. rm -rf temp1 rm -rf temp2-+rm -rf temp3
− tests/example_binary.png
binary file changed (6742 → absent bytes)
− tests/external.sh
@@ -1,37 +0,0 @@-#!/usr/bin/env bash--# Some tests for launching external commands--. lib--rm -rf temp1--touch_fakessh='./touch-fakessh'-if echo $OS | grep -i windows; then- touch_fakessh="touch_fakessh.bat"-fi-export DARCS_SSH=$touch_fakessh-export DARCS_SCP=$touch_fakessh-export DARCS_SFTP=$touch_fakessh-rm -rf 'fakessh'-rm -rf 'touch-fakessh'--# make our ssh command one word only-echo 'echo hello > fakessh' > $touch_fakessh-chmod u+x $touch_fakessh-# first test the DARCS_SSH environment variable-not darcs get example.com:foo-grep hello fakessh-rm -f fakessh--# now make sure that we don't launch ssh for nothing-mkdir temp1-cd temp1-darcs init-cd ..-darcs get temp1 > log-not grep fakessh log-not darcs get http://example.com/foo-not grep fakessh log-cd ..-rm -rf temp1
tests/failed-amend-should-not-break-repo.sh view
@@ -25,7 +25,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib+. lib set -ev rm -rf R mkdir R
tests/failing-add_permissions.sh view
@@ -24,7 +24,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib+. lib abort_windows # does not work on Windows. rm -rf temp1 # Another script may have left a mess.
+ tests/failing-haskell_policy.sh view
@@ -0,0 +1,41 @@+#!/usr/bin/env bash+## This is a pseudo-test that runs tweaked hlint on the source code.+##+## Copyright (C) 2009 Petr Rockai+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib++explain() {+ echo >&2+ echo "## It seems that hlint has found errors. This usually means that you" >&2+ echo "## have used a forbidden function. See contrib/darcs-errors.hlint for" >&2+ echo "## explanation. Please also disregard any possible parse errors." >&2+}++trap explain ERR++hlint >& /dev/null || exit 200 # skip if there's no hlint++wd="`pwd`"+cd ..+hlint --hint=contrib/darcs-errors.hlint src
tests/failing-issue1190_unmarked_hunk_replace_conflict.sh view
@@ -24,7 +24,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib+. lib rm -rf d e # Another script may have left a mess. darcs init --repo d/
tests/failing-issue1266_init_inside_a_repo.sh view
@@ -25,7 +25,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib+. lib rm -rf temp1 out # Another script may have left a mess. darcs init --repodir temp1
tests/failing-issue1317_list-options_subdir.sh view
@@ -23,7 +23,7 @@ # OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN # THE SOFTWARE. -. ../tests/lib+. lib rm -rf R mkdir R cd R
tests/failing-issue1325_pending_minimisation.sh view
@@ -24,7 +24,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R S # Another script may have left a mess. darcs init --repo=R darcs init --repo=S
tests/failing-issue1332_add_r_boring.sh view
@@ -23,7 +23,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R # Another script may have left a mess. darcs init --repo R # Create our test repos.
tests/failing-issue1396_changepref-conflict.sh view
@@ -1,7 +1,7 @@ #!/usr/bin/env bash set -ev -. ../tests/lib+. lib rm -rf temp1 temp1a temp1b
tests/failing-issue1401_bug_in_get_extra.sh view
@@ -25,7 +25,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib+. lib ## This bug only affects darcs-2 repositories. fgrep darcs-2 ~/.darcs/defaults &>/dev/null || exit 0
tests/failing-issue1406.sh view
@@ -24,7 +24,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R S # Another script may have left a mess. darcs init --repo R # Create our test repos. darcs init --repo S@@ -39,7 +39,7 @@ #!/bin/sh set -ev -. ../tests/lib+. lib rm -rf temp1 darcs init --repodir temp1@@ -48,7 +48,7 @@ echo "test exit 1" > _darcs/prefs/prefs echo "a" > a-darcs record --look-for-adds --no-test --all --patch-name=p1+darcs record --look-for-adds --no-test --all --name=p1 echo "b" >> a echo "y" | not darcs amend-record --all --patch=p1 @@ -68,7 +68,7 @@ # check that we do the operations on checkpoints tentatively rm -rf old-with-checkpoint- tar zxf ../tests/repos/old-with-checkpoint.tgz+ gunzip -c $TESTDATA/old-with-checkpoint.tgz | tar xf - echo "test exit 1" > old-with-checkpoint/_darcs/prefs/prefs
tests/failing-issue1442_encoding_round-trip.sh view
@@ -26,7 +26,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib+. lib rm -rf R # Another script may have left a mess.
tests/failing-issue1461_case_folding.sh view
@@ -24,7 +24,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. touch casetest test -e CASETEST || exit 200
tests/failing-issue1473_annotate_repodir.sh view
@@ -1,7 +1,7 @@ #!/usr/bin/env bash set -ev -. ../tests/lib+. lib rm -rf temp mkdir temp cd temp
tests/failing-issue1609_ot_convergence.sh view
@@ -31,7 +31,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf S1 S2 S3 # Another script may have left a mess. darcs init --repo S1 # Create our test repos.
tests/failing-issue1610_get_extra.sh view
@@ -25,7 +25,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. # this test is not relevant for darcs 2 repositories (not grep darcs-2 $HOME/.darcs/defaults) || exit 200
tests/failing-issue1632_changes_nonexisting.sh view
@@ -24,7 +24,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R # Another script may have left a mess. darcs init --repo R # Create our test repos.
tests/failing-issue1702-optimize-relink-vs-cache.sh view
@@ -24,7 +24,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R S # Another script may have left a mess. darcs init --repo R # Create our test repos.
tests/failing-issue1727_move_current_directory.sh view
@@ -24,7 +24,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R # Another script may have left a mess. # Create repository R
− tests/failing-issue1737-move_args.sh
@@ -1,38 +0,0 @@-#!/usr/bin/env bash-## Test for issue1737 - command line filtering on darcs move-## yields suprising results with shell globs-##-## Copyright (C) 2010 Eric Kow-##-## Permission is hereby granted, free of charge, to any person-## obtaining a copy of this software and associated documentation-## files (the "Software"), to deal in the Software without-## restriction, including without limitation the rights to use, copy,-## modify, merge, publish, distribute, sublicense, and/or sell copies-## of the Software, and to permit persons to whom the Software is-## furnished to do so, subject to the following conditions:-##-## The above copyright notice and this permission notice shall be-## included in all copies or substantial portions of the Software.-##-## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,-## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF-## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND-## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS-## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN-## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN-## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE-## SOFTWARE.--. lib # Load some portability helpers.-rm -rf R # Another script may have left a mess.-darcs init --repo R # Create our test repos.--cd R-mkdir d-touch d.txt-darcs record -lam 'Add d and d.txt'-darcs move d d.txt d 2> log || : # this can happen if eg. you darcs move d* d-# d.txt isn't a directory; we should probably just say that you-# can't move a directory on to itself-not grep "target directory d.txt" log
+ tests/failing-issue1790_darcs-send.sh view
@@ -0,0 +1,69 @@+#!/usr/bin/env bash+## Test for issue1790 - darcs send --context foo should not require+## a remote repository+##+## Copyright (C) 2009 Loup Vaillant+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+rm -rf R S # Another script may have left a mess.+darcs init --repo R # Create our test repos.+darcs init --repo S++cd R+ # populate R (optional)+ echo foo > foo.txt+ darcs add foo.txt+ darcs record -a -m "foo"++ # create a context file to represent R's state+ darcs changes --context > ../R.context+cd ..++# copy the repository the hard way.+# normally one would use `darcs get A B` to do that,+# but when no central server is available, this sort of+# hard copy may be perceived as simpler: Just tar xcfz+# the repository and send it via email.+cp -r R S++cd S+ # Make sure there is no _darcs/prefs/defaultrepo file+ # If there is one even on new repositories, that would+ # appear to solve the issue, but I think this is not a+ # good solution: the absence of the defaultrepo file+ # is useful to indicate the absence of interaction with+ # remote repositories.+ #+ # Of course, at the time of this writing, the following+ # line has no effect+ rm -rf _darcs/prefs/defaultrepo++ # make some further modifications (optional)+ echo bar > bar.txt+ darcs add bar.txt+ darcs record -a -m "bar"++ # try to send a patch to the first repository,+ # using its context file+ darcs send -a -o ../bar.patch --context=../R.context+cd ..
+ tests/failing-issue1829-inconsistent-conflictor.sh view
@@ -0,0 +1,62 @@+#!/usr/bin/env bash+## Leads darcs into creating an inconsistent conflictor.+## Public Domain, 2010, Ganesh Sittampalam, Ian Lynagh and Petr Rockai++# This file is included as part of the Darcs test distribution,+# which is licensed to you under the following terms:+#+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.+. lib++rm -rf r1 r2++mkdir r1+cd r1+darcs init+echo Line BB > file+darcs add file+darcs rec -a -m "Main patch 1"+echo Line DDDD >> file+darcs rec -a -m "Main patch 2"+echo Line A > file+echo Line BB >> file+echo Line CCC >> file+echo Line DDDD >> file+echo Line EEEEE >> file+darcs rec -a -m "Main patch 3"+cd ..++mkdir r2+cd r2+darcs init+darcs pull -a -p "Main patch 1" ../r1+echo Line TTTTTTT >> file+darcs rec -a -m "Alternate patch 1"+darcs pull -a -p "Main patch 2" ../r1+darcs revert -a+echo Line XXXXXXXXX >> file+darcs rec -a -m "Alternate patch 2"+echo Line XXXXXXXXX > file+darcs rec -a -m "Alternate patch 3"+cd ..++cd r1+darcs pull -a ../r2
− tests/failing-issue1909-unrecord-O-misses-tag.sh
@@ -1,20 +0,0 @@-#!/usr/bin/env bash-## issue1909: unrecord -O in tagged repo makes a busted bundle--. lib--rm -rf R-mkdir R-darcs init --repo R-echo a > R/a-darcs rec -lam a --repo R --ignore-times-darcs tag -m T --repo R-echo b > R/a-darcs rec -lam b --repo R --ignore-times-echo c > R/a-darcs rec -lam c --repo R --ignore-times--darcs unpull -p c -a --repo R -O-cat c.dpatch-grep '^\[b' c.dpatch-grep TAG c.dpatch
+ tests/failing-issue1926_amend-record_ignores_--index.sh view
@@ -0,0 +1,48 @@+#!/usr/bin/env bash+## Test for issue1926 - amend-record --index+##+## Copyright (C) 2010 Iago Abal+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+rm -rf R S # Another script may have left a mess.+darcs init --repo R # Create our test repos.+#darcs init --repo S++cd R+echo 'Example content 1.' > f+darcs record -lam 'Add file f'+echo 'Example content 2.' > g+darcs record -lam 'Add file g'+darcs put ../S # S as a copy of R+echo "y" | darcs amend-record --index=2 -m 'A new file f' # Since --index is ignored this command works in+ # interactive mode, and the amended patch is the one+ # with index 1.+darcs changes > changes+cd ..++cd S+echo "y" | darcs amend-record -p 'Add file f' -m 'A new file f' # -p works as expected and amends the right patch.+darcs changes > changes+cd ..++diff R/changes S/changes # Shows us the differences between both 'darcs changes'.
+ tests/failing-issue1928-file-dir-replace.sh view
@@ -0,0 +1,36 @@+#!/usr/bin/env bash+## Test for issue1913 - test for directory diffing+##+## Copyright (C) 2010 Ganesh Sittampalam+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+rm -rf R # Another script may have left a mess.+darcs init --repo R # Create our test repos.++cd R+touch foo+darcs rec -l -a -m "foo file patch"+rm foo+mkdir foo+darcs rec -l -a -m "foo dir patch"+cd ..
+ tests/failing-issue1932-colon-breaks-add.sh view
@@ -0,0 +1,77 @@+#!/usr/bin/env bash+## Test for issue1932 - "darcs add -qr ." should not break on files with colons+##+## Copyright(C) 2010 Dmitry Astapov+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+rm -rf R # Another script may have left a mess.+mkdir -p R # Create our test repo.++cd R+darcs init+darcs --version++# Colons could be in repo names and in file name.+# Colon in repo name is an indication of special case - remote repo.+# Colon in the file could be there under unix and requires no special treatment.++# Repo name with ':' is either scp repo or http repo.+# Let's check scp repo first.+( darcs get user@host:path || true ) > log 2>&1+[ -n "$(fgrep '(scp) failed to fetch' log)" ]++# HTTP repo+( darcs get http://www.bogus.domain.so.it.will.surely.fail.com || true ) > log 2>&1+[ -n "$(fgrep 'CouldNotResolveHost' log)" ]++# All following files should not be added unless "--reserved-ok" is specified,+# but should be added with "--reserved-ok" just fine+mkdir funny+touch funny/0401:19d2+touch funny/c:src+touch funny/c:\\src+touch funny/user@host:path +touch funny/droundy@host: +touch funny/host:path++# Try to add those files. None should be added, darcs should not fail+darcs add -qr funny+darcs wh -l > log 2>&1++# Check that darcs didn't drop dead as 2.4.4 does+[ -z "$(fgrep 'fromJust: Nothing' log)" ]++# Check that no funny files were added+[ -z "$(grep '^A \./funny/.' log)" ]++# Now let's allow colons and add those files+darcs add --reserved-ok -qr funny +darcs wh -l > log 2>&1++# This should add all those files+[ -n "$(grep '^A \./funny/0401:19d2' log)" ]+[ -n "$(grep '^A \./funny/c:src' log)" ]+[ -n "$(grep '^A \./funny/c:\\src' log)" ]+[ -n "$(grep '^A \./funny/user@host:path' log)" ]+[ -n "$(grep '^A \./funny/droundy@host:' log)" ]+[ -n "$(grep '^A \./funny/host:path' log)" ]
+ tests/failing-issue2017-missing-tag.sh view
@@ -0,0 +1,85 @@+#!/usr/bin/env bash+## Test for issue2017 - apply should gracefully handle tag missing+## from context (complain, not crash)+##+## Copyright (C) 2010 Eric Kow+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+darcs init --repo R # Create our test repos.++cd R+echo 'Example content.' > f+darcs record -lam 'Add f'+cd ..++# variant 0 - this passes trivially+darcs get R R0+darcs get R0 S0+darcs tag 's' --repo S0+darcs get S0 T0+cd T0+echo 'More content.' > f+darcs record -lam 'Modify f'+darcs send -o foo.dpatch -a+cd ..+not darcs apply --repo R0 T0/foo.dpatch > log 2>&1+not grep bug log+grep missing log++# variant 1 - tag in shared context+darcs get R R1+darcs tag '1' --repo R1+darcs get R1 S1+darcs tag 's1' --repo S1+darcs get S1 T1+cd T1+echo 'More content.' > f+darcs record -lam 'Modify f'+darcs send -o foo.dpatch -a+cd ..+# sanity check: should be able to cherry pick+darcs get R1 R1b+cd R1b+[ `darcs changes --count` -eq 2 ]+darcs pull ../T1 --match 'touch f' --all+[ `darcs changes --count` -eq 3 ]+cd ..+# the test: can't apply this due to incorrect context+not darcs apply --repo R1 T1/foo.dpatch > log 2>&1+not grep 'bug' log+grep missing log++# variant 2 - tag created after the fact+darcs get R R2+darcs get R2 S2+darcs tag 's2' --repo S2+darcs get S2 T2+cd T2+echo 'More content.' > f+darcs record -lam 'Modify f'+darcs send -o foo.dpatch -a+cd ..+darcs tag '2' --repo R2 # only tag after+not darcs apply --repo R2 T2/foo.dpatch > log 2>&1+not grep 'bug' log+grep missing log
+ tests/failing-issue2066_add_and_remove.sh view
@@ -0,0 +1,41 @@+#!/usr/bin/env bash+## Test for issue2066 - darcs record fails when deleted file and added file are specified on the command line+##+## Copyright (C) 2011 David Caldwell <david@porkrind.org>+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib+rm -rf R+mkdir R++cd R+darcs init+echo a > a+darcs add a+darcs record --all -m "a"+rm -f a+echo b > b+darcs add b+darcs record --all -m "-a+b" a b+darcs changes -v | grep 'rmfile ./a' # the remove doesn't get recorded even though we told it to.++cd ..
+ tests/failing-issue2076-move_into_dir.sh view
@@ -0,0 +1,40 @@+#!/usr/bin/env bash+## Copyright (C) 2011 Lennart Kolmodin <kolmodin@gmail.com>+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++++. lib # Load some portability helpers.+darcs init --repo issue2076++cd issue2076+touch file1+darcs record -lam 'file1'+mkdir dir1++mv file1 dir1++darcs mv file1 dir1++# darcs crashes when it expects a file but finds a directory instead++darcs whatsnew
+ tests/failing-issue612_repo_not_writable.sh view
@@ -0,0 +1,39 @@+#!/usr/bin/env bash++# Test that darcs fails appropriately when the target repo inventory file is not writable.+# See issue612++. lib++abort_windows++if grep old-fashioned .darcs/defaults; then+ exit 200+fi++rm -rf temp1 temp2+mkdir temp1+cd temp1+darcs init+touch t.t+darcs add t.t+darcs record -am "initial add"+if [ -e _darcs/inventories ]; then+ chmod 0555 _darcs/inventories/*+ chmod 0555 _darcs/inventories+fi+if [ -e _darcs/inventory ]; then+ chmod 0555 _darcs/inventory+fi+cd ..++darcs get temp1 temp2+cd temp2+# this block may fail so we'd better make sure we clean up after+# ourselves to avoid a permissions mess for other tests+trap "cd ..; chmod -R 0755 temp1; rm -rf temp1 temp2" EXIT+echo new >> t.t+darcs record -am "new patch"+not darcs push -a ../temp1 2> log+grep failed log+
− tests/failing-issue944_partial_inventory.sh
@@ -1,46 +0,0 @@-#!/usr/bin/env bash--set -ev--test $DARCS || DARCS=$PWD/../darcs-ACTUAL_DARCS=`which $DARCS`-DARCSPATH=`dirname $ACTUAL_DARCS`-PATH="$DARCSPATH:$PATH"-export PATH--# create base repository-rm -rf temp1-mkdir temp1-cd temp1-darcs init--echo first > a-darcs add a-darcs record -am first-darcs tag --checkpoint 'Tag 1'--echo second > b-darcs add b-darcs record -am second-darcs tag --checkpoint 'Tag 2'--echo third > c-darcs add c-darcs record -am third-darcs tag --checkpoint 'Tag 3'--# create a partial copy of the base repository and modify it-cd ..-rm -rf temp2-darcs get --partial temp1 temp2-cd temp2--# instead of the following three commands one could also use darcs optimize-echo mistake > a-darcs record -am mistake-darcs unrecord -ap mistake--# now check the repository-darcs check-# => darcs: failed to read patch: ...-
tests/failing-merging_newlines.sh view
@@ -38,7 +38,7 @@ cat log not grep -i conflicts log # BUG HERE-# after a conflict, darcs resolve should report a conflict+# after a conflict, darcs mark-conflicts should report a conflict darcs mark-conflicts > log 2>&1 cat log not grep -i 'no conflicts' log
+ tests/failing-pristine-problems.sh view
@@ -0,0 +1,57 @@+#!/usr/bin/env bash+## Check for correct behaviour with missing files in pristine+##+## Copyright (C) 2010 Ganesh Sittampalam+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.++if grep old-fashioned .darcs/defaults; then exit 200; fi++rm -rf foo+mkdir foo+cd foo+darcs init++echo 'wibble' > wibble+darcs rec -lam 'wibble'++darcs check++roothash=`darcs show pristine | grep ' ./$' | cut -d' ' -f1`+wibblehash=`darcs show pristine | grep ' wibble$' | cut -d' ' -f1`++rm _darcs/pristine.hashed/$roothash++not darcs check+not darcs check+# At the time of writing this test goes wrong at the line above+# I'm not 100% certain if the rest of it is right.+darcs repair | grep -v 'The repository is already consistent'+darcs check++rm _darcs/pristine.hashed/$wibblehash++not darcs check+not darcs check+darcs repair | grep -v 'The repository is already consistent'+darcs check
tests/failing-record-scaling.sh view
@@ -23,7 +23,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. which strace || exit 200 # This test requires strace(1). rm -rf R # Another script may have left a mess.
+ tests/get-http-packed-detect.sh view
@@ -0,0 +1,41 @@+#!/usr/bin/env bash+# 2011, by Petr Rockai, Guillaume Hoffmann, public domain++# Tets that darcs get --verbose reports getting a pack when there is one,+# and does not report when there is none or when --no-packs is passed.++. lib++rm -rf R S && mkdir R+cd R+darcs init++darcs show repo > repo+grep "Format: hashed" repo || exit 200 # not supported with oldfashioned repos++for f in `seq 1 200`; do+ echo $f > $f+ darcs rec -lam $f+done++darcs optimize # FIXME the pristine.hashed in the basic tarball has extra files+ # without this step++darcs optimize --http+test -e _darcs/packs/basic.tar.gz+test -e _darcs/packs/patches.tar.gz+cd ..++serve_http # sets baseurl++# check that default behaviour is to get packs+darcs get $baseurl/R S --verbose |grep "Getting packed repository"++# check that it does really not get packs when --no-packs is passed+rm -rf S+darcs get $baseurl/R S --no-packs --verbose |not grep "Getting packed repository"++# check that it does not clam getting packs when there are not+rm -rf S+rm -rf R/_darcs/packs/+darcs get $baseurl/R S --verbose |not grep "Getting packed repository"
+ tests/get-http-packed.sh view
@@ -0,0 +1,30 @@+#!/usr/bin/env bash+# Written in 2010 by Petr Rockai, placed in public domain++. lib++rm -rf R S && mkdir R+cd R+darcs init++darcs show repo > repo+grep "Format: hashed" repo || exit 200 # not supported with oldfashioned repos++for f in `seq 1 200`; do+ echo $f > $f+ darcs rec -lam $f+done++darcs optimize # FIXME the pristine.hashed in the basic tarball has extra files+ # without this step++darcs optimize --http+test -e _darcs/packs/basic.tar.gz+test -e _darcs/packs/patches.tar.gz+cd ..++serve_http # sets baseurl+darcs get --packs $baseurl/R S+cd S+rm _darcs/prefs/sources # avoid any further contact with the original repository+darcs check
+ tests/get-http.sh view
@@ -0,0 +1,41 @@+#!/usr/bin/env bash+# Written in 2010 by Petr Rockai, placed in public domain++# This file is included as part of the Darcs test distribution,+# which is licensed to you under the following terms:+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib++rm -rf R S && mkdir R+cd R+darcs init+echo a > a+darcs rec -lam a+cd ..++serve_http # sets baseurl+darcs get $baseurl/R S+cd S+darcs pull ../R | tee log+grep "No remote changes" log+darcs check
tests/gzcrcs.sh view
@@ -28,9 +28,9 @@ darcs gzcrcs --help > /dev/null if [ $? == 2 ] ; then echo gzcrcs not supported by this darcs ; exit 0 ; fi -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf maybench-crc-gunzip -c repos/maybench-crc.tgz | tar xf -+gunzip -c $TESTDATA/maybench-crc.tgz | tar xf - cd maybench-crc not darcs gzcrcs --check darcs gzcrcs --repair
tests/harness.sh view
@@ -1,6 +1,6 @@ #!/usr/bin/env bash -set -ev+set -vex # Print some stuff out for debugging if something goes wrong: echo $HOME@@ -10,7 +10,14 @@ # Check things that should be true when all the testscripts run -test -f "$HOME"/harness.sh || { echo "HOME=\"$HOME\" is not the test suite directory"; exit 1; }+test -f "$HOME/lib"+password="AKARABNADABARAK-KARABADANKBARAKA"+grep $password "$HOME/test" || grep $password "$HOME/harness.sh" -homedirname=`dirname "$HOME"`-command -v darcs | grep "$homedirname"+if echo $OS | grep -i windows; then+ real=$(cmd //c echo $(command -v darcs.exe) | sed -e 's,\\,/,g')+ wanted=$(echo "$DARCS" | sed -e 's,\\,/,g')+ test "$real" = "$wanted"+else+ command -v darcs | fgrep "$DARCS"+fi
tests/hashed_inventory.sh view
@@ -29,7 +29,6 @@ -rm -rf temp1 temp2 temp3 temp4 temp5 mkdir temp1 cd temp1 darcs init --hashed@@ -49,7 +48,7 @@ makepristine cd .. -darcs get --hashed temp1 temp3+darcs get temp1 temp3 cd temp3 darcs changes cp _darcs/hashed_inventory inv@@ -100,7 +99,7 @@ diff -rc temp2/pristine temp3/pristine cd temp1-darcs put --hashed ../temp4+darcs put ../temp4 cd .. cd temp4 makepristine@@ -147,17 +146,7 @@ diff temp1/_darcs/hashed_inventory temp4/_darcs/hashed_inventory -rm -rf temp3-darcs get --old-fashioned temp1 temp3--rm -rf "$HOME"/.darcs/sources-echo cache:"$HOME"/.darcs/cache > "$HOME"/.darcs/sources-darcs get --hashed temp3 temp5-rm -rf temp5-# check that sources directory was created:-cd "$HOME"/.darcs/sources && cd ---darcs get temp1 temp5 --hashed --old-fashioned+darcs get temp1 temp5 cd temp5 darcs obliterate --last 3 -a darcs pull ../temp1 -a@@ -165,8 +154,6 @@ darcs pull ../temp2 -a darcs check darcs obliterate --last 3 -a-darcs pull ../temp3 -a-darcs obliterate --last 3 -a darcs pull ../temp4 -a cd .. @@ -175,11 +162,6 @@ darcs pull ../temp5 -a cd .. -cd temp3-darcs obliterate --last 3 -a-darcs pull ../temp5 -a-cd ..- cd temp2 darcs obliterate --last 3 -a darcs pull ../temp5 -a@@ -189,6 +171,4 @@ darcs obliterate --last 3 -a darcs pull ../temp5 -a cd ..--rm -rf temp1 temp2 temp3 temp4 temp5
− tests/haskell_policy.sh
@@ -1,41 +0,0 @@-#!/usr/bin/env bash-## This is a pseudo-test that runs tweaked hlint on the source code.-##-## Copyright (C) 2009 Petr Rockai-##-## Permission is hereby granted, free of charge, to any person-## obtaining a copy of this software and associated documentation-## files (the "Software"), to deal in the Software without-## restriction, including without limitation the rights to use, copy,-## modify, merge, publish, distribute, sublicense, and/or sell copies-## of the Software, and to permit persons to whom the Software is-## furnished to do so, subject to the following conditions:-##-## The above copyright notice and this permission notice shall be-## included in all copies or substantial portions of the Software.-##-## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,-## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF-## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND-## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS-## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN-## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN-## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE-## SOFTWARE.--. lib--explain() {- echo >&2- echo "## It seems that hlint has found errors. This usually means that you" >&2- echo "## have used a forbidden function. See contrib/darcs-errors.hlint for" >&2- echo "## explanation. Please also disregard any possible parse errors." >&2-}--trap explain ERR--hlint >& /dev/null || exit 200 # skip if there's no hlint--wd="`pwd`"-cd ..-hlint --hint=contrib/darcs-errors.hlint src
@@ -60,7 +60,7 @@ # we should have a marked conflict now. grep 'v v' A # we resolve it simply by removing conflict markers.-sed -e '/\^ \^|\*\*|v v/d' A > temp+sed -e '/\^ \^\|\*\*\|v v/d' A > temp mv temp A darcs record -m resolution --all # now mark-conflicts shouldn't find any unmarked conflicts
− tests/hspwd.hs
@@ -1,5 +0,0 @@-module Main where--import Directory ( getCurrentDirectory )--main = getCurrentDirectory >>= putStr
+ tests/hunk-editor.sh view
@@ -0,0 +1,46 @@+#!/usr/bin/env bash+## Test for hunk editor+##+## Copyright (C) 2011 Ganesh Sittampalam+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+rm -rf R # Another script may have left a mess.++darcs init --repo R++cd R++echo 'version1' > file+darcs record -lam "version1"++echo 'version2' > file+(echo e ; echo y ; echo n) | DARCS_EDITOR="sed -i -e s/version2/version1.5/" darcs record -m "version1.5"++cat > expected <<EOF+hunk ./file 1+-version1.5++version2+EOF++darcs whatsnew | diff -u expected -+
tests/illegal_mv.sh view
@@ -8,7 +8,7 @@ darcs initialize echo text > afile.txt darcs add afile.txt-darcs record --author me --all --no-test --patch-name init+darcs record --author me --all --no-test --name init mkdir d echo The following mv should fail, since d isnt in the repo. if darcs mv afile.txt d/afile.txt; then
+ tests/invalid_absolute_paths.sh view
@@ -0,0 +1,54 @@+#!/usr/bin/env bash+##+## Regression test for patch178+##+## Copyright (C) 2010 Alexey Levan+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+rm -rf R # Another script may have left a mess.+darcs init --repo R # Create our test repos.+cd R++if darcs move /non_existent_path/a /non_existent_path/b 2>&1 | grep 'bug'; then+ echo 'Not OK 1: darcs move causes a bug'+ exit 1+else+ echo 'OK 1'+fi++if darcs move /non_existent_path/a /non_existent_path/b /non_existent_path/c 2>&1 | grep 'Prelude.init: empty list'; then+ echo 'Not OK 2: darcs move causes an error'+ exit 1+else+ echo 'OK 2'+fi++if darcs annotate /non_existent_path/a 2>&1 | grep 'Pattern match failure'; then+ echo 'Not OK 3: darcs annotate causes an error'+ exit 1+else+ echo 'OK 3'+fi++cd ..+rm -rf R
tests/issue1039.sh view
@@ -11,7 +11,7 @@ darcs init echo a > a darcs add a-darcs record --all --patch-name=a+darcs record --all --name=a cd ../temp2 darcs init darcs pull --all --dont-allow-conflicts ../temp1@@ -28,7 +28,7 @@ darcs init echo a > a darcs add a-darcs record --all --patch-name=a+darcs record --all --name=a darcs push --all ../temp1 cd ../temp1 test `darcs changes --count` = "1"@@ -42,7 +42,7 @@ darcs init echo a > a darcs add a-darcs record --all --patch-name=a+darcs record --all --name=a for i in 1 2 3 4 5 6 7 8 9; do echo Change number $i >> a@@ -53,7 +53,7 @@ darcs init echo b > b darcs add b-darcs record --all --patch-name=b+darcs record --all --name=b for i in 1 2 3 4 5 6 7 8 9; do echo Change number $i >> b
tests/issue1110_get_hashed.sh view
@@ -1,10 +1,10 @@ #!/usr/bin/env bash set -ev rm -rf temp1 temp1-h-mkdir temp1-cd temp1-darcs init --old-fashioned-inventory-cd ..-darcs get --hashed temp1 temp1-h++gunzip -c $TESTDATA/many-files--old-fashioned-inventory.tgz | tar xf -+mv many-files--old-fashioned-inventory temp1++darcs get temp1 temp1-h test -e temp1-h/_darcs/hashed_inventory rm -rf temp1 temp1-h
− tests/issue1110_get_old-fashioned.sh
@@ -1,30 +0,0 @@-#!/usr/bin/env bash-set -ev--rm -rf temp0 temp1-# sanity check-mkdir temp0-cd temp0-darcs init --old-fashioned-cd ..-darcs get --old-fashioned temp0 temp1-test -e temp1/_darcs/inventory-rm -rf temp0 temp1--# get from hashed-mkdir temp0-cd temp0-darcs init --hashed-cd ..-darcs get --old-fashioned temp0 temp1-test -e temp1/_darcs/inventory-rm -rf temp0 temp1--# get from darcs-2-mkdir temp0-cd temp0-darcs init --darcs-2-cd ..-darcs get --old-fashioned temp0 temp1 > log-grep 'Warning' log-rm -rf temp0 temp1
tests/issue1111-pull-intersection.sh view
@@ -1,7 +1,32 @@ #!/usr/bin/env bash+# This file is included as part of the Darcs test distribution,+# which is licensed to you under the following terms:+#+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE. . lib # This test script is in the public domain.+# This file is included as part of the Darcs test distribution,+# which is licensed to you under the following terms:+# rm -rf temp1 temp2 temp3
tests/issue1139-diff-last.sh view
@@ -14,12 +14,12 @@ echo newtext > foo darcs record -am 'modify foo' -darcs diff --store-in-mem --last=1 > out1+darcs diff --no-unified --store-in-mem --last=1 > out1 cat out1 grep text out1 grep foo out1 -darcs diff --last=1 > out+darcs diff --no-unified --last=1 > out cat out grep text out grep foo out
tests/issue1139-diff-with-no-args.sh view
@@ -12,12 +12,12 @@ echo newtext > foo darcs wh -darcs diff --store > out1+darcs diff --no-unified --store > out1 cat out1 grep text out1 grep foo out1 -darcs diff > out+darcs diff --no-unified > out cat out grep text out grep foo out
tests/issue121.sh view
@@ -23,7 +23,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R darcs init --repo R # Create our test repos.
tests/issue1224_convert-darcs2-repository.sh view
@@ -27,14 +27,14 @@ # this test is not relevant for other than darcs 2 repositories grep darcs-2 $HOME/.darcs/defaults || exit 200 -. ../tests/lib+. lib rm -rf R darcs init --repo R echo File contents > R/file.txt darcs add R/file.txt --repodir R-darcs record --patch-name=add_file.txt --author=me --no-test -a --repodir R+darcs record --name=add_file.txt --author=me --no-test -a --repodir R # This should fail with repository already in darcs-2 format. echo "I understand the consequences of my action" > ack
− tests/issue1232_convert_forgets_prefs.sh
@@ -1,62 +0,0 @@-#!/usr/bin/env bash-## Test for issue1232 - When converting a repo to darcs2 format,-## the prefs file isn't copied.-##-## Copyright (C) 2010 Dino Morelli-##-## Permission is hereby granted, free of charge, to any person-## obtaining a copy of this software and associated documentation-## files (the "Software"), to deal in the Software without-## restriction, including without limitation the rights to use, copy,-## modify, merge, publish, distribute, sublicense, and/or sell copies-## of the Software, and to permit persons to whom the Software is-## furnished to do so, subject to the following conditions:-##-## The above copyright notice and this permission notice shall be-## included in all copies or substantial portions of the Software.-##-## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,-## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF-## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND-## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS-## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN-## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN-## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE-## SOFTWARE.--. lib---# Test set-up where src repo DOES NOT already have a-# _darcs/prefs/prefs file--# Another script may have left a mess-rm -rf R S--# Create source repo-darcs init --old-fashioned-inventory --repo R--# Perform the d1 to d2 conversion-echo "I understand the consequences of my action" | darcs convert R S--# Check that the new repo is d2-test -f S/_darcs/hashed_inventory---# Test set-up where src repo DOES have a _darcs/prefs/prefs file--# Another script may have left a mess-rm -rf R S--# Create source repo-darcs init --old-fashioned-inventory --repo R--# Do something easy that will create a prefs file-darcs setpref test 'true' --repo R--# Perform the d1 to d2 conversion-echo "I understand the consequences of my action" | darcs convert R S--# Check that the prefs file was copied over-prefsPath="_darcs/prefs/prefs"-diff R/$prefsPath S/$prefsPath
tests/issue1248.sh view
@@ -5,17 +5,8 @@ ## Placed into the public domain by Ganesh Sittampalam, 2009 . lib-rm -rf temp1-mkdir temp1-cd temp1-darcs init --old-fashioned-touch foo-darcs rec -a -m'foo' -l --author=me@me-darcs tag --author=me@me foo-darcs check-darcs optimize --reorder-darcs check-darcs optimize --compress++gunzip -c $TESTDATA/oldfashioned-compressed.tgz | tar xf -+cd oldfashioned-compressed+darcs optimize --upgrade darcs check-cd ..-rm -rf temp1
tests/issue1290-diff-index.sh view
@@ -1,7 +1,27 @@ #!/usr/bin/env bash ## Test for issue1290 - darcs diff --index ##-## Public domain - 2010 Eric Kow+## Copyright (C) 2010 Eric Kow+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE. . lib # Load some portability helpers. rm -rf R # Another script may have left a mess.@@ -16,7 +36,7 @@ darcs record -lam 'three' echo '4' > f darcs record -lam 'four'- darcs diff --from-patch one --to-patch two > d1- darcs diff --index=3-4 > d2 # the numbers go backwards+ darcs diff --no-unified --from-patch one --to-patch two > d1+ darcs diff --no-unified --index=3-4 > d2 # the numbers go backwards diff -q d1 d2 cd ..
tests/issue1300_record_delete-file.sh view
@@ -24,7 +24,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R # Another script may have left a mess. darcs init --repo R # Create our test repos. cd R
tests/issue1337_darcs_changes_false_positives.sh view
@@ -25,7 +25,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib+. lib rm -rf temp1 darcs init --repodir temp1
+ tests/issue1344_abort_early_cant_send.sh view
@@ -0,0 +1,73 @@+#!/usr/bin/env bash+## Test for issue1344 - abort early darcs send if sendmail is not+## available+##+## Copyright (C) 2010 Gabriel Kerneis+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++set -ev++. lib++# The mail sending code on Windows uses the MAPI API unconditionally+# so this test fails.+# If it's possible to discover in advance whether mail sending would work,+# the code and this test could be improved to do that.+abort_windows++# Skip this test if sendmail is available+if which sendmail ; then+ echo "Sendmail found (in path), skipping test."+ exit 200+fi+if [ -f "/usr/sbin/sendmail" -o -f "/sbin/sendmail" -o \+ -f "/usr/lib/sendmail" ]; then+ echo "Sendmail found, skipping test."+ exit 200+fi++DARCS_EDITOR=echo+export DARCS_EDITOR++mkdir temp1 temp2++cd temp2+darcs init++# setup test+cd ../temp1+darcs init+touch foo bar+darcs add foo bar+darcs record -a -m add_foo_bar -A x++# If --sendmail-command is provided, no warning+darcs send --author=me -a --to=random@random --sendmail-command='true' ../temp2+# If --dry-run is provided, no warning+darcs send --author=me -a --to=random@random --dry-run ../temp2+# If -o or -O is provided, no warning+darcs send --author=me -a --to=random@random -O ../temp2+darcs send --author=me -a --to=random@random -o test.patch ../temp2+# Otherwise, fail early+darcs send --author=me -a --to=random@random ../temp2 | grep "No working sendmail"++cd ..
tests/issue1392_authorspelling.sh view
@@ -23,7 +23,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R # Another script may have left a mess. darcs init --repo R # Create our test repos. cd R
tests/issue142_record-log.sh view
@@ -24,7 +24,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R # Another script may have left a mess. darcs init --repo R # Create our test repos. cd R
tests/issue1465_ortryrunning.sh view
@@ -1,6 +1,6 @@ #!/usr/bin/env bash ## Test for issue1465 - ortryrunning should try RHS if AND ONLY IF the-## LHS actually failed wasn't found or wasn't executable.+## LHS wasn't found or wasn't executable. ## ## Copyright (C) 2009 Trent W. Buck ##@@ -24,20 +24,63 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.-rm -rf R # Another script may have left a mess.+. lib # Load some portability helpers. darcs init --repo R # Create our test repo.-mkdir R/d # Change the working tree. -# Set the editor to a program that just fails (VISUAL), make Darcs use-# it (--edit), and then make sure when it brokenly launches a fallback-# editor, that editor will exit because stdin isn't a tty (/dev/null).-not env -u TERM DARCS_EDITOR=false VISUAL=false </dev/null &>R/log \-darcs record --repo R -lam 'Initial commit.' --edit+FAKE_EDITOR_HOME=`pwd`+cat <<FAKE > editor-good.hs+import System.Environment+import System.IO+main = getArgs >>= \[name] -> writeFile name "fake"+FAKE+ghc -o editor-good --make editor-good.hs +cat <<FAKE > editor-bad.hs+import System.Exit+main = exitWith (ExitFailure 127)+FAKE+ghc -o editor-bad --make editor-bad.hs++cat <<FAKE > editor-gave-up.hs+import System.Exit+main = exitWith (ExitFailure 1)+FAKE+ghc -o editor-gave-up --make editor-gave-up.hs++cat <<VI > vi.hs+import System.Environment+import System.IO+main = getArgs >>= \[name] -> writeFile name "vi"+VI+ghc -o vi --make vi.hs++cd R+mkdir d+unset TERM++DARCSDIR=$(dirname $(which darcs))+# the /dev/null stdin redirection is to make vi or the fallback editor just fail+DARCS_EDITOR=$FAKE_EDITOR_HOME/editor-good \+darcs record -lam 'Initial commit.' --edit </dev/null &> log-1+darcs changes > changes-1+darcs unrecord -a+grep fake changes-1++# Bad editor: fall through to the next choice+DARCS_EDITOR=$FAKE_EDITOR_HOME/editor-bad \+PATH=.:$DARCSDIR \+darcs record -lam 'Initial commit.' --edit </dev/null &> log-2+darcs changes > changes-2+darcs unrecord -a+grep "Initial" changes-2+egrep -i 'vi|emacs|nano|edit' log-2++# Normal failure (eg. user hit ^-C) # If Darcs did the right thing, the output won't make any mention of # the fallback editors.-# We skip ^\+ since the commandline is logged and matches "edit".-egrep -v '^\+' R/log | not egrep -i 'not found|vi|emacs|nano|edit'--rm -rf R/ # Clean up after ourselves.+DARCS_EDITOR=$FAKE_EDITOR_HOME/editor-gave-up \+darcs record -lam 'Initial commit.' --edit </dev/null &> log-3+darcs changes > changes-3+darcs unrecord -a+grep "Initial" changes-3+not egrep -i 'not found|vi|emacs|nano|edit' log-3
tests/issue1472_read_too_much.sh view
@@ -24,7 +24,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R # Another script may have left a mess. darcs init --repo R # Create our test repo. mkdir R/d/ # Change the working tree.
tests/issue1488_whatsnew-l.sh view
@@ -23,7 +23,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R mkdir -p R/Foo/Bar # 2 directory levels needed
+ tests/issue1558_xml_output_gz_extension.sh view
@@ -0,0 +1,35 @@+#!/usr/bin/env bash+## Test for issue1558 - xml output for patch hash includes "gz"+## extension+##+## Copyright (C) 2010 Gabriel Kerneis+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+darcs init --repo R # Create our test repos.++cd R+mkdir d e # Change the working tree.+echo 'Example content.' > d/f+darcs record -lam 'Add d/f and e.'+darcs changes --xml | not grep "\\.gz"+cd ..
tests/issue1584_optimize_upgrade.sh view
@@ -23,16 +23,14 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R # Another script may have left a mess.-darcs init --repo R --old-fashioned # Create our test repos.-mkdir R/d/ R/e/ # Change the working tree.-echo 'Example content.' >R/d/f-darcs record --repo R -lam 'Add d/f and e.'-darcs mv --repo R d/f e/ # Unrecorded change-darcs whatsnew --repo R | grep 'move ./d/f'+gunzip -c $TESTDATA/many-files--old-fashioned-inventory.tgz | tar xf -+mv many-files--old-fashioned-inventory R++echo x > R/foo # Unrecorded change darcs optimize --repo R --upgrade darcs check --repo R grep hashed R/_darcs/format not grep darcs-2 R/_darcs/format-darcs whatsnew --repo R | grep 'move ./d/f'+darcs whatsnew --repo R | grep 'hunk ./foo 1'
+ tests/issue1599-automatically-expire-unused-caches.sh view
@@ -0,0 +1,57 @@+#!/usr/bin/env bash+## Test for issue1599 - 'Automatically expire unused caches'+##+## Copyright (C) 2010 Adolfo Builes+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.+. lib++skip-formats old-fashioned++rm -rf R S log && mkdir R+cd R+darcs init+echo a > a+darcs rec -lam a+echo b > b+darcs rec -lam b+echo c > c+darcs rec -lam c+cd ..++serve_http # sets baseurl+darcs get --lazy $baseurl/R S+rm S/_darcs/prefs/sources+if [ -z "$http_proxy" ]; then+ echo "repo:http://10.1.2.3/S" >> S/_darcs/prefs/sources+fi+echo "repo:$baseurl/dummyRepo" >> S/_darcs/prefs/sources+echo "repo:~/test1599/S" >> S/_darcs/prefs/sources+echo "repo:$baseurl/R" >> S/_darcs/prefs/sources+darcs changes --repo S --debug --verbose --no-cache 2>&1 | tee log+if [ -z "$http_proxy" ]; then+ c=`grep -c "URL.waitUrl http://10.1.2.3/S" log`+ [ $c -eq 1 ]+fi+c1=`grep -c "URL.waitUrl $baseurl/dummyRepo" log`+[ $c1 -eq 2 ]+c2=`grep -c "~/test1599/S" log`+[ $c2 -eq 1 ]
+ tests/issue1611_amend-tag.sh view
@@ -0,0 +1,42 @@+#!/usr/bin/env bash+## Test for issue1611 - amend-record should prevent adding new changes to a tag.+##+## Copyright (C) 2011 Iago Abal Rivas+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+darcs init --repo R # Create our test repos.++cd R++# Creates a patch+echo 'Example content.' > f+darcs record -lam 'Add f'++darcs tag V1 # Creates a tag++echo 'Another example content.' > f # Edit repository++# Amend the tag should be illegal+echo y | darcs amend -ap 'V1' | not grep 'amending patch'++
tests/issue1618-amend-preserve-logfile.sh view
@@ -25,14 +25,14 @@ ## SOFTWARE. set -ev-. ../tests/lib+. lib rm -rf R; mkdir R; cd R darcs init darcs setpref test false darcs record -am foo --no-test export DARCS_EDITOR="echo 'new log' > "-echo y | not darcs amend -p foo --edit-long-comment --test 2> out+echo yn | not darcs amend -p foo --edit-long-comment --test 2> out # the msg has the format: "Logfile left in filenamehere." LOGFILE=`grep "Logfile left in" out | sed "s/Logfile left in //" | sed s/.$//`
tests/issue1620-record-lies-about-leaving-logfile.sh view
@@ -25,12 +25,12 @@ ## SOFTWARE. set -ev-. ../tests/lib+. lib rm -rf R; mkdir R; cd R export DARCS_EDITOR="echo 'a log' > " darcs init darcs setpref test false-echo yy | not darcs record -m foo -a --edit-long-comment --test 2> out+echo yy| not darcs record -m foo -a --edit-long-comment --test 2> out # the msg has the format: "Logfile left in filenamehere." LOGFILE=`grep "Logfile left in" out | sed "s/Logfile left in //" | sed s/.$//`
tests/issue1636-match-hunk.sh view
@@ -23,7 +23,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R darcs init --repo R # Create our test repos.
+ tests/issue1640_verbose_stdin.sh view
@@ -0,0 +1,58 @@+#!/usr/bin/env bash+## Test for issue1640 - <SYNOPSIS: darcs Issue 1640 darcs apply+## --verbose with no file args should mention stdin>+##+## Copyright (C) 2011 Radoslav Dorcik <dixiecko@gmail.com>+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.++#######################################################+# Test preparation +#######################################################++# Create repository+darcs init --repo S+darcs init --repo T+darcs init --repo T2+cd S+touch foo bar+darcs add foo bar+darcs record -a -m add_foo_bar -A x+darcs send --author=me --output=funpatch -a ../T+++#######################################################+# Apply from stdin and check message+#######################################################++# Message when --verbose+cd ../T+darcs apply --verbose < ../S/funpatch | tee output.txt+grep "reading patch bundle from stdin..." output.txt || exit 1+++# No message when no --verbose+cd ../T2+darcs apply < ../S/funpatch | tee output.txt+grep "reading patch bundle from stdin..." output.txt && exit 1+exit 0;
tests/issue1726_darcs_always-boring.sh view
@@ -25,7 +25,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R # Another script may have left a mess. darcs init --repo R # Create our test repos.
+ tests/issue1737-move_args.sh view
@@ -0,0 +1,38 @@+#!/usr/bin/env bash+## Test for issue1737 - command line filtering on darcs move+## yields suprising results with shell globs+##+## Copyright (C) 2010 Eric Kow+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+rm -rf R # Another script may have left a mess.+darcs init --repo R # Create our test repos.++cd R+mkdir d+touch d.txt+darcs record -lam 'Add d and d.txt'+darcs move d d.txt d 2> log || : # this can happen if eg. you darcs move d* d+# d.txt isn't a directory; we should probably just say that you+# can't move a directory on to itself+not grep "target directory d.txt" log
tests/issue1739-escape-multibyte-chars-correctly.sh view
@@ -23,7 +23,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib+. lib # First, try to see if character set is UTF-8. If we can't find out or if it # isn't, we skip this test.
tests/issue1749-rmdir.sh view
@@ -23,7 +23,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R # Another script may have left a mess. darcs init --repo R cd R
− tests/issue1837_get-partial.sh
@@ -1,44 +0,0 @@-#!/usr/bin/env bash-## Test for issue1837 - darcs get --partial should produce a-## consistent repository-##-## Copyright (C) 2010 Petr Rockai-## Copyright (C) 2010 Eric Kow-##-## Permission is hereby granted, free of charge, to any person-## obtaining a copy of this software and associated documentation-## files (the "Software"), to deal in the Software without-## restriction, including without limitation the rights to use, copy,-## modify, merge, publish, distribute, sublicense, and/or sell copies-## of the Software, and to permit persons to whom the Software is-## furnished to do so, subject to the following conditions:-##-## The above copyright notice and this permission notice shall be-## included in all copies or substantial portions of the Software.-##-## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,-## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF-## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND-## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS-## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN-## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN-## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE-## SOFTWARE.--# not relevant to old-fashioned-if grep old-fashioned .darcs/defaults; then exit 200; fi--. lib # Load some portability helpers.-rm -rf R S # Another script may have left a mess.--tar xzf repos/old-with-checkpoint.tgz--darcs get old-with-checkpoint R-cd R- darcs check-cd ..--darcs get --partial old-with-checkpoint S-cd S- darcs check-cd ..
tests/issue1857-pristine-conversion.sh view
@@ -26,7 +26,7 @@ . lib # Load some portability helpers. rm -rf minimal-darcs-2.4-tar zxf ../tests/repos/minimal-darcs-2.4.tgz+tar zx < $TESTDATA/minimal-darcs-2_4.tgz cd minimal-darcs-2.4 darcs check
tests/issue1871-record-dot.sh view
@@ -2,7 +2,28 @@ ## Test for issue1871 - darcs record . should work for tracked changes ## in a subdirectory even if the subdirectory itself is not known yet. ##-## Public domain - 2010 Eric Kow+## Copyright (C) 2010 Eric Kow+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.+ . lib # Load some portability helpers. rm -rf R # Another script may have left a mess.
tests/issue1879-same-patchinfo-uncommon.sh view
@@ -34,5 +34,5 @@ cd .. cd R-not darcs pull -a ../S > log 2>&1+not darcs pull -a ../S 2>&1 | tee log cd ..
+ tests/issue1909-unrecord-O-misses-tag.sh view
@@ -0,0 +1,20 @@+#!/usr/bin/env bash+## issue1909: unrecord -O in tagged repo makes a busted bundle++. lib++rm -rf R+mkdir R+darcs init --repo R+echo a > R/a+darcs rec -lam a --repo R --ignore-times+darcs tag -m T --repo R+echo b > R/a+darcs rec -lam b --repo R --ignore-times+echo c > R/a+darcs rec -lam c --repo R --ignore-times++darcs unpull -p c -a --repo R -O+cat c.dpatch+grep '^\[b' c.dpatch+grep TAG c.dpatch
+ tests/issue1922-obliterate-o-context.sh view
@@ -0,0 +1,47 @@+#!/usr/bin/env bash+## Test for issue1922 - obliterate -o does not give the right context+##+## Copyright (C) 2010 Florent Becker+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+darcs init --repo R # Create our test repos.++rm -rf x+mkdir x+darcs init --repo x+echo a > x/a+darcs rec -lam a --repo x --ig+echo b > x/a+darcs rec -lam b --repo x --ig+echo a > x/b+darcs rec -lam a2 --repo x --ig+echo b > x/b+darcs rec -lam b2 --repo x --ig+echo c > x/a+darcs rec -lam c --repo x --ig++rm -f foo.dpatch+darcs unpull -a -o foo.dpatch --match 'name a2' --repo x --last 3+cat foo.dpatch+darcs chan --context --repo x+darcs apply foo.dpatch --repo x
+ tests/issue1923-cache-warning.sh view
@@ -0,0 +1,55 @@+#!/usr/bin/env bash+## Test for issue1599 - 'Automatically expire unused caches'+##+## Copyright (C) 2010 Adolfo Builes+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.+. lib++skip-formats old-fashioned++darcs init --repo R+cd R+echo a > a+darcs rec -lam a+cd ..++serve_http+cat <<SOURCES > fake-sources+repo:$baseurl/dummyRepo+repo:/some/bogus/local/path+repo:$baseurl/R+SOURCES+darcs get --lazy R S1 && cp fake-sources S1/_darcs/prefs/sources+darcs get --lazy R S2 && cp fake-sources S2/_darcs/prefs/sources++# make sure we do warn about things that are under your control+darcs changes --verbose --repo S1 --no-cache 2>&1 | tee log-local+c1=`grep -c "$baseurl/dummyRepo" log-local`+[ $c1 -eq 1 ]+c2=`grep -c "/some/bogus/local/path" log-local`+[ $c2 -eq 1 ]++# now what about things that aren't?+darcs changes --verbose --repo $baseurl/S2 --no-cache 2>&1 | tee log-remote+c1=`grep -c "$baseurl/dummyRepo" log-remote`+[ $c1 -eq 1 ] # always under your control+not grep -c "/some/bogus/local/path" log-remote
+ tests/issue1977-darcs-repair.sh view
@@ -0,0 +1,12 @@+#!/usr/bin/env bash++# Issue1977 darcs repair complains when there is no pristine.hashed directory+set -ev+mkdir temp1+cd temp1+darcs init+echo "a" > a+darcs add a+darcs rec -am a+rm -rf _darcs/pristine.hashed/+darcs repair
+ tests/issue1978.sh view
@@ -0,0 +1,35 @@+#!/usr/bin/env bash++. lib++mkdir future+cd future+darcs init+touch titi+darcs add titi+darcs record -am titi+cat > _darcs/format <<EOF+hashed|gobbledygook+darcs-2+EOF+cat _darcs/format+cd ..++if grep 'old-fashioned' .darcs/defaults; then+ exit 200+fi++if grep hashed .darcs/defaults; then+ exit 200+fi++# get future repo: should be ok+darcs get future temp1+cd temp1+darcs changes+touch toto+darcs add toto+darcs record -am 'blah'+cd ..+rm -rf temp1 future+
+ tests/issue2012_send_output_no_address.sh view
@@ -0,0 +1,50 @@+#!/usr/bin/env bash+## Test for issue2012 - darcs send -o shall not print a "will be sent+## to" line+##+## Copyright (C) 2010 Gabriel Kerneis+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++set -ev++. lib++DARCS_EDITOR=echo+export DARCS_EDITOR++mkdir temp1 temp2++cd temp2+darcs init+echo "default@email" > _darcs/prefs/email+cd ..++cd temp1+darcs init+touch foo bar+darcs add foo bar+darcs record -a -m add_foo_bar -A x++darcs send -a -o test.patch ../temp2 2>&1 | not grep "Patch bundle will be sent to: default@email"+darcs send -a -O ../temp2 | not grep "Patch bundle will be sent to: default@email"++cd ..
+ tests/issue2013_send_to_context.sh view
@@ -0,0 +1,57 @@+#!/usr/bin/env bash+## Test for issue2013 - darcs send --context --to shall not ask email address+##+## Copyright (C) 2010 Gabriel Kerneis+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++set -ev++. lib++DARCS_EDITOR=echo+export DARCS_EDITOR++mkdir temp2++cd temp2+darcs init+echo foo > a+darcs record -a -m add_a -A x++# setup test+cd ..+darcs get temp2 temp1++cd temp1+darcs changes --context > context+touch foo bar+darcs add foo bar+darcs record -a -m add_foo_bar -A x++# Test that --to works with send --context+darcs send --author=me -a --to=random@random --sendmail-command='grep "^To: random@random$" %<' --context context++# Test that a default preference will NOT be used when no --to value is specified+echo "default@email" > ../temp2/_darcs/prefs/email+not darcs send --author=me -a --sendmail-command='grep "^To: default@email$" %<' --context context++cd ..
+ tests/issue2035-malicious-subpath.sh view
@@ -0,0 +1,28 @@+#!/usr/bin/env bash+## Test for issue2035 - malicious subpaths+##+## Copyright (C) 2010 Eric Kow <kowey@darcs.net>+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+gunzip -c $TESTDATA/badrepo.tgz | tar xf -+not darcs get badrepo
+ tests/issue2041_dont_add_symlinks.sh view
@@ -0,0 +1,53 @@+#!/usr/bin/env bash+## Test for issue1645 - Since Darcs does not version-contol symlinks,+## it should reject them when a user is trying to 'darcs add' them.+## Thist must hold for both file and directory symlinks.+##+## Copyright (C) 2011 Alexey Levan+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+rm -rf R # Another script may have left a mess.+darcs init --repo R # Create our test repo.++darcs --version++cd R++unset pwd # Since this test is pretty much linux-specific, hspwd.hs is not needed+abort_windows # and skip if we are on win32...++# test for file+touch test-file++ln -s ./test-file ./test-file-link1 # relative symlink+ln -s "`pwd`"/test-file ./test-file-link2 # absolute symlink+not darcs add test-file-link1 # darcs must fail to add symlinks+not darcs add test-file-link2++# test for directory+mkdir test-dir++ln -s ./test-dir ./test-dir-link1+ln -s "`pwd`"/test-dir ./test-dir-link2+not darcs add test-dir-link1+not darcs add test-dir-link2
+ tests/issue2049-dir-case-change.sh view
@@ -0,0 +1,43 @@+#!/usr/bin/env bash+## Test for issue2049 - adding files inside a directory+## that's had a case change.+##+## This is not the exact failure reported in issue2049,+## but was reported by another user on IRC around the+## same time, and is closely related.+##+## Copyright (C) 2011 Sven Strittmatter, Ganesh Sittampalam+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+rm -rf R+darcs init --repo R # Create our test repos.++cd R+mkdir foo+touch foo/bar+darcs add foo -r+# two stage case change so it works on Windows+mv foo fox+mv fox foO+touch foO/bar2+not darcs add foO/bar2
+ tests/issue2049-file-in-boring-dir.sh view
@@ -0,0 +1,33 @@+#!/usr/bin/env bash+## Test for issue2049 - adding files inside a boring directory+##+## Copyright (C) 2011 Iago Abal, Ganesh Sittampalam+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+rm -rf R+darcs init --repo R # Create our test repos.++cd R+mkdir foo~+touch foo~/a.txt+not darcs add foo~/a.txt
+ tests/issue2052-default-unified-diff.sh view
@@ -0,0 +1,40 @@+#!/usr/bin/env bash+## Test for issue2052 - Ensure we use unified Diff by default.+##+## Copyright (C) 2011 Owen Stephens+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++set -ev+. lib # Load some portability helpers.++rm -rf R+darcs init --repo R+cd R+touch a+darcs add a+darcs record -am 'Add a'++echo testing > a++test `darcs diff | grep -c "diff -rN -u"` -eq 1+test `darcs diff --no-unified | grep -c "diff -rN -u"` -eq 0+test `darcs diff --no-unified | grep -c "diff -rN"` -eq 1
tests/issue257.sh view
@@ -1,5 +1,5 @@ #!/usr/bin/env bash-set -ev+. lib rm -rf tempc mkdir tempc
tests/issue27.sh view
@@ -8,14 +8,14 @@ darcs init echo first > a darcs add a-darcs record --pipe --all --patch-name=first <<EOF+darcs record --pipe --all --name=first <<EOF Thu Sep 18 22:37:06 MSD 2008 author EOF echo first > b darcs add b-darcs record --pipe --all --patch-name=first <<EOF+darcs record --pipe --all --name=first <<EOF Thu Sep 18 22:37:06 MSD 2008 author EOF@@ -24,14 +24,14 @@ darcs init darcs pull --all --dont-allow-conflicts ../temp1 echo second >> a-darcs record --pipe --all --patch-name=second <<EOF+darcs record --pipe --all --name=second <<EOF Thu Sep 18 22:37:07 MSD 2008 author EOF cd ../temp1 echo second >> b-darcs record --pipe --all --patch-name=second <<EOF+darcs record --pipe --all --name=second <<EOF Thu Sep 18 22:37:07 MSD 2008 author EOF
− tests/issue612_repo_not_writeable.sh
@@ -1,42 +0,0 @@-#!/usr/bin/env bash--# Test that darcs fails appropriately when the target repo inventory file is not writable.-# See issue612--. lib--abort_windows--if grep old-fashioned .darcs/defaults; then- echo This test does not work with old-fashioned inventories- exit 0-fi--rm -rf temp1 temp2-mkdir temp1-cd temp1-darcs init-touch t.t-darcs add t.t-darcs record -am "initial add"-if [ -e _darcs/inventories ]; then- chmod 0555 _darcs/inventories/*- chmod 0555 _darcs/inventories-fi-if [ -e _darcs/inventory ]; then- chmod 0555 _darcs/inventory-fi-cd ..--darcs get temp1 temp2-cd temp2-echo new >> t.t-darcs record -am "new patch"-not darcs push -a ../r1 2> log-grep failed log-cd ..--chmod -R 0755 temp1-rm -rf temp1 temp2--
tests/issue691.sh view
@@ -5,7 +5,7 @@ mkdir temp cd temp darcs init-echo 'record patch-name' > _darcs/prefs/defaults # patch-name requires an argument+echo 'record name' > _darcs/prefs/defaults # name requires an argument echo 'ALL unified foobar' >> _darcs/prefs/defaults # unified takes no argument darcs record && exit 1 darcs whats && exit 1
tests/issue942_push_apply_prehook.sh view
@@ -25,7 +25,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R S # Another script may have left a mess. darcs init --repo R # Create our test repos. echo 'apply prehook touch g' >R/_darcs/prefs/defaults
tests/lib view
@@ -1,5 +1,4 @@ # This is a -*- sh -*- library.-set -vex -o pipefail ## I would use the builtin !, but that has the wrong semantics. not () { "$@" && exit 1 || :; }@@ -13,8 +12,8 @@ } pwd() {- ghc --make "$TESTS_WD/hspwd.hs"- "$TESTS_WD/hspwd"+ ghc --make -o hspwd "$TESTBIN/hspwd.hs" > /dev/null+ "./hspwd" } # switch locale to latin9 if supported if there's a locale command, skip test@@ -32,3 +31,31 @@ export LC_ALL=$latin9_locale echo "character encoding is now `locale charmap`" }+++serve_http() {+ cat > light.conf <<EOF+ server.document-root = "$PWD"+ server.errorlog = "/dev/null"+ server.port = 23032 ## FIXME+ server.bind = "localhost"+ server.pid-file = "$PWD/light.pid"+EOF+ trap "finish_http \"$PWD\"" EXIT+ lighttpd -f light.conf || exit 200+ ps `cat light.pid` > /dev/null 2>&1 || exit 200+ baseurl="http://localhost:23032"+}++finish_http() {+ test -e "$1/light.pid" && kill `cat "$1/light.pid"` || true+}++skip-formats() {+ for f in "$@"; do grep $f $HOME/.darcs/defaults && exit 200 || true; done+}++grep -q darcs-2 .darcs/defaults && format=darcs-2+grep -q hashed .darcs/defaults && format=hashed++set -vex -o pipefail
tests/merging_newlines.sh view
@@ -3,7 +3,7 @@ # trick: requiring something to fail . lib -# A test for darcs resolve detecting a conflict, inspired by bug #152 in RT+# A test for darcs detecting a conflict, inspired by bug #152 in RT rm -rf temp1 temp2
tests/mv.sh view
@@ -7,7 +7,7 @@ darcs init echo hi world > temp.c darcs add temp.c-darcs record --all -A test --patch-name=hi+darcs record --all -A test --name=hi echo goodbye >> temp.c darcs whatsnew darcs record -a -A au -m bye
tests/mv_and_remove_tests.sh view
@@ -8,7 +8,7 @@ darcs init touch fee fi fo fum darcs add f*-darcs record --author me --all --no-test --patch-name add+darcs record --author me --all --no-test --name add mkdir d darcs add d darcs mv f* d@@ -18,7 +18,7 @@ echo let us have fun > fun darcs add fun darcs mv fun fum ..-darcs record --author me --all --no-test --patch-name mv+darcs record --author me --all --no-test --name mv cd .. if darcs show files | egrep '^./fee$'; then false; else true; fi
tests/mv_then_add.sh view
@@ -8,16 +8,16 @@ darcs init touch fee fi fo fum darcs add f*-darcs record --author me --all --no-test --patch-name add+darcs record --author me --all --no-test --name add darcs mv fee foo touch fee darcs add fee-darcs record --author me --all --no-test --patch-name newfee+darcs record --author me --all --no-test --name newfee darcs mv fi fib-darcs record --author me --all --no-test --patch-name mvfi+darcs record --author me --all --no-test --name mvfi date > fi darcs add fi -darcs record --author me --all --no-test --patch-name newfi+darcs record --author me --all --no-test --name newfi cd ..
+ tests/network/external.sh view
@@ -0,0 +1,37 @@+#!/usr/bin/env bash++# Some tests for launching external commands++. lib++rm -rf temp1++touch_fakessh='./touch-fakessh'+if echo $OS | grep -i windows; then+ touch_fakessh="touch_fakessh.bat"+fi+export DARCS_SSH=$touch_fakessh+export DARCS_SCP=$touch_fakessh+export DARCS_SFTP=$touch_fakessh+rm -rf 'fakessh'+rm -rf 'touch-fakessh'++# make our ssh command one word only+echo 'echo hello > fakessh' > $touch_fakessh+chmod u+x $touch_fakessh+# first test the DARCS_SSH environment variable+not darcs get example.com:foo+grep hello fakessh+rm -f fakessh++# now make sure that we don't launch ssh for nothing+mkdir temp1+cd temp1+darcs init+cd ..+darcs get temp1 > log+not grep fakessh log+not darcs get http://darcs.net/nonexistent+not grep fakessh log+cd ..+rm -rf temp1
tests/network/issue1503_prefer_local_caches_to_remote_one.sh view
@@ -23,7 +23,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib+. lib rm -rf S T darcs get --lazy http://darcs.net/testing/repo1 S
+ tests/network/ssh.sh view
@@ -0,0 +1,143 @@+#!/usr/bin/env bash+set -ev++if [ x${REMOTE_DIR} = x ]; then+ REMOTE_DIR=sshtest+fi++if [ x"${USE_PUTTY}" != x ]; then+ DARCS_SSH=plink+ export DARCS_SSH+ DARCS_SCP=pscp+ export DARCS_SCP+ DARCS_SFTP=psftp+ export DARCS_SFTP+fi++if [ x"${USE_CONTROL_MASTER}" != x ]; then+ DARCS_SSH_FLAGS="--ssh-cm"+ export DARCS_SSH_FLAGS+fi++if [ x"${DARCS_SSH}" = x ]; then+ SSH=ssh+else+ SSH=${DARCS_SSH}+fi++rm -rf tempssh+mkdir tempssh+cd tempssh++cleanup () {+ cd ..+ rm -rf tempssh+}++if [ x${REMOTE} = x ]; then+ echo+ echo "Note: to enable full SSH testing, set REMOTE to some SSH path first,"+ echo " e.g. REMOTE=you@server.org $0"+ cleanup+ exit 200+fi++# ================ Setting up remote repositories ===============+${SSH} ${REMOTE} "\+rm -rf ${REMOTE_DIR}; \+mkdir ${REMOTE_DIR}; \+cd ${REMOTE_DIR}; \+\+mkdir testrepo; cd testrepo; \+darcs init; \+echo moi > _darcs/prefs/author; \+touch a; darcs add a; darcs record a --ignore-times -am 'add file a'; \+echo 'first line' > a; darcs record a --ignore-times -am 'add first line to a'; \+cd ..; \+\+darcs get testrepo testrepo-pull; \+cd testrepo-pull; \+echo moi > _darcs/prefs/author; \+touch b; darcs add b; darcs record b --ignore-times -am 'add file b'; \+echo 'other line' > b; darcs record b --ignore-times -am 'add other line to b'; \+cd ..; \+\+darcs get testrepo testrepo-push; \+darcs get testrepo testrepo-send; \+"++# ================ Settings ===============+echo ${DARCS_SSH_FLAGS}+echo ${DARCS_SSH}+echo ${DARCS_SCP}+echo ${DARCS_SFTP}++# ================ Checking darcs get ==================+${DARCS} get ${DARCS_SSH_FLAGS} ${REMOTE}:${REMOTE_DIR}/testrepo ${DARCS_SSH_FLAGS}+# check that the test repo made it over+[ -d testrepo ]+[ -d testrepo/_darcs ]+[ -f testrepo/a ]++# if the above test is disabled we just init a blank repo+# so that the other tests can continue+if [ ! -d testrepo ]; then+ mkdir testrepo+ cd testrepo+ darcs init+ cd ..+fi++# ================ Checking darcs pull =================+${DARCS} get ${DARCS_SSH_FLAGS} testrepo testrepo-pull+cd testrepo-pull+echo yy | ${DARCS} pull ${DARCS_SSH_FLAGS} ${REMOTE}:${REMOTE_DIR}/testrepo-pull+# see if the changes got pulled over+grep "other line" b++cd ..++# ================ Checking darcs push and send ================="+${DARCS} get ${DARCS_SSH_FLAGS} testrepo testrepo-push+cd testrepo-push+echo moi > _darcs/prefs/author+echo "second line" >> a; ${DARCS} record a --ignore-times -am "add second line to a"+touch c; ${DARCS} add c+${DARCS} record --ignore-times -am "add file c" c+echo yy | ${DARCS} push ${DARCS_SSH_FLAGS} ${REMOTE}:${REMOTE_DIR}/testrepo-push+# check that the file c got pushed over+${SSH} ${REMOTE} "[ -f ${REMOTE_DIR}/testrepo-push/c ]"+echo yy | ${DARCS} send ${DARCS_SSH_FLAGS} ${REMOTE}:${REMOTE_DIR}/testrepo-send -o mybundle.dpatch+# check that the bundle was created+grep "add file c" mybundle.dpatch+cd ..++# ================ Checking darcs put =================="+cd testrepo+${DARCS} put ${DARCS_SSH_FLAGS} ${REMOTE}:${REMOTE_DIR}/testrepo-put+# check that the put was successful+${SSH} ${REMOTE} "[ -d ${REMOTE_DIR}/testrepo-put/_darcs ]"+${SSH} ${REMOTE} "[ -f ${REMOTE_DIR}/testrepo-put/a ]"+cd ..++# ======== Checking push over ssh with a conflict ========="+${SSH} ${REMOTE} "echo apply no-allow-conflicts >> ${REMOTE_DIR}/testrepo-put/_darcs/prefs/defaults"++cd testrepo +echo 'change for remote' > a+darcs record --ignore-times -am 'change for remote'+darcs push -a+darcs ob --last 1 -a+echo 'change for local' > a+darcs record --ignore-times -am 'change for local'++if darcs push -a 2>&1 | grep -q 'conflicts options to apply' ; then+ # do nothing. + echo "OK";+else+ exit 1;+fi++cd ..++cleanup
tests/nfs-failure.sh view
@@ -8,14 +8,14 @@ darcs init echo first > a darcs add a-darcs record --pipe --all --patch-name=first <<EOF+darcs record --pipe --all --name=first <<EOF Thu Sep 18 22:37:06 MSD 2008 author EOF echo first > b darcs add b-darcs record --pipe --all --patch-name=first <<EOF+darcs record --pipe --all --name=first <<EOF Thu Sep 18 22:37:06 MSD 2008 author EOF
+ tests/oldfashioned_refusal.sh view
@@ -0,0 +1,58 @@+#!/usr/bin/env bash++## Test that darcs refuses to work on old-fashioned repositories+## for certain commands.+##+## Copyright (C) 2011 Guillaume Hoffmann+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.++rm -rf old+gunzip -c $TESTDATA/many-files--old-fashioned-inventory.tgz | tar xf -+mv many-files--old-fashioned-inventory old++cd old+not darcs add+not darcs amend+not darcs annotate+not darcs apply+not darcs check+not darcs diff+not darcs dist+not darcs mark+not darcs move+not darcs pull+not darcs push+not darcs put+not darcs record+not darcs remove+not darcs repair+not darcs replace+not darcs revert+not darcs rollback+not darcs send+not darcs setpref+not darcs tag+not darcs trackdown+not darcs unrecord+not darcs unrevert
+ tests/oldfashioned_support.sh view
@@ -0,0 +1,44 @@+#!/usr/bin/env bash++## Test that darcs can get, pull and send (from, to) a remote+## old-fashioned repository.+##+## Copyright (C) 2011 Guillaume Hoffmann+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.++rm -rf old hashed+gunzip -c $TESTDATA/many-files--old-fashioned-inventory.tgz | tar xf -+mv many-files--old-fashioned-inventory old++darcs get old hashed+cd hashed++echo "yyyd" | darcs unpull++darcs pull -a++touch tralala+darcs add tralala+darcs rec -am "patch to be sent"+darcs send -aO
− tests/partial.sh
@@ -1,63 +0,0 @@-#!/usr/bin/env bash--exit 200 # checkpoint creation is not supported by current darcs- # we would need a testdata tarball for this test--# A partial get of a repo shall have the same _darcs/pristine as the original--set -ev--rm -rf temp-mkdir temp-cd temp--# Create a development repo, do some work--darcs initialize --darcs-2-echo ALL ignore-times >> _darcs/prefs/defaults-touch a-darcs add a-darcs record -a -m aa -A x-touch b-darcs add b-darcs record -a -m bb -A x--# Create a release repo, pull the good patches and tag it--mkdir _rel-cd _rel-darcs initialize --darcs-2 -darcs pull -a --patch a ..-darcs tag -m tt -A x-cd ..--# Pull the tag to the devel repo and continue developement--darcs pull -a _rel-touch c-darcs add c-darcs record -a -m cc -A x--# Create a checkpoint and get a partial temp repo--darcs tag -A x --checkpoint first_checkpoint -darcs get --partial . _partial--# We should have all our devel files--cd _partial-cat a-cat b-cat c--# This is a regression test for issue406-darcs tag -A x --checkpoint checkpointing_a_partial--cd ..--# With the darcs-2 format, doing a get on a partial repo succeeds.-# With the darcs-1 format it would be required to add the --partial flag, or darcs would give an error. -darcs get _partial _second_partial--cd ..-rm -rf temp
tests/pending.sh view
@@ -7,7 +7,7 @@ darcs init date > bla darcs add bla-darcs record -a --patch-name=11+darcs record -a --name=11 echo hello > world darcs add world darcs whatsnew --dont-look-for-adds > wn1@@ -17,7 +17,7 @@ date > bla2 date >> bla darcs add bla2-darcs record -a --patch-name=22+darcs record -a --name=22 darcs push -a ../temp cd .. cd temp
tests/prefs.sh view
@@ -4,13 +4,13 @@ rm -rf temp1 temp2 mkdir temp1 cd temp1-darcs initialize --old-fashion+darcs initialize echo ALL ignore-times >> _darcs/prefs/defaults cp _darcs/prefs/boring .boring darcs add .boring darcs setpref boringfile .boring darcs record -a -m p1 -A me cd ..-darcs get --hashed temp1 temp2+darcs get temp1 temp2 cmp temp1/_darcs/prefs/prefs temp2/_darcs/prefs/prefs rm -rf temp1 temp2
tests/pull.sh view
@@ -23,7 +23,7 @@ echo -- darcs pull should pull into repo specified with --repo cd ../.. # now in temp2 darcs add one;-darcs record --patch-name uno --all+darcs record --name uno --all cd .. # now outside of any repo darcs pull --set-default --repodir temp1 --all temp2 | grep -i 'Finished pulling.' # temp2 is not relative to temp1
tests/pull_binary.sh view
@@ -2,6 +2,29 @@ # This test script, originally written by David Roundy and Ian Lynagh is in # the public domain.+#+# This file is included as part of the Darcs test distribution,+# which is licensed to you under the following terms:+#+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE. set -ev
tests/pull_compl.sh view
@@ -1,6 +1,30 @@ #!/usr/bin/env bash -# This test script is in the public domain.+## Public domain 2007 Kevin Quick+##+## This file is included as part of the Darcs test distribution,+## which is licensed to you under the following terms:+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.+ set -ev
tests/pull_conflicts.sh view
@@ -24,7 +24,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R S # Another script may have left a mess. mkdir R
tests/pull_many_files.sh view
@@ -1,5 +1,5 @@ #!/usr/bin/env bash-set -ev+. lib rm -rf temp1 temp2 @@ -11,7 +11,7 @@ mkdir temp2 cd temp2-gunzip -c ../repos/many-files--${format}.tgz | tar xf -+gunzip -c $TESTDATA/many-files--${format}.tgz | tar xf - cd .. mkdir temp1
tests/push-formerly-pl.sh view
@@ -39,7 +39,7 @@ # darcs push should push into repo specified with --repo cd temp2 darcs add one-darcs record --patch-name uno --all+darcs record --name uno --all cd .. darcs push --repodir temp2 --all temp1 | grep -i 'Finished apply'
tests/push.sh view
@@ -8,13 +8,13 @@ echo tester > _darcs/prefs/author date > bla darcs add bla-darcs record -a --patch-name=11+darcs record -a --name=11 cd .. darcs get temp cd temp date > bla2 darcs add bla2-darcs record -a --patch-name=22+darcs record -a --name=22 darcs push -a ../temp_0 cd ..
tests/push_conflicts.sh view
@@ -24,7 +24,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R S # Another script may have left a mess. mkdir R
tests/query_manifest.sh view
@@ -49,7 +49,7 @@ darcs add d/3 d/4 check_manifest "" "" "--no-pending" check_manifest "a b c/1 c/2 d/3 d/4" "c d" "--pending"-darcs record -A test --all --patch-name "patch 1" --skip-long-comment+darcs record -A test --all --name "patch 1" --skip-long-comment check_manifest "a b c/1 c/2 d/3 d/4" "c d" "--no-pending" check_manifest "a b c/1 c/2 d/3 d/4" "c d" "--pending" @@ -65,7 +65,7 @@ darcs mv c/2 c/1 check_manifest "a b c/1 c/2 d/3 d/4" "c d" "--no-pending" check_manifest "a b c/1 e/3 e/4" "c e" "--pending"-darcs record -A test --all --patch-name "patch 2" --skip-long-comment+darcs record -A test --all --name "patch 2" --skip-long-comment check_manifest "a b c/1 e/3 e/4" "c e" "--no-pending" check_manifest "a b c/1 e/3 e/4" "c e" "--pending" @@ -75,7 +75,7 @@ darcs remove c check_manifest "a b c/1 e/3 e/4" "c e" "--no-pending" check_manifest "a b e/3 e/4" "e" "--pending"-darcs record -A test --all --patch-name "patch 3" --skip-long-comment+darcs record -A test --all --name "patch 3" --skip-long-comment check_manifest "a b e/3 e/4" "e" "--no-pending" check_manifest "a b e/3 e/4" "e" "--pending" @@ -83,7 +83,7 @@ darcs mv b2 b3 check_manifest "a b e/3 e/4" "e" "--no-pending" check_manifest "a b3 e/3 e/4" "e" "--pending"-darcs record -A test --all --patch-name "patch 3" --skip-long-comment+darcs record -A test --all --name "patch 3" --skip-long-comment check_manifest "a b3 e/3 e/4" "e" "--no-pending" check_manifest "a b3 e/3 e/4" "e" "--pending"
tests/record_editor.sh view
@@ -29,6 +29,28 @@ cd .. rm -rf temp2\ dir +# make sure summaries are coalesced+mkdir temp3+cd temp3+darcs init+cat > file <<EOF+1+2+3+4+EOF+darcs add file+darcs rec -a -m "init" file+cat > file <<EOF+A+2+3+B+EOF+echo y | darcs record --edit-long-comment -a -m edit | grep -c "./file" | grep 1+cd ..+rm -rf temp2\ dir+ export DARCS_EDITOR='grep "END OF"' # editor: quoting in command mkdir temp1
tests/remove.sh view
@@ -22,7 +22,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib # Load some portability helpers.+. lib # Load some portability helpers. rm -rf R S # Another script may have left a mess. darcs init --repo R # Create our test repos.
tests/replace_after_pending_mv.sh view
@@ -10,7 +10,7 @@ echo a b a b a b > A darcs add A-darcs record --all --patch-name=p1+darcs record --all --name=p1 darcs mv A B if darcs replace a c B | grep Skipping; then exit 1
tests/repoformat.sh view
@@ -2,13 +2,117 @@ . lib -rm -rf temp1 temp2-mkdir temp1-cd temp1+rm -rf garbage future+mkdir garbage+cd garbage darcs init echo gobbledygook > _darcs/format cd .. -not darcs get temp1 temp2 2> log+mkdir future+cd future+darcs init+touch titi+darcs add titi+darcs record -am titi+cat > _darcs/format <<EOF+hashed|gobbledygook+darcs-2+EOF+cd ..+++# check the rules for reading and writing++## garbage repo: we don't understand anything+# get garbage repo+not darcs get garbage temp1 2> log grep -i "can't understand repository format" log-rm -rf temp1 temp2 log+rm -rf temp1 log++# pull from garbage repo+mkdir temp1+cd temp1+darcs init+not darcs pull ../garbage 2> log+grep -i "can't understand repository format" log+cd ..+rm -rf temp1++# apply in garbage repo+mkdir temp1+cd temp1+darcs init+darcs changes --context > empty-context+darcs tag -m "just a patch"+darcs send -a --context=empty-context -o ../bundle.dpatch .+cd ../garbage+not darcs apply ../bundle.dpatch 2> log+grep -i "can't understand repository format" log+cd ..+rm -rf temp1 bundle.dpatch++# add in garbage repo+cd garbage+touch toto+not darcs add toto 2> log+grep -i "can't understand repository format" log+cd ..++rm -rf garbage+++## future repo: we don't understand one+# alternative of a line of format+# only look at future vs darcs2++if grep 'old-fashioned' .darcs/defaults; then+ exit 200+fi++if grep hashed .darcs/defaults; then+ exit 200+fi++# get future repo: ok+# --to-match is needed because of bug###+darcs get future temp1 --to-match "name titi"+cd temp1+darcs changes+touch toto+darcs add toto+darcs record -am 'blah'+cd ..+rm -rf temp1++# pull from future repo: ok+mkdir temp1+cd temp1+darcs init+darcs pull ../future -a+darcs cha | grep titi+cd ..+rm -rf temp1++# apply in future repo: !ok+mkdir temp1+cd temp1+darcs init+darcs changes --context > empty-context+darcs tag -m "just a patch"+darcs send -a --context=empty-context -o ../bundle.dpatch .+cd ../future+not darcs apply ../bundle.dpatch 2> log+cat log+grep -i "can't write repository format" log+cd ..+rm -rf temp1 bundle.dpatch++# record in future repo: !ok+cd future+touch toto+not darcs add toto 2> log+grep -i "can't write repository format" log+cd ..++rm -rf future #No future!
− tests/repos/README
@@ -1,4 +0,0 @@--Larger or more complex pre-built repos are stored here for testing. They are-stored as archives for space efficiency, and to emphasize that they are meant-to be read-only.
− tests/repos/many-files--darcs-2.tgz
binary file changed (250790 → absent bytes)
− tests/repos/many-files--hashed.tgz
binary file changed (169112 → absent bytes)
− tests/repos/many-files--old-fashioned-inventory.tgz
binary file changed (87207 → absent bytes)
− tests/repos/maybench-crc.tgz
binary file changed (114197 → absent bytes)
− tests/repos/minimal-darcs-2.4.tgz
binary file changed (3443 → absent bytes)
− tests/repos/old-with-checkpoint.tgz
binary file changed (3053 → absent bytes)
+ tests/rollback-no-record.sh view
@@ -0,0 +1,67 @@+#!/usr/bin/env bash+## Test for rollback --no-record+##+## Copyright (C) 2010 Florent Becker+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+darcs init --repo R # Create our test repos.+darcs init --repo S++cd R+mkdir d e+echo 'Example content.' > d/f+darcs record -lam 'Add d/f and e.'+darcs mv d/f e/+darcs replace Example Kestatepa e/f+echo "Blih blah bloh" >> e/f+darcs record -am 'Some changes.'++cat <<EOF >> e/f++Kestatepa++EOF++cat e/f+darcs record -am 'one more line in f'+darcs changes --context > context+darcs rollback -a -p 'Some changes' -m 'rollback'+darcs send -a -o rollback.dpatch --context context ../S+darcs obliterate -a -p rollback+darcs rollback -a -p 'Some changes' --no-record+darcs record -am 'rollback'+darcs send -a -o rollback2.dpatch --context context ../S++#check the effects+not ls e/f+ls d/f+grep Example d/f+not grep "Blih" d/f++#check the content of the patches+#"diff rollback.dpatch rollback2.dpatch" fails because of+#the order of the hunks.+grep "replace .* Kestatepa Example" rollback2.dpatch+grep "move ./e/f ./d/f" rollback2.dpatch+grep -e "-Blih blah bloh" rollback2.dpatch+
tests/rollback.sh view
@@ -23,7 +23,7 @@ if darcs whatsnew ; then : Resolve conflict - rollback our patch darcs revert --all- darcs rollback -a --patch-name x0+ darcs rollback -a --name x0 darcs revert --all fi : Create local change and record it
+ tests/send-output-v1.sh view
@@ -0,0 +1,53 @@+#!/usr/bin/env bash++## Test that we produce exactly correct output when sending v1 patches+##+## Copyright (C) 2010 Ganesh Sittampalam+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.++grep old-fashioned $HOME/.darcs/defaults || grep hashed $HOME/.darcs/defaults || exit 200++rm -rf empty+mkdir empty+cd empty+darcs init+cd ..++rm -rf repo+gunzip -c $TESTDATA/simple-v1.tgz | tar xf -+cd repo+darcs send -o repo.dpatch -a ../empty++day=$(grep "<.*@.*>" $TESTDATA/simple-v1.dpatch | head -n 1 | cut -f1-3 -d' ')+diff -u -I'1 patch for repository ' -I'patches for repository ' -I"$day" $TESTDATA/simple-v1.dpatch repo.dpatch+cd ..++# context-v1 tests that we are including some context lines in hunk patches+rm -rf repo+gunzip -c $TESTDATA/context-v1.tgz | tar xf -+cd repo+darcs send -o repo.dpatch -a ../empty+day=$(grep "<.*@.*>" $TESTDATA/context-v1.dpatch | head -n 1 | cut -f1-3 -d' ')+diff -u -I'1 patch for repository ' -I'patches for repository ' -I"$day" $TESTDATA/context-v1.dpatch repo.dpatch+cd ..
+ tests/send-output-v2.sh view
@@ -0,0 +1,54 @@+#!/usr/bin/env bash++## Test that we produce exactly correct output when sending v2 patches+##+## Copyright (C) 2010 Ganesh Sittampalam+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.++grep darcs-2 $HOME/.darcs/defaults || exit 200++rm -rf empty+mkdir empty+cd empty+darcs init+cd ..++rm -rf repo+gunzip -c $TESTDATA/simple-v2.tgz | tar xf -+cd repo+darcs send -o repo.dpatch -a ../empty++day=$(grep "<.*@.*>" $TESTDATA/simple-v2.dpatch | head -n 1 | cut -f1-3 -d' ')+diff -u -I'1 patch for repository ' -I'patches for repository ' -I"$day" $TESTDATA/simple-v2.dpatch repo.dpatch+cd ..++# context-v1 tests that we are including some context lines in hunk patches+rm -rf repo+gunzip -c $TESTDATA/context-v2.tgz | tar xf -+cd repo+darcs send -o repo.dpatch -a ../empty++day=$(grep "<.*@.*>" $TESTDATA/context-v2.dpatch | head -n 1 | cut -f1-3 -d' ')+diff -u -I'1 patch for repository ' -I'patches for repository ' -I"$day" $TESTDATA/context-v2.dpatch repo.dpatch+cd ..
+ tests/set-default-hint.sh view
@@ -0,0 +1,51 @@+#!/usr/bin/env bash+## Test that set-default hint messages are produced at the right times+##+## Copyright (C) 2011 Ganesh Sittampalam+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+rm -rf R1 R2 R3 # Another script may have left a mess.++darcs init --repo R1+darcs get R1 R2+darcs get R1 R3++HINTSTRING="issue the same command with the --set-default flag"++cd R3+for command in pull push send+do+ # R1 should be the default for R3+ darcs $command ../R1 | not grep "$HINTSTRING"+ darcs $command ../R2 | grep "$HINTSTRING"++ # can disable message on the command-line+ darcs $command --no-set-default ../R2 | not grep "$HINTSTRING"++ # or using defaults+ echo "$command no-set-default" >> ../.darcs/defaults+ darcs $command ../R2 | not grep "$HINTSTRING"++ darcs $command --set-default ../R2 | not grep "$HINTSTRING"+ darcs $command --set-default ../R1 | not grep "$HINTSTRING"+done
tests/set_scripts_executable.sh view
@@ -23,7 +23,7 @@ test ! -x script.pl test ! -x nonscript darcs add script.pl nonscript-darcs record --patch-name 'uno' --all+darcs record --name 'uno' --all cd .. # sans --set-scripts-executable (should not be executable)
tests/show-authors.sh view
@@ -1,9 +1,6 @@ #!/usr/bin/env bash set -ev -rm -rf test-mkdir test-cd test darcs init echo zig > foo darcs add foo@@ -24,7 +21,3 @@ darcs show authors --verbose | grep y | wc -l > num-patches cat num-patches grep 2 num-patches--cd ..-rm -rf test-
tests/show-bug.sh view
@@ -3,10 +3,6 @@ ## All these commands SHOULD fail (hence leading NOTs). . lib -rm -rf test-mkdir test-cd test- darcs show bug --debug 1> stdout 2> stderr || true cat stdout@@ -24,7 +20,3 @@ #not grep unable stderr grep 'fake bug' stderr--cd ..-rm -rf test-
+ tests/show_tags-remote.sh view
@@ -0,0 +1,46 @@+#!/usr/bin/env bash+## Test for show tags --repo+##+## Copyright (C) 2010 Eric Kow+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.+darcs init --repo R # Create our test repos.+darcs init --repo S++cd R+echo 'Example content.' > f+darcs record -lam 'Add f'+darcs tag 't0'+darcs tag 't1'+darcs show tags | grep t0+cd ..+serve_http # sets baseurl++cd S+darcs changes --repo ../R+darcs show tags --repo ../R | grep t0+darcs show tags --repo $baseurl/R | grep t0+cd ..++darcs show tags --repo R | grep t0+darcs show tags --repo $baseurl/R | grep t0
+ tests/split-patches.sh view
@@ -0,0 +1,64 @@+#!/usr/bin/env bash++## Test for correct handling of Darcs v1 patches with nested { }+##+## Copyright (C) 2010 Ganesh Sittampalam+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.++if grep old-fashioned .darcs/defaults; then+format=old-fashioned-inventory+patchtype=darcs-1+elif grep darcs-2 .darcs/defaults; then+format=darcs-2+patchtype=darcs-2+elif grep hashed .darcs/defaults; then+format=hashed+patchtype=darcs-1+else exit 200; fi++rm -rf split--${format}+gunzip -c $TESTDATA/split--${format}.tgz | tar xf -+cd split--${format}+darcs check+cd ..++# .dpatch tests: .dpatch files for darcs 2 split patches were+# broken in darcs 2.5 (and probably always broken) so we don't+# bother to test them.++if [ ${patchtype} != darcs-1 ] ; then exit 0 ; fi++rm -rf temp+mkdir temp+cd temp+darcs init+darcs apply $TESTDATA/split--${patchtype}.dpatch+cd ..++rm -rf temp2+mkdir temp2+cd temp2+darcs init+darcs apply $TESTDATA/split2--${patchtype}.dpatch+cd ..
− tests/ssh.sh
@@ -1,143 +0,0 @@-#!/usr/bin/env bash-set -ev--if [ x${REMOTE_DIR} = x ]; then- REMOTE_DIR=sshtest-fi--if [ x"${USE_PUTTY}" != x ]; then- DARCS_SSH=plink- export DARCS_SSH- DARCS_SCP=pscp- export DARCS_SCP- DARCS_SFTP=psftp- export DARCS_SFTP-fi--if [ x"${USE_CONTROL_MASTER}" != x ]; then- DARCS_SSH_FLAGS="--ssh-cm"- export DARCS_SSH_FLAGS-fi--if [ x"${DARCS_SSH}" = x ]; then- SSH=ssh-else- SSH=${DARCS_SSH}-fi--rm -rf tempssh-mkdir tempssh-cd tempssh--cleanup () {- cd ..- rm -rf tempssh-}--if [ x${REMOTE} = x ]; then- echo- echo "Note: to enable full SSH testing, set REMOTE to some SSH path first,"- echo " e.g. REMOTE=you@server.org $0"- cleanup- exit 0 # exit normally in case we are being run from the shell harness-fi--# ================ Setting up remote repositories ===============-${SSH} ${REMOTE} "\-rm -rf ${REMOTE_DIR}; \-mkdir ${REMOTE_DIR}; \-cd ${REMOTE_DIR}; \-\-mkdir testrepo; cd testrepo; \-darcs init; \-echo moi > _darcs/prefs/author; \-touch a; darcs add a; darcs record a --ignore-times -am 'add file a'; \-echo 'first line' > a; darcs record a --ignore-times -am 'add first line to a'; \-cd ..; \-\-darcs get testrepo testrepo-pull; \-cd testrepo-pull; \-echo moi > _darcs/prefs/author; \-touch b; darcs add b; darcs record b --ignore-times -am 'add file b'; \-echo 'other line' > b; darcs record b --ignore-times -am 'add other line to b'; \-cd ..; \-\-darcs get testrepo testrepo-push; \-darcs get testrepo testrepo-send; \-"--# ================ Settings ===============-echo ${DARCS_SSH_FLAGS}-echo ${DARCS_SSH}-echo ${DARCS_SCP}-echo ${DARCS_SFTP}--# ================ Checking darcs get ==================-${DARCS} get ${DARCS_SSH_FLAGS} ${REMOTE}:${REMOTE_DIR}/testrepo ${DARCS_SSH_FLAGS}-# check that the test repo made it over-[ -d testrepo ]-[ -d testrepo/_darcs ]-[ -f testrepo/a ]--# if the above test is disabled we just init a blank repo-# so that the other tests can continue-if [ ! -d testrepo ]; then- mkdir testrepo- cd testrepo- darcs init- cd ..-fi--# ================ Checking darcs pull =================-${DARCS} get ${DARCS_SSH_FLAGS} testrepo testrepo-pull-cd testrepo-pull-echo yy | ${DARCS} pull ${DARCS_SSH_FLAGS} ${REMOTE}:${REMOTE_DIR}/testrepo-pull-# see if the changes got pulled over-grep "other line" b--cd ..--# ================ Checking darcs push and send ================="-${DARCS} get ${DARCS_SSH_FLAGS} testrepo testrepo-push-cd testrepo-push-echo moi > _darcs/prefs/author-echo "second line" >> a; ${DARCS} record a --ignore-times -am "add second line to a"-touch c; ${DARCS} add c-${DARCS} record --ignore-times -am "add file c" c-echo yy | ${DARCS} push ${DARCS_SSH_FLAGS} ${REMOTE}:${REMOTE_DIR}/testrepo-push-# check that the file c got pushed over-${SSH} ${REMOTE} "[ -f ${REMOTE_DIR}/testrepo-push/c ]"-echo yy | ${DARCS} send ${DARCS_SSH_FLAGS} ${REMOTE}:${REMOTE_DIR}/testrepo-send -o mybundle.dpatch-# check that the bundle was created-grep "add file c" mybundle.dpatch-cd ..--# ================ Checking darcs put =================="-cd testrepo-${DARCS} put ${DARCS_SSH_FLAGS} ${REMOTE}:${REMOTE_DIR}/testrepo-put-# check that the put was successful-${SSH} ${REMOTE} "[ -d ${REMOTE_DIR}/testrepo-put/_darcs ]"-${SSH} ${REMOTE} "[ -f ${REMOTE_DIR}/testrepo-put/a ]"-cd ..--# ======== Checking push over ssh with a conflict ========="-${SSH} ${REMOTE} "echo apply no-allow-conflicts >> ${REMOTE_DIR}/testrepo-put/_darcs/prefs/defaults"--cd testrepo -echo 'change for remote' > a-darcs record --ignore-times -am 'change for remote'-darcs push -a-darcs ob --last 1 -a-echo 'change for local' > a-darcs record --ignore-times -am 'change for local'--if darcs push -a 2>&1 | grep -q 'conflicts options to apply' ; then- # do nothing. - echo "OK";-else- exit 1;-fi--cd ..--cleanup
tests/tag.sh view
@@ -9,7 +9,7 @@ darcs init touch one darcs add one-darcs record --patch-name 'uno' --all+darcs record --name 'uno' --all darcs tag soup > log not grep failed log grep TAG log
tests/tentative_revert.sh view
@@ -24,7 +24,7 @@ ## SOFTWARE. set -ev-. ../tests/lib+. lib rm -rf R darcs init --repo R touch R/foo
− tests/trackdown-bisect-helper.hs
@@ -1,38 +0,0 @@-{---Tool for construction of testing repository for trackdown testing-with bisect option. Written by Matthias Fischmann.--Usage:--./trackdown-bisect-helper '[0,1,1,1,0,0,0]'--This will generate a repository in which `grep -q 1 j` will first fail-three times, then succeed three times, then fail once if you unapply-patches with the linear implementation.---}---import Control.Monad-import System.IO-import System-import System.Random-import Data.List-import Control.Exception---stamp i j = system ("echo " ++ show i ++ " > ./i") >>- system ("echo " ++ show j ++ " > ./j") >>- -- system ("sleep 1") >>- hFlush stdout >>- system ("darcs record --ignore-times -am '" ++ show i ++ "'")--generate :: [Int] -> IO ()-generate = mapM_ (uncurry stamp) . zip [1..]--main :: IO ()-main = do- args <- getArgs- let js = (read (head args)) :: [Int]- generate js
tests/trackdown-bisect.sh view
@@ -15,7 +15,7 @@ exit 0 fi -ghc -o trackdown-bisect-helper trackdown-bisect-helper.hs+ghc -o trackdown-bisect-helper $TESTBIN/trackdown-bisect-helper.hs function make_repo_with_test { rm -fr temp1
tests/tricky_unrecord.sh view
@@ -7,19 +7,19 @@ darcs init date > temp.c darcs add temp.c-darcs record --all -A test --patch-name=hi+darcs record --all -A test --name=hi mkdir d darcs add d darcs mv temp.c d/-darcs record --all -A test --patch-name=mvetc+darcs record --all -A test --name=mvetc darcs show contents d/temp.c | cmp d/temp.c - echo y/d/y | tr / \\012 | darcs unrecord darcs whatsnew # darcs show contents d/temp.c | cmp d/temp.c - -darcs record --all -A test --patch-name=again+darcs record --all -A test --name=again darcs show contents d/temp.c | cmp d/temp.c - cd ..
− tests/unrecord.sh
@@ -1,31 +0,0 @@-#!/usr/bin/env bash--set -ev--exit 200 # checkpoint creation is not supported by current darcs- # we would need a testdata tarball for this test--# Check that checkpoints are removed when tags are unrecorded--rm -rf temp1-mkdir temp1-cd temp1-darcs init-echo foo > f-darcs rec -Ax -alm init-darcs tag -Ax --checkpoint t-echo y | darcs unrec -t t-# the complete inventory has only one patch to check-darcs check --complete > out-# The following test fails because the new progress code only-# prints out information on slow commands.-#grep '1 of 1' out >/dev/null--# the checkpoint (if left) has two patches to check-# but it should have been removed-darcs check --partial > out-# The following test fails because the new progress code only-# prints out information on slow commands.-#grep '1 of 1' out >/dev/null-cd ..-rm -rf temp1
tests/utf8.sh view
@@ -23,7 +23,7 @@ ## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ## SOFTWARE. -. ../tests/lib +. lib # Helper function: do a darcs changes --xml and grep the result for the first # argument. If it is not found, exit with status 1. Otherwise, continue. The
+ tests/v1-braced.sh view
@@ -0,0 +1,48 @@+#!/usr/bin/env bash++## Test for correct handling of Darcs v1 patches with nested { }+##+## Copyright (C) 2010 Ganesh Sittampalam+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.++grep hashed $HOME/.darcs/defaults || exit 200++rm -rf braced+gunzip -c $TESTDATA/braced.tgz | tar xf -+cd braced+darcs check+cd ..++rm -rf empty+mkdir empty+cd empty+darcs init+darcs apply $TESTDATA/braced.dpatch+cd ..++cd braced+darcs pull -a ../empty | grep 'No remote changes to pull in'++cd ../empty+darcs pull -a ../braced | grep 'No remote changes to pull in'
tests/whatsnew-pending.sh view
@@ -1,6 +1,29 @@ #!/usr/bin/env bash ## Ensure that darcs whatsnew <paths> only lists relevant bits. ## Public Domain, 2010, Petr Rockai+##+## This file is included as part of the Darcs test distribution,+## which is licensed to you under the following terms:+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE. . lib # Load some portability helpers. rm -rf R # Another script may have left a mess.
+ tests/xmlschema.sh view
@@ -0,0 +1,127 @@+#!/usr/bin/env bash+## Test for XML schema - <SYNOPSIS: Verify that darcs output is valid+## against the XSD and vice versa>+##+## Copyright (C) 2011 Radoslav Dorcik <dixiecko@gmail.com>+##+## Permission is hereby granted, free of charge, to any person+## obtaining a copy of this software and associated documentation+## files (the "Software"), to deal in the Software without+## restriction, including without limitation the rights to use, copy,+## modify, merge, publish, distribute, sublicense, and/or sell copies+## of the Software, and to permit persons to whom the Software is+## furnished to do so, subject to the following conditions:+##+## The above copyright notice and this permission notice shall be+## included in all copies or substantial portions of the Software.+##+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS+## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN+## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+## SOFTWARE.++. lib # Load some portability helpers.++repod="$TESTDATA/../../"+xsdf="$repod/contrib/darcs.xsd"+tmpf="changes_tmp.xml"++if [ -z "$(which xmllint)" ]; then+ echo this test does not work on this machine+ echo it needs xmllint for XML validation.+ exit 200+fi++if [ ! -d "$repod/_darcs" ]; then+ echo this test does not work on this machine+ echo it needs source repo+ exit 200+fi++if [ ! -f "$xsdf" ]; then+ echo this test does not work on this machine+ echo it needs $(basename $xsdf)+ exit 200+fi++#######################################################+# Test preparation +#######################################################++# Create repository with all kind of operations+darcs init --repo R # Create our test repos.+cd R++# Add File and Dir+mkdir dir1 dir2+echo "Example content." > dir1/file1+echo "Example content." > dir2/file2+darcs record -lam 'Add dir1 and dir2'+# Modify (add)+echo "Example content." >> dir1/file1+echo "Example content." >> dir2/file2+echo "Example content." >> dir1/file1+echo "Example content." >> dir2/file2+darcs record -lam 'Modify dir1 and dir2 (add)'+# Modify (add,del)+echo "Example content." > dir1/file1+echo "Example content." > dir2/file2+echo "Example contentx." >> dir1/file1+echo "Example contentx." >> dir2/file2+darcs record -lam 'Modify dir1 and dir2 (add,del)'+# Replace +darcs replace contentx contenty dir1/file1 dir2/file2+darcs record -lam 'Replace contentx contenty'+# Modify (del)+echo "Example content." > dir1/file1+echo "Example content." > dir2/file2+darcs record -lam 'Modify dir1 and dir2 (del)'+# Moving+darcs mv dir1 dir11+darcs mv dir2 dir22+darcs record -lam 'Move dir1 and dir2'+# Remove+rm -fr dir11+rm -fr dir22+darcs record -lam 'Remove dir1 and dir2'+# Complex patch Replace and Modify, Add and Delete+mkdir dir3 dir4+echo "Example contentx." >> dir3/file3+echo "Example contentx." >> dir3/file3+echo "Example contentx." >> dir3/file3+echo "Example contentz." >> dir3/file3+echo "Example contentx." >> dir4/file4+darcs record -lam 'Complex patch (prep)'+darcs replace contentx contenty dir3/file3+mkdir dir5+echo "Example contentx." >> dir5/file4+darcs mv dir3 dir7+echo "Example contentx." >> dir7/file3+darcs record -lam 'Complex patch (done)'+rm -fr dir4++cd ..++#######################################################+# Testing +#######################################################+# Darcs produces XMLs with non-UTF8 characters. +echo '<?xml version="1.0" encoding="ISO-8859-1"?>' > $tmpf+darcs log -s --xml-output --repodir=R >> $tmpf+xmllint --noout --schema $xsdf $tmpf || exit 1++echo '<?xml version="1.0" encoding="ISO-8859-1"?>' > $tmpf+darcs log --xml-output --repodir=R >> $tmpf+xmllint --noout --schema $xsdf $tmpf || exit 1++exit 0; # Comment this out for next long running tests ++## Next tests are disabled by default because they are long running (~10 minutes)+## But they are be helpfull for manual verifications+echo '<?xml version="1.0" encoding="ISO-8859-1"?>' > $tmpf+darcs log --xml-output -s --repodir=$repod >> $tmpf+xmllint --noout --schema $xsdf $tmpf || exit 1