Merge pull request #7 from j2ghz/search

Search

paket.dependencies

@@ -4,6 +4,9 @@ group Server
     storage: none
 
     nuget FSharp.Core
+    nuget Lucene.Net ~> 4.8 prerelease
+    nuget Lucene.Net.Analysis.Common ~> 4.8 prerelease
+    nuget Lucene.Net.QueryParser ~> 4.8 prerelease
     nuget Saturn
     nuget Fable.Remoting.Giraffe ~> 3
     nuget Fsharp.Data

paket.lock

@@ -820,6 +820,18 @@ NUGET
       System.Xml.XmlSerializer (>= 4.3)
       TaskBuilder.fs (>= 2.1)
       Utf8Json (>= 1.3.7)
+    Lucene.Net (4.8.0-beta00006)
+      Microsoft.CSharp (>= 4.4)
+    Lucene.Net.Analysis.Common (4.8.0-beta00006)
+      Lucene.Net (>= 4.8.0-beta00006)
+    Lucene.Net.Queries (4.8.0-beta00006)
+      Lucene.Net (>= 4.8.0-beta00006)
+    Lucene.Net.QueryParser (4.8.0-beta00006)
+      Lucene.Net.Analysis.Common (>= 4.8.0-beta00006)
+      Lucene.Net.Queries (>= 4.8.0-beta00006)
+      Lucene.Net.Sandbox (>= 4.8.0-beta00006)
+    Lucene.Net.Sandbox (4.8.0-beta00006)
+      Lucene.Net (>= 4.8.0-beta00006)
     Microsoft.AspNetCore (2.2)
       Microsoft.AspNetCore.Diagnostics (>= 2.2)
       Microsoft.AspNetCore.HostFiltering (>= 2.2)
@@ -1038,6 +1050,7 @@ NUGET
     Microsoft.AspNetCore.WebUtilities (2.2)
       Microsoft.Net.Http.Headers (>= 2.2)
       System.Text.Encodings.Web (>= 4.5)
+    Microsoft.CSharp (4.6)
     Microsoft.Extensions.Caching.Abstractions (3.0)
       Microsoft.Extensions.Primitives (>= 3.0)
     Microsoft.Extensions.Caching.Memory (3.0)

src/Client/Quests/State.fs

@@ -7,7 +7,8 @@ open Elmish
 let init route =
     { Sources = Shared.Remote.Empty
       QuestLines = Empty
-      QuestLine = Empty }, Cmd.ofMsg LoadSources
+      QuestLine = Empty
+      SearchResults = Empty }, Cmd.ofMsg LoadSources
 
 let urlUpdate page =
     match page with
@@ -16,7 +17,9 @@ let urlUpdate page =
     | QuestLine(s, i) ->
         Cmd.batch
             [ Cmd.ofMsg (LoadQuestLine(s, i))
-              Cmd.ofMsg (LoadQuestLines s) ]
+              //Cmd.ofMsg (LoadQuestLines s)
+             ]
+    | Search(s, st) -> Cmd.ofMsg (LoadSearchResults(s, st))
 
 let update model =
     function
@@ -47,4 +50,9 @@ let update model =
         { model with QuestLine = Loading },
         Cmd.OfAsync.either (Server.API.questLineById s) i LoadQuestLineFinished LoadQuestLineError
     | LoadQuestLineFinished qli -> { model with QuestLine = Body qli }, Cmd.Empty
-    | LoadQuestLineError(_) -> failwith "Not Implemented"
+    | LoadQuestLineError e -> { model with QuestLine = LoadError(e |> string) }, Cmd.Empty
+    | LoadSearchResults(s, st) ->
+        { model with SearchResults = Empty },
+        Cmd.OfAsync.either Server.API.questSearch (s, st) LoadSearchResultsFinished LoadSearchResultsError
+    | LoadSearchResultsFinished s -> { model with SearchResults = Body s }, Cmd.Empty
+    | LoadSearchResultsError e -> { model with SearchResults = LoadError(e |> string) }, Cmd.Empty

src/Client/Quests/Types.fs

@@ -1,24 +1,34 @@
 module Quests.Types
 
 open Shared
+open Elmish
 
 type Page =
     | Home
     | SelectedSource of source: Source
     | QuestLine of Source * int
+    | Search of Source * string
 
 type Msg =
+    //Sources
     | LoadSources
     | LoadSourcesFinished of Source list
     | LoadSourcesError of exn
+    //QuestLines
     | LoadQuestLines of Source
     | LoadQuestLinesFinished of Shared.QuestLineInfo list
     | LoadQuestLinesError of exn
+    //QuestLine
     | LoadQuestLine of Source * int
     | LoadQuestLineFinished of Shared.QuestLine
     | LoadQuestLineError of exn
