darcs 2.14.2 → 2.14.3
raw patch · 53 files changed
+330/−275 lines, 53 filesdep ~QuickCheckdep ~arraydep ~basesetup-changednew-uploader
Dependency ranges changed: QuickCheck, array, base, bytestring, containers, directory, filepath, hashable, haskeline, mtl, network, shelly, text, transformers, zip-archive
Files
- CHANGELOG +8/−0
- README.md +27/−1
- Setup.hs +29/−7
- darcs.cabal +54/−53
- harness/Darcs/Test/Patch/Arbitrary/PrimFileUUID.hs +1/−2
- harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs +1/−1
- harness/Darcs/Test/Patch/Check.hs +113/−142
- harness/Darcs/Test/Patch/Examples/Set1.hs +1/−0
- harness/Darcs/Test/Patch/Examples/Set2Unwitnessed.hs +0/−1
- harness/Darcs/Test/Patch/FileUUIDModel.hs +1/−1
- harness/Darcs/Test/Patch/Properties/Check.hs +10/−11
- harness/Darcs/Test/Patch/Properties/RepoPatchV2.hs +1/−0
- harness/Darcs/Test/Patch/RepoModel.hs +0/−4
- release/distributed-context +1/−1
- src/Darcs/Patch/Bundle.hs +1/−1
- src/Darcs/Patch/Depends.hs +1/−1
- src/Darcs/Patch/Info.hs +1/−1
- src/Darcs/Patch/Match.hs +4/−4
- src/Darcs/Patch/Named.hs +1/−1
- src/Darcs/Patch/Named/Wrapped.hs +1/−1
- src/Darcs/Patch/PatchInfoAnd.hs +8/−1
- src/Darcs/Patch/Prim/Class.hs +0/−1
- src/Darcs/Patch/Prim/FileUUID/Read.hs +4/−3
- src/Darcs/Patch/Prim/FileUUID/Show.hs +1/−1
- src/Darcs/Patch/Prim/V1/Apply.hs +3/−4
- src/Darcs/Patch/Prim/V1/Commute.hs +4/−0
- src/Darcs/Patch/Prim/V1/Show.hs +1/−1
- src/Darcs/Patch/ReadMonads.hs +1/−1
- src/Darcs/Patch/Summary.hs +1/−1
- src/Darcs/Patch/V1/Commute.hs +4/−0
- src/Darcs/Prelude.hs +4/−3
- src/Darcs/Repository/Diff.hs +1/−1
- src/Darcs/Repository/Inventory.hs +1/−1
- src/Darcs/Repository/Match.hs +1/−1
- src/Darcs/Repository/PatchIndex.hs +12/−3
- src/Darcs/Repository/Pending.hs +2/−2
- src/Darcs/Repository/State.hs +7/−2
- src/Darcs/UI/Commands/Convert.hs +1/−1
- src/Darcs/UI/Commands/Diff.hs +2/−0
- src/Darcs/UI/Commands/Log.hs +1/−1
- src/Darcs/UI/Commands/MarkConflicts.hs +2/−1
- src/Darcs/UI/Commands/Optimize.hs +1/−1
- src/Darcs/UI/Commands/Replace.hs +1/−1
- src/Darcs/UI/Commands/Send.hs +1/−1
- src/Darcs/UI/Commands/Unrecord.hs +1/−1
- src/Darcs/UI/Commands/Util.hs +2/−2
- src/Darcs/UI/Email.hs +1/−1
- src/Darcs/Util/Diff/Patience.hs +1/−0
- src/Darcs/Util/Lock.hs +1/−1
- src/Darcs/Util/Printer/Color.hs +1/−1
- src/Darcs/Util/Text.hs +1/−1
- src/Darcs/Util/Tree.hs +0/−1
- src/Darcs/Util/Tree/Monad.hs +2/−2
CHANGELOG view
@@ -1,3 +1,11 @@+Darcs 2.14.3, 24 April 2020++ * Support for GHC 8.8 and GHC 8.10+ * Loosen upper bounds for a few dependencies+ * mitigate issue 2643 (corrupt patch index) with a better error message+ * remove our own optimisation settings in darcs.cabal+ * Setup.hs: allow use of darcs as a cabal subproject+ Darcs 2.14.2, 26 January 2019 * Support GHC 8.6 (Ganesh Sittampalam)
README.md view
@@ -10,7 +10,33 @@ Compiling --------- -Build instructions are available at <http://darcs.net/Binaries>.+Build instructions are available at <http://darcs.net/Binaries> but they may+not be up-to-date.++Here is a quick run down. The easiest way to build darcs is by using+cabal-install version 3.2 or later. A plain++> cabal build++should work out of the box with any ghc-8.x version. You may see some cabal+warnings. Ignore them. If you want to run the tests, you need++> cabal build --enable-tests++This can be made permanent by using++> cabal configure --enable-tests++before building, which is useful mainly for development. Or you can combine+building and testing:++> cabal test --test-show-details=streaming++You can also run++> cabal install++to install the library and the executable. Using -----
Setup.hs view
@@ -1,7 +1,8 @@ -- copyright (c) 2008 Duncan Coutts -- portions copyright (c) 2008 David Roundy -- portions copyright (c) 2007-2009 Judah Jacobson-+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# LANGUAGE CPP #-} import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) import Distribution.ModuleName( toFilePath )@@ -21,17 +22,26 @@ import Distribution.Simple.Setup (buildVerbosity, copyDest, copyVerbosity, fromFlag, haddockVerbosity, installVerbosity, sDistVerbosity, replVerbosity )+#if MIN_VERSION_Cabal(3,0,0)+import Distribution.Simple.BuildPaths ( autogenPackageModulesDir )+#else import Distribution.Simple.BuildPaths ( autogenModulesDir )+#endif import Distribution.System ( OS(Windows), buildOS ) import Distribution.Simple.Utils (copyFiles, createDirectoryIfMissingVerbose, rawSystemStdout,- rewriteFile )+#if MIN_VERSION_Cabal(3,0,0)+ rewriteFileEx+#else+ rewriteFile+#endif+ ) import Distribution.Verbosity- ( Verbosity )+ ( Verbosity, silent ) import Distribution.Text ( display )-import Control.Monad ( unless, void )+import Control.Monad ( unless, void, when ) import System.Directory ( doesDirectoryExist, doesFileExist )@@ -48,6 +58,11 @@ import qualified Control.Exception as Exception +#if MIN_VERSION_Cabal(3,0,0)+autogenModulesDir = autogenPackageModulesDir+rewriteFile = rewriteFileEx silent+#endif+ catchAny :: IO a -> (Exception.SomeException -> IO a) -> IO a catchAny f h = Exception.catch f (\e -> h (e :: Exception.SomeException)) @@ -70,6 +85,7 @@ postInst = \ _ flags pkg lbi -> installManpage pkg lbi (fromFlag $ installVerbosity flags) NoCopyDest, +#if !MIN_VERSION_Cabal(3,0,0) sDistHook = \ pkg lbi hooks flags -> do let pkgVer = packageVersion pkg verb = fromFlag $ sDistVerbosity flags@@ -85,6 +101,7 @@ sDistHook simpleUserHooks pkg' lbi hooks flags ,+#endif postConf = \_ _ _ _ -> return () --- Usually this checked for external C --- dependencies, but we already have performed such --- check in the confHook@@ -137,13 +154,18 @@ buildManpage lbi = do let darcs = buildDir lbi </> "darcs/darcs" manpage = buildDir lbi </> "darcs/darcs.1"- manpageHandle <- openFile manpage WriteMode- void $ runProcess darcs ["help","manpage"]+ darcsExists <- doesFileExist darcs+ when darcsExists $ do+ manpageHandle <- openFile manpage WriteMode+ void $ runProcess darcs ["help","manpage"] Nothing Nothing Nothing (Just manpageHandle) Nothing installManpage :: PackageDescription -> LocalBuildInfo -> Verbosity -> CopyDest -> IO ()-installManpage pkg lbi verbosity copy =+installManpage pkg lbi verbosity copy = do+ let manpage = buildDir lbi </> "darcs/darcs.1"+ manpageExists <- doesFileExist manpage+ when manpageExists $ do copyFiles verbosity (mandir (absoluteInstallDirs pkg lbi copy) </> "man1") [(buildDir lbi </> "darcs", "darcs.1")]
darcs.cabal view
@@ -1,5 +1,6 @@+cabal-version: 1.24 Name: darcs-version: 2.14.2+version: 2.14.3 License: GPL-2 License-file: COPYING Author: David Roundy <droundy@darcs.net>, <darcs-devel@darcs.net>@@ -33,29 +34,37 @@ Homepage: http://darcs.net/ Build-Type: Custom-Cabal-Version: >= 1.24 extra-source-files:- -- C headers+ -- C files+ src/*.c src/*.h- src/win32/send_email.h src/win32/sys/mman.h+ src/win32/send_email.c+ src/win32/send_email.h+ src/win32/sys/mman.h - -- The contrib directory would make a sensible 'darcs-contrib' package- contrib/_darcs.zsh, contrib/darcs_completion,- contrib/cygwin-wrapper.bash, contrib/update_roundup.pl, contrib/upload.cgi,- contrib/darcs-errors.hlint,- contrib/runHLint.sh,+ contrib/cygwin-wrapper.bash+ contrib/darcs_completion+ contrib/darcs-errors.hlint+ contrib/_darcs.zsh+ contrib/runHLint.sh+ contrib/update_roundup.pl+ contrib/upload.cgi - README.md, CHANGELOG+ README.md+ CHANGELOG -- release data- release/distributed-version, release/distributed-context+ release/distributed-version+ release/distributed-context -- testsuite- tests/data/*.tgz tests/data/README+ tests/data/*.tgz+ tests/data/README tests/data/*.dpatch tests/data/example_binary.png- tests/data/convert/darcs1/*.dpatch tests/data/convert/darcs2/*.dpatch+ tests/data/convert/darcs1/*.dpatch+ tests/data/convert/darcs2/*.dpatch tests/*.sh tests/README.test_maintainers.txt tests/bin/*.hs@@ -93,15 +102,11 @@ flag executable description: Build darcs executable default: True+ manual: True flag rts default: False --- 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 manual: True@@ -112,7 +117,7 @@ -- ---------------------------------------------------------------------- custom-setup- setup-depends: base >= 4.9 && < 4.13,+ setup-depends: base >= 4.9 && < 4.15, Cabal >= 1.24, process >= 1.2.3.0 && < 1.7, filepath >= 1.4.1 && < 1.5.0.0,@@ -352,6 +357,7 @@ Darcs.Util.URL Darcs.Util.Workaround + autogen-modules: Version other-modules: Version Darcs.Util.Download.Curl @@ -380,7 +386,7 @@ else build-depends: unix >= 2.7.1.0 && < 2.8 - build-depends: base >= 4.9 && < 4.13,+ build-depends: base >= 4.9 && < 4.15, stm >= 2.1 && < 2.6, binary >= 0.5 && < 0.10, containers >= 0.5.6.2 && < 0.7,@@ -393,7 +399,7 @@ graphviz >= 2999.18.1 && < 2999.20.1, html >= 1.0.1.2 && < 1.1, filepath >= 1.4.1 && < 1.5.0.0,- haskeline >= 0.7.2 && < 0.8,+ haskeline >= 0.7.2 && < 0.9, cryptohash >= 0.11 && < 0.12, base16-bytestring >= 0.1 && < 0.2, utf8-string >= 1 && < 1.1,@@ -403,7 +409,7 @@ attoparsec >= 0.13.0.1 && < 0.14, zip-archive >= 0.3 && < 0.5, async >= 2.0.2 && < 2.3,- sandi >= 0.4 && < 0.5,+ sandi >= 0.4 && < 0.6, unix-compat >= 0.4.2 && < 0.6, bytestring >= 0.10.6 && < 0.11, old-time >= 1.1.0.3 && < 1.2,@@ -413,18 +419,13 @@ process >= 1.2.3.0 && < 1.7, array >= 0.5.1.0 && < 0.6, random >= 1.1 && < 1.2,- hashable >= 1.2.3.3 && < 1.3,+ hashable >= 1.2.3.3 && < 1.4, mmap >= 0.5.9 && < 0.6, zlib >= 0.6.1.2 && < 0.7.0.0, network-uri == 2.6.*,- network >= 2.6 && < 2.9,+ network >= 2.6 && < 3.2, HTTP >= 4000.2.20 && < 4000.4 - if flag(optimize)- ghc-options: -O2- else- ghc-options: -O0- if flag(warn-as-error) ghc-options: -Werror @@ -476,14 +477,12 @@ main-is: darcs.hs hs-source-dirs: darcs - if flag(optimize)- ghc-options: -O2- else- ghc-options: -O0- if flag(warn-as-error) ghc-options: -Werror + if impl(ghc >= 8.2)+ ghc-options: -Wno-missing-home-modules+ ghc-options: -Wall -funbox-strict-fields -fwarn-tabs if flag(threaded)@@ -498,8 +497,7 @@ -- see http://bugs.darcs.net/issue1037 cc-options: -D_REENTRANT - build-depends: darcs,- base >= 4.9 && < 4.13+ build-depends: darcs, base -- ---------------------------------------------------------------------- -- unit test driver@@ -517,26 +515,31 @@ build-depends: Win32 >= 2.3.1 && < 2.4 build-depends: darcs,- base >= 4.9 && < 4.13,- array >= 0.5.1.0 && < 0.6,- bytestring >= 0.10.6 && < 0.11,+ base,+ array,+ bytestring, cmdargs >= 0.10.10 && < 0.11,- containers >= 0.5.6.2 && < 0.7,- filepath >= 1.4.1 && < 1.5.0.0,- mtl >= 2.2.1 && < 2.3,- shelly >= 1.6.8 && < 1.9,+ containers,+ filepath,+ mtl,+ transformers,+ shelly >= 1.6.8 && < 1.10, split >= 0.2.2 && < 0.3,- text >= 1.2.1.3 && < 1.3,- directory >= 1.2.6.2 && < 1.4,+ text,+ directory, FindBin >= 0.0.5 && < 0.1,- QuickCheck >= 2.8.2 && < 2.13,+ QuickCheck >= 2.8.2 && < 2.14, HUnit >= 1.3 && < 1.7, test-framework >= 0.8.1.1 && < 0.9, test-framework-hunit >= 0.3.0.2 && < 0.4, test-framework-quickcheck2 >= 0.3.0.3 && < 0.4,- zip-archive >= 0.3 && < 0.5+ zip-archive - -- https://github.com/yesodweb/Shelly.hs/issues/177+ -- note for windows we can't allow 1.9 or above until+ -- https://github.com/gregwebs/Shelly.hs/issues/176+ -- and possibly+ -- https://github.com/gregwebs/Shelly.hs/issues/177+ -- are dealt with if os(windows) build-depends: shelly < 1.7.2 @@ -575,13 +578,11 @@ Darcs.Test.Util.TestResult Darcs.Test.Util.QuickCheck - if flag(optimize)- ghc-options: -O2- else- ghc-options: -O0- if flag(warn-as-error) ghc-options: -Werror++ if impl(ghc >= 8.2)+ ghc-options: -Wno-missing-home-modules ghc-options: -Wall -funbox-strict-fields -fwarn-tabs -fno-warn-orphans
harness/Darcs/Test/Patch/Arbitrary/PrimFileUUID.hs view
@@ -27,9 +27,8 @@ import Darcs.Patch.Prim -import Control.Applicative ( (<$>) ) import qualified Data.ByteString as B-import Data.Maybe ( isJust )+import Data.Maybe ( fromJust, isJust ) import qualified Data.Map as M import Darcs.Util.Hash( Hash(..) )
harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs view
@@ -36,7 +36,7 @@ import Darcs.Patch.Apply ( ApplyState ) import qualified Data.ByteString.Char8 as BC-import Data.Maybe ( isJust )+import Data.Maybe ( fromJust, isJust ) type Prim1 = V1.Prim type Prim2 = V2.Prim
harness/Darcs/Test/Patch/Check.hs view
@@ -15,26 +15,24 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. -{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Darcs.Test.Patch.Check ( PatchCheck(), doCheck, fileExists, dirExists,+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}+module Darcs.Test.Patch.Check ( PatchCheck, doCheck, fileExists, dirExists, removeFile, removeDir, createFile, createDir,- insertLine, deleteLine, isValid, doVerboseCheck,+ insertLine, deleteLine, isValid, fileEmpty,- checkMove, modifyFile, FileContents(..)+ checkMove, modifyFile, FileContents(..),+ inconsistent, handleInconsistent ) where import Prelude () import Darcs.Prelude -import System.IO.Unsafe ( unsafePerformIO ) import qualified Data.ByteString as B (ByteString) import Data.List ( isPrefixOf, inits )-import Control.Monad.State ( State, evalState, runState )+import Control.Monad.State ( State, evalState )+import Control.Monad.Trans.Maybe ( MaybeT(..) ) import Control.Monad.State.Class ( get, put, modify, MonadState )-import Control.Monad.Fail ( MonadFail(fail) )--- use Map, not IntMap, because Map has mapKeys and IntMap hasn't-import Data.Map ( Map )-import qualified Data.Map as M ( mapKeys, delete, insert, empty, lookup, null )+import qualified Data.IntMap as M ( IntMap, mapKeys, delete, insert, empty, lookup, null ) import System.FilePath ( joinPath, splitDirectories ) -- | File contents are represented by a map from line numbers to line contents.@@ -43,39 +41,47 @@ -- We must also store the greatest line number that is known to exist in a -- file, to be able to exclude the possibility of it being empty without -- knowing its contents.-data FileContents = FC { fcLines :: Map Int B.ByteString+data FileContents = FC { fcLines :: M.IntMap B.ByteString , fcMaxline :: Int } deriving (Eq, Show) data Prop = FileEx String | DirEx String | NotEx String | FileLines String FileContents deriving (Eq)--- | A @KnownState@ is a simulated repository state. The repository is either--- inconsistent, or it has two lists of properties: one list with properties--- that hold for this repo, and one with properties that do not hold for this--- repo. These two lists may not have any common elements: if they had, the--- repository would be inconsistent.-data KnownState = P [Prop] [Prop]- | Inconsistent- deriving (Show)+ instance Show Prop where show (FileEx f) = "FileEx "++f show (DirEx d) = "DirEx "++d 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.+-- | A simulated repository state. The repository is assumed to be+-- consistent, and it has two lists of properties: one list with properties+-- that hold for this repo, and one with properties that do not hold for this+-- repo. These two lists may not have any common elements: if they had, the+-- repository would be inconsistent.+data ValidState = P [Prop] [Prop] deriving Show -- | PatchCheck is a state monad with a simulated repository state-newtype PatchCheck a = PatchCheck { runPatchCheck :: State KnownState a }- deriving (Functor, Applicative, Monad, MonadState KnownState)+newtype PatchCheck a = PatchCheck { runPatchCheck :: MaybeT (State ValidState) a }+ deriving (Functor, Applicative, Monad, MonadState ValidState) -instance MonadFail PatchCheck where- fail = error+-- The existing instance definitions in Control.Monad.Except make it+-- impossible to provide an 'instance MonadError () (MaybeT m)'. +throwPC :: PatchCheck a+throwPC = PatchCheck $ MaybeT $ return Nothing++catchPC :: PatchCheck a -> PatchCheck a -> PatchCheck a+PatchCheck m `catchPC` h =+ PatchCheck $ MaybeT $ do+ a <- runMaybeT m+ case a of+ Nothing -> runMaybeT (runPatchCheck h)+ Just r -> return (Just r)++inconsistent :: PatchCheck ()+inconsistent = throwPC+ -- | The @FileContents@ structure for an empty file emptyFilecontents :: FileContents emptyFilecontents = FC M.empty 0@@ -85,41 +91,30 @@ handleInconsistent :: a -- ^ The value to return if the state is inconsistent -> PatchCheck a -- ^ The action to perform otherwise -> PatchCheck a-handleInconsistent v a = do state <- get- case state of- Inconsistent -> return v- _ -> a--doCheck :: PatchCheck a -> a-doCheck p = evalState (runPatchCheck p) (P [] [])+handleInconsistent v a = a `catchPC` return v --- | Run a check, and print the final repository state-doVerboseCheck :: PatchCheck a -> a-doVerboseCheck p =- case runState (runPatchCheck p) (P [] []) of- (b, pc) -> unsafePerformIO $ do print pc- return b+doCheck :: PatchCheck a -> Bool+doCheck p =+ evalState (maybe False (const True) <$> runMaybeT (runPatchCheck p)) (P [] []) --- | Returns true if the current repository state is not inconsistent-isValid :: PatchCheck Bool-isValid = handleInconsistent False (return True)+isValid :: PatchCheck ()+isValid = return () has :: Prop -> [Prop] -> Bool has _ [] = False has k (k':ks) = k == k' || has k ks modifyFile :: String- -> (Maybe FileContents -> Maybe FileContents)- -> PatchCheck Bool+ -> (Maybe FileContents -> Maybe FileContents)+ -> PatchCheck () modifyFile f change = do- _ <- fileExists f+ fileExists f c <- fileContents f case change c of Nothing -> assertNot $ FileEx f -- shorthand for "FAIL"- Just c' -> do setContents f c'- isValid+ Just c' -> setContents f c' -insertLine :: String -> Int -> B.ByteString -> PatchCheck Bool+insertLine :: String -> Int -> B.ByteString -> PatchCheck () insertLine f n l = do c <- fileContents f case c of@@ -129,11 +124,10 @@ lines'' = M.insert n l lines' maxline' = max n (fcMaxline c') setContents f (FC lines'' maxline')- return True -- deletes a line from a hunk patch (third argument) in the given file (first -- argument) at the given line number (second argument)-deleteLine :: String -> Int -> B.ByteString -> PatchCheck Bool+deleteLine :: String -> Int -> B.ByteString -> PatchCheck () deleteLine f n l = do c <- fileContents f case c of@@ -145,9 +139,7 @@ maxlinenum' | n <= fcMaxline c' = fcMaxline c' - 1 | otherwise = n - 1 c'' = FC flines' maxlinenum'- do_delete = do- setContents f c''- isValid+ do_delete = setContents f c'' in case M.lookup n flines of Nothing -> do_delete Just l' -> if l == l'@@ -155,7 +147,7 @@ else assertNot $ FileEx f setContents :: String -> FileContents -> PatchCheck ()-setContents f c = handleInconsistent () $ do+setContents f c = do P ks nots <- get let ks' = FileLines f c : filter (not . is_file_lines_for f) ks put (P ks' nots)@@ -166,7 +158,7 @@ -- | Get (as much as we know about) the contents of a file in the current state. -- Returns Nothing if the state is inconsistent. fileContents :: String -> PatchCheck (Maybe FileContents)-fileContents f = handleInconsistent Nothing $ do+fileContents f = do P ks _ <- get return (fic ks) where fic (FileLines f' c:_) | f == f' = Just c@@ -174,19 +166,16 @@ fic [] = Just emptyFilecontents -- | Checks if a file is empty-fileEmpty :: String -- ^ Name of the file to check- -> PatchCheck Bool+fileEmpty :: String -> PatchCheck () fileEmpty f = do c <- fileContents f let empty = case c of Just c' -> fcMaxline c' == 0 && M.null (fcLines c') Nothing -> True- _ <- if empty- then do setContents f emptyFilecontents- isValid+ if empty+ then setContents f emptyFilecontents -- Crude way to make it inconsistent and return false: else assertNot $ FileEx f- return empty movedirfilename :: String -> String -> String -> String movedirfilename d d' f@@ -196,10 +185,8 @@ -- | Replaces a filename by another in all paths. Returns True if the repository -- is consistent, False if it is not.-doSwap :: String -> String -> PatchCheck Bool-doSwap f f' = handleInconsistent False $ do- modify map_sw- return True+doSwap :: String -> String -> PatchCheck ()+doSwap f f' = modify map_sw where sw (FileEx a) | f `is_soe` a = FileEx $ movedirfilename f f' a | f' `is_soe` a = FileEx $ movedirfilename f' f a sw (DirEx a) | f `is_soe` a = DirEx $ movedirfilename f f' a@@ -212,124 +199,108 @@ is_soe d1 d2 = -- is_superdir_or_equal d1 == d2 || (d1 ++ "/") `isPrefixOf` d2 map_sw (P ks nots) = P (map sw ks) (map sw nots)- map_sw _ = impossible -- | Assert a property about the repository. If the property is already present -- in the repo state, nothing changes, and the function returns True. If it is -- not present yet, it is added to the repo state, and the function is True. If -- the property is already in the list of properties that do not hold for the -- repo, the state becomes inconsistent, and the function returns false.-assert :: Prop -> PatchCheck Bool-assert p = handleInconsistent False $ do+assert :: Prop -> PatchCheck ()+assert p = do P ks nots <- get if has p nots- then do- put Inconsistent- return False+ then inconsistent else if has p ks- then return True- else do- put (P (p:ks) nots)- return True+ then isValid+ else put (P (p:ks) nots) -- | Like @assert@, but negatively: state that some property must not hold for -- the current repo.-assertNot :: Prop -> PatchCheck Bool-assertNot p = handleInconsistent False $ do+assertNot :: Prop -> PatchCheck ()+assertNot p = do P ks nots <- get if has p ks- then do- put Inconsistent- return False+ then inconsistent else if has p nots- then return True- else do- put (P ks (p:nots))- return True+ then isValid+ else put (P ks (p:nots)) -- | Remove a property from the list of properties that do not hold for this -- repo (if it's there), and add it to the list of properties that hold. -- Returns False if the repo is inconsistent, True otherwise.-changeToTrue :: Prop -> PatchCheck Bool-changeToTrue p = handleInconsistent False $ do- modify filter_nots- return True- where filter_nots (P ks nots) = P (p:ks) (filter (p /=) nots)- filter_nots _ = impossible+changeToTrue :: Prop -> PatchCheck ()+changeToTrue p = modify filter_nots+ where filter_nots (P ks nots) = P (p:ks) (filter (p /=) nots) -- | Remove a property from the list of properties that hold for this repo (if -- it's in there), and add it to the list of properties that do not hold. -- Returns False if the repo is inconsistent, True otherwise.-changeToFalse :: Prop -> PatchCheck Bool-changeToFalse p = handleInconsistent False $ do+changeToFalse :: Prop -> PatchCheck ()+changeToFalse p = do modify filter_ks- return True where filter_ks (P ks nots) = P (filter (p /=) ks) (p:nots)- filter_ks _ = impossible -assertFileExists :: String -> PatchCheck Bool-assertFileExists f = do _ <- assertNot $ NotEx f- _ <- assertNot $ DirEx f+assertFileExists :: String -> PatchCheck ()+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 :: String -> PatchCheck ()+assertDirExists d = do assertNot $ NotEx d+ assertNot $ FileEx d assert $ DirEx d-assertExists :: String -> PatchCheck Bool+assertExists :: String -> PatchCheck () assertExists f = assertNot $ NotEx f -assertNoSuch :: String -> PatchCheck Bool-assertNoSuch f = do _ <- assertNot $ FileEx f- _ <- assertNot $ DirEx f+assertNoSuch :: String -> PatchCheck ()+assertNoSuch f = do assertNot $ FileEx f+ assertNot $ DirEx f assert $ NotEx f -createFile :: String -> PatchCheck Bool+createFile :: String -> PatchCheck () 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 :: String -> PatchCheck () 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 :: String -> PatchCheck () 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 :: String -> PatchCheck () 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 :: String -> String -> PatchCheck () 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-substuffDontExist d = handleInconsistent False $ do+substuffDontExist :: String -> PatchCheck ()+substuffDontExist d = do P ks _ <- get if all noss ks- then return True- else do- put Inconsistent- return False+ then isValid+ else inconsistent where noss (FileEx f) = not (is_within_dir f) noss (DirEx f) = not (is_within_dir f) noss _ = True@@ -338,17 +309,17 @@ -- the init and tail calls dump the final init (which is just the path itself -- again), the first init (which is empty), and the initial "." from -- splitDirectories-superdirsExist :: String -> PatchCheck Bool-superdirsExist fn = and `fmap` mapM assertDirExists superdirs+superdirsExist :: String -> PatchCheck ()+superdirsExist fn = mapM_ assertDirExists superdirs where superdirs = map (("./"++) . joinPath) (init (tail (inits (tail (splitDirectories fn))))) -fileExists :: String -> PatchCheck Bool+fileExists :: String -> PatchCheck () fileExists fn = do- _ <- superdirsExist fn+ superdirsExist fn assertFileExists fn -dirExists :: String -> PatchCheck Bool+dirExists :: String -> PatchCheck () dirExists fn = do- _ <- superdirsExist fn+ superdirsExist fn assertDirExists fn
harness/Darcs/Test/Patch/Examples/Set1.hs view
@@ -24,6 +24,7 @@ import Prelude () import Darcs.Prelude+import Data.Maybe ( fromJust ) import System.IO.Unsafe ( unsafePerformIO ) import qualified Data.ByteString.Char8 as BC ( pack ) import qualified Data.ByteString as B ( empty )
harness/Darcs/Test/Patch/Examples/Set2Unwitnessed.hs view
@@ -25,7 +25,6 @@ import Data.Maybe ( catMaybes ) import qualified Data.ByteString.Char8 as BC ( pack ) import Darcs.Patch.Witnesses.Sealed-import Darcs.Patch ( invert, hunk ) import Darcs.Patch.Invert ( Invert(..) ) import Darcs.Patch.Prim ( PrimPatch, fromPrim ) import Darcs.Patch.V2 ( RepoPatchV2 )
harness/Darcs/Test/Patch/FileUUIDModel.hs view
@@ -33,10 +33,10 @@ import Darcs.Util.Path ( Name, unsafeMakeName ) import Darcs.Util.Hash( Hash(..) ) -import Control.Applicative ( (<$>) ) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import qualified Data.Map as M+import Data.Maybe ( fromJust ) import Test.QuickCheck ( Arbitrary(..) , Gen, choose, vectorOf, frequency, oneof )
harness/Darcs/Test/Patch/Properties/Check.hs view
@@ -4,20 +4,19 @@ import Prelude () import Darcs.Prelude import Control.Monad ( liftM )-import Data.Maybe ( isNothing ) import Darcs.Test.Patch.Check ( PatchCheck, checkMove, removeDir, createDir, isValid, insertLine, fileEmpty, fileExists, deleteLine, modifyFile, createFile, removeFile,- doCheck, FileContents(..)+ doCheck, inconsistent, FileContents(..) ) import Darcs.Patch.RegChars ( regChars ) import Darcs.Util.ByteString ( linesPS ) import qualified Data.ByteString as B ( ByteString, null, concat ) import qualified Data.ByteString.Char8 as BC ( break, pack ) import Darcs.Util.Path ( fn2fp )-import qualified Data.Map as M ( mapMaybe )+import qualified Data.IntMap as M ( mapMaybe ) import Darcs.Patch ( invert, effect, PrimPatch ) import Darcs.Patch.Invert ( Invert )@@ -35,7 +34,7 @@ type Prim2 = V2.Prim class Check p where- checkPatch :: p wX wY -> PatchCheck Bool+ checkPatch :: p wX wY -> PatchCheck () instance Check p => Check (FL p) where checkPatch NilFL = isValid@@ -45,11 +44,11 @@ checkPatch (p1 :> p2) = checkPatch p1 >> checkPatch p2 checkAPatch :: (Invert p, Check p) => p wX wY -> Bool-checkAPatch p = doCheck $ do _ <- checkPatch p+checkAPatch p = doCheck $ do checkPatch p checkPatch $ invert p instance PrimPatch prim => Check (RepoPatchV2 prim) where- checkPatch p = return $ isNothing $ isConsistent p+ checkPatch p = maybe isValid (const inconsistent) $ isConsistent p instance Check (RepoPatchV1 Prim1) where checkPatch p | isMerger p = checkPatch $ effect p@@ -61,14 +60,14 @@ deriving instance Check Prim2 instance Check FileUUID.Prim where- checkPatch _ = return True -- XXX+ checkPatch _ = isValid -- XXX instance Check Prim where 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+ fileExists $ fn2fp f mapM_ (deleteLine (fn2fp f) line) old mapM_ (insertLine (fn2fp f) line) (reverse new) isValid@@ -77,9 +76,9 @@ -- 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+ fileExists $ fn2fp f mapM_ (deleteLine (fn2fp f) 1) (linesPS o)- _ <- fileEmpty $ fn2fp f+ fileEmpty $ fn2fp f mapM_ (insertLine (fn2fp f) 1) (reverse $ linesPS n) isValid @@ -87,7 +86,7 @@ checkPatch (DP d RmDir) = removeDir $ fn2fp d checkPatch (Move f f') = checkMove (fn2fp f) (fn2fp f')- checkPatch (ChangePref _ _ _) = return True+ checkPatch (ChangePref _ _ _) = isValid tryTokPossibly :: String -> String -> String -> (Maybe FileContents) -> (Maybe FileContents)
harness/Darcs/Test/Patch/Properties/RepoPatchV2.hs view
@@ -3,6 +3,7 @@ import Prelude () import Darcs.Prelude+import Data.Maybe ( fromJust ) import Darcs.Test.Patch.Arbitrary.Generic ( Tree, flattenTree, G2(..), mapTree ) import Darcs.Test.Patch.WithState
harness/Darcs/Test/Patch/RepoModel.hs view
@@ -2,7 +2,6 @@ import Darcs.Patch.Apply ( Apply, ApplyState ) import Darcs.Patch.Witnesses.Ordered ( FL ) -import Control.Monad.Fail ( MonadFail(fail) ) import Test.QuickCheck ( Gen ) data Fail a = Failed String | OK a@@ -22,9 +21,6 @@ return = OK Failed s >>= _ = Failed s OK v >>= f = f v--instance MonadFail Fail where- fail = Failed unFail :: Fail t -> t unFail (OK x) = x
release/distributed-context view
@@ -1,1 +1,1 @@-Just "\nContext:\n\n[TAG 2.14.2\nGanesh Sittampalam <ganesh@earth.li>**20190126112346\n Ignore-this: 5c94e042fbcfdf311008d6e980d9cf1d\n] \n"+Just "\nContext:\n\n\n[TAG 2.14.3\nBen Franksen <ben.franksen@online.de>**20200426190656\n Ignore-this: 21d97b8ff1af6e5d823789e49c08f75057f0a85eef34de7b605eae60501b2c1ce45e5e8dd84264da\n] \n"
src/Darcs/Patch/Bundle.hs view
@@ -64,7 +64,7 @@ ( mmapFilePS, linesPS, unlinesPS, dropSpace, substrPS, decodeLocale ) import Darcs.Util.Hash ( sha1PS ) import Darcs.Util.Printer ( Doc, renderPS, newline, text, ($$),- (<>), vcat, vsep, renderString )+ vcat, vsep, renderString ) -- |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
src/Darcs/Patch/Depends.hs view
@@ -251,7 +251,7 @@ unwrapOneTagged :: (Monad m) => PatchSet rt p wX wY -> m (PatchSet rt p wX wY) unwrapOneTagged (PatchSet (ts :<: Tagged t _ tps) ps) = return $ PatchSet ts (tps :<: t +<+ ps)-unwrapOneTagged _ = fail "called unwrapOneTagged with no Tagged's in the set"+unwrapOneTagged _ = error "called unwrapOneTagged with no Tagged's in the set" -- | @getUncovered ps@ returns the 'PatchInfo' for all the patches in -- @ps@ that are not depended on by anything else *through explicit
src/Darcs/Patch/Info.hs view
@@ -78,7 +78,7 @@ import Data.List( isPrefixOf ) import Darcs.Util.Printer ( Doc, packedString,- empty, ($$), (<>), (<+>), vcat, text, cyanText, blueText, prefix )+ empty, ($$), (<+>), vcat, text, cyanText, blueText, prefix ) import Darcs.Util.IsoDate ( readUTCDate ) import System.Time ( CalendarTime, calendarTimeToString, toClockTime, toCalendarTime )
src/Darcs/Patch/Match.hs view
@@ -421,7 +421,7 @@ Just m -> if nonrangeMatcherIsTag fs then getTagS m repo else getMatcherS Exclusive m repo- Nothing -> fail "Pattern not specified in getNonrangeMatch."+ Nothing -> error "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@@ -441,7 +441,7 @@ Just (_,b) -> unpullLastN repo b -- b is chronologically earlier than a Nothing -> case firstMatcher fs of- Nothing -> fail "Pattern not specified in getFirstMatchS."+ Nothing -> error "Pattern not specified in getFirstMatchS." Just m -> if firstMatcherIsTag fs then getTagS m repo else getMatcherS Inclusive m repo@@ -462,7 +462,7 @@ checkMatchSyntax opts = case getMatchPattern opts of Nothing -> return ()- Just p -> either fail (const $ return ()) (parseMatch p::Either String (MatchFun rt DummyPatch))+ Just p -> either error (const $ return ()) (parseMatch p::Either String (MatchFun rt DummyPatch)) getMatchPattern :: [MatchFlag] -> Maybe String getMatchPattern [] = Nothing@@ -718,7 +718,7 @@ getMatcherS ioe m repo = if matchExists m repo then applyInvToMatcher ioe m repo- else fail $ "Couldn't match pattern "++ show m+ else error $ "Couldn't match pattern "++ show m getTagS :: (ApplyMonad (ApplyState p) m, MonadProgress m, Matchable p) => Matcher rt p -> PatchSet rt p Origin wX -> m ()
src/Darcs/Patch/Named.hs view
@@ -62,7 +62,7 @@ import Darcs.Patch.Witnesses.Show ( ShowDict(..), Show1(..), Show2(..) ) import Darcs.Util.Printer- ( Doc, ($$), (<+>), (<>), prefix, text, vcat, cyanText, blueText )+ ( Doc, ($$), (<+>), prefix, text, vcat, cyanText, blueText ) -- | The @Named@ type adds a patch info about a patch, that is a name. data Named p wX wY where
src/Darcs/Patch/Named/Wrapped.hs view
@@ -56,7 +56,7 @@ import Darcs.Util.IsoDate ( getIsoDateTime ) import Darcs.Util.Text ( formatParas )-import Darcs.Util.Printer ( ($$), (<>), vcat, prefix )+import Darcs.Util.Printer ( ($$), vcat, prefix ) import Control.Applicative ( (<|>) )
src/Darcs/Patch/PatchInfoAnd.hs view
@@ -15,6 +15,7 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. +{-# LANGUAGE CPP #-} module Darcs.Patch.PatchInfoAnd ( Hopefully(..), SimpleHopefully(..), PatchInfoAnd(..), WPatchInfo, unWPatchInfo, compareWPatchInfo, piap, n2pia, patchInfoAndPatch,@@ -167,7 +168,13 @@ -- | @hopefullyM@ is a version of @hopefully@ which calls @fail@ in a -- monad instead of erroring.-hopefullyM :: Monad m => PatchInfoAnd rt p wA wB -> m (WrappedNamed rt p wA wB)+hopefullyM ::+#if MIN_VERSION_base(4,13,0)+ MonadFail m+#else+ Monad m+#endif+ => PatchInfoAnd rt p wA wB -> m (WrappedNamed rt p wA wB) hopefullyM (PIAP pinf hp) = case hopefully2either hp of Right p -> return p Left e -> fail $ renderString
src/Darcs/Patch/Prim/Class.hs view
@@ -13,7 +13,6 @@ import Darcs.Prelude import Darcs.Patch.ApplyMonad ( ApplyMonad )-import Darcs.Patch.Apply( ApplyState ) import Darcs.Patch.FileHunk ( FileHunk, IsHunk ) import Darcs.Util.Path ( FileName ) import Darcs.Patch.Format ( FileNameFormat, PatchListFormat )
src/Darcs/Patch/Prim/FileUUID/Read.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ViewPatterns, OverloadedStrings #-}+{-# LANGUAGE CPP, ViewPatterns, OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Darcs.Patch.Prim.FileUUID.Read () where @@ -8,7 +8,7 @@ import Darcs.Patch.Read ( ReadPatch(..) ) import Darcs.Patch.ReadMonads import Darcs.Patch.Prim.Class( PrimRead(..) )-import Darcs.Patch.Prim.FileUUID.Core( Prim(..), Hunk(..), Location(..) )+import Darcs.Patch.Prim.FileUUID.Core( Prim(..), Hunk(..) ) import Darcs.Patch.Prim.FileUUID.ObjectMap import Darcs.Patch.Witnesses.Sealed( seal ) import Darcs.Util.Path ( unsafeMakeName )@@ -58,5 +58,6 @@ _ -> error "malformed filename" decodeWhite (BC.uncons -> Just (c, cs)) = c `BC.cons` decodeWhite cs decodeWhite (BC.uncons -> Nothing) = BC.empty+#if !MIN_VERSION_base(4,14,0) decodeWhite _ = impossible-+#endif
src/Darcs/Patch/Prim/FileUUID/Show.hs view
@@ -22,7 +22,7 @@ import Darcs.Util.Path ( Name, encodeWhiteName ) import Darcs.Util.Printer ( text, packedString, blueText, prefix- , (<+>), (<>), ($$), Doc, vcat+ , (<+>), ($$), Doc, vcat ) -- TODO this instance shouldn't really be necessary, as Prims aren't used generically
src/Darcs/Patch/Prim/V1/Apply.hs view
@@ -28,7 +28,6 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Internal as BI-import qualified Data.ByteString as B ( ByteString, empty, null, concat ) import qualified Data.ByteString.Char8 as BC (pack, unpack, unlines) type FileContents = B.ByteString@@ -41,13 +40,13 @@ apply (FP f (TokReplace t o n)) = mModifyFilePS f doreplace where doreplace fc = case tryTokReplace t (BC.pack o) (BC.pack n) fc of- Nothing -> fail $ "replace patch to " ++ fn2fp f+ Nothing -> error $ "replace patch to " ++ fn2fp f ++ " couldn't apply." Just fc' -> return fc' 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+ else error $ "binary patch to " ++ fn2fp f ++ " couldn't apply." apply (DP d AddDir) = mCreateDirectory d apply (DP d RmDir) = mRemoveDirectory d@@ -115,7 +114,7 @@ case applyHunkLines h fc of Right fc' -> return fc' Left msg ->- fail $+ error $ "### Error applying:\n" ++ renderHunk h ++ "\n### to file " ++ fn2fp f ++ ":\n" ++ BC.unpack fc ++ "### Reason: " ++ msg
src/Darcs/Patch/Prim/V1/Commute.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Darcs.Patch.Prim.V1.Commute ( Perhaps(..)@@ -58,6 +59,9 @@ Failed >>= _ = Failed Unknown >>= _ = Unknown return = Succeeded+#if MIN_VERSION_base(4,13,0)+instance MonadFail Perhaps where+#endif fail _ = Unknown instance Alternative Perhaps where
src/Darcs/Patch/Prim/V1/Show.hs view
@@ -26,7 +26,7 @@ import Darcs.Util.Path ( FileName ) import Darcs.Util.Printer ( Doc, vcat, text, userchunk, invisibleText, invisiblePS, blueText,- ($$), (<+>), (<>),+ ($$), (<+>) ) import Darcs.Util.Show ( appPrec, BSWrapper(..) ) import Darcs.Util.Tree ( Tree )
src/Darcs/Patch/ReadMonads.hs view
@@ -1,6 +1,7 @@ -- | 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, Darcs.Patch.ReadMonads.take, parse, parseStrictly, char, int, option, choice, skipSpace, skipWhile, string,@@ -237,7 +238,6 @@ instance Monad SM where (>>=) = bindSM return = returnSM- fail = failSM instance ParserM SM where work = SM
src/Darcs/Patch/Summary.hs view
@@ -16,7 +16,7 @@ import Darcs.Util.Printer ( Doc, empty, vcat, text,- minus, plus, ($$), (<+>), (<>),+ minus, plus, ($$), (<+>) )
src/Darcs/Patch/V1/Commute.hs view
@@ -15,6 +15,7 @@ -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Darcs.Patch.V1.Commute@@ -93,6 +94,9 @@ Failed >>= _ = Failed Unknown >>= _ = Unknown return = Succeeded+#if MIN_VERSION_base(4,13,0)+instance MonadFail Perhaps where+#endif fail _ = Unknown instance Alternative Perhaps where
src/Darcs/Prelude.hs view
@@ -20,13 +20,13 @@ it to the Prelude import. -} +{-# LANGUAGE CPP #-} module Darcs.Prelude ( module Prelude , module Control.Applicative , module Data.Monoid- , module Data.Semigroup+ , Semigroup(..) , module Data.Traversable- , module Data.Maybe , impossible, bug ) where @@ -42,9 +42,11 @@ -- because it's in the new Prelude but only in Data.Monoid in older GHCs Monoid(..) ,+#if MIN_VERSION_base(4,11,0) -- because it's in the new Prelude but only in Data.Semigroup in older GHCs Semigroup(..) ,+#endif -- because it's in the new Prelude but only in Data.Traversable in older GHCs traverse ,@@ -62,7 +64,6 @@ import Data.Monoid ( Monoid(..) ) import Data.Semigroup ( Semigroup(..) ) import Data.Traversable ( traverse )-import Data.Maybe ( fromJust ) impossible :: a impossible = error "Impossible case"
src/Darcs/Repository/Diff.hs view
@@ -138,7 +138,7 @@ do rmDirP <- diff p (Removed subtree) addFileP <- diff p (Changed (File emptyBlob) b') return $ joinGap (+>+) rmDirP addFileP- diff p _ = fail $ "Missing case at path " ++ show p+ diff p _ = error $ "Missing case at path " ++ show p text_diff p a b | BL.null a && BL.null b = emptyGap NilFL
src/Darcs/Repository/Inventory.hs view
@@ -38,7 +38,7 @@ import Darcs.Repository.Cache ( okayHash ) import Darcs.Util.Hash ( sha256sum ) import Darcs.Util.Printer- ( Doc, (<>), (<+>), ($$), hcat, text, invisiblePS, packedString, renderPS )+ ( Doc, (<+>), ($$), hcat, text, invisiblePS, packedString, renderPS ) -- * Hash validation
src/Darcs/Repository/Match.hs view
@@ -60,7 +60,7 @@ getNonrangeMatch r = withRecordedMatch r . getMatch where getMatch fs = case hasIndexRange fs of Just (n, m) | n == m -> applyNInv (n-1)- | otherwise -> fail "Index range is not allowed for this command."+ | otherwise -> error "Index range is not allowed for this command." _ -> getNonrangeMatchS fs getOnePatchset :: (IsRepoType rt, RepoPatch p)
src/Darcs/Repository/PatchIndex.hs view
@@ -37,11 +37,11 @@ import Prelude () import Darcs.Prelude -import Data.Binary ( encodeFile, decodeFile )+import Data.Binary ( Binary, encodeFile, decodeFileOrFail ) import Data.Word ( Word32 ) import Data.Int ( Int8 ) import Data.List ( group, mapAccumL, sort, isPrefixOf, nub, (\\) )-import Data.Maybe ( fromMaybe, isJust )+import Data.Maybe ( fromJust, fromMaybe, isJust ) import Data.Set (Set) import Data.Map (Map) import qualified Data.Map as M@@ -49,7 +49,6 @@ import Control.Exception ( catch ) import Control.Monad ( forM_, unless, when ) import Control.Monad.State.Strict ( evalState, execState, State, gets, modify )-import Control.Applicative ( (<$>) ) import System.Directory ( createDirectory, renameDirectory, doesFileExist, doesDirectoryExist ) import Darcs.Repository.Format ( formatHas, RepoProperty( HashedInventory ) ) import Darcs.Repository.InternalTypes ( Repository, repoLocation, repoFormat )@@ -511,6 +510,16 @@ return tmpdir rmRecursive cdir `catch` \(_ :: IOError) -> return () renameDirectory tmpdir cdir++decodeFile :: Binary a => FilePath -> IO a+decodeFile path = do+ result <- decodeFileOrFail path+ case result of+ Left (offset, msg) ->+ fail $+ "Patch index is corrupt (file "++path++" at offset "++show offset++"): "++msg+++ "\nPlease remove the corrupt file and then try again."+ Right r -> return r storeRepoState :: FilePath -> String -> IO () storeRepoState fp inv_hash = encodeFile fp (version,inv_hash)
src/Darcs/Repository/Pending.hs view
@@ -36,7 +36,7 @@ import qualified Data.ByteString as B ( empty ) import Control.Exception ( catch, IOException )-import Data.Maybe ( fromMaybe )+import Data.Maybe ( fromJust, fromMaybe ) import Darcs.Util.Printer ( errorDoc ) import Darcs.Util.Global ( darcsdir )@@ -82,7 +82,7 @@ , lengthFL, allFL, filterOutFLFL , reverseFL, mapFL ) import Darcs.Util.ByteString ( gzReadFilePS )-import Darcs.Util.Printer ( Doc, ($$), (<>), text, vcat, (<+>) )+import Darcs.Util.Printer ( Doc, ($$), text, vcat, (<+>) ) import Darcs.Util.Progress ( debugMessage ) pendingName :: String
src/Darcs/Repository/State.hs view
@@ -44,13 +44,18 @@ import Control.Monad ( when, foldM, forM ) import Control.Monad.State ( StateT, runStateT, get, put, liftIO ) import Control.Exception ( catch, IOException )-import Data.Maybe ( isJust )+import Data.Maybe ( fromJust, isJust ) import Data.Ord ( comparing ) import Data.List ( sortBy, union, delete ) import Text.Regex( matchRegex ) import System.Directory( removeFile, doesFileExist, doesDirectoryExist, renameFile )-import System.FilePath ( (</>), (<.>) )+import System.FilePath+ ( (</>)+#if mingw32_HOST_OS+ , (<.>)+#endif+ ) import qualified Data.ByteString as B ( ByteString, readFile, drop, writeFile, empty, concat ) import qualified Data.ByteString.Char8 as BC
src/Darcs/UI/Commands/Convert.hs view
@@ -39,7 +39,7 @@ import Control.Applicative ( (<|>) ) import System.Time ( toClockTime )-import Data.Maybe ( catMaybes, fromMaybe )+import Data.Maybe ( catMaybes, fromJust, fromMaybe ) import qualified Data.IntMap as M import qualified Data.ByteString as B
src/Darcs/UI/Commands/Diff.hs view
@@ -20,7 +20,9 @@ import Prelude () import Darcs.Prelude hiding ( all ) +import Data.Maybe ( fromJust ) import System.FilePath.Posix ( takeFileName, (</>) )+ import Darcs.Util.Workaround ( getCurrentDirectory ) import Darcs.Util.File ( withCurrentDirectory ) import Darcs.Util.Prompt ( askEnter )
src/Darcs/UI/Commands/Log.hs view
@@ -84,7 +84,7 @@ ) import Darcs.Patch.Matchable ( Matchable ) import Darcs.Util.Printer ( Doc, simplePrinters, (<+>), prefix, text, vcat,- vsep, (<>), ($$), errorDoc, insertBeforeLastline, empty )+ vsep, ($$), errorDoc, insertBeforeLastline, empty ) import Darcs.Util.Printer.Color ( fancyPrinters ) import Darcs.Util.Progress ( setProgressMode, debugMessage ) import Darcs.Util.URL ( isValidLocalPath )
src/Darcs/UI/Commands/MarkConflicts.hs view
@@ -24,6 +24,7 @@ import System.Exit ( exitSuccess ) import Data.List.Ordered ( nubSort, isect )+import Data.Maybe ( fromJust ) import Control.Monad ( when, unless ) import Control.Exception ( catch, IOException ) @@ -31,7 +32,7 @@ import Darcs.Util.SignalHandler ( withSignalsBlocked ) import Darcs.Util.Path ( AbsolutePath, SubPath, toFilePath, simpleSubPath ) import Darcs.Util.Printer- ( Doc, putDocLnWith, text, redText, debugDocLn, vsep, (<>), (<+>), ($$) )+ ( Doc, putDocLnWith, text, redText, debugDocLn, vsep, (<+>), ($$) ) import Darcs.Util.Printer.Color ( fancyPrinters ) import Darcs.Util.Text ( pathlist )
src/Darcs/UI/Commands/Optimize.hs view
@@ -24,7 +24,7 @@ import Control.Monad ( when, unless, forM_ ) import Data.List ( nub )-import Data.Maybe ( isJust, fromJust )+import Data.Maybe ( fromJust, isJust ) import System.Directory ( getDirectoryContents , doesDirectoryExist
src/Darcs/UI/Commands/Replace.hs view
@@ -27,7 +27,7 @@ import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString as B import Data.Char ( isSpace )-import Data.Maybe ( isJust )+import Data.Maybe ( fromJust, isJust ) import Control.Exception ( catch, IOException ) import Control.Monad ( unless, filterM, void ) import Darcs.Util.Tree( readBlob, modifyTree, findFile, TreeItem(..), Tree
src/Darcs/UI/Commands/Send.hs view
@@ -128,7 +128,7 @@ import Darcs.UI.Email ( makeEmail ) import Darcs.UI.Completion ( prefArgs ) import Darcs.Util.Printer- ( Doc, vsep, text, ($$), (<+>), (<>), putDoc, putDocLn+ ( Doc, vsep, text, ($$), (<+>), putDoc, putDocLn , renderPS, vcat ) import Darcs.Util.English ( englishNum, Noun(..) )
src/Darcs/UI/Commands/Unrecord.hs view
@@ -74,7 +74,7 @@ selectionContext, runSelection ) import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions (..) ) import Darcs.Util.English ( presentParticiple )-import Darcs.Util.Printer ( text, putDoc, vcat, (<>), (<+>), ($$) )+import Darcs.Util.Printer ( text, putDoc, vcat, (<+>), ($$) ) import Darcs.Util.Progress ( debugMessage ) unrecordDescription :: String
src/Darcs/UI/Commands/Util.hs view
@@ -30,7 +30,7 @@ ) where import Control.Monad ( when, unless )-import Data.Maybe ( catMaybes )+import Data.Maybe ( catMaybes, fromJust ) import Prelude () import Darcs.Prelude@@ -68,7 +68,7 @@ , simpleSubPath, toPath, anchorPath ) import Darcs.Util.Printer- ( text, (<>), (<+>), hsep, ($$), vcat, vsep+ ( text, (<+>), hsep, ($$), vcat, vsep , putDocLn, insertBeforeLastline, prefix ) import Darcs.Util.Prompt ( PromptConfig(..), promptChar, promptYorn )
src/Darcs/UI/Email.hs view
@@ -12,7 +12,7 @@ import Data.Char ( digitToInt, isHexDigit, ord, intToDigit, isPrint, toUpper ) import Data.List ( isInfixOf ) import Darcs.Util.Printer- ( Doc, ($$), (<+>), (<>), text, empty, packedString, renderPS )+ ( Doc, ($$), (<+>), text, empty, packedString, renderPS ) import Darcs.Util.ByteString ( packStringToUTF8, dropSpace, linesPS, betweenLinesPS ) import qualified Data.ByteString as B (ByteString, length, null, tail
src/Darcs/Util/Diff/Patience.hs view
@@ -22,6 +22,7 @@ import Darcs.Prelude import Data.List ( sort )+import Data.Maybe ( fromJust ) import Data.Array.Unboxed import Data.Array.ST import Control.Monad.ST
src/Darcs/Util/Lock.hs view
@@ -54,7 +54,7 @@ import Darcs.Prelude import Data.List ( inits )-import Data.Maybe ( isJust, listToMaybe )+import Data.Maybe ( fromJust, isJust, listToMaybe ) import System.Exit ( exitWith, ExitCode(..) ) import System.IO ( withFile, withBinaryFile, openBinaryTempFile
src/Darcs/Util/Printer/Color.hs view
@@ -9,7 +9,7 @@ import Darcs.Util.Printer ( Printer, Printers, Printers'(..), Printable(..), Color(..)- , invisiblePrinter, (<>), (<?>), Doc(Doc,unDoc), unsafeBothText, simplePrinter, hcat+ , invisiblePrinter, (<?>), Doc(Doc,unDoc), unsafeBothText, simplePrinter, hcat , unsafeText, unsafePackedString , renderStringWith, prefix )
src/Darcs/Util/Text.hs view
@@ -22,7 +22,7 @@ import Control.Arrow ( first ) import Data.List ( intercalate ) -import Darcs.Util.Printer ( Doc, (<>), renderString, quoted, hsep )+import Darcs.Util.Printer ( Doc, renderString, quoted, hsep ) sentence :: Doc -> Doc sentence = (<> ".")
src/Darcs/Util/Tree.hs view
@@ -46,7 +46,6 @@ import Data.Either( lefts, rights ) import Data.List( union, sort ) import Control.Monad( filterM )-import Control.Applicative( (<$>) ) -------------------------------- -- Tree, Blob and friends
src/Darcs/Util/Tree/Monad.hs view
@@ -216,7 +216,7 @@ t <- gets tree let f = findFile t p' case f of- Nothing -> fail $ "No such file " ++ show p'+ Nothing -> error $ "No such file " ++ show p' Just x -> lift (readBlob x) currentDirectory = ask@@ -251,7 +251,7 @@ let item = find tr from' found_to = find tr to' unless (isNothing found_to) $- fail $ "Error renaming: destination " ++ show to ++ " exists."+ error $ "Error renaming: destination " ++ show to ++ " exists." unless (isNothing item) $ do modifyItem from Nothing modifyItem to item