Hi,

this is an alternative "hlint" patch, that actually replaces haskell_policy. It
only catches and reports actual errors, so there's no issue with huge
output. It also provides a ratification mechanism, so it is possible to make
the test pass (we need to use the unsafe functions from time to time).

Nevertheless, even though the test passes now, it should probably wait till the
hlint cpp issue [1] is fixed.

[1]: http://code.google.com/p/ndmitchell/issues/detail?id=137

Yours,
   Petr.

Fri Aug  7 08:57:36 CEST 2009  Petr Rockai <[email protected]>
  * Re-implement haskell_policy in terms of hlint.
  
  This also comes with a change to the ratification mechanism, which now uses a
  separate Ratified module, from which you have to import the unsafe
  functions. Requires a recent hlint.

New patches:

[Re-implement haskell_policy in terms of hlint.
Petr Rockai <[email protected]>**20090807065736
 Ignore-this: 15fbaf506ae0569d904c1ed2543abc30
 
 This also comes with a change to the ratification mechanism, which now uses a
 separate Ratified module, from which you have to import the unsafe
 functions. Requires a recent hlint.
] addfile ./contrib/darcs-errors.hlint
hunk ./contrib/darcs-errors.hlint 1
+# Only report errors, since we use this as part of the testsuite. It needs to
+# be easy to see what tripped up the testcase.
+
+ignore "Eta reduce" = ""
+ignore "Use camelCase" = ""
+ignore "Use const" = ""
+ignore "Use on" = ""
+ignore "Use foldr" = ""
+ignore "Use String" = ""
+ignore "Use string literal" = ""
+ignore "Use guards" = ""
+ignore "Use :" = ""
+ignore "Redundant brackets" = ""
+ignore "Redundant do" = ""
+ignore "Redundant return" = ""
+ignore "Redundant $" = ""
+ignore "Redundant lambda" = ""
+
+# The problem with Prelude readFile is that it's based on hGetContents, which
+# is lazy by definition. This also means that unless you force consumption of
+# the produced list, it will keep an fd open for the file, possibly
+# indefinitely.  This is called a fd leak. Other than being annoying and if done
+# often, leading to fd exhaustion and failure to open any new files (which is
+# usually fatal), it also prevents the file to be unlinked (deleted) on win32.
+
+# On the other hand, *strict* bytestring version of readFile will read the whole
+# file into a contiguous buffer, *close the fd* and return. This is perfectly
+# safe with regards to fd leaks. Btw., this is *not* the case with lazy
+# bytestring variant of readFile, so that one is unsafe as well.
+
+error "Avoid Prelude.readFile" = Prelude.readFile ==> Data.ByteString.readFile
+error "Avoid hGetContents" = System.IO.hGetContents ==> Data.ByteString.hGetContents
+error "Avoid BL.hGetContents" = Data.ByteString.Lazy.hGetContents
+                              ==> Data.ByteString.hGetContents
+error "Avoid BL.hGetContents" = Data.ByteString.Lazy.Char8.hGetContents
+                              ==> Data.ByteString.hGetContents
+error "Avoid BL.readFile" = Data.ByteString.Lazy.Char8.readFile ==> Data.ByteString.readFile
+error "Avoid BL.readFile" = Data.ByteString.Lazy.readFile ==> Data.ByteString.readFile
hunk ./src/Darcs/Commands/Record.lhs 24
 {-# LANGUAGE CPP, PatternGuards #-}
 
 module Darcs.Commands.Record ( record, commit, get_date, get_log, file_exists ) where
+import qualified Ratified( hGetContents )
 import Control.Exception ( handleJust, Exception( ExitException ) )
 import Control.Monad ( filterM, when )
hunk ./src/Darcs/Commands/Record.lhs 27
-import System.IO ( hGetContents, stdin )
+import System.IO ( stdin )
 import Data.List ( sort, isPrefixOf )
 import System.Exit ( exitWith, exitFailure, ExitCode(..) )
 import System.IO ( hPutStrLn )
hunk ./src/Darcs/Commands/Record.lhs 300
                                   PriorPatchName p -> return p
                                   NoPatchName      -> prompt_patchname False
                            putStrLn "What is the log?"
-                           thelog <- lines `fmap` hGetContents stdin -- ratify hGetContents: stdin not deleted
+                           thelog <- lines `fmap` Ratified.hGetContents stdin
                            return (p, thelog, Nothing)
           gl (LogFile f:fs) =
               do -- round 1 (patchname)
hunk ./src/Darcs/Commands/ShowAuthors.lhs 23
 {-# OPTIONS_GHC -cpp #-}
 module Darcs.Commands.ShowAuthors ( show_authors ) where
 
+import qualified Ratified( readFile )
 import Control.Arrow ((&&&), (***))
 import Data.List ( sort, sortBy, group, groupBy, isInfixOf, isPrefixOf )
 import Data.Ord (comparing)
hunk ./src/Darcs/Commands/ShowAuthors.lhs 144
 
 author_spellings_from_file :: IO [[String]]
 author_spellings_from_file = do
-  s <- readFile -- ratify readFile: never unlinked from within darcs
+  s <- Ratified.readFile -- never unlinked from within darcs
          authorspellingsfile `catch` (\_ -> return "")
   let noncomments = filter (not . ("--" `isPrefixOf`)) $
                     filter (not . null) $ map strip $ lines s
hunk ./src/Darcs/External.hs 19
     sendmail_path, diff_program
   ) where
 
+import qualified Ratified
 import Data.Maybe ( isJust, isNothing, maybeToList )
 import Control.Monad ( when, zipWithM_, filterM, liftM2 )
 import System.Exit ( ExitCode(..) )
hunk ./src/Darcs/External.hs 24
 import System.Environment ( getEnv )
-import System.IO ( hPutStr, hPutStrLn, hGetContents, hClose,
+import System.IO ( hPutStr, hPutStrLn, hClose,
                    openBinaryFile, IOMode( ReadMode ),
                    openBinaryTempFile,
                    hIsTerminalDevice, stdout, stderr, Handle )
hunk ./src/Darcs/External.hs 59
 import Progress ( withoutProgress, progressList, debugMessage )
 
 import ByteStringUtils (gzReadFilePS, linesPS, unlinesPS)
-import qualified Data.ByteString as B (ByteString, empty, null, readFile -- ratify readFile: Just an import from ByteString
-            ,hGetContents, writeFile, hPut, length -- ratify hGetContents: importing from ByteString
+import qualified Data.ByteString as B (ByteString, empty, null, readFile
+            ,hGetContents, writeFile, hPut, length
             ,take, concat, drop, isPrefixOf, singleton, append)
 import qualified Data.ByteString.Char8 as BC (unpack, pack)
 
hunk ./src/Darcs/External.hs 310
     do debugMessage $ unwords (c:args)
        (i,o,e,pid) <- runInteractiveProcess c args Nothing Nothing
        mvare <- newEmptyMVar
-       forkIO ((hGetContents e >>= -- ratify hGetContents: it's immediately consumed
+       forkIO ((Ratified.hGetContents e >>= -- ratify: immediately consumed
                 hPutStr stderr)
                `finally` putMVar mvare ())
        mvaro <- newEmptyMVar
hunk ./src/Darcs/External.hs 314
-       forkIO ((hGetContents o >>= -- ratify hGetContents: it's immediately consumed
+       forkIO ((Ratified.hGetContents o >>= -- ratify: immediately consumed
                 hPutStr stdout)
                `finally` putMVar mvaro ())
        hPutDoc i inp
hunk ./src/Darcs/External.hs 489
     do (i,o,e,pid) <- runInteractiveProcess c args Nothing Nothing
        forkIO $ hPutDoc i instr >> hClose i
        mvare <- newEmptyMVar
-       forkIO ((hGetContents e >>= -- ratify hGetContents: it's immediately consumed
+       forkIO ((Ratified.hGetContents e >>= -- ratify: immediately consumed
                 hPutStr stderr)
                `finally` putMVar mvare ())
        out <- B.hGetContents o
hunk ./src/Darcs/External.hs 507
     do (i,o,e,pid) <- runInteractiveProcess c args Nothing Nothing
        forkIO $ hPutDoc i instr >> hClose i
        mvare <- newEmptyMVar
-       forkIO ((hGetContents e >>= -- ratify hGetContents: it's immediately consumed
+       forkIO ((Ratified.hGetContents e >>= -- ratify: immediately consumed
                 hPutStr stderr)
                `finally` putMVar mvare ())
        out <- B.hGetContents o
hunk ./src/Darcs/Gorsvet.hs 68
 import Storage.Hashed.Monad
     ( virtualTreeIO, hashedTreeIO, plainTreeIO
     , unlink, rename, createDirectory, writeFile
-    , readFile -- ratify readFile: haskell_policy je natvrdlá
-    , cwd, tree, TreeIO )
+    , readFile, cwd, tree, TreeIO )
 import Storage.Hashed
 
 floatFn :: FileName -> AnchoredPath
hunk ./src/Darcs/Gorsvet.hs 84
       modify (\x' -> x' { cwd = wd })
       return x
     mGetDirectoryContents = error "get dir contents"
-    mReadFilePS p = do x <- readFile (floatFn p) -- ratify readFile: ...
+    mReadFilePS p = do x <- readFile (floatFn p)
                        return $ BS.concat (BL.toChunks x)
 
 instance WriteableDirectory TreeIO where
hunk ./src/Darcs/Gorsvet.hs 90
     mWithCurrentDirectory = mInCurrentDirectory
     mSetFileExecutable _ _ = return ()
-    mWriteFilePS p ps = writeFile -- ratify readFile: haskell_policy is stupid.
-          (floatFn p) (BL.fromChunks [ps])
+    mWriteFilePS p ps = writeFile (floatFn p) (BL.fromChunks [ps])
     mCreateDirectory p = createDirectory (floatFn p)
     mRename from to = rename (floatFn from) (floatFn to)
     mRemoveDirectory = unlink . floatFn
hunk ./src/Preproc.hs 16
 --     LaTeX text.  In particular, \\darcsCommand{foo} is replaced by
 --     LaTeX markup describing the command @f...@.
 module Preproc ( preproc_main ) where
+import qualified Ratified( readFile )
 import System.FilePath ( (</>) )
 import System.Environment ( getArgs )
 import System.Exit ( exitWith, ExitCode(..) )
hunk ./src/Preproc.hs 89
   let rx = mkRegex "^\\\\(input|darcs(Command|Env))\\{(.+)\\}$"
   case matchRegex rx s of
     Just ["input", _, path] ->
-        do cs <- readFile $ "src" </> path -- ratify readFile: not part of darcs executable
+        do cs <- Ratified.readFile $ "src" </> path -- not part of normal darcs operation
            this <- preproc $ lines cs
            return $ this ++ rest
     Just ["darcsCommand", _, command] ->
addfile ./src/Ratified.hs
hunk ./src/Ratified.hs 1
+module Ratified( readFile, hGetContents ) where
+import System.IO( hGetContents )
hunk ./src/Ssh.hs 8
            ) where
 
 import Prelude hiding ( lookup, catch )
+import qualified Ratified( hGetContents )
 
 import System.Exit ( ExitCode(..) )
 import System.Environment ( getEnv )
hunk ./src/Ssh.hs 102
                    clean "" = bug $ "Buggy path in grabSSH: "++x
                    file = clean dir
                    failwith e = do severSSHConnection x
-                                   eee <- hGetContents (err c) -- ratify hGetContents: it's okay
-                                                               -- here because we're only grabbing
-                                                               -- stderr, and we're also about to
-                                                               -- throw the contents.
+                                   -- 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
hunk ./tests/haskell_policy.sh 2
 #!/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.
 
hunk ./tests/haskell_policy.sh 26
-RESULT=tmpfile
-ROOT=..
-ERRORSTATUS=0
+. lib
 
hunk ./tests/haskell_policy.sh 28
-# lookfor ( $1=what, $2=reason, $3=source module exception )
-lookfor () {
-    rm -f "$RESULT"
-    darcs query manifest --repodir="$ROOT" | grep '\.l\?hs$' | while read f; do
-        grep -Hnwe "$1" "$ROOT/$f" | grep -v "$3\.$1" | \
-        grep -v ":[0-9]\+:import " | grep -Fv "ratify $1: " >> "$RESULT"
-    done
-    if [ -s "$RESULT" ]; then
-        echo "Found the following unratified uses of $1:"
-        # ugly sed expresion to fix relative paths; think pretty cat
-        sed -e 's/[^:]*\/\.\///' "$RESULT"
-        echo "$2"
-        echo "Comment 'ratify $1: <why>' on the same line to allow it"
-        echo
-        ERRORSTATUS=1
-    fi
-    rm -f "$RESULT"
+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
 }
 
hunk ./tests/haskell_policy.sh 35
-# On 2009-02-12 Petr Rockai explained this on darcs-users:
-# The problem with Prelude readFile is that it's based on hGetContents, which
-# is lazy by definition. This also means that unless you force consumption of
-# the produced list, it will keep an fd open for the file, possibly
-# indefinitely.  This is called a fd leak. Other than being annoying and if done
-# often, leading to fd exhaustion and failure to open any new files (which is
-# usually fatal), it also prevents the file to be unlinked (deleted) on win32.
-#
-# On the other hand, *strict* bytestring version of readFile will read the whole
-# file into a contiguous buffer, *close the fd* and return. This is perfectly
-# safe with regards to fd leaks. Btw., this is *not* the case with lazy
-# bytestring variant of readFile, so that one is unsafe.
-lookfor readFile \
-        "Prelude.readFile doesn't ensure the file is closed before it is deleted!\nConsider import Data.ByteString.Char8 as B (readFile), B.readFile instead." \
-        B # importing readFile from Data.ByteString as B, is allowed
+trap explain ERR
 
hunk ./tests/haskell_policy.sh 37
-lookfor hGetContents \
-        "hGetContents doesn't ensure the file is closed before it is deleted!"
+hlint >& /dev/null || exit 200 # skip if there's no hlint
 
hunk ./tests/haskell_policy.sh 39
-# look for tabs in haskell source
-rm -f "$RESULT"
-darcs query manifest --repodir="$ROOT" | grep '\.l\?hs$' | while read f; do
-    grep -FHnwe "	" "$ROOT/$f" >> "$RESULT"
-done
-if [ -s "$RESULT" ]; then
-    echo "Found the following lines with unwanted tabs:"
-    # ugly sed expresion to fix relative paths; think pretty cat
-    sed -e 's/[^:]*\/\.\///' "$RESULT"
-    echo
-    ERRORSTATUS=1
-fi
-rm -f "$RESULT"
-
-exit "$ERRORSTATUS"
+wd="`pwd`"
+cd ..
+hlint --hint=contrib/darcs-errors.hlint src

Context:

[Avoid unescaped hyphens and backslashes in manpage.
Trent W. Buck <[email protected]>**20090803063335
 Ignore-this: 4db2b484b68590f754d36f4751e93962
 Fixes these bugs:
 
   W: darcs: manpage-has-errors-from-man darcs.1.gz:
        297: a tab character is not allowed in an escape name
   I: darcs: hyphen-used-as-minus-sign darcs.1.gz (87 times)
 
 http://lintian.debian.org/tags/manpage-has-errors-from-man.html
 http://lintian.debian.org/tags/hyphen-used-as-minus-sign.html
] 
[Typo: s/comand/command/.
Trent W. Buck <[email protected]>**20090803042007
 Ignore-this: fcbe6f2cbcb3743872b0431b11dea10c
 Thanks to http://lintian.debian.org/tags/spelling-error-in-binary.html.
] 
[Add script that tricks cabal into installing our build-depends only.
Petr Rockai <[email protected]>**20090805152653
 Ignore-this: 6a70f5ff464d26a944b81967606e7af0
] 
[Update hpc.README to use Cabal.
Petr Rockai <[email protected]>**20090730190304
 Ignore-this: 7f63751a7daa418ffdca2ca6d20af1b1
] 
[Add a flag for enabling HPC for the darcs library.
Petr Rockai <[email protected]>**20090730185959
 Ignore-this: e0246133e84e8547e223f61b67a28066
] 
[Combine the HPC tix files after each test in ShellHarness.
Petr Rockai <[email protected]>**20090730185951
 Ignore-this: 577a6e1614aa8c5ff6f25d9df6f81554
 
 This is done when HPCTIXDIR is set, so presumably we are generating coverage
 report. We need to do this, because otherwise, a full testsuite run produces
 over a gigabyte of tixfiles, even though the combined tix is less than 200K.
] 
[Fix link to autoconf tarball.
Eric Kow <[email protected]>**20090723135420
 Ignore-this: cfe87256fbd5af286a00fbb84ca443d0
] 
[Update web page for 2.3.0 release.
Eric Kow <[email protected]>**20090723134705
 Ignore-this: dfa04b99e5c0170448d635bf0e496a66
] 
[Resolve conflict between autoconf removal and version number updates.
Eric Kow <[email protected]>**20090723133543
 Ignore-this: efcf724bf0230243cee1e88502428ccd
] 
[Makefile: fix dependency on no longer existing distclean target.
Eric Kow <[email protected]>**20090722093438
 Ignore-this: d0f8da797e26b0c42a2da76eddd4ed31
] 
[Add support for skipping tests (exit 200).
Petr Rockai <[email protected]>**20090720095346
 Ignore-this: 133cb02e8cca03a4678068450cb150a9
] 
[Remove the --checkpoint option from the UI.
Petr Rockai <[email protected]>**20090720093634
 Ignore-this: 2fb627cd1e64bbe264fda6e19f0b085b
] 
[Remove the support for writing out new checkpoints.
Petr Rockai <[email protected]>**20090720091809
 Ignore-this: 87eb23fe7604ed0abe5c38daafb87a7e
] 
[Remove ununsed test/shell_harness.hs.
Eric Kow <[email protected]>**20090721192027
 Ignore-this: 7efbe97744c698beecd4f17a09868467
] 
[Remove unused determine_release_state.pl.
Eric Kow <[email protected]>**20090721205227
 Ignore-this: 15331bbb258fbdeb6bd4887c8dabb8ed
] 
[Require haskell zlib, dropping the legacy internal zlib binding.
Petr Rockai <[email protected]>**20090722091325
 Ignore-this: 348c1fd005fe19900e4a9706567b4ee0
] 
[Make utf8-string mandatory.
Eric Kow <[email protected]>**20090721194433
 Ignore-this: cd8a94b3e4e41bb938e82dffbcb27e2d
] 
[Remove UTF8 module completely.
Eric Kow <[email protected]>**20090721194220
 Ignore-this: f4ec3fe853ecbc928a8d3e3c3b9aa07c
 The utf8-string package has been the default for a while.
 Now we're wholly dependent on it.
] 
[Remove autoconf support and cut GNUmakefile to only build manual and tags.
Petr Rockai <[email protected]>**20090717160355
 Ignore-this: 8a45c095c566172076adbe6e44b37827
] 
[Note darcs 2.3 pre-release and darcs 2.2 stable versions in website.
Eric Kow <[email protected]>**20090716133323
 Ignore-this: bbe9c36213a07890816b8599f2f29aee
] 
[Remove website automation from Makefile.
Eric Kow <[email protected]>**20090716133230
 Ignore-this: f0cdb9afaa9d314321b345a08e2784bf
] 
[Rename index.html.in to index.html, forgoing website automation.
Eric Kow <[email protected]>**20090716133023
 Ignore-this: a4c62db2d3ca341e95262cd05328473f
 
 The website automation allowed us to avoid duplication of information (ie.
 version numbers), but we're in the process of changing our build and
 release system, which breaks the site.  For now, we go for simplicity and
 robustness, perhaps restoring the automation in the future when things
 have settled down somewhat.
] 
[Remove bytestring flag from darcs.cabal.
Eric Kow <[email protected]>**20090714165021
 Ignore-this: 4325773231f9679054c7d045657bdae0
 Now that we're requiring GHC 6.8 or above, we always use the external bytestring
 package.
] 
[Slightly refactor the run function in ShellHarness.
Petr Rockai <[email protected]>**20090714134205
 Ignore-this: 92c7f05b9c4d6973e95706f23ea27dfc
] 
[Slightly refactor test machinery in Setup.lhs.
Petr Rockai <[email protected]>**20090714134119
 Ignore-this: 32206a331658d407d9c0fb3b48405db6
] 
[Use tee in pending_has_conflicts.sh for easier debugging.
Petr Rockai <[email protected]>**20090713180404
 Ignore-this: 7b96b7f7df6358ddb0466cfe58803f71
] 
[Roll back the getSymbolicLinkStatus workaround, since it constitutes a fd leak.
Petr Rockai <[email protected]>**20090710143149
 Ignore-this: cd2aa7e13cc902852a7c5d0855d55538
 
 rolling back:
 
 Sun Jun 21 17:39:42 CEST 2009  Petr Rockai <[email protected]>
   * Avoid getSymbolicLinkStatus in mmap implementation, works around GHC 6.8.2 bug.
] 
[Avoid getSymbolicLinkStatus in mmap implementation, works around GHC 6.8.2 bug.
Petr Rockai <[email protected]>**20090621153942
 Ignore-this: 91092453d97c87edfc4e46b11e4ae208
] 
[Move email unit tests to Darcs.Test module space
Reinier Lamers <[email protected]>**20090629203409
 Ignore-this: 3187d24822e7a125a46e0a273956d792
] 
[Teach cabal about new Darcs.Test modules
Reinier Lamers <[email protected]>**20090629193208
 Ignore-this: c27c8398fd637e100259fdf1f4d42e0a
] 
[Move unit tests to Darcs.Test module space
Reinier Lamers <[email protected]>**20090629192934
 Ignore-this: e88d9ecb7ca8f0b5679fba2cd2813ff0
] 
[Bound size of trees generated in Darcs.Patch.QuickCheck
Reinier Lamers <[email protected]>**20090628134952
 Ignore-this: c499b850ad5ca15d4bada56b69ee98f3
 
 This keeps the 'Checking that tree flattenings are consistent' test from
 occasionally taking hours and hours to complete. The maximum depth of 5 was
 found by experiment.
] 
[Add some comments in Darcs.Patch.QuickCheck
Reinier Lamers <[email protected]>**20090628134908
 Ignore-this: c66a386865832e75427f99febfb91a91
] 
[TAG 2.3.0
Petr Rockai <[email protected]>**20090723115125
 Ignore-this: e326d4ddff92c578e8fe8a3c23d00193
] 
Patch bundle hash:
19649f623d8c6acbcf5a3d08e77eda74b0727d61
_______________________________________________
darcs-users mailing list
[email protected]
http://lists.osuosl.org/mailman/listinfo/darcs-users

Reply via email to