summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Refined/AEq.hs12
-rw-r--r--src/Trivmix/Types.hs16
2 files changed, 25 insertions, 3 deletions
diff --git a/src/Refined/AEq.hs b/src/Refined/AEq.hs
new file mode 100644
index 0000000..0a60679
--- /dev/null
+++ b/src/Refined/AEq.hs
@@ -0,0 +1,12 @@
1{-# OPTIONS_GHC -fno-warn-orphans #-}
2
3module Refined.AEq where
4
5import Data.AEq
6import Refined
7
8import Data.Function (on)
9
10instance AEq a => AEq (Refined p a) where
11 (===) = (===) `on` unrefine
12 (~==) = (~==) `on` unrefine
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
26import Data.Function (on) 26import Data.Function (on)
27 27
28import Refined 28import Refined
29import Data.AEq
29 30
30import Data.Scientific 31import Data.Scientific
31import Data.Scientific.Lift 32import Data.Scientific.Lift
32 33
34import Refined.AEq
35
33 36
34type Level' = Refined NonNegative Scientific 37type Level' = Refined NonNegative Scientific
38
35data Level = Lin { toLin :: Level' } | DB { toLin :: Level' } 39data Level = Lin { toLin :: Level' } | DB { toLin :: Level' }
36 40
37instance Num Level where 41instance Num Level where
@@ -43,7 +47,7 @@ instance Num Level where
43 fromInteger = Lin . either error id . refine . fromInteger 47 fromInteger = Lin . either error id . refine . fromInteger
44 48
45asScientific :: (Scientific -> Scientific -> Scientific) -> Level -> Level -> Either String Level 49asScientific :: (Scientific -> Scientific -> Scientific) -> Level -> Level -> Either String Level
46asScientific ((`on` toScientific) -> f) x y = toLvl <$> refine (f x y) 50asScientific ((`on` toScientific) -> f) x y = toLvl <$> refineSticky (f x y)
47 where 51 where
48 toLvl 52 toLvl
49 | DB _ <- x = DB 53 | DB _ <- x = DB
@@ -66,7 +70,13 @@ linToDb :: Level' -> Scientific
66linToDb (unrefine -> x) = realToFrac (20 * (logBase 10 $ toRealFloat x) :: Double) 70linToDb (unrefine -> x) = realToFrac (20 * (logBase 10 $ toRealFloat x) :: Double)
67 71
68dBToLin :: Scientific -> Level' 72dBToLin :: Scientific -> Level'
69dBToLin x = either error id . refine . realToFrac $ (10 ** (0.05 * toRealFloat x) :: Double) 73dBToLin x = either error id . refineSticky . realToFrac $ (10 ** (0.05 * toRealFloat x) :: Double)
74
75refineSticky :: Scientific -> Either String Level'
76refineSticky sc@(toRealFloat -> f)
77 | f ~== (1 :: Float) = Right ($$(refineTH 1) :: Level')
78 | f ~== (0 :: Float) = Right ($$(refineTH 0) :: Level')
79 | otherwise = refine sc
70 80
71instance Show Level where 81instance Show Level where
72 show (Lin (unrefine -> x)) = show x 82 show (Lin (unrefine -> x)) = show x
@@ -84,7 +94,7 @@ instance Read Level where
84 return . DB $ dBToLin db 94 return . DB $ dBToLin db
85 parseLin = do 95 parseLin = do
86 lin <- readS_to_Prec readsPrec 96 lin <- readS_to_Prec readsPrec
87 either (const mzero) (return . Lin) $ refine lin 97 either (const mzero) (return . Lin) $ refineSticky lin
88 98
89instance Eq Level where 99instance Eq Level where
90 (==) = (==) `on` toLin 100 (==) = (==) `on` toLin