[backend/parsing] Add F# SearchQuery parser (ISH-11)

Iceshrimp.NET.sln

@@ -4,6 +4,8 @@ Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "Iceshrimp.Backend", "Iceshr
 EndProject
 Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "Iceshrimp.Tests", "Iceshrimp.Tests\Iceshrimp.Tests.csproj", "{0C93C33B-3D68-41DE-8BD6-2C19EB1C95F7}"
 EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Iceshrimp.Parsing", "Iceshrimp.Parsing\Iceshrimp.Parsing.fsproj", "{665B7CCA-6B5B-44DC-9CDB-D070622476C2}"
+EndProject
 Global
 	GlobalSection(SolutionConfigurationPlatforms) = preSolution
 		Debug|Any CPU = Debug|Any CPU
@@ -18,5 +20,9 @@ Global
 		{0C93C33B-3D68-41DE-8BD6-2C19EB1C95F7}.Debug|Any CPU.Build.0 = Debug|Any CPU
 		{0C93C33B-3D68-41DE-8BD6-2C19EB1C95F7}.Release|Any CPU.ActiveCfg = Release|Any CPU
 		{0C93C33B-3D68-41DE-8BD6-2C19EB1C95F7}.Release|Any CPU.Build.0 = Release|Any CPU
+		{665B7CCA-6B5B-44DC-9CDB-D070622476C2}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{665B7CCA-6B5B-44DC-9CDB-D070622476C2}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{665B7CCA-6B5B-44DC-9CDB-D070622476C2}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{665B7CCA-6B5B-44DC-9CDB-D070622476C2}.Release|Any CPU.Build.0 = Release|Any CPU
 	EndGlobalSection
 EndGlobal

Iceshrimp.Parsing/Iceshrimp.Parsing.fsproj

@@ -0,0 +1,16 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+    <PropertyGroup>
+        <TargetFramework>net8.0</TargetFramework>
+        <GenerateDocumentationFile>true</GenerateDocumentationFile>
+    </PropertyGroup>
+
+    <ItemGroup>
+        <Compile Include="SearchQuery.fs" />
+    </ItemGroup>
+
+    <ItemGroup>
+      <PackageReference Include="FParsec" Version="1.1.1" />
+    </ItemGroup>
+
+</Project>

Iceshrimp.Parsing/SearchQuery.fs