+    //Search
+    | LoadSearchResults of Source * string
+    | LoadSearchResultsFinished of QuestSearchResult list
+    | LoadSearchResultsError of exn
 
 type State =
     { Sources: Shared.Source list Remote
       QuestLines: Shared.QuestLineInfo list Remote
-      QuestLine: Shared.QuestLine Remote }
+      QuestLine: Shared.QuestLine Remote
+      SearchResults: Shared.QuestSearchResult list Remote }

src/Client/Quests/View.fs

@@ -4,8 +4,11 @@ open Fable.React.Standard
 open Fable.React.Helpers
 open Fable.React.Props
 open Fulma
+open Types
 open Shared
 open Fulma.Extensions.Wikiki
+open Fable.Core.JsInterop
+open Elmish.Navigation
 
 let navbarSource urlMaker s =
     Navbar.Item.a
@@ -28,7 +31,7 @@ let navbarItem (model: Types.State) currentPage urlMaker =
               [ Navbar.Link.a [] [ str "Quests" ]
                 Navbar.Dropdown.div [] (sources |> List.map (navbarSource urlMaker)) ] ]
 
-let menu s (model: Types.State) urlMaker =
+let menu s (model: Types.State) urlMaker i =
     [ Menu.label [] [ str s ]
       Menu.list []
           (match model.QuestLines with
@@ -39,11 +42,12 @@ let menu s (model: Types.State) urlMaker =
                qlis
                |> List.map (fun qli ->
                    Menu.Item.li
-                       [ Menu.Item.Props
-                           [ (s, qli.Id)
-                             |> Types.Page.QuestLine
-                             |> urlMaker
-                             |> Href ] ] [ str qli.Name ])) ]
+                       [ Menu.Item.IsActive(qli.Id = i)
+                         Menu.Item.Props
+                             [ (s, qli.Id)
+                               |> Types.Page.QuestLine
+                               |> urlMaker
+                               |> Href ] ] [ str qli.Name ])) ]
 
 let questLineInfo (ql: Shared.QuestLineInfo) =
     Hero.hero []
@@ -98,8 +102,8 @@ let questLineQuestGridItem (qlq: QuestLineQuest) =
               SVGAttr.Y y
               SVGAttr.Stroke "black" ] [] ]
 
-let questLineQuestGridConnections qlqs =
-    let questById id = List.tryFind (fun q -> q.Id = id) qlqs
+let questLineQuestGridConnections (qlqs: QuestLineQuest list) =
+    let questById id = List.tryFind (fun (q: QuestLineQuest) -> q.Id = id) qlqs
     let prereqQuests qlq = qlq.Quest.Prerequisites |> List.choose questById
 
     let questCenter q =
@@ -144,19 +148,45 @@ let questLineView ql =
                   yield! questLineQuestGridConnections ql.Quests ] ]
       div [] (ql.Quests |> List.map questCard) ]
 
+let search s (dispatch: Types.Msg -> unit) value =
+    Input.search
+        [ Input.Placeholder "Search Quests"
+          Input.ValueOrDefault value
+          Input.OnChange(fun e ->
+              (s, !!e.target?value)
+              |> LoadSearchResults
+              |> dispatch) ]
+
 let view (currentPage: Types.Page) urlMaker (model: Types.State) (dispatch: Types.Msg -> unit) =
-    [ Columns.columns []
-          [ Column.column [ Column.Width(Screen.All, Column.Is3) ]
-                [ Menu.menu []
-                      (match currentPage with
-                       | Types.Page.Home -> [ Menu.label [] [ str "Select a source" ] ]
-                       | Types.Page.SelectedSource s -> menu s model urlMaker
-                       | Types.Page.QuestLine(s, i) -> menu s model urlMaker) ]
-            Column.column [ Column.Width(Screen.All, Column.Is9) ]
-                [ yield! (match model.QuestLine with
-                          | Empty -> [ str "Select a source and a questline" ]
-                          | Loading -> [ str "Loading QuestLine" ]
-                          | LoadError e ->
-                              [ sprintf "Loading QuestLine failed:\n%s" e
-                                |> str ]
-                          | Body ql -> questLineView ql) ] ] ]
+    match currentPage with
+    | Home -> [ str "Select a source" ]
+    | SelectedSource s ->
+        search s dispatch "" :: [ Columns.columns []
+                                      [ Column.column [ Column.Width(Screen.All, Column.Is3) ]
+                                            [ Menu.menu [] (menu s model urlMaker -1) ]
+                                        Column.column [ Column.Width(Screen.All, Column.Is9) ] [] ] ]
+    | QuestLine(s, i) ->
+        [ Columns.columns []
+              [ Column.column [ Column.Width(Screen.All, Column.Is2) ] [ Menu.menu [] (menu s model urlMaker i) ]
+                Column.column [ Column.Width(Screen.All, Column.Is10) ]
+                    [ yield! (match model.QuestLine with
+                              | Empty -> [ str "Select a source and a questline" ]
+                              | Loading -> [ str "Loading QuestLine" ]
+                              | LoadError e ->
+                                  [ sprintf "Loading QuestLine failed:\n%s" e
+                                    |> str ]
+                              | Body ql -> questLineView ql) ] ] ]
+    | Search(s, st) ->
+        search s dispatch st :: match model.SearchResults with
+                                | Empty -> [ str "Search for something" ]
+                                | Loading -> [ str "Searching" ]
+                                | LoadError e ->
+                                    [ str "Searching error:"
+                                      str e ]
+                                | Body results ->
+                                    [ div []
+                                          (results
+                                           |> List.map (fun r ->
+                                               Box.box' []
+                                                   [ Heading.h2 [] [ str r.Name ]
+                                                     p [] [ str r.Description ] ])) ]

