git.iko.soy/squeal
on dev help sign in
numbers
de54759Eitan Chatav
squeel-postgresql/src/Squeel/PostgreSQL/Schema.hs+12
compare with dev
unifiedsplit
@@ -18,6 +18,8 @@ module Squeel.PostgreSQL.Schema
18 , ToOid (..)
18 , ToOid (..)
19 , ToOids (..)
19 , ToOids (..)
20 , PGNum
20 , PGNum
21+ , PGFractional
22+ , PGFloating
21 , (:::)
23 , (:::)
22 , Alias (Alias)
24 , Alias (Alias)
23 , Aliased (As)
25 , Aliased (As)
@@ -87,6 +89,16 @@ instance PGNum 'PGNumeric
87instance PGNum 'PGFloat4
89instance PGNum 'PGFloat4
88instance PGNum 'PGFloat8
90instance PGNum 'PGFloat8
89
91
92+class PGNum ty => PGFractional (ty :: PGType) where
93+instance PGFractional 'PGNumeric
94+instance PGFractional 'PGFloat4
95+instance PGFractional 'PGFloat8
96+
97+class PGFractional ty => PGFloating (ty :: PGType) where
98+instance PGFloating 'PGNumeric
99+instance PGFloating 'PGFloat4
100+instance PGFloating 'PGFloat8
101+
90type (:::) (alias :: Symbol) (ty :: polykind) = '(alias,ty)
102type (:::) (alias :: Symbol) (ty :: polykind) = '(alias,ty)
91
103
92data Alias (alias :: Symbol) = Alias (Proxy# alias)
104data Alias (alias :: Symbol) = Alias (Proxy# alias)
squeel-postgresql/src/Squeel/PostgreSQL/Statement.hs+99−8
@@ -16,15 +16,17 @@ module Squeel.PostgreSQL.Statement where
16
16
17import Control.Category
17import Control.Category
18import Data.Boolean
18import Data.Boolean
19+import Data.Boolean.Numbers
19import Data.ByteString (ByteString)
20import Data.ByteString (ByteString)
20import Data.Maybe
21import Data.Maybe
21import Data.Monoid
22import Data.Monoid
23+import Data.Ratio
22import Data.String
24import Data.String
23import Generics.SOP
25import Generics.SOP
24import GHC.Exts
26import GHC.Exts
25import GHC.OverloadedLabels
27import GHC.OverloadedLabels
26import GHC.TypeLits
28import GHC.TypeLits
27−import Prelude hiding (id,(.))
29+import Prelude hiding (id,(.),RealFrac(..))
28
30
29import qualified Data.ByteString as ByteString
31import qualified Data.ByteString as ByteString
30
32
@@ -124,13 +126,94 @@ unsafeFunction
124unsafeFunction fun x = UnsafeExpression $ mconcat
126unsafeFunction fun x = UnsafeExpression $ mconcat
125 [fun, "(", renderExpression x, ")"]
127 [fun, "(", renderExpression x, ")"]
126
128
129+instance PGNum ty
127−instance PGNum ty => Num (Expression params tables ('Required (nullity ty))) where
130+ => Num (Expression params tables ('Required (nullity ty))) where
128− (+) = unsafeBinaryOp "+"
131+ (+) = unsafeBinaryOp "+"
129− (-) = unsafeBinaryOp "-"
132+ (-) = unsafeBinaryOp "-"
130− (*) = unsafeBinaryOp "*"
133+ (*) = unsafeBinaryOp "*"
131− abs = unsafeUnaryOp "@"
134+ abs = unsafeFunction "abs"
132− signum = unsafeFunction "sign"
135+ signum = unsafeFunction "sign"
133− fromInteger = UnsafeExpression . fromString . show
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"
134
217
135instance IsString (Expression params tables ('Required (nullity 'PGText))) where
218instance IsString (Expression params tables ('Required (nullity 'PGText))) where
136 fromString str = UnsafeExpression $
219 fromString str = UnsafeExpression $
@@ -490,6 +573,14 @@ default_ x ty = UnsafeTypeExpression $
490serial :: TypeExpression ('Optional ('NotNull 'PGInt4))
573serial :: TypeExpression ('Optional ('NotNull 'PGInt4))
491serial = UnsafeTypeExpression "serial"
574serial = UnsafeTypeExpression "serial"
492
575
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+
493createTable
584createTable
494 :: (KnownSymbol table, SListI columns)
585 :: (KnownSymbol table, SListI columns)
495 => Alias table
586 => Alias table