git.iko.soy/denis
on master help sign in
Added faculty search function
e26a709iko
denis/sql/indexes.sqlnew file+5
compare with master
unifiedsplit
@@ -0,0 +1,5 @@
1+CREATE OR REPLACE FUNCTION my_array_to_text(text[])
2+ RETURNS text LANGUAGE sql IMMUTABLE AS $$SELECT array_to_string($1, ' ')$$;
3+
4+CREATE INDEX "faculty_text" ON "faculties" USING GIN (to_tsvector('russian', "facultyName" || ' ' || "facultyPath" || ' ' || "facultyCampusName" || ' ' || my_array_to_text("facultyTags")))
5+
denis/src/Data/Faculty/Parser.hs+5−2
@@ -43,7 +43,7 @@ getCampuses = do
43 processCampus :: (HM.HashMap T.Text T.Text, T.Text) -> Maybe Campus
43 processCampus :: (HM.HashMap T.Text T.Text, T.Text) -> Maybe Campus
44 processCampus (hm, name) = do
44 processCampus (hm, name) = do
45 code <- HM.lookup "hse-value" hm
45 code <- HM.lookup "hse-value" hm
46− return $ Campus name code
46+ return $ Campus (T.strip name) code
47
47
48
48
49getFacultiesForCampus :: Campus -> Req [Faculty]
49getFacultiesForCampus :: Campus -> Req [Faculty]
@@ -58,7 +58,10 @@ getFacultiesForCampus (Campus cName cCode) = do
58 let els = elements [NodeElement el]
58 let els = elements [NodeElement el]
59 nameTag <- listToMaybe . texts' mempty . map (NodeElement) . filter (classIs "link large b") $ els
59 nameTag <- listToMaybe . texts' mempty . map (NodeElement) . filter (classIs "link large b") $ els
60 let name = T.strip . snd $ nameTag
60 let name = T.strip . snd $ nameTag
61− url <- HM.lookup "href" . fst $ nameTag
61+ url <- (T.strip . snd . T.breakOnEnd "://") <$> (HM.lookup "href" . fst $ nameTag)
62+ _ <- if T.null url
63+ then Nothing
64+ else Just ()
62 let tags = map (T.strip . snd) . texts' mempty . map (NodeElement) . filter (classIs "with-indent small tag-set") $ els
65 let tags = map (T.strip . snd) . texts' mempty . map (NodeElement) . filter (classIs "with-indent small tag-set") $ els
63 let path = T.unwords . map (T.strip . snd) . texts' mempty . map (NodeElement) . filter (classIs "small") $ els
66 let path = T.unwords . map (T.strip . snd) . texts' mempty . map (NodeElement) . filter (classIs "small") $ els
64 return $ Faculty name url path cName cCode (V.fromList tags)
67 return $ Faculty name url path cName cCode (V.fromList tags)
denis/src/Data/Query.hs+63−1
@@ -42,7 +42,8 @@ module Data.Query (
42 leaveGroupChat,
42 leaveGroupChat,
43 getGroupChatForUser,
43 getGroupChatForUser,
44 getFaculty,
44 getFaculty,
45− updateFaculty
45+ updateFaculty,
46+ getFacultyFromQuery
46) where
47) where
47
48
48import Squeal.PostgreSQL
49import Squeal.PostgreSQL
@@ -69,6 +70,7 @@ import Servant.Docs
69import Data.Proxy
70import Data.Proxy
70import Data.Vector (Vector, toList, fromList)
71import Data.Vector (Vector, toList, fromList)
71import Data.Text (Text)
72import Data.Text (Text)
73+import qualified Data.Text as T
72import Data.Channel.NamedChannel
74import Data.Channel.NamedChannel
73import Data.Channel.AnonymousChannel
75import Data.Channel.AnonymousChannel
74import Data.Maybe (fromMaybe)
76import Data.Maybe (fromMaybe)
@@ -78,6 +80,9 @@ import Data.Message
78import Server.Query.Dialog
80import Server.Query.Dialog
79import qualified Server.Query.Pagination as P
81import qualified Server.Query.Pagination as P
80import Data.Faculty
82import Data.Faculty
83+import Data.ByteString (ByteString)
84+import Data.Foldable (fold)
85+import Data.Char
81
86
82-- MARK: Documentation
87-- MARK: Documentation
83
88
@@ -447,6 +452,56 @@ getGroupChatForUserQ = selectStar $
447 where_ (#groupChatId .== param @2) &
452 where_ (#groupChatId .== param @2) &
448 where_ (#groupChatUsers .? param @1)
453 where_ (#groupChatUsers .? param @1)
449
454
455+getFacultySearchResultQ :: Query Schema (TuplePG (Only Text)) (RowPG Faculty)
456+getFacultySearchResultQ = selectStar (from (table #faculties) &
457+ where_ (vector @@ query) &
458+ orderBy [tsRankCd vector query & Desc])
459+ where
460+ vector = tsVector "russian" (textArrayToText [
461+ #facultyName,
462+ #facultyPath,
463+ #facultyCampusName,
464+ (arrayToText #facultyTags)])
465+ query = tsQuery (param @1)
466+
467+tsRankCd
468+ :: Expression schema from grouping params ('NotNull 'PGtext)
469+ -> Expression schema from grouping params ('NotNull 'PGtext)
470+ -> Expression schema from grouping params ('NotNull 'PGfloat4)
471+tsRankCd vector query = UnsafeExpression $
472+ "ts_rank_cd" <> parenthesized (commaSeparated . map renderExpression $ [vector, query])
473+
474+tsVector
475+ :: ByteString -- ^ Language
476+ -> Expression schema from grouping params ('NotNull 'PGtext)
477+ -> Expression schema from grouping params ('NotNull 'PGtext)
478+tsVector lang x = UnsafeExpression $
479+ "to_tsvector" <> parenthesized (commaSeparated [singleQuotedUtf8 lang, renderExpression x])
480+
481+tsQuery
482+ :: Expression schema from grouping params ('NotNull 'PGtext)
483+ -> Expression schema from grouping params ('NotNull 'PGtext)
484+tsQuery = unsafeFunction "to_tsquery"
485+
486+arrayToText
487+ :: Expression schema from grouping params ('NotNull ('PGvararray ('NotNull 'PGtext)))
488+ -> Expression schema from grouping params ('NotNull 'PGtext)
489+arrayToText x = UnsafeExpression $
490+ "array_to_string" <> parenthesized (commaSeparated [renderExpression x, "' '"])
491+
492+(@@)
493+ :: Expression schema from grouping params (nullity0 'PGtext)
494+ -> Expression schema from grouping params (nullity1 'PGtext)
495+ -> Expression schema from grouping params (nullity2 'PGbool)
496+(@@) = unsafeBinaryOp "@@"
497+
498+space :: Expression schema from grouping params ('NotNull 'PGtext)
499+space = UnsafeExpression "' '"
500+
501+textArrayToText
502+ :: [Expression schema from grouping params ('NotNull 'PGtext)]
503+ -> Expression schema from grouping params ('NotNull 'PGtext)
504+textArrayToText = fold . L.intersperse space
450
505
451-- MARK: FrontEnd Data Structures
506-- MARK: FrontEnd Data Structures
452
507
@@ -694,8 +749,15 @@ getGroupChatForUser uId gId = do
694 (Just c) -> return c
749 (Just c) -> return c
695 Nothing -> lift $ S.throwError S.err404
750 Nothing -> lift $ S.throwError S.err404
696
751
752+getFacultyFromQuery :: T.Text -> StaticPQ [Faculty]
753+getFacultyFromQuery query =
754+ runQueryParams getFacultySearchResultQ (Only . queryFromText $ query) >>= getRows
755+
697-- MARK: Utils
756-- MARK: Utils
698
757
758+queryFromText :: Text -> Text
759+queryFromText = T.unwords . L.intersperse "&" . map (`T.append` ":*") . filter (not . T.null) . T.split (not . isAlphaNum)
760+
699directionToOperator
761directionToOperator
700 :: P.PaginationDirection
762 :: P.PaginationDirection
701 -> (ConditionOp schema0 from0 grouping0 params0 nullity0 nullity1 (ty :: PGType),
763 -> (ConditionOp schema0 from0 grouping0 params0 nullity0 nullity1 (ty :: PGType),
denis/src/Data/Schema.hs+2−2
@@ -144,7 +144,7 @@ type Schema =
144
144
145 "faculties" ::: 'Table (
145 "faculties" ::: 'Table (
146 '[
146 '[
147− "pk_faculties" ::: 'PrimaryKey '["facultyName"]
147+ "pk_faculties" ::: 'PrimaryKey '["facultyURL"]
148 ] :=>
148 ] :=>
149 '[
149 '[
150 "facultyName" ::: 'NoDef :=> 'NotNull 'PGtext,
150 "facultyName" ::: 'NoDef :=> 'NotNull 'PGtext,
@@ -264,7 +264,7 @@ createTables = createTable #users (
264 notNullable text `as` #facultyCampusCode :*
264 notNullable text `as` #facultyCampusCode :*
265 notNullable (vararray text) `as` #facultyTags
265 notNullable (vararray text) `as` #facultyTags
266 ) (
266 ) (
267− primaryKey #facultyName `as` #pk_faculties
267+ primaryKey #facultyURL `as` #pk_faculties
268 )
268 )
269-- quoteUniquenessCheck :: TableConstraintExpression Schema _ (Check '["rowElementOrd", "rowElementMarkdown", "rowElementLatex", "rowElementImage", "rowElementQuote", "rowElementAttachment"])
269-- quoteUniquenessCheck :: TableConstraintExpression Schema _ (Check '["rowElementOrd", "rowElementMarkdown", "rowElementLatex", "rowElementImage", "rowElementQuote", "rowElementAttachment"])
270-- quoteUniquenessCheck = check (#rowElementOrd :* #rowElementMarkdown :* #rowElementLatex :* #rowElementImage :* #rowElementQuote :* #rowElementAttachment) $
270-- quoteUniquenessCheck = check (#rowElementOrd :* #rowElementMarkdown :* #rowElementLatex :* #rowElementImage :* #rowElementQuote :* #rowElementAttachment) $