b11f955 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

Range module

b11f955Eitan Chatav7 years ago

squeal-postgresql/squeal-postgresql.cabal+1

compare with dev

unifiedsplit

@@ -35,6 +35,7 @@ library

35 Squeal.PostgreSQL.Expression.Math

36 Squeal.PostgreSQL.Expression.Null

37 Squeal.PostgreSQL.Expression.Parameter

38+ Squeal.PostgreSQL.Expression.Range

38 Squeal.PostgreSQL.Expression.SetOf

39 Squeal.PostgreSQL.Expression.SetOf

39 Squeal.PostgreSQL.Expression.Sort

40 Squeal.PostgreSQL.Expression.Sort

40 Squeal.PostgreSQL.Expression.Subquery

41 Squeal.PostgreSQL.Expression.Subquery

squeal-postgresql/src/Squeal/PostgreSQL.hs+1

@@ -205,6 +205,7 @@ import Squeal.PostgreSQL.Expression.Logic as X

205import Squeal.PostgreSQL.Expression.Math as X

206import Squeal.PostgreSQL.Expression.Null as X

207import Squeal.PostgreSQL.Expression.Parameter as X

208+import Squeal.PostgreSQL.Expression.Range as X

208import Squeal.PostgreSQL.Expression.SetOf as X

209import Squeal.PostgreSQL.Expression.SetOf as X

209import Squeal.PostgreSQL.Expression.Sort as X

210import Squeal.PostgreSQL.Expression.Sort as X

210import Squeal.PostgreSQL.Expression.Subquery as X

211import Squeal.PostgreSQL.Expression.Subquery as X

squeal-postgresql/src/Squeal/PostgreSQL/Expression/Collection.hs−16

@@ -33,10 +33,8 @@ module Squeal.PostgreSQL.Expression.Collection

33 , unnest

34 , row

35 , field

36− , range

37 ) where

36 ) where

39−import Data.Bool

40import Data.String

38import Data.String

41import Data.Word (Word64)

39import Data.Word (Word64)

@@ -46,7 +44,6 @@ import Squeal.PostgreSQL.Alias

46import Squeal.PostgreSQL.Expression

44import Squeal.PostgreSQL.Expression

47import Squeal.PostgreSQL.Expression.SetOf

45import Squeal.PostgreSQL.Expression.SetOf

48import Squeal.PostgreSQL.List

46import Squeal.PostgreSQL.List

49−import Squeal.PostgreSQL.PG

50import Squeal.PostgreSQL.Render

47import Squeal.PostgreSQL.Render

51import Squeal.PostgreSQL.Schema

48import Squeal.PostgreSQL.Schema

@@ -170,16 +167,3 @@ field

170field td fld expr = UnsafeExpression $

167field td fld expr = UnsafeExpression $

171 parenthesized (renderSQL expr <> "::" <> renderSQL td)

168 parenthesized (renderSQL expr <> "::" <> renderSQL td)

172 <> "." <> renderSQL fld

169 <> "." <> renderSQL fld

173−

174−-- | >>> printSQL $ range (Closed (Just now)) (Open Nothing)

175−-- [now(), )

176−range

