{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- |This module defines types for many useful time periods, as well as
-- mechanisms for converting between them.
module Data.Time.Units(
         TimeUnit(..)
       , Attosecond
       , Femtosecond
       , Picosecond
       , Nanosecond
       , Microsecond
       , Millisecond
       , Second
       , Minute
       , Hour
       , Day
       , Week
       , Fortnight
       , addTime
       , subTime
       , convertUnit
       , getCPUTimeWithUnit
       )
 where

import Data.Ix(Ix)
import Data.Data(Data)
import Data.List(isPrefixOf)
import Data.Typeable(Typeable)
import System.CPUTime

-- |A generic class that describes all the units of time. We use microseconds
-- here because that tends to be what GHC (at least) tends to use as its 
-- system-level minimum tick size.
class TimeUnit a where
  -- |Converts the given unit of time into microseconds, flooring the value
  -- if it comes to a fractional number of microseconds. (In other words:
  -- be careful, you may lose precision!)
  toMicroseconds   :: a -> Integer
  -- |Converts the given number of microseconds into the unit of time, flooring
  -- the value if it comes to a fraction number of the given unit. (In other
  -- words: be careful, you may lose precision!)
  fromMicroseconds :: Integer -> a

-- |Add two times together to get a useful third time unit. As per usual,
-- you'll want to make sure that you are careful regarding precision. This
-- function goes through microseconds as an intermediary form.
addTime :: (TimeUnit a, TimeUnit b, TimeUnit c) => a -> b -> c
addTime :: a -> b -> c
addTime a
x b
y = Integer -> c
forall a. TimeUnit a => Integer -> a
fromMicroseconds (a -> Integer
forall a. TimeUnit a => a -> Integer
toMicroseconds a
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ b -> Integer
forall a. TimeUnit a => a -> Integer
toMicroseconds b
y)

-- |Subtract the second time from the first, to get a useful third time unit.
-- As per usual, you'll want to make sure that you are careful regarding
-- precision. This function goes through microseconds as an intermediary form.
subTime :: (TimeUnit a, TimeUnit b, TimeUnit c) => a -> b -> c
subTime :: a -> b -> c
subTime a
x b
y = Integer -> c
forall a. TimeUnit a => Integer -> a
fromMicroseconds (a -> Integer
forall a. TimeUnit a => a -> Integer
toMicroseconds a
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- b -> Integer
forall a. TimeUnit a => a -> Integer
toMicroseconds b
y)

-- |Convert one time unit to another. Note that if you move from a smaller
-- time unit to a larger one, or between two time units smaller than a
-- microsecond, you will lose precision.
convertUnit :: (TimeUnit a, TimeUnit b) => a -> b
convertUnit :: a -> b
convertUnit = Integer -> b
forall a. TimeUnit a => Integer -> a
fromMicroseconds (Integer -> b) -> (a -> Integer) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a. TimeUnit a => a -> Integer
toMicroseconds

-- |Get the current CPU time in your favorite units. This is probably not
-- very useful in itself, but is likely useful for comparison purposes ...
getCPUTimeWithUnit :: TimeUnit a => IO a
getCPUTimeWithUnit :: IO a
getCPUTimeWithUnit =
  (Integer -> a
forall a. TimeUnit a => Integer -> a
fromMicroseconds (Integer -> a) -> (Integer -> Integer) -> Integer -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Picosecond -> Integer
forall a. TimeUnit a => a -> Integer
toMicroseconds (Picosecond -> Integer)
-> (Integer -> Picosecond) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Picosecond
Picosecond) (Integer -> a) -> IO Integer -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO Integer
getCPUTime

--

newtype Attosecond  = Attosecond  Integer
 deriving (Int -> Attosecond
Attosecond -> Int
Attosecond -> [Attosecond]
Attosecond -> Attosecond
Attosecond -> Attosecond -> [Attosecond]
Attosecond -> Attosecond -> Attosecond -> [Attosecond]
(Attosecond -> Attosecond)
-> (Attosecond -> Attosecond)
-> (Int -> Attosecond)
-> (Attosecond -> Int)
-> (Attosecond -> [Attosecond])
-> (Attosecond -> Attosecond -> [Attosecond])
-> (Attosecond -> Attosecond -> [Attosecond])
-> (Attosecond -> Attosecond -> Attosecond -> [Attosecond])
-> Enum Attosecond
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Attosecond -> Attosecond -> Attosecond -> [Attosecond]
$cenumFromThenTo :: Attosecond -> Attosecond -> Attosecond -> [Attosecond]
enumFromTo :: Attosecond -> Attosecond -> [Attosecond]
$cenumFromTo :: Attosecond -> Attosecond -> [Attosecond]
enumFromThen :: Attosecond -> Attosecond -> [Attosecond]
$cenumFromThen :: Attosecond -> Attosecond -> [Attosecond]
enumFrom :: Attosecond -> [Attosecond]
$cenumFrom :: Attosecond -> [Attosecond]
fromEnum :: Attosecond -> Int
$cfromEnum :: Attosecond -> Int
toEnum :: Int -> Attosecond
$ctoEnum :: Int -> Attosecond
pred :: Attosecond -> Attosecond
$cpred :: Attosecond -> Attosecond
succ :: Attosecond -> Attosecond
$csucc :: Attosecond -> Attosecond
Enum,Attosecond -> Attosecond -> Bool
(Attosecond -> Attosecond -> Bool)
-> (Attosecond -> Attosecond -> Bool) -> Eq Attosecond
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attosecond -> Attosecond -> Bool
$c/= :: Attosecond -> Attosecond -> Bool
== :: Attosecond -> Attosecond -> Bool
$c== :: Attosecond -> Attosecond -> Bool
Eq,Enum Attosecond
Real Attosecond
Real Attosecond
-> Enum Attosecond
-> (Attosecond -> Attosecond -> Attosecond)
-> (Attosecond -> Attosecond -> Attosecond)
-> (Attosecond -> Attosecond -> Attosecond)
-> (Attosecond -> Attosecond -> Attosecond)
-> (Attosecond -> Attosecond -> (Attosecond, Attosecond))
-> (Attosecond -> Attosecond -> (Attosecond, Attosecond))
-> (Attosecond -> Integer)
-> Integral Attosecond
Attosecond -> Integer
Attosecond -> Attosecond -> (Attosecond, Attosecond)
Attosecond -> Attosecond -> Attosecond
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Attosecond -> Integer
$ctoInteger :: Attosecond -> Integer
divMod :: Attosecond -> Attosecond -> (Attosecond, Attosecond)
$cdivMod :: Attosecond -> Attosecond -> (Attosecond, Attosecond)
quotRem :: Attosecond -> Attosecond -> (Attosecond, Attosecond)
$cquotRem :: Attosecond -> Attosecond -> (Attosecond, Attosecond)
mod :: Attosecond -> Attosecond -> Attosecond
$cmod :: Attosecond -> Attosecond -> Attosecond
div :: Attosecond -> Attosecond -> Attosecond
$cdiv :: Attosecond -> Attosecond -> Attosecond
rem :: Attosecond -> Attosecond -> Attosecond
$crem :: Attosecond -> Attosecond -> Attosecond
quot :: Attosecond -> Attosecond -> Attosecond
$cquot :: Attosecond -> Attosecond -> Attosecond
$cp2Integral :: Enum Attosecond
$cp1Integral :: Real Attosecond
Integral,Typeable Attosecond
DataType
Constr
Typeable Attosecond
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Attosecond -> c Attosecond)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Attosecond)
-> (Attosecond -> Constr)
-> (Attosecond -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Attosecond))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Attosecond))
-> ((forall b. Data b => b -> b) -> Attosecond -> Attosecond)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Attosecond -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Attosecond -> r)
-> (forall u. (forall d. Data d => d -> u) -> Attosecond -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Attosecond -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Attosecond -> m Attosecond)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Attosecond -> m Attosecond)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Attosecond -> m Attosecond)
-> Data Attosecond
Attosecond -> DataType
Attosecond -> Constr
(forall b. Data b => b -> b) -> Attosecond -> Attosecond
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attosecond -> c Attosecond
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attosecond
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Attosecond -> u
forall u. (forall d. Data d => d -> u) -> Attosecond -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Attosecond -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Attosecond -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Attosecond -> m Attosecond
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attosecond -> m Attosecond
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attosecond
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attosecond -> c Attosecond
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Attosecond)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attosecond)
$cAttosecond :: Constr
$tAttosecond :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Attosecond -> m Attosecond
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attosecond -> m Attosecond
gmapMp :: (forall d. Data d => d -> m d) -> Attosecond -> m Attosecond
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Attosecond -> m Attosecond
gmapM :: (forall d. Data d => d -> m d) -> Attosecond -> m Attosecond
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Attosecond -> m Attosecond
gmapQi :: Int -> (forall d. Data d => d -> u) -> Attosecond -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Attosecond -> u
gmapQ :: (forall d. Data d => d -> u) -> Attosecond -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Attosecond -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Attosecond -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Attosecond -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Attosecond -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Attosecond -> r
gmapT :: (forall b. Data b => b -> b) -> Attosecond -> Attosecond
$cgmapT :: (forall b. Data b => b -> b) -> Attosecond -> Attosecond
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attosecond)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Attosecond)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Attosecond)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Attosecond)
dataTypeOf :: Attosecond -> DataType
$cdataTypeOf :: Attosecond -> DataType
toConstr :: Attosecond -> Constr
$ctoConstr :: Attosecond -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attosecond
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Attosecond
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attosecond -> c Attosecond
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Attosecond -> c Attosecond
$cp1Data :: Typeable Attosecond
Data,Integer -> Attosecond
Attosecond -> Attosecond
Attosecond -> Attosecond -> Attosecond
(Attosecond -> Attosecond -> Attosecond)
-> (Attosecond -> Attosecond -> Attosecond)
-> (Attosecond -> Attosecond -> Attosecond)
-> (Attosecond -> Attosecond)
-> (Attosecond -> Attosecond)
-> (Attosecond -> Attosecond)
-> (Integer -> Attosecond)
-> Num Attosecond
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Attosecond
$cfromInteger :: Integer -> Attosecond
signum :: Attosecond -> Attosecond
$csignum :: Attosecond -> Attosecond
abs :: Attosecond -> Attosecond
$cabs :: Attosecond -> Attosecond
negate :: Attosecond -> Attosecond
$cnegate :: Attosecond -> Attosecond
* :: Attosecond -> Attosecond -> Attosecond
$c* :: Attosecond -> Attosecond -> Attosecond
- :: Attosecond -> Attosecond -> Attosecond
$c- :: Attosecond -> Attosecond -> Attosecond
+ :: Attosecond -> Attosecond -> Attosecond
$c+ :: Attosecond -> Attosecond -> Attosecond
Num,Eq Attosecond
Eq Attosecond
-> (Attosecond -> Attosecond -> Ordering)
-> (Attosecond -> Attosecond -> Bool)
-> (Attosecond -> Attosecond -> Bool)
-> (Attosecond -> Attosecond -> Bool)
-> (Attosecond -> Attosecond -> Bool)
-> (Attosecond -> Attosecond -> Attosecond)
-> (Attosecond -> Attosecond -> Attosecond)
-> Ord Attosecond
Attosecond -> Attosecond -> Bool
Attosecond -> Attosecond -> Ordering
Attosecond -> Attosecond -> Attosecond
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Attosecond -> Attosecond -> Attosecond
$cmin :: Attosecond -> Attosecond -> Attosecond
max :: Attosecond -> Attosecond -> Attosecond
$cmax :: Attosecond -> Attosecond -> Attosecond
>= :: Attosecond -> Attosecond -> Bool
$c>= :: Attosecond -> Attosecond -> Bool
> :: Attosecond -> Attosecond -> Bool
$c> :: Attosecond -> Attosecond -> Bool
<= :: Attosecond -> Attosecond -> Bool
$c<= :: Attosecond -> Attosecond -> Bool
< :: Attosecond -> Attosecond -> Bool
$c< :: Attosecond -> Attosecond -> Bool
compare :: Attosecond -> Attosecond -> Ordering
$ccompare :: Attosecond -> Attosecond -> Ordering
$cp1Ord :: Eq Attosecond
Ord,Num Attosecond
Ord Attosecond
Num Attosecond
-> Ord Attosecond -> (Attosecond -> Rational) -> Real Attosecond
Attosecond -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Attosecond -> Rational
$ctoRational :: Attosecond -> Rational
$cp2Real :: Ord Attosecond
$cp1Real :: Num Attosecond
Real,Ord Attosecond
Ord Attosecond
-> ((Attosecond, Attosecond) -> [Attosecond])
-> ((Attosecond, Attosecond) -> Attosecond -> Int)
-> ((Attosecond, Attosecond) -> Attosecond -> Int)
-> ((Attosecond, Attosecond) -> Attosecond -> Bool)
-> ((Attosecond, Attosecond) -> Int)
-> ((Attosecond, Attosecond) -> Int)
-> Ix Attosecond
(Attosecond, Attosecond) -> Int
(Attosecond, Attosecond) -> [Attosecond]
(Attosecond, Attosecond) -> Attosecond -> Bool
(Attosecond, Attosecond) -> Attosecond -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Attosecond, Attosecond) -> Int
$cunsafeRangeSize :: (Attosecond, Attosecond) -> Int
rangeSize :: (Attosecond, Attosecond) -> Int
$crangeSize :: (Attosecond, Attosecond) -> Int
inRange :: (Attosecond, Attosecond) -> Attosecond -> Bool
$cinRange :: (Attosecond, Attosecond) -> Attosecond -> Bool
unsafeIndex :: (Attosecond, Attosecond) -> Attosecond -> Int
$cunsafeIndex :: (Attosecond, Attosecond) -> Attosecond -> Int
index :: (Attosecond, Attosecond) -> Attosecond -> Int
$cindex :: (Attosecond, Attosecond) -> Attosecond -> Int
range :: (Attosecond, Attosecond) -> [Attosecond]
$crange :: (Attosecond, Attosecond) -> [Attosecond]
$cp1Ix :: Ord Attosecond
Ix,Typeable)

instance TimeUnit Attosecond where
  toMicroseconds :: Attosecond -> Integer
toMicroseconds (Attosecond Integer
x) = Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
12)
  fromMicroseconds :: Integer -> Attosecond
fromMicroseconds Integer
x            = Integer -> Attosecond
Attosecond (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
12))
instance Show Attosecond where
  show :: Attosecond -> String
show (Attosecond Integer
x) = Integer -> String
forall a. Show a => a -> String
show Integer
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"as"
instance Read Attosecond where
  readsPrec :: Int -> ReadS Attosecond
readsPrec = (Integer -> Attosecond) -> String -> Int -> ReadS Attosecond
forall a.
(Integer -> a) -> String -> Int -> String -> [(a, String)]
readUnit Integer -> Attosecond
Attosecond String
"as"

readUnit :: (Integer -> a) -> String ->
            Int -> String ->
            [(a, String)]
readUnit :: (Integer -> a) -> String -> Int -> String -> [(a, String)]
readUnit Integer -> a
builder String
unitstr Int
prec String
str = (Integer -> a) -> [(Integer, String)] -> [(a, String)]
forall a. (Integer -> a) -> [(Integer, String)] -> [(a, String)]
processItems Integer -> a
builder (Int -> ReadS Integer
forall a. Read a => Int -> ReadS a
readsPrec Int
prec String
str)
 where
  processItems :: (Integer -> a) -> [(Integer,String)] -> [(a,String)]
  processItems :: (Integer -> a) -> [(Integer, String)] -> [(a, String)]
processItems Integer -> a
builder  [] = []
  processItems Integer -> a
builder ((Integer
a,String
s):[(Integer, String)]
rest)
    | String
unitstr String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s =
           (Integer -> a
builder Integer
a, Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
unitstr) String
s) (a, String) -> [(a, String)] -> [(a, String)]
forall a. a -> [a] -> [a]
: ((Integer -> a) -> [(Integer, String)] -> [(a, String)]
forall a. (Integer -> a) -> [(Integer, String)] -> [(a, String)]
processItems Integer -> a
builder [(Integer, String)]
rest)
        | Bool
otherwise              =
           (Integer -> a) -> [(Integer, String)] -> [(a, String)]
forall a. (Integer -> a) -> [(Integer, String)] -> [(a, String)]
processItems Integer -> a
builder [(Integer, String)]
rest

