{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Copyright: © 2021 IOHK
-- License: Apache-2.0
--
-- This module provides functions and types that extend those provided by
-- the 'aeson' package.
--
module Data.Aeson.Extra
    ( parseBoundedIntegral
    ) where

import Prelude

import Data.Aeson
    ( Value (Number) )
import Data.Aeson.Types
    ( Parser )

import qualified Data.Scientific as Scientific

parseBoundedIntegral
    :: forall a. (Bounded a, Integral a) => String -> Value -> Parser a
parseBoundedIntegral :: String -> Value -> Parser a
parseBoundedIntegral String
typeName =
    Parser a -> (a -> Parser a) -> Maybe a -> Parser a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errorMessage) a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> Parser a) -> (Value -> Maybe a) -> Value -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe a
parseInner
  where
    parseInner :: Value -> Maybe a
    parseInner :: Value -> Maybe a
parseInner = \case
        Number Scientific
n -> Scientific -> Maybe a
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Scientific.toBoundedInteger Scientific
n
        Value
_        -> Maybe a
forall a. Maybe a
Nothing

    errorMessage :: String
    errorMessage :: String
errorMessage = [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"Failed to parse value of type '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typeName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'. "
        , String
"Expected an integral value in the range ["
        , Integer -> String
forall a. Show a => a -> String
show (a -> Integer
forall a. Integral a => a -> Integer
toInteger (a -> Integer) -> a -> Integer
forall a b. (a -> b) -> a -> b
$ Bounded a => a
forall a. Bounded a => a
minBound @a)
        , String
", "
        , Integer -> String
forall a. Show a => a -> String
show (a -> Integer
forall a. Integral a => a -> Integer
toInteger (a -> Integer) -> a -> Integer
forall a b. (a -> b) -> a -> b
$ Bounded a => a
forall a. Bounded a => a
maxBound @a)
        , String
"]."
        ]