diff options
| -rw-r--r-- | Types/Cost.hs | 7 | ||||
| -rw-r--r-- | Utility/HumanTime.hs | 102 | ||||
| -rw-r--r-- | Utility/PartialPrelude.hs | 70 | ||||
| -rw-r--r-- | Utility/QuickCheck.hs | 45 | ||||
| -rw-r--r-- | keysafe.cabal | 4 |
5 files changed, 1 insertions, 227 deletions
diff --git a/Types/Cost.hs b/Types/Cost.hs index 2aa6ee7..b3aed71 100644 --- a/Types/Cost.hs +++ b/Types/Cost.hs @@ -7,8 +7,6 @@ module Types.Cost where -import Utility.HumanTime - -- | An estimated cost to perform an operation. data Cost op = CPUCost Seconds -- ^ using 1 CPU core @@ -18,10 +16,7 @@ unknownCost :: Cost op unknownCost = CPUCost (Seconds 0) newtype Seconds = Seconds Integer - deriving (Num, Eq, Ord) - -instance Show Seconds where - show (Seconds n) = fromDuration (Duration n) + deriving (Num, Eq, Ord, Show) data UsingHardware = UsingCPU | UsingGPU | UsingASIC deriving (Show) diff --git a/Utility/HumanTime.hs b/Utility/HumanTime.hs deleted file mode 100644 index fe7cf22..0000000 --- a/Utility/HumanTime.hs +++ /dev/null @@ -1,102 +0,0 @@ -{- Time for humans. - - - - Copyright 2012-2013 Joey Hess <id@joeyh.name> - - - - License: BSD-2-clause - -} - -module Utility.HumanTime ( - Duration(..), - durationSince, - durationToPOSIXTime, - durationToDays, - daysToDuration, - parseDuration, - fromDuration, - prop_duration_roundtrips -) where - -import Utility.PartialPrelude -import Utility.QuickCheck - -import qualified Data.Map as M -import Data.Time.Clock -import Data.Time.Clock.POSIX (POSIXTime) -import Data.Char -import Control.Applicative -import Prelude - -newtype Duration = Duration { durationSeconds :: Integer } - deriving (Eq, Ord, Read, Show) - -durationSince :: UTCTime -> IO Duration -durationSince pasttime = do - now <- getCurrentTime - return $ Duration $ round $ diffUTCTime now pasttime - -durationToPOSIXTime :: Duration -> POSIXTime -durationToPOSIXTime = fromIntegral . durationSeconds - -durationToDays :: Duration -> Integer -durationToDays d = durationSeconds d `div` dsecs - -daysToDuration :: Integer -> Duration -daysToDuration i = Duration $ i * dsecs - -{- Parses a human-input time duration, of the form "5h", "1m", "5h1m", etc -} -parseDuration :: Monad m => String -> m Duration -parseDuration = maybe parsefail (return . Duration) . go 0 - where - go n [] = return n - go n s = do - num <- readish s :: Maybe Integer - case dropWhile isDigit s of - (c:rest) -> do - u <- M.lookup c unitmap - go (n + num * u) rest - _ -> return $ n + num - parsefail = fail "duration parse error; expected eg \"5m\" or \"1h5m\"" - -fromDuration :: Duration -> String -fromDuration Duration { durationSeconds = d } - | d == 0 = "0s" - | otherwise = concatMap showunit $ go [] units d - where - showunit (u, n) - | n > 0 = show n ++ [u] - | otherwise = "" - go c [] _ = reverse c - go c ((u, n):us) v = - let (q,r) = v `quotRem` n - in go ((u, q):c) us r - -units :: [(Char, Integer)] -units = - [ ('y', ysecs) - , ('d', dsecs) - , ('h', hsecs) - , ('m', msecs) - , ('s', 1) - ] - -unitmap :: M.Map Char Integer -unitmap = M.fromList units - -ysecs :: Integer -ysecs = dsecs * 365 - -dsecs :: Integer -dsecs = hsecs * 24 - -hsecs :: Integer -hsecs = msecs * 60 - -msecs :: Integer -msecs = 60 - --- Durations cannot be negative. -instance Arbitrary Duration where - arbitrary = Duration <$> nonNegative arbitrary - -prop_duration_roundtrips :: Duration -> Bool -prop_duration_roundtrips d = parseDuration (fromDuration d) == Just d diff --git a/Utility/PartialPrelude.hs b/Utility/PartialPrelude.hs deleted file mode 100644 index 5579556..0000000 --- a/Utility/PartialPrelude.hs +++ /dev/null @@ -1,70 +0,0 @@ -{- Parts of the Prelude are partial functions, which are a common source of - - bugs. - - - - This exports functions that conflict with the prelude, which avoids - - them being accidentially used. - -} - -{-# OPTIONS_GHC -fno-warn-tabs #-} - -module Utility.PartialPrelude where - -import qualified Data.Maybe - -{- read should be avoided, as it throws an error - - Instead, use: readish -} -read :: Read a => String -> a -read = Prelude.read - -{- head is a partial function; head [] is an error - - Instead, use: take 1 or headMaybe -} -head :: [a] -> a -head = Prelude.head - -{- tail is also partial - - Instead, use: drop 1 -} -tail :: [a] -> [a] -tail = Prelude.tail - -{- init too - - Instead, use: beginning -} -init :: [a] -> [a] -init = Prelude.init - -{- last too - - Instead, use: end or lastMaybe -} -last :: [a] -> a -last = Prelude.last - -{- Attempts to read a value from a String. - - - - Ignores leading/trailing whitespace, and throws away any trailing - - text after the part that can be read. - - - - readMaybe is available in Text.Read in new versions of GHC, - - but that one requires the entire string to be consumed. - -} -readish :: Read a => String -> Maybe a -readish s = case reads s of - ((x,_):_) -> Just x - _ -> Nothing - -{- Like head but Nothing on empty list. -} -headMaybe :: [a] -> Maybe a -headMaybe = Data.Maybe.listToMaybe - -{- Like last but Nothing on empty list. -} -lastMaybe :: [a] -> Maybe a -lastMaybe [] = Nothing -lastMaybe v = Just $ Prelude.last v - -{- All but the last element of a list. - - (Like init, but no error on an empty list.) -} -beginning :: [a] -> [a] -beginning [] = [] -beginning l = Prelude.init l - -{- Like last, but no error on an empty list. -} -end :: [a] -> [a] -end [] = [] -end l = [Prelude.last l] diff --git a/Utility/QuickCheck.hs b/Utility/QuickCheck.hs deleted file mode 100644 index 4978d42..0000000 --- a/Utility/QuickCheck.hs +++ /dev/null @@ -1,45 +0,0 @@ -{- QuickCheck with additional instances - - - - Copyright 2012-2014 Joey Hess <id@joeyh.name> - - - - License: BSD-2-clause - -} - -{-# 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 Control.Applicative -import Prelude - -{- Times before the epoch are excluded. -} -instance Arbitrary POSIXTime where - arbitrary = fromInteger <$> nonNegative arbitrarySizedIntegral - -instance Arbitrary EpochTime where - arbitrary = fromInteger <$> 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) diff --git a/keysafe.cabal b/keysafe.cabal index 7f27178..00390fe 100644 --- a/keysafe.cabal +++ b/keysafe.cabal @@ -25,7 +25,6 @@ Executable keysafe , deepseq == 1.4.* , random == 1.1.* , raaz == 0.0.2 - , QuickCheck == 2.8.* , time == 1.5.* , containers == 0.5.* , binary == 0.7.* @@ -74,9 +73,6 @@ Executable keysafe UI UI.Readline UI.Zenity - Utility.HumanTime - Utility.PartialPrelude - Utility.QuickCheck source-repository head type: git |