6f1f957 · squeal · git.iko.soy

git.iko.soy/squeal

move stuff from binary to pg

commit6f1f95707d251ce58bf4559d9b6acd90ecae6f2b authorEitan Chatav <eitan@Eitans-MacBook-Pro.local> dateSat 6 Apr 2019, 09:05 (8 years ago) parent212174e

4 files changed+85−82

compare with dev

unifiedsplit

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+2−79 squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs−1 squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+1−1 squeal-postgresql/src/Squeal/PostgreSQL/PG.hs+82−1

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+2−79

@@ -202,16 +202,8 @@ True

202202#-}

203203

204204module Squeal.PostgreSQL.Binary

205− ( -- * Storage newtypes

206− Money (..)

207− , Json (..)

208− , Jsonb (..)

209− , Composite (..)

210− , Enumerated (..)

211− , VarArray (..)

212− , FixArray (..)

213− -- * Encoding

214− , ToParam (..)

205+ ( -- * Encoding

206+ ToParam (..)

215207 , ToParams (..)

216208 , ToNullityParam

217209 , ToField

@@ -712,72 +704,3 @@ replicateMN

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

713705replicateMN mx = hsequence' $

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

715−

716−{- | The `Money` newtype stores a monetary value in terms

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

718−@Money { cents = 200020 }@.

719−

720−>>> import Control.Monad (void)

721−>>> import Control.Monad.IO.Class (liftIO)

722−>>> import Squeal.PostgreSQL

723−>>> :{

724−let

725− roundTrip :: Query_ (Public '[]) (Only Money) (Only Money)

726− roundTrip = values_ $ parameter @1 money `as` #fromOnly

727−:}

728−

729−>>> let input = Only (Money 20020)

730−

731−>>> :{

732−void . withConnection "host=localhost port=5432 dbname=exampledb" $ do

733− result <- runQueryParams roundTrip input

734− Just output <- firstRow result

735− liftIO . print $ input == output

736−:}

737−True

738−-}

739−newtype Money = Money { cents :: Int64 }

740− deriving (Eq, Ord, Show, Read, GHC.Generic)

741−type instance PG Money = 'PGmoney

742−

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

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

745−-}

746−newtype Json hask = Json {getJson :: hask}

747− deriving (Eq, Ord, Show, Read, GHC.Generic)

748−type instance PG (Json hask) = 'PGjson

749−

750−{- | The `Jsonb` newtype is an indication that the Haskell

751−type it's applied to should be stored as a `PGjsonb`.

752−-}

753−newtype Jsonb hask = Jsonb {getJsonb :: hask}

754− deriving (Eq, Ord, Show, Read, GHC.Generic)

755−type instance PG (Jsonb hask) = 'PGjsonb

756−

757−{- | The `Composite` newtype is an indication that the Haskell

758−type it's applied to should be stored as a `PGcomposite`.

759−-}

760−newtype Composite record = Composite {getComposite :: record}

761− deriving (Eq, Ord, Show, Read, GHC.Generic)

762−type instance PG (Composite hask) = 'PGcomposite (RowPG hask)

763−

764−{- | The `Enumerated` newtype is an indication that the Haskell

765−type it's applied to should be stored as a `PGenum`.

766−-}

767−newtype Enumerated enum = Enumerated {getEnumerated :: enum}

768− deriving (Eq, Ord, Show, Read, GHC.Generic)

769−type instance PG (Enumerated hask) = 'PGenum (LabelsPG hask)

770−

771−{- | The `VarArray` newtype is an indication that the Haskell

772−type it's applied to should be stored as a `PGvararray`.

773−-}

774−newtype VarArray arr = VarArray {getVarArray :: arr}

775− deriving (Eq, Ord, Show, Read, GHC.Generic)

776−type instance PG (VarArray (Vector hask)) = 'PGvararray (NullPG hask)

777−

778−{- | The `FixArray` newtype is an indication that the Haskell

779−type it's applied to should be stored as a `PGfixarray`.

780−-}

781−newtype FixArray arr = FixArray {getFixArray :: arr}

782− deriving (Eq, Ord, Show, Read, GHC.Generic)

783−type instance PG (FixArray x) = 'PGfixarray (DimPG x) (FixPG x)

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs−1

@@ -96,7 +96,6 @@ import qualified Generics.SOP as SOP

9696import qualified GHC.Generics as GHC

9797

9898import Squeal.PostgreSQL.Alias

99−import Squeal.PostgreSQL.Binary

10099import Squeal.PostgreSQL.Expression

101100import Squeal.PostgreSQL.PG

102101import Squeal.PostgreSQL.Query

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

@@ -210,7 +210,7 @@ instance Migratory Definition where

210210into a category by restricting the return type to @()@ and permuting the type variables.

211211This is similar to how applying a monad to @()@ yields a monoid.

212212Since a `Terminally` action has a trivial return value, the only reason

213−to run one is for the side effects, in particular database effects.

213+to run one is for the side effects, in particular database and other IO effects.

214214-}

215215newtype Terminally trans monad x0 x1 = Terminally

216216 { runTerminally :: trans x0 x1 monad () }

squeal-postgresql/src/Squeal/PostgreSQL/PG.hs+82−1

@@ -23,12 +23,22 @@

2323#-}

2424

2525module Squeal.PostgreSQL.PG

26− ( PG

26+ ( -- * PG embeddings

27+ PG

2728 , NullPG

2829 , TuplePG

2930 , RowPG

3031 , Entity

32+ -- * Storage newtypes

33+ , Money (..)

34+ , Json (..)

35+ , Jsonb (..)

36+ , Composite (..)

37+ , Enumerated (..)

38+ , VarArray (..)

39+ , FixArray (..)

3140 , SOP.P (..)

41+ -- * Type families

3242 , LabelsPG

3343 , DimPG

3444 , FixPG

@@ -44,6 +54,7 @@ import Data.Kind (Type)

4454import Data.Int (Int16, Int32, Int64)

4555import Data.Scientific (Scientific)

4656import Data.Time (Day, DiffTime, LocalTime, TimeOfDay, TimeZone, UTCTime)

57+import Data.Vector (Vector)

4758import Data.Word (Word16, Word32, Word64)

4859import Data.UUID.Types (UUID)

4960import GHC.TypeLits

@@ -53,6 +64,7 @@ import qualified Data.ByteString.Lazy as Lazy (ByteString)

5364import qualified Data.ByteString as Strict (ByteString)

5465import qualified Data.Text.Lazy as Lazy (Text)

5566import qualified Data.Text as Strict (Text)

67+import qualified GHC.Generics as GHC

5668import qualified Generics.SOP as SOP

5769import qualified Generics.SOP.Record as SOP

5870import qualified Generics.SOP.Type.Metadata as Type

@@ -295,3 +307,72 @@ type family FixPG (hask :: Type) :: NullityType where

295307 FixPG (x,x,x,x,x,x,x,x,x,x) = FixPG x

296308 FixPG (x,x,x,x,x,x,x,x,x,x,x) = FixPG x

297309 FixPG x = NullPG x

310+

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

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

313+@Money { cents = 200020 }@.

314+

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

316+>>> import Control.Monad.IO.Class (liftIO)

317+>>> import Squeal.PostgreSQL

318+>>> :{

319+let

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

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

322+:}

323+

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

325+

326+>>> :{

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

328+ result <- runQueryParams roundTrip input

329+ Just output <- firstRow result

330+ liftIO . print $ input == output

331+:}

332+True

333+-}

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

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

336+type instance PG Money = 'PGmoney

337+

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

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

340+-}

341+newtype Json hask = Json {getJson :: hask}

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

343+type instance PG (Json hask) = 'PGjson

344+

345+{- | The `Jsonb` newtype is an indication that the Haskell

346+type it's applied to should be stored as a `PGjsonb`.

347+-}

348+newtype Jsonb hask = Jsonb {getJsonb :: hask}

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

350+type instance PG (Jsonb hask) = 'PGjsonb

351+

352+{- | The `Composite` newtype is an indication that the Haskell

353+type it's applied to should be stored as a `PGcomposite`.

354+-}

355+newtype Composite record = Composite {getComposite :: record}

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

357+type instance PG (Composite hask) = 'PGcomposite (RowPG hask)

358+

359+{- | The `Enumerated` newtype is an indication that the Haskell

360+type it's applied to should be stored as a `PGenum`.

361+-}

362+newtype Enumerated enum = Enumerated {getEnumerated :: enum}

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

364+type instance PG (Enumerated hask) = 'PGenum (LabelsPG hask)

365+

366+{- | The `VarArray` newtype is an indication that the Haskell

367+type it's applied to should be stored as a `PGvararray`.

368+-}

369+newtype VarArray arr = VarArray {getVarArray :: arr}

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

371+type instance PG (VarArray (Vector hask)) = 'PGvararray (NullPG hask)

372+

373+{- | The `FixArray` newtype is an indication that the Haskell

374+type it's applied to should be stored as a `PGfixarray`.

375+-}

376+newtype FixArray arr = FixArray {getFixArray :: arr}

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

378+type instance PG (FixArray x) = 'PGfixarray (DimPG x) (FixPG x)