--

newtype Femtosecond = Femtosecond Integer
 deriving (Int -> Femtosecond
Femtosecond -> Int
Femtosecond -> [Femtosecond]
Femtosecond -> Femtosecond
Femtosecond -> Femtosecond -> [Femtosecond]
Femtosecond -> Femtosecond -> Femtosecond -> [Femtosecond]
(Femtosecond -> Femtosecond)
-> (Femtosecond -> Femtosecond)
-> (Int -> Femtosecond)
-> (Femtosecond -> Int)
-> (Femtosecond -> [Femtosecond])
-> (Femtosecond -> Femtosecond -> [Femtosecond])
-> (Femtosecond -> Femtosecond -> [Femtosecond])
-> (Femtosecond -> Femtosecond -> Femtosecond -> [Femtosecond])
-> Enum Femtosecond
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Femtosecond -> Femtosecond -> Femtosecond -> [Femtosecond]
$cenumFromThenTo :: Femtosecond -> Femtosecond -> Femtosecond -> [Femtosecond]
enumFromTo :: Femtosecond -> Femtosecond -> [Femtosecond]
$cenumFromTo :: Femtosecond -> Femtosecond -> [Femtosecond]
enumFromThen :: Femtosecond -> Femtosecond -> [Femtosecond]
$cenumFromThen :: Femtosecond -> Femtosecond -> [Femtosecond]
enumFrom :: Femtosecond -> [Femtosecond]
$cenumFrom :: Femtosecond -> [Femtosecond]
fromEnum :: Femtosecond -> Int
$cfromEnum :: Femtosecond -> Int
toEnum :: Int -> Femtosecond
$ctoEnum :: Int -> Femtosecond
pred :: Femtosecond -> Femtosecond
$cpred :: Femtosecond -> Femtosecond
succ :: Femtosecond -> Femtosecond
$csucc :: Femtosecond -> Femtosecond
Enum,Femtosecond -> Femtosecond -> Bool
(Femtosecond -> Femtosecond -> Bool)
-> (Femtosecond -> Femtosecond -> Bool) -> Eq Femtosecond
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Femtosecond -> Femtosecond -> Bool
$c/= :: Femtosecond -> Femtosecond -> Bool
== :: Femtosecond -> Femtosecond -> Bool
$c== :: Femtosecond -> Femtosecond -> Bool
Eq,Enum Femtosecond
Real Femtosecond
Real Femtosecond
-> Enum Femtosecond
-> (Femtosecond -> Femtosecond -> Femtosecond)
-> (Femtosecond -> Femtosecond -> Femtosecond)
-> (Femtosecond -> Femtosecond -> Femtosecond)
-> (Femtosecond -> Femtosecond -> Femtosecond)
-> (Femtosecond -> Femtosecond -> (Femtosecond, Femtosecond))
-> (Femtosecond -> Femtosecond -> (Femtosecond, Femtosecond))
-> (Femtosecond -> Integer)
-> Integral Femtosecond
Femtosecond -> Integer
Femtosecond -> Femtosecond -> (Femtosecond, Femtosecond)
Femtosecond -> Femtosecond -> Femtosecond
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Femtosecond -> Integer
$ctoInteger :: Femtosecond -> Integer
divMod :: Femtosecond -> Femtosecond -> (Femtosecond, Femtosecond)
$cdivMod :: Femtosecond -> Femtosecond -> (Femtosecond, Femtosecond)
quotRem :: Femtosecond -> Femtosecond -> (Femtosecond, Femtosecond)
$cquotRem :: Femtosecond -> Femtosecond -> (Femtosecond, Femtosecond)
mod :: Femtosecond -> Femtosecond -> Femtosecond
$cmod :: Femtosecond -> Femtosecond -> Femtosecond
div :: Femtosecond -> Femtosecond -> Femtosecond
$cdiv :: Femtosecond -> Femtosecond -> Femtosecond
rem :: Femtosecond -> Femtosecond -> Femtosecond
$crem :: Femtosecond -> Femtosecond -> Femtosecond
quot :: Femtosecond -> Femtosecond -> Femtosecond
$cquot :: Femtosecond -> Femtosecond -> Femtosecond
$cp2Integral :: Enum Femtosecond
$cp1Integral :: Real Femtosecond
Integral,Typeable Femtosecond
DataType
Constr
Typeable Femtosecond
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Femtosecond -> c Femtosecond)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Femtosecond)
-> (Femtosecond -> Constr)
-> (Femtosecond -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Femtosecond))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Femtosecond))
-> ((forall b. Data b => b -> b) -> Femtosecond -> Femtosecond)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Femtosecond -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Femtosecond -> r)
-> (forall u. (forall d. Data d => d -> u) -> Femtosecond -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Femtosecond -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Femtosecond -> m Femtosecond)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Femtosecond -> m Femtosecond)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Femtosecond -> m Femtosecond)
-> Data Femtosecond
Femtosecond -> DataType
Femtosecond -> Constr
(forall b. Data b => b -> b) -> Femtosecond -> Femtosecond
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Femtosecond -> c Femtosecond
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Femtosecond
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Femtosecond -> u
forall u. (forall d. Data d => d -> u) -> Femtosecond -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Femtosecond -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Femtosecond -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Femtosecond -> m Femtosecond
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Femtosecond -> m Femtosecond
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Femtosecond
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Femtosecond -> c Femtosecond
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Femtosecond)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Femtosecond)
$cFemtosecond :: Constr
$tFemtosecond :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Femtosecond -> m Femtosecond
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Femtosecond -> m Femtosecond
gmapMp :: (forall d. Data d => d -> m d) -> Femtosecond -> m Femtosecond
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Femtosecond -> m Femtosecond
gmapM :: (forall d. Data d => d -> m d) -> Femtosecond -> m Femtosecond
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Femtosecond -> m Femtosecond
gmapQi :: Int -> (forall d. Data d => d -> u) -> Femtosecond -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Femtosecond -> u
gmapQ :: (forall d. Data d => d -> u) -> Femtosecond -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Femtosecond -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Femtosecond -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Femtosecond -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Femtosecond -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Femtosecond -> r
gmapT :: (forall b. Data b => b -> b) -> Femtosecond -> Femtosecond
$cgmapT :: (forall b. Data b => b -> b) -> Femtosecond -> Femtosecond
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Femtosecond)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Femtosecond)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Femtosecond)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Femtosecond)
dataTypeOf :: Femtosecond -> DataType
$cdataTypeOf :: Femtosecond -> DataType
toConstr :: Femtosecond -> Constr
$ctoConstr :: Femtosecond -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Femtosecond
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Femtosecond
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Femtosecond -> c Femtosecond
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Femtosecond -> c Femtosecond
$cp1Data :: Typeable Femtosecond
Data,Integer -> Femtosecond
Femtosecond -> Femtosecond
Femtosecond -> Femtosecond -> Femtosecond
(Femtosecond -> Femtosecond -> Femtosecond)
-> (Femtosecond -> Femtosecond -> Femtosecond)
-> (Femtosecond -> Femtosecond -> Femtosecond)
-> (Femtosecond -> Femtosecond)
-> (Femtosecond -> Femtosecond)
-> (Femtosecond -> Femtosecond)
-> (Integer -> Femtosecond)
-> Num Femtosecond
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Femtosecond
$cfromInteger :: Integer -> Femtosecond
signum :: Femtosecond -> Femtosecond
$csignum :: Femtosecond -> Femtosecond
abs :: Femtosecond -> Femtosecond
$cabs :: Femtosecond -> Femtosecond
negate :: Femtosecond -> Femtosecond
$cnegate :: Femtosecond -> Femtosecond
* :: Femtosecond -> Femtosecond -> Femtosecond
$c* :: Femtosecond -> Femtosecond -> Femtosecond
- :: Femtosecond -> Femtosecond -> Femtosecond
$c- :: Femtosecond -> Femtosecond -> Femtosecond
+ :: Femtosecond -> Femtosecond -> Femtosecond
$c+ :: Femtosecond -> Femtosecond -> Femtosecond
Num,Eq Femtosecond
Eq Femtosecond
-> (Femtosecond -> Femtosecond -> Ordering)
-> (Femtosecond -> Femtosecond -> Bool)
-> (Femtosecond -> Femtosecond -> Bool)
-> (Femtosecond -> Femtosecond -> Bool)
-> (Femtosecond -> Femtosecond -> Bool)
-> (Femtosecond -> Femtosecond -> Femtosecond)
-> (Femtosecond -> Femtosecond -> Femtosecond)
-> Ord Femtosecond
Femtosecond -> Femtosecond -> Bool
Femtosecond -> Femtosecond -> Ordering
Femtosecond -> Femtosecond -> Femtosecond
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Femtosecond -> Femtosecond -> Femtosecond
$cmin :: Femtosecond -> Femtosecond -> Femtosecond
max :: Femtosecond -> Femtosecond -> Femtosecond
$cmax :: Femtosecond -> Femtosecond -> Femtosecond
>= :: Femtosecond -> Femtosecond -> Bool
$c>= :: Femtosecond -> Femtosecond -> Bool
> :: Femtosecond -> Femtosecond -> Bool
$c> :: Femtosecond -> Femtosecond -> Bool
<= :: Femtosecond -> Femtosecond -> Bool
$c<= :: Femtosecond -> Femtosecond -> Bool
< :: Femtosecond -> Femtosecond -> Bool
$c< :: Femtosecond -> Femtosecond -> Bool
compare :: Femtosecond -> Femtosecond -> Ordering
$ccompare :: Femtosecond -> Femtosecond -> Ordering
$cp1Ord :: Eq Femtosecond
Ord,Num Femtosecond
Ord Femtosecond
Num Femtosecond
-> Ord Femtosecond -> (Femtosecond -> Rational) -> Real Femtosecond
Femtosecond -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Femtosecond -> Rational
$ctoRational :: Femtosecond -> Rational
$cp2Real :: Ord Femtosecond
$cp1Real :: Num Femtosecond
Real,Ord Femtosecond
Ord Femtosecond
-> ((Femtosecond, Femtosecond) -> [Femtosecond])
-> ((Femtosecond, Femtosecond) -> Femtosecond -> Int)
-> ((Femtosecond, Femtosecond) -> Femtosecond -> Int)
-> ((Femtosecond, Femtosecond) -> Femtosecond -> Bool)
-> ((Femtosecond, Femtosecond) -> Int)
-> ((Femtosecond, Femtosecond) -> Int)
-> Ix Femtosecond
(Femtosecond, Femtosecond) -> Int
(Femtosecond, Femtosecond) -> [Femtosecond]
(Femtosecond, Femtosecond) -> Femtosecond -> Bool
(Femtosecond, Femtosecond) -> Femtosecond -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Femtosecond, Femtosecond) -> Int
$cunsafeRangeSize :: (Femtosecond, Femtosecond) -> Int
rangeSize :: (Femtosecond, Femtosecond) -> Int
$crangeSize :: (Femtosecond, Femtosecond) -> Int
inRange :: (Femtosecond, Femtosecond) -> Femtosecond -> Bool
$cinRange :: (Femtosecond, Femtosecond) -> Femtosecond -> Bool
unsafeIndex :: (Femtosecond, Femtosecond) -> Femtosecond -> Int
$cunsafeIndex :: (Femtosecond, Femtosecond) -> Femtosecond -> Int
index :: (Femtosecond, Femtosecond) -> Femtosecond -> Int
$cindex :: (Femtosecond, Femtosecond) -> Femtosecond -> Int
range :: (Femtosecond, Femtosecond) -> [Femtosecond]
$crange :: (Femtosecond, Femtosecond) -> [Femtosecond]
$cp1Ix :: Ord Femtosecond
Ix,Typeable)

instance TimeUnit Femtosecond where
  toMicroseconds :: Femtosecond -> Integer
toMicroseconds (Femtosecond Integer
x) = Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
9)
  fromMicroseconds :: Integer -> Femtosecond
fromMicroseconds Integer
x             = Integer -> Femtosecond
Femtosecond (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
9))
instance Show Femtosecond where
  show :: Femtosecond -> String
show (Femtosecond Integer
x) = Integer -> String
forall a. Show a => a -> String
show Integer
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"fs"
instance Read Femtosecond where
  readsPrec :: Int -> ReadS Femtosecond
readsPrec = (Integer -> Femtosecond) -> String -> Int -> ReadS Femtosecond
forall a.
(Integer -> a) -> String -> Int -> String -> [(a, String)]
readUnit Integer -> Femtosecond
Femtosecond String
"fs"

--

