-- |
-- Module      : Numeric.Literals.Decimal
-- Copyright   : (c) Justus Sagemüller 2017
-- License     : GPL v3
-- 
-- Maintainer  : (@) jsagemue $ uni-koeln.de
-- Stability   : experimental
-- Portability : portable
-- 
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}

module Numeric.Literals.Decimal
          ( FractionalLit
          , pattern (:%)
          , pattern Scientific
          -- * Auxiliary
          , B₁₀Digit
          ) where

import Data.Ratio


-- | A type whose 'Fractional' instance gives a somewhat reliable indication whether
--   a value was actually defined as an integer or a ratio, or as a decimal-fraction
--   literal. This is useful to know for a type that supports both exact fraction
--   values and more floating-point-like / physical values; it allows avoiding
--   issues like @0.524@ showing up as @589971551185535/1125899906842624@, or conversely
--   @7/23@ as @0.30434782608695654@. Both of these scenarios are quite awkward.
data FractionalLit = ExactRatio Rational
                   | DecimalFraction {
                       decimalMantissa :: Integer
                     , decimalExponent :: Int }

asFraction :: FractionalLit -> Maybe (Integer, Integer)
asFraction (ExactRatio r) = Just (numerator r, denominator r)
asFraction (DecimalFraction _ _) = Nothing

-- | Construct an exact fraction. The values behave like 'Rational', until combined
--   – e.g. added – with a 'Scientific' value (which has an implicit
--   measurement-uncertainty, and that carries over to the result).
pattern (:%) :: Integer -> Integer -> FractionalLit
pattern n:%d <- (asFraction -> Just (n,d))
 where n:%d = ExactRatio $ fromInteger n % fromInteger d

asScientific :: FractionalLit -> Maybe ((Int, [B₁₀Digit]), Int)
asScientific (ExactRatio _) = Nothing
asScientific n = case break (=='e') $ show n of
      (m, 'e':e) -> Just (splitMantissa m, read e)
      (m, [])    -> Just (splitMantissa m, 0)
 where splitMantissa m = case break (=='.') m of
         (pm,'.':am) -> (read pm, parseB₁₀<$>am)
         (pm,[])     -> (read pm, [])
       parseB₁₀ c = case fromEnum c - fromEnum '0' of
         i | i>=0 && i<10  -> toEnum i
           | otherwise     -> error $
               "Impossible digit "++[c]++" in number "++show n

-- | Construct a scientific number of the form @m.n * 10^e@, where @m@ and @e@ are
--   integers and @n@ is a list of digits after the decimal point. The result
--   is considered to be only exact up to the precision indicated by the number
--   of digits. I.e. @Scientific 2 [4,8,3]\ (-4)@ basically means @2.483×10⁻⁴ ± 10⁻⁷@,
--   
--   The 'Fractional' instance allows these values to be written in the standard
--   @2.483e-4@ notation. Note that this cannot completely reconstruct the written
--   form, e.g. @12.483e-4@ will actually show up as @Scientific 1 [2,4,8,3]\ (-3)@.
--   Leading and trailing zeroes are always ignored.
pattern Scientific :: Int        -- ^ Integral part of the mantissa
                   -> [B₁₀Digit] -- ^ Digits after the point of the mantissa
                   -> Int        -- ^ Base-10 exponent of the number in scientific form
                   -> FractionalLit
pattern Scientific pc ac ex <- (asScientific -> Just ((pc,ac),ex))
 where Scientific pc ac ex = DecimalFraction (nqr (fromIntegral pc) ac) $ ex - length ac
        where nqr n [] = n
              nqr n (d:ds) = nqr (n*10 + fromIntegral (fromEnum d)) ds
              

-- | A number between @0@ and @9@.
data B₁₀Digit = D0 | D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 deriving (Enum, Eq, Ord)
instance Show B₁₀Digit where show = show . fromEnum
instance Num B₁₀Digit where
  fromInteger = toEnum . (`mod`10) . fromInteger
  d + e = toEnum $ (fromEnum d + fromEnum e)`mod`10
  d * e = toEnum $ (fromEnum d * fromEnum e)`mod`10
  d - e = toEnum $ (fromEnum d - fromEnum e)`mod`10
  abs = id
  signum D0 = 0
  signum _ = 1

instance Eq FractionalLit where
  ExactRatio r₀ == ExactRatio r₁  =  r₀==r₁
  DecimalFraction m₀ e₀ == DecimalFraction m₁ e₁  =  m₀==m₁ && e₀==e₁
  ExactRatio r == DecimalFraction m e
   | e>0        = ExactRatio r == DecimalFraction (m*10^e) 0
   | (ers,0) <- (10^(-e)) `divMod` denominator r
                =  m == numerator r*ers
   | otherwise  =  False
  n == m  =  m == n

