This commit is contained in:
hokoriko 2024-05-16 11:03:36 +02:00
commit 25efc510e5
7 changed files with 37304 additions and 0 deletions

16
RedCat.sln Normal file
View file

@ -0,0 +1,16 @@

Microsoft Visual Studio Solution File, Format Version 12.00
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "RedCat", "RedCat\RedCat.fsproj", "{712648D9-AF68-4847-AF7F-B976AC1AB1D2}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
Release|Any CPU = Release|Any CPU
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{712648D9-AF68-4847-AF7F-B976AC1AB1D2}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{712648D9-AF68-4847-AF7F-B976AC1AB1D2}.Debug|Any CPU.Build.0 = Debug|Any CPU
{712648D9-AF68-4847-AF7F-B976AC1AB1D2}.Release|Any CPU.ActiveCfg = Release|Any CPU
{712648D9-AF68-4847-AF7F-B976AC1AB1D2}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
EndGlobal

View file

@ -0,0 +1,128 @@
module RedCat.DrugsDataExtractor
open System.Collections.Generic
open Newtonsoft.Json.Linq
open FuzzySharp
open System.IO
let drugsJson = File.ReadAllText(Path.Combine("/opt/redcatbot/", "drugs.json"))
let comboJson = File.ReadAllText(Path.Combine("/opt/redcatbot/", "combos.json"))
let DrugsJsonData = JObject.Parse(drugsJson)
let ComboJsonData = JObject.Parse(drugsJson)
let private tryExtractProps (propName: string) (jsonValue: JToken) =
match jsonValue["properties"][propName] with
| null -> None
| token -> token.ToString() |> Some
let private tryExtract (x: string) (jsonValue: JToken) =
match jsonValue[x] with
| null -> None
| token -> token.ToString() |> Some
let private tryExtractArray (fieldName: string) (jsonValue: JToken) =
match jsonValue[fieldName] with
| null -> None
| categories ->
categories.Values()
|> Seq.cast<JToken>
|> Seq.map(fun text -> text.ToString())
|> Seq.toList |> Some
let private DrugNamesWithAliases =
DrugsJsonData.Properties()
|> Seq.map(fun obj ->
match obj.Value |> tryExtractArray "aliases" with
| Some aliasesList -> aliasesList |> List.map(fun al -> (al, obj.Name))
| None -> [(obj.Name, obj.Name)])
|> Seq.concat
|> Map.ofSeq
let private DrugNames =
DrugNamesWithAliases |> Map.values |> Set.ofSeq
let private search (userInput: string) =
let clearString (inStr: string) = inStr.Replace("-", "").Replace(",", "")
let findCond (_in: KeyValuePair<string, string>) =
match (_in.Key, _in.Value) with
| _, drugName when drugName = userInput || clearString drugName = userInput ->
drugName |> Some
| someAlias, drugName when someAlias = userInput -> drugName |> Some
| _ -> None
let drugNameFound =
DrugNamesWithAliases
|> Seq.choose(findCond)
|> Seq.tryHead
drugNameFound
type DrugRecord = {
Name: string
Summary: string option
Categories: string list option
OnSet: string option
TotalDuration: string option
Dose: string option
}
type ComboRecord = {
DrugA: string
DrugB: string
Status: string option
Note: string option
}
type SearchResult =
| DrugRecord of DrugRecord
| ResponseText of string
let getComboRecord (userInputA: string) (userInputB: string) =
let getRecord (jsonValue: JToken) = {
DrugA = userInputA
DrugB = userInputB
Status = jsonValue |> tryExtract "status"
Note = jsonValue |> tryExtract "note"
}
let tryGetCombo drugA drugB =
match DrugsJsonData[drugA][drugB] with
| null -> None
| obj -> Some obj
match (search userInputA, search userInputB) with
| None, None -> Error $"Can't find both drugs {userInputA} and {userInputB}"
| Some _, None -> Error $"Can't find second drug {userInputB}"
| None, Some _ -> Error $"Can't find first drug {userInputA}"
| Some drugA, Some drugB ->
tryGetCombo drugA drugB
|> Option.bind(fun jsonValue -> (getRecord jsonValue) |> Some)
|> function
| None -> Error $"Can't find combo from {userInputA} and {userInputB}"
| Some combo -> combo |> Ok
let getSearchResponse (userInput: string) =
let matches =
Process.ExtractTop(userInput, DrugNames)
|> Seq.choose(fun e -> if e.Score > 62 then e.Value |> Some else None)
|> String.concat "\n- "
match matches with
| "" -> Error $"Can't find drug name: {userInput}"
| matches -> $"- {matches}" |> ResponseText |> Ok
let getDrugRecord (userInput: string) =
let getRecord (drugName: string) (jsonValue: JToken) = {
Name = drugName
Summary = jsonValue |> tryExtractProps "summary"
Categories = jsonValue |> tryExtractArray "categories"
OnSet = jsonValue |> tryExtractProps "onset"
TotalDuration = jsonValue |> tryExtractProps "duration"
Dose = jsonValue |> tryExtractProps "dose"
}
match search userInput with
| Some drugName -> getRecord drugName DrugsJsonData[drugName] |> DrugRecord |> Ok
| None -> getSearchResponse userInput

