module Sound.SC3.Lang.Collection.Universal.Datum where
import qualified Data.ByteString.Char8 as C
import Data.Int
import Data.Ratio
import Data.String
import Sound.OSC
import Sound.SC3
import System.Random
type UOp n = (n -> n)
liftD :: UOp Int32 -> UOp Int64 -> UOp Float -> UOp Double -> UOp Datum
liftD fi fh ff fd d =
case d of
Int32 n -> Int32 (fi n)
Int64 n -> Int64 (fh n)
Float n -> Float (ff n)
Double n -> Double (fd n)
_ -> error "liftD: NaN"
liftD' :: UOp Double -> UOp Datum
liftD' fd =
liftD (error "liftD'") (error "liftD'") (error "liftD'") fd .
datum_promote
type BinOp n = (n -> n -> n)
liftD2 :: BinOp Int32 -> BinOp Int64 ->
BinOp Float -> BinOp Double ->
BinOp Datum
liftD2 fi fh ff fd d1 d2 =
case (d1,d2) of
(Int32 n1,Int32 n2) -> Int32 (fi n1 n2)
(Int64 n1,Int64 n2) -> Int64 (fh n1 n2)
(Float n1,Float n2) -> Float (ff n1 n2)
(Double n1,Double n2) -> Double (fd n1 n2)
_ -> case (datum_floating d1,datum_floating d2) of
(Just n1,Just n2) -> Double (fd n1 n2)
_ -> error "liftD2: NaN"
liftD2' :: BinOp Double -> BinOp Datum
liftD2' f d1 =
let d1' = datum_promote d1
in liftD2 (error "liftD2'") (error "liftD2'") (error "liftD2'") f d1' .
datum_promote
atD :: (Int32 -> a) -> (Int64 -> a) ->
(Float -> a) -> (Double -> a) ->
Datum -> a
atD fi fh ff fd d =
case d of
Int32 n -> fi n
Int64 n -> fh n
Float n -> ff n
Double n -> fd n
_ -> error "atD: NaN"
atD' :: (Double -> a) -> Datum -> a
atD' f = f . d_double . datum_promote
type BinAt n a = (n -> n -> a)
atD2 :: BinAt Int32 a -> BinAt Int64 a ->
BinAt Float a -> BinAt Double a ->
BinAt Datum a
atD2 fi fh ff fd d1 d2 =
case (d1,d2) of
(Int32 n1,Int32 n2) -> fi n1 n2
(Int64 n1,Int64 n2) -> fh n1 n2
(Float n1,Float n2) -> ff n1 n2
(Double n1,Double n2) -> fd n1 n2
_ -> error "atD2: NaN"
type TriAt n a = (n -> n -> n -> a)
atD3 :: TriAt Int32 a -> TriAt Int64 a ->
TriAt Float a -> TriAt Double a ->
TriAt Datum a
atD3 fi fh ff fd d1 d2 d3 =
case (d1,d2,d3) of
(Int32 n1,Int32 n2,Int32 n3) -> fi n1 n2 n3
(Int64 n1,Int64 n2,Int64 n3) -> fh n1 n2 n3
(Float n1,Float n2,Float n3) -> ff n1 n2 n3
(Double n1,Double n2,Double n3) -> fd n1 n2 n3
_ -> error "atD3: NaN"
instance IsString Datum where
fromString = ASCII_String . C.pack
instance EqE Datum where
(==*) = liftD2 (==*) (==*) (==*) (==*)
(/=*) = liftD2 (/=*) (/=*) (/=*) (/=*)
instance Num Datum where
negate = liftD negate negate negate negate
(+) = liftD2 (+) (+) (+) (+)
() = liftD2 () () () ()
(*) = liftD2 (*) (*) (*) (*)
abs = liftD abs abs abs abs
signum = liftD signum signum signum signum
fromInteger n = Int64 (fromInteger n)
instance Fractional Datum where
recip = liftD' recip
(/) = liftD2' (/)
fromRational n = Double (fromRational n)
instance Floating Datum where
pi = Double pi
exp = liftD' exp
log = liftD' log
sqrt = liftD' sqrt
(**) = liftD2' (**)
logBase = liftD2' logBase
sin = liftD' sin
cos = liftD' cos
tan = liftD' tan
asin = liftD' asin
acos = liftD' acos
atan = liftD' atan
sinh = liftD' sinh
cosh = liftD' cosh
tanh = liftD' tanh
asinh = liftD' asinh
acosh = liftD' acosh
atanh = liftD' atanh
instance Real Datum where
toRational d =
case d of
Int32 n -> fromIntegral n % 1
Int64 n -> fromIntegral n % 1
Float n -> toRational n
Double n -> toRational n
_ -> error "Datum.toRational: NaN"
instance RealFrac Datum where
properFraction d =
let (i,j) = properFraction (d_double d)
in (i,Double j)
truncate = atD' truncate
round = atD' round
ceiling = atD' ceiling
floor = atD' floor
instance RealFracE Datum where
truncateE = liftD undefined undefined truncateE truncateE
roundE = liftD undefined undefined roundE roundE
ceilingE = liftD undefined undefined ceilingE ceilingE
floorE = liftD undefined undefined floorE floorE
instance RealFloat Datum where
floatRadix = atD' floatRadix
floatDigits = atD' floatDigits
floatRange = atD' floatRange
decodeFloat = atD' decodeFloat
encodeFloat i = Double . encodeFloat i
exponent = atD' exponent
significand = liftD' significand
scaleFloat i = liftD' (scaleFloat i)
isNaN = atD' isNaN
isInfinite = atD' isInfinite
isDenormalized = atD' isDenormalized
isNegativeZero = atD' isNegativeZero
isIEEE = atD' isIEEE
atan2 = liftD2' atan2
instance Ord Datum where
compare p q =
case (datum_promote p,datum_promote q) of
(Double i, Double j) -> compare i j
(ASCII_String i,ASCII_String j) -> compare i j
(TimeStamp i,TimeStamp j) -> compare i j
_ -> error "Datum.compare"
instance OrdE Datum where
(>*) = liftD2 (>*) (>*) (>*) (>*)
(>=*) = liftD2 (>=*) (>=*) (>=*) (>=*)
(<*) = liftD2 (<*) (<*) (<*) (<*)
(<=*) = liftD2 (<=*) (<=*) (<=*) (<=*)
instance Enum Datum where
fromEnum = atD fromEnum fromEnum fromEnum fromEnum
enumFrom =
atD
(map Int32 . enumFrom)
(map Int64 . enumFrom)
(map Float . enumFrom)
(map Double . enumFrom)
enumFromThen =
atD2
(\a -> map Int32 . enumFromThen a)
(\a -> map Int64 . enumFromThen a)
(\a -> map Float . enumFromThen a)
(\a -> map Double . enumFromThen a)
enumFromTo =
atD2
(\a -> map Int32 . enumFromTo a)
(\a -> map Int64 . enumFromTo a)
(\a -> map Float . enumFromTo a)
(\a -> map Double . enumFromTo a)
enumFromThenTo =
atD3
(\a b -> map Int32 . enumFromThenTo a b)
(\a b -> map Int64 . enumFromThenTo a b)
(\a b -> map Float . enumFromThenTo a b)
(\a b -> map Double . enumFromThenTo a b)
toEnum = Int64 . fromIntegral
instance Random Datum where
randomR i g =
case i of
(Int32 l,Int32 r) -> let (n,g') = randomR (l,r) g in (Int32 n,g')
(Int64 l,Int64 r) -> let (n,g') = randomR (l,r) g in (Int64 n,g')
(Float l,Float r) -> let (n,g') = randomR (l,r) g in (Float n,g')
(Double l,Double r) -> let (n,g') = randomR (l,r) g in (Double n,g')
_ -> error "Datum.randomR: NaN"
random g = let (n,g') = randomR (0::Double,1::Double) g in (Double n,g')