From 19b440fbabf5bc95e97a7a53119ec6218c3639d7 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 15 May 2018 23:08:51 +0200 Subject: Be somewhat sticky --- src/Trivmix/Types.hs | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) (limited to 'src/Trivmix') diff --git a/src/Trivmix/Types.hs b/src/Trivmix/Types.hs index 5e4660d..347be8e 100644 --- a/src/Trivmix/Types.hs +++ b/src/Trivmix/Types.hs @@ -26,12 +26,16 @@ import Data.Default import Data.Function (on) import Refined +import Data.AEq import Data.Scientific import Data.Scientific.Lift +import Refined.AEq + type Level' = Refined NonNegative Scientific + data Level = Lin { toLin :: Level' } | DB { toLin :: Level' } instance Num Level where @@ -43,7 +47,7 @@ instance Num Level where fromInteger = Lin . either error id . refine . fromInteger asScientific :: (Scientific -> Scientific -> Scientific) -> Level -> Level -> Either String Level -asScientific ((`on` toScientific) -> f) x y = toLvl <$> refine (f x y) +asScientific ((`on` toScientific) -> f) x y = toLvl <$> refineSticky (f x y) where toLvl | DB _ <- x = DB @@ -66,7 +70,13 @@ linToDb :: Level' -> Scientific linToDb (unrefine -> x) = realToFrac (20 * (logBase 10 $ toRealFloat x) :: Double) dBToLin :: Scientific -> Level' -dBToLin x = either error id . refine . realToFrac $ (10 ** (0.05 * toRealFloat x) :: Double) +dBToLin x = either error id . refineSticky . realToFrac $ (10 ** (0.05 * toRealFloat x) :: Double) + +refineSticky :: Scientific -> Either String Level' +refineSticky sc@(toRealFloat -> f) + | f ~== (1 :: Float) = Right ($$(refineTH 1) :: Level') + | f ~== (0 :: Float) = Right ($$(refineTH 0) :: Level') + | otherwise = refine sc instance Show Level where show (Lin (unrefine -> x)) = show x @@ -84,7 +94,7 @@ instance Read Level where return . DB $ dBToLin db parseLin = do lin <- readS_to_Prec readsPrec - either (const mzero) (return . Lin) $ refine lin + either (const mzero) (return . Lin) $ refineSticky lin instance Eq Level where (==) = (==) `on` toLin -- cgit v1.2.3