fscode.fs

namespace Application.Domain

open System
open Application.Domain
open Common
open System.Collections.Generic
open System.Threading.Tasks
open Application
open FSharp.UMX

[<Struct>]
type ScoredItem<'a> = { Item: 'a; Score: int }

[<Struct>]
type DocId =
    | GameEventId of GameEventId
    | CasinoGameId of CasinoGameId * CasinoLobbyId
    | StaticDocId of url:string


type Document =
    | GameEventDoc of GameEvent
    | CasinoGameDoc of CasinoGame
    | StaticDoc     of StaticDoc
    
    
type RefType =
    | CasinoName
    | GameEventName
    | CategoryName
    | TournamentName
    | SportName
    | StaticDocText
    

type DocRef = { RefType: RefType; Lang: Lang; Document: Document; }
type Index = Map<Word, xSet<DocId, DocRef>>


module ScoredItem =
    let map f x = { Item = f x.Item; Score = x.Score }
    
    
module RefType =
    let weight = memoize ^ function
        | GameEventName  -> 1.0
        | CasinoName     -> 1.0
        | SportName      -> 0.7
        | CategoryName   -> 0.6
        | TournamentName -> 0.6
        | StaticDocText  -> 1.0


module DocId =
    let fromGameEvent x = GameEventId x.Id
    let fromCasino x = CasinoGameId (x.GameId, x.LobbyId)
    let fromStaticDoc x = StaticDocId (x.Url)
    
    let fromDocument = function
        | GameEventDoc x -> fromGameEvent x
        | CasinoGameDoc x -> fromCasino x
        | StaticDoc x -> fromStaticDoc x


