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

Maintainer  :  claude@mathr.co.uk
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
  , F, X, C, CF, CX
  , F8, F16, F24, F32, F40, F48, F53
  , f8, f16, f24, f32, f40, f48, f53
  , X8, X16, X24, X32, X40, X48, X53
  , x8, x16, x24, x32, x40, x48, x53
  , CF8, CF16, CF24, CF32, CF40, CF48, CF53
  , cf8, cf16, cf24, cf32, cf40, cf48, cf53
  , CX8, CX16, CX24, CX32, CX40, CX48, CX53
  , cx8, cx16, cx24, cx32, cx40, cx48, cx53
  , 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.Fixed (VFixed)
import Numeric.VariablePrecision.Complex (VComplex, recodeComplex, toComplex, fromComplex)
import Numeric.VariablePrecision.Algorithms (recodeFloat)

import Data.Complex.Generic (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 :: CF24 -> Complex Float
toComplexFloat = recodeComplex . toComplex

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

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

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

type F = VFloat
type X = VFixed
type C = VComplex
type CF = C F
type CX = C X

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

type X8  = X N8  ; x8  :: X8  ; x8  = 0
type X16 = X N16 ; x16 :: X16 ; x16 = 0
type X24 = X N24 ; x24 :: X24 ; x24 = 0
type X32 = X N32 ; x32 :: X32 ; x32 = 0
type X40 = X N40 ; x40 :: X40 ; x40 = 0
type X48 = X N48 ; x48 :: X48 ; x48 = 0
type X53 = X N53 ; x53 :: X53 ; x53 = 0

type CF8  = CF N8  ; cf8  :: CF8  ; cf8  = 0
type CF16 = CF N16 ; cf16 :: CF16 ; cf16 = 0
type CF24 = CF N24 ; cf24 :: CF24 ; cf24 = 0
type CF32 = CF N32 ; cf32 :: CF32 ; cf32 = 0
type CF40 = CF N40 ; cf40 :: CF40 ; cf40 = 0
type CF48 = CF N48 ; cf48 :: CF48 ; cf48 = 0
type CF53 = CF N53 ; cf53 :: CF53 ; cf53 = 0

type CX8  = CX N8  ; cx8  :: CX8  ; cx8  = 0
type CX16 = CX N16 ; cx16 :: CX16 ; cx16 = 0
type CX24 = CX N24 ; cx24 :: CX24 ; cx24 = 0
type CX32 = CX N32 ; cx32 :: CX32 ; cx32 = 0
type CX40 = CX N40 ; cx40 :: CX40 ; cx40 = 0
type CX48 = CX N48 ; cx48 :: CX48 ; cx48 = 0
type CX53 = CX N53 ; cx53 :: CX53 ; cx53 = 0