5a626eb · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

money

5a626ebEitan Chatav8 years ago

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+31−1

compare with dev

unifiedsplit

@@ -209,6 +209,7 @@ module Squeal.PostgreSQL.Binary

209 , RowPG

210 , LabelsPG

211 -- * Storage newtypes

212+ , Money (..)

212 , Json (..)

213 , Json (..)

213 , Jsonb (..)

214 , Jsonb (..)

214 , Composite (..)

215 , Composite (..)

@@ -289,6 +290,7 @@ instance ToParam Word64 'PGint8 where toParam = K . Encoding.int8_word64

289instance ToParam Float 'PGfloat4 where toParam = K . Encoding.float4

290instance ToParam Float 'PGfloat4 where toParam = K . Encoding.float4

290instance ToParam Double 'PGfloat8 where toParam = K . Encoding.float8

291instance ToParam Double 'PGfloat8 where toParam = K . Encoding.float8

291instance ToParam Scientific 'PGnumeric where toParam = K . Encoding.numeric

292instance ToParam Scientific 'PGnumeric where toParam = K . Encoding.numeric

293+instance ToParam Money 'PGmoney where toParam = K . Encoding.int8_int64 . cents

292instance ToParam UUID 'PGuuid where toParam = K . Encoding.uuid

294instance ToParam UUID 'PGuuid where toParam = K . Encoding.uuid

293instance ToParam (NetAddr IP) 'PGinet where toParam = K . Encoding.inet

295instance ToParam (NetAddr IP) 'PGinet where toParam = K . Encoding.inet

294instance ToParam Char ('PGchar 1) where toParam = K . Encoding.char_utf8

296instance ToParam Char ('PGchar 1) where toParam = K . Encoding.char_utf8

@@ -465,6 +467,7 @@ instance FromValue 'PGint8 Int64 where fromValue = Decoding.int

465instance FromValue 'PGfloat4 Float where fromValue = Decoding.float4

467instance FromValue 'PGfloat4 Float where fromValue = Decoding.float4

466instance FromValue 'PGfloat8 Double where fromValue = Decoding.float8

468instance FromValue 'PGfloat8 Double where fromValue = Decoding.float8

467instance FromValue 'PGnumeric Scientific where fromValue = Decoding.numeric

469instance FromValue 'PGnumeric Scientific where fromValue = Decoding.numeric

470+instance FromValue 'PGmoney Money where fromValue = Money <$> Decoding.int

468instance FromValue 'PGuuid UUID where fromValue = Decoding.uuid

471instance FromValue 'PGuuid UUID where fromValue = Decoding.uuid

469instance FromValue 'PGinet (NetAddr IP) where fromValue = Decoding.inet

472instance FromValue 'PGinet (NetAddr IP) where fromValue = Decoding.inet

470instance FromValue ('PGchar 1) Char where fromValue = Decoding.char

473instance FromValue ('PGchar 1) Char where fromValue = Decoding.char

@@ -713,7 +716,34 @@ replicateMN

713 :: forall x xs m. (All ((~) x) xs, Monad m, SListI xs)

716 :: forall x xs m. (All ((~) x) xs, Monad m, SListI xs)

714 => m x -> m (NP I xs)

717 => m x -> m (NP I xs)

715replicateMN mx = hsequence' $

718replicateMN mx = hsequence' $

716− hcpure (Proxy :: Proxy ((~) x)) (Comp (I <$> mx))

719+ hcpure (Proxy :: Proxy ((~) x)) (Comp (I <$> mx))

720+

721+{- | The `Money` newtype stores a monetary value in terms

722+of the number of cents, i.e. @$2,000.20@ would be expressed as

723+@Money { cents = 200020 }@.

724+

725+>>> import Control.Monad (void)

726+>>> import Control.Monad.Base (liftBase)

727+>>> import Squeal.PostgreSQL

728+>>> :{

729+let

730+ roundTrip :: Query_ (Public '[]) (Only Money) (Only Money)

731+ roundTrip = values_ $ parameter @1 money `as` #fromOnly

732+:}

733+

734+>>> let input = Only (Money 20020)

735+

736+>>> :{

737+void . withConnection "host=localhost port=5432 dbname=exampledb" $ do

738+ result <- runQueryParams roundTrip input

739+ Just output <- firstRow result

740+ liftBase . print $ input == output

741+:}

742+True

743+-}

744+newtype Money = Money { cents :: Int64 }

745+ deriving (Eq, Ord, Show, Read, GHC.Generic)

746+type instance PG Money = 'PGmoney

717

747

718{- | The `Json` newtype is an indication that the Haskell

748{- | The `Json` newtype is an indication that the Haskell

719type it's applied to should be stored as a `PGjson`.

749type it's applied to should be stored as a `PGjson`.

squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+4

@@ -175,6 +175,7 @@ module Squeal.PostgreSQL.Expression

175 , real

176 , float8

177 , doublePrecision

178+ , money

178 , text

179 , text

179 , char

180 , char

180 , character

181 , character

@@ -1926,6 +1927,9 @@ real = UnsafeTypeExpression "real"

1926float8, doublePrecision :: TypeExpression schemas (nullity 'PGfloat8)

1927float8, doublePrecision :: TypeExpression schemas (nullity 'PGfloat8)

1927float8 = UnsafeTypeExpression "float8"

1928float8 = UnsafeTypeExpression "float8"

1928doublePrecision = UnsafeTypeExpression "double precision"

1929doublePrecision = UnsafeTypeExpression "double precision"

1930+-- | currency amount

1931+money :: TypeExpression schema (nullity 'PGmoney)

1932+money = UnsafeTypeExpression "money"

1929-- | variable-length character string

1933-- | variable-length character string

1930text :: TypeExpression schemas (nullity 'PGtext)

1934text :: TypeExpression schemas (nullity 'PGtext)

1931text = UnsafeTypeExpression "text"

1935text = UnsafeTypeExpression "text"

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+1

@@ -145,6 +145,7 @@ data PGType

145 | PGnumeric -- ^ arbitrary precision numeric type

146 | PGfloat4 -- ^ single precision floating-point number (4 bytes)

147 | PGfloat8 -- ^ double precision floating-point number (8 bytes)

148+ | PGmoney -- ^ currency amount

148 | PGchar Nat -- ^ fixed-length character string

149 | PGchar Nat -- ^ fixed-length character string

149 | PGvarchar Nat -- ^ variable-length character string

150 | PGvarchar Nat -- ^ variable-length character string

150 | PGtext -- ^ variable-length character string

151 | PGtext -- ^ variable-length character string