{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

#include "thyme.h"

-- | FOR INTERNAL USE ONLY.
module Data.Thyme.Internal.Micro where

import Prelude
import Control.DeepSeq
import Data.AdditiveGroup
import Data.Basis
import Data.Data
import Data.Hashable
import Data.Int
import Data.Ix
import Data.Ratio
#if __GLASGOW_HASKELL__ == 704
import qualified Data.Vector.Generic
import qualified Data.Vector.Generic.Mutable
#endif
import Data.Vector.Unboxed.Deriving
import Data.VectorSpace
import GHC.Generics (Generic)
import System.Random
import Test.QuickCheck

#if !SHOW_INTERNAL
import Control.Monad
import Data.Char
import Data.Thyme.Format.Internal
import Numeric
import Text.ParserCombinators.ReadPrec
import Text.ParserCombinators.ReadP
import Text.Read
#endif

newtype Micro = Micro Int64 deriving (INSTANCES_MICRO)

derivingUnbox "Micro" [t| Micro -> Int64 |]
    [| \ (Micro a) -> a |] [| Micro |]

#if SHOW_INTERNAL
deriving instance Show Micro
deriving instance Read Micro
#else
instance Show Micro where
    {-# INLINEABLE showsPrec #-}
    showsPrec :: Int -> Micro -> ShowS
showsPrec Int
_ (Micro Int64
a) = ShowS
sign forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int64
si forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
frac where
        sign :: ShowS
sign = if Int64
a forall a. Ord a => a -> a -> Bool
< Int64
0 then (:) Char
'-' else forall a. a -> a
id
        (Int64
si, Int64
su) = forall a. Num a => a -> a
abs Int64
a forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
1000000
        frac :: ShowS
frac = if Int64
su forall a. Eq a => a -> a -> Bool
== Int64
0 then forall a. a -> a
id else (:) Char
'.' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ShowS
fills06 Int64
su forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ShowS
drops0 Int64
su

instance Read Micro where
    {-# INLINEABLE readPrec #-}
    readPrec :: ReadPrec Micro
readPrec = forall a. ReadP a -> ReadPrec a
lift forall a b. (a -> b) -> a -> b
$ do
        Int64 -> Int64
sign <- (Char -> ReadP Char
char Char
'-' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Num a => a -> a
negate) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id
        Int64
s <- forall a. ReadS a -> ReadP a
readS_to_P forall a. (Eq a, Num a) => ReadS a
readDec
        Int64
us <- (forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *) a. Monad m => a -> m a
return Int64
0) forall a b. (a -> b) -> a -> b
$ do
            Char
_ <- Char -> ReadP Char
char Char
'.'
            [(Int64
us10, String
"")] <- (forall a. (Eq a, Num a) => ReadS a
readDec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
7 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ String
"000000"))
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isDigit
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Integral a => a -> a -> a
div (Int64
us10 forall a. Num a => a -> a -> a
+ Int64
5) Int64
10)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Micro
Micro forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
sign forall a b. (a -> b) -> a -> b
$ Int64
s forall a. Num a => a -> a -> a
* Int64
1000000 forall a. Num a => a -> a -> a
+ Int64
us
#endif

{-# INLINE microQuotRem #-}
{-# INLINE microDivMod #-}
microQuotRem, microDivMod :: Micro -> Micro -> (Int64, Micro)
microQuotRem :: Micro -> Micro -> (Int64, Micro)
microQuotRem (Micro Int64
a) (Micro Int64
b) = (Int64
n, Int64 -> Micro
Micro Int64
f) where (Int64
n, Int64
f) = forall a. Integral a => a -> a -> (a, a)
quotRem Int64
a Int64
b
microDivMod :: Micro -> Micro -> (Int64, Micro)
microDivMod  (Micro Int64
a) (Micro Int64
b) = (Int64
n, Int64 -> Micro
Micro Int64
f) where (Int64
n, Int64
f) = forall a. Integral a => a -> a -> (a, a)
divMod Int64
a Int64
b

instance AdditiveGroup Micro where
    {-# INLINE zeroV #-}
    zeroV :: Micro
zeroV = Int64 -> Micro
Micro Int64
0
    {-# INLINE (^+^) #-}
    ^+^ :: Micro -> Micro -> Micro
(^+^) = \ (Micro Int64
a) (Micro Int64
b) -> Int64 -> Micro
Micro (Int64
a forall a. Num a => a -> a -> a
+ Int64
b)
    {-# INLINE negateV #-}
    negateV :: Micro -> Micro
negateV = \ (Micro Int64
a) -> Int64 -> Micro
Micro (forall a. Num a => a -> a
negate Int64
a)

instance VectorSpace Micro where
    type Scalar Micro = Rational
    {-# INLINE (*^) #-}
    Scalar Micro
s *^ :: Scalar Micro -> Micro -> Micro
*^ Micro Int64
a = Int64 -> Micro
Micro forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ -- 'round'-to-even
        case forall a. Ord a => a -> a -> Ordering
compare (Integer
2 forall a. Num a => a -> a -> a
* forall a. Num a => a -> a
abs Integer
r) (forall a. Ratio a -> a
denominator Scalar Micro
s) of
            Ordering
LT -> Integer
n
            Ordering
EQ -> if forall a. Integral a => a -> Bool
even Integer
n then Integer
n else Integer
m
            Ordering
GT -> Integer
m
      where
        (Integer
n, Integer
r) = forall a. Integral a => a -> a -> (a, a)
quotRem (forall a. Integral a => a -> Integer
toInteger Int64
a forall a. Num a => a -> a -> a
* forall a. Ratio a -> a
numerator Scalar Micro
s) (forall a. Ratio a -> a
denominator Scalar Micro
s)
        m :: Integer
m = if Integer
r forall a. Ord a => a -> a -> Bool
< Integer
0 then Integer
n forall a. Num a => a -> a -> a
- Integer
1 else Integer
n forall a. Num a => a -> a -> a
+ Integer
1

instance HasBasis Micro where
    type Basis Micro = ()
    {-# INLINE basisValue #-}
    basisValue :: Basis Micro -> Micro
basisValue = \ Basis Micro
_ -> Int64 -> Micro
Micro Int64
1000000
    {-# INLINE decompose #-}
    decompose :: Micro -> [(Basis Micro, Scalar Micro)]
decompose = \ (Micro Int64
a) -> [((), forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a forall a. Integral a => a -> a -> Ratio a
% Integer
1000000)]
    {-# INLINE decompose' #-}
    decompose' :: Micro -> Basis Micro -> Scalar Micro
decompose' = \ (Micro Int64
a) Basis Micro
_ -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
a forall a. Integral a => a -> a -> Ratio a
% Integer
1000000