on bec6ff8 help sign in
65 lines 2.1 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE ScopedTypeVariables #-}
5-- |
6-- Module : Network.Google.Data.Numeric
7-- Copyright : (c) 2015 Brendan Hay <brendan.g.hay@gmail.com>
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 , _Nat
16 ) where
18import Control.Lens
19import Control.Monad
20import Data.Aeson
21import Data.Data
22import Data.Scientific
23import Data.Text (Text)
24import qualified Data.Text as Text
25import qualified Data.Text.Lazy as LText
26import Data.Text.Lazy.Builder (Builder)
27import qualified Data.Text.Lazy.Builder as Build
28import qualified Data.Text.Lazy.Builder.Int as Build
29import qualified Data.Text.Read as Read
30import Numeric.Natural
31import Servant.API
33newtype Nat = Nat { unNat :: Natural }
34 deriving (Eq, Ord, Enum, Show, Read, Num, Real, Integral, Data, Typeable)
36_Nat :: Iso' Nat Natural
37_Nat = iso unNat Nat
39instance FromJSON Nat where
40 parseJSON = parseJSON >=> go
41 where
42 go n = case floatingOrInteger n of
43 Left (_ :: Double) -> fail (floatErr n)
44 Right i
45 | n < 0 -> fail (negateErr n)
46 | otherwise -> return . Nat $ fromInteger i
48 floatErr = mappend "Cannot convert float to Natural: " . show
49 negateErr = mappend "Cannot convert negative number to Natural: " . show
51instance ToJSON Nat where
52 toJSON = Number . flip scientific 0 . toInteger . unNat
54instance ToText Nat where
55 toText = shortText . Build.decimal
57instance FromText Nat where
58 fromText t =
59 case Read.decimal t of
60 Right (x, r) | Text.null r
61 -> Just x
62 _ -> Nothing
64shortText :: Builder -> Text
65shortText = LText.toStrict . Build.toLazyTextWith 32