content: {-# LANGUAGE Trustworthy #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE AutoDeriveTypeable #-}
  
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  Data.Fixed
  -- Copyright   :  (c) Ashley Yakeley 2005, 2006, 2009
  -- License     :  BSD-style (see the file libraries/base/LICENSE)
  --
  -- Maintainer  :  Ashley Yakeley <ashley@semantic.org>
  -- Stability   :  experimental
  -- Portability :  portable
  --
  -- This module defines a \"Fixed\" type for fixed-precision arithmetic.
  -- The parameter to Fixed is any type that's an instance of HasResolution.
  -- HasResolution has a single method that gives the resolution of the Fixed type.
  --
  -- This module also contains generalisations of div, mod, and divmod to work
  -- with any Real instance.
  --
  -----------------------------------------------------------------------------
  
  module Data.Fixed
  (
      div',mod',divMod',
  
      Fixed(..), HasResolution(..),
      showFixed,
      E0,Uni,
      E1,Deci,
      E2,Centi,
      E3,Milli,
      E6,Micro,
      E9,Nano,
      E12,Pico
  ) where
  
  import Data.Data
  import GHC.Read
  import Text.ParserCombinators.ReadPrec
  import Text.Read.Lex
  
  default () -- avoid any defaulting shenanigans
  
  -- | generalisation of 'div' to any instance of Real
  div' :: (Real a,Integral b) => a -> a -> b
  div' n d = floor ((toRational n) / (toRational d))
  
  -- | generalisation of 'divMod' to any instance of Real
  divMod' :: (Real a,Integral b) => a -> a -> (b,a)
  divMod' n d = (f,n - (fromIntegral f) * d) where
      f = div' n d
  
  -- | generalisation of 'mod' to any instance of Real
  mod' :: (Real a) => a -> a -> a
  mod' n d = n - (fromInteger f) * d where
      f = div' n d
  
  -- | The type parameter should be an instance of 'HasResolution'.
  newtype Fixed a = MkFixed Integer -- ^ @since 4.7.0.0
          deriving (Eq,Ord)
  
  -- We do this because the automatically derived Data instance requires (Data a) context.
  -- Our manual instance has the more general (Typeable a) context.
  tyFixed :: DataType
  tyFixed = mkDataType "Data.Fixed.Fixed" [conMkFixed]
  conMkFixed :: Constr
  conMkFixed = mkConstr tyFixed "MkFixed" [] Prefix
  
  -- | @since 4.1.0.0
  instance (Typeable a) => Data (Fixed a) where
      gfoldl k z (MkFixed a) = k (z MkFixed) a
      gunfold k z _ = k (z MkFixed)
      dataTypeOf _ = tyFixed
      toConstr _ = conMkFixed
  
  class HasResolution a where
      resolution :: p a -> Integer
  
  withType :: (p a -> f a) -> f a
  withType foo = foo undefined
  
  withResolution :: (HasResolution a) => (Integer -> f a) -> f a
  withResolution foo = withType (foo . resolution)
  
  -- | @since 2.01
  instance Enum (Fixed a) where
      succ (MkFixed a) = MkFixed (succ a)
      pred (MkFixed a) = MkFixed (pred a)
      toEnum = MkFixed . toEnum
      fromEnum (MkFixed a) = fromEnum a
      enumFrom (MkFixed a) = fmap MkFixed (enumFrom a)
      enumFromThen (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromThen a b)
      enumFromTo (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromTo a b)
      enumFromThenTo (MkFixed a) (MkFixed b) (MkFixed c) = fmap MkFixed (enumFromThenTo a b c)
  
  -- | @since 2.01
  instance (HasResolution a) => Num (Fixed a) where
      (MkFixed a) + (MkFixed b) = MkFixed (a + b)
      (MkFixed a) - (MkFixed b) = MkFixed (a - b)
      fa@(MkFixed a) * (MkFixed b) = MkFixed (div (a * b) (resolution fa))
      negate (MkFixed a) = MkFixed (negate a)
      abs (MkFixed a) = MkFixed (abs a)
      signum (MkFixed a) = fromInteger (signum a)
      fromInteger i = withResolution (\res -> MkFixed (i * res))
  
  -- | @since 2.01
  instance (HasResolution a) => Real (Fixed a) where
      toRational fa@(MkFixed a) = (toRational a) / (toRational (resolution fa))
  
  -- | @since 2.01
  instance (HasResolution a) => Fractional (Fixed a) where
      fa@(MkFixed a) / (MkFixed b) = MkFixed (div (a * (resolution fa)) b)
      recip fa@(MkFixed a) = MkFixed (div (res * res) a) where
          res = resolution fa
      fromRational r = withResolution (\res -> MkFixed (floor (r * (toRational res))))
  
  -- | @since 2.01
  instance (HasResolution a) => RealFrac (Fixed a) where
      properFraction a = (i,a - (fromIntegral i)) where
          i = truncate a
      truncate f = truncate (toRational f)
      round f = round (toRational f)
      ceiling f = ceiling (toRational f)
      floor f = floor (toRational f)
  
  chopZeros :: Integer -> String
  chopZeros 0 = ""
  chopZeros a | mod a 10 == 0 = chopZeros (div a 10)
  chopZeros a = show a
  
  -- only works for positive a
  showIntegerZeros :: Bool -> Int -> Integer -> String
  showIntegerZeros True _ 0 = ""
  showIntegerZeros chopTrailingZeros digits a = replicate (digits - length s) '0' ++ s' where
      s = show a
      s' = if chopTrailingZeros then chopZeros a else s
  
  withDot :: String -> String
  withDot "" = ""
  withDot s = '.':s
  
  -- | First arg is whether to chop off trailing zeros
  showFixed :: (HasResolution a) => Bool -> Fixed a -> String
  showFixed chopTrailingZeros fa@(MkFixed a) | a < 0 = "-" ++ (showFixed chopTrailingZeros (asTypeOf (MkFixed (negate a)) fa))
  showFixed chopTrailingZeros fa@(MkFixed a) = (show i) ++ (withDot (showIntegerZeros chopTrailingZeros digits fracNum)) where
      res = resolution fa
      (i,d) = divMod a res
      -- enough digits to be unambiguous
      digits = ceiling (logBase 10 (fromInteger res) :: Double)
      maxnum = 10 ^ digits
      -- read floors, so show must ceil for `read . show = id` to hold. See #9240
      fracNum = divCeil (d * maxnum) res
      divCeil x y = (x + y - 1) `div` y
  
  -- | @since 2.01
  instance (HasResolution a) => Show (Fixed a) where
      show = showFixed False
  
  -- | @since 4.3.0.0
  instance (HasResolution a) => Read (Fixed a) where
      readPrec     = readNumber convertFixed
      readListPrec = readListPrecDefault
      readList     = readListDefault
  
  convertFixed :: forall a . HasResolution a => Lexeme -> ReadPrec (Fixed a)
  convertFixed (Number n)
   | Just (i, f) <- numberToFixed e n =
      return (fromInteger i + (fromInteger f / (10 ^ e)))
      where r = resolution (undefined :: Fixed a)
            -- round 'e' up to help make the 'read . show == id' property
            -- possible also for cases where 'resolution' is not a
            -- power-of-10, such as e.g. when 'resolution = 128'
            e = ceiling (logBase 10 (fromInteger r) :: Double)
  convertFixed _ = pfail
  
  data E0
  
  -- | @since 4.1.0.0
  instance HasResolution E0 where
      resolution _ = 1
  -- | resolution of 1, this works the same as Integer
  type Uni = Fixed E0
  
  data E1
  
  -- | @since 4.1.0.0
  instance HasResolution E1 where
      resolution _ = 10
  -- | resolution of 10^-1 = .1
  type Deci = Fixed E1
  
  data E2
  
  -- | @since 4.1.0.0
  instance HasResolution E2 where
      resolution _ = 100
  -- | resolution of 10^-2 = .01, useful for many monetary currencies
  type Centi = Fixed E2
  
  data E3
  
  -- | @since 4.1.0.0
  instance HasResolution E3 where
      resolution _ = 1000
  -- | resolution of 10^-3 = .001
  type Milli = Fixed E3
  
  data E6
  
  -- | @since 2.01
  instance HasResolution E6 where
      resolution _ = 1000000
  -- | resolution of 10^-6 = .000001
  type Micro = Fixed E6
  
  data E9
  
  -- | @since 4.1.0.0
  instance HasResolution E9 where
      resolution _ = 1000000000
  -- | resolution of 10^-9 = .000000001
  type Nano = Fixed E9
  
  data E12
  
  -- | @since 2.01
  instance HasResolution E12 where
      resolution _ = 1000000000000
  -- | resolution of 10^-12 = .000000000001
  type Pico = Fixed E12
  