module Crypto.Lol.CRTrans
( CRTrans(..), CRTEmbed(..)
, CRTInfo
) where
import Crypto.Lol.Prelude
import Crypto.Lol.Reflects
import Control.Arrow
type CRTInfo r = (Int -> r, r)
class (Monad mon, Ring r) => CRTrans mon r where
crtInfo :: Reflects m Int => TaggedT m mon (CRTInfo r)
class (Ring r, Ring (CRTExt r)) => CRTEmbed r where
type CRTExt r
toExt :: r -> CRTExt r
fromExt :: CRTExt r -> r
instance (CRTrans mon a, CRTrans mon b) => CRTrans mon (a,b) where
crtInfo = do
(fa, inva) <- crtInfo
(fb, invb) <- crtInfo
return (fa &&& fb, (inva, invb))
instance (CRTEmbed a, CRTEmbed b) => CRTEmbed (a,b) where
type CRTExt (a,b) = (CRTExt a, CRTExt b)
toExt = toExt *** toExt
fromExt = fromExt *** fromExt
instance (Monad mon, Transcendental a) => CRTrans mon (Complex a) where
crtInfo = crtInfoC
crtInfoC :: forall mon m a . (Monad mon, Reflects m Int, Transcendental a)
=> TaggedT m mon (CRTInfo (Complex a))
crtInfoC = let mval = proxy value (Proxy::Proxy m)
mhat = valueHat mval
in return (omegaPowC mval, recip $ fromIntegral mhat)
omegaPowC :: (Transcendental a) => Int -> Int -> Complex a
omegaPowC m i = cis (2*pi*fromIntegral i / fromIntegral m)
instance (Transcendental a) => CRTEmbed (Complex a) where
type CRTExt (Complex a) = Complex a
toExt = id
fromExt = id
instance CRTrans Maybe Double where crtInfo = tagT Nothing
instance CRTrans Maybe Int where crtInfo = tagT Nothing
instance CRTrans Maybe Int64 where crtInfo = tagT Nothing
instance CRTrans Maybe Integer where crtInfo = tagT Nothing
instance CRTEmbed Double where
type CRTExt Double = Complex Double
toExt = fromReal . realToField
fromExt = realToField . real
instance CRTEmbed Int where
type CRTExt Int = Complex Double
toExt = fromIntegral
fromExt = fst . roundComplex
instance CRTEmbed Int64 where
type CRTExt Int64 = Complex Double
toExt = fromIntegral
fromExt = fst . roundComplex
instance CRTEmbed Integer where
type CRTExt Integer = Complex Double
toExt = fromIntegral
fromExt = fst . roundComplex