@@ -0,0 +1,253 @@
+namespace Iceshrimp.Parsing
+
+open System
+open FParsec
+
+module SearchQueryFilters =
+    type Filter() =
+        class
+        end
+
+    type WordFilter(neg: bool, value: string) =
+        inherit Filter()
+        member val Negated = neg
+        member val Value = value
+
+    type MultiWordFilter(values: string list) =
+        inherit Filter()
+        member val Values = values
+
+    type FromFilter(neg: bool, value: string) =
+        inherit Filter()
+        member val Negated = neg
+        member val Value = value
+
+    type MentionFilter(neg: bool, value: string) =
+        inherit Filter()
+        member val Negated = neg
+        member val Value = value
+
+    type ReplyFilter(neg: bool, value: string) =
+        inherit Filter()
+        member val Negated = neg
+        member val Value = value
+
+    type InstanceFilter(neg: bool, value: string) =
+        inherit Filter()
+        member val Negated = neg
+        member val Value = value
+
+    type MiscFilterType =
+        | Followers
+        | Following
+        | Replies
+        | Renotes
+
+    type MiscFilter(neg: bool, value: string) =
+        inherit Filter()
+        member val Negated = neg
+
+        member val Value =
+            match value with
+            | "followers" -> Followers
+            | "following" -> Following
+            | "replies" -> Replies
+            | "reply" -> Replies
+            | "boosts" -> Renotes
+            | "boost" -> Renotes
+            | "renote" -> Renotes
+            | "renotes" -> Renotes
+            | _ -> failwith $"Invalid type: {value}"
+
+    type InFilterType =
+        | Bookmarks
+        | Likes
+        | Reactions
+
+    type InFilter(neg: bool, value: string) =
+        inherit Filter()
+        member val Negated = neg
+
+        member val Value =
+            match value with
+            | "bookmarks" -> Bookmarks
+            | "likes" -> Likes
+            | "favorites" -> Likes
+            | "favourites" -> Likes
+            | "reactions" -> Reactions
+            | _ -> failwith $"Invalid type: {value}"
+
+
+    type AttachmentFilterType =
+        | Any
+        | Image
+        | Video
+        | Audio
+        | File
+
+    type AttachmentFilter(neg: bool, value: string) =
+        inherit Filter()
+        member val Negated = neg
+
+        member val Value =
+            match value with
+            | "any" -> Any
+            | "image" -> Image
+            | "video" -> Video
+            | "audio" -> Audio
+            | "file" -> File
+            | _ -> failwith $"Invalid type: {value}"
+
+    type AfterFilter(d: DateOnly) =
+        inherit Filter()
+        member val Value = d
+
+    type BeforeFilter(d: DateOnly) =
+        inherit Filter()
+        member val Value = d
+
+    type CaseFilterType =
+        | Sensitive
+        | Insensitive
+
+    type CaseFilter(v: string) =
+        inherit Filter()
+
+        member val Value =
+            match v with
+            | "sensitive" -> Sensitive
+            | "insensitive" -> Insensitive
+            | _ -> failwith $"Invalid type: {v}"
+
+    type MatchFilterType =
+        | Words
+        | Substring
+
+    type MatchFilter(v: string) =
+        inherit Filter()
+
+        member val Value =
+            match v with
+            | "word" -> Words
+            | "words" -> Words
+            | "substr" -> Substring
+            | "substring" -> Substring
+            | _ -> failwith $"Invalid type: {v}"
+
+module private SearchQueryParser =
+    open SearchQueryFilters
+
+    // Abstractions
+    let str s = pstring s
+    let tokenEnd = (skipChar ' ' <|> eof)
+    let token = anyChar |> manyCharsTill <| tokenEnd
+    let orTokenEnd = (skipChar ' ' <|> lookAhead (skipChar ')') <|> eof)
+    let orToken = spaces >>. anyChar |> manyCharsTill <| orTokenEnd
+    let key s = str s .>>? pchar ':'
+    let strEnd s = str s .>>? tokenEnd
+    let anyStr s = choice (s |> Seq.map strEnd)
+    let anyKey k = choice (k |> Seq.map key)
+    let seqAttempt s = s |> Seq.map attempt
+    let neg = opt <| pchar '-'
+    let negFilter k = pipe2 neg (anyKey k >>. token)
+    let negKeyFilter k v = pipe2 neg (anyKey k >>. anyStr v)
+    let keyFilter k v = anyKey k >>. anyStr v
+    let strSepByOr = sepBy orToken (str "OR ")
+
+    let parseDate (s: string) =
+        match DateOnly.TryParseExact(s, "O") with
+        | true, result -> preturn result
+        | false, _ -> fail $"Invalid date: {s}"
+
+    let dateFilter k = anyKey k >>. token >>= parseDate
+
+    // Filters
+    let wordFilter = pipe2 neg token <| fun a b -> WordFilter(a.IsSome, b) :> Filter
+
+    let multiWordFilter =
+        skipChar '(' >>. strSepByOr .>> skipChar ')'
+        |>> fun v -> MultiWordFilter(v) :> Filter
+
+    let literalStringFilter =
+        skipChar '"' >>. manyCharsTill anyChar (skipChar '"')
+        |>> fun v -> WordFilter(false, v) :> Filter
+
+    let fromFilter =
+        negFilter [ "from"; "author"; "by"; "user" ]
+        <| fun n v -> FromFilter(n.IsSome, v) :> Filter
+
+    let mentionFilter =
+        negFilter [ "mention"; "mentions"; "mentioning" ]
+        <| fun n v -> MentionFilter(n.IsSome, v) :> Filter
+
+    let replyFilter =
+        negFilter [ "reply"; "replying"; "to" ]
+        <| fun n v -> ReplyFilter(n.IsSome, v) :> Filter
+
+    let instanceFilter =
+        negFilter [ "instance"; "domain"; "host" ]
+        <| fun n v -> InstanceFilter(n.IsSome, v) :> Filter
+
+    let miscFilter =
+        negKeyFilter
+            [ "filter" ]
+            [ "followers"
+              "following"
+              "replies"
+              "reply"
+              "renote"
+              "renotes"
+              "boosts"
+              "boost" ]
+        <| fun n v -> MiscFilter(n.IsSome, v) :> Filter
+
+    let inFilter =
+        negKeyFilter [ "in" ] [ "bookmarks"; "favorites"; "favourites"; "reactions"; "likes" ]
+        <| fun n v -> InFilter(n.IsSome, v) :> Filter
+
+    let attachmentFilter =
+        negKeyFilter [ "has"; "attachment"; "attached" ] [ "any"; "image"; "video"; "audio"; "file" ]
+        <| fun n v -> AttachmentFilter(n.IsSome, v) :> Filter
+
+    let afterFilter =
+        dateFilter [ "after"; "since" ] |>> fun v -> AfterFilter(v) :> Filter
+
+    let beforeFilter =
+        dateFilter [ "before"; "until" ] |>> fun v -> BeforeFilter(v) :> Filter
+
+    let caseFilter =
+        keyFilter [ "case" ] [ "sensitive"; "insensitive" ]
+        |>> fun v -> CaseFilter(v) :> Filter
+
+    let matchFilter =
+        keyFilter [ "match" ] [ "words"; "word"; "substr"; "substring" ]
+        |>> fun v -> MatchFilter(v) :> Filter
+
+    // Filter collection
+    let filterSeq =
+        [ literalStringFilter
+          fromFilter
+          mentionFilter
+          replyFilter
+          instanceFilter
+          miscFilter
+          inFilter
+          attachmentFilter
+          afterFilter
+          beforeFilter
+          caseFilter
+          matchFilter
+          multiWordFilter
+          wordFilter ]
+
+    // Final parse commands
+    let filters = choice <| seqAttempt filterSeq
+    let parse = manyTill (spaces >>. filters .>> spaces) eof
+
+module SearchQuery =
+    open SearchQueryParser
+
+    let parse str =
+        match run parse str with
+        | Success(result, _, _) -> result
+        | Failure(s, _, _) -> failwith $"Failed to parse query: {s}"