module PostgreSQL.Binary.Numeric where

import qualified Data.Scientific as Scientific
import qualified Data.Vector as Vector
import PostgreSQL.Binary.Prelude

{-# INLINE posSignCode #-}
posSignCode :: Word16
posSignCode :: Word16
posSignCode = Word16
0x0000

{-# INLINE negSignCode #-}
negSignCode :: Word16
negSignCode :: Word16
negSignCode = Word16
0x4000

{-# INLINE nanSignCode #-}
nanSignCode :: Word16
nanSignCode :: Word16
nanSignCode = Word16
0xC000

{-# INLINE extractComponents #-}
extractComponents :: Integral a => a -> [Word16]
extractComponents :: forall a. Integral a => a -> [Word16]
extractComponents =
  (forall a. [a] -> [a]
reverse forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Num a => a -> a
abs) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr forall a b. (a -> b) -> a -> b
$ \case
    a
0 -> forall a. Maybe a
Nothing
    a
x -> case forall a. Integral a => a -> a -> (a, a)
divMod a
x a
10000 of
      (a
d, a
m) -> forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
m, a
d)

{-# INLINE mergeComponents #-}
mergeComponents :: Integral a => Vector a -> Integer
mergeComponents :: forall a. Integral a => Vector a -> Integer
mergeComponents =
  forall a b. (a -> b -> a) -> a -> Vector b -> a
Vector.foldl' (\Integer
l a
r -> Integer
l forall a. Num a => a -> a -> a
* Integer
10000 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
r) Integer
0

{-# INLINE mergeDigits #-}
mergeDigits :: Integral a => Vector a -> a
mergeDigits :: forall a. Integral a => Vector a -> a
mergeDigits =
  forall a b. (a -> b -> a) -> a -> Vector b -> a
Vector.foldl' (\a
l a
r -> a
l forall a. Num a => a -> a -> a
* a
10 forall a. Num a => a -> a -> a
+ a
r) a
0

-- |
-- Unpack a component into digits.
{-# INLINE componentDigits #-}
componentDigits :: Int16 -> [Int16]
componentDigits :: Int16 -> [Int16]
componentDigits =
  forall s a. State s a -> s -> a
evalState forall a b. (a -> b) -> a -> b
$ do
    Int16
a <- forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> (a, a)
divMod Int16
1000)
    Int16
b <- forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> (a, a)
divMod Int16
100)
    Int16
c <- forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> (a, a)
divMod Int16
10)
    Int16
d <- forall (m :: * -> *) s. Monad m => StateT s m s
get
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Int16
a, Int16
b, Int16
c, Int16
d]

{-# INLINEABLE componentsReplicateM #-}
componentsReplicateM :: (Integral a, Applicative m) => Int -> m a -> m a
componentsReplicateM :: forall a (m :: * -> *).
(Integral a, Applicative m) =>
Int -> m a -> m a
componentsReplicateM Int
amount m a
component =
  forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {f :: * -> *} {c}.
(Applicative f, Num c) =>
f c -> f c -> f c
folder (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
0) (forall a. Int -> a -> [a]
replicate Int
amount m a
component)
  where
    folder :: f c -> f c -> f c
folder f c
acc f c
component =
      forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Num a => a -> a -> a
(+) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
* c
10000) f c
acc) f c
component

{-# INLINE signer #-}
signer :: Integral a => Word16 -> Either Text (a -> a)
signer :: forall a. Integral a => Word16 -> Either Text (a -> a)
signer =
  \case
    Word16
0x0000 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    Word16
0x4000 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Num a => a -> a
negate
    Word16
0xC000 -> forall a b. a -> Either a b
Left Text
"NAN sign"
    Word16
signCode -> forall a b. a -> Either a b
Left (Text
"Unexpected sign code: " forall a. Semigroup a => a -> a -> a
<> (forall a. IsString a => String -> a
fromString forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => a -> String
show) Word16
signCode)

{-# INLINE scientific #-}
scientific :: Int16 -> Word16 -> Vector Word16 -> Either Text Scientific
scientific :: Int16 -> Word16 -> Vector Word16 -> Either Text Scientific
scientific Int16
pointIndex Word16
signCode Vector Word16
components =
  do
    Integer -> Integer
theSigner <- forall a. Integral a => Word16 -> Either Text (a -> a)
signer Word16
signCode
    forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int -> Scientific
Scientific.scientific ((Integer -> Integer) -> Integer
c Integer -> Integer
theSigner) Int
e)
  where
    c :: (Integer -> Integer) -> Integer
c Integer -> Integer
signer =
      Integer -> Integer
signer (forall a. Integral a => Vector a -> Integer
mergeComponents Vector Word16
components)
    e :: Int
e =
      (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
pointIndex forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
- forall a. Vector a -> Int
Vector.length Vector Word16
components) forall a. Num a => a -> a -> a
* Int
4