instance Show FractionalLit where
  showsPrec p (ExactRatio r)
   | denominator r > 1  = showParen (p>6)
                 $ showsPrec 7 (numerator r) . ('/':) . showsPrec 7 (denominator r)
   | otherwise          = shows $ numerator r
  showsPrec p (DecimalFraction m e)
   | m < 0             = showParen (p>5) $ ('-':) . shows (DecimalFraction (-m) e)
   | e > 4 || e < -2   = case show m of
               lsh | e<0, length lsh + 1 > -e
                           -> case splitAt (-e) $ reverse lsh of
                             (acs, []) -> ("0."++) . (replicate (-e-length acs) '0'++)
                                           . (reverse acs++)
                             (acs, pcs) -> (reverse pcs++) . ('.':) . (reverse acs++)
               (hd:[]) -> (hd:) . ("e"++) . shows e
               (hd:lds) -> (hd:) . ('.':) . (lds++) . ("e"++) . shows (e + length lds)
   | e < 0             = case splitAt (-e) . reverse $ show m of
               (acs, [])  -> ("0."++) . (replicate (-e-length acs) '0'++) . (reverse acs++)
               (acs, pcs) -> (reverse pcs++) . ('.':) . (reverse acs++)
   | otherwise         = shows m . (replicate e '0'++)

infixl 7 `unbiasedDiv`
unbiasedDiv :: Integral a => a -> a -> a
unbiasedDiv x y = (x + y`quot`2)`div`y

instance Num FractionalLit where
  fromInteger = ExactRatio . fromInteger
  ExactRatio r₀ + ExactRatio r₁ = ExactRatio $ r₀ + r₁
  DecimalFraction m e + ExactRatio r
      = DecimalFraction (m + round (r * 10^^(-e))) e
  DecimalFraction m₀ e₀ + DecimalFraction m₁ e₁
   | e₀ <= e₁  = DecimalFraction (m₀`unbiasedDiv`10^(e₁ - e₀) + m₁) e₁
  n + m = m + n
  ExactRatio r₀ * ExactRatio r₁ = ExactRatio $ r₀ * r₁
  DecimalFraction m e * ExactRatio r
     = DecimalFraction ((m * numerator r)`unbiasedDiv`denominator r) e
  DecimalFraction m₀ e₀ * DecimalFraction m₁ e₁
        = DecimalFraction (m₀*m₁) (e₀+e₁)
  n * m = m * n
  negate (ExactRatio r) = ExactRatio $ -r
  negate (DecimalFraction m e) = DecimalFraction (-m) e
  abs (ExactRatio r) = ExactRatio $ abs r
  abs (DecimalFraction m e) = DecimalFraction (abs m) e
  signum (ExactRatio r) = ExactRatio $ signum r
  signum (DecimalFraction m e) = ExactRatio . fromIntegral $ signum m

-- | Despite the name, 'fromRational' should /not/ be used to promote a 'Rational'
--   value to 'FractionalLit', because that method contains the heuristic which interprets
--   decimal\/scientific literals (which in Haskell are, perhaps unfortunately, always
--   desugared through 'fromRational'). Use '/' or ':%' instead, to define exact-ratio
--   values.
instance Fractional FractionalLit where
  fromRational r
    | r < 0               = negate $ fromRational (-r)
    | denominator r == 1  = goI 0 0 $ numerator r
    | otherwise           = goF 0 0 $ denominator r
   where goI n2 n5 u
          | (u', 0) <- u`divMod`2  = goI (n2+1) n5 u'
          | (u', 0) <- u`divMod`5  = goI n2 (n5+1) u'
          | n2 > 3 && n5 > n2      = DecimalFraction (u*5^(n5-n2)) n2
          | n5 > 3 && n2 >= n5     = DecimalFraction (u*2^(n2-n5)) n5
          | otherwise              = ExactRatio r
         goF 0 0 1     = ExactRatio r
         goF n2 n5 1
          | n2>n5      = DecimalFraction (numerator r*5^(n2-n5)) (-n2)
          | otherwise  = DecimalFraction (numerator r*2^(n5-n2)) (-n5)
         goF n2 n5 d
          | (d', 0) <- d`divMod`2  = goF (n2+1) n5 d'
          | (d', 0) <- d`divMod`5  = goF n2 (n5+1) d'
          | otherwise              = ExactRatio r
  ExactRatio r₀ / ExactRatio r₁ = ExactRatio $ r₀ / r₁
  DecimalFraction m e / ExactRatio r
     = DecimalFraction ((m * denominator r)`unbiasedDiv`numerator r) e
  ExactRatio r / DecimalFraction m e
     = DecimalFraction (round $ r * 10^dp / fromIntegral m) (-dp-e)
   where dp = ceiling . logBase 10 $ fromIntegral m
  DecimalFraction m₀ e₀ / DecimalFraction m₁ e₁
        = DecimalFraction ((m₀*10^dp)`unbiasedDiv`m₁) (e₀-e₁-dp)
   where dp = ceiling . logBase 10 $ fromIntegral m₁