@@ -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