74
RedCat/Program.fs Normal file
View file

@ -0,0 +1,74 @@
module RedCat.Program
open Microsoft.Extensions.Logging
open Funogram.Api
open Funogram.Telegram
open Funogram.Telegram.Bot
open RedCat.DrugsDataExtractor
open RedCat.RecordFormatter
let private factory = LoggerFactory.Create(fun builder ->
builder.AddSimpleConsole(fun opts -> opts.TimestampFormat <- "[MM-dd HH:mm:ss.fff] ") |> ignore)
let NewConsoleOnlyLogger (loggerName: string) =
factory.CreateLogger(loggerName)
let logger = NewConsoleOnlyLogger "RedCatLog"
type BotCommands =
| Start
| Combo of string * string
| Info of string
| Dose of string
| Search of string
let parseCommand (cmd: BotCommands) =
match cmd with
| Start -> "Utilizzo: !info lsd"
| Combo (userInputA, userInputB) ->
match getComboRecord userInputA userInputB with
| Ok comboRecord -> formatComboRecord comboRecord
| Error errMsg ->
logger.LogError errMsg
$"Non trovo informazioni relative alla combo {userInputA} e {userInputB}"
| Info userInput ->
match getDrugRecord userInput with
| Ok (DrugRecord drugData) -> formatDrugInfoResponse drugData
| Ok (ResponseText suggestionsResponse) ->
$"Non trovo informazioni relative a '{userInput}'.\nForse stavi cercando:\n{suggestionsResponse}"
| Error _ -> $"Non trovo informazioni relative a '{userInput}'"
| Dose userInput -> "Not implemented yet"
| Search userInput ->
match getSearchResponse userInput with
| Ok (ResponseText rt) -> $"Possibili risultati: \n{rt}"
| Error _ -> $"Non trovo informazioni relative a '{userInput}'"
| _ -> failwith "Shouldn't happen here"
let sendMsg (ctx: UpdateContext) (cmd: BotCommands) =
match ctx.Update.Message with
| Some { MessageId = messageId; Chat = chat } ->
let msg = cmd |> parseCommand
Api.sendMessageReply chat.Id msg messageId
|> api ctx.Config
|> Async.Ignore
|> Async.Start
| _ -> ()
let updateArrived (ctx: UpdateContext) =
processCommands ctx [|
cmd "!start" (fun _ -> sendMsg ctx Start)
cmdScan "!info %s" (fun userInput _ -> sendMsg ctx (Info (formatDrugInput userInput)))
cmdScan "!search %s" (fun userInput _ -> sendMsg ctx (Search (formatDrugInput userInput)))
//cmdScan "!combo %s %s" (fun (drugA, drugB) _ -> sendMsg ctx (Combo(drugA,drugB)))
//cmdScan "!dose %s" (fun drug _ -> sendMsg ctx (Dose drug))
|] |> ignore
[<EntryPoint>]
let main _ =
async {
let config = { Config.defaultConfig
with Token = "1171254969:AAGraSaWhTxAoJVLnSEkh8DfrpqdqOmf1aM" }
let! _ = Api.deleteWebhookBase () |> api config
return! startBot config updateArrived None
} |> Async.RunSynchronously
0