newtype Picosecond  = Picosecond  Integer
 deriving (Int -> Picosecond
Picosecond -> Int
Picosecond -> [Picosecond]
Picosecond -> Picosecond
Picosecond -> Picosecond -> [Picosecond]
Picosecond -> Picosecond -> Picosecond -> [Picosecond]
(Picosecond -> Picosecond)
-> (Picosecond -> Picosecond)
-> (Int -> Picosecond)
-> (Picosecond -> Int)
-> (Picosecond -> [Picosecond])
-> (Picosecond -> Picosecond -> [Picosecond])
-> (Picosecond -> Picosecond -> [Picosecond])
-> (Picosecond -> Picosecond -> Picosecond -> [Picosecond])
-> Enum Picosecond
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Picosecond -> Picosecond -> Picosecond -> [Picosecond]
$cenumFromThenTo :: Picosecond -> Picosecond -> Picosecond -> [Picosecond]
enumFromTo :: Picosecond -> Picosecond -> [Picosecond]
$cenumFromTo :: Picosecond -> Picosecond -> [Picosecond]
enumFromThen :: Picosecond -> Picosecond -> [Picosecond]
$cenumFromThen :: Picosecond -> Picosecond -> [Picosecond]
enumFrom :: Picosecond -> [Picosecond]
$cenumFrom :: Picosecond -> [Picosecond]
fromEnum :: Picosecond -> Int
$cfromEnum :: Picosecond -> Int
toEnum :: Int -> Picosecond
$ctoEnum :: Int -> Picosecond
pred :: Picosecond -> Picosecond
$cpred :: Picosecond -> Picosecond
succ :: Picosecond -> Picosecond
$csucc :: Picosecond -> Picosecond
Enum,Picosecond -> Picosecond -> Bool
(Picosecond -> Picosecond -> Bool)
-> (Picosecond -> Picosecond -> Bool) -> Eq Picosecond
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Picosecond -> Picosecond -> Bool
$c/= :: Picosecond -> Picosecond -> Bool
== :: Picosecond -> Picosecond -> Bool
$c== :: Picosecond -> Picosecond -> Bool
Eq,Enum Picosecond
Real Picosecond
Real Picosecond
-> Enum Picosecond
-> (Picosecond -> Picosecond -> Picosecond)
-> (Picosecond -> Picosecond -> Picosecond)
-> (Picosecond -> Picosecond -> Picosecond)
-> (Picosecond -> Picosecond -> Picosecond)
-> (Picosecond -> Picosecond -> (Picosecond, Picosecond))
-> (Picosecond -> Picosecond -> (Picosecond, Picosecond))
-> (Picosecond -> Integer)
-> Integral Picosecond
Picosecond -> Integer
Picosecond -> Picosecond -> (Picosecond, Picosecond)
Picosecond -> Picosecond -> Picosecond
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Picosecond -> Integer
$ctoInteger :: Picosecond -> Integer
divMod :: Picosecond -> Picosecond -> (Picosecond, Picosecond)
$cdivMod :: Picosecond -> Picosecond -> (Picosecond, Picosecond)
quotRem :: Picosecond -> Picosecond -> (Picosecond, Picosecond)
$cquotRem :: Picosecond -> Picosecond -> (Picosecond, Picosecond)
mod :: Picosecond -> Picosecond -> Picosecond
$cmod :: Picosecond -> Picosecond -> Picosecond
div :: Picosecond -> Picosecond -> Picosecond
$cdiv :: Picosecond -> Picosecond -> Picosecond
rem :: Picosecond -> Picosecond -> Picosecond
$crem :: Picosecond -> Picosecond -> Picosecond
quot :: Picosecond -> Picosecond -> Picosecond
$cquot :: Picosecond -> Picosecond -> Picosecond
$cp2Integral :: Enum Picosecond
$cp1Integral :: Real Picosecond
Integral,Typeable Picosecond
DataType
Constr
Typeable Picosecond
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Picosecond -> c Picosecond)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Picosecond)
-> (Picosecond -> Constr)
-> (Picosecond -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Picosecond))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Picosecond))
-> ((forall b. Data b => b -> b) -> Picosecond -> Picosecond)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Picosecond -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Picosecond -> r)
-> (forall u. (forall d. Data d => d -> u) -> Picosecond -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Picosecond -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Picosecond -> m Picosecond)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Picosecond -> m Picosecond)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Picosecond -> m Picosecond)
-> Data Picosecond
Picosecond -> DataType
Picosecond -> Constr
(forall b. Data b => b -> b) -> Picosecond -> Picosecond
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Picosecond -> c Picosecond
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Picosecond
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Picosecond -> u
forall u. (forall d. Data d => d -> u) -> Picosecond -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Picosecond -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Picosecond -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Picosecond -> m Picosecond
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Picosecond -> m Picosecond
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Picosecond
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Picosecond -> c Picosecond
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Picosecond)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Picosecond)
$cPicosecond :: Constr
$tPicosecond :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Picosecond -> m Picosecond
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Picosecond -> m Picosecond
gmapMp :: (forall d. Data d => d -> m d) -> Picosecond -> m Picosecond
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Picosecond -> m Picosecond
gmapM :: (forall d. Data d => d -> m d) -> Picosecond -> m Picosecond
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Picosecond -> m Picosecond
gmapQi :: Int -> (forall d. Data d => d -> u) -> Picosecond -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Picosecond -> u
gmapQ :: (forall d. Data d => d -> u) -> Picosecond -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Picosecond -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Picosecond -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Picosecond -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Picosecond -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Picosecond -> r
gmapT :: (forall b. Data b => b -> b) -> Picosecond -> Picosecond
$cgmapT :: (forall b. Data b => b -> b) -> Picosecond -> Picosecond
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Picosecond)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Picosecond)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Picosecond)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Picosecond)
dataTypeOf :: Picosecond -> DataType
$cdataTypeOf :: Picosecond -> DataType
toConstr :: Picosecond -> Constr
$ctoConstr :: Picosecond -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Picosecond
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Picosecond
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Picosecond -> c Picosecond
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Picosecond -> c Picosecond
$cp1Data :: Typeable Picosecond
Data,Integer -> Picosecond
Picosecond -> Picosecond
Picosecond -> Picosecond -> Picosecond
(Picosecond -> Picosecond -> Picosecond)
-> (Picosecond -> Picosecond -> Picosecond)
-> (Picosecond -> Picosecond -> Picosecond)
-> (Picosecond -> Picosecond)
-> (Picosecond -> Picosecond)
-> (Picosecond -> Picosecond)
-> (Integer -> Picosecond)
-> Num Picosecond
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Picosecond
$cfromInteger :: Integer -> Picosecond
signum :: Picosecond -> Picosecond
$csignum :: Picosecond -> Picosecond
abs :: Picosecond -> Picosecond
$cabs :: Picosecond -> Picosecond
negate :: Picosecond -> Picosecond
$cnegate :: Picosecond -> Picosecond
* :: Picosecond -> Picosecond -> Picosecond
$c* :: Picosecond -> Picosecond -> Picosecond
- :: Picosecond -> Picosecond -> Picosecond
$c- :: Picosecond -> Picosecond -> Picosecond
+ :: Picosecond -> Picosecond -> Picosecond
$c+ :: Picosecond -> Picosecond -> Picosecond
Num,Eq Picosecond
Eq Picosecond
-> (Picosecond -> Picosecond -> Ordering)
-> (Picosecond -> Picosecond -> Bool)
-> (Picosecond -> Picosecond -> Bool)
-> (Picosecond -> Picosecond -> Bool)
-> (Picosecond -> Picosecond -> Bool)
-> (Picosecond -> Picosecond -> Picosecond)
-> (Picosecond -> Picosecond -> Picosecond)
-> Ord Picosecond
Picosecond -> Picosecond -> Bool
Picosecond -> Picosecond -> Ordering
Picosecond -> Picosecond -> Picosecond
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Picosecond -> Picosecond -> Picosecond
$cmin :: Picosecond -> Picosecond -> Picosecond
max :: Picosecond -> Picosecond -> Picosecond
$cmax :: Picosecond -> Picosecond -> Picosecond
>= :: Picosecond -> Picosecond -> Bool
$c>= :: Picosecond -> Picosecond -> Bool
> :: Picosecond -> Picosecond -> Bool
$c> :: Picosecond -> Picosecond -> Bool
<= :: Picosecond -> Picosecond -> Bool
$c<= :: Picosecond -> Picosecond -> Bool
< :: Picosecond -> Picosecond -> Bool
$c< :: Picosecond -> Picosecond -> Bool
compare :: Picosecond -> Picosecond -> Ordering
$ccompare :: Picosecond -> Picosecond -> Ordering
$cp1Ord :: Eq Picosecond
Ord,Num Picosecond
Ord Picosecond
Num Picosecond
-> Ord Picosecond -> (Picosecond -> Rational) -> Real Picosecond
Picosecond -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Picosecond -> Rational
$ctoRational :: Picosecond -> Rational
$cp2Real :: Ord Picosecond
$cp1Real :: Num Picosecond
Real,Ord Picosecond
Ord Picosecond
-> ((Picosecond, Picosecond) -> [Picosecond])
-> ((Picosecond, Picosecond) -> Picosecond -> Int)
-> ((Picosecond, Picosecond) -> Picosecond -> Int)
-> ((Picosecond, Picosecond) -> Picosecond -> Bool)
-> ((Picosecond, Picosecond) -> Int)
-> ((Picosecond, Picosecond) -> Int)
-> Ix Picosecond
(Picosecond, Picosecond) -> Int
(Picosecond, Picosecond) -> [Picosecond]
(Picosecond, Picosecond) -> Picosecond -> Bool
(Picosecond, Picosecond) -> Picosecond -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Picosecond, Picosecond) -> Int
$cunsafeRangeSize :: (Picosecond, Picosecond) -> Int
rangeSize :: (Picosecond, Picosecond) -> Int
$crangeSize :: (Picosecond, Picosecond) -> Int
inRange :: (Picosecond, Picosecond) -> Picosecond -> Bool
$cinRange :: (Picosecond, Picosecond) -> Picosecond -> Bool
unsafeIndex :: (Picosecond, Picosecond) -> Picosecond -> Int
$cunsafeIndex :: (Picosecond, Picosecond) -> Picosecond -> Int
index :: (Picosecond, Picosecond) -> Picosecond -> Int
$cindex :: (Picosecond, Picosecond) -> Picosecond -> Int
range :: (Picosecond, Picosecond) -> [Picosecond]
$crange :: (Picosecond, Picosecond) -> [Picosecond]
$cp1Ix :: Ord Picosecond
Ix,Typeable)

instance TimeUnit Picosecond where
  toMicroseconds :: Picosecond -> Integer
toMicroseconds (Picosecond Integer
x) = Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6)
  fromMicroseconds :: Integer -> Picosecond
fromMicroseconds Integer
x            = Integer -> Picosecond
Picosecond (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6))
instance Show Picosecond where
  show :: Picosecond -> String
show (Picosecond Integer
x) = Integer -> String
forall a. Show a => a -> String
show Integer
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"ps"
instance Read Picosecond where
  readsPrec :: Int -> ReadS Picosecond
readsPrec = (Integer -> Picosecond) -> String -> Int -> ReadS Picosecond
forall a.
(Integer -> a) -> String -> Int -> String -> [(a, String)]
readUnit Integer -> Picosecond
Picosecond String
"ps"

--

newtype Nanosecond  = Nanosecond  Integer
 deriving (Int -> Nanosecond
Nanosecond -> Int
Nanosecond -> [Nanosecond]
Nanosecond -> Nanosecond
Nanosecond -> Nanosecond -> [Nanosecond]
Nanosecond -> Nanosecond -> Nanosecond -> [Nanosecond]
(Nanosecond -> Nanosecond)
-> (Nanosecond -> Nanosecond)
-> (Int -> Nanosecond)
-> (Nanosecond -> Int)
-> (Nanosecond -> [Nanosecond])
-> (Nanosecond -> Nanosecond -> [Nanosecond])
-> (Nanosecond -> Nanosecond -> [Nanosecond])
-> (Nanosecond -> Nanosecond -> Nanosecond -> [Nanosecond])
-> Enum Nanosecond
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Nanosecond -> Nanosecond -> Nanosecond -> [Nanosecond]
$cenumFromThenTo :: Nanosecond -> Nanosecond -> Nanosecond -> [Nanosecond]
enumFromTo :: Nanosecond -> Nanosecond -> [Nanosecond]
$cenumFromTo :: Nanosecond -> Nanosecond -> [Nanosecond]
enumFromThen :: Nanosecond -> Nanosecond -> [Nanosecond]
$cenumFromThen :: Nanosecond -> Nanosecond -> [Nanosecond]
enumFrom :: Nanosecond -> [Nanosecond]
$cenumFrom :: Nanosecond -> [Nanosecond]
fromEnum :: Nanosecond -> Int
$cfromEnum :: Nanosecond -> Int
toEnum :: Int -> Nanosecond
$ctoEnum :: Int -> Nanosecond
pred :: Nanosecond -> Nanosecond
$cpred :: Nanosecond -> Nanosecond
succ :: Nanosecond -> Nanosecond
$csucc :: Nanosecond -> Nanosecond
Enum,Nanosecond -> Nanosecond -> Bool
(Nanosecond -> Nanosecond -> Bool)
-> (Nanosecond -> Nanosecond -> Bool) -> Eq Nanosecond
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nanosecond -> Nanosecond -> Bool
$c/= :: Nanosecond -> Nanosecond -> Bool
== :: Nanosecond -> Nanosecond -> Bool
$c== :: Nanosecond -> Nanosecond -> Bool
Eq,Enum Nanosecond
Real Nanosecond
Real Nanosecond
-> Enum Nanosecond
-> (Nanosecond -> Nanosecond -> Nanosecond)
-> (Nanosecond -> Nanosecond -> Nanosecond)
-> (Nanosecond -> Nanosecond -> Nanosecond)
-> (Nanosecond -> Nanosecond -> Nanosecond)
-> (Nanosecond -> Nanosecond -> (Nanosecond, Nanosecond))
-> (Nanosecond -> Nanosecond -> (Nanosecond, Nanosecond))
-> (Nanosecond -> Integer)
-> Integral Nanosecond
Nanosecond -> Integer
Nanosecond -> Nanosecond -> (Nanosecond, Nanosecond)
Nanosecond -> Nanosecond -> Nanosecond
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Nanosecond -> Integer
$ctoInteger :: Nanosecond -> Integer
divMod :: Nanosecond -> Nanosecond -> (Nanosecond, Nanosecond)
$cdivMod :: Nanosecond -> Nanosecond -> (Nanosecond, Nanosecond)
quotRem :: Nanosecond -> Nanosecond -> (Nanosecond, Nanosecond)
$cquotRem :: Nanosecond -> Nanosecond -> (Nanosecond, Nanosecond)
mod :: Nanosecond -> Nanosecond -> Nanosecond
$cmod :: Nanosecond -> Nanosecond -> Nanosecond
div :: Nanosecond -> Nanosecond -> Nanosecond
$cdiv :: Nanosecond -> Nanosecond -> Nanosecond
rem :: Nanosecond -> Nanosecond -> Nanosecond
$crem :: Nanosecond -> Nanosecond -> Nanosecond
quot :: Nanosecond -> Nanosecond -> Nanosecond
$cquot :: Nanosecond -> Nanosecond -> Nanosecond
$cp2Integral :: Enum Nanosecond
$cp1Integral :: Real Nanosecond
Integral,Typeable Nanosecond
DataType
Constr
Typeable Nanosecond
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Nanosecond -> c Nanosecond)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Nanosecond)
-> (Nanosecond -> Constr)
-> (Nanosecond -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Nanosecond))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Nanosecond))
-> ((forall b. Data b => b -> b) -> Nanosecond -> Nanosecond)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Nanosecond -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Nanosecond -> r)
-> (forall u. (forall d. Data d => d -> u) -> Nanosecond -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Nanosecond -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Nanosecond -> m Nanosecond)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Nanosecond -> m Nanosecond)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Nanosecond -> m Nanosecond)
-> Data Nanosecond
Nanosecond -> DataType
Nanosecond -> Constr
(forall b. Data b => b -> b) -> Nanosecond -> Nanosecond
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Nanosecond -> c Nanosecond
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Nanosecond
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Nanosecond -> u
forall u. (forall d. Data d => d -> u) -> Nanosecond -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Nanosecond -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Nanosecond -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Nanosecond -> m Nanosecond
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Nanosecond -> m Nanosecond
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Nanosecond
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Nanosecond -> c Nanosecond
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Nanosecond)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Nanosecond)
$cNanosecond :: Constr
$tNanosecond :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Nanosecond -> m Nanosecond
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Nanosecond -> m Nanosecond
gmapMp :: (forall d. Data d => d -> m d) -> Nanosecond -> m Nanosecond
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Nanosecond -> m Nanosecond
gmapM :: (forall d. Data d => d -> m d) -> Nanosecond -> m Nanosecond
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Nanosecond -> m Nanosecond
gmapQi :: Int -> (forall d. Data d => d -> u) -> Nanosecond -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Nanosecond -> u
gmapQ :: (forall d. Data d => d -> u) -> Nanosecond -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Nanosecond -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Nanosecond -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Nanosecond -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Nanosecond -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Nanosecond -> r
gmapT :: (forall b. Data b => b -> b) -> Nanosecond -> Nanosecond
$cgmapT :: (forall b. Data b => b -> b) -> Nanosecond -> Nanosecond
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Nanosecond)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Nanosecond)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Nanosecond)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Nanosecond)
dataTypeOf :: Nanosecond -> DataType
$cdataTypeOf :: Nanosecond -> DataType
toConstr :: Nanosecond -> Constr
$ctoConstr :: Nanosecond -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Nanosecond
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Nanosecond
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Nanosecond -> c Nanosecond
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Nanosecond -> c Nanosecond
$cp1Data :: Typeable Nanosecond
Data,Integer -> Nanosecond
Nanosecond -> Nanosecond
Nanosecond -> Nanosecond -> Nanosecond
(Nanosecond -> Nanosecond -> Nanosecond)
-> (Nanosecond -> Nanosecond -> Nanosecond)
-> (Nanosecond -> Nanosecond -> Nanosecond)
-> (Nanosecond -> Nanosecond)
-> (Nanosecond -> Nanosecond)
-> (Nanosecond -> Nanosecond)
-> (Integer -> Nanosecond)
-> Num Nanosecond
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Nanosecond
$cfromInteger :: Integer -> Nanosecond
signum :: Nanosecond -> Nanosecond
$csignum :: Nanosecond -> Nanosecond
abs :: Nanosecond -> Nanosecond
$cabs :: Nanosecond -> Nanosecond
negate :: Nanosecond -> Nanosecond
$cnegate :: Nanosecond -> Nanosecond
* :: Nanosecond -> Nanosecond -> Nanosecond
$c* :: Nanosecond -> Nanosecond -> Nanosecond
- :: Nanosecond -> Nanosecond -> Nanosecond
$c- :: Nanosecond -> Nanosecond -> Nanosecond
+ :: Nanosecond -> Nanosecond -> Nanosecond
$c+ :: Nanosecond -> Nanosecond -> Nanosecond
Num,Eq Nanosecond
Eq Nanosecond
-> (Nanosecond -> Nanosecond -> Ordering)
-> (Nanosecond -> Nanosecond -> Bool)
-> (Nanosecond -> Nanosecond -> Bool)
-> (Nanosecond -> Nanosecond -> Bool)
-> (Nanosecond -> Nanosecond -> Bool)
-> (Nanosecond -> Nanosecond -> Nanosecond)
-> (Nanosecond -> Nanosecond -> Nanosecond)
-> Ord Nanosecond
Nanosecond -> Nanosecond -> Bool
Nanosecond -> Nanosecond -> Ordering
Nanosecond -> Nanosecond -> Nanosecond
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Nanosecond -> Nanosecond -> Nanosecond
$cmin :: Nanosecond -> Nanosecond -> Nanosecond
max :: Nanosecond -> Nanosecond -> Nanosecond
$cmax :: Nanosecond -> Nanosecond -> Nanosecond
>= :: Nanosecond -> Nanosecond -> Bool
$c>= :: Nanosecond -> Nanosecond -> Bool
> :: Nanosecond -> Nanosecond -> Bool
$c> :: Nanosecond -> Nanosecond -> Bool
<= :: Nanosecond -> Nanosecond -> Bool
$c<= :: Nanosecond -> Nanosecond -> Bool
< :: Nanosecond -> Nanosecond -> Bool
$c< :: Nanosecond -> Nanosecond -> Bool
compare :: Nanosecond -> Nanosecond -> Ordering
$ccompare :: Nanosecond -> Nanosecond -> Ordering
$cp1Ord :: Eq Nanosecond
Ord,Num Nanosecond
Ord Nanosecond
Num Nanosecond
-> Ord Nanosecond -> (Nanosecond -> Rational) -> Real Nanosecond
Nanosecond -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Nanosecond -> Rational
$ctoRational :: Nanosecond -> Rational
$cp2Real :: Ord Nanosecond
$cp1Real :: Num Nanosecond
Real,Ord Nanosecond
Ord Nanosecond
-> ((Nanosecond, Nanosecond) -> [Nanosecond])
-> ((Nanosecond, Nanosecond) -> Nanosecond -> Int)
-> ((Nanosecond, Nanosecond) -> Nanosecond -> Int)
-> ((Nanosecond, Nanosecond) -> Nanosecond -> Bool)
-> ((Nanosecond, Nanosecond) -> Int)
-> ((Nanosecond, Nanosecond) -> Int)
-> Ix Nanosecond
(Nanosecond, Nanosecond) -> Int
(Nanosecond, Nanosecond) -> [Nanosecond]
(Nanosecond, Nanosecond) -> Nanosecond -> Bool
(Nanosecond, Nanosecond) -> Nanosecond -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Nanosecond, Nanosecond) -> Int
$cunsafeRangeSize :: (Nanosecond, Nanosecond) -> Int
rangeSize :: (Nanosecond, Nanosecond) -> Int
$crangeSize :: (Nanosecond, Nanosecond) -> Int
inRange :: (Nanosecond, Nanosecond) -> Nanosecond -> Bool
$cinRange :: (Nanosecond, Nanosecond) -> Nanosecond -> Bool
unsafeIndex :: (Nanosecond, Nanosecond) -> Nanosecond -> Int
$cunsafeIndex :: (Nanosecond, Nanosecond) -> Nanosecond -> Int
index :: (Nanosecond, Nanosecond) -> Nanosecond -> Int
$cindex :: (Nanosecond, Nanosecond) -> Nanosecond -> Int
range :: (Nanosecond, Nanosecond) -> [Nanosecond]
$crange :: (Nanosecond, Nanosecond) -> [Nanosecond]
$cp1Ix :: Ord Nanosecond
Ix,Typeable)

