git.iko.soy/rowtype-yoga/purescript-yoga-postgres
on main help sign in
Add Point, TSVector, TSQuery types; add REAL/SMALLINT/FTS keywords
bbfdc0aMark
src/Yoga/Postgres/Schema.purs+96−2
compare with main
unifiedsplit
@@ -132,6 +132,51 @@ instance ReadForeign PGTime where
132 dt :: DateTime <- readImpl f
132 dt :: DateTime <- readImpl f
133 pure (PGTime (time dt))
133 pure (PGTime (time dt))
134
134
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+
135-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
180-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
136-- Nullability: inferred from Maybe
181-- Nullability: inferred from Maybe
137-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
182-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -194,6 +239,15 @@ instance PGTypeName PGDate where
194instance PGTypeName PGTime where
239instance PGTypeName PGTime where
195 pgTypeName _ = "TIME"
240 pgTypeName _ = "TIME"
196
241
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+
197instance PGTypeName Jsonb where
251instance PGTypeName Jsonb where
198 pgTypeName _ = "JSONB"
252 pgTypeName _ = "JSONB"
199
253
@@ -1489,8 +1543,12 @@ else instance FlushWhereWordU word currentType tables paramsIn currentTypeOut pa
1489else instance FlushWhereWordU word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "u" word currentType tables paramsIn currentTypeOut paramsOut
1543else instance FlushWhereWordU word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "u" word currentType tables paramsIn currentTypeOut paramsOut
1490else instance FlushWhereWordV word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "V" word currentType tables paramsIn currentTypeOut paramsOut
1544else instance FlushWhereWordV word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "V" word currentType tables paramsIn currentTypeOut paramsOut
1491else instance FlushWhereWordV word currentType tables paramsIn currentTypeOut paramsOut => FlushWhereWordByHead "v" word currentType tables paramsIn currentTypeOut paramsOut
1545else 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
1492
1550
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)
1494else instance
1552else instance
1495 ( ResolveColumn word tables entry
1553 ( ResolveColumn word tables entry
1496 , ExtractType entry typ
1554 , ExtractType entry typ
@@ -1679,7 +1737,9 @@ else instance
1679class FlushWhereWordS :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint
1737class FlushWhereWordS :: Symbol -> Type -> Row (Row Type) -> RL.RowList Type -> Type -> RL.RowList Type -> Constraint
1680class FlushWhereWordS word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut
1738class FlushWhereWordS word currentType tables paramsIn currentTypeOut paramsOut | word currentType tables paramsIn -> currentTypeOut paramsOut
1681
1739
1740+instance FlushWhereWordS "SMALLINT" currentType tables paramsIn currentType paramsIn
1741+else instance FlushWhereWordS "smallint" currentType tables paramsIn currentType paramsIn
1682−instance FlushWhereWordS "SUM" currentType tables paramsIn currentType paramsIn
1742+else instance FlushWhereWordS "SUM" currentType tables paramsIn currentType paramsIn
1683else instance FlushWhereWordS "sum" currentType tables paramsIn currentType paramsIn
1743else instance FlushWhereWordS "sum" currentType tables paramsIn currentType paramsIn
1684else instance FlushWhereWordS "STRING_AGG" currentType tables paramsIn String paramsIn
1744else instance FlushWhereWordS "STRING_AGG" currentType tables paramsIn String paramsIn
1685else instance FlushWhereWordS "string_agg" currentType tables paramsIn String paramsIn
1745else instance FlushWhereWordS "string_agg" currentType tables paramsIn String paramsIn
@@ -1702,6 +1762,14 @@ else instance FlushWhereWordT "timestamptz" currentType tables paramsIn currentT
1702else instance FlushWhereWordT "timestamp" currentType tables paramsIn currentType paramsIn
1762else instance FlushWhereWordT "timestamp" currentType tables paramsIn currentType paramsIn
1703else instance FlushWhereWordT "TIME" currentType tables paramsIn currentType paramsIn
1763else instance FlushWhereWordT "TIME" currentType tables paramsIn currentType paramsIn
1704else instance FlushWhereWordT "time" currentType tables paramsIn currentType paramsIn
1764else 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
1705else instance
1773else instance
1706 ( ResolveColumn word tables entry
1774 ( ResolveColumn word tables entry
1707 , ExtractType entry typ
1775 , ExtractType entry typ
@@ -1733,6 +1801,32 @@ else instance
1733 ) =>
1801 ) =>
1734 FlushWhereWordV word currentType tables paramsIn unwrapped paramsIn
1802 FlushWhereWordV word currentType tables paramsIn unwrapped paramsIn
1735
1803
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+
1736-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
1830-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
1737-- ValidateColumnList: comma-separated column references
1831-- ValidateColumnList: comma-separated column references
1738-- Used by GROUP BY, DISTINCT ON, ON CONFLICT target
1832-- Used by GROUP BY, DISTINCT ON, ON CONFLICT target
test/Schema.purs+38
@@ -706,6 +706,38 @@ typedScheduleWhere
706 :: Q _ _ (d :: PGDate) _
706 :: Q _ _ (d :: PGDate) _
707typedScheduleWhere = from scheduleTable # selectAll # where_ @"event_date = $d"
707typedScheduleWhere = from scheduleTable # selectAll # where_ @"event_date = $d"
708
708
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+
709-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
741-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
710-- Spec
742-- Spec
711-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
743-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -751,6 +783,12 @@ spec = do
751 it "renders DATE and TIME in DDL" do
783 it "renders DATE and TIME in DDL" do
752 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)"
784 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)"
753
785
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+
754 describe "UPDATE SQL" do
792 describe "UPDATE SQL" do
755 it "generates UPDATE with SET and WHERE" do
793 it "generates UPDATE with SET and WHERE" do
756 updateSQL `shouldEqual` "UPDATE users SET name = $1 WHERE id = $2"
794 updateSQL `shouldEqual` "UPDATE users SET name = $1 WHERE id = $2"