git.iko.soy/squeal
on dev help sign in
example exe
commit1cdb88a40c3094bf5633bf11d9f003002a17091c authorEitan Chatav <eitan.chatav@gmail.com> dateSun 25 Jun 2017, 20:47 (9 years ago) parent38d7ee0
5 files changed+116−19
compare with dev
unifiedsplit
squeel-postgresql/exe/Example.hs+79 squeel-postgresql/squeel-postgresql.cabal+12 squeel-postgresql/src/Squeel/PostgreSQL/Binary.hs+7−3 squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+12−10 squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+6−6
squeel-postgresql/exe/Example.hsnew file+79
@@ -0,0 +1,79 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , MagicHash
4+ , OverloadedLabels
5+ , OverloadedStrings
6+ , TypeOperators
7+#-}
8+
9+module Main (main) where
10+
11+import Control.Monad.Base
12+import Data.Int
13+import Data.Monoid
14+import Data.Vinyl
15+import GHC.Exts
16+import Squeel.PostgreSQL
17+
18+import qualified Data.ByteString.Char8 as Char8
19+
20+main :: IO ()
21+main = do
22+ Char8.putStrLn "squeel"
23+ connectionString <- pure
24+ "host=localhost port=5432 dbname=exampledb"
25+ Char8.putStrLn $ "connecting to " <> connectionString
26+ connection0 <- connectdb connectionString
27+ Char8.putStrLn "creating tables"
28+ connection1 <- flip execPQ connection0 $ pqExec $
29+ createTable #table1 (proxy# :: Proxy# Columns)
30+ .>>.
31+ createTable #students (proxy# :: Proxy# StudentsColumns)
32+ .>>.
33+ createTable #shippers (proxy# :: Proxy# ShipperColumns)
34+ .>>.
35+ createTable #customers (proxy# :: Proxy# CustomerColumns)
36+ .>>.
37+ createTable #orders (proxy# :: Proxy# OrderColumns)
38+ connection2 <- flip execPQ connection1 $ do
39+ _insertTable1Result <- pqExec $
40+ insertInto #table1 ( 1 `As` #col1 :& 2 `As` #col2 :& RNil )
41+ .>>.
42+ insertInto #table1 ( 3 `As` #col1 :& 4 `As` #col2 :& RNil )
43+ Just selectTable1Result <- pqExec $ select $ starFrom #table1
44+ Just (Right value00) <- getvalue selectTable1Result (RowNumber 0) colNum0
45+ Just (Right value01) <- getvalue selectTable1Result (RowNumber 0) colNum1
46+ Just (Right value10) <- getvalue selectTable1Result (RowNumber 1) colNum0
47+ Just (Right value11) <- getvalue selectTable1Result (RowNumber 1) colNum1
48+ liftBase $ do
49+ print (value00 :: Int32)
50+ print (value01 :: Int32)
51+ print (value10 :: Int32)
52+ print (value11 :: Int32)
53+ finish connection2
54+
55+type Columns = '[ "col1" ::: 'NotNull 'PGInt4, "col2" ::: 'NotNull 'PGInt4]
56+-- type Tables = '[ "table1" ::: Columns ]
57+-- type SumAndCol1 = '[ "sum" ::: 'NotNull 'PGInt4, "col1" ::: 'NotNull 'PGInt4]
58+type StudentsColumns = '["name" ::: 'NotNull 'PGText]
59+-- type StudentsTable = '["students" ::: StudentsColumns]
60+type OrderColumns =
61+ [ "orderID" ::: 'NotNull 'PGInt4
62+ , "orderVal" ::: 'NotNull 'PGText
63+ , "customerID" ::: 'NotNull 'PGInt4
64+ , "shipperID" ::: 'NotNull 'PGInt4
65+ ]
66+type CustomerColumns =
67+ [ "customerID" ::: 'NotNull 'PGInt4, "customerVal" ::: 'NotNull 'PGFloat4 ]
68+type ShipperColumns =
69+ [ "shipperID" ::: 'NotNull 'PGInt4, "shipperVal" ::: 'NotNull 'PGBool ]
70+-- type JoinTables =
71+-- [ "shippers" ::: ShipperColumns
72+-- , "customers" ::: CustomerColumns
73+-- , "orders" ::: OrderColumns
74+-- ]
75+-- type ValueColumns =
76+-- [ "orderVal" ::: 'NotNull 'PGText
77+-- , "customerVal" ::: 'NotNull 'PGFloat4
78+-- , "shipperVal" ::: 'NotNull 'PGBool
79+-- ]
squeel-postgresql/squeel-postgresql.cabal+12
@@ -53,6 +53,18 @@ test-suite squeel-postgresql-test
5353 , squeel-postgresql
5454 , vinyl
5555
56+executable squeel-postgresql-example
57+ default-language: Haskell2010
58+ hs-source-dirs: exe
59+ ghc-options: -Wall -Werror
60+ main-is: Example.hs
61+ build-depends:
62+ base
63+ , bytestring
64+ , squeel-postgresql
65+ , transformers-base
66+ , vinyl
67+
5668source-repository head
5769 type: git
5870 location: https://github.com/echatav/squeel
squeel-postgresql/src/Squeel/PostgreSQL/Binary.hs+7−3
@@ -11,6 +11,8 @@
1111
1212module Squeel.PostgreSQL.Binary where
1313
14+import Debug.Trace
15+
1416import Control.Arrow (left)
1517import Data.Aeson (FromJSON, ToJSON, eitherDecodeStrict, encode)
1618import Data.ByteString (ByteString)
@@ -36,12 +38,12 @@ import Squeel.PostgreSQL.Schema
3638decodeValue :: FromValue pg x => Proxy# pg -> ByteString -> Either Text x
3739decodeValue p = Decoder.run $ fromValue p
3840
39−class FromValue (pg :: PGType) x where
41+class FromValue pg x where
4042 fromValue :: Proxy# pg -> Decoder x
4143instance FromValue 'PGInt2 Int16 where
4244 fromValue _ = Decoder.int
4345instance FromValue 'PGInt4 Int32 where
44− fromValue _ = Decoder.int
46+ fromValue _ = trace "Decoder.int" Decoder.int
4547instance FromValue 'PGInt8 Int64 where
4648 fromValue _ = Decoder.int
4749instance FromValue 'PGFloat4 Float where
@@ -80,6 +82,8 @@ instance FromValue 'PGTimestampTZ UTCTime where
8082 fromValue _ = Decoder.timestamptz_int
8183instance FromValue 'PGInterval DiffTime where
8284 fromValue _ = Decoder.interval_int
85+instance FromValue pg ty => FromValue (column ::: 'NotNull pg) ty where
86+ fromValue _ = fromValue (proxy# :: Proxy# pg)
8387
8488class FromValues pgs xs where
8589 decodeValues :: Proxy# pgs -> Rec (Const ByteString) xs -> Rec (Either Text) xs
@@ -90,7 +94,7 @@ instance (FromValue pg x, FromValues pgs xs)
9094 decodeValue (proxy# :: Proxy# pg) result
9195 :& decodeValues (proxy# :: Proxy# pgs) results
9296
93−class ToValue x (pg :: PGType) where
97+class ToValue x pg where
9498 toValue :: Proxy# pg -> Encoder x
9599instance ToValue Int16 'PGInt2 where
96100 toValue _ = Encoder.int2_int16
squeel-postgresql/src/Squeel/PostgreSQL/PQ.hs+12−10
@@ -17,6 +17,8 @@
1717
1818module Squeel.PostgreSQL.PQ where
1919
20+import Debug.Trace
21+
2022import Control.Exception.Lifted
2123import Control.Monad.Base
2224import Control.Monad.Trans
@@ -187,28 +189,28 @@ class KnownNat n => HasColumnNumber (n :: Nat) columns column
187189 | n columns -> column where
188190 colNum :: Proxy# n -> ColumnNumber columns column
189191 colNum p = ColumnNumber . fromIntegral $ natVal' p
190−instance {-# OVERLAPPING #-} HasColumnNumber 1 (column1:columns) column1
192+instance {-# OVERLAPPING #-} HasColumnNumber 0 (column1:columns) column1
191193instance {-# OVERLAPPABLE #-}
192194 (KnownNat n, HasColumnNumber (n-1) columns column)
193195 => HasColumnNumber n (column' : columns) column
194196
195197colNum0 :: ColumnNumber (c0:cs) c0
196−colNum0 = colNum (proxy# :: Proxy# 1)
198+colNum0 = colNum (proxy# :: Proxy# 0)
197199colNum1 :: ColumnNumber (c0:c1:cs) c1
198−colNum1 = colNum (proxy# :: Proxy# 2)
200+colNum1 = colNum (proxy# :: Proxy# 1)
199201colNum2 :: ColumnNumber (c0:c1:c2:cs) c2
200−colNum2 = colNum (proxy# :: Proxy# 3)
202+colNum2 = colNum (proxy# :: Proxy# 2)
201203colNum3 :: ColumnNumber (c0:c1:c2:c3:cs) c3
202−colNum3 = colNum (proxy# :: Proxy# 4)
204+colNum3 = colNum (proxy# :: Proxy# 3)
203205colNum4 :: ColumnNumber (c0:c1:c2:c3:c4:cs) c4
204−colNum4 = colNum (proxy# :: Proxy# 5)
206+colNum4 = colNum (proxy# :: Proxy# 4)
205207
206208getvalue
207209 :: (FromValue x y, MonadBase IO io)
208− => Proxy# x
209− -> Result xs
210+ => Result xs
210211 -> RowNumber
211212 -> ColumnNumber xs x
212213 -> io (Maybe (Either Text y))
213−getvalue proxy (Result result) (RowNumber r) (ColumnNumber c) = liftBase $
214− fmap (fmap (decodeValue proxy)) (LibPQ.getvalue result r c)
214+getvalue (Result result) (RowNumber r) (ColumnNumber c :: ColumnNumber xs x) =
215+ liftBase $ fmap (fmap (decodeValue (proxy# :: Proxy# x)))
216+ (traceShowId <$> LibPQ.getvalue' result r c)
squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+6−6
@@ -69,12 +69,12 @@ data PGType
6969
7070class ToOid pg where toOid :: Proxy# pg -> LibPQ.Oid
7171--staticTypeInfo
72−instance ToOid 'PGBool where toOid _ = LibPQ.Oid 16
73−instance ToOid 'PGBytea where toOid _ = LibPQ.Oid 17
74−instance ToOid 'PGInt8 where toOid _ = LibPQ.Oid 20
75−instance ToOid 'PGInt2 where toOid _ = LibPQ.Oid 21
76−instance ToOid 'PGInt4 where toOid _ = LibPQ.Oid 23
77−instance ToOid 'PGText where toOid _ = LibPQ.Oid 26
72+instance ToOid ('NotNull 'PGBool) where toOid _ = LibPQ.Oid 16
73+instance ToOid ('NotNull 'PGBytea) where toOid _ = LibPQ.Oid 17
74+instance ToOid ('NotNull 'PGInt8) where toOid _ = LibPQ.Oid 20
75+instance ToOid ('NotNull 'PGInt2) where toOid _ = LibPQ.Oid 21
76+instance ToOid ('NotNull 'PGInt4) where toOid _ = LibPQ.Oid 23
77+instance ToOid ('NotNull 'PGText) where toOid _ = LibPQ.Oid 26
7878class ToOids pgs where toOids :: Proxy# pgs -> [LibPQ.Oid]
7979instance ToOids '[] where toOids _ = []
8080instance (ToOid pg, ToOids pgs) => ToOids (pg ': pgs) where