instance TimeUnit Nanosecond where
  toMicroseconds :: Nanosecond -> Integer
toMicroseconds (Nanosecond Integer
x) = Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
3)
  fromMicroseconds :: Integer -> Nanosecond
fromMicroseconds Integer
x            = Integer -> Nanosecond
Nanosecond (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
3))
instance Show Nanosecond where
  show :: Nanosecond -> String
show (Nanosecond Integer
x) = Integer -> String
forall a. Show a => a -> String
show Integer
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"ns"
instance Read Nanosecond where
  readsPrec :: Int -> ReadS Nanosecond
readsPrec = (Integer -> Nanosecond) -> String -> Int -> ReadS Nanosecond
forall a.
(Integer -> a) -> String -> Int -> String -> [(a, String)]
readUnit Integer -> Nanosecond
Nanosecond String
"ns"

--

newtype Microsecond = Microsecond Integer
 deriving (Int -> Microsecond
Microsecond -> Int
Microsecond -> [Microsecond]
Microsecond -> Microsecond
Microsecond -> Microsecond -> [Microsecond]
Microsecond -> Microsecond -> Microsecond -> [Microsecond]
(Microsecond -> Microsecond)
-> (Microsecond -> Microsecond)
-> (Int -> Microsecond)
-> (Microsecond -> Int)
-> (Microsecond -> [Microsecond])
-> (Microsecond -> Microsecond -> [Microsecond])
-> (Microsecond -> Microsecond -> [Microsecond])
-> (Microsecond -> Microsecond -> Microsecond -> [Microsecond])
-> Enum Microsecond
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Microsecond -> Microsecond -> Microsecond -> [Microsecond]
$cenumFromThenTo :: Microsecond -> Microsecond -> Microsecond -> [Microsecond]
enumFromTo :: Microsecond -> Microsecond -> [Microsecond]
$cenumFromTo :: Microsecond -> Microsecond -> [Microsecond]
enumFromThen :: Microsecond -> Microsecond -> [Microsecond]
$cenumFromThen :: Microsecond -> Microsecond -> [Microsecond]
enumFrom :: Microsecond -> [Microsecond]
$cenumFrom :: Microsecond -> [Microsecond]
fromEnum :: Microsecond -> Int
$cfromEnum :: Microsecond -> Int
toEnum :: Int -> Microsecond
$ctoEnum :: Int -> Microsecond
pred :: Microsecond -> Microsecond
$cpred :: Microsecond -> Microsecond
succ :: Microsecond -> Microsecond
$csucc :: Microsecond -> Microsecond
Enum,Microsecond -> Microsecond -> Bool
(Microsecond -> Microsecond -> Bool)
-> (Microsecond -> Microsecond -> Bool) -> Eq Microsecond
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Microsecond -> Microsecond -> Bool
$c/= :: Microsecond -> Microsecond -> Bool
== :: Microsecond -> Microsecond -> Bool
$c== :: Microsecond -> Microsecond -> Bool
Eq,Enum Microsecond
Real Microsecond
Real Microsecond
-> Enum Microsecond
-> (Microsecond -> Microsecond -> Microsecond)
-> (Microsecond -> Microsecond -> Microsecond)
-> (Microsecond -> Microsecond -> Microsecond)
-> (Microsecond -> Microsecond -> Microsecond)
-> (Microsecond -> Microsecond -> (Microsecond, Microsecond))
-> (Microsecond -> Microsecond -> (Microsecond, Microsecond))
-> (Microsecond -> Integer)
-> Integral Microsecond
Microsecond -> Integer
Microsecond -> Microsecond -> (Microsecond, Microsecond)
Microsecond -> Microsecond -> Microsecond
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Microsecond -> Integer
$ctoInteger :: Microsecond -> Integer
divMod :: Microsecond -> Microsecond -> (Microsecond, Microsecond)
$cdivMod :: Microsecond -> Microsecond -> (Microsecond, Microsecond)
quotRem :: Microsecond -> Microsecond -> (Microsecond, Microsecond)
$cquotRem :: Microsecond -> Microsecond -> (Microsecond, Microsecond)
mod :: Microsecond -> Microsecond -> Microsecond
$cmod :: Microsecond -> Microsecond -> Microsecond
div :: Microsecond -> Microsecond -> Microsecond
$cdiv :: Microsecond -> Microsecond -> Microsecond
rem :: Microsecond -> Microsecond -> Microsecond
$crem :: Microsecond -> Microsecond -> Microsecond
quot :: Microsecond -> Microsecond -> Microsecond
$cquot :: Microsecond -> Microsecond -> Microsecond
$cp2Integral :: Enum Microsecond
$cp1Integral :: Real Microsecond
Integral,Typeable Microsecond
DataType
Constr
Typeable Microsecond
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Microsecond -> c Microsecond)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Microsecond)
-> (Microsecond -> Constr)
-> (Microsecond -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Microsecond))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Microsecond))
-> ((forall b. Data b => b -> b) -> Microsecond -> Microsecond)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Microsecond -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Microsecond -> r)
-> (forall u. (forall d. Data d => d -> u) -> Microsecond -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Microsecond -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Microsecond -> m Microsecond)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Microsecond -> m Microsecond)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Microsecond -> m Microsecond)
-> Data Microsecond
Microsecond -> DataType
Microsecond -> Constr
(forall b. Data b => b -> b) -> Microsecond -> Microsecond
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Microsecond -> c Microsecond
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Microsecond
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Microsecond -> u
forall u. (forall d. Data d => d -> u) -> Microsecond -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Microsecond -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Microsecond -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Microsecond -> m Microsecond
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Microsecond -> m Microsecond
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Microsecond
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Microsecond -> c Microsecond
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Microsecond)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Microsecond)
$cMicrosecond :: Constr
$tMicrosecond :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Microsecond -> m Microsecond
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Microsecond -> m Microsecond
gmapMp :: (forall d. Data d => d -> m d) -> Microsecond -> m Microsecond
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Microsecond -> m Microsecond
gmapM :: (forall d. Data d => d -> m d) -> Microsecond -> m Microsecond
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Microsecond -> m Microsecond
gmapQi :: Int -> (forall d. Data d => d -> u) -> Microsecond -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Microsecond -> u
gmapQ :: (forall d. Data d => d -> u) -> Microsecond -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Microsecond -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Microsecond -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Microsecond -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Microsecond -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Microsecond -> r
gmapT :: (forall b. Data b => b -> b) -> Microsecond -> Microsecond
$cgmapT :: (forall b. Data b => b -> b) -> Microsecond -> Microsecond
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Microsecond)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Microsecond)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Microsecond)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Microsecond)
dataTypeOf :: Microsecond -> DataType
$cdataTypeOf :: Microsecond -> DataType
toConstr :: Microsecond -> Constr
$ctoConstr :: Microsecond -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Microsecond
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Microsecond
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Microsecond -> c Microsecond
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Microsecond -> c Microsecond
$cp1Data :: Typeable Microsecond
Data,Integer -> Microsecond
Microsecond -> Microsecond
Microsecond -> Microsecond -> Microsecond
(Microsecond -> Microsecond -> Microsecond)
-> (Microsecond -> Microsecond -> Microsecond)
-> (Microsecond -> Microsecond -> Microsecond)
-> (Microsecond -> Microsecond)
-> (Microsecond -> Microsecond)
-> (Microsecond -> Microsecond)
-> (Integer -> Microsecond)
-> Num Microsecond
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Microsecond
$cfromInteger :: Integer -> Microsecond
signum :: Microsecond -> Microsecond
$csignum :: Microsecond -> Microsecond
abs :: Microsecond -> Microsecond
$cabs :: Microsecond -> Microsecond
negate :: Microsecond -> Microsecond
$cnegate :: Microsecond -> Microsecond
* :: Microsecond -> Microsecond -> Microsecond
$c* :: Microsecond -> Microsecond -> Microsecond
- :: Microsecond -> Microsecond -> Microsecond
$c- :: Microsecond -> Microsecond -> Microsecond
+ :: Microsecond -> Microsecond -> Microsecond
$c+ :: Microsecond -> Microsecond -> Microsecond
Num,Eq Microsecond
Eq Microsecond
-> (Microsecond -> Microsecond -> Ordering)
-> (Microsecond -> Microsecond -> Bool)
-> (Microsecond -> Microsecond -> Bool)
-> (Microsecond -> Microsecond -> Bool)
-> (Microsecond -> Microsecond -> Bool)
-> (Microsecond -> Microsecond -> Microsecond)
-> (Microsecond -> Microsecond -> Microsecond)
-> Ord Microsecond
Microsecond -> Microsecond -> Bool
Microsecond -> Microsecond -> Ordering
Microsecond -> Microsecond -> Microsecond
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Microsecond -> Microsecond -> Microsecond
$cmin :: Microsecond -> Microsecond -> Microsecond
max :: Microsecond -> Microsecond -> Microsecond
$cmax :: Microsecond -> Microsecond -> Microsecond
>= :: Microsecond -> Microsecond -> Bool
$c>= :: Microsecond -> Microsecond -> Bool
> :: Microsecond -> Microsecond -> Bool
$c> :: Microsecond -> Microsecond -> Bool
<= :: Microsecond -> Microsecond -> Bool
$c<= :: Microsecond -> Microsecond -> Bool
< :: Microsecond -> Microsecond -> Bool
$c< :: Microsecond -> Microsecond -> Bool
compare :: Microsecond -> Microsecond -> Ordering
$ccompare :: Microsecond -> Microsecond -> Ordering
$cp1Ord :: Eq Microsecond
Ord,Num Microsecond
Ord Microsecond
Num Microsecond
-> Ord Microsecond -> (Microsecond -> Rational) -> Real Microsecond
Microsecond -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Microsecond -> Rational
$ctoRational :: Microsecond -> Rational
$cp2Real :: Ord Microsecond
$cp1Real :: Num Microsecond
Real,Ord Microsecond
Ord Microsecond
-> ((Microsecond, Microsecond) -> [Microsecond])
-> ((Microsecond, Microsecond) -> Microsecond -> Int)
-> ((Microsecond, Microsecond) -> Microsecond -> Int)
-> ((Microsecond, Microsecond) -> Microsecond -> Bool)
-> ((Microsecond, Microsecond) -> Int)
-> ((Microsecond, Microsecond) -> Int)
-> Ix Microsecond
(Microsecond, Microsecond) -> Int
(Microsecond, Microsecond) -> [Microsecond]
(Microsecond, Microsecond) -> Microsecond -> Bool
(Microsecond, Microsecond) -> Microsecond -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Microsecond, Microsecond) -> Int
$cunsafeRangeSize :: (Microsecond, Microsecond) -> Int
rangeSize :: (Microsecond, Microsecond) -> Int
$crangeSize :: (Microsecond, Microsecond) -> Int
inRange :: (Microsecond, Microsecond) -> Microsecond -> Bool
$cinRange :: (Microsecond, Microsecond) -> Microsecond -> Bool
unsafeIndex :: (Microsecond, Microsecond) -> Microsecond -> Int
$cunsafeIndex :: (Microsecond, Microsecond) -> Microsecond -> Int
index :: (Microsecond, Microsecond) -> Microsecond -> Int
$cindex :: (Microsecond, Microsecond) -> Microsecond -> Int
range :: (Microsecond, Microsecond) -> [Microsecond]
$crange :: (Microsecond, Microsecond) -> [Microsecond]
$cp1Ix :: Ord Microsecond
Ix,Typeable)

instance TimeUnit Microsecond where
  toMicroseconds :: Microsecond -> Integer
toMicroseconds (Microsecond Integer
x) = Integer
x
  fromMicroseconds :: Integer -> Microsecond
fromMicroseconds Integer
x             = Integer -> Microsecond
Microsecond Integer
x
instance Show Microsecond where
  show :: Microsecond -> String
show (Microsecond Integer
x) = Integer -> String
forall a. Show a => a -> String
show Integer
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"µs"
instance Read Microsecond where
  readsPrec :: Int -> ReadS Microsecond
readsPrec = (Integer -> Microsecond) -> String -> Int -> ReadS Microsecond
forall a.
(Integer -> a) -> String -> Int -> String -> [(a, String)]
readUnit Integer -> Microsecond
Microsecond String
"µs"

--

