module Data.JsonRpc.Id (Id(..), numberId) where

import Control.Applicative (Applicative, (<$>))
import Control.Monad (MonadPlus)
import Data.Text (Text)
import Data.Scientific (Scientific)

import Data.JsonRpc.Integral (fromScientific)

{-
-- citation from http://www.jsonrpc.org/specification
--
--  An identifier established by the Client that MUST contain
--  a String, Number, or NULL value if included.
--  If it is not included it is assumed to be a notification.
--  The value SHOULD normally not be Null [1]
--  and Numbers SHOULD NOT contain fractional parts [2]
--
--  [1] The use of Null as a value for the id member in
--  a Request object is discouraged, because this specification
--  uses a value of Null for Responses with an unknown id.
--  Also, because JSON-RPC 1.0 uses an id value of Null
--  for Notifications this could cause confusion in handling.

--  [2] Fractional parts may be problematic,
--  since many decimal fractions cannot be
--  represented exactly as binary fractions.
-}

data Id
  = StringId !Text
  | NumberId !Integer
  deriving (Id -> Id -> Bool
(Id -> Id -> Bool) -> (Id -> Id -> Bool) -> Eq Id
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c== :: Id -> Id -> Bool
Eq, Eq Id
Eq Id
-> (Id -> Id -> Ordering)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Id)
-> (Id -> Id -> Id)
-> Ord Id
Id -> Id -> Bool
Id -> Id -> Ordering
Id -> Id -> Id
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Id -> Id -> Id
$cmin :: Id -> Id -> Id
max :: Id -> Id -> Id
$cmax :: Id -> Id -> Id
>= :: Id -> Id -> Bool
$c>= :: Id -> Id -> Bool
> :: Id -> Id -> Bool
$c> :: Id -> Id -> Bool
<= :: Id -> Id -> Bool
$c<= :: Id -> Id -> Bool
< :: Id -> Id -> Bool
$c< :: Id -> Id -> Bool
compare :: Id -> Id -> Ordering
$ccompare :: Id -> Id -> Ordering
$cp1Ord :: Eq Id
Ord, Int -> Id -> ShowS
[Id] -> ShowS
Id -> String
(Int -> Id -> ShowS)
-> (Id -> String) -> ([Id] -> ShowS) -> Show Id
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Id] -> ShowS
$cshowList :: [Id] -> ShowS
show :: Id -> String
$cshow :: Id -> String
showsPrec :: Int -> Id -> ShowS
$cshowsPrec :: Int -> Id -> ShowS
Show, ReadPrec [Id]
ReadPrec Id
Int -> ReadS Id
ReadS [Id]
(Int -> ReadS Id)
-> ReadS [Id] -> ReadPrec Id -> ReadPrec [Id] -> Read Id
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Id]
$creadListPrec :: ReadPrec [Id]
readPrec :: ReadPrec Id
$creadPrec :: ReadPrec Id
readList :: ReadS [Id]
$creadList :: ReadS [Id]
readsPrec :: Int -> ReadS Id
$creadsPrec :: Int -> ReadS Id
Read)

numberId :: (MonadPlus m, Applicative m) => Scientific -> m Id
numberId :: Scientific -> m Id
numberId Scientific
sci = Integer -> Id
NumberId (Integer -> Id) -> m Integer -> m Id
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scientific -> m Integer
forall (m :: * -> *). MonadPlus m => Scientific -> m Integer
fromScientific Scientific
sci