53
RedCat/RecordFormatter.fs Normal file
View file

@ -0,0 +1,53 @@
module RedCat.RecordFormatter
open RedCat.DrugsDataExtractor
let formatDrugInput (drugRawName: string) =
drugRawName.ToLower().Replace(" ", "").Replace("-", "").Replace(",", "")
let formatDrugInfoResponse (drugData: DrugRecord) =
let toPrettyString (drugInfo: string option) =
match drugInfo with
| Some s when drugInfo = drugData.Summary -> $"📜 {s}" |> Some
| Some s when drugInfo = drugData.Dose -> $"🍽️ {s}" |> Some
| Some s when drugInfo = drugData.TotalDuration -> $"⏳ Durata: {s}" |> Some
| Some s when drugInfo = drugData.OnSet -> $"🤯 Inizio effetti: {s}" |> Some
| _ -> None
let formattedCategories =
drugData.Categories
|> Option.bind(fun catgs -> catgs |> String.concat " | " |> Some)
let mainResponseText =
[drugData.Summary; drugData.Dose; drugData.TotalDuration; drugData.OnSet]
|> List.choose toPrettyString
|> String.concat "\n\n"
match formattedCategories with
| None -> $"~{drugData.Name} \n\n{mainResponseText}"
| Some categories -> $"~{drugData.Name} [ {categories} ]\n\n{mainResponseText}"
let formatComboRecord (comboData: ComboRecord) =
let translate (s: string) =
match s with
| "Dangerous" -> "❌ Molto pericoloso alla vita e alla salute"
| "Unsafe" -> "‼️ Pericoloso"
| "Caution" -> "⚠️ Attenzione"
| "Low Risk & Synergy" -> " Rischio basso e amplificazione effetto "
| "Low Risk & Decrease" -> " Rischio basso e diminuzione effetto "
| "Low Risk & No Synergy" -> "🟰🟰 Rischio basso e interazione assente 🟰🟰"
| _ -> failwith "Shouldn't happen here"
let toPrettyString (comboInfo: string option) =
match comboInfo with
| Some s when comboInfo = comboData.Status -> $"{translate s}" |> Some
| Some s when comboInfo = comboData.Note -> $"{s}" |> Some
| _ -> None
let comboText =
[comboData.Status; comboData.Note]
|> List.choose toPrettyString
|> String.concat "\n"
$"[{comboData.DrugA}] ~ [{comboData.DrugB}]\n\n{comboText}"

26
RedCat/RedCat.fsproj Normal file
View file

@ -0,0 +1,26 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net7.0</TargetFramework>
<PublishSingleFile>true</PublishSingleFile>
<SelfContained>true</SelfContained>
<RuntimeIdentifier>linux-x64</RuntimeIdentifier>
</PropertyGroup>
<ItemGroup>
<Compile Include="DrugsDataExtractor.fs" />
<Compile Include="RecordFormatter.fs" />
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="Funogram" Version="2.0.8" />
<PackageReference Include="Funogram.Telegram" Version="6.9.0" />
<PackageReference Include="FuzzySharp" Version="2.0.2" />
<PackageReference Include="Microsoft.Extensions.Logging" Version="8.0.0" />
<PackageReference Include="Microsoft.Extensions.Logging.Console" Version="8.0.0" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.3" />
</ItemGroup>
</Project>

2543
RedCat/combos.json Normal file

File diff suppressed because it is too large Load diff

34464
RedCat/drugs.json Normal file

File diff suppressed because it is too large Load diff