From e011fd72ef69dbbaa4f63bfd61564e0918cb3e22 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 19 Nov 2013 16:09:44 -0400
Subject: initial work on git repository destroyer

I suspect this might sometimes corrupt the **source** repo, so use with
caution!
---
 Utility/FileMode.hs   |  7 +++++--
 Utility/QuickCheck.hs | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 53 insertions(+), 2 deletions(-)
 create mode 100644 Utility/QuickCheck.hs

(limited to 'Utility')

diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs
index d76fb57..1307d38 100644
--- a/Utility/FileMode.hs
+++ b/Utility/FileMode.hs
@@ -65,12 +65,15 @@ allowWrite :: FilePath -> IO ()
 allowWrite f = modifyFileMode f $ addModes [ownerWriteMode]
 
 {- Allows owner and group to read and write to a file. -}
-groupWriteRead :: FilePath -> IO ()
-groupWriteRead f = modifyFileMode f $ addModes
+groupSharedModes :: [FileMode]
+groupSharedModes =
 	[ ownerWriteMode, groupWriteMode
 	, ownerReadMode, groupReadMode
 	]
 
+groupWriteRead :: FilePath -> IO ()
+groupWriteRead f = modifyFileMode f $ addModes groupSharedModes
+
 checkMode :: FileMode -> FileMode -> Bool
 checkMode checkfor mode = checkfor `intersectFileModes` mode == checkfor
 
diff --git a/Utility/QuickCheck.hs b/Utility/QuickCheck.hs
new file mode 100644
index 0000000..82af09f
--- /dev/null
+++ b/Utility/QuickCheck.hs
@@ -0,0 +1,48 @@
+{- QuickCheck with additional instances
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module Utility.QuickCheck
+	( module X
+	, module Utility.QuickCheck
+	) where
+
+import Test.QuickCheck as X
+import Data.Time.Clock.POSIX
+import System.Posix.Types
+import qualified Data.Map as M
+import Control.Applicative
+
+instance (Arbitrary k, Arbitrary v, Eq k, Ord k) => Arbitrary (M.Map k v) where
+	arbitrary = M.fromList <$> arbitrary
+
+{- Times before the epoch are excluded. -}
+instance Arbitrary POSIXTime where
+	arbitrary = nonNegative arbitrarySizedIntegral
+
+instance Arbitrary EpochTime where
+	arbitrary = nonNegative arbitrarySizedIntegral
+
+{- Pids are never negative, or 0. -}
+instance Arbitrary ProcessID where
+	arbitrary = arbitrarySizedBoundedIntegral `suchThat` (> 0)
+
+{- Inodes are never negative. -}
+instance Arbitrary FileID where
+	arbitrary = nonNegative arbitrarySizedIntegral
+
+{- File sizes are never negative. -}
+instance Arbitrary FileOffset where
+	arbitrary = nonNegative arbitrarySizedIntegral
+
+nonNegative :: (Num a, Ord a) => Gen a -> Gen a
+nonNegative g = g `suchThat` (>= 0)
+
+positive :: (Num a, Ord a) => Gen a -> Gen a
+positive g = g `suchThat` (> 0)
-- 
cgit v1.2.3