core/src/Network/Google/Data/Numeric.hs · gogol

git.iko.soy/gogol

on ce42607 help sign in

gogol/core/src/Network/Google/Data/Numeric.hs

61 lines 2.0 kB history raw

1{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3{-# LANGUAGE ScopedTypeVariables #-}

5-- |

6-- Module : Network.Google.Data.Numeric

8-- License : Mozilla Public License, v. 2.0.

9-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>

10-- Stability : provisional

11-- Portability : non-portable (GHC extensions)

12--

13module Network.Google.Data.Numeric

14 ( Nat (..)

15 ) where

18import Control.Monad

19import Data.Aeson

20import Data.Data

21import Data.Scientific

22import Data.Text (Text)

23import qualified Data.Text as Text

24import qualified Data.Text.Lazy as LText

25import Data.Text.Lazy.Builder (Builder)

26import qualified Data.Text.Lazy.Builder as Build

27import qualified Data.Text.Lazy.Builder.Int as Build

28import qualified Data.Text.Read as Read

29import Numeric.Natural

30import Servant.API

32newtype Nat = Nat { unNat :: Natural }

33 deriving (Eq, Ord, Enum, Show, Read, Num, Real, Integral, Data, Typeable)

35instance FromJSON Nat where

36 parseJSON = parseJSON >=> go

37 where

38 go n = case floatingOrInteger n of

39 Left (_ :: Double) -> fail (floatErr n)

40 Right i

41 | n < 0 -> fail (negateErr n)

42 | otherwise -> return . Nat $ fromInteger i

44 floatErr = mappend "Cannot convert float to Natural: " . show

45 negateErr = mappend "Cannot convert negative number to Natural: " . show

47instance ToJSON Nat where

48 toJSON = Number . flip scientific 0 . toInteger . unNat

50instance ToText Nat where

51 toText = shortText . Build.decimal

53instance FromText Nat where

54 fromText t =

55 case Read.decimal t of

56 Right (x, r) | Text.null r

57 -> Just x

58 _ -> Nothing

60shortText :: Builder -> Text

61shortText = LText.toStrict . Build.toLazyTextWith 32