559334b · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

Start on Array refactor

559334bEitan Chatav8 years ago

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

compare with dev

unifiedsplit

@@ -1,3 +1,7 @@

1+{-# LANGUAGE

2+ TypeFamilies

3+#-}

1{-|

5{-|

2Module: Squeal.PostgreSQL.Binary

6Module: Squeal.PostgreSQL.Binary

3Description: Binary encoding and decoding

7Description: Binary encoding and decoding

@@ -200,8 +204,13 @@ True

200#-}

204#-}

201

205

202module Squeal.PostgreSQL.Binary

206module Squeal.PostgreSQL.Binary

207+ ( Json (..)

208+ , Jsonb (..)

209+ , Composite (..)

210+ , Enumerated (..)

211+ , VarArray (..)

203− ( -- * Encoding

212+ -- * Encoding

204− ToParam (..)

213+ , ToParam (..)

205 , ToParams (..)

214 , ToParams (..)

206 -- * Decoding

215 -- * Decoding

207 , FromValue (..)

216 , FromValue (..)

@@ -660,3 +669,70 @@ replicateMN

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

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

661replicateMN mx = hsequence' $

670replicateMN mx = hsequence' $

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

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

672+

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

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

675+-}

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

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

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

679+

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

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

682+-}

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

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

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

686+

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

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

689+-}

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

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

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

693+

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

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

696+-}

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

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

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

700+

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

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

703+-}

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

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

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

707+

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

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

710+-}

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

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

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

714+

715+type family DimPG (hask :: Type) :: [Nat] where

716+ DimPG (x,x) = 2 ': DimPG x

717+ DimPG (x,x,x) = 3 ': DimPG x

718+ DimPG (x,x,x,x) = 4 ': DimPG x

719+ DimPG (x,x,x,x,x) = 5 ': DimPG x

720+ DimPG (x,x,x,x,x,x) = 6 ': DimPG x

721+ DimPG (x,x,x,x,x,x,x) = 7 ': DimPG x

722+ DimPG (x,x,x,x,x,x,x,x) = 8 ': DimPG x

723+ DimPG (x,x,x,x,x,x,x,x,x) = 9 ': DimPG x

724+ DimPG (x,x,x,x,x,x,x,x,x,x) = 10 ': DimPG x

725+ DimPG x = '[]

726+

727+type family FixPG (hask :: Type) :: NullityType where

728+ FixPG (x,x) = FixPG x

729+ FixPG (x,x,x) = FixPG x

730+ FixPG (x,x,x,x) = FixPG x

731+ FixPG (x,x,x,x,x) = FixPG x

732+ FixPG (x,x,x,x,x,x) = FixPG x

733+ FixPG (x,x,x,x,x,x,x) = FixPG x

734+ FixPG (x,x,x,x,x,x,x,x) = FixPG x

735+ FixPG (x,x,x,x,x,x,x,x,x) = FixPG x

736+ FixPG (x,x,x,x,x,x,x,x,x,x) = FixPG x

737+ FixPG (x,x,x,x,x,x,x,x,x,x,x) = FixPG x

738+ FixPG x = NullPG x

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

@@ -95,6 +95,7 @@ import Prelude hiding ((.), id)

95import qualified Generics.SOP as SOP

96import qualified GHC.Generics as GHC

98+import Squeal.PostgreSQL.Binary

98import Squeal.PostgreSQL.Expression

99import Squeal.PostgreSQL.Expression

99import Squeal.PostgreSQL.Query

100import Squeal.PostgreSQL.Query

100import Squeal.PostgreSQL.Render

101import Squeal.PostgreSQL.Render

squeal-postgresql/src/Squeal/PostgreSQL/Render.hs+6−2

@@ -29,6 +29,7 @@ module Squeal.PostgreSQL.Render

29 , renderCommaSeparated

30 , renderCommaSeparatedMaybe

31 , renderNat

32+ , renderNats

32 , renderSymbol

33 , renderSymbol

33 , RenderSQL (..)

34 , RenderSQL (..)

34 , printSQL

35 , printSQL

