@@ -3,7 +3,9 @@
33 , FlexibleContexts
44 , FlexibleInstances
55 , GADTs
6+ , MagicHash
67 , MultiParamTypeClasses
8+ , OverloadedLabels
79 , OverloadedStrings
810 , PolyKinds
911 , RankNTypes
@@ -21,10 +23,9 @@ import Data.Monoid
2123import Data.Proxy
2224import Data.String
2325import Data.Vinyl
24−-- import Data.Vinyl.Functor
26+import GHC.OverloadedLabels
2527import GHC.TypeLits
2628
27−-- import qualified Data.ByteString as ByteString
2829import qualified Data.ByteString.Char8 as Char8
2930
3031import Squeel.PostgreSQL.Type
@@ -43,45 +44,39 @@ param4 = UnsafeExpression "$4"
4344param5 :: Expression (p1:p2:p3:p4:p5:ps) cols p5
4445param5 = UnsafeExpression "$5"
4546
46−class HasField ident xs x where
47− fieldName :: Proxy ident -> Proxy xs -> Proxy x -> ByteString
48−instance KnownSymbol name
49− => HasField '[name] ((name ':= x) ': xs) x where
50− fieldName _ _ _ = Char8.pack (symbolVal (Proxy @name))
51−instance HasField ident (x ': xs) y => HasField ident (x' ': x ': xs) y where
52− fieldName _ _ _ = fieldName (Proxy @ident) (Proxy @(x ': xs)) (Proxy @y)
53−instance (KnownSymbol name, HasField (name' ': names) xs x)
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
63−column_ (_ :: Proxy ident) = UnsafeExpression $
64− fieldName (Proxy @ident) (Proxy @xs) (Proxy @x)
47+class HasField label xs x where
48+ fieldName :: Proxy label -> Proxy xs -> Proxy x -> ByteString
49+instance {-# OVERLAPPING #-} KnownSymbol label
50+ => HasField label ((label ':= x) ': xs) x where
51+ fieldName _ _ _ = Char8.pack (symbolVal (Proxy @label))
52+instance {-# OVERLAPPABLE #-} HasField label xs y
53+ => HasField label (x ': xs) y where
54+ fieldName _ _ _ = fieldName (Proxy @label) (Proxy @xs) (Proxy @y)
55+
56+instance HasField label xs x => IsLabel label (Expression ps xs x) where
57+ fromLabel _ = UnsafeExpression $
58+ fieldName (Proxy @label) (Proxy @xs) (Proxy @x)
6559
6660data Identified ident x = (:=) ident x
67−data Aliased obj named where AS :: obj x -> Aliased obj (name ':= x)
61+data Alias label = Alias
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
6865
6966unalias :: Aliased obj (name ':= x) -> obj x
70−unalias (AS obj) = obj
67+unalias (obj `As` _) = obj
7168
72−column
73− :: forall ident xs x ps
74− . HasField '[ident] xs x
75− => Aliased (Expression ps xs) (ident ':= x)
76−column = AS $ column_ (Proxy @'[ident])
69+instance HasField label xs x =>
70+ IsLabel label (Aliased (Expression ps xs) (label ':= x)) where
71+ fromLabel p = fromLabel p `As` fromLabel p
7772
7873renderAliased
7974 :: KnownSymbol name
8075 => (obj x -> ByteString)
8176 -> Aliased obj (name ':= x)
8277 -> ByteString
83−renderAliased render (AS obj :: Aliased obj (name ':= x)) =
84− render obj <> " AS " <> Char8.pack (symbolVal (Proxy @name))
78+renderAliased render (obj `As` label) =
79+ render obj <> " AS " <> Char8.pack (symbolVal label)
8580
8681class AllAliased xs where
8782 renderAllAliased
@@ -154,19 +149,14 @@ project = UnsafeProjection . renderAllAliased renderExpression
154149newtype Relation ps xss ys = UnsafeRelation
155150 { renderRelation :: ByteString }
156151
157−table_
158− :: forall ident xss xs ps
159− . HasField ident xss xs
160− => Proxy ident
161− -> Relation ps xss xs
162−table_ (_ :: Proxy ident) = UnsafeRelation $
163− fieldName (Proxy @ident) (Proxy @xss) (Proxy @xs)
164−
165−table
166− :: forall ident xss xs ps
167− . HasField ident xss xs
168− => Aliased (Relation ps xss) (ident ':= xs)
169−table = AS $ table_ (Proxy @ident)
152+instance HasField label xss xs
153+ => IsLabel label (Relation ps xss xs) where
154+ fromLabel _ = UnsafeRelation $
155+ fieldName (Proxy @label) (Proxy @xss) (Proxy @xs)
156+
157+instance HasField label xss xs
158+ => IsLabel label (Aliased (Relation ps xss) (label ':= xs)) where
159+ fromLabel p = fromLabel p `As` fromLabel p
170160
171161data Selection ps xss xs ys = Selection
172162 { projection :: Projection ps xs ys