git.iko.soy/squeal
on dev help sign in
expressions
commitc6b24cad2d0a3935a6c6b577b15e5b8e1db9011e authorEitan Chatav <eitan.chatav@gmail.com> dateSat 11 Mar 2017, 17:47 (10 years ago) parent8679175
6 files changed+168−11
compare with dev
unifiedsplit
squeel-postgresql/squeel-postgresql.cabal+1 squeel-postgresql/src/Squeel/PostgreSQL/Connection.hs−10 squeel-postgresql/src/Squeel/PostgreSQL/Query.hs+1−1 squeel-postgresql/src/Squeel/PostgreSQL/Query/Expression.hs+115 squeel-postgresql/src/Squeel/PostgreSQL/Query/Relation.hs+14 squeel-postgresql/src/Squeel/PostgreSQL/Type.hs+37
squeel-postgresql/squeel-postgresql.cabal+1
@@ -31,6 +31,7 @@ library
3131 , text
3232 , time
3333 , uuid
34+ , vinyl
3435
3536test-suite blockapps-data-test
3637 default-language: Haskell2010
squeel-postgresql/src/Squeel/PostgreSQL/Connection.hs−10
@@ -4,19 +4,9 @@
44
55module Squeel.PostgreSQL.Connection where
66
7−import Control.Monad.IO.Class
87import qualified Database.PostgreSQL.LibPQ as LibPQ
98
10−import Squeel.PostgreSQL.Query
11−import Squeel.PostgreSQL.Value
12−
139newtype Connection db = Connection LibPQ.Connection
1410
1511newtype PQ m db0 db1 x = PQ
1612 { runPQ :: Connection db0 -> m (x, Connection db1) }
17−
18−exec
19− :: (MonadIO io, Row xs x)
20− => Query db0 db1 '[] xs
21− -> PQ io db0 db1 [x]
22−exec = undefined
squeel-postgresql/src/Squeel/PostgreSQL/Query.hs+1−1
@@ -6,4 +6,4 @@ module Squeel.PostgreSQL.Query where
66
77import Data.ByteString (ByteString)
88
9−newtype Query db0 db1 ps xs = Query { unQuery :: ByteString }
9+newtype Query db0 db1 ps x = Query { unQuery :: ByteString }
squeel-postgresql/src/Squeel/PostgreSQL/Query/Expression.hs+115
@@ -1 +1,116 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , FlexibleInstances
4+ , GADTs
5+ , LambdaCase
6+ , OverloadedStrings
7+ , PolyKinds
8+ , RankNTypes
9+ , ScopedTypeVariables
10+ , TypeApplications
11+ , TypeOperators
12+#-}
13+
114module Squeel.PostgreSQL.Query.Expression where
15+
16+import Data.ByteString (ByteString)
17+import Data.Monoid
18+import Data.Proxy
19+import Data.String
20+
21+import qualified PostgreSQL.Binary.Encoder as Encoder
22+
23+import Squeel.PostgreSQL.Value
24+import Squeel.PostgreSQL.Type
25+
26+data Expression (ps :: [PGType]) (cols :: [Column]) (x :: PGType) =
27+ Expression { unExpression :: ByteString } deriving Show
28+
29+param1 :: Expression (p1:ps) cols p1
30+param1 = Expression "$1"
31+
32+param2 :: Expression (p1:p2:ps) cols p2
33+param2 = Expression "$2"
34+
35+param3 :: Expression (p1:p2:p3:ps) cols p3
36+param3 = Expression "$3"
37+
38+param4 :: Expression (p1:p2:p3:p4:ps) cols p4
39+param4 = Expression "$4"
40+
41+param5 :: Expression (p1:p2:p3:p4:p5:ps) cols p5
42+param5 = Expression "$5"
43+
44+whenThen :: (Expression ps cols x,Expression ps cols y) -> ByteString
45+whenThen (Expression when_,Expression then_) = mconcat
46+ [" WHEN ",when_," THEN ",then_,"\n"]
47+
48+case_
49+ :: [(Expression ps cols ('PGType "bool"),Expression ps cols x)]
50+ -> Expression ps cols x
51+ -> Expression ps cols x
52+case_ whens (Expression else_) = Expression $ mconcat
53+ [ "CASE\n"
54+ , mconcat (map whenThen whens)
55+ , " ELSE ",else_
56+ , "\nEND"
57+ ]
58+
59+caseSwitch
60+ :: Expression ps cols x
61+ -> [(Expression ps cols x,Expression ps cols y)]
62+ -> Expression ps cols y
63+ -> Expression ps cols y
64+caseSwitch (Expression val) whens (Expression else_) = Expression $ mconcat
65+ [ "CASE ",val,"\n"
66+ , mconcat (map whenThen whens)
67+ , " ELSE ",else_
68+ ,"\nEND"
69+ ]
70+
71+(.==)
72+ :: Expression ps cols x
73+ -> Expression ps cols x
74+ -> Expression ps cols ('PGType "bool")
75+(.==) (Expression x1) (Expression x2) = Expression $ x1 <> "=" <> x2
76+
77+(./=)
78+ :: Expression ps cols x
79+ -> Expression ps cols x
80+ -> Expression ps cols ('PGType "bool")
81+(./=) (Expression x1) (Expression x2) = Expression $ x1 <> "<>" <> x2
82+
83+(.>)
84+ :: Expression ps cols x
85+ -> Expression ps cols x
86+ -> Expression ps cols ('PGType "bool")
87+(.>) (Expression x1) (Expression x2) = Expression $ x1 <> ">" <> x2
88+
89+(.<)
90+ :: Expression ps cols x
91+ -> Expression ps cols x
92+ -> Expression ps cols ('PGType "bool")
93+(.<) (Expression x1) (Expression x2) = Expression $ x1 <> "<" <> x2
94+
95+(.>=)
96+ :: Expression ps cols x
97+ -> Expression ps cols x
98+ -> Expression ps cols ('PGType "bool")
99+(.>=) (Expression x1) (Expression x2) = Expression $ x1 <> ">=" <> x2
100+
101+(.<=)
102+ :: Expression ps cols x
103+ -> Expression ps cols x
104+ -> Expression ps cols ('PGType "bool")
105+(.<=) (Expression x1) (Expression x2) = Expression $ x1 <> "<=" <> x2
106+
107+instance IsString (Expression ps cols ('PGType "text")) where
108+ fromString str = Expression $ "\'" <> fromString str <> "\'"
109+
110+instance Num (Expression ps cols ('PGType "int4")) where
111+ fromInteger n = Expression . fromString $ show n
112+ Expression x + Expression y = Expression $ x <> "+" <> y
113+ Expression x * Expression y = Expression $ x <> "*" <> y
114+ Expression x - Expression y = Expression $ x <> "+" <> y
115+ abs (Expression x) = Expression $ "@" <> x
116+ signum (Expression x) = Expression $ "sign(" <> x <> ")"
squeel-postgresql/src/Squeel/PostgreSQL/Query/Relation.hs+14
@@ -1 +1,15 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , GADTs
4+ , KindSignatures
5+ , RankNTypes
6+#-}
7+
18module Squeel.PostgreSQL.Query.Relation where
9+
10+import Data.ByteString (ByteString)
11+
12+import Squeel.PostgreSQL.Type
13+
14+data Relation (ps::[PGType]) (xs::[Column]) (ys::[Column]) =
15+ Relation { unRelation :: ByteString }
squeel-postgresql/src/Squeel/PostgreSQL/Type.hs+37
@@ -1,5 +1,42 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , TypeFamilies
4+ , TypeOperators
5+#-}
6+
17module Squeel.PostgreSQL.Type where
28
39import GHC.TypeLits
410
511newtype PGType = PGType Symbol
12+data Column = Column Symbol PGType
13+data Table = Table Symbol [Column]
14+data Database = Database Symbol [Table]
15+data Schema = Schema Symbol [Database]
16+
17+type family HasColumn table column where
18+ HasColumn ('Table table '[]) column = 'False
19+ HasColumn ('Table table (column ': columns)) column = 'True
20+ HasColumn ('Table table (column ': columns)) column'
21+ = HasColumn ('Table table columns) column'
22+
23+type family HasTable database table where
24+ HasTable ('Database database '[]) table = 'False
25+ HasTable ('Database database (table ': tables)) table = 'True
26+ HasTable ('Database database (table ': tables)) table'
27+ = HasTable ('Database database tables) table'
28+
29+type family HasDatabase schema database where
30+ HasDatabase ('Schema schema '[]) database = 'False
31+ HasDatabase ('Schema schema (database ': databases)) database = 'True
32+ HasDatabase ('Schema schema (database ': databases)) database'
33+ = HasDatabase ('Schema schema databases) database'
34+
35+type family TableColumns table where
36+ TableColumns ('Table table columns) = columns
37+
38+type family DatabaseTables database where
39+ DatabaseTables ('Database database tables) = tables
40+
41+type family SchemaDatabases schema where
42+ SchemaDatabases ('Schema schema databases) = databases