module Document =
    let docId x = DocId.fromDocument x 
    
    let tryGameEvent = function
        | GameEventDoc x -> Some x
        | _ -> None
        
    let tryCasino = function
        | CasinoGameDoc game -> Some game
        | _ -> None
    
    let tryStaticDoc = function
        | StaticDoc doc -> Some doc
        | _ -> None
    
    
    let patternMatch (source: Document) // for C#
                     (onGameEvent: Func<GameEvent, 'a>)
                     (onCasino: Func<CasinoGame, 'a>)
                     (onStaticDoc: Func<StaticDoc, 'a>) =
        match source with 
        | GameEventDoc game -> onGameEvent.Invoke game
        | CasinoGameDoc game -> onCasino.Invoke game
        | StaticDoc doc -> onStaticDoc.Invoke doc




module DocRef =
    let document x = x.Document
    let docId = document >> Document.docId
    let weight x = RefType.weight x.RefType  
    
    let fromDocs mkDoc items mkConfig =
        seq {
            for item in items do
                let document = mkDoc item
                for refType, str in mkConfig item do
                for lang, words in Word.fromMlString str do
                for word in words do
                    word, { Document = document; Lang = lang; RefType = refType; }
        }
        |> Set.ofSeq



module Index =
    let empty = Map.empty
    
    let merge (a: Index) (b: Index) : Index =
        let smaller, bigger = if a.Count < b.Count then (a, b) else (b, a)
        
        let merger (state: Index) word refs =
            let addOrReplace oldRefs =  
                oldRefs
                |> Option.map ^ xSet.addMany refs
                |> Option.defaultValue refs
                |> Some
                
            state.Change(word, addOrReplace)
            
        smaller |> Map.fold merger bigger
        
    
    
    let fromDocs mkDocRef items mkConfig : Index =
        DocRef.fromDocs mkDocRef items mkConfig
        |> Seq.groupBy fst
        |> Seq.map ^ fun (word, xs) ->
            let refs = xs |> Seq.map snd |> xSet.ofSeq DocRef.docId
            word, refs
        |> Map.ofSeq
        
    
    let fromGameEvents games =
        fromDocs GameEventDoc games ^ fun x -> [
            GameEventName, x.Name
            SportName, x.Sport.Name
            CategoryName, x.Category.Name
            TournamentName, x.Tournament.Name
        ]
        
    let fromCasinos games =
        fromDocs CasinoGameDoc games ^ fun x -> [
            CasinoName, x.Name
        ]
        
    
    let fromStaticDocs docs =
        fromDocs StaticDoc docs ^ fun doc -> [
            let docText = MLString.fromLang doc.Lang (doc.Title + " " + doc.Body)
            StaticDocText, docText
        ]
    
    
    
    let create events casinos docs =
        let events = Task.Run(fun () -> fromGameEvents events)
        let casinos = Task.Run(fun () -> fromCasinos casinos)
        let staticDocs = Task.Run(fun () -> fromStaticDocs docs)
        casinos.Result
        |> merge events.Result 
        |> merge staticDocs.Result
        
    
    let getDocs (index: Index) =
        index
        |> Map.toSeq
        |> Seq.collect snd
        |> Seq.map DocRef.document
        |> xSet.ofSeq Document.docId
        
        
    let getGameEvents index =
        getDocs index
        |> Seq.choose Document.tryGameEvent
        |> Set.ofSeq
        
        
    let getCasinos index =
        getDocs index
        |> Seq.choose Document.tryCasino
        |> Set.ofSeq
    
    let staticDocs index =
        getDocs index
        |> Seq.choose Document.tryStaticDoc
    
    let cleanUp (index: Index) =
        let docs = 
            getDocs index
            |> Seq.filter ^ function
                | GameEventDoc  x -> GameEvent.isActual x
                | CasinoGameDoc x -> true
                | StaticDoc x     -> true 
            |> Seq.toArray
            
        let events = docs |> Seq.choose Document.tryGameEvent |> Seq.cache
        let casinos = docs |> Seq.choose Document.tryCasino |> Seq.cache
        let staticDocs = docs |> Seq.choose Document.tryStaticDoc |> Seq.cache
        
        create events casinos staticDocs
        
    let removeCasinos (index: Index) =
        let remover (state: Index) (key: Word) (value: xSet<DocId, DocRef>) =
            let newValue = value |> xSet.filter ^ fun _ ref -> ref.Document |> Document.tryCasino |> Option.isNone
            if newValue.IsEmpty then state
            else state.Add(key, newValue)
        
        Map.fold remover Map.empty index
        |> tap (fun x -> printfn $"count of keys {x.Count}")
        
    
    let applyGameEvent (state: Index) (x: GameEvent) = 
        let newIndex = fromGameEvents [x]
        match GameEvent.isActual x with
        | true -> merge newIndex state
        | false ->
            let docId = DocId.fromGameEvent x
            let cleaner (state: Index) key value =
                state |> Map.change key ^ fun refs ->
                    match refs with
                    | None -> None
                    | Some refs ->
                        refs
                        |> xSet.filter ^ fun id _ -> id <> docId
                        |> fun x -> if x.IsEmpty then None else Some x
            
            newIndex |> Map.fold cleaner state

                
    let applyGameEvents state xs = xs |> Seq.fold applyGameEvent state 

    let applyCasinos (state: Index) (x: CasinoGame seq) =
        let newIndex = fromCasinos x
        merge state newIndex
        
    let applyStaticDocs (state: Index) (x: StaticDoc seq) =
        let newIndex = fromStaticDocs x
        merge state newIndex
    
    
    let scoredDocs customFilter (index: Index) (locale: Lang) (query: string) =
        let words = Word.extractWords query
        let queryScore word = words |> Seq.sumBy ^ Word.matchScore word |> float
        let dict = Dictionary()
        
        for item in index do
            let wordScore = queryScore item.Key
            
            for docRef in item.Value |> Seq.filter (DocRef.document >> customFilter) do
                let docId = DocRef.docId docRef
//                if docId.ToString() = "GameEventId \"9615454\"" then ()
                let langScore = if docRef.Lang = locale then Defaults.LangBoost else 1.0
                let weight = RefType.weight docRef.RefType
                let score = wordScore * langScore * weight
                
                match dict.TryGetValue(docId) with
                | false, _ -> dict.[docId] <- (ref score, docRef.Document)
                | true, (oldScore, _) -> oldScore.Value <- oldScore.Value + score
                 
        dict.Values
        |> Seq.map ^ fun (score, doc) -> (score.Value, doc)
        |> Set.ofSeq
    
    
    let scoreBiggerThanMinimum (score: float, doc) =
        match doc with
        | GameEventDoc _ -> int score >= Defaults.MinGameEventScore
        | CasinoGameDoc _ -> int score >= Defaults.MinCasinoScore
        | StaticDoc _ -> score >= Defaults.MinScoreStaticContent
    
    
    let searchGameEvents (index: Index)
                         (taxonomy: Taxonomy.TaxonomyState)
                         (brand: SiteBrand)
                         (locale: Lang)
                         (query: string) =
        
        let filter = function
            | GameEventDoc game -> Restriction.canAccess brand game.Restrictions
            | CasinoGameDoc _ -> false
            | StaticDoc doc -> false
            
        scoredDocs filter index locale query
        |> Seq.filter ^ scoreBiggerThanMinimum
        |> Seq.choose ^ fun (score, document) ->
            match document with
            | GameEventDoc game ->
                let fullScore = Taxonomy.fullScore brand game.Id taxonomy
                let score = score + %fullScore * Defaults.FullScoreBoost
                Some { Score = int score; Item = game }
            | _ -> None
        |> Seq.sortByDescending It.score
        |> Seq.cache
    
    
    let searchDocs (findCorrections: Word Set -> WordCorrection seq)
                   (fullScore: GameEventId -> FullScore)
                   (casinoRank: CasinoGame -> CasinoRank)
                   (customDocFilter: Document -> bool)
                   (index: Index)
                   (locale: Lang)
                   (query: string) = 
        
        query
        |> Word.extractWords
        |> findCorrections
        |> Seq.collect ^ fun correction -> 
            index.TryFind correction.Word <?> (xSet.empty DocRef.docId)
            |> Seq.map ^ fun docRef -> struct {| Correction = correction; DocRef = docRef |} 
        |> Seq.groupBy ^ fun x -> DocRef.docId x.DocRef
        |> Seq.map ^ fun (_, items) ->
            let items = items |> Seq.cache
            let doc = items |> Seq.map (fun x -> x.DocRef.Document) |> Seq.head
            let score =
                items
                |> Seq.sumBy ^ fun x ->
                    let refWeight = DocRef.weight x.DocRef
                    let langBoost = if x.DocRef.Lang = locale then Defaults.LangBoost else 1.0
                    let textScore = float (WordCorrection.score x.Correction)
                    int (textScore * refWeight * langBoost)
            { Score = score; Item = doc }
        |> Seq.filter ^ fun x -> customDocFilter x.Item
        |> Seq.filter ^ fun x ->
            match x.Item with
            | GameEventDoc _ -> x.Score >= Defaults.MinGameEventScore
            | CasinoGameDoc _ -> x.Score >= Defaults.MinCasinoScore
            | StaticDoc _ -> x.Score >= Defaults.MinScoreStaticContent
        |> Seq.map ^ fun x ->
            match x.Item with
            | GameEventDoc game -> 
                let fullScore = fullScore game.Id * Defaults.FullScoreBoost 
                { Score = x.Score + int fullScore; Item = x.Item }
            | CasinoGameDoc game ->
                let rank = casinoRank game
                { Score = x.Score + int rank; Item = x.Item }
            | StaticDoc doc -> x
        |> Seq.sortByDescending It.score
        |> Seq.cache
        

    
    let getGameEventsDocs source =
        source
        |> Seq.choose ^ fun x ->
            match x.Item with
            | GameEventDoc game -> x |> ScoredItem.map (constant game) |> Some
            | _ -> None
            
    let getCasinoDocs source =
        source
        |> Seq.choose ^ fun x ->
            match x.Item with
            | CasinoGameDoc game -> x |> ScoredItem.map (constant game) |> Some  
            | _ -> None

    
    let casinoLoaded (index: Index) =
        index
        |> Seq.collect ^ fun x -> x.Value
        |> Seq.choose (It.document >> Document.tryCasino)
        |> Seq.exists (constant true)