git.iko.soy/squeal
on dev help sign in
query second try
7985cb1Eitan Chatav
squeel-postgresql/squeel-postgresql.cabal+2
compare with dev
unifiedsplit
@@ -16,12 +16,14 @@ library
16 Squeel.PostgreSQL
16 Squeel.PostgreSQL
17 Squeel.PostgreSQL.PQ
17 Squeel.PostgreSQL.PQ
18 Squeel.PostgreSQL.Query
18 Squeel.PostgreSQL.Query
19+ Squeel.PostgreSQL.Query2
19 Squeel.PostgreSQL.Type
20 Squeel.PostgreSQL.Type
20 Squeel.PostgreSQL.Value
21 Squeel.PostgreSQL.Value
21 default-language: Haskell2010
22 default-language: Haskell2010
22 ghc-options: -Wall -Werror
23 ghc-options: -Wall -Werror
23 build-depends: base
24 build-depends: base
24 , aeson
25 , aeson
26+ , Boolean
25 , bytestring
27 , bytestring
26 , lifted-base
28 , lifted-base
27 , monad-control
29 , monad-control
squeel-postgresql/src/Squeel/PostgreSQL/Query2.hsnew file+111
@@ -0,0 +1,111 @@
1+{-# LANGUAGE
2+ DataKinds
3+ , FlexibleInstances
4+ , GADTs
5+ , MultiParamTypeClasses
6+ , OverloadedStrings
7+ , PolyKinds
8+ , ScopedTypeVariables
9+ , TypeApplications
10+ , TypeFamilies
11+ , TypeOperators
12+#-}
13+
14+module Squeel.PostgreSQL.Query2 where
15+
16+import Data.Boolean
17+import Data.ByteString
18+import Data.Monoid
19+import Data.Proxy
20+import Data.String
21+import GHC.TypeLits
22+
23+import qualified Data.ByteString.Char8 as Char8
24+
25+import Squeel.PostgreSQL.Type
26+
27+newtype Expression ps xs x =
28+ UnsafeExpression { renderExpression :: ByteString }
29+
30+param1 :: Expression (p1:ps) cols p1
31+param1 = UnsafeExpression "$1"
32+param2 :: Expression (p1:p2:ps) cols p2
33+param2 = UnsafeExpression "$2"
34+param3 :: Expression (p1:p2:p3:ps) cols p3
35+param3 = UnsafeExpression "$3"
36+param4 :: Expression (p1:p2:p3:p4:ps) cols p4
37+param4 = UnsafeExpression "$4"
38+param5 :: Expression (p1:p2:p3:p4:p5:ps) cols p5
39+param5 = UnsafeExpression "$5"
40+
41+class HasField ident xs x where
42+ fieldName :: Proxy ident -> Proxy xs -> Proxy x -> ByteString
43+instance KnownSymbol name => HasField '[name] ((name ':= x) ': xs) x where
44+ fieldName _ _ _ = Char8.pack (symbolVal (Proxy @name))
45+instance HasField ident xs x => HasField ident (y ': xs) x where
46+ fieldName _ _ _ = fieldName (Proxy @ident) (Proxy @xs) (Proxy @x)
47+instance (KnownSymbol name, HasField names xs x)
48+ => HasField (name ': names) ((name ':= xs) ': xss) x where
49+ fieldName _ _ _ = Char8.pack (symbolVal (Proxy @name))
50+ <> "." <> fieldName (Proxy @names) (Proxy @xs) (Proxy @x)
51+
52+field
53+ :: forall ident xs x ps
54+ . HasField ident xs x
55+ => Proxy ident
56+ -> Expression ps xs x
57+field (_ :: Proxy ident) = UnsafeExpression $
58+ fieldName (Proxy @ident) (Proxy @xs) (Proxy @x)
59+
60+data Aliased obj named where
61+ AS :: obj x -> Aliased obj (name ':= x)
62+
63+unalias :: Aliased obj (name ':= x) -> obj x
64+unalias (AS obj) = obj
65+
66+fieldAs
67+ :: forall ident xs x ps
68+ . HasField ident xs x
69+ => Aliased (Expression ps xs) (ident ':= x)
70+fieldAs = AS $ field (Proxy @ident)
71+
72+instance IsString (Expression ps xs 'PGText) where
73+ fromString str = UnsafeExpression $ "\'" <> fromString str <> "\'"
74+
75+instance Num (Expression ps xs 'PGInt4) where
76+ fromInteger n = UnsafeExpression . fromString $ show n
77+ UnsafeExpression x + UnsafeExpression y = UnsafeExpression $ x <> "+" <> y
78+ UnsafeExpression x * UnsafeExpression y = UnsafeExpression $ x <> "*" <> y
79+ UnsafeExpression x - UnsafeExpression y = UnsafeExpression $ x <> "+" <> y
80+ abs (UnsafeExpression x) = UnsafeExpression $ "@" <> x
81+ signum (UnsafeExpression x) = UnsafeExpression $ "sign(" <> x <> ")"
82+
83+instance Boolean (Expression ps xs 'PGBool) where
84+ true = UnsafeExpression "TRUE"
85+ false = UnsafeExpression "FALSE"
86+ notB x = UnsafeExpression $ " NOT " <> renderExpression x
87+ x &&* y = UnsafeExpression $
88+ renderExpression x <> " AND " <> renderExpression y
89+ x ||* y = UnsafeExpression $
90+ renderExpression x <> " OR " <> renderExpression y
91+
92+type instance BooleanOf (Expression ps xs x) = Expression ps xs 'PGBool
93+
94+instance IfB (Expression ps xs x) where
95+ ifB predicate then_ else_ = UnsafeExpression $ mconcat
96+ [ "CASE\n"
97+ , "\n WHEN ",renderExpression predicate
98+ , "\n THEN ",renderExpression then_
99+ , "\n ELSE ",renderExpression else_
100+ , "\nEND"
101+ ]
102+
103+instance EqB (Expression ps xs x) where
104+ x ==* y = UnsafeExpression $ renderExpression x <> "=" <> renderExpression y
105+ x /=* y = UnsafeExpression $ renderExpression x <> "<>" <> renderExpression y
106+
107+instance OrdB (Expression ps xs x) where
108+ x >* y = UnsafeExpression $ renderExpression x <> ">" <> renderExpression y
109+ x >=* y = UnsafeExpression $ renderExpression x <> ">=" <> renderExpression y
110+ x <* y = UnsafeExpression $ renderExpression x <> "<" <> renderExpression y
111+ x <=* y = UnsafeExpression $ renderExpression x <> "<=" <> renderExpression y
squeel-postgresql/src/Squeel/PostgreSQL/Type.hs−15
@@ -45,21 +45,6 @@ data Named k = (:=) Symbol k
45type family Unnamed named where Unnamed (name ':= x) = x
45type family Unnamed named where Unnamed (name ':= x) = x
46type family Name k where Name (name ':= x) = name
46type family Name k where Name (name ':= x) = name
47
47
48−type family Field1 xs name x where
49− Field1 '[] name x = 'False
50− Field1 ((name ':= x) ': xs) name x = 'True
51− Field1 (y ': xs) name x = Field1 xs name x
52−
53−type family Field2 xss names x where
54− Field2 '[] names x = 'False
55− Field2 ((name ':= xs) ': xss) '[name,name1] x = Field1 xs name x
56− Field2 (y ': xss) names x = Field2 xss names x
57−
58−type family Field3 xsss names x where
59− Field3 '[] names x = 'False
60− Field3 ((name ':= xss) ': xsss) (name ': names) x = Field2 xss names x
61− Field3 (y ': xss) names x = Field3 xss names x
62−
63type Column = Named PGType
48type Column = Named PGType
64type Table = Named [Column]
49type Table = Named [Column]
65type Database = Named [Table]
50type Database = Named [Table]