src/Client/State.fs

@@ -13,6 +13,7 @@ let pageHash =
         | Quests.Types.Page.Home -> "#/Quests"
         | Quests.Types.Page.SelectedSource s -> sprintf "#/Quests/%s" s
         | Quests.Types.Page.QuestLine(s, qli) -> sprintf "#/Quests/%s/%i" s qli
+        | Quests.Types.Page.Search(s, st) -> sprintf "#/Quests/%s/Search/%s" s st
     | Recipes r ->
         match r with
         | Recipes.Types.Page.Home -> "#/Recipes"
@@ -61,7 +62,9 @@ let route state =
           map (Recipes << Recipes.Types.Page.SelectedSource) (s "Recipes" </> str)
           map (Quests Quests.Types.Page.Home) (s "Quests")
           map (Quests << Quests.Types.Page.SelectedSource) (s "Quests" </> str)
-          map (fun s i -> Quests.Types.Page.QuestLine(s, i) |> Quests) (s "Quests" </> str </> i32) ] state
+          map (fun s i -> Quests.Types.Page.QuestLine(s, i) |> Quests) (s "Quests" </> str </> i32)
+          map (fun s st -> Quests.Types.Page.Search(s, st) |> Quests) (s "Quests" </> str </> s "Search" </> str) ]
+        state
 
 let a loc = parseHash route loc
 

src/Server/Parsers.fs

@@ -80,7 +80,7 @@ module RecEx =
 module BQv3 =
     open Shared
 
-    type private BetterQuestingDB = FSharp.Data.JsonProvider<"./SampleData/DefaultQuests-2.0.7.6c-dev-cleaned-minified.json">
+    type private BetterQuestingDB = FSharp.Data.JsonProvider<"./SampleData/DefaultQuests-2.0.7.7-dev-cleaned-minified.json">
 
     let mapQuestLine id (ql: BetterQuestingDB.QuestLine) =
         { Id = ql.LineId

src/Server/Search.fs

@@ -0,0 +1,56 @@
+module Search
+
+open Lucene.Net.Util
+open Lucene.Net.Store
+open System.IO
+open Lucene.Net.Index
+open Shared
+open Lucene.Net.Documents
+open Lucene.Net.Search
+open Lucene.Net.QueryParsers.Simple
+open System.Collections.Generic
+open System.Linq
+
+[<Literal>]
+let VERSION = LuceneVersion.LUCENE_48
+
+let questSearch quests =
+    let storage = new RAMDirectory() //new MMapDirectory(DirectoryInfo("./lucene-index"))
+    let analyzer = new Lucene.Net.Analysis.Standard.StandardAnalyzer(VERSION)
+    let indexConfig = IndexWriterConfig(VERSION, analyzer)
+    let writer = new IndexWriter(storage, indexConfig)
+
+    let questToDoc (quest: Quest) =
+        let doc = Document()
+        doc.AddInt32Field("ID", quest.Id, Field.Store.YES) |> ignore
+        doc.AddTextField("Name", quest.Name, Field.Store.YES) |> ignore
+        doc.AddTextField("Description", quest.Description, Field.Store.YES) |> ignore
+        doc :> IIndexableField seq
+
+    quests
+    |> List.map questToDoc
+    |> writer.AddDocuments
+    do writer.Flush(true, true)
+
+    let reader = writer.GetReader(false)
+    let searcher = IndexSearcher(reader)
+
+    let parser =
+        SimpleQueryParser
+            (analyzer,
+             dict
+                 [ "Name", 0.5f
+                   "Description", 0.5f ])
+
+    let getDoc id =
+        let doc = searcher.Doc(id)
+        { Id = doc.GetField("ID").GetInt32Value().GetValueOrDefault()
+          Name = doc.Get("Name")
+          Description = doc.Get("Description") }
+
+    fun searchText ->
+        let query = parser.Parse(searchText)
+        searcher.Search(query, 20).ScoreDocs
+        |> Array.toList
+        |> List.sortBy (fun d -> d.Score)
+        |> List.map (fun d -> d.Doc |> getDoc)

src/Server/Server.fs

@@ -28,34 +28,41 @@ let questSources =
     [ "2.0.7.5",
       Parsers.BQv1.parser "./SampleData/DefaultQuests-2.0.7.5-cleaned-minified.json"
 
-      "2.0.7.6c-dev",
-      Parsers.BQv3.parser "./SampleData/DefaultQuests-2.0.7.6c-dev-cleaned-minified.json"
+      "2.0.7.7-dev",
+      Parsers.BQv3.parser "./SampleData/DefaultQuests-2.0.7.7-dev-cleaned-minified.json"  ]
 
-      "2.0.7.6d-dev",
-      Parsers.BQv3.parser "./SampleData/DefaultQuests-2.0.7.6d-dev-cleaned-minified.json"
-
-      "2.0.7.6e-dev",
-      Parsers.BQv3.parser "./SampleData/DefaultQuests-2.0.7.6e-dev-cleaned-minified.json"  ]
+      |> List.map (fun (id,parser) -> (id,parser, Search.questSearch parser.getQuests))
 
 let recipeSources =
     [ "2.0.7.5",
-      Async.RunSynchronously <| Parsers.RecEx.parser "./SampleData/v2.0.7.5-gt-shaped-shapeless-cleaned-minified.json" ]
+      Parsers.RecEx.parser "./SampleData/v2.0.7.5-gt-shaped-shapeless-cleaned-minified.json", "" ]
+
+let fst3 (a,b,c) = a
+let snd3 (a,b,c) = b
+let trd3 (a,b,c) = c
 
 let parserBySourceId list (src:Source) =
     list
