module Data.JsonRpc.Integral (
  fromScientific,
  ) where

import Control.Monad (MonadPlus, guard)
import Data.Scientific (Scientific, toDecimalDigits)


fromScientific :: MonadPlus m => Scientific -> m Integer
fromScientific :: Scientific -> m Integer
fromScientific Scientific
sci = do
  let ([Int]
ds, Int
e) = Scientific -> ([Int], Int)
toDecimalDigits Scientific
sci
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Scientific
sci Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== Scientific
0 Bool -> Bool -> Bool
|| [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
e [Int]
ds)  -- test integral
  Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Scientific -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round Scientific
sci