newtype Millisecond  = Millisecond  Integer
 deriving (Int -> Millisecond
Millisecond -> Int
Millisecond -> [Millisecond]
Millisecond -> Millisecond
Millisecond -> Millisecond -> [Millisecond]
Millisecond -> Millisecond -> Millisecond -> [Millisecond]
(Millisecond -> Millisecond)
-> (Millisecond -> Millisecond)
-> (Int -> Millisecond)
-> (Millisecond -> Int)
-> (Millisecond -> [Millisecond])
-> (Millisecond -> Millisecond -> [Millisecond])
-> (Millisecond -> Millisecond -> [Millisecond])
-> (Millisecond -> Millisecond -> Millisecond -> [Millisecond])
-> Enum Millisecond
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Millisecond -> Millisecond -> Millisecond -> [Millisecond]
$cenumFromThenTo :: Millisecond -> Millisecond -> Millisecond -> [Millisecond]
enumFromTo :: Millisecond -> Millisecond -> [Millisecond]
$cenumFromTo :: Millisecond -> Millisecond -> [Millisecond]
enumFromThen :: Millisecond -> Millisecond -> [Millisecond]
$cenumFromThen :: Millisecond -> Millisecond -> [Millisecond]
enumFrom :: Millisecond -> [Millisecond]
$cenumFrom :: Millisecond -> [Millisecond]
fromEnum :: Millisecond -> Int
$cfromEnum :: Millisecond -> Int
toEnum :: Int -> Millisecond
$ctoEnum :: Int -> Millisecond
pred :: Millisecond -> Millisecond
$cpred :: Millisecond -> Millisecond
succ :: Millisecond -> Millisecond
$csucc :: Millisecond -> Millisecond
Enum,Millisecond -> Millisecond -> Bool
(Millisecond -> Millisecond -> Bool)
-> (Millisecond -> Millisecond -> Bool) -> Eq Millisecond
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Millisecond -> Millisecond -> Bool
$c/= :: Millisecond -> Millisecond -> Bool
== :: Millisecond -> Millisecond -> Bool
$c== :: Millisecond -> Millisecond -> Bool
Eq,Enum Millisecond
Real Millisecond
Real Millisecond
-> Enum Millisecond
-> (Millisecond -> Millisecond -> Millisecond)
-> (Millisecond -> Millisecond -> Millisecond)
-> (Millisecond -> Millisecond -> Millisecond)
-> (Millisecond -> Millisecond -> Millisecond)
-> (Millisecond -> Millisecond -> (Millisecond, Millisecond))
-> (Millisecond -> Millisecond -> (Millisecond, Millisecond))
-> (Millisecond -> Integer)
-> Integral Millisecond
Millisecond -> Integer
Millisecond -> Millisecond -> (Millisecond, Millisecond)
Millisecond -> Millisecond -> Millisecond
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Millisecond -> Integer
$ctoInteger :: Millisecond -> Integer
divMod :: Millisecond -> Millisecond -> (Millisecond, Millisecond)
$cdivMod :: Millisecond -> Millisecond -> (Millisecond, Millisecond)
quotRem :: Millisecond -> Millisecond -> (Millisecond, Millisecond)
$cquotRem :: Millisecond -> Millisecond -> (Millisecond, Millisecond)
mod :: Millisecond -> Millisecond -> Millisecond
$cmod :: Millisecond -> Millisecond -> Millisecond
div :: Millisecond -> Millisecond -> Millisecond
$cdiv :: Millisecond -> Millisecond -> Millisecond
rem :: Millisecond -> Millisecond -> Millisecond
$crem :: Millisecond -> Millisecond -> Millisecond
quot :: Millisecond -> Millisecond -> Millisecond
$cquot :: Millisecond -> Millisecond -> Millisecond
$cp2Integral :: Enum Millisecond
$cp1Integral :: Real Millisecond
Integral,Typeable Millisecond
DataType
Constr
Typeable Millisecond
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Millisecond -> c Millisecond)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Millisecond)
-> (Millisecond -> Constr)
-> (Millisecond -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Millisecond))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Millisecond))
-> ((forall b. Data b => b -> b) -> Millisecond -> Millisecond)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Millisecond -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Millisecond -> r)
-> (forall u. (forall d. Data d => d -> u) -> Millisecond -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Millisecond -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Millisecond -> m Millisecond)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Millisecond -> m Millisecond)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Millisecond -> m Millisecond)
-> Data Millisecond
Millisecond -> DataType
Millisecond -> Constr
(forall b. Data b => b -> b) -> Millisecond -> Millisecond
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Millisecond -> c Millisecond
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Millisecond
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Millisecond -> u
forall u. (forall d. Data d => d -> u) -> Millisecond -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Millisecond -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Millisecond -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Millisecond -> m Millisecond
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Millisecond -> m Millisecond
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Millisecond
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Millisecond -> c Millisecond
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Millisecond)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Millisecond)
$cMillisecond :: Constr
$tMillisecond :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Millisecond -> m Millisecond
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Millisecond -> m Millisecond
gmapMp :: (forall d. Data d => d -> m d) -> Millisecond -> m Millisecond
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Millisecond -> m Millisecond
gmapM :: (forall d. Data d => d -> m d) -> Millisecond -> m Millisecond
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Millisecond -> m Millisecond
gmapQi :: Int -> (forall d. Data d => d -> u) -> Millisecond -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Millisecond -> u
gmapQ :: (forall d. Data d => d -> u) -> Millisecond -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Millisecond -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Millisecond -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Millisecond -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Millisecond -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Millisecond -> r
gmapT :: (forall b. Data b => b -> b) -> Millisecond -> Millisecond
$cgmapT :: (forall b. Data b => b -> b) -> Millisecond -> Millisecond
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Millisecond)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Millisecond)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Millisecond)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Millisecond)
dataTypeOf :: Millisecond -> DataType
$cdataTypeOf :: Millisecond -> DataType
toConstr :: Millisecond -> Constr
$ctoConstr :: Millisecond -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Millisecond
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Millisecond
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Millisecond -> c Millisecond
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Millisecond -> c Millisecond
$cp1Data :: Typeable Millisecond
Data,Integer -> Millisecond
Millisecond -> Millisecond
Millisecond -> Millisecond -> Millisecond
(Millisecond -> Millisecond -> Millisecond)
-> (Millisecond -> Millisecond -> Millisecond)
-> (Millisecond -> Millisecond -> Millisecond)
-> (Millisecond -> Millisecond)
-> (Millisecond -> Millisecond)
-> (Millisecond -> Millisecond)
-> (Integer -> Millisecond)
-> Num Millisecond
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Millisecond
$cfromInteger :: Integer -> Millisecond
signum :: Millisecond -> Millisecond
$csignum :: Millisecond -> Millisecond
abs :: Millisecond -> Millisecond
$cabs :: Millisecond -> Millisecond
negate :: Millisecond -> Millisecond
$cnegate :: Millisecond -> Millisecond
* :: Millisecond -> Millisecond -> Millisecond
$c* :: Millisecond -> Millisecond -> Millisecond
- :: Millisecond -> Millisecond -> Millisecond
$c- :: Millisecond -> Millisecond -> Millisecond
+ :: Millisecond -> Millisecond -> Millisecond
$c+ :: Millisecond -> Millisecond -> Millisecond
Num,Eq Millisecond
Eq Millisecond
-> (Millisecond -> Millisecond -> Ordering)
-> (Millisecond -> Millisecond -> Bool)
-> (Millisecond -> Millisecond -> Bool)
-> (Millisecond -> Millisecond -> Bool)
-> (Millisecond -> Millisecond -> Bool)
-> (Millisecond -> Millisecond -> Millisecond)
-> (Millisecond -> Millisecond -> Millisecond)
-> Ord Millisecond
Millisecond -> Millisecond -> Bool
Millisecond -> Millisecond -> Ordering
Millisecond -> Millisecond -> Millisecond
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Millisecond -> Millisecond -> Millisecond
$cmin :: Millisecond -> Millisecond -> Millisecond
max :: Millisecond -> Millisecond -> Millisecond
$cmax :: Millisecond -> Millisecond -> Millisecond
>= :: Millisecond -> Millisecond -> Bool
$c>= :: Millisecond -> Millisecond -> Bool
> :: Millisecond -> Millisecond -> Bool
$c> :: Millisecond -> Millisecond -> Bool
<= :: Millisecond -> Millisecond -> Bool
$c<= :: Millisecond -> Millisecond -> Bool
< :: Millisecond -> Millisecond -> Bool
$c< :: Millisecond -> Millisecond -> Bool
compare :: Millisecond -> Millisecond -> Ordering
$ccompare :: Millisecond -> Millisecond -> Ordering
$cp1Ord :: Eq Millisecond
Ord,Num Millisecond
Ord Millisecond
Num Millisecond
-> Ord Millisecond -> (Millisecond -> Rational) -> Real Millisecond
Millisecond -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Millisecond -> Rational
$ctoRational :: Millisecond -> Rational
$cp2Real :: Ord Millisecond
$cp1Real :: Num Millisecond
Real,Ord Millisecond
Ord Millisecond
-> ((Millisecond, Millisecond) -> [Millisecond])
-> ((Millisecond, Millisecond) -> Millisecond -> Int)
-> ((Millisecond, Millisecond) -> Millisecond -> Int)
-> ((Millisecond, Millisecond) -> Millisecond -> Bool)
-> ((Millisecond, Millisecond) -> Int)
-> ((Millisecond, Millisecond) -> Int)
-> Ix Millisecond
(Millisecond, Millisecond) -> Int
(Millisecond, Millisecond) -> [Millisecond]
(Millisecond, Millisecond) -> Millisecond -> Bool
(Millisecond, Millisecond) -> Millisecond -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Millisecond, Millisecond) -> Int
$cunsafeRangeSize :: (Millisecond, Millisecond) -> Int
rangeSize :: (Millisecond, Millisecond) -> Int
$crangeSize :: (Millisecond, Millisecond) -> Int
inRange :: (Millisecond, Millisecond) -> Millisecond -> Bool
$cinRange :: (Millisecond, Millisecond) -> Millisecond -> Bool
unsafeIndex :: (Millisecond, Millisecond) -> Millisecond -> Int
$cunsafeIndex :: (Millisecond, Millisecond) -> Millisecond -> Int
index :: (Millisecond, Millisecond) -> Millisecond -> Int
$cindex :: (Millisecond, Millisecond) -> Millisecond -> Int
range :: (Millisecond, Millisecond) -> [Millisecond]
$crange :: (Millisecond, Millisecond) -> [Millisecond]
$cp1Ix :: Ord Millisecond
Ix,Typeable)

instance TimeUnit Millisecond where
  toMicroseconds :: Millisecond -> Integer
toMicroseconds (Millisecond Integer
x) = Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
3)
  fromMicroseconds :: Integer -> Millisecond
fromMicroseconds Integer
x             = Integer -> Millisecond
Millisecond (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
3))
instance Show Millisecond where
  show :: Millisecond -> String
show (Millisecond Integer
x) = Integer -> String
forall a. Show a => a -> String
show Integer
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"ms"
instance Read Millisecond where
  readsPrec :: Int -> ReadS Millisecond
readsPrec = (Integer -> Millisecond) -> String -> Int -> ReadS Millisecond
forall a.
(Integer -> a) -> String -> Int -> String -> [(a, String)]
readUnit Integer -> Millisecond
Millisecond String
"ms"

--

newtype Second      = Second      Integer
 deriving (Int -> Second
Second -> Int
Second -> [Second]
Second -> Second
Second -> Second -> [Second]
Second -> Second -> Second -> [Second]
(Second -> Second)
-> (Second -> Second)
-> (Int -> Second)
-> (Second -> Int)
-> (Second -> [Second])
-> (Second -> Second -> [Second])
-> (Second -> Second -> [Second])
-> (Second -> Second -> Second -> [Second])
-> Enum Second
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Second -> Second -> Second -> [Second]
$cenumFromThenTo :: Second -> Second -> Second -> [Second]
enumFromTo :: Second -> Second -> [Second]
$cenumFromTo :: Second -> Second -> [Second]
enumFromThen :: Second -> Second -> [Second]
$cenumFromThen :: Second -> Second -> [Second]
enumFrom :: Second -> [Second]
$cenumFrom :: Second -> [Second]
fromEnum :: Second -> Int
$cfromEnum :: Second -> Int
toEnum :: Int -> Second
$ctoEnum :: Int -> Second
pred :: Second -> Second
$cpred :: Second -> Second
succ :: Second -> Second
$csucc :: Second -> Second
Enum,Second -> Second -> Bool
(Second -> Second -> Bool)
-> (Second -> Second -> Bool) -> Eq Second
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Second -> Second -> Bool
$c/= :: Second -> Second -> Bool
== :: Second -> Second -> Bool
$c== :: Second -> Second -> Bool
Eq,Enum Second
Real Second
Real Second
-> Enum Second
-> (Second -> Second -> Second)
-> (Second -> Second -> Second)
-> (Second -> Second -> Second)
-> (Second -> Second -> Second)
-> (Second -> Second -> (Second, Second))
-> (Second -> Second -> (Second, Second))
-> (Second -> Integer)
-> Integral Second
Second -> Integer
Second -> Second -> (Second, Second)
Second -> Second -> Second
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Second -> Integer
$ctoInteger :: Second -> Integer
divMod :: Second -> Second -> (Second, Second)
$cdivMod :: Second -> Second -> (Second, Second)
quotRem :: Second -> Second -> (Second, Second)
$cquotRem :: Second -> Second -> (Second, Second)
mod :: Second -> Second -> Second
$cmod :: Second -> Second -> Second
div :: Second -> Second -> Second
$cdiv :: Second -> Second -> Second
rem :: Second -> Second -> Second
$crem :: Second -> Second -> Second
quot :: Second -> Second -> Second
$cquot :: Second -> Second -> Second
$cp2Integral :: Enum Second
$cp1Integral :: Real Second
Integral,Typeable Second
DataType
Constr
Typeable Second
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Second -> c Second)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Second)
-> (Second -> Constr)
-> (Second -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Second))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Second))
-> ((forall b. Data b => b -> b) -> Second -> Second)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Second -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Second -> r)
-> (forall u. (forall d. Data d => d -> u) -> Second -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Second -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Second -> m Second)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Second -> m Second)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Second -> m Second)
-> Data Second
Second -> DataType
Second -> Constr
(forall b. Data b => b -> b) -> Second -> Second
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Second -> c Second
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Second
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Second -> u
forall u. (forall d. Data d => d -> u) -> Second -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Second -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Second -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Second -> m Second
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Second -> m Second
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Second
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Second -> c Second
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Second)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Second)
$cSecond :: Constr
$tSecond :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Second -> m Second
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Second -> m Second
gmapMp :: (forall d. Data d => d -> m d) -> Second -> m Second
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Second -> m Second
gmapM :: (forall d. Data d => d -> m d) -> Second -> m Second
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Second -> m Second
gmapQi :: Int -> (forall d. Data d => d -> u) -> Second -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Second -> u
gmapQ :: (forall d. Data d => d -> u) -> Second -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Second -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Second -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Second -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Second -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Second -> r
gmapT :: (forall b. Data b => b -> b) -> Second -> Second
$cgmapT :: (forall b. Data b => b -> b) -> Second -> Second
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Second)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Second)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Second)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Second)
dataTypeOf :: Second -> DataType
$cdataTypeOf :: Second -> DataType
toConstr :: Second -> Constr
$ctoConstr :: Second -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Second
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Second
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Second -> c Second
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Second -> c Second
$cp1Data :: Typeable Second
Data,Integer -> Second
Second -> Second
Second -> Second -> Second
(Second -> Second -> Second)
-> (Second -> Second -> Second)
-> (Second -> Second -> Second)
-> (Second -> Second)
-> (Second -> Second)
-> (Second -> Second)
-> (Integer -> Second)
-> Num Second
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Second
$cfromInteger :: Integer -> Second
signum :: Second -> Second
$csignum :: Second -> Second
abs :: Second -> Second
$cabs :: Second -> Second
negate :: Second -> Second
$cnegate :: Second -> Second
* :: Second -> Second -> Second
$c* :: Second -> Second -> Second
- :: Second -> Second -> Second
$c- :: Second -> Second -> Second
+ :: Second -> Second -> Second
$c+ :: Second -> Second -> Second
Num,Eq Second
Eq Second
-> (Second -> Second -> Ordering)
-> (Second -> Second -> Bool)
-> (Second -> Second -> Bool)
-> (Second -> Second -> Bool)
-> (Second -> Second -> Bool)
-> (Second -> Second -> Second)
-> (Second -> Second -> Second)
-> Ord Second
Second -> Second -> Bool
Second -> Second -> Ordering
Second -> Second -> Second
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Second -> Second -> Second
$cmin :: Second -> Second -> Second
max :: Second -> Second -> Second
$cmax :: Second -> Second -> Second
>= :: Second -> Second -> Bool
$c>= :: Second -> Second -> Bool
> :: Second -> Second -> Bool
$c> :: Second -> Second -> Bool
<= :: Second -> Second -> Bool
$c<= :: Second -> Second -> Bool
< :: Second -> Second -> Bool
$c< :: Second -> Second -> Bool
compare :: Second -> Second -> Ordering
$ccompare :: Second -> Second -> Ordering
$cp1Ord :: Eq Second
Ord,Num Second
Ord Second
Num Second -> Ord Second -> (Second -> Rational) -> Real Second
Second -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Second -> Rational
$ctoRational :: Second -> Rational
$cp2Real :: Ord Second
$cp1Real :: Num Second
Real,Ord Second
Ord Second
-> ((Second, Second) -> [Second])
-> ((Second, Second) -> Second -> Int)
-> ((Second, Second) -> Second -> Int)
-> ((Second, Second) -> Second -> Bool)
-> ((Second, Second) -> Int)
-> ((Second, Second) -> Int)
-> Ix Second
(Second, Second) -> Int
(Second, Second) -> [Second]
(Second, Second) -> Second -> Bool
(Second, Second) -> Second -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Second, Second) -> Int
$cunsafeRangeSize :: (Second, Second) -> Int
rangeSize :: (Second, Second) -> Int
$crangeSize :: (Second, Second) -> Int
inRange :: (Second, Second) -> Second -> Bool
$cinRange :: (Second, Second) -> Second -> Bool
unsafeIndex :: (Second, Second) -> Second -> Int
$cunsafeIndex :: (Second, Second) -> Second -> Int
index :: (Second, Second) -> Second -> Int
$cindex :: (Second, Second) -> Second -> Int
range :: (Second, Second) -> [Second]
$crange :: (Second, Second) -> [Second]
$cp1Ix :: Ord Second
Ix,Typeable)

