git.iko.soy/rowtype-yoga/purescript-yoga-postgres
on main help sign in
Add UUID type and DefaultExpr modifier for server-side defaults
commitda06d4defd6a71d488cd317550493c549ce135a1 authorMark <mark.eibes@gmail.com> dateSun 15 Feb 2026, 16:04 (8 months ago) parentc4bbae5
3 files changed+79−1
compare with main
unifiedsplit
.psc-ide-port−1 src/Yoga/Postgres/Schema.purs+31 test/Schema.purs+48
.psc-ide-portdeleted−1
@@ -1 +0,0 @@
1−15245
src/Yoga/Postgres/Schema.purs+31
@@ -63,6 +63,9 @@ data References
6363data ForeignKey :: Symbol -> Type -> Symbol -> Type -> Type
6464data ForeignKey table references col a
6565
66+data DefaultExpr :: Symbol -> Type -> Type
67+data DefaultExpr expr a
68+
6669-- Internal: used by LEFT JOIN to mark columns as nullable
6770data Nullable :: Type -> Type
6871data Nullable a
@@ -78,6 +81,22 @@ derive instance Newtype Jsonb _
7881instance ReadForeign Jsonb where
7982 readImpl = pure <<< Jsonb
8083
84+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
85+-- UUID type for Postgres
86+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
87+
88+newtype UUID = UUID String
89+
90+derive instance Newtype UUID _
91+derive newtype instance Eq UUID
92+derive newtype instance Ord UUID
93+derive newtype instance Show UUID
94+
95+instance ReadForeign UUID where
96+ readImpl f = do
97+ s :: String <- readImpl f
98+ pure (UUID s)
99+
81100-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
82101-- Nullability: inferred from Maybe
83102-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -101,6 +120,7 @@ instance ExtractType a typ => ExtractType (PrimaryKey a) typ
101120else instance ExtractType a typ => ExtractType (AutoIncrement a) typ
102121else instance ExtractType a typ => ExtractType (Unique a) typ
103122else instance ExtractType a typ => ExtractType (Default val a) typ
123+else instance ExtractType a typ => ExtractType (DefaultExpr expr a) typ
104124else instance ExtractType a typ => ExtractType (ForeignKey t r c a) typ
105125else instance ExtractType a typ => ExtractType (Nullable a) (Maybe typ)
106126else instance ExtractType a a
@@ -130,6 +150,9 @@ instance PGTypeName DateTime where
130150instance PGTypeName BigInt where
131151 pgTypeName _ = "BIGINT"
132152
153+instance PGTypeName UUID where
154+ pgTypeName _ = "UUID"
155+
133156instance PGTypeName Jsonb where
134157 pgTypeName _ = "JSONB"
135158
@@ -170,6 +193,11 @@ else instance RenderConstraint a => RenderConstraint (Unique a) where
170193else instance (RenderDefaultValue val a, RenderConstraint a) => RenderConstraint (Default val a) where
171194 renderConstraint _ = joinConstraints (renderDefaultValue (Proxy :: Proxy val) (Proxy :: Proxy a)) (renderConstraint (Proxy :: Proxy a))
172195
196+else instance (IsSymbol expr, RenderConstraint a) => RenderConstraint (DefaultExpr expr a) where
197+ renderConstraint _ = joinConstraints
198+ ("DEFAULT " <> reflectSymbol (Proxy :: Proxy expr))
199+ (renderConstraint (Proxy :: Proxy a))
200+
173201else instance (IsSymbol table, IsSymbol col, RenderConstraint a) => RenderConstraint (ForeignKey table References col a) where
174202 renderConstraint _ = joinConstraints
175203 ("REFERENCES " <> reflectSymbol (Proxy :: Proxy table) <> "(" <> reflectSymbol (Proxy :: Proxy col) <> ")")
@@ -241,6 +269,8 @@ instance IsAutoGenerated (AutoIncrement a) where
241269 isAutoGenerated _ = true
242270else instance IsAutoGenerated (Default v a) where
243271 isAutoGenerated _ = true
272+else instance IsAutoGenerated (DefaultExpr expr a) where
273+ isAutoGenerated _ = true
244274else instance IsAutoGenerated a => IsAutoGenerated (PrimaryKey a) where
245275 isAutoGenerated _ = isAutoGenerated (Proxy :: Proxy a)
246276else instance IsAutoGenerated a => IsAutoGenerated (Unique a) where
@@ -2381,6 +2411,7 @@ class IsAutoGeneratedTC constraints result | constraints -> result
23812411
23822412instance IsAutoGeneratedTC (AutoIncrement a) True
23832413else instance IsAutoGeneratedTC (Default s a) True
2414+else instance IsAutoGeneratedTC (DefaultExpr expr a) True
23842415else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (PrimaryKey a) result
23852416else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (Unique a) result
23862417else instance IsAutoGeneratedTC a result => IsAutoGeneratedTC (ForeignKey t r c a) result
test/Schema.purs+48
@@ -643,6 +643,44 @@ typedCoalesceSelect
643643typedCoalesceSelect = from usersTable
644644 # select @"name, COALESCE(age, 0) AS val"
645645
646+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
647+-- UUID + DefaultExpr
648+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
649+
650+type SessionsTable = Table "sessions"
651+ ( id :: UUID # PrimaryKey # DefaultExpr "gen_random_uuid()"
652+ , user_id :: Int # ForeignKey "users" References "id"
653+ , token :: String # Unique
654+ , created_at :: DateTime # DefaultExpr "now()"
655+ )
656+
657+sessionsTable :: Proxy SessionsTable
658+sessionsTable = Proxy
659+
660+sessionsDDL :: String
661+sessionsDDL = createTableDDL @SessionsTable
662+
663+sessionsInsertSQL :: String
664+sessionsInsertSQL = insertSQLFor @SessionsTable
665+
666+typedSessionSelect
667+ :: Q _ (id :: UUID, token :: String) () _
668+typedSessionSelect = from sessionsTable # select @"id, token"
669+
670+typedSessionWhere
671+ :: Q _ (id :: UUID, token :: String, user_id :: Int, created_at :: DateTime) (userId :: Int) _
672+typedSessionWhere = from sessionsTable # selectAll # where_ @"user_id = $userId"
673+
674+typedSessionInsert
675+ :: Q _ () () _
676+typedSessionInsert = from sessionsTable # insert { user_id: 42, token: "abc" }
677+
678+builderSessionSelect :: String
679+builderSessionSelect = typedSessionSelect # toSQL
680+
681+builderSessionInsert :: String
682+builderSessionInsert = typedSessionInsert # toSQL
683+
646684-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
647685-- Spec
648686-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -674,6 +712,16 @@ spec = do
674712 it "skips Default columns in INSERT" do
675713 configInsertSQL `shouldEqual` "INSERT INTO config () VALUES () RETURNING *"
676714
715+ describe "UUID + DefaultExpr" do
716+ it "renders UUID and DefaultExpr in DDL" do
717+ sessionsDDL `shouldEqual` "CREATE TABLE sessions (created_at TIMESTAMPTZ NOT NULL DEFAULT now(), id UUID NOT NULL DEFAULT gen_random_uuid() PRIMARY KEY, token TEXT NOT NULL UNIQUE, user_id INTEGER NOT NULL REFERENCES users(id))"
718+ it "skips DefaultExpr columns in INSERT" do
719+ sessionsInsertSQL `shouldEqual` "INSERT INTO sessions (token, user_id) VALUES ($1, $2) RETURNING *"
720+ it "builds SELECT with UUID column" do
721+ builderSessionSelect `shouldEqual` "SELECT id, token FROM sessions"
722+ it "builds INSERT skipping DefaultExpr columns" do
723+ builderSessionInsert `shouldEqual` "INSERT INTO sessions (token, user_id) VALUES ($1, $2)"
724+
677725 describe "UPDATE SQL" do
678726 it "generates UPDATE with SET and WHERE" do
679727 updateSQL `shouldEqual` "UPDATE users SET name = $1 WHERE id = $2"