@@ -98,13 +99,16 @@ renderCommaSeparatedMaybe render

98renderNat :: forall n. KnownNat n => ByteString

99renderNat :: forall n. KnownNat n => ByteString

99renderNat = fromString (show (natVal' (proxy# :: Proxy# n)))

100renderNat = fromString (show (natVal' (proxy# :: Proxy# n)))

100

101

102+-- | Render a promoted list of `Nat`s.

103+renderNats :: forall ns. All KnownNat ns => ByteString

104+renderNats = undefined

105+

101-- | Render a promoted `Symbol`.

106-- | Render a promoted `Symbol`.

102renderSymbol :: forall s. KnownSymbol s => ByteString

107renderSymbol :: forall s. KnownSymbol s => ByteString

103renderSymbol = fromString (symbolVal' (proxy# :: Proxy# s))

108renderSymbol = fromString (symbolVal' (proxy# :: Proxy# s))

104

109

105-- | A class for rendering SQL

110-- | A class for rendering SQL

106−class RenderSQL sql where

111+class RenderSQL sql where renderSQL :: sql -> ByteString

107− renderSQL :: sql -> ByteString

108

112

109-- | Print SQL.

113-- | Print SQL.

110printSQL :: (RenderSQL sql, MonadBase IO io) => sql -> io ()

114printSQL :: (RenderSQL sql, MonadBase IO io) => sql -> io ()

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs−48

@@ -44,10 +44,6 @@ module Squeal.PostgreSQL.Schema

44 , NullPG

45 , TuplePG

46 , RowPG

47− , Json (..)

48− , Jsonb (..)

49− , Composite (..)

50− , Enumerated (..)

51 -- * Schema Types

47 -- * Schema Types

52 , ColumnType

48 , ColumnType

53 , ColumnsType

49 , ColumnsType

@@ -137,7 +133,6 @@ import Data.Time

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

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

138import Data.Type.Bool

134import Data.Type.Bool

139import Data.UUID.Types (UUID)

135import Data.UUID.Types (UUID)

140−import Data.Vector (Vector)

141import Generics.SOP

136import Generics.SOP

142import Generics.SOP.Record

137import Generics.SOP.Record

143import GHC.OverloadedLabels

138import GHC.OverloadedLabels

@@ -755,49 +750,6 @@ type instance PG DiffTime = 'PGinterval

755type instance PG UUID = 'PGuuid

750type instance PG UUID = 'PGuuid

756type instance PG (NetAddr IP) = 'PGinet

751type instance PG (NetAddr IP) = 'PGinet

757type instance PG Value = 'PGjson

752type instance PG Value = 'PGjson

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

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

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

761−type instance PG (hask, hask) = 'PGfixarray 2 (NullPG hask)

762−type instance PG (hask, hask, hask) = 'PGfixarray 3 (NullPG hask)

763−type instance PG (hask, hask, hask, hask) = 'PGfixarray 4 (NullPG hask)

764−type instance PG (hask, hask, hask, hask, hask) = 'PGfixarray 5 (NullPG hask)

765−type instance PG (hask, hask, hask, hask, hask, hask)

766− = 'PGfixarray 6 (NullPG hask)

767−type instance PG (hask, hask, hask, hask, hask, hask, hask)

768− = 'PGfixarray 7 (NullPG hask)

769−type instance PG (hask, hask, hask, hask, hask, hask, hask, hask)

770− = 'PGfixarray 8 (NullPG hask)

771−type instance PG (hask, hask, hask, hask, hask, hask, hask, hask, hask)

772− = 'PGfixarray 9 (NullPG hask)

773−type instance PG (hask, hask, hask, hask, hask, hask, hask, hask, hask, hask)

774− = 'PGfixarray 10 (NullPG hask)

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

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

777−

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

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

780−-}

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

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

783−

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

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

786−-}

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

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

789−

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

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

792−-}

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

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

795−

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

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

798−-}

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

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

801

753

802{-| The `LabelsPG` type family calculates the constructors of a

754{-| The `LabelsPG` type family calculates the constructors of a

803Haskell enum type.

755Haskell enum type.