module BuildBox.Aspect.Units
(
Seconds (..)
, Bytes (..)
, IsUnits (..)
, HasUnits (..)
, WithUnits (..)
, secs
, bytes
, appWithUnits
, liftWithUnits
, liftsWithUnits
, liftsWithUnits2
, Collatable (..)
, collateWithUnits)
where
import BuildBox.Aspect.Single
import BuildBox.Aspect.Stats
import BuildBox.Data.Dividable
import BuildBox.Pretty
import Data.Maybe
data Seconds = Seconds Double
deriving (Read, Show, Ord, Eq)
instance Real Seconds where
toRational (Seconds s1) = toRational s1
instance Dividable Seconds where
divide (Seconds s1) (Seconds s2) = Seconds (s1 / s2)
instance Num Seconds where
(+) (Seconds f1) (Seconds f2) = Seconds (f1 + f2)
() (Seconds f1) (Seconds f2) = Seconds (f1 f2)
(*) (Seconds f1) (Seconds f2) = Seconds (f1 * f2)
abs (Seconds f1) = Seconds (abs f1)
signum (Seconds f1) = Seconds (signum f1)
fromInteger i = Seconds (fromInteger i)
instance Pretty Seconds where
ppr (Seconds f)
= fromMaybe (text (show f))
$ pprEngDouble "s" f
data Bytes = Bytes Integer
deriving (Read, Show, Ord, Eq)
instance Real Bytes where
toRational (Bytes b1) = toRational b1
instance Dividable Bytes where
divide (Bytes s1) (Bytes s2) = Bytes (s1 `div` s2)
instance Num Bytes where
(+) (Bytes f1) (Bytes f2) = Bytes (f1 + f2)
() (Bytes f1) (Bytes f2) = Bytes (f1 f2)
(*) (Bytes f1) (Bytes f2) = Bytes (f1 * f2)
abs (Bytes f1) = Bytes (abs f1)
signum (Bytes f1) = Bytes (signum f1)
fromInteger i = Bytes (fromInteger i)
instance Pretty Bytes where
ppr (Bytes b)
= fromMaybe (text (show b))
$ pprEngInteger "B" b
data IsUnits a where
IsSeconds :: IsUnits Seconds
IsBytes :: IsUnits Bytes
class HasUnits a a => Units a where
isUnits :: a -> Maybe (IsUnits a)
instance Units Seconds where
isUnits s = hasUnits s
instance Units Bytes where
isUnits s = hasUnits s
class HasUnits a b | a -> b where
hasUnits :: a -> Maybe (IsUnits b)
instance HasUnits Seconds Seconds where
hasUnits _ = Just IsSeconds
instance HasUnits Bytes Bytes where
hasUnits _ = Just IsBytes
instance HasUnits a a => HasUnits (Single a) a where
hasUnits (Single x) = hasUnits x
instance HasUnits a a => HasUnits (Stats a) a where
hasUnits (Stats x _ _) = hasUnits x
instance HasUnits a a => HasUnits [a] a where
hasUnits [] = Nothing
hasUnits (x : _) = hasUnits x
data WithUnits t where
WithSeconds :: t Seconds -> WithUnits t
WithBytes :: t Bytes -> WithUnits t
deriving instance (Show (t Bytes), Show (t Seconds)) => Show (WithUnits t)
deriving instance (Read (t Bytes), Read (t Seconds)) => Read (WithUnits t)
instance (Pretty (t Bytes), Pretty (t Seconds))
=> Pretty (WithUnits t) where
ppr withUnits
= case withUnits of
WithSeconds s -> ppr s
WithBytes b -> ppr b
secs :: (Single Seconds -> c Single Seconds)
-> Double -> WithUnits (c Single)
secs mk f = WithSeconds (mk (Single (Seconds f)))
bytes :: (Single Bytes -> c Single Bytes)
-> Integer -> WithUnits (c Single)
bytes mk b = WithBytes (mk (Single (Bytes b)))
appWithUnits
:: (forall units. Real units => t1 units -> b)
-> WithUnits t1 -> b
appWithUnits f withUnits
= case withUnits of
WithSeconds dat -> f dat
WithBytes dat -> f dat
liftWithUnits
:: (forall units. Real units => t1 units -> t2 units)
-> WithUnits t1 -> WithUnits t2
liftWithUnits f withUnits
= case withUnits of
WithSeconds dat -> WithSeconds (f dat)
WithBytes dat -> WithBytes (f dat)
liftsWithUnits
:: (forall units. Real units => [t1 units] -> [t2 units])
-> [WithUnits t1] -> [WithUnits t2]
liftsWithUnits f us
= let asSeconds = [a | WithSeconds a <- us]
asBytes = [a | WithBytes a <- us]
in (map WithSeconds $ f asSeconds)
++ (map WithBytes $ f asBytes)
liftsWithUnits2
:: (forall units. Real units => [t1 units] -> [t2 units] -> [t3 units])
-> [WithUnits t1] -> [WithUnits t2] -> [WithUnits t3]
liftsWithUnits2 f as bs
= let asSeconds = [a | WithSeconds a <- as]
bsSeconds = [b | WithSeconds b <- bs]
asBytes = [a | WithBytes a <- as]
bsBytes = [b | WithBytes b <- bs]
in (map WithSeconds $ f asSeconds bsSeconds)
++ (map WithBytes $ f asBytes bsBytes)
class Collatable t where
collate :: forall a. HasUnits a a
=> [t Single a] -> [t [] a]
collateWithUnits :: Collatable c => [WithUnits (c Single)] -> [WithUnits (c [])]
collateWithUnits as
= let asSeconds = [a | WithSeconds a <- as]
asBytes = [a | WithBytes a <- as]
in (map WithSeconds $ collate asSeconds)
++ (map WithBytes $ collate asBytes)