{-|
Module      :  Numeric.VariablePrecision.Aliases
Copyright   :  (c) Claude Heiland-Allen 2012
License     :  BSD3

Maintainer  :  claudiusmaximus@goto10.org
Stability   :  unstable
Portability :  portable

Aliases for 'recodeFloat' and 'recodeComplex' with specialized types.

Aliases for commonly desired types.

-}
module Numeric.VariablePrecision.Aliases
  ( toFloat, fromFloat, toDouble, fromDouble
  , toComplexFloat, fromComplexFloat, toComplexDouble, fromComplexDouble
  , F8, F16, F24, F32, F40, F48, F53
  , f8, f16, f24, f32, f40, f48, f53
  , C8, C16, C24, C32, C40, C48, C53
  , c8, c16, c24, c32, c40, c48, c53
  , module TypeLevel.NaturalNumber
  , module TypeLevel.NaturalNumber.ExtraNumbers
  ) where

import TypeLevel.NaturalNumber (N8, n8)
import TypeLevel.NaturalNumber.ExtraNumbers
  (N16, n16, N24, n24, N32, n32, N40, n40, N48, n48, N53, n53)

import Numeric.VariablePrecision.Float (VFloat)
import Numeric.VariablePrecision.Complex (VComplex, recodeComplex, toComplex, fromComplex)
import Numeric.VariablePrecision.Algorithms (recodeFloat)

import Data.Complex (Complex)

-- | Convert to a Float from the same precision.
toFloat :: F24 -> Float
toFloat = recodeFloat

-- | Convert from a Float to the same precision.
fromFloat :: Float -> F24
fromFloat = recodeFloat

-- | Convert to a Double from the same precision.
toDouble :: F53 -> Double
toDouble = recodeFloat

-- | Convert from a Double to the same precision.
fromDouble :: Double -> F53
fromDouble = recodeFloat

-- | Convert to a Float from the same precision.
toComplexFloat :: C24 -> Complex Float
toComplexFloat = recodeComplex . toComplex

-- | Convert from a Float to the same precision.
fromComplexFloat :: Complex Float -> C24
fromComplexFloat = fromComplex . recodeComplex

-- | Convert to a Double from the same precision.
toComplexDouble :: C53 -> Complex Double
toComplexDouble = recodeComplex . toComplex

-- | Convert from a Double to the same precision.
fromComplexDouble :: Complex Double -> C53
fromComplexDouble = fromComplex . recodeComplex

type F8  = VFloat N8  ; f8  :: F8  ; f8  = 0
type F16 = VFloat N16 ; f16 :: F16 ; f16 = 0
type F24 = VFloat N24 ; f24 :: F24 ; f24 = 0
type F32 = VFloat N32 ; f32 :: F32 ; f32 = 0
type F40 = VFloat N40 ; f40 :: F40 ; f40 = 0
type F48 = VFloat N48 ; f48 :: F48 ; f48 = 0
type F53 = VFloat N53 ; f53 :: F53 ; f53 = 0

type C8  = VComplex N8  ; c8  :: C8  ; c8  = 0
type C16 = VComplex N16 ; c16 :: C16 ; c16 = 0
type C24 = VComplex N24 ; c24 :: C24 ; c24 = 0
type C32 = VComplex N32 ; c32 :: C32 ; c32 = 0
type C40 = VComplex N40 ; c40 :: C40 ; c40 = 0
type C48 = VComplex N48 ; c48 :: C48 ; c48 = 0
type C53 = VComplex N53 ; c53 :: C53 ; c53 = 0