@@ -16,15 +16,17 @@ module Squeel.PostgreSQL.Statement where
1616
1717import Control.Category
1818import Data.Boolean
19+import Data.Boolean.Numbers
1920import Data.ByteString (ByteString)
2021import Data.Maybe
2122import Data.Monoid
23+import Data.Ratio
2224import Data.String
2325import Generics.SOP
2426import GHC.Exts
2527import GHC.OverloadedLabels
2628import GHC.TypeLits
27−import Prelude hiding (id,(.))
29+import Prelude hiding (id,(.),RealFrac(..))
2830
2931import qualified Data.ByteString as ByteString
3032
@@ -124,13 +126,94 @@ unsafeFunction
124126unsafeFunction fun x = UnsafeExpression $ mconcat
125127 [fun, "(", renderExpression x, ")"]
126128
127−instance PGNum ty => Num (Expression params tables ('Required (nullity ty))) where
128− (+) = unsafeBinaryOp "+"
129− (-) = unsafeBinaryOp "-"
130− (*) = unsafeBinaryOp "*"
131− abs = unsafeUnaryOp "@"
132− signum = unsafeFunction "sign"
133− fromInteger = UnsafeExpression . fromString . show
129+instance PGNum ty
130+ => Num (Expression params tables ('Required (nullity ty))) where
131+ (+) = unsafeBinaryOp "+"
132+ (-) = unsafeBinaryOp "-"
133+ (*) = unsafeBinaryOp "*"
134+ abs = unsafeFunction "abs"
135+ signum = unsafeFunction "sign"
136+ fromInteger = UnsafeExpression . fromString . show
137+
138+instance PGFractional ty
139+ => Fractional (Expression params tables ('Required (nullity ty))) where
140+ (/) = unsafeBinaryOp "/"
141+ fromRational x = UnsafeExpression $ mconcat
142+ [ fromString (show (numerator x))
143+ , "/"
144+ , fromString (show (denominator x))
145+ ]
146+
147+instance (PGFloating ty, PGCast 'PGNumeric ty, PGTyped ty)
148+ => Floating (Expression params tables ('Required (nullity ty))) where
149+ pi = UnsafeExpression "pi()"
150+ exp = unsafeFunction "exp"
151+ log = unsafeFunction "ln"
152+ sqrt = unsafeFunction "sqrt"
153+ b ** x = UnsafeExpression $
154+ "power(" <> renderExpression b <> ", " <> renderExpression x <> ")"
155+ logBase b y = cast pgtype $ logBaseNumeric b y
156+ where
157+ logBaseNumeric
158+ :: Expression params tables ('Required (nullity ty))
159+ -> Expression params tables ('Required (nullity ty))
160+ -> Expression params tables ('Required (nullity 'PGNumeric))
161+ logBaseNumeric b' y' = UnsafeExpression $ mconcat
162+ [ "log("
163+ , renderExpression b' <> "::numeric"
164+ , ", "
165+ , renderExpression y' <> "::numeric"
166+ , ")"
167+ ]
168+ sin = unsafeFunction "sin"
169+ cos = unsafeFunction "cos"
170+ tan = unsafeFunction "tan"
171+ asin = unsafeFunction "asin"
172+ acos = unsafeFunction "acos"
173+ atan = unsafeFunction "atan"
174+ sinh x = (exp x - exp (-x)) / 2
175+ cosh x = (exp x + exp (-x)) / 2
176+ tanh x = sinh x / cosh x
177+ asinh x = log (x + sqrt (x*x + 1))
178+ acosh x = log (x + sqrt (x*x - 1))
179+ atanh x = log ((1 + x) / (1 - x)) / 2
180+
181+class PGCast (ty0 :: PGType) (ty1 :: PGType) where
182+ cast
183+ :: TypeExpression ('Required ('Null ty1))
184+ -> Expression params tables ('Required (nullity ty0))
185+ -> Expression params tables ('Required (nullity ty1))
186+ cast ty x = UnsafeExpression $
187+ "(" <> renderExpression x <> "::" <> renderTypeExpression ty <> ")"
188+
189+instance (PGNum ty, PGTyped ty, PGCast 'PGInt8 ty)
190+ => NumB (Expression params tables ('Required (nullity ty))) where
191+ type IntegerOf (Expression params tables ('Required (nullity ty)))
192+ = (Expression params tables ('Required (nullity 'PGInt8)))
193+ fromIntegerB = cast pgtype
194+
195+instance (PGNum ty, PGTyped ty, PGCast 'PGInt8 ty, PGCast ty 'PGInt8)
196+ => IntegralB (Expression params tables ('Required ('NotNull ty))) where
197+ quot = unsafeBinaryOp "/"
198+ rem = unsafeBinaryOp "%"
199+ div = unsafeBinaryOp "/"
200+ mod = unsafeBinaryOp "%"
201+ toIntegerB = cast int8
202+
203+instance
204+ ( IntegerOf (Expression params tables ('Required ('NotNull ty)))
205+ ~ (Expression params tables ('Required ('NotNull 'PGInt8)))
206+ , PGNum ty
207+ , PGTyped ty
208+ , PGCast 'PGInt8 ty
209+ , PGFractional ty
210+ )
211+ => RealFracB (Expression params tables ('Required ('NotNull ty))) where
212+ properFraction x = (truncate x, x - unsafeFunction "trunc" x)
213+ truncate = fromIntegerB . unsafeFunction "trunc"
214+ round = fromIntegerB . unsafeFunction "round"
215+ ceiling = fromIntegerB . unsafeFunction "ceiling"
216+ floor = fromIntegerB . unsafeFunction "floor"
134217
135218instance IsString (Expression params tables ('Required (nullity 'PGText))) where
136219 fromString str = UnsafeExpression $
@@ -490,6 +573,14 @@ default_ x ty = UnsafeTypeExpression $
490573serial :: TypeExpression ('Optional ('NotNull 'PGInt4))
491574serial = UnsafeTypeExpression "serial"
492575
576+class PGTyped (ty :: PGType) where
577+ pgtype :: TypeExpression ('Required ('Null ty))
578+instance PGTyped 'PGInt2 where pgtype = int2
579+instance PGTyped 'PGInt4 where pgtype = int4
580+instance PGTyped 'PGInt8 where pgtype = int8
581+instance PGTyped 'PGBool where pgtype = bool
582+instance PGTyped 'PGText where pgtype = text
583+
493584createTable
494585 :: (KnownSymbol table, SListI columns)
495586 => Alias table