9216dbd · rel8 · git.iko.soy

Doctest.hsdeleted−53

compare with master

unifiedsplit

@@ -1,53 +0,0 @@

1−{-# language BlockArguments #-}

2−{-# language OverloadedStrings #-}

3−

4−module Main where

5−

6−-- base

7−import Control.Exception ( bracket, throwIO )

8−import Data.Foldable ( traverse_ )

9−import System.Environment ( lookupEnv, setEnv )

10−

11−-- base-compat

12−import System.Environment.Compat ( unsetEnv )

13−

14−-- bytestring

15−import Data.ByteString.Char8 ( unpack )

16−

17−-- doctest

18−import Test.DocTest ( doctest )

19−

20−-- hasql

21−import Hasql.Connection ( acquire, release )

22−import Hasql.Session ( run, sql )

23−

24−-- rel8

25−import Build_doctests ( flags, module_sources, pkgs )

26−

27−-- tmp-postgres

28−import Database.Postgres.Temp ( toConnectionString, verboseConfig, with, withConfig )

29−

30−

31−main :: IO ()

32−main = do

33− nixGhcLibdir <- lookupEnv "NIX_GHC_LIBDIR"

34− unsetEnv "GHC_ENVIRONMENT"

35− either throwIO return =<< with \db -> do

36− setEnv "TEST_DATABASE_URL" (unpack (toConnectionString db))

37− bracket (either (error . show) return =<< acquire (toConnectionString db)) release \conn -> do

38− flip run conn do

39− sql "create table author ( author_id serial primary key, name text not null, url text )"

40− sql "create table project ( author_id int not null references author (author_id), name text not null )"

41−

42− sql "insert into author ( name, url ) values ( 'Ollie', 'https://ocharles.org.uk' )"

43− sql "insert into author ( name, url ) values ( 'Bryan O''Sullivan', null )"

44− sql "insert into author ( name, url ) values ( 'Emily Pillmore', 'https://cohomolo.gy' )"

45− sql "insert into project ( author_id, name ) values ( 1, 'rel8' )"

46− sql "insert into project ( author_id, name ) values ( 2, 'aeson' )"

47− sql "insert into project ( author_id, name ) values ( 2, 'text' )"

48−

49− doctest (args nixGhcLibdir)

50−

51− where

52− args nixGhcLibdir =

53− flags ++ pkgs ++ foldMap (\x -> ["-package-db" <> x <> "/package.conf.d"]) nixGhcLibdir ++ module_sources

Setup.hsdeleted−6

@@ -1,6 +0,0 @@

1−module Main where

2−

3−import Distribution.Extra.Doctest (defaultMainWithDoctests)

4−

5−main :: IO ()

6−main = defaultMainWithDoctests "doctests"

rel8.cabal+1−20

@@ -6,13 +6,7 @@ license: BSD3

6license-file: LICENSE

7author: Oliver Charles

8maintainer: ollie@ocharles.org.uk

9−build-type: Custom

9+build-type: Simple

10−

11−custom-setup

12− setup-depends:

13− base >= 4 && <5,

14− Cabal,

15− cabal-doctest >= 1 && <1.1

16

10

17library

11library

18 build-depends:

12 build-depends:

@@ -201,16 +195,3 @@ test-suite tests

201 -Wno-missing-import-lists -Wno-prepositive-qualified-module

195 -Wno-missing-import-lists -Wno-prepositive-qualified-module

202 -Wno-deprecations -Wno-monomorphism-restriction

196 -Wno-deprecations -Wno-monomorphism-restriction

203 -Wno-missing-local-signatures -Wno-implicit-prelude

197 -Wno-missing-local-signatures -Wno-implicit-prelude

204−

205−test-suite doctests

206− type: exitcode-stdio-1.0

207− build-depends:

208− base

209− , base-compat

210− , bytestring

211− , doctest

212− , hasql

213− , tmp-postgres

214−

215− main-is: Doctest.hs

216− default-language: Haskell2010

src/Rel8/Expr/Bool.hs−40

@@ -32,68 +32,28 @@ true = litExpr True

32

33

34-- | The SQL @AND@ operator.

35−--

36−-- >>> :{

37−-- mapM_ print =<< select c do

38−-- x <- values [lit True, lit False]

39−-- y <- values [lit True, lit False]

40−-- return (x, y, x &&. y)

41−-- :}

42−-- (True,True,True)

43−-- (True,False,False)

44−-- (False,True,False)

45−-- (False,False,False)

46(&&.) :: Expr Bool -> Expr Bool -> Expr Bool

35(&&.) :: Expr Bool -> Expr Bool -> Expr Bool

47(&&.) = zipPrimExprsWith (Opaleye.BinExpr Opaleye.OpAnd)

36(&&.) = zipPrimExprsWith (Opaleye.BinExpr Opaleye.OpAnd)

48infixr 3 &&.

37infixr 3 &&.

49

38

50

39

51-- | The SQL @OR@ operator.

40-- | The SQL @OR@ operator.

52−--

53−-- >>> :{

54−-- mapM_ print =<< select c do

55−-- x <- values [lit True, lit False]

56−-- y <- values [lit True, lit False]

57−-- return (x, y, x ||. y)

58−-- :}

59−-- (True,True,True)

60−-- (True,False,True)

61−-- (False,True,True)

62−-- (False,False,False)

63(||.) :: Expr Bool -> Expr Bool -> Expr Bool

41(||.) :: Expr Bool -> Expr Bool -> Expr Bool

64(||.) = zipPrimExprsWith (Opaleye.BinExpr Opaleye.OpOr)

42(||.) = zipPrimExprsWith (Opaleye.BinExpr Opaleye.OpOr)

65infixr 2 ||.

43infixr 2 ||.

66

44

67

45

68-- | The SQL @NOT@ operator.

46-- | The SQL @NOT@ operator.

69−--

70−-- >>> select c $ pure $ not_ $ lit True

71−-- [False]

72−--

73−-- >>> select c $ pure $ not_ $ lit False

74−-- [True]

75not_ :: Expr Bool -> Expr Bool

47not_ :: Expr Bool -> Expr Bool

76not_ = mapPrimExpr (Opaleye.UnExpr Opaleye.OpNot)

48not_ = mapPrimExpr (Opaleye.UnExpr Opaleye.OpNot)

77

49

78

50

79-- | Fold @AND@ over a collection of expressions.

51-- | Fold @AND@ over a collection of expressions.

80−--

81−-- >>> select c $ pure $ and_ [ lit True ==. lit False, lit False, lit True ]

82−-- [False]

83−--

84−-- >>> select c $ pure $ and_ []

85−-- [True]

86and_ :: Foldable f => f (Expr Bool) -> Expr Bool

52and_ :: Foldable f => f (Expr Bool) -> Expr Bool

87and_ = foldl' (&&.) true

53and_ = foldl' (&&.) true

88

54

89

55

90-- | Fold @OR@ over a collection of expressions.

56-- | Fold @OR@ over a collection of expressions.

91−--

92−-- >>> select c $ pure $ or_ [ lit True ==. lit False, lit False, lit True ]

93−-- [True]

94−--

95−-- >>> select c $ pure $ or_ []

96−-- [False]

97or_ :: Foldable f => f (Expr Bool) -> Expr Bool

57or_ :: Foldable f => f (Expr Bool) -> Expr Bool

98or_ = foldl' (||.) false

58or_ = foldl' (||.) false

99

59

src/Rel8/Expr/Eq.hs−18

@@ -74,12 +74,6 @@ infix 4 /=.

74--

75-- This corresponds to the SQL @=@ operator, though it will always return a

76-- 'Bool'.

77−--

78−-- >>> select c $ pure $ lit Nothing ==? lit True

79−-- False

80−--

81−-- >>> select c $ pure $ lit Nothing ==? lit Nothing

82−-- False

83(==?) :: DBEq a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool

77(==?) :: DBEq a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool

84a ==? b = coalesce $ unsafeLiftOpNullable eq a b

78a ==? b = coalesce $ unsafeLiftOpNullable eq a b

85infix 4 ==?

79infix 4 ==?

@@ -89,12 +83,6 @@ infix 4 ==?

89--

83--

90-- This corresponds to the SQL @<>@ operator, though it will always return a

84-- This corresponds to the SQL @<>@ operator, though it will always return a

91-- 'Bool'.

85-- 'Bool'.

92−--

93−-- >>> select c $ pure $ lit Nothing /=? lit True

94−-- True

95−--

96−-- >>> select c $ pure $ lit Nothing /=? lit Nothing

97−-- False

98(/=?) :: DBEq a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool

86(/=?) :: DBEq a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool

99a /=? b = coalesce $ unsafeLiftOpNullable ne a b

87a /=? b = coalesce $ unsafeLiftOpNullable ne a b

100infix 4 /=?

88infix 4 /=?

@@ -102,12 +90,6 @@ infix 4 /=?

102

90

103-- | Like the SQL @IN@ operator, but implemented by folding over a list with

91-- | Like the SQL @IN@ operator, but implemented by folding over a list with

104-- '==.' and '||.'.

92-- '==.' and '||.'.

105−--

106−-- >>> select c $ return $ lit (5 :: Int32) `in_` [ lit x | x <- [1..5] ]

107−-- [True]

108−--

109−-- >>> select c $ return $ lit (42 :: Int32) `in_` [ lit x | x <- [1..5] ]

110−-- [False]

111in_ :: forall a f. (Sql DBEq a, Foldable f)

93in_ :: forall a f. (Sql DBEq a, Foldable f)

112 => Expr a -> f (Expr a) -> Expr Bool

94 => Expr a -> f (Expr a) -> Expr Bool

113in_ a (toList -> as) = case nullabilization @a of

95in_ a (toList -> as) = case nullabilization @a of

src/Rel8/Expr/Function.hs−31

@@ -47,42 +47,11 @@ instance (arg ~ Expr a, Function args res) => Function arg (args -> res) where

47

48-- | Construct an n-ary function that produces an 'Expr' that when called runs

49-- a SQL function.

50−--

51−-- For example, here's how we can wrap PostgreSQL's @factorial@ function:

52−--

53−-- >>> :{

54−-- factorial :: Expr Int64 -> Expr Data.Scientific.Scientific

55−-- factorial = function "factorial"

56−-- :}

57−--

58−-- >>> select c $ pure $ factorial 5

59−-- [120.0]

60−--

61−-- The same approach works for any number of arguments:

62−--

63−-- >>> :{

64−-- power :: Expr Float -> Expr Float -> Expr Double

65−-- power = function "power"

66−-- :}

67−--

68−-- >>> select c $ pure $ power 9 3

69−-- [729.0]

70function :: Function args result => String -> args -> result

50function :: Function args result => String -> args -> result

71function = applyArgument . Opaleye.FunExpr

51function = applyArgument . Opaleye.FunExpr

72

52

73

53

74-- | Construct a function call for functions with no arguments.

54-- | Construct a function call for functions with no arguments.

75−--

76−-- For example, we can call the database function @pi()@ by using

77−-- @nullaryFunction@:

78−--

79−-- >>> :{

80−-- sqlPi :: Expr Double

81−-- sqlPi = nullaryFunction "pi"

82−-- :}

83−--

84−-- >>> select c $ pure $ sqlPi

85−-- [3.141592653589793]

86nullaryFunction :: Sql DBType a => String -> Expr a

55nullaryFunction :: Sql DBType a => String -> Expr a

87nullaryFunction name = castExpr $ Expr (Opaleye.FunExpr name [])

56nullaryFunction name = castExpr $ Expr (Opaleye.FunExpr name [])

88

57

src/Rel8/Expr/Null.hs−12

@@ -40,12 +40,6 @@ unsafeUnnullify (Expr a) = Expr a

40

41

42-- | Like 'maybe', but to eliminate @null@.

43−--

44−-- >>> select c $ pure $ null 0 id (nullExpr :: Expr (Maybe Int32))

45−-- [0]

46−--

47−-- >>> select c $ pure $ null 0 id (lit (Just 42) :: Expr (Maybe Int32))

48−-- [42]

49nullable :: Expr b -> (Expr a -> Expr b) -> Expr (Maybe a) -> Expr b

43nullable :: Expr b -> (Expr a -> Expr b) -> Expr (Maybe a) -> Expr b

50nullable b f ma = boolExpr (f (unsafeUnnullify ma)) b (isNull ma)

44nullable b f ma = boolExpr (f (unsafeUnnullify ma)) b (isNull ma)

51

45

@@ -55,12 +49,6 @@ nullableOf = maybe null nullify

55

49

56

50

57-- | Like 'isNothing', but for @null@.

51-- | Like 'isNothing', but for @null@.

58−--

59−-- >>> select c $ pure $ isNull (nullExpr :: Expr (Maybe Int32))

60−-- [True]

61−--

62−-- >>> select c $ pure $ isNull (lit (Just 42) :: Expr (Maybe Int32))

63−-- [False]

64isNull :: Expr (Maybe a) -> Expr Bool

52isNull :: Expr (Maybe a) -> Expr Bool

65isNull = mapPrimExpr (Opaleye.UnExpr Opaleye.OpIsNull)

53isNull = mapPrimExpr (Opaleye.UnExpr Opaleye.OpIsNull)

66

54

src/Rel8/Expr/Order.hs−12

@@ -28,9 +28,6 @@ import Rel8.Type.Ord ( DBOrd )

28

29

30-- | Sort a column in ascending order.

31−--

32−-- >>> select c $ orderBy asc $ values [ lit x | x <- [1..5 :: Int32] ]

33−-- [1,2,3,4,5]

34asc :: DBOrd a => Order (Expr a)

31asc :: DBOrd a => Order (Expr a)

35asc = Order $ Opaleye.Order (\expr -> [(orderOp, toPrimExpr expr)])

32asc = Order $ Opaleye.Order (\expr -> [(orderOp, toPrimExpr expr)])

36 where

33 where

@@ -42,9 +39,6 @@ asc = Order $ Opaleye.Order (\expr -> [(orderOp, toPrimExpr expr)])

42

39

43

40

44-- | Sort a column in descending order.

41-- | Sort a column in descending order.

45−--

46−-- >>> select c $ orderBy desc $ values [ lit x | x <- [1..5 :: Int32] ]

47−-- [5,4,3,2,1]

48desc :: DBOrd a => Order (Expr a)

42desc :: DBOrd a => Order (Expr a)

49desc = Order $ Opaleye.Order (\expr -> [(orderOp, toPrimExpr expr)])

43desc = Order $ Opaleye.Order (\expr -> [(orderOp, toPrimExpr expr)])

50 where

44 where

@@ -57,9 +51,6 @@ desc = Order $ Opaleye.Order (\expr -> [(orderOp, toPrimExpr expr)])

57

51

58-- | Transform an ordering so that @null@ values appear first. This corresponds

52-- | Transform an ordering so that @null@ values appear first. This corresponds

59-- to @NULLS FIRST@ in SQL.

53-- to @NULLS FIRST@ in SQL.

60−--

61−-- >>> select c $ orderBy (nullsFirst desc) $ values $ [ nullExpr, nullExpr ] <> [ lit (Just x) | x <- [1..5 :: Int32] ]

62−-- [Nothing,Nothing,Just 5,Just 4,Just 3,Just 2,Just 1]

63nullsFirst :: Order (Expr a) -> Order (Expr (Maybe a))

54nullsFirst :: Order (Expr a) -> Order (Expr (Maybe a))

64nullsFirst (Order (Opaleye.Order f)) =

55nullsFirst (Order (Opaleye.Order f)) =

65 Order $ Opaleye.Order $ fmap (first g) . f . unsafeUnnullify

56 Order $ Opaleye.Order $ fmap (first g) . f . unsafeUnnullify

@@ -70,9 +61,6 @@ nullsFirst (Order (Opaleye.Order f)) =

70

61

71-- | Transform an ordering so that @null@ values appear first. This corresponds

62-- | Transform an ordering so that @null@ values appear first. This corresponds

72-- to @NULLS LAST@ in SQL.

63-- to @NULLS LAST@ in SQL.

73−--

74−-- >>> select c $ orderBy (nullsLast desc) $ values $ [ nullExpr, nullExpr ] <> [ lit (Just x) | x <- [1..5 :: Int32] ]

75−-- [Just 5,Just 4,Just 3,Just 2,Just 1,Nothing,Nothing]

76nullsLast :: Order (Expr a) -> Order (Expr (Maybe a))

64nullsLast :: Order (Expr a) -> Order (Expr (Maybe a))

77nullsLast (Order (Opaleye.Order f)) =

65nullsLast (Order (Opaleye.Order f)) =

78 Order $ Opaleye.Order $ fmap (first g) . f . unsafeUnnullify

66 Order $ Opaleye.Order $ fmap (first g) . f . unsafeUnnullify

src/Rel8/Order.hs+1−11

@@ -23,17 +23,7 @@ import qualified Opaleye.Internal.Order as Opaleye

23-- and 'desc', and you can combine @Order@ via its various instances.

24--

25-- A common pattern is to use '<>' to combine multiple orderings in sequence,

26−-- and '>$<' (from 'Contravariant') to select individual columns. For example,

26+-- and '>$<' (from 'Contravariant') to select individual columns.

27−-- to sort a @Query@ on two columns, we could do:

28−--

29−-- >>> import Data.Functor.Contravariant ((>$<))

30−-- >>> :{

31−-- select c $ orderBy (mconcat [fst >$< asc, snd >$< desc]) $ do

32−-- x <- values [ lit x | x <- [1..3 :: Int32 ] ]

33−-- y <- values [ lit x | x <- [1..3 :: Int32 ] ]

34−-- return (x, y)

35−-- :}

36−-- [(1,3),(1,2),(1,1),(2,3),(2,2),(2,1),(3,3),(3,2),(3,1)]

37type Order :: Type -> Type

27type Order :: Type -> Type

38newtype Order a = Order (Opaleye.Order a)

28newtype Order a = Order (Opaleye.Order a)

39 deriving newtype (Contravariant, Divisible, Decidable, Semigroup, Monoid)

29 deriving newtype (Contravariant, Divisible, Decidable, Semigroup, Monoid)

src/Rel8/Query/Distinct.hs−3

@@ -25,9 +25,6 @@ import Rel8.Table.Opaleye ( distinctspec, unpackspec )

25

26-- | Select all distinct rows from a query, removing duplicates. @distinct q@

27-- is equivalent to the SQL statement @SELECT DISTINCT q@.

28−--

29−-- >>> select c $ distinct $ values [ lit True, lit True, lit False ]

30−-- [False,True]

31distinct :: EqTable a => Query a -> Query a

28distinct :: EqTable a => Query a -> Query a

32distinct = mapOpaleye (Opaleye.distinctExplicit distinctspec)

29distinct = mapOpaleye (Opaleye.distinctExplicit distinctspec)

33

30

src/Rel8/Query/Each.hs−5

@@ -22,11 +22,6 @@ import Rel8.Table.Opaleye ( table, unpackspec )

22

23-- | Select each row from a table definition. This is equivalent to @FROM

24-- table@.

25−--

26−-- >>> mapM_ print =<< select c (each projectSchema)

27−-- Project {projectAuthorId = 1, projectName = "rel8"}

28−-- Project {projectAuthorId = 2, projectName = "aeson"}

29−-- Project {projectAuthorId = 2, projectName = "text"}

30each :: Selects names exprs => TableSchema names -> Query exprs

25each :: Selects names exprs => TableSchema names -> Query exprs

31each =

26each =

32 fmap fromColumns .

27 fmap fromColumns .

src/Rel8/Query/Exists.hs−32

@@ -24,18 +24,6 @@ import Rel8.Table.Maybe ( isJustTable )

24

25

26-- | Checks if a query returns at least one row.

27−--

28−-- >>> :{

29−-- mapM_ print =<< select c do

30−-- author <- each authorSchema

31−-- hasProjects <- exists do

32−-- project <- each projectSchema

33−-- where_ $ authorId author ==. projectAuthorId project

34−-- return (authorName author, hasProjects)

35−-- :}

36−-- ("Ollie",True)

37−-- ("Bryan O'Sullivan",True)

38−-- ("Emily Pillmore",False)

39exists :: Query a -> Query (Expr Bool)

27exists :: Query a -> Query (Expr Bool)

40exists = fmap isJustTable . optional . whereExists

28exists = fmap isJustTable . optional . whereExists

41-- FIXME: change this when b7aacc07c6392654cae439fc3b997620c3aa7a87 makes it

29-- FIXME: change this when b7aacc07c6392654cae439fc3b997620c3aa7a87 makes it

@@ -48,32 +36,12 @@ inQuery a = exists . (>>= filter (a ==:))

48

36

49-- | Produce the empty query if the given query returns no rows. @whereExists@

37-- | Produce the empty query if the given query returns no rows. @whereExists@

50-- is equivalent to @WHERE EXISTS@ in SQL.

38-- is equivalent to @WHERE EXISTS@ in SQL.

51−--

52−-- >>> :{

53−-- select c do

54−-- author <- each authorSchema

55−-- whereExists do

56−-- project <- each projectSchema

57−-- where_ $ projectAuthorId project ==. authorId author

58−-- return $ authorName author

59−-- :}

60−-- ["Ollie","Bryan O'Sullivan"]

61whereExists :: Query a -> Query ()

39whereExists :: Query a -> Query ()

62whereExists = mapOpaleye Opaleye.restrictExists

40whereExists = mapOpaleye Opaleye.restrictExists

63

41

64

42

65-- | Produce the empty query if the given query returns rows. @whereNotExists@

43-- | Produce the empty query if the given query returns rows. @whereNotExists@

66-- is equivalent to @WHERE NOT EXISTS@ in SQL.

44-- is equivalent to @WHERE NOT EXISTS@ in SQL.

67−--

68−-- >>> :{

69−-- select c do

70−-- author <- each authorSchema

71−-- whereNotExists do

72−-- project <- each projectSchema

73−-- where_ $ projectAuthorId project ==. authorId author

74−-- return $ authorName author

75−-- :}

76−-- ["Emily Pillmore"]

77whereNotExists :: Query a -> Query ()

45whereNotExists :: Query a -> Query ()

78whereNotExists = mapOpaleye Opaleye.restrictNotExists

46whereNotExists = mapOpaleye Opaleye.restrictNotExists

79

47

src/Rel8/Query/Filter.hs−11

@@ -24,23 +24,12 @@ import Rel8.Query.Opaleye ( fromOpaleye )

24-- return @x@ unchanged when @f x@ is @True@. This is similar to

25-- 'Control.Monad.guard', but as the predicate is separate from the argument,

26-- it is easy to use in a pipeline of 'Query' transformations.

27−--

28−-- >>> select c $ values [ lit x | x <- [ 1..5 :: Int32 ] ] >>= filter (>. 3)

29−-- [4,5]

30filter :: (a -> Expr Bool) -> a -> Query a

27filter :: (a -> Expr Bool) -> a -> Query a

31filter f a = a <$ where_ (f a)

28filter f a = a <$ where_ (f a)

32

29

33

30

34-- | Drop any rows that don't match a predicate. @where_ expr@ is equivalent

31-- | Drop any rows that don't match a predicate. @where_ expr@ is equivalent

35-- to the SQL @WHERE expr@.

32-- to the SQL @WHERE expr@.

36−--

37−-- >>> :{

38−-- select c $ do

39−-- x <- values [ lit x | x <- [ 1..5 :: Int32 ] ]

40−-- where_ $ x >. lit 2

41−-- return x

42−-- :}

43−-- [3,4,5]

44where_ :: Expr Bool -> Query ()

33where_ :: Expr Bool -> Query ()

45where_ condition =

34where_ condition =

46 fromOpaleye $ lmap (\_ -> toColumn $ toPrimExpr condition) Opaleye.restrict

35 fromOpaleye $ lmap (\_ -> toColumn $ toPrimExpr condition) Opaleye.restrict

src/Rel8/Query/Limit.hs−6

@@ -17,17 +17,11 @@ import Rel8.Query.Opaleye ( mapOpaleye )

17

18-- | @limit n@ select at most @n@ rows from a query. @limit n@ is equivalent

19-- to the SQL @LIMIT n@.

20−--

21−-- >>> select c $ limit 3 $ values [ lit x | x <- [ 1..5 :: Int32 ] ]

22−-- [1,2,3]

23limit :: Word -> Query a -> Query a

20limit :: Word -> Query a -> Query a

24limit = mapOpaleye . Opaleye.limit . fromIntegral

21limit = mapOpaleye . Opaleye.limit . fromIntegral

25

22

26

23

27-- | @offset n@ drops the first @n@ rows from a query. @offset n@ is equivalent

24-- | @offset n@ drops the first @n@ rows from a query. @offset n@ is equivalent

28-- to the SQL @OFFSET n@.

25-- to the SQL @OFFSET n@.

29−--

30−-- >>> select c $ offset 3 $ values [ lit x | x <- [ 1..5 :: Int32 ] ]

31−-- [4,5]

32offset :: Word -> Query a -> Query a

26offset :: Word -> Query a -> Query a

33offset = mapOpaleye . Opaleye.offset . fromIntegral

27offset = mapOpaleye . Opaleye.offset . fromIntegral

src/Rel8/Query/Maybe.hs+4−61

@@ -47,34 +47,6 @@ optional = mapOpaleye $ Opaleye.QueryArr . go

47-- This operation can be used to "undo" the effect of 'optional', which

48-- operationally is like turning a @LEFT JOIN@ back into a full @JOIN@. You

49-- can think of this as analogous to 'Data.Maybe.catMaybes'.

50−--

51−-- To see this in action, first consider the following 'optional' query:

52−--

53−-- >>> :{

54−-- select c $ do

55−-- author <- each authorSchema

56−-- maybeRel8 <- optional $

57−-- each projectSchema

58−-- >>= filter (\p -> projectAuthorId p ==. authorId author)

59−-- >>= filter (\p -> projectName p ==. "rel8")

60−-- return (authorName author, projectName <$> maybeRel8)

61−-- :}

62−-- [("Ollie",Just "rel8"),("Bryan O'Sullivan",Nothing),("Emily Pillmore",Nothing)]

63−--

64−-- Here @optional@ is acting as a @LEFT JOIN@. We can turn this into a proper

65−-- join by using @catMaybeTable@ to filter out rows where the join failed:

66−--

67−-- >>> :{

68−-- select c $ do

69−-- author <- each authorSchema

70−-- maybeRel8 <- optional $

71−-- each projectSchema

72−-- >>= filter (\p -> projectAuthorId p ==. authorId author)

73−-- >>= filter (\p -> projectName p ==. "rel8")

74−-- rel8 <- catMaybeTable maybeRel8

75−-- return (authorName author, projectName rel8)

76−-- :}

77−-- [("Ollie","rel8")]

78catMaybeTable :: MaybeTable a -> Query a

50catMaybeTable :: MaybeTable a -> Query a

79catMaybeTable ma@(MaybeTable _ a) = do

51catMaybeTable ma@(MaybeTable _ a) = do

80 where_ $ isJustTable ma

52 where_ $ isJustTable ma

@@ -87,15 +59,6 @@ catMaybeTable ma@(MaybeTable _ a) = do

87--

59--

88-- This is similar to 'traverseMaybeTable', followed by a @join@ on the

60-- This is similar to 'traverseMaybeTable', followed by a @join@ on the

89-- resulting @MaybeTable@s.

61-- resulting @MaybeTable@s.

90−--

91−-- >>> select c $ bindMaybeTable (optional . values . pure . not_) =<< optional (values [lit True])

92−-- [Just False]

93−--

94−-- >>> select c $ bindMaybeTable (\_ -> return (noTable :: MaybeTable (Expr Bool))) =<< optional (values [lit True])

95−-- [Nothing]

96−--

97−-- >>> select c $ bindMaybeTable (optional . values . pure . not_) =<< return (noTable :: MaybeTable (Expr Bool))

98−-- [Nothing]

99bindMaybeTable :: Monad m

62bindMaybeTable :: Monad m

100 => (a -> m (MaybeTable b)) -> MaybeTable a -> m (MaybeTable b)

63 => (a -> m (MaybeTable b)) -> MaybeTable a -> m (MaybeTable b)

101bindMaybeTable query (MaybeTable input a) = do

64bindMaybeTable query (MaybeTable input a) = do

@@ -107,30 +70,10 @@ bindMaybeTable query (MaybeTable input a) = do

107-- to step through multiple @LEFT JOINs@.

70-- to step through multiple @LEFT JOINs@.

108--

71--

109-- Note that @traverseMaybeTable@ takes a @a -> Query b@ function, which means

72-- Note that @traverseMaybeTable@ takes a @a -> Query b@ function, which means

110−-- you also have the ability to "expand" one row into multiple rows.

73+-- you also have the ability to "expand" one row into multiple rows. If the

111−--

112−-- >>> :{

113−-- duplicate :: Expr Bool -> Query (Expr Bool)

114−-- duplicate x = unionAll (return x) (return x)

115−-- :}

116−--

117−-- >>> select c $ traverseMaybeTable duplicate =<< optional (values [lit True])

118−-- [Just True,Just True]

119−--

120−-- Note that if the @a -> Query b@ function returns no rows, then the resulting

74+-- @a -> Query b@ function returns no rows, then the resulting query will also

121−-- query will also have no rows:

122−--

123−-- >>> select c $ traverseMaybeTable (limit 0 . pure) =<< optional (values [lit True])

124−-- []

125−--

126−-- However, regardless of the given @a -> Query b@ function, if the input is

75+-- have no rows. However, regardless of the given @a -> Query b@ function, if

127−-- @noTable@, you will always get exactly one @noTable@ back:

76+-- the input is @noTable@, you will always get exactly one @noTable@ back.

128−--

129−-- >>> select c $ traverseMaybeTable duplicate (noTable :: MaybeTable (Expr Bool))

130−-- [Nothing]

131−--

132−-- >>> select c $ traverseMaybeTable (limit 0 . pure) (noTable :: MaybeTable (Expr Bool))

133−-- [Nothing]

134traverseMaybeTable :: (a -> Query b) -> MaybeTable a -> Query (MaybeTable b)

77traverseMaybeTable :: (a -> Query b) -> MaybeTable a -> Query (MaybeTable b)

135traverseMaybeTable query ma@(MaybeTable input _) = do

78traverseMaybeTable query ma@(MaybeTable input _) = do

136 MaybeTable output b <- optional (query =<< catMaybeTable ma)

79 MaybeTable output b <- optional (query =<< catMaybeTable ma)

src/Rel8/Query/Null.hs−15

@@ -17,21 +17,6 @@ import Rel8.Query.Filter ( where_ )

17-- @null@s.

18--

19-- Corresponds to 'Data.Maybe.catMaybes'.

20−--

21−-- >>> select c $ pure (nullExpr :: Expr (Maybe Bool))

22−-- [Nothing]

23−--

24−-- >>> select c $ catNullable (nullExpr :: Expr (Maybe Bool))

25−-- []

26−--

27−-- >>> select c $ catNullable (lit (Just True))

28−-- [True]

29−--

30−-- Notice how in the last example a @Bool@ is returned (rather than @Maybe

31−-- Bool@):

32−--

33−-- >>> :t catNullable (lit (Just True))

34−-- catMaybe (lit (Just True)) :: Query (Expr Bool)

35catNullable :: Expr (Maybe a) -> Query (Expr a)

20catNullable :: Expr (Maybe a) -> Query (Expr a)

36catNullable a = do

21catNullable a = do

37 where_ $ isNonNull a

22 where_ $ isNonNull a

src/Rel8/Query/Set.hs−18

@@ -24,53 +24,35 @@ import Rel8.Table.Opaleye ( binaryspec )

24

25-- | Combine the results of two queries of the same type, collapsing

26-- duplicates. @union a b@ is the same as the SQL statement @x UNION b@.

27−--

28−-- >>> select c $ values [lit True, lit True, lit False] `union` values [lit True]

29−-- [False,True]

30union :: EqTable a => Query a -> Query a -> Query a

27union :: EqTable a => Query a -> Query a -> Query a

31union = zipOpaleyeWith (Opaleye.unionExplicit binaryspec)

28union = zipOpaleyeWith (Opaleye.unionExplicit binaryspec)

32

29

33

30

34-- | Combine the results of two queries of the same type, retaining duplicates.

31-- | Combine the results of two queries of the same type, retaining duplicates.

35-- @unionAll a b@ is the same as the SQL statement @x UNION ALL b@.

32-- @unionAll a b@ is the same as the SQL statement @x UNION ALL b@.

36−--

37−-- >>> select c $ values [lit True, lit True, lit False] `unionAll` values [lit True]

38−-- [True,True,False,True]

39unionAll :: Table Expr a => Query a -> Query a -> Query a

33unionAll :: Table Expr a => Query a -> Query a -> Query a

40unionAll = zipOpaleyeWith (Opaleye.unionAllExplicit binaryspec)

34unionAll = zipOpaleyeWith (Opaleye.unionAllExplicit binaryspec)

41

35

42

36

43-- | Find the intersection of two queries, collapsing duplicates. @intersect a

37-- | Find the intersection of two queries, collapsing duplicates. @intersect a

44-- b@ is the same as the SQL statement @x INTERSECT b@.

38-- b@ is the same as the SQL statement @x INTERSECT b@.

45−--

46−-- >>> select c $ values [lit True, lit True, lit False] `intersect` values [lit True]

47−-- [True]

48intersect :: EqTable a => Query a -> Query a -> Query a

39intersect :: EqTable a => Query a -> Query a -> Query a

49intersect = zipOpaleyeWith (Opaleye.intersectExplicit binaryspec)

40intersect = zipOpaleyeWith (Opaleye.intersectExplicit binaryspec)

50

41

51

42

52-- | Find the intersection of two queries, retaining duplicates. @intersectAll

43-- | Find the intersection of two queries, retaining duplicates. @intersectAll

53-- a b@ is the same as the SQL statement @x INTERSECT ALL b@.

44-- a b@ is the same as the SQL statement @x INTERSECT ALL b@.

54−--

55−-- >>> select c $ values [lit True, lit True, lit False] `intersectAll` values [lit True, lit True]

56−-- [True,True]

57intersectAll :: EqTable a => Query a -> Query a -> Query a

45intersectAll :: EqTable a => Query a -> Query a -> Query a

58intersectAll = zipOpaleyeWith (Opaleye.intersectAllExplicit binaryspec)

46intersectAll = zipOpaleyeWith (Opaleye.intersectAllExplicit binaryspec)

59

47

60

48

61-- | Find the difference of two queries, collapsing duplicates @except a b@ is

49-- | Find the difference of two queries, collapsing duplicates @except a b@ is

62-- the same as the SQL statement @x INTERSECT b@.

50-- the same as the SQL statement @x INTERSECT b@.

63−--

64−-- >>> select c $ values [lit True, lit False, lit False] `except` values [lit True]

65−-- [False]

66except :: EqTable a => Query a -> Query a -> Query a

51except :: EqTable a => Query a -> Query a -> Query a

67except = zipOpaleyeWith (Opaleye.exceptExplicit binaryspec)

52except = zipOpaleyeWith (Opaleye.exceptExplicit binaryspec)

68

53

69

54

70-- | Find the difference of two queries, retaining duplicates. @exceptAll a b@

55-- | Find the difference of two queries, retaining duplicates. @exceptAll a b@

71-- is the same as the SQL statement @x EXCEPT ALL b@.

56-- is the same as the SQL statement @x EXCEPT ALL b@.

72−--

73−-- >>> select c $ values [lit True, lit False, lit False] `exceptAll` values [lit True]

74−-- [False,False]

75exceptAll :: EqTable a => Query a -> Query a -> Query a

57exceptAll :: EqTable a => Query a -> Query a -> Query a

76exceptAll = zipOpaleyeWith (Opaleye.exceptAllExplicit binaryspec)

58exceptAll = zipOpaleyeWith (Opaleye.exceptAllExplicit binaryspec)

src/Rel8/Query/Values.hs−6

@@ -23,11 +23,5 @@ import Rel8.Table.Opaleye ( valuesspec )

23-- | Construct a query that returns the given input list of rows. This is like

24-- folding a list of 'return' statements under 'union', but uses the SQL

25-- @VALUES@ expression for efficiency.

26−--

27−-- Typically @values@ will be used with 'lit':

28−--

29−-- >>> mapM_ Data.Text.IO.putStrLn =<< select c (values [ lit "Hello", lit "World!" ])

30−-- Hello

31−-- World!

32values :: (Table Expr a, Foldable f) => f a -> Query a

26values :: (Table Expr a, Foldable f) => f a -> Query a

33values = fromOpaleye . Opaleye.valuesExplicit valuesspec . toList

27values = fromOpaleye . Opaleye.valuesExplicit valuesspec . toList

src/Rel8/Schema/Column.hs−26

@@ -80,32 +80,6 @@ type family UnwrapDefault a where

80-- data types are single columns in queries. This type family has special

81-- support when a query is executed, allowing you to use a single data type for

82-- both query data and rows decoded to Haskell.

83−--

84−-- To understand why this type family is special, let's consider a simple

85−-- higher-kinded data type of Haskell packages:

86−--

87−-- >>> :{

88−-- data Package f = Package

89−-- { packageName :: Column f Text

90−-- , packageAuthor :: Column f Text

91−-- }

92−-- :}

93−--

94−-- In queries, @f@ will be some type of 'Expr', and @Column Expr a@ reduces to

95−-- just @Expr a@:

96−--

97−-- >>> :t packageName (undefined :: Package Expr)

98−-- packageName (undefined :: Package Expr) :: Expr Text

99−--

100−-- When we 'select' queries of this type, @f@ will be instantiated as

101−-- @Identity@, at which point all wrapping entire disappears:

102−--

103−-- >>> :t packageName (undefined :: Package Identity)

104−-- packageName (undefined :: Package Identity) :: Text

105−--

106−-- In @rel8@ we try hard to always know what @f@ is, which means holes should

107−-- mention precise types, rather than the @Column@ type family. You should only

108−-- need to be aware of the type family when defining your table types.

109type Column :: K.Context -> Type -> Type

83type Column :: K.Context -> Type -> Type

110type Column context a =

84type Column context a =

111 Field context (GetLabel a)

85 Field context (GetLabel a)

src/Rel8/Schema/Table.hs+1−14

@@ -15,20 +15,7 @@ import Prelude

15-- the columns within this table.

16--

17-- For each selectable table in your database, you should provide a

18−-- @TableSchema@ in order to interact with the table via Rel8. For a table

18+-- @TableSchema@ in order to interact with the table via Rel8.

19−-- storing a list of projects (as defined in the introduction):

20−--

21−-- >>> :{

22−-- projectSchema :: TableSchema (Project ColumnSchema)

23−-- projectSchema = TableSchema

24−-- { tableName = "project"

25−-- , tableSchema = Nothing -- Assumes that the 'project' table is reachable from your connection's search_path

26−-- , tableColumns = Project

27−-- { projectAuthorId = "author_id"

28−-- , projectName = "name"

29−-- }

30−-- }

31−-- :}

32data TableSchema names = TableSchema

19data TableSchema names = TableSchema

33 { name :: String

20 { name :: String

34 -- ^ The name of the table.

21 -- ^ The name of the table.

src/Rel8/Statement/Delete.hs−18

@@ -56,24 +56,6 @@ data Delete a where

56

57

58-- | Run a @DELETE@ statement.

59−--

60−-- >>> mapM_ print =<< select c (each projectSchema)

61−-- Project {projectAuthorId = 1, projectName = "rel8"}

62−-- Project {projectAuthorId = 2, projectName = "aeson"}

63−-- Project {projectAuthorId = 2, projectName = "text"}

64−--

65−-- >>> :{

66−-- delete c Delete

67−-- { from = projectSchema

68−-- , deleteWhere = \p -> projectName p ==. lit "rel8"

69−-- , returning = Projection projectName

70−-- }

71−-- :}

72−-- ["rel8"]

73−--

74−-- >>> mapM_ print =<< select c (each projectSchema)

75−-- Project {projectAuthorId = 2, projectName = "aeson"}

76−-- Project {projectAuthorId = 2, projectName = "text"}

77delete :: Connection -> Delete a -> IO a

59delete :: Connection -> Delete a -> IO a

78delete c Delete {from, deleteWhere, returning} =

60delete c Delete {from, deleteWhere, returning} =

79 case returning of

61 case returning of

src/Rel8/Statement/Insert.hs−10

@@ -39,16 +39,6 @@ import Data.Text.Encoding ( encodeUtf8 )

39

40

41-- | Run an @INSERT@ statement

42−--

43−-- >>> :{

44−-- insert c Insert

45−-- { into = authorSchema

46−-- , rows = [ lit Author{ authorName = "Gabriel Gonzales", authorId = AuthorId 4, authorUrl = Just "https://haskellforall.com" } ]

47−-- , onConflict = Abort

48−-- , returning = NumberOfRowsAffected

49−-- }

50−-- :}

51−-- 1

52insert :: Connection -> Insert a -> IO a

42insert :: Connection -> Insert a -> IO a

53insert c Insert {into, rows, onConflict, returning} =

43insert c Insert {into, rows, onConflict, returning} =

54 case (rows, returning) of

44 case (rows, returning) of

src/Rel8/Statement/Update.hs−20

@@ -61,26 +61,6 @@ data Update a where

61

62

63-- | Run an @UPDATE@ statement.

64−--

65−-- >>> mapM_ print =<< select c (each projectSchema)

66−-- Project {projectAuthorId = 1, projectName = "rel8"}

67−-- Project {projectAuthorId = 2, projectName = "aeson"}

68−-- Project {projectAuthorId = 2, projectName = "text"}

69−--

70−-- >>> :{

71−-- update c Update

72−-- { target = projectSchema

73−-- , set = \p -> p { projectName = "Rel8!" }

74−-- , updateWhere = \p -> projectName p ==. lit "rel8"

75−-- , returning = NumberOfRowsAffected

76−-- }

77−-- :}

78−-- 1

79−--

80−-- >>> mapM_ print =<< select c (each projectSchema)

81−-- Project {projectAuthorId = 2, projectName = "aeson"}

82−-- Project {projectAuthorId = 2, projectName = "text"}

83−-- Project {projectAuthorId = 1, projectName = "Rel8!"}

84update :: Connection -> Update a -> IO a

64update :: Connection -> Update a -> IO a

85update c Update {target, set, updateWhere, returning} =

65update c Update {target, set, updateWhere, returning} =

86 case returning of

66 case returning of

src/Rel8/Table/Maybe.hs−3

@@ -212,9 +212,6 @@ justTable = MaybeTable (fromExpr mempty)

212-- | Project a single expression out of a 'MaybeTable'. You can think of this

213-- operator like the '$' operator, but it also has the ability to return

214-- @null@.

215−--

216−-- >>> select c $ fmap (fst $?) (optional (values [lit (True, False)]))

217−-- [Just True]

218($?) :: forall a b. Sql DBType b

215($?) :: forall a b. Sql DBType b

219 => (a -> Expr b) -> MaybeTable a -> Expr (Nullify b)

216 => (a -> Expr b) -> MaybeTable a -> Expr (Nullify b)

220f $? ma@(MaybeTable _ a) = case nullabilization @b of

217f $? ma@(MaybeTable _ a) = case nullabilization @b of

src/Rel8/Type.hs−12

@@ -79,18 +79,6 @@ import qualified Data.UUID as UUID

79-- should only need to derive instances of this class for custom database

80-- types, such as types defined in PostgreSQL extensions, or custom domain

81-- types.

82−--

83−-- [ Creating @DBType@s using @newtype@ ]

84−--

85−-- Generalized newtype deriving can be used when you want use a @newtype@

86−-- around a database type for clarity and accuracy in your Haskell code. A

87−-- common example is to @newtype@ row id types:

88−--

89−-- >>> newtype UserId = UserId { toInt32 :: Int32 } deriving newtype (DBType)

90−--

91−-- You can now write queries using @UserId@ instead of @Int32@, which may help

92−-- avoid making bad joins. However, when SQL is generated, it will be as if you

93−-- just used integers (the type distinction does not impact query generation).

94type DBType :: Type -> Constraint

82type DBType :: Type -> Constraint

95class NotNull a => DBType a where

83class NotNull a => DBType a where

96 typeInformation :: TypeInformation a

84 typeInformation :: TypeInformation a

src/Rel8/Type/Eq.hs−30

@@ -49,36 +49,6 @@ import Data.UUID ( UUID )

49-- | Database types that can be compared for equality in queries. If a type is

50-- an instance of 'DBEq', it means we can compare expressions for equality

51-- using the SQL @=@ operator.

52−--

53−-- [ @DBEq@ with @newtype@s ]

54−--

55−-- Like with 'Rel8.DBType', @DBEq@ plays well with generalized newtype

56−-- deriving. The example given for @DBType@ added a @UserId@ @newtype@, but

57−-- without a @DBEq@ instance won't actually be able to use that in joins or

58−-- where-clauses, because it lacks equality. We can add this by changing our

59−-- @newtype@ definition to:

60−--

61−-- >>> newtype UserId = UserId { toInt32 :: Int32 } deriving newtype (DBType, DBEq)

62−--

63−-- This will re-use the equality logic for @Int32@, which is to just use the

64−-- @=@ operator.

65−--

66−-- [ @DBEq@ with @DeriveAnyType@ ]

67−--

68−-- You can also use @DBEq@ with the @DeriveAnyType@ extension to easily add

69−-- equality to your type, assuming that @=@ is sufficient on @DBType@ encoded

70−-- values. Extending the example from 'Rel8.ReadShow''s 'Rel8.DBType' instance,

71−-- we could add equality to @Color@ by writing:

72−--

73−-- >>> :{

74−-- data Color = Red | Green | Blue | Purple | Gold

75−-- deriving (Generic, Show, Read, DBEq)

76−-- deriving DBType via ReadShow Color

77−-- :}

78−--

79−-- This means @Color@s will be treated as the literal strings @"Red"@,

80−-- @"Green"@, etc, in the database, and they can be compared for equality by

81−-- just using @=@.

82type DBEq :: Type -> Constraint

52type DBEq :: Type -> Constraint

83class DBType a => DBEq a

53class DBType a => DBEq a

84

54

src/Rel8/Type/Information.hs−18

@@ -56,24 +56,6 @@ mapTypeInformation = parseTypeInformation . fmap pure

56-- a given 'TypeInformation'. The parser is applied when deserializing rows

57-- returned - the encoder assumes that the input data is already in the

58-- appropriate form.

59−--

60−-- One example where this may be useful is with a database that stores data in

61−-- some legacy encoding:

62−--

63−-- >>> import Data.Text (Text)

64−--

65−-- >>> data Color = Red | Green | Blue

66−-- >>> :{

67−-- instance DBType Color where

68−-- typeInformation = parseTypeInformation parseLegacy toLegacy typeInformation

69−-- where

70−-- parseLegacy :: Text -> Either String Color

71−-- parseLegacy "red" = Right Red

72−-- parseLegacy "green" = Right Green

73−-- parseLegacy _ = Left "Unexpected Color"

74−-- toLegacy Red = "red"

75−-- toLegacy Green = "green"

76−-- :}

77parseTypeInformation :: ()

59parseTypeInformation :: ()

78 => (a -> Either String b) -> (b -> a)

60 => (a -> Either String b) -> (b -> a)

79 -> TypeInformation a -> TypeInformation b

61 -> TypeInformation a -> TypeInformation b

src/Rel8/Type/JSONEncoded.hs−13

@@ -15,19 +15,6 @@ import Rel8.Type.Information ( parseTypeInformation )

15-- | A deriving-via helper type for column types that store a Haskell value

16-- using a JSON encoding described by @aeson@'s 'ToJSON' and 'FromJSON' type

17-- classes.

18−--

19−-- The declaration:

20−--

21−-- >>> import Data.Aeson

22−--

23−-- >>> :{

24−-- data Pet = Pet { petName :: String, petAge :: Int }

25−-- deriving (Generic, ToJSON, FromJSON)

26−-- deriving PrimitiveType via JSONEncoded Pet

27−-- :}

28−--

29−-- will allow you to store @Pet@ values in a single SQL column (stored as

30−-- @json@ values).

31newtype JSONEncoded a = JSONEncoded { fromJSONEncoded :: a }

18newtype JSONEncoded a = JSONEncoded { fromJSONEncoded :: a }

32

19

33

20

src/Rel8/Type/ReadShow.hs−11

@@ -14,17 +14,6 @@ import qualified Data.Text as Text

14

15-- | A deriving-via helper type for column types that store a Haskell value

16-- using a Haskell's 'Read' and 'Show' type classes.

17−--

18−-- The declaration:

19−--

20−-- >>> :{

21−-- data Color = Red | Green | Blue

22−-- deriving (Read, Show)

23−-- deriving PrimitiveType via ReadShow Color

24−-- :}

25−--

26−-- will allow you to store @Color@ values in a single SQL column (stored as

27−-- @text@).

28newtype ReadShow a = ReadShow { fromReadShow :: a }

17newtype ReadShow a = ReadShow { fromReadShow :: a }

29

18

30

19