instance TimeUnit Second where
  toMicroseconds :: Second -> Integer
toMicroseconds (Second Integer
x) = Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6)
  fromMicroseconds :: Integer -> Second
fromMicroseconds Integer
x        = Integer -> Second
Second (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6))
instance Show Second where
  show :: Second -> String
show (Second Integer
x) = Integer -> String
forall a. Show a => a -> String
show Integer
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"s"
instance Read Second where
  readsPrec :: Int -> ReadS Second
readsPrec = (Integer -> Second) -> String -> Int -> ReadS Second
forall a.
(Integer -> a) -> String -> Int -> String -> [(a, String)]
readUnit Integer -> Second
Second String
"s"

--

newtype Minute      = Minute      Integer
 deriving (Int -> Minute
Minute -> Int
Minute -> [Minute]
Minute -> Minute
Minute -> Minute -> [Minute]
Minute -> Minute -> Minute -> [Minute]
(Minute -> Minute)
-> (Minute -> Minute)
-> (Int -> Minute)
-> (Minute -> Int)
-> (Minute -> [Minute])
-> (Minute -> Minute -> [Minute])
-> (Minute -> Minute -> [Minute])
-> (Minute -> Minute -> Minute -> [Minute])
-> Enum Minute
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Minute -> Minute -> Minute -> [Minute]
$cenumFromThenTo :: Minute -> Minute -> Minute -> [Minute]
enumFromTo :: Minute -> Minute -> [Minute]
$cenumFromTo :: Minute -> Minute -> [Minute]
enumFromThen :: Minute -> Minute -> [Minute]
$cenumFromThen :: Minute -> Minute -> [Minute]
enumFrom :: Minute -> [Minute]
$cenumFrom :: Minute -> [Minute]
fromEnum :: Minute -> Int
$cfromEnum :: Minute -> Int
toEnum :: Int -> Minute
$ctoEnum :: Int -> Minute
pred :: Minute -> Minute
$cpred :: Minute -> Minute
succ :: Minute -> Minute
$csucc :: Minute -> Minute
Enum,Minute -> Minute -> Bool
(Minute -> Minute -> Bool)
-> (Minute -> Minute -> Bool) -> Eq Minute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Minute -> Minute -> Bool
$c/= :: Minute -> Minute -> Bool
== :: Minute -> Minute -> Bool
$c== :: Minute -> Minute -> Bool
Eq,Enum Minute
Real Minute
Real Minute
-> Enum Minute
-> (Minute -> Minute -> Minute)
-> (Minute -> Minute -> Minute)
-> (Minute -> Minute -> Minute)
-> (Minute -> Minute -> Minute)
-> (Minute -> Minute -> (Minute, Minute))
-> (Minute -> Minute -> (Minute, Minute))
-> (Minute -> Integer)
-> Integral Minute
Minute -> Integer
Minute -> Minute -> (Minute, Minute)
Minute -> Minute -> Minute
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Minute -> Integer
$ctoInteger :: Minute -> Integer
divMod :: Minute -> Minute -> (Minute, Minute)
$cdivMod :: Minute -> Minute -> (Minute, Minute)
quotRem :: Minute -> Minute -> (Minute, Minute)
$cquotRem :: Minute -> Minute -> (Minute, Minute)
mod :: Minute -> Minute -> Minute
$cmod :: Minute -> Minute -> Minute
div :: Minute -> Minute -> Minute
$cdiv :: Minute -> Minute -> Minute
rem :: Minute -> Minute -> Minute
$crem :: Minute -> Minute -> Minute
quot :: Minute -> Minute -> Minute
$cquot :: Minute -> Minute -> Minute
$cp2Integral :: Enum Minute
$cp1Integral :: Real Minute
Integral,Typeable Minute
DataType
Constr
Typeable Minute
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Minute -> c Minute)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Minute)
-> (Minute -> Constr)
-> (Minute -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Minute))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Minute))
-> ((forall b. Data b => b -> b) -> Minute -> Minute)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Minute -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Minute -> r)
-> (forall u. (forall d. Data d => d -> u) -> Minute -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Minute -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Minute -> m Minute)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Minute -> m Minute)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Minute -> m Minute)
-> Data Minute
Minute -> DataType
Minute -> Constr
(forall b. Data b => b -> b) -> Minute -> Minute
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Minute -> c Minute
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Minute
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Minute -> u
forall u. (forall d. Data d => d -> u) -> Minute -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Minute -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Minute -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Minute -> m Minute
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Minute -> m Minute
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Minute
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Minute -> c Minute
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Minute)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Minute)
$cMinute :: Constr
$tMinute :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Minute -> m Minute
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Minute -> m Minute
gmapMp :: (forall d. Data d => d -> m d) -> Minute -> m Minute
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Minute -> m Minute
gmapM :: (forall d. Data d => d -> m d) -> Minute -> m Minute
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Minute -> m Minute
gmapQi :: Int -> (forall d. Data d => d -> u) -> Minute -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Minute -> u
gmapQ :: (forall d. Data d => d -> u) -> Minute -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Minute -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Minute -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Minute -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Minute -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Minute -> r
gmapT :: (forall b. Data b => b -> b) -> Minute -> Minute
$cgmapT :: (forall b. Data b => b -> b) -> Minute -> Minute
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Minute)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Minute)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Minute)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Minute)
dataTypeOf :: Minute -> DataType
$cdataTypeOf :: Minute -> DataType
toConstr :: Minute -> Constr
$ctoConstr :: Minute -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Minute
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Minute
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Minute -> c Minute
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Minute -> c Minute
$cp1Data :: Typeable Minute
Data,Integer -> Minute
Minute -> Minute
Minute -> Minute -> Minute
(Minute -> Minute -> Minute)
-> (Minute -> Minute -> Minute)
-> (Minute -> Minute -> Minute)
-> (Minute -> Minute)
-> (Minute -> Minute)
-> (Minute -> Minute)
-> (Integer -> Minute)
-> Num Minute
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Minute
$cfromInteger :: Integer -> Minute
signum :: Minute -> Minute
$csignum :: Minute -> Minute
abs :: Minute -> Minute
$cabs :: Minute -> Minute
negate :: Minute -> Minute
$cnegate :: Minute -> Minute
* :: Minute -> Minute -> Minute
$c* :: Minute -> Minute -> Minute
- :: Minute -> Minute -> Minute
$c- :: Minute -> Minute -> Minute
+ :: Minute -> Minute -> Minute
$c+ :: Minute -> Minute -> Minute
Num,Eq Minute
Eq Minute
-> (Minute -> Minute -> Ordering)
-> (Minute -> Minute -> Bool)
-> (Minute -> Minute -> Bool)
-> (Minute -> Minute -> Bool)
-> (Minute -> Minute -> Bool)
-> (Minute -> Minute -> Minute)
-> (Minute -> Minute -> Minute)
-> Ord Minute
Minute -> Minute -> Bool
Minute -> Minute -> Ordering
Minute -> Minute -> Minute
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Minute -> Minute -> Minute
$cmin :: Minute -> Minute -> Minute
max :: Minute -> Minute -> Minute
$cmax :: Minute -> Minute -> Minute
>= :: Minute -> Minute -> Bool
$c>= :: Minute -> Minute -> Bool
> :: Minute -> Minute -> Bool
$c> :: Minute -> Minute -> Bool
<= :: Minute -> Minute -> Bool
$c<= :: Minute -> Minute -> Bool
< :: Minute -> Minute -> Bool
$c< :: Minute -> Minute -> Bool
compare :: Minute -> Minute -> Ordering
$ccompare :: Minute -> Minute -> Ordering
$cp1Ord :: Eq Minute
Ord,Num Minute
Ord Minute
Num Minute -> Ord Minute -> (Minute -> Rational) -> Real Minute
Minute -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Minute -> Rational
$ctoRational :: Minute -> Rational
$cp2Real :: Ord Minute
$cp1Real :: Num Minute
Real,Ord Minute
Ord Minute
-> ((Minute, Minute) -> [Minute])
-> ((Minute, Minute) -> Minute -> Int)
-> ((Minute, Minute) -> Minute -> Int)
-> ((Minute, Minute) -> Minute -> Bool)
-> ((Minute, Minute) -> Int)
-> ((Minute, Minute) -> Int)
-> Ix Minute
(Minute, Minute) -> Int
(Minute, Minute) -> [Minute]
(Minute, Minute) -> Minute -> Bool
(Minute, Minute) -> Minute -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Minute, Minute) -> Int
$cunsafeRangeSize :: (Minute, Minute) -> Int
rangeSize :: (Minute, Minute) -> Int
$crangeSize :: (Minute, Minute) -> Int
inRange :: (Minute, Minute) -> Minute -> Bool
$cinRange :: (Minute, Minute) -> Minute -> Bool
unsafeIndex :: (Minute, Minute) -> Minute -> Int
$cunsafeIndex :: (Minute, Minute) -> Minute -> Int
index :: (Minute, Minute) -> Minute -> Int
$cindex :: (Minute, Minute) -> Minute -> Int
range :: (Minute, Minute) -> [Minute]
$crange :: (Minute, Minute) -> [Minute]
$cp1Ix :: Ord Minute
Ix,Typeable)

instance TimeUnit Minute where
  toMicroseconds :: Minute -> Integer
toMicroseconds (Minute Integer
x) = Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Second -> Integer
forall a. TimeUnit a => a -> Integer
toMicroseconds (Second -> Integer) -> Second -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Second
Second Integer
60)
  fromMicroseconds :: Integer -> Minute
fromMicroseconds Integer
x        = Integer -> Minute
Minute (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Second -> Integer
forall a. TimeUnit a => a -> Integer
toMicroseconds (Second -> Integer) -> Second -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Second
Second Integer
60))
instance Show Minute where
  show :: Minute -> String
show (Minute Integer
x) = Integer -> String
forall a. Show a => a -> String
show Integer
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"m"
instance Read Minute where
  readsPrec :: Int -> ReadS Minute
readsPrec = (Integer -> Minute) -> String -> Int -> ReadS Minute
forall a.
(Integer -> a) -> String -> Int -> String -> [(a, String)]
readUnit Integer -> Minute
Minute String
"m"

--

newtype Hour        = Hour        Integer
 deriving (Int -> Hour
Hour -> Int
Hour -> [Hour]
Hour -> Hour
Hour -> Hour -> [Hour]
Hour -> Hour -> Hour -> [Hour]
(Hour -> Hour)
-> (Hour -> Hour)
-> (Int -> Hour)
-> (Hour -> Int)
-> (Hour -> [Hour])
-> (Hour -> Hour -> [Hour])
-> (Hour -> Hour -> [Hour])
-> (Hour -> Hour -> Hour -> [Hour])
-> Enum Hour
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Hour -> Hour -> Hour -> [Hour]
$cenumFromThenTo :: Hour -> Hour -> Hour -> [Hour]
enumFromTo :: Hour -> Hour -> [Hour]
$cenumFromTo :: Hour -> Hour -> [Hour]
enumFromThen :: Hour -> Hour -> [Hour]
$cenumFromThen :: Hour -> Hour -> [Hour]
enumFrom :: Hour -> [Hour]
$cenumFrom :: Hour -> [Hour]
fromEnum :: Hour -> Int
$cfromEnum :: Hour -> Int
toEnum :: Int -> Hour
$ctoEnum :: Int -> Hour
pred :: Hour -> Hour
$cpred :: Hour -> Hour
succ :: Hour -> Hour
$csucc :: Hour -> Hour
Enum,Hour -> Hour -> Bool
(Hour -> Hour -> Bool) -> (Hour -> Hour -> Bool) -> Eq Hour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hour -> Hour -> Bool
$c/= :: Hour -> Hour -> Bool
== :: Hour -> Hour -> Bool
$c== :: Hour -> Hour -> Bool
Eq,Enum Hour
Real Hour
Real Hour
-> Enum Hour
-> (Hour -> Hour -> Hour)
-> (Hour -> Hour -> Hour)
-> (Hour -> Hour -> Hour)
-> (Hour -> Hour -> Hour)
-> (Hour -> Hour -> (Hour, Hour))
-> (Hour -> Hour -> (Hour, Hour))
-> (Hour -> Integer)
-> Integral Hour
Hour -> Integer
Hour -> Hour -> (Hour, Hour)
Hour -> Hour -> Hour
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Hour -> Integer
$ctoInteger :: Hour -> Integer
divMod :: Hour -> Hour -> (Hour, Hour)
$cdivMod :: Hour -> Hour -> (Hour, Hour)
quotRem :: Hour -> Hour -> (Hour, Hour)
$cquotRem :: Hour -> Hour -> (Hour, Hour)
mod :: Hour -> Hour -> Hour
$cmod :: Hour -> Hour -> Hour
div :: Hour -> Hour -> Hour
$cdiv :: Hour -> Hour -> Hour
rem :: Hour -> Hour -> Hour
$crem :: Hour -> Hour -> Hour
quot :: Hour -> Hour -> Hour
$cquot :: Hour -> Hour -> Hour
$cp2Integral :: Enum Hour
$cp1Integral :: Real Hour
Integral,Typeable Hour
DataType
Constr
Typeable Hour
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Hour -> c Hour)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Hour)
-> (Hour -> Constr)
-> (Hour -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Hour))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Hour))
-> ((forall b. Data b => b -> b) -> Hour -> Hour)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Hour -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Hour -> r)
-> (forall u. (forall d. Data d => d -> u) -> Hour -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Hour -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Hour -> m Hour)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Hour -> m Hour)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Hour -> m Hour)
-> Data Hour
Hour -> DataType
Hour -> Constr
(forall b. Data b => b -> b) -> Hour -> Hour
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Hour -> c Hour
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Hour
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Hour -> u
forall u. (forall d. Data d => d -> u) -> Hour -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Hour -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Hour -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Hour -> m Hour
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Hour -> m Hour
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Hour
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Hour -> c Hour
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Hour)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Hour)
$cHour :: Constr
$tHour :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Hour -> m Hour
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Hour -> m Hour
gmapMp :: (forall d. Data d => d -> m d) -> Hour -> m Hour
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Hour -> m Hour
gmapM :: (forall d. Data d => d -> m d) -> Hour -> m Hour
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Hour -> m Hour
gmapQi :: Int -> (forall d. Data d => d -> u) -> Hour -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Hour -> u
gmapQ :: (forall d. Data d => d -> u) -> Hour -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Hour -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Hour -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Hour -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Hour -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Hour -> r
gmapT :: (forall b. Data b => b -> b) -> Hour -> Hour
$cgmapT :: (forall b. Data b => b -> b) -> Hour -> Hour
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Hour)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Hour)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Hour)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Hour)
dataTypeOf :: Hour -> DataType
$cdataTypeOf :: Hour -> DataType
toConstr :: Hour -> Constr
$ctoConstr :: Hour -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Hour
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Hour
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Hour -> c Hour
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Hour -> c Hour
$cp1Data :: Typeable Hour
Data,Integer -> Hour
Hour -> Hour
Hour -> Hour -> Hour
(Hour -> Hour -> Hour)
-> (Hour -> Hour -> Hour)
-> (Hour -> Hour -> Hour)
-> (Hour -> Hour)
-> (Hour -> Hour)
-> (Hour -> Hour)
-> (Integer -> Hour)
-> Num Hour
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Hour
$cfromInteger :: Integer -> Hour
signum :: Hour -> Hour
$csignum :: Hour -> Hour
abs :: Hour -> Hour
$cabs :: Hour -> Hour
negate :: Hour -> Hour
$cnegate :: Hour -> Hour
* :: Hour -> Hour -> Hour
$c* :: Hour -> Hour -> Hour
- :: Hour -> Hour -> Hour
$c- :: Hour -> Hour -> Hour
+ :: Hour -> Hour -> Hour
$c+ :: Hour -> Hour -> Hour
Num,Eq Hour
Eq Hour
-> (Hour -> Hour -> Ordering)
-> (Hour -> Hour -> Bool)
-> (Hour -> Hour -> Bool)
-> (Hour -> Hour -> Bool)
-> (Hour -> Hour -> Bool)
-> (Hour -> Hour -> Hour)
-> (Hour -> Hour -> Hour)
-> Ord Hour
Hour -> Hour -> Bool
Hour -> Hour -> Ordering
Hour -> Hour -> Hour
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Hour -> Hour -> Hour
$cmin :: Hour -> Hour -> Hour
max :: Hour -> Hour -> Hour
$cmax :: Hour -> Hour -> Hour
>= :: Hour -> Hour -> Bool
$c>= :: Hour -> Hour -> Bool
> :: Hour -> Hour -> Bool
$c> :: Hour -> Hour -> Bool
<= :: Hour -> Hour -> Bool
$c<= :: Hour -> Hour -> Bool
< :: Hour -> Hour -> Bool
$c< :: Hour -> Hour -> Bool
compare :: Hour -> Hour -> Ordering
$ccompare :: Hour -> Hour -> Ordering
$cp1Ord :: Eq Hour
Ord,Num Hour
Ord Hour
Num Hour -> Ord Hour -> (Hour -> Rational) -> Real Hour
Hour -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Hour -> Rational
$ctoRational :: Hour -> Rational
$cp2Real :: Ord Hour
$cp1Real :: Num Hour
Real,Ord Hour
Ord Hour
-> ((Hour, Hour) -> [Hour])
-> ((Hour, Hour) -> Hour -> Int)
-> ((Hour, Hour) -> Hour -> Int)
-> ((Hour, Hour) -> Hour -> Bool)
-> ((Hour, Hour) -> Int)
-> ((Hour, Hour) -> Int)
-> Ix Hour
(Hour, Hour) -> Int
(Hour, Hour) -> [Hour]
(Hour, Hour) -> Hour -> Bool
(Hour, Hour) -> Hour -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Hour, Hour) -> Int
$cunsafeRangeSize :: (Hour, Hour) -> Int
rangeSize :: (Hour, Hour) -> Int
$crangeSize :: (Hour, Hour) -> Int
inRange :: (Hour, Hour) -> Hour -> Bool
$cinRange :: (Hour, Hour) -> Hour -> Bool
unsafeIndex :: (Hour, Hour) -> Hour -> Int
$cunsafeIndex :: (Hour, Hour) -> Hour -> Int
index :: (Hour, Hour) -> Hour -> Int
$cindex :: (Hour, Hour) -> Hour -> Int
range :: (Hour, Hour) -> [Hour]
$crange :: (Hour, Hour) -> [Hour]
$cp1Ix :: Ord Hour
Ix,Typeable)

