@@ -3,16 +3,17 @@ module Test.SchemaQ where
33import Prelude
44
55import Control.Monad.Error.Class (throwError)
6+import Control.Monad.Except (throwError) as Except
67import Data.Array as Array
78import Data.Maybe (Maybe(..))
89import Data.Newtype (class Newtype)
910import Effect.Aff (Aff)
1011import Effect.Class (class MonadEffect, liftEffect)
1112import Effect.Exception as Exception
12−import Foreign (MultipleErrors)
13+import Foreign (ForeignError(..), MultipleErrors)
1314import Test.Spec (Spec, describe, it)
1415import Type.Proxy (Proxy(..))
15−import Yoga.JSON (class ReadForeign, class WriteForeign)
16+import Yoga.JSON (class ReadForeign, class WriteForeign, readImpl, writeImpl)
1617import Yoga.Om as Om
1718import Yoga.Postgres as PG
1819import Yoga.Postgres.ClientOm (run, runOne, exec)
@@ -22,79 +23,79 @@ spec :: Spec Unit
2223spec = describe "Query builder" do
2324
2425 it "selects columns with a WHERE clause" $ withUsersTable do
25− _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: admin } # exec {}
26− _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: user } # exec {}
26+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
27+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
2728 rows <- from usersTable
2829 # select @"name, email"
2930 # where_ @"role = $role"
30− # run { role: admin }
31+ # run { role: Admin }
3132 rows `shouldEqual` [ { name: "Alice", email: Email "a@t.com" } ]
3233
3334 it "orders and limits results" $ withUsersTable do
34− _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: admin } # exec {}
35− _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: user } # exec {}
36− _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: user } # exec {}
35+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
36+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
37+ _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: User } # exec {}
3738 rows <- from usersTable # select @"name" # orderBy @"name" # limit @"2" # run {}
3839 rows `shouldEqual` [ { name: "Alice" }, { name: "Bob" } ]
3940
4041 it "groups results" $ withUsersTable do
41− _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: admin } # exec {}
42− _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: user } # exec {}
43− _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: user } # exec {}
42+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
43+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
44+ _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: User } # exec {}
4445 rows <- from usersTable # select @"role" # groupBy @"role" # orderBy @"role" # run {}
45− rows `shouldEqual` [ { role: admin }, { role: user } ]
46+ rows `shouldEqual` [ { role: Admin }, { role: User } ]
4647
4748 it "filters with a BETWEEN range" $ withUsersTable do
48− _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: admin } # exec {}
49− _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: user } # exec {}
50− _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: mod } # exec {}
49+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
50+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
51+ _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: Mod } # exec {}
5152 rows <- from usersTable # select @"name" # where_ @"id BETWEEN $lo AND $hi" # orderBy @"id" # run { lo: 2, hi: 3 }
5253 rows `shouldEqual` [ { name: "Bob" }, { name: "Carol" } ]
5354
5455 it "inserts a row and returns specific columns" $ withUsersTable do
55− rows <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: admin } # returning @"name" # run {}
56+ rows <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # returning @"name" # run {}
5657 rows `shouldEqual` [ { name: "Alice" } ]
5758
5859 it "inserts a row with default created_at and updated_at" $ withUsersTable do
59− row <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: admin } # returning @"created_at, updated_at" # runOne {}
60+ row <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # returning @"created_at, updated_at" # runOne {}
6061 r <- shouldBeJust row
6162 r.created_at `shouldEqual` r.updated_at
6263
6364 it "deletes with a condition and returns the deleted rows" $ withUsersTable do
64− _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: admin } # exec {}
65− _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: user } # exec {}
66− rows <- from usersTable # delete # where_ @"role = $role" # returning @"name" # run { role: admin }
65+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
66+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
67+ rows <- from usersTable # delete # where_ @"role = $role" # returning @"name" # run { role: Admin }
6768 rows `shouldEqual` [ { name: "Alice" } ]
6869
6970 it "updates a row with SET and WHERE" $ withUsersTable do
70− _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: admin } # exec {}
71− _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: user } # exec {}
72− _ <- update usersTable # set { role: mod } # where_ @"name = $name" # exec { name: "Bob" }
71+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
72+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
73+ _ <- update usersTable # set { role: Mod } # where_ @"name = $name" # exec { name: "Bob" }
7374 rows <- from usersTable # select @"name, role" # orderBy @"name" # run {}
74− rows `shouldEqual` [ { name: "Alice", role: admin }, { name: "Bob", role: mod } ]
75+ rows `shouldEqual` [ { name: "Alice", role: Admin }, { name: "Bob", role: Mod } ]
7576
7677 it "updates multiple columns" $ withUsersTable do
77− _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: admin } # exec {}
78− _ <- update usersTable # set { name: "Alicia", role: mod } # where_ @"email = $email" # exec { email: Email "a@t.com" }
78+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
79+ _ <- update usersTable # set { name: "Alicia", role: Mod } # where_ @"email = $email" # exec { email: Email "a@t.com" }
7980 rows <- from usersTable # select @"name, role" # run {}
80− rows `shouldEqual` [ { name: "Alicia", role: mod } ]
81+ rows `shouldEqual` [ { name: "Alicia", role: Mod } ]
8182
8283 it "updates and returns the modified row" $ withUsersTable do
83− _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: admin } # exec {}
84+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
8485 rows <- update usersTable
85− # set { role: mod }
86+ # set { role: Mod }
8687 # where_ @"email = $email"
8788 # returning @"name, role"
8889 # run { email: Email "a@t.com" }
89− rows `shouldEqual` [ { name: "Alice", role: mod } ]
90+ rows `shouldEqual` [ { name: "Alice", role: Mod } ]
9091
9192 it "combines two queries with UNION" $ withUsersTable do
92− _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: admin } # exec {}
93− _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: user } # exec {}
94− _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: mod } # exec {}
93+ _ <- into usersTable # insert { name: "Alice", email: Email "a@t.com", role: Admin } # exec {}
94+ _ <- into usersTable # insert { name: "Bob", email: Email "b@t.com", role: User } # exec {}
95+ _ <- into usersTable # insert { name: "Carol", email: Email "c@t.com", role: Mod } # exec {}
9596 rows <- from usersTable # select @"name" # where_ @"role = $a"
9697 # union (from usersTable # select @"name" # where_ @"role = $b")
97− # run { a: admin, b: mod }
98+ # run { a: Admin, b: Mod }
9899 Array.sort (rows <#> _.name) `shouldEqual` [ "Alice", "Carol" ]
99100
100101-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -110,23 +111,31 @@ derive newtype instance Show Email
110111derive newtype instance ReadForeign Email
111112derive newtype instance WriteForeign Email
112113
113−newtype Role = Role String
114+data Role = Admin | User | Mod
114115
115−derive instance Newtype Role _
116116derive instance Eq Role
117117derive instance Ord Role
118−derive newtype instance Show Role
119−derive newtype instance ReadForeign Role
120−derive newtype instance WriteForeign Role
121118
122−admin :: Role
123−admin = Role "admin"
119+instance Show Role where
120+ show = roleToString
124121
125−user :: Role
126−user = Role "user"
122+instance WriteForeign Role where
123+ writeImpl = roleToString >>> writeImpl
127124
128−mod :: Role
129−mod = Role "mod"
125+instance ReadForeign Role where
126+ readImpl f = do
127+ s :: String <- readImpl f
128+ case s of
129+ "admin" -> pure Admin
130+ "user" -> pure User
131+ "mod" -> pure Mod
132+ _ -> Except.throwError $ pure $ ForeignError $ "Unknown role: " <> s
133+
134+roleToString :: Role -> String
135+roleToString = case _ of
136+ Admin -> "admin"
137+ User -> "user"
138+ Mod -> "mod"
130139
131140instance PGTypeName Email where
132141 pgTypeName _ = "TEXT"
@@ -134,6 +143,7 @@ instance PGTypeName Email where
134143instance PGTypeName Role where
135144 pgTypeName _ = "TEXT"
136145
146+
137147type UsersTable = Table "test_om_users"
138148 ( id :: PrimaryKey (AutoIncrement Int)
139149 , name :: String