git.iko.soy/rowtype-yoga/purescript-yoga-postgres
on main help sign in
Add Point, TSVector, TSQuery types; add REAL/SMALLINT/FTS keywords
commitbbfdc0a570739347d2cd6f7a47cd96aad9798621 authorMark <mark.eibes@gmail.com> dateMon 16 Feb 2026, 00:19 (8 months ago) parent6aa617b
2 files changed+134−2
compare with main
unifiedsplit
src/Yoga/Postgres/Schema.purs+96−2 test/Schema.purs+38
src/Yoga/Postgres/Schema.purs+96−2
@@ -132,6 +132,51 @@ instance ReadForeign PGTime where
132132 dt :: DateTime <- readImpl f
133133 pure (PGTime (time dt))
134134
135+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
136+-- Point: geometric point "(x,y)"
137+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
138+
139+newtype Point = Point { x :: Number, y :: Number }
140+
141+derive instance Newtype Point _
142+derive instance Eq Point
143+
144+instance Show Point where
145+ show (Point { x, y }) = "(Point " <> show x <> " " <> show y <> ")"
146+
147+instance ReadForeign Point where
148+ readImpl f = do
149+ { x, y } :: { x :: Number, y :: Number } <- readImpl f
150+ pure (Point { x, y })
151+
152+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
153+-- TSVector / TSQuery: full-text search types
154+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
155+
156+newtype TSVector = TSVector String
157+
158+derive instance Newtype TSVector _
159+derive newtype instance Eq TSVector
160+derive newtype instance Ord TSVector
161+derive newtype instance Show TSVector
162+
163+instance ReadForeign TSVector where
164+ readImpl f = do
165+ s :: String <- readImpl f
166+ pure (TSVector s)
167+
168+newtype TSQuery = TSQuery String
169+
170+derive instance Newtype TSQuery _
171+derive newtype instance Eq TSQuery
172+derive newtype instance Ord TSQuery
173+derive newtype instance Show TSQuery
174+
175+instance ReadForeign TSQuery where
176+ readImpl f = do
177+ s :: String <- readImpl f
178+ pure (TSQuery s)
179+
135180-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
136181-- Nullability: inferred from Maybe
137182-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -194,6 +239,15 @@ instance PGTypeName PGDate where
194239instance PGTypeName PGTime where
195240 pgTypeName _ = "TIME"
196241
242+instance PGTypeName Point where
243+ pgTypeName _ = "POINT"
244+
245+instance PGTypeName TSVector where
246+ pgTypeName _ = "TSVECTOR"
247+
248+instance PGTypeName TSQuery where
249+ pgTypeName _ = "TSQUERY"
250+
197251instance PGTypeName Jsonb where
198252 pgTypeName _ = "JSONB"
199253
@@ -1489,8 +1543,12 @@ else instance FlushWhereWordU word currentType tables paramsIn currentTypeOut pa
14891543else instance FlushWhereWordU word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "u" word currentType tables paramsIn currentTypeOut paramsOut
14901544else instance FlushWhereWordV word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "V" word currentType tables paramsIn currentTypeOut paramsOut
14911545else instance FlushWhereWordV word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "v" word currentType tables paramsIn currentTypeOut paramsOut
1546+else instance FlushWhereWordP word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "P" word currentType tables paramsIn currentTypeOut paramsOut
1547+else instance FlushWhereWordP word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "p" word currentType tables paramsIn currentTypeOut paramsOut
1548+else instance FlushWhereWordR word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "R" word currentType tables paramsIn currentTypeOut paramsOut
1549+else instance FlushWhereWordR word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "r" word currentType tables paramsIn currentTypeOut paramsOut
14921550
1493−-- Catch-all: column reference (letters without keywords like g, h, p, q, r, w, x, y, z)
1551+-- Catch-all: column reference (letters without keywords like g, h, q, w, x, y, z)
14941552else instance
14951553 ( ResolveColumn word tables entry
14961554 , ExtractType entry typ
@@ -1679,7 +1737,9 @@ else instance
16791737class FlushWhereWordS :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint
16801738class FlushWhereWordS word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut
16811739
1682−instance FlushWhereWordS "SUM" currentType tables paramsIn currentType paramsIn
1740+instance FlushWhereWordS "SMALLINT" currentType tables paramsIn currentType paramsIn
1741+else instance FlushWhereWordS "smallint" currentType tables paramsIn currentType paramsIn
1742+else instance FlushWhereWordS "SUM" currentType tables paramsIn currentType paramsIn
16831743else instance FlushWhereWordS "sum" currentType tables paramsIn currentType paramsIn
16841744else instance FlushWhereWordS "STRING_AGG" currentType tables paramsIn String paramsIn
16851745else instance FlushWhereWordS "string_agg" currentType tables paramsIn String paramsIn
@@ -1702,6 +1762,14 @@ else instance FlushWhereWordT "timestamptz" currentType tables paramsIn currentT
17021762else instance FlushWhereWordT "timestamp" currentType tables paramsIn currentType paramsIn
17031763else instance FlushWhereWordT "TIME" currentType tables paramsIn currentType paramsIn
17041764else instance FlushWhereWordT "time" currentType tables paramsIn currentType paramsIn
1765+else instance FlushWhereWordT "tsvector" currentType tables paramsIn currentType paramsIn
1766+else instance FlushWhereWordT "TSVECTOR" currentType tables paramsIn currentType paramsIn
1767+else instance FlushWhereWordT "tsquery" currentType tables paramsIn currentType paramsIn
1768+else instance FlushWhereWordT "TSQUERY" currentType tables paramsIn currentType paramsIn
1769+else instance FlushWhereWordT "to_tsvector" currentType tables paramsIn currentType paramsIn
1770+else instance FlushWhereWordT "TO_TSVECTOR" currentType tables paramsIn currentType paramsIn
1771+else instance FlushWhereWordT "to_tsquery" currentType tables paramsIn currentType paramsIn
1772+else instance FlushWhereWordT "TO_TSQUERY" currentType tables paramsIn currentType paramsIn
17051773else instance
17061774 ( ResolveColumn word tables entry
17071775 , ExtractType entry typ
@@ -1733,6 +1801,32 @@ else instance
17331801 ) =>
17341802 FlushWhereWordV word currentType tables paramsIn unwrapped paramsIn
17351803
1804+class FlushWhereWordP :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint
1805+class FlushWhereWordP word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut
1806+
1807+instance FlushWhereWordP "point" currentType tables paramsIn currentType paramsIn
1808+else instance FlushWhereWordP "POINT" currentType tables paramsIn currentType paramsIn
1809+else instance FlushWhereWordP "plainto_tsquery" currentType tables paramsIn currentType paramsIn
1810+else instance FlushWhereWordP "PLAINTO_TSQUERY" currentType tables paramsIn currentType paramsIn
1811+else instance
1812+ ( ResolveColumn word tables entry
1813+ , ExtractType entry typ
1814+ , UnwrapMaybe typ unwrapped
1815+ ) =>
1816+ FlushWhereWordP word currentType tables paramsIn unwrapped paramsIn
1817+
1818+class FlushWhereWordR :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint
1819+class FlushWhereWordR word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut
1820+
1821+instance FlushWhereWordR "real" currentType tables paramsIn currentType paramsIn
1822+else instance FlushWhereWordR "REAL" currentType tables paramsIn currentType paramsIn
1823+else instance
1824+ ( ResolveColumn word tables entry
1825+ , ExtractType entry typ
1826+ , UnwrapMaybe typ unwrapped
1827+ ) =>
1828+ FlushWhereWordR word currentType tables paramsIn unwrapped paramsIn
1829+
17361830-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
17371831-- ValidateColumnList: comma-separated column references
17381832-- Used by GROUP BY, DISTINCT ON, ON CONFLICT target
test/Schema.purs+38
@@ -706,6 +706,38 @@ typedScheduleWhere
706706 :: Q _ _ (d :: PGDate) _
707707typedScheduleWhere = from scheduleTable # selectAll # where_ @"event_date = $d"
708708
709+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
710+-- Point + TSVector + TSQuery
711+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
712+
713+type LocationsTable = Table "locations"
714+ ( id :: Int # PrimaryKey # AutoIncrement
715+ , name :: String
716+ , coords :: Point
717+ )
718+
719+locationsTable :: Proxy LocationsTable
720+locationsTable = Proxy
721+
722+locationsDDL :: String
723+locationsDDL = createTableDDL @LocationsTable
724+
725+type ArticlesTable = Table "articles"
726+ ( id :: Int # PrimaryKey # AutoIncrement
727+ , title :: String
728+ , body_vector :: TSVector
729+ )
730+
731+articlesTable :: Proxy ArticlesTable
732+articlesTable = Proxy
733+
734+articlesDDL :: String
735+articlesDDL = createTableDDL @ArticlesTable
736+
737+typedFTSWhere
738+ :: Q _ _ _ _
739+typedFTSWhere = from articlesTable # selectAll # where_ @"body_vector @@ to_tsquery($q)"
740+
709741-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
710742-- Spec
711743-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -751,6 +783,12 @@ spec = do
751783 it "renders DATE and TIME in DDL" do
752784 scheduleDDL `shouldEqual` "CREATE TABLE schedule (event_date DATE NOT NULL, id INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY PRIMARY KEY, start_time TIME NOT NULL, title TEXT NOT NULL)"
753785
786+ describe "Point + TSVector + TSQuery" do
787+ it "renders POINT in DDL" do
788+ locationsDDL `shouldEqual` "CREATE TABLE locations (coords POINT NOT NULL, id INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY PRIMARY KEY, name TEXT NOT NULL)"
789+ it "renders TSVECTOR in DDL" do
790+ articlesDDL `shouldEqual` "CREATE TABLE articles (body_vector TSVECTOR NOT NULL, id INTEGER NOT NULL GENERATED ALWAYS AS IDENTITY PRIMARY KEY, title TEXT NOT NULL)"
791+
754792 describe "UPDATE SQL" do
755793 it "generates UPDATE with SET and WHERE" do
756794 updateSQL `shouldEqual` "UPDATE users SET name = $1 WHERE id = $2"