instance TimeUnit Hour where
  toMicroseconds :: Hour -> Integer
toMicroseconds (Hour Integer
x) = Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Minute -> Integer
forall a. TimeUnit a => a -> Integer
toMicroseconds (Minute -> Integer) -> Minute -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Minute
Minute Integer
60)
  fromMicroseconds :: Integer -> Hour
fromMicroseconds Integer
x      = Integer -> Hour
Hour (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Minute -> Integer
forall a. TimeUnit a => a -> Integer
toMicroseconds (Minute -> Integer) -> Minute -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Minute
Minute Integer
60))
instance Show Hour where
  show :: Hour -> String
show (Hour Integer
x) = Integer -> String
forall a. Show a => a -> String
show Integer
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"h"
instance Read Hour where
  readsPrec :: Int -> ReadS Hour
readsPrec = (Integer -> Hour) -> String -> Int -> ReadS Hour
forall a.
(Integer -> a) -> String -> Int -> String -> [(a, String)]
readUnit Integer -> Hour
Hour String
"h"

--

newtype Day         = Day         Integer
 deriving (Int -> Day
Day -> Int
Day -> [Day]
Day -> Day
Day -> Day -> [Day]
Day -> Day -> Day -> [Day]
(Day -> Day)
-> (Day -> Day)
-> (Int -> Day)
-> (Day -> Int)
-> (Day -> [Day])
-> (Day -> Day -> [Day])
-> (Day -> Day -> [Day])
-> (Day -> Day -> Day -> [Day])
-> Enum Day
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Day -> Day -> Day -> [Day]
$cenumFromThenTo :: Day -> Day -> Day -> [Day]
enumFromTo :: Day -> Day -> [Day]
$cenumFromTo :: Day -> Day -> [Day]
enumFromThen :: Day -> Day -> [Day]
$cenumFromThen :: Day -> Day -> [Day]
enumFrom :: Day -> [Day]
$cenumFrom :: Day -> [Day]
fromEnum :: Day -> Int
$cfromEnum :: Day -> Int
toEnum :: Int -> Day
$ctoEnum :: Int -> Day
pred :: Day -> Day
$cpred :: Day -> Day
succ :: Day -> Day
$csucc :: Day -> Day
Enum,Day -> Day -> Bool
(Day -> Day -> Bool) -> (Day -> Day -> Bool) -> Eq Day
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Day -> Day -> Bool
$c/= :: Day -> Day -> Bool
== :: Day -> Day -> Bool
$c== :: Day -> Day -> Bool
Eq,Enum Day
Real Day
Real Day
-> Enum Day
-> (Day -> Day -> Day)
-> (Day -> Day -> Day)
-> (Day -> Day -> Day)
-> (Day -> Day -> Day)
-> (Day -> Day -> (Day, Day))
-> (Day -> Day -> (Day, Day))
-> (Day -> Integer)
-> Integral Day
Day -> Integer
Day -> Day -> (Day, Day)
Day -> Day -> Day
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Day -> Integer
$ctoInteger :: Day -> Integer
divMod :: Day -> Day -> (Day, Day)
$cdivMod :: Day -> Day -> (Day, Day)
quotRem :: Day -> Day -> (Day, Day)
$cquotRem :: Day -> Day -> (Day, Day)
mod :: Day -> Day -> Day
$cmod :: Day -> Day -> Day
div :: Day -> Day -> Day
$cdiv :: Day -> Day -> Day
rem :: Day -> Day -> Day
$crem :: Day -> Day -> Day
quot :: Day -> Day -> Day
$cquot :: Day -> Day -> Day
$cp2Integral :: Enum Day
$cp1Integral :: Real Day
Integral,Typeable Day
DataType
Constr
Typeable Day
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Day -> c Day)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Day)
-> (Day -> Constr)
-> (Day -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Day))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Day))
-> ((forall b. Data b => b -> b) -> Day -> Day)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r)
-> (forall u. (forall d. Data d => d -> u) -> Day -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Day -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Day -> m Day)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Day -> m Day)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Day -> m Day)
-> Data Day
Day -> DataType
Day -> Constr
(forall b. Data b => b -> b) -> Day -> Day
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Day -> c Day
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Day
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Day -> u
forall u. (forall d. Data d => d -> u) -> Day -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Day -> m Day
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Day -> m Day
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Day
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Day -> c Day
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Day)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Day)
$cDay :: Constr
$tDay :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Day -> m Day
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Day -> m Day
gmapMp :: (forall d. Data d => d -> m d) -> Day -> m Day
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Day -> m Day
gmapM :: (forall d. Data d => d -> m d) -> Day -> m Day
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Day -> m Day
gmapQi :: Int -> (forall d. Data d => d -> u) -> Day -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Day -> u
gmapQ :: (forall d. Data d => d -> u) -> Day -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Day -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r
gmapT :: (forall b. Data b => b -> b) -> Day -> Day
$cgmapT :: (forall b. Data b => b -> b) -> Day -> Day
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Day)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Day)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Day)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Day)
dataTypeOf :: Day -> DataType
$cdataTypeOf :: Day -> DataType
toConstr :: Day -> Constr
$ctoConstr :: Day -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Day
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Day
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Day -> c Day
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Day -> c Day
$cp1Data :: Typeable Day
Data,Integer -> Day
Day -> Day
Day -> Day -> Day
(Day -> Day -> Day)
-> (Day -> Day -> Day)
-> (Day -> Day -> Day)
-> (Day -> Day)
-> (Day -> Day)
-> (Day -> Day)
-> (Integer -> Day)
-> Num Day
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Day
$cfromInteger :: Integer -> Day
signum :: Day -> Day
$csignum :: Day -> Day
abs :: Day -> Day
$cabs :: Day -> Day
negate :: Day -> Day
$cnegate :: Day -> Day
* :: Day -> Day -> Day
$c* :: Day -> Day -> Day
- :: Day -> Day -> Day
$c- :: Day -> Day -> Day
+ :: Day -> Day -> Day
$c+ :: Day -> Day -> Day
Num,Eq Day
Eq Day
-> (Day -> Day -> Ordering)
-> (Day -> Day -> Bool)
-> (Day -> Day -> Bool)
-> (Day -> Day -> Bool)
-> (Day -> Day -> Bool)
-> (Day -> Day -> Day)
-> (Day -> Day -> Day)
-> Ord Day
Day -> Day -> Bool
Day -> Day -> Ordering
Day -> Day -> Day
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Day -> Day -> Day
$cmin :: Day -> Day -> Day
max :: Day -> Day -> Day
$cmax :: Day -> Day -> Day
>= :: Day -> Day -> Bool
$c>= :: Day -> Day -> Bool
> :: Day -> Day -> Bool
$c> :: Day -> Day -> Bool
<= :: Day -> Day -> Bool
$c<= :: Day -> Day -> Bool
< :: Day -> Day -> Bool
$c< :: Day -> Day -> Bool
compare :: Day -> Day -> Ordering
$ccompare :: Day -> Day -> Ordering
$cp1Ord :: Eq Day
Ord,Num Day
Ord Day
Num Day -> Ord Day -> (Day -> Rational) -> Real Day
Day -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Day -> Rational
$ctoRational :: Day -> Rational
$cp2Real :: Ord Day
$cp1Real :: Num Day
Real,Ord Day
Ord Day
-> ((Day, Day) -> [Day])
-> ((Day, Day) -> Day -> Int)
-> ((Day, Day) -> Day -> Int)
-> ((Day, Day) -> Day -> Bool)
-> ((Day, Day) -> Int)
-> ((Day, Day) -> Int)
-> Ix Day
(Day, Day) -> Int
(Day, Day) -> [Day]
(Day, Day) -> Day -> Bool
(Day, Day) -> Day -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Day, Day) -> Int
$cunsafeRangeSize :: (Day, Day) -> Int
rangeSize :: (Day, Day) -> Int
$crangeSize :: (Day, Day) -> Int
inRange :: (Day, Day) -> Day -> Bool
$cinRange :: (Day, Day) -> Day -> Bool
unsafeIndex :: (Day, Day) -> Day -> Int
$cunsafeIndex :: (Day, Day) -> Day -> Int
index :: (Day, Day) -> Day -> Int
$cindex :: (Day, Day) -> Day -> Int
range :: (Day, Day) -> [Day]
$crange :: (Day, Day) -> [Day]
$cp1Ix :: Ord Day
Ix,Typeable)

instance TimeUnit Day where
  toMicroseconds :: Day -> Integer
toMicroseconds (Day Integer
x) = Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Hour -> Integer
forall a. TimeUnit a => a -> Integer
toMicroseconds (Hour -> Integer) -> Hour -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Hour
Hour Integer
24)
  fromMicroseconds :: Integer -> Day
fromMicroseconds Integer
x     = Integer -> Day
Day (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Hour -> Integer
forall a. TimeUnit a => a -> Integer
toMicroseconds (Hour -> Integer) -> Hour -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Hour
Hour Integer
24))
instance Show Day where
  show :: Day -> String
show (Day Integer
x) = Integer -> String
forall a. Show a => a -> String
show Integer
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"d"
instance Read Day where
  readsPrec :: Int -> ReadS Day
readsPrec = (Integer -> Day) -> String -> Int -> ReadS Day
forall a.
(Integer -> a) -> String -> Int -> String -> [(a, String)]
readUnit Integer -> Day
Day String
"d"

--

