module Data.JSON2.Internal
(
ConvResult
, checkBoundsIntegral
, checkBoundsEnum
, checkInfinite
, ConvError(ConvError)
, mkError
, mkError'
)
where
import Control.Monad.Error
import Data.Typeable
type ConvResult a = Either ConvError a
checkBoundsIntegral :: (Typeable a, Bounded a, Integral a)
=> (Rational -> a) -> Rational -> ConvResult a
checkBoundsIntegral f x = do
let res = f x
let min = toRational (asTypeOf minBound res)
let max = toRational (asTypeOf maxBound res)
if x >= min && x <= max
then
return res
else
mkError' ("Value must between: (" ++ show min ++ ", "
++ show max ++ ")") x
checkBoundsEnum :: (Typeable a, Bounded a, Enum a)
=> (Rational -> a) -> Rational -> ConvResult a
checkBoundsEnum f x = do
let x' = fromEnum x
let res = f x
let min = fromEnum (asTypeOf minBound res)
let max = fromEnum (asTypeOf maxBound res)
if x' >= min && x' <= max
then
return res
else
mkError' ("Value must between: (" ++ show min ++ ", "
++ show max ++ ")") x
checkInfinite :: (Typeable a, RealFloat a)
=> (Rational -> a) -> Rational -> ConvResult a
checkInfinite f x = do
let res = f x
if not (isInfinite res)
then
return res
else
mkError' ("Value conveversion to infinity. ") x
mkError :: (Show a, Typeable a, Typeable b) => a -> ConvResult b
mkError inpval = mkErrorGen "" inpval undefined
mkError' :: (Show a, Typeable a, Typeable b)
=> String -> a -> ConvResult b
mkError' msg inpval = mkErrorGen msg inpval undefined
mkErrorGen :: (Show a, Typeable a, Typeable b)
=> String -> a -> b -> ConvResult b
mkErrorGen msg inp ret =
Left ConvError {jsonValue = show inp,
jsonType = show . typeOf $ inp,
destType = show . typeOf $ ret,
errorMessage = msg}
data ConvError = ConvError {
jsonValue :: String,
jsonType :: String,
destType :: String,
errorMessage :: String}
deriving (Eq, Read, Show)
instance Error ConvError where
strMsg s = ConvError "" "" "" s