on dev help sign in
labels
4ed439cEitan Chatav
squeel-postgresql/src/Squeel/PostgreSQL/Query.hs+33−43
@@ -3,7 +3,9 @@
3 , FlexibleContexts
3 , FlexibleContexts
4 , FlexibleInstances
4 , FlexibleInstances
5 , GADTs
5 , GADTs
6+ , MagicHash
6 , MultiParamTypeClasses
7 , MultiParamTypeClasses
8+ , OverloadedLabels
7 , OverloadedStrings
9 , OverloadedStrings
8 , PolyKinds
10 , PolyKinds
9 , RankNTypes
11 , RankNTypes
@@ -21,10 +23,9 @@ import Data.Monoid
21import Data.Proxy
23import Data.Proxy
22import Data.String
24import Data.String
23import Data.Vinyl
25import Data.Vinyl
24−-- import Data.Vinyl.Functor
26+import GHC.OverloadedLabels
25import GHC.TypeLits
27import GHC.TypeLits
26
28
27−-- import qualified Data.ByteString as ByteString
28import qualified Data.ByteString.Char8 as Char8
29import qualified Data.ByteString.Char8 as Char8
29
30
30import Squeel.PostgreSQL.Type
31import Squeel.PostgreSQL.Type
@@ -43,45 +44,39 @@ param4 = UnsafeExpression "$4"
43param5 :: Expression (p1:p2:p3:p4:p5:ps) cols p5
44param5 :: Expression (p1:p2:p3:p4:p5:ps) cols p5
44param5 = UnsafeExpression "$5"
45param5 = UnsafeExpression "$5"
45
46
46−class HasField ident xs x where
47+class HasField label xs x where
47− fieldName :: Proxy ident -> Proxy xs -> Proxy x -> ByteString
48+ fieldName :: Proxy label -> Proxy xs -> Proxy x -> ByteString
48−instance KnownSymbol name
49+instance {-# OVERLAPPING #-} KnownSymbol label
49− => HasField '[name] ((name ':= x) ': xs) x where
50+ => HasField label ((label ':= x) ': xs) x where
50− fieldName _ _ _ = Char8.pack (symbolVal (Proxy @name))
51+ fieldName _ _ _ = Char8.pack (symbolVal (Proxy @label))
52+instance {-# OVERLAPPABLE #-} HasField label xs y
51−instance HasField ident (x ': xs) y => HasField ident (x' ': x ': xs) y where
53+ => HasField label (x ': xs) y where
52− fieldName _ _ _ = fieldName (Proxy @ident) (Proxy @(x ': xs)) (Proxy @y)
54+ fieldName _ _ _ = fieldName (Proxy @label) (Proxy @xs) (Proxy @y)
53−instance (KnownSymbol name, HasField (name' ': names) xs x)
55+
54− => HasField (name ': name' ': names) ((name ':= xs) ': xss) x where
55− fieldName _ _ _ = Char8.pack (symbolVal (Proxy @name))
56− <> "." <> fieldName (Proxy @(name' ': names)) (Proxy @xs) (Proxy @x)
57−
58−column_
59− :: forall ident xs x ps
60− . HasField ident xs x
61− => Proxy ident
62− -> Expression ps xs x
56+instance HasField label xs x => IsLabel label (Expression ps xs x) where
63−column_ (_ :: Proxy ident) = UnsafeExpression $
57+ fromLabel _ = UnsafeExpression $
64− fieldName (Proxy @ident) (Proxy @xs) (Proxy @x)
58+ fieldName (Proxy @label) (Proxy @xs) (Proxy @x)
65
59
66data Identified ident x = (:=) ident x
60data Identified ident x = (:=) ident x
61+data Alias label = Alias
67−data Aliased obj named where AS :: obj x -> Aliased obj (name ':= x)
62+data Aliased obj named where
63+ As :: obj x -> Alias name -> Aliased obj (name ':= x)
64+instance IsLabel label (Alias label) where fromLabel _ = Alias
68
65
69unalias :: Aliased obj (name ':= x) -> obj x
66unalias :: Aliased obj (name ':= x) -> obj x
70−unalias (AS obj) = obj
67+unalias (obj `As` _) = obj
71
68
72−column
73− :: forall ident xs x ps
74− . HasField '[ident] xs x
69+instance HasField label xs x =>
75− => Aliased (Expression ps xs) (ident ':= x)
70+ IsLabel label (Aliased (Expression ps xs) (label ':= x)) where
76−column = AS $ column_ (Proxy @'[ident])
71+ fromLabel p = fromLabel p `As` fromLabel p
77
72
78renderAliased
73renderAliased
79 :: KnownSymbol name
74 :: KnownSymbol name
80 => (obj x -> ByteString)
75 => (obj x -> ByteString)
81 -> Aliased obj (name ':= x)
76 -> Aliased obj (name ':= x)
82 -> ByteString
77 -> ByteString
83−renderAliased render (AS obj :: Aliased obj (name ':= x)) =
78+renderAliased render (obj `As` label) =
84− render obj <> " AS " <> Char8.pack (symbolVal (Proxy @name))
79+ render obj <> " AS " <> Char8.pack (symbolVal label)
85
80
86class AllAliased xs where
81class AllAliased xs where
87 renderAllAliased
82 renderAllAliased
@@ -154,19 +149,14 @@ project = UnsafeProjection . renderAllAliased renderExpression
154newtype Relation ps xss ys = UnsafeRelation
149newtype Relation ps xss ys = UnsafeRelation
155 { renderRelation :: ByteString }
150 { renderRelation :: ByteString }
156
151
157−table_
158− :: forall ident xss xs ps
159− . HasField ident xss xs
152+instance HasField label xss xs
160− => Proxy ident
161− -> Relation ps xss xs
153+ => IsLabel label (Relation ps xss xs) where
162−table_ (_ :: Proxy ident) = UnsafeRelation $
154+ fromLabel _ = UnsafeRelation $
163− fieldName (Proxy @ident) (Proxy @xss) (Proxy @xs)
155+ fieldName (Proxy @label) (Proxy @xss) (Proxy @xs)
164−
156+
165−table
166− :: forall ident xss xs ps
167− . HasField ident xss xs
157+instance HasField label xss xs
168− => Aliased (Relation ps xss) (ident ':= xs)
158+ => IsLabel label (Aliased (Relation ps xss) (label ':= xs)) where
169−table = AS $ table_ (Proxy @ident)
159+ fromLabel p = fromLabel p `As` fromLabel p
170
160
171data Selection ps xss xs ys = Selection
161data Selection ps xss xs ys = Selection
172 { projection :: Projection ps xs ys
162 { projection :: Projection ps xs ys