on 74fb2ab help sign in
62 lines 2.2 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE ScopedTypeVariables #-}
6-- |
7-- Module : Network.Google.Data.Numeric
8-- Copyright : (c) 2015-2016 Brendan Hay <brendan.g.hay@gmail.com>
9-- License : Mozilla Public License, v. 2.0.
10-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
11-- Stability : provisional
12-- Portability : non-portable (GHC extensions)
13--
14module Network.Google.Data.Numeric
15 ( Nat (..)
16 ) where
18import Control.Monad
19import Data.Aeson
20import Data.Data
21import Data.Monoid ((<>))
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)
36instance FromJSON Nat where
37 parseJSON = parseJSON >=> go
38 where
39 go n = case floatingOrInteger n of
40 Left (_ :: Double) -> fail (floatErr n)
41 Right i
42 | n < 0 -> fail (negateErr n)
43 | otherwise -> return . Nat $ fromInteger i
45 floatErr = mappend "Cannot convert float to Natural: " . show
46 negateErr = mappend "Cannot convert negative number to Natural: " . show
48instance ToJSON Nat where
49 toJSON = Number . flip scientific 0 . toInteger . unNat
51instance ToHttpApiData Nat where
52 toQueryParam = shortText . Build.decimal
54instance FromHttpApiData Nat where
55 parseQueryParam t =
56 case Read.decimal t of
57 Right (x, r) | Text.null r
58 -> Right x
59 _ -> Left ("Unable to parse natural from: " <> t)
61shortText :: Builder -> Text
62shortText = LText.toStrict . Build.toLazyTextWith 32