relational-query: export SQL: add test definitions.

relational-query/test/Export.hs

@@ -0,0 +1,40 @@
+module Export where
+
+import Data.Functor.ProductIsomorphic (pureP, (|$|), (|*|))
+import Data.Int (Int32)
+
+import Model
+
+import Database.Relational
+
+
+onX :: Relation () (Maybe SetA, SetB)
+onX = relation $ do
+  a <- queryMaybe setA
+  b <- query      setB
+  on $ a ?! intA0' .=. just (b ! intB0')
+  return $ (,) |$| a |*| b
+
+assignX :: Update ()
+assignX = update $ \_proj -> do
+  intA0' <-# value (0 :: Int32)
+  return $ pureP ()
+
+registerX :: Insert (String, Maybe String)
+registerX = insertValue $ do
+  intC0' <-# value 1
+  (ph1, ()) <- placeholder (\ph' -> strC1' <-# ph')
+  intC2' <-# value 2
+  (ph2, ()) <- placeholder (\ph' -> mayStrC3' <-# ph')
+  return $ (,) |$| ph1 |*| ph2
+
+setAFromB :: Pi SetB SetA
+setAFromB =  SetA |$| intB0' |*| strB2' |*| strB2'
+
+insertQueryX :: InsertQuery ()
+insertQueryX =  insertQuery setAFromB setA
+
+deleteX :: Delete ()
+deleteX = delete $ \proj -> do
+  wheres $ proj ! strA1' .=. value "A"
+  return $ pureP ()

relational-query/test/exportsEq.hs

@@ -0,0 +1,53 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+import Test.QuickCheck.Simple (Test, eqTest, defaultMain)
+
+import Export (onX, assignX, registerX, insertQueryX, deleteX)
+
+import qualified Data.ByteString.Char8 as B
+import Data.ByteString.Short (ShortByteString, fromShort)
+
+import Database.Relational (relationalQuery)
+import Database.Relational.Export
+  (inlineQuery_, inlineUpdate_, inlineInsertValue_, inlineInsertQuery_, inlineDelete_)
+
+
+$(inlineQuery_
+  (const $ return ())
+  (relationalQuery onX)
+  "inlineOnX")
+
+$(inlineUpdate_
+  (const $ return ())
+  assignX
+  "inlineAssignX")
+
+$(inlineInsertValue_
+  (const $ return ())
+  registerX
+  "inlineRegisterX")
+
+$(inlineInsertQuery_
+  (const $ return ())
+  insertQueryX
+  "inlineInsertQueryX")
+
+$(inlineDelete_
+  (const $ return ())
+  deleteX
+  "inlineDeleteX")
+
+eqInline :: Show a => String -> ShortByteString -> a -> Test
+eqInline name inline orig = eqTest name (B.unpack $ fromShort inline) (show orig)
+
+tests :: [Test]
+tests =
+  [ eqInline "onX"          inlineOnX          onX
+  , eqInline "assignX"      inlineAssignX      assignX
+  , eqInline "registerX"    inlineRegisterX    registerX
+  , eqInline "insertQueryX" inlineInsertQueryX insertQueryX
+  , eqInline "deleteX"      inlineDeleteX      deleteX
+  ]
+
+main :: IO ()
+main = defaultMain tests