177− :: Bound (Expression outer commons grp schemas params from ('NotNull ty))

178− -> Bound (Expression outer commons grp schemas params from ('NotNull ty))

179− -> Expression outer commons grp schemas params from (null ('PGrange ty))

180−range l u = UnsafeExpression $ commaSeparated [renderLower l, renderUpper u]

181− where

182− renderLower (Bound isClosed x) =

183− bool "(" "[" isClosed <> maybe "" renderSQL x

184− renderUpper (Bound isClosed x) =

185− maybe "" renderSQL x <> bool ")" "]" isClosed

squeal-postgresql/src/Squeal/PostgreSQL/Expression/Range.hsnew file+106

@@ -0,0 +1,106 @@

1+{-|

2+Module: Squeal.PostgreSQL.Expression.Range

3+Description: range types and functions

4+Copyright: (c) Eitan Chatav, 2019

5+Maintainer: eitan@morphism.tech

6+Stability: experimental

8+Range types and functions

9+-}

10+

11+{-# LANGUAGE

12+ AllowAmbiguousTypes

13+ , DataKinds

14+ , DeriveAnyClass

15+ , DeriveGeneric

16+ , DeriveFoldable

17+ , DerivingStrategies

18+ , DeriveTraversable

19+ , FlexibleContexts

20+ , FlexibleInstances

21+ , LambdaCase

22+ , MultiParamTypeClasses

23+ , OverloadedLabels

24+ , OverloadedStrings

25+ , PatternSynonyms

26+ , RankNTypes

27+ , ScopedTypeVariables

28+ , TypeApplications

29+ , TypeFamilies

30+ , TypeOperators

31+ , UndecidableInstances

32+#-}

33+

34+module Squeal.PostgreSQL.Expression.Range

35+ ( range

36+ , Range (..)

37+ , (<=..<=), (<..<), (<=..<), (<..<=)

38+ , pattern HalfGT, pattern HalfGTE

39+ , pattern HalfLT, pattern HalfLTE

40+ , Bound (..)

41+ , pattern Closed, pattern Open

42+ ) where

43+

44+import Data.Bool

45+

46+import qualified GHC.Generics as GHC

47+import qualified Generics.SOP as SOP

48+

49+import Squeal.PostgreSQL.Expression

50+import Squeal.PostgreSQL.PG

51+import Squeal.PostgreSQL.Render

52+import Squeal.PostgreSQL.Schema

53+

54+-- $setup

55+-- >>> import Squeal.PostgreSQL

56+

57+-- | >>> printSQL $ range (HalfGTE now)

58+-- [now(), )

59+-- >>> printSQL $ range (0 <..<= (pi & astype numeric))

60+-- (0, (pi() :: numeric)]

61+range

62+ :: Range (Expression outer commons grp schemas params from ('NotNull ty))

63+ -> Expression outer commons grp schemas params from (null ('PGrange ty))

64+range = UnsafeExpression . renderSQL

65+

66+data Bound x = Bound

67+ { closedBound :: Bool

68+ , getBound :: Maybe x

69+ } deriving

70+ ( Eq, Ord, Show, Read, GHC.Generic

71+ , Functor, Foldable, Traversable )

72+ deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)

73+pattern Closed, Open :: Maybe x -> Bound x

74+pattern Closed x = Bound True x

75+pattern Open x = Bound False x

76+

77+data Range x

78+ = Empty

79+ | NonEmpty (Bound x) (Bound x)

80+ deriving

81+ ( Eq, Ord, Show, Read, GHC.Generic

82+ , Functor, Foldable, Traversable )

83+ deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)

84+type instance PG (Range x) = 'PGrange (PG x)

85+

86+instance RenderSQL x => RenderSQL (Range x) where

87+ renderSQL = \case

88+ Empty -> "empty"

89+ NonEmpty l u -> commaSeparated [renderLower l, renderUpper u]

90+ where

91+ renderLower (Bound isClosed x) =

92+ bool "(" "[" isClosed <> maybe "" renderSQL x

93+ renderUpper (Bound isClosed x) =

94+ maybe "" renderSQL x <> bool ")" "]" isClosed

95+

96+(<=..<=), (<..<), (<=..<), (<..<=) :: x -> x -> Range x

97+x <=..<= y = NonEmpty (Closed (Just x)) (Closed (Just y))

98+x <..< y = NonEmpty (Open (Just x)) (Open (Just y))

99+x <=..< y = NonEmpty (Closed (Just x)) (Open (Just y))

100+x <..<= y = NonEmpty (Open (Just x)) (Closed (Just y))

101+

102+pattern HalfGT, HalfGTE, HalfLT, HalfLTE :: x -> Range x

103+pattern HalfGT x = NonEmpty (Open (Just x)) (Open Nothing)

104+pattern HalfGTE x = NonEmpty (Closed (Just x)) (Open Nothing)

105+pattern HalfLT x = NonEmpty (Open Nothing) (Open (Just x))

106+pattern HalfLTE x = NonEmpty (Open Nothing) (Closed (Just x))

squeal-postgresql/src/Squeal/PostgreSQL/PG.hs−31

@@ -46,10 +46,6 @@ module Squeal.PostgreSQL.PG

46 , Enumerated (..)

47 , VarArray (..)

48 , FixArray (..)

49− , Bound (..)

50− , pattern Closed

51− , pattern Open

52− , (<=..<=), (<..<), (<=..<), (<..<=)

53 -- * Type families

49 -- * Type families

54 , LabelsPG

50 , LabelsPG

55 , DimPG

51 , DimPG

@@ -368,30 +364,3 @@ newtype FixArray arr = FixArray {getFixArray :: arr}

368 deriving (Eq, Ord, Show, Read, GHC.Generic)

364 deriving (Eq, Ord, Show, Read, GHC.Generic)

369-- | `PGfixarray` @(@`DimPG` @hask) (@`FixPG` @hask)@

365-- | `PGfixarray` @(@`DimPG` @hask) (@`FixPG` @hask)@

370type instance PG (FixArray hask) = 'PGfixarray (DimPG hask) (FixPG hask)

366type instance PG (FixArray hask) = 'PGfixarray (DimPG hask) (FixPG hask)

371−

372−data Bound x = Bound

373− { closedBound :: Bool

374− , getBound :: Maybe x

375− } deriving

376− ( Eq, Ord, Show, Read, GHC.Generic

377− , Functor, Foldable, Traversable )

378−pattern Closed, Open :: Maybe x -> Bound x

379−pattern Closed x = Bound True x

380−pattern Open x = Bound False x

381−type instance PG (Bound x, Bound x) = 'PGrange (PG x)

382−

383−data Range x

384− = Empty

385− | NonEmpty (Bound x) (Bound x)

386− deriving

387− ( Eq, Ord, Show, Read, GHC.Generic

388− , Functor, Foldable, Traversable )

389−-- instance RenderSQL x => RenderSQL

390−(<=..<=), (<..<), (<=..<), (<..<=) :: x -> x -> Range x

391−x <=..<= y = NonEmpty (Closed (Just x)) (Closed (Just y))

392−x <..< y = NonEmpty (Open (Just x)) (Open (Just y))

393−x <=..< y = NonEmpty (Closed (Just x)) (Open (Just y))

394−x <..<= y = NonEmpty (Open (Just x)) (Closed (Just y))

395−pattern Above, Below :: Bound x -> Range x

396−pattern Above x = NonEmpty (Open Nothing) x

397−pattern Below x = NonEmpty x (Open Nothing)