{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Lang.Crucible.Utils.Seconds
  ( Seconds
  , secondsToInt
  , secondsFromInt
  , secondsToMicroseconds
  ) where

newtype Seconds = Seconds { Seconds -> Int
secondsToInt :: Int }
  deriving (Seconds -> Seconds -> Bool
(Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool) -> Eq Seconds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Seconds -> Seconds -> Bool
== :: Seconds -> Seconds -> Bool
$c/= :: Seconds -> Seconds -> Bool
/= :: Seconds -> Seconds -> Bool
Eq, Integer -> Seconds
Seconds -> Seconds
Seconds -> Seconds -> Seconds
(Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Integer -> Seconds)
-> Num Seconds
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Seconds -> Seconds -> Seconds
+ :: Seconds -> Seconds -> Seconds
$c- :: Seconds -> Seconds -> Seconds
- :: Seconds -> Seconds -> Seconds
$c* :: Seconds -> Seconds -> Seconds
* :: Seconds -> Seconds -> Seconds
$cnegate :: Seconds -> Seconds
negate :: Seconds -> Seconds
$cabs :: Seconds -> Seconds
abs :: Seconds -> Seconds
$csignum :: Seconds -> Seconds
signum :: Seconds -> Seconds
$cfromInteger :: Integer -> Seconds
fromInteger :: Integer -> Seconds
Num, Eq Seconds
Eq Seconds =>
(Seconds -> Seconds -> Ordering)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> Ord Seconds
Seconds -> Seconds -> Bool
Seconds -> Seconds -> Ordering
Seconds -> Seconds -> Seconds
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
$ccompare :: Seconds -> Seconds -> Ordering
compare :: Seconds -> Seconds -> Ordering
$c< :: Seconds -> Seconds -> Bool
< :: Seconds -> Seconds -> Bool
$c<= :: Seconds -> Seconds -> Bool
<= :: Seconds -> Seconds -> Bool
$c> :: Seconds -> Seconds -> Bool
> :: Seconds -> Seconds -> Bool
$c>= :: Seconds -> Seconds -> Bool
>= :: Seconds -> Seconds -> Bool
$cmax :: Seconds -> Seconds -> Seconds
max :: Seconds -> Seconds -> Seconds
$cmin :: Seconds -> Seconds -> Seconds
min :: Seconds -> Seconds -> Seconds
Ord, Int -> Seconds -> ShowS
[Seconds] -> ShowS
Seconds -> String
(Int -> Seconds -> ShowS)
-> (Seconds -> String) -> ([Seconds] -> ShowS) -> Show Seconds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Seconds -> ShowS
showsPrec :: Int -> Seconds -> ShowS
$cshow :: Seconds -> String
show :: Seconds -> String
$cshowList :: [Seconds] -> ShowS
showList :: [Seconds] -> ShowS
Show)

-- | Inverse of 'secondsToInt'
secondsFromInt :: Int -> Seconds
secondsFromInt :: Int -> Seconds
secondsFromInt = Int -> Seconds
Seconds

secondsToMicroseconds :: Seconds -> Int
secondsToMicroseconds :: Seconds -> Int
secondsToMicroseconds = (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000) (Int -> Int) -> (Seconds -> Int) -> Seconds -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seconds -> Int
secondsToInt