newtype Week        = Week        Integer
 deriving (Int -> Week
Week -> Int
Week -> [Week]
Week -> Week
Week -> Week -> [Week]
Week -> Week -> Week -> [Week]
(Week -> Week)
-> (Week -> Week)
-> (Int -> Week)
-> (Week -> Int)
-> (Week -> [Week])
-> (Week -> Week -> [Week])
-> (Week -> Week -> [Week])
-> (Week -> Week -> Week -> [Week])
-> Enum Week
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Week -> Week -> Week -> [Week]
$cenumFromThenTo :: Week -> Week -> Week -> [Week]
enumFromTo :: Week -> Week -> [Week]
$cenumFromTo :: Week -> Week -> [Week]
enumFromThen :: Week -> Week -> [Week]
$cenumFromThen :: Week -> Week -> [Week]
enumFrom :: Week -> [Week]
$cenumFrom :: Week -> [Week]
fromEnum :: Week -> Int
$cfromEnum :: Week -> Int
toEnum :: Int -> Week
$ctoEnum :: Int -> Week
pred :: Week -> Week
$cpred :: Week -> Week
succ :: Week -> Week
$csucc :: Week -> Week
Enum,Week -> Week -> Bool
(Week -> Week -> Bool) -> (Week -> Week -> Bool) -> Eq Week
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Week -> Week -> Bool
$c/= :: Week -> Week -> Bool
== :: Week -> Week -> Bool
$c== :: Week -> Week -> Bool
Eq,Enum Week
Real Week
Real Week
-> Enum Week
-> (Week -> Week -> Week)
-> (Week -> Week -> Week)
-> (Week -> Week -> Week)
-> (Week -> Week -> Week)
-> (Week -> Week -> (Week, Week))
-> (Week -> Week -> (Week, Week))
-> (Week -> Integer)
-> Integral Week
Week -> Integer
Week -> Week -> (Week, Week)
Week -> Week -> Week
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Week -> Integer
$ctoInteger :: Week -> Integer
divMod :: Week -> Week -> (Week, Week)
$cdivMod :: Week -> Week -> (Week, Week)
quotRem :: Week -> Week -> (Week, Week)
$cquotRem :: Week -> Week -> (Week, Week)
mod :: Week -> Week -> Week
$cmod :: Week -> Week -> Week
div :: Week -> Week -> Week
$cdiv :: Week -> Week -> Week
rem :: Week -> Week -> Week
$crem :: Week -> Week -> Week
quot :: Week -> Week -> Week
$cquot :: Week -> Week -> Week
$cp2Integral :: Enum Week
$cp1Integral :: Real Week
Integral,Typeable Week
DataType
Constr
Typeable Week
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Week -> c Week)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Week)
-> (Week -> Constr)
-> (Week -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Week))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Week))
-> ((forall b. Data b => b -> b) -> Week -> Week)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Week -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Week -> r)
-> (forall u. (forall d. Data d => d -> u) -> Week -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Week -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Week -> m Week)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Week -> m Week)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Week -> m Week)
-> Data Week
Week -> DataType
Week -> Constr
(forall b. Data b => b -> b) -> Week -> Week
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Week -> c Week
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Week
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Week -> u
forall u. (forall d. Data d => d -> u) -> Week -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Week -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Week -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Week -> m Week
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Week -> m Week
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Week
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Week -> c Week
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Week)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Week)
$cWeek :: Constr
$tWeek :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Week -> m Week
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Week -> m Week
gmapMp :: (forall d. Data d => d -> m d) -> Week -> m Week
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Week -> m Week
gmapM :: (forall d. Data d => d -> m d) -> Week -> m Week
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Week -> m Week
gmapQi :: Int -> (forall d. Data d => d -> u) -> Week -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Week -> u
gmapQ :: (forall d. Data d => d -> u) -> Week -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Week -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Week -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Week -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Week -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Week -> r
gmapT :: (forall b. Data b => b -> b) -> Week -> Week
$cgmapT :: (forall b. Data b => b -> b) -> Week -> Week
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Week)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Week)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Week)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Week)
dataTypeOf :: Week -> DataType
$cdataTypeOf :: Week -> DataType
toConstr :: Week -> Constr
$ctoConstr :: Week -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Week
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Week
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Week -> c Week
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Week -> c Week
$cp1Data :: Typeable Week
Data,Integer -> Week
Week -> Week
Week -> Week -> Week
(Week -> Week -> Week)
-> (Week -> Week -> Week)
-> (Week -> Week -> Week)
-> (Week -> Week)
-> (Week -> Week)
-> (Week -> Week)
-> (Integer -> Week)
-> Num Week
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Week
$cfromInteger :: Integer -> Week
signum :: Week -> Week
$csignum :: Week -> Week
abs :: Week -> Week
$cabs :: Week -> Week
negate :: Week -> Week
$cnegate :: Week -> Week
* :: Week -> Week -> Week
$c* :: Week -> Week -> Week
- :: Week -> Week -> Week
$c- :: Week -> Week -> Week
+ :: Week -> Week -> Week
$c+ :: Week -> Week -> Week
Num,Eq Week
Eq Week
-> (Week -> Week -> Ordering)
-> (Week -> Week -> Bool)
-> (Week -> Week -> Bool)
-> (Week -> Week -> Bool)
-> (Week -> Week -> Bool)
-> (Week -> Week -> Week)
-> (Week -> Week -> Week)
-> Ord Week
Week -> Week -> Bool
Week -> Week -> Ordering
Week -> Week -> Week
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Week -> Week -> Week
$cmin :: Week -> Week -> Week
max :: Week -> Week -> Week
$cmax :: Week -> Week -> Week
>= :: Week -> Week -> Bool
$c>= :: Week -> Week -> Bool
> :: Week -> Week -> Bool
$c> :: Week -> Week -> Bool
<= :: Week -> Week -> Bool
$c<= :: Week -> Week -> Bool
< :: Week -> Week -> Bool
$c< :: Week -> Week -> Bool
compare :: Week -> Week -> Ordering
$ccompare :: Week -> Week -> Ordering
$cp1Ord :: Eq Week
Ord,Num Week
Ord Week
Num Week -> Ord Week -> (Week -> Rational) -> Real Week
Week -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Week -> Rational
$ctoRational :: Week -> Rational
$cp2Real :: Ord Week
$cp1Real :: Num Week
Real,Ord Week
Ord Week
-> ((Week, Week) -> [Week])
-> ((Week, Week) -> Week -> Int)
-> ((Week, Week) -> Week -> Int)
-> ((Week, Week) -> Week -> Bool)
-> ((Week, Week) -> Int)
-> ((Week, Week) -> Int)
-> Ix Week
(Week, Week) -> Int
(Week, Week) -> [Week]
(Week, Week) -> Week -> Bool
(Week, Week) -> Week -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Week, Week) -> Int
$cunsafeRangeSize :: (Week, Week) -> Int
rangeSize :: (Week, Week) -> Int
$crangeSize :: (Week, Week) -> Int
inRange :: (Week, Week) -> Week -> Bool
$cinRange :: (Week, Week) -> Week -> Bool
unsafeIndex :: (Week, Week) -> Week -> Int
$cunsafeIndex :: (Week, Week) -> Week -> Int
index :: (Week, Week) -> Week -> Int
$cindex :: (Week, Week) -> Week -> Int
range :: (Week, Week) -> [Week]
$crange :: (Week, Week) -> [Week]
$cp1Ix :: Ord Week
Ix,Typeable)

instance TimeUnit Week where
  toMicroseconds :: Week -> Integer
toMicroseconds (Week Integer
x) = Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Day -> Integer
forall a. TimeUnit a => a -> Integer
toMicroseconds (Day -> Integer) -> Day -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Day
Day Integer
7)
  fromMicroseconds :: Integer -> Week
fromMicroseconds Integer
x      = Integer -> Week
Week (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Day -> Integer
forall a. TimeUnit a => a -> Integer
toMicroseconds (Day -> Integer) -> Day -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Day
Day Integer
7))
instance Show Week where
  show :: Week -> String
show (Week Integer
x) = Integer -> String
forall a. Show a => a -> String
show Integer
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"w"
instance Read Week where
  readsPrec :: Int -> ReadS Week
readsPrec = (Integer -> Week) -> String -> Int -> ReadS Week
forall a.
(Integer -> a) -> String -> Int -> String -> [(a, String)]
readUnit Integer -> Week
Week String
"w"

--

newtype Fortnight   = Fortnight   Integer
 deriving (Int -> Fortnight
Fortnight -> Int
Fortnight -> [Fortnight]
Fortnight -> Fortnight
Fortnight -> Fortnight -> [Fortnight]
Fortnight -> Fortnight -> Fortnight -> [Fortnight]
(Fortnight -> Fortnight)
-> (Fortnight -> Fortnight)
-> (Int -> Fortnight)
-> (Fortnight -> Int)
-> (Fortnight -> [Fortnight])
-> (Fortnight -> Fortnight -> [Fortnight])
-> (Fortnight -> Fortnight -> [Fortnight])
-> (Fortnight -> Fortnight -> Fortnight -> [Fortnight])
-> Enum Fortnight
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Fortnight -> Fortnight -> Fortnight -> [Fortnight]
$cenumFromThenTo :: Fortnight -> Fortnight -> Fortnight -> [Fortnight]
enumFromTo :: Fortnight -> Fortnight -> [Fortnight]
$cenumFromTo :: Fortnight -> Fortnight -> [Fortnight]
enumFromThen :: Fortnight -> Fortnight -> [Fortnight]
$cenumFromThen :: Fortnight -> Fortnight -> [Fortnight]
enumFrom :: Fortnight -> [Fortnight]
$cenumFrom :: Fortnight -> [Fortnight]
fromEnum :: Fortnight -> Int
$cfromEnum :: Fortnight -> Int
toEnum :: Int -> Fortnight
$ctoEnum :: Int -> Fortnight
pred :: Fortnight -> Fortnight
$cpred :: Fortnight -> Fortnight
succ :: Fortnight -> Fortnight
$csucc :: Fortnight -> Fortnight
Enum,Fortnight -> Fortnight -> Bool
(Fortnight -> Fortnight -> Bool)
-> (Fortnight -> Fortnight -> Bool) -> Eq Fortnight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fortnight -> Fortnight -> Bool
$c/= :: Fortnight -> Fortnight -> Bool
== :: Fortnight -> Fortnight -> Bool
$c== :: Fortnight -> Fortnight -> Bool
Eq,Enum Fortnight
Real Fortnight
Real Fortnight
-> Enum Fortnight
-> (Fortnight -> Fortnight -> Fortnight)
-> (Fortnight -> Fortnight -> Fortnight)
-> (Fortnight -> Fortnight -> Fortnight)
-> (Fortnight -> Fortnight -> Fortnight)
-> (Fortnight -> Fortnight -> (Fortnight, Fortnight))
-> (Fortnight -> Fortnight -> (Fortnight, Fortnight))
-> (Fortnight -> Integer)
-> Integral Fortnight
Fortnight -> Integer
Fortnight -> Fortnight -> (Fortnight, Fortnight)
Fortnight -> Fortnight -> Fortnight
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Fortnight -> Integer
$ctoInteger :: Fortnight -> Integer
divMod :: Fortnight -> Fortnight -> (Fortnight, Fortnight)
$cdivMod :: Fortnight -> Fortnight -> (Fortnight, Fortnight)
quotRem :: Fortnight -> Fortnight -> (Fortnight, Fortnight)
$cquotRem :: Fortnight -> Fortnight -> (Fortnight, Fortnight)
mod :: Fortnight -> Fortnight -> Fortnight
$cmod :: Fortnight -> Fortnight -> Fortnight
div :: Fortnight -> Fortnight -> Fortnight
$cdiv :: Fortnight -> Fortnight -> Fortnight
rem :: Fortnight -> Fortnight -> Fortnight
$crem :: Fortnight -> Fortnight -> Fortnight
quot :: Fortnight -> Fortnight -> Fortnight
$cquot :: Fortnight -> Fortnight -> Fortnight
$cp2Integral :: Enum Fortnight
$cp1Integral :: Real Fortnight
Integral,Typeable Fortnight
DataType
Constr
Typeable Fortnight
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Fortnight -> c Fortnight)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Fortnight)
-> (Fortnight -> Constr)
-> (Fortnight -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Fortnight))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Fortnight))
-> ((forall b. Data b => b -> b) -> Fortnight -> Fortnight)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Fortnight -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Fortnight -> r)
-> (forall u. (forall d. Data d => d -> u) -> Fortnight -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Fortnight -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Fortnight -> m Fortnight)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Fortnight -> m Fortnight)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Fortnight -> m Fortnight)
-> Data Fortnight
Fortnight -> DataType
Fortnight -> Constr
(forall b. Data b => b -> b) -> Fortnight -> Fortnight
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Fortnight -> c Fortnight
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Fortnight
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Fortnight -> u
forall u. (forall d. Data d => d -> u) -> Fortnight -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Fortnight -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Fortnight -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Fortnight -> m Fortnight
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Fortnight -> m Fortnight
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Fortnight
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Fortnight -> c Fortnight
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Fortnight)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Fortnight)
$cFortnight :: Constr
$tFortnight :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Fortnight -> m Fortnight
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Fortnight -> m Fortnight
gmapMp :: (forall d. Data d => d -> m d) -> Fortnight -> m Fortnight
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Fortnight -> m Fortnight
gmapM :: (forall d. Data d => d -> m d) -> Fortnight -> m Fortnight
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Fortnight -> m Fortnight
gmapQi :: Int -> (forall d. Data d => d -> u) -> Fortnight -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Fortnight -> u
gmapQ :: (forall d. Data d => d -> u) -> Fortnight -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Fortnight -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Fortnight -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Fortnight -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Fortnight -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Fortnight -> r
gmapT :: (forall b. Data b => b -> b) -> Fortnight -> Fortnight
$cgmapT :: (forall b. Data b => b -> b) -> Fortnight -> Fortnight
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Fortnight)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Fortnight)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Fortnight)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Fortnight)
dataTypeOf :: Fortnight -> DataType
$cdataTypeOf :: Fortnight -> DataType
toConstr :: Fortnight -> Constr
$ctoConstr :: Fortnight -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Fortnight
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Fortnight
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Fortnight -> c Fortnight
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Fortnight -> c Fortnight
$cp1Data :: Typeable Fortnight
Data,Integer -> Fortnight
Fortnight -> Fortnight
Fortnight -> Fortnight -> Fortnight
(Fortnight -> Fortnight -> Fortnight)
-> (Fortnight -> Fortnight -> Fortnight)
-> (Fortnight -> Fortnight -> Fortnight)
-> (Fortnight -> Fortnight)
-> (Fortnight -> Fortnight)
-> (Fortnight -> Fortnight)
-> (Integer -> Fortnight)
-> Num Fortnight
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Fortnight
$cfromInteger :: Integer -> Fortnight
signum :: Fortnight -> Fortnight
$csignum :: Fortnight -> Fortnight
abs :: Fortnight -> Fortnight
$cabs :: Fortnight -> Fortnight
negate :: Fortnight -> Fortnight
$cnegate :: Fortnight -> Fortnight
* :: Fortnight -> Fortnight -> Fortnight
$c* :: Fortnight -> Fortnight -> Fortnight
- :: Fortnight -> Fortnight -> Fortnight
$c- :: Fortnight -> Fortnight -> Fortnight
+ :: Fortnight -> Fortnight -> Fortnight
$c+ :: Fortnight -> Fortnight -> Fortnight
Num,Eq Fortnight
Eq Fortnight
-> (Fortnight -> Fortnight -> Ordering)
-> (Fortnight -> Fortnight -> Bool)
-> (Fortnight -> Fortnight -> Bool)
-> (Fortnight -> Fortnight -> Bool)
-> (Fortnight -> Fortnight -> Bool)
-> (Fortnight -> Fortnight -> Fortnight)
-> (Fortnight -> Fortnight -> Fortnight)
-> Ord Fortnight
Fortnight -> Fortnight -> Bool
Fortnight -> Fortnight -> Ordering
Fortnight -> Fortnight -> Fortnight
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Fortnight -> Fortnight -> Fortnight
$cmin :: Fortnight -> Fortnight -> Fortnight
max :: Fortnight -> Fortnight -> Fortnight
$cmax :: Fortnight -> Fortnight -> Fortnight
>= :: Fortnight -> Fortnight -> Bool
$c>= :: Fortnight -> Fortnight -> Bool
> :: Fortnight -> Fortnight -> Bool
$c> :: Fortnight -> Fortnight -> Bool
<= :: Fortnight -> Fortnight -> Bool
$c<= :: Fortnight -> Fortnight -> Bool
< :: Fortnight -> Fortnight -> Bool
$c< :: Fortnight -> Fortnight -> Bool
compare :: Fortnight -> Fortnight -> Ordering
$ccompare :: Fortnight -> Fortnight -> Ordering
$cp1Ord :: Eq Fortnight
Ord,Num Fortnight
Ord Fortnight
Num Fortnight
-> Ord Fortnight -> (Fortnight -> Rational) -> Real Fortnight
Fortnight -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Fortnight -> Rational
$ctoRational :: Fortnight -> Rational
$cp2Real :: Ord Fortnight
$cp1Real :: Num Fortnight
Real,Ord Fortnight
Ord Fortnight
-> ((Fortnight, Fortnight) -> [Fortnight])
-> ((Fortnight, Fortnight) -> Fortnight -> Int)
-> ((Fortnight, Fortnight) -> Fortnight -> Int)
-> ((Fortnight, Fortnight) -> Fortnight -> Bool)
-> ((Fortnight, Fortnight) -> Int)
-> ((Fortnight, Fortnight) -> Int)
-> Ix Fortnight
(Fortnight, Fortnight) -> Int
(Fortnight, Fortnight) -> [Fortnight]
(Fortnight, Fortnight) -> Fortnight -> Bool
(Fortnight, Fortnight) -> Fortnight -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Fortnight, Fortnight) -> Int
$cunsafeRangeSize :: (Fortnight, Fortnight) -> Int
rangeSize :: (Fortnight, Fortnight) -> Int
$crangeSize :: (Fortnight, Fortnight) -> Int
inRange :: (Fortnight, Fortnight) -> Fortnight -> Bool
$cinRange :: (Fortnight, Fortnight) -> Fortnight -> Bool
unsafeIndex :: (Fortnight, Fortnight) -> Fortnight -> Int
$cunsafeIndex :: (Fortnight, Fortnight) -> Fortnight -> Int
index :: (Fortnight, Fortnight) -> Fortnight -> Int
$cindex :: (Fortnight, Fortnight) -> Fortnight -> Int
range :: (Fortnight, Fortnight) -> [Fortnight]
$crange :: (Fortnight, Fortnight) -> [Fortnight]
$cp1Ix :: Ord Fortnight
Ix,Typeable)

instance TimeUnit Fortnight where
  toMicroseconds :: Fortnight -> Integer
toMicroseconds (Fortnight Integer
x) = Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Week -> Integer
forall a. TimeUnit a => a -> Integer
toMicroseconds (Week -> Integer) -> Week -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Week
Week Integer
2)
  fromMicroseconds :: Integer -> Fortnight
fromMicroseconds Integer
x           = Integer -> Fortnight
Fortnight (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Week -> Integer
forall a. TimeUnit a => a -> Integer
toMicroseconds (Week -> Integer) -> Week -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Week
Week Integer
2))
instance Show Fortnight where
  show :: Fortnight -> String
show (Fortnight Integer
x) = Integer -> String
forall a. Show a => a -> String
show Integer
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"fn"
instance Read Fortnight where
  readsPrec :: Int -> ReadS Fortnight
readsPrec = (Integer -> Fortnight) -> String -> Int -> ReadS Fortnight
forall a.
(Integer -> a) -> String -> Int -> String -> [(a, String)]
readUnit Integer -> Fortnight
Fortnight String
"fn"