@@ -8,7 +8,7 @@ import Data.Enum (toEnum)
88import Data.UUID as UUID
99import JS.BigInt as JS.BigInt
1010import Data.Maybe (Maybe(..), fromJust, isNothing)
11−import Data.Newtype (un)
11+import Data.Newtype (class Newtype, un)
1212import Data.Array as Array
1313import Data.Tuple.Nested ((/\))
1414import Data.Time (Time(..))
@@ -27,6 +27,7 @@ import Test.Spec.Runner (runSpec)
2727import Type.Function (type (#))
2828import Type.Proxy (Proxy(..))
2929import Test.Sqlite.TempDb (mkTempDbUrl)
30+import Yoga.JSON (class ReadForeign, readImpl, unsafeStringify)
3031import Yoga.Test.Docker as Docker
3132import Yoga.SQLite.SQLite as SQLite
3233import Yoga.SQLite.Schema
@@ -134,6 +135,34 @@ type NullableEverythingTable = Table "nullable_everything"
134135 , active :: Maybe SQLiteBool
135136 )
136137
138+newtype Code = Code String
139+
140+derive instance Newtype Code _
141+derive newtype instance Eq Code
142+derive newtype instance Show Code
143+
144+instance SQLiteTypeName Code where
145+ sqliteTypeName _ = "TEXT"
146+
147+instance ReadForeign Code where
148+ readImpl = map Code <<< readImpl
149+
150+type CodesTable = Table "codes"
151+ ( code :: Code # PrimaryKey
152+ )
153+
154+type LinkedCodesTable = Table "linked_codes"
155+ ( id :: Int # PrimaryKey # AutoIncrement
156+ , code :: ForeignKey "codes" References "code" Code
157+ )
158+
159+typedForeignKeyNewtypeSelectAll
160+ :: Q _
161+ (code :: Code, id :: Int)
162+ ()
163+ _
164+typedForeignKeyNewtypeSelectAll = from (Proxy :: Proxy LinkedCodesTable) # selectAll
165+
137166-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
138167-- Type annotations prove correctness at compile time
139168-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -413,6 +442,10 @@ spec = before setupConn do
413442 let result = createTableDDL @ConfigTable
414443 result `shouldEqual` "CREATE TABLE config (active INTEGER NOT NULL DEFAULT 1, id INTEGER PRIMARY KEY AUTOINCREMENT, role TEXT NOT NULL DEFAULT 'user', score INTEGER NOT NULL DEFAULT 0)"
415444
445+ it "uses wrapped SQLite type names inside ForeignKey" \_ -> do
446+ let result = createTableDDL @LinkedCodesTable
447+ result `shouldEqual` "CREATE TABLE linked_codes (code TEXT NOT NULL REFERENCES codes(code), id INTEGER PRIMARY KEY AUTOINCREMENT)"
448+
416449 describe "SQL builder output" do
417450 it "SELECT *" \_ -> do
418451 toSQL typedSelectAll `shouldEqual` "SELECT * FROM users"
@@ -793,6 +826,9 @@ spec = before setupConn do
793826 it "RandomRowId insert excludes id" \_ -> do
794827 toSQL typedRandomRowIdInsert `shouldEqual` "INSERT INTO things (name) VALUES (?1)"
795828
829+ it "ForeignKey wrapped newtype survives selectAll typing" \_ -> do
830+ toSQL typedForeignKeyNewtypeSelectAll `shouldEqual` "SELECT * FROM linked_codes"
831+
796832 describe "Edge cases" do
797833 it "Maybe Just as SQLiteValue passes the inner value" \conn -> do
798834 SQLite.executeSimple (SQLite.SQL (createTableDDL @UsersTable)) conn # void
@@ -1202,12 +1238,23 @@ spec = before setupConn do
12021238 let dts = map (_.created_at) (rows :: Array { created_at :: DateTime })
12031239 dts `shouldEqual` [dt]
12041240
1241+ it "ForeignKey newtype round-trips without wrapper workaround" \conn -> do
1242+ SQLite.executeSimple (SQLite.SQL (createTableDDL @CodesTable)) conn # void
1243+ SQLite.executeSimple (SQLite.SQL (createTableDDL @LinkedCodesTable)) conn # void
1244+ runExecute conn {} (from (Proxy :: Proxy CodesTable) # insert { code: Code "alpha" }) # void
1245+ runExecute conn {} (from (Proxy :: Proxy LinkedCodesTable) # insert { code: Code "alpha" }) # void
1246+ rows <- runQuery conn {} (from (Proxy :: Proxy LinkedCodesTable) # select @"code")
1247+ let codes = map (_.code) (rows :: Array { code :: Code })
1248+ codes `shouldEqual` [Code "alpha"]
1249+
12051250 it "Json round-trip with nested object" \conn -> do
12061251 SQLite.executeSimple (SQLite.SQL (createTableDDL @EventsTable)) conn # void
12071252 let obj = unsafeToForeign { key: "value", nested: { a: 1 } }
12081253 runExecute conn {} (from eventsTable # insert { title: "test", metadata: Json obj, created_at: mkDateTime 2024 1 1 0 0 0 }) # void
12091254 rows <- runQuery conn {} (from eventsTable # select @"metadata")
12101255 Array.length (rows :: Array { metadata :: Json }) `shouldEqual` 1
1256+ let Json f = unsafePartial $ fromJust $ Array.head (map _.metadata rows)
1257+ unsafeStringify f `shouldEqual` unsafeStringify obj
12111258
12121259 it "onConflictDoNothing does not insert duplicate" \conn -> do
12131260 SQLite.executeSimple (SQLite.SQL (createTableDDL @UsersTable)) conn # void