-    |> List.where (fst >> ((=) src))
+    |> List.where (fst3 >> ((=) src))
+    |> List.exactlyOne
+    |> snd3
+
+let searcherBySourceId list (src:Source) =
+    list
+    |> List.where (fst3 >> ((=) src))
     |> List.exactlyOne
-    |> snd
+    |> trd3
 
-let rnd = System.Random()
 let api : IApi =
-    { questSources = fun () -> async { return questSources |> List.map fst }
+    { questSources = fun () -> async { return questSources |> List.map fst3 }
       quests = fun src -> async { return (parserBySourceId questSources src).getQuests }
       questLines = fun src -> async { return (parserBySourceId questSources src).getQuestLines }
       questLineById = fun src id -> async { return (parserBySourceId questSources src).getQuestLineById id }
-      recipeSources = fun () -> async { return recipeSources |> List.map fst }
-      recipes = fun src -> async { return ((parserBySourceId recipeSources src).getRecipes |> List.choose (fun i -> if rnd.Next(0,10000) <= 1 then Some i else None)) };
-      items = fun src -> async {return (parserBySourceId recipeSources src).getItems} }
+      questSearch = fun (src,searchText) -> async { return searchText |> (searcherBySourceId questSources src) }
+      recipeSources = fun () -> async { return recipeSources |> List.map fst3 }
+      items = fun src -> async {
+          let! parser = parserBySourceId recipeSources src
+          return parser.getItems} }
 
 let webApp =
     Remoting.createApi()

src/Server/Server.fsproj

@@ -1,14 +1,15 @@
 <Project Sdk="Microsoft.NET.Sdk.Web">
-    <PropertyGroup>
-        <OutputType>Exe</OutputType>
-        <TargetFramework>netcoreapp3.0</TargetFramework>
-    </PropertyGroup>
-    <ItemGroup>
-        <None Include="paket.references" />
-        <None Include="SampleData/*" CopyToOutputDirectory="Always" />
-        <Compile Include="../Shared/Shared.fs" />
-        <Compile Include="Parsers.fs" />
-        <Compile Include="Server.fs" />
-    </ItemGroup>
-    <Import Project="..\..\.paket\Paket.Restore.targets" />
+  <PropertyGroup>
+    <OutputType>Exe</OutputType>
+    <TargetFramework>netcoreapp3.0</TargetFramework>
+  </PropertyGroup>
+  <ItemGroup>
+    <None Include="paket.references" />
+    <None Include="SampleData/*" />
+    <Compile Include="../Shared/Shared.fs" />
+    <Compile Include="Parsers.fs" />
+    <Compile Include="Search.fs" />
+    <Compile Include="Server.fs" />
+  </ItemGroup>
+  <Import Project="..\..\.paket\Paket.Restore.targets" />
 </Project>

src/Server/paket.references

@@ -3,3 +3,6 @@ group Server
     Saturn
     Fable.Remoting.Giraffe
     Fsharp.Data
+    Lucene.Net
+    Lucene.Net.Analysis.Common
+    Lucene.Net.QueryParser