summaryrefslogtreecommitdiff
path: root/src/FundLab.Web/App.fs
diff options
context:
space:
mode:
Diffstat (limited to 'src/FundLab.Web/App.fs')
-rw-r--r--src/FundLab.Web/App.fs607
1 files changed, 593 insertions, 14 deletions
diff --git a/src/FundLab.Web/App.fs b/src/FundLab.Web/App.fs
index 630a8e9..0ee4d56 100644
--- a/src/FundLab.Web/App.fs
+++ b/src/FundLab.Web/App.fs
@@ -1,41 +1,620 @@
module FundLab.Web
+open System
+open System.Globalization
open Elmish
open Elmish.React
open Feliz
+open Fable.Core
+
+type Instrument =
+ {
+ code: string
+ name: string
+ fundType: string option
+ }
+
+type NavObservation =
+ {
+ navDate: string
+ nav: string
+ dailyReturn: string option
+ }
+
+type ChartPoint =
+ {
+ x: float
+ y: float
+ navDate: string
+ nav: string
+ }
+
+module Chart =
+ let private invariant = CultureInfo.InvariantCulture
+
+ let private navValue (observation: NavObservation) =
+ Decimal.Parse(observation.nav, NumberStyles.Float, invariant)
+
+ let chartPoints (observations: NavObservation list) =
+ let ordered: NavObservation list = observations |> List.sortBy (fun observation -> observation.navDate)
+ let values = ordered |> List.map navValue
+
+ match values with
+ | [] -> []
+ | _ ->
+ let minimum = List.min values
+ let maximum = List.max values
+ let range = maximum - minimum
+ let count = List.length ordered
+
+ ordered
+ |> List.mapi (fun index observation ->
+ let value = navValue observation
+ let x =
+ if count = 1 then
+ 0.5
+ else
+ float index / float (count - 1)
+
+ let y =
+ if range = 0M then
+ 0.5
+ else
+ float ((value - minimum) / range)
+
+ {
+ x = x
+ y = y
+ navDate = observation.navDate
+ nav = observation.nav
+ })
+
+type RawOptionalText =
+ {
+ case: string
+ fields: string array
+ }
+
+type RawInstrument =
+ {
+ code: string
+ name: string
+ fundType: obj
+ }
+
+type RawSearchResponse =
+ {
+ instruments: RawInstrument array
+ }
+
+type RawObservation =
+ {
+ navDate: string
+ nav: string
+ dailyReturn: obj
+ }
+
+type RawNavResponse =
+ {
+ observations: RawObservation array
+ }
+
+module Api =
+ [<Import("searchInstruments", "./src/api.js")>]
+ let searchInstruments (token: string) (query: string) : JS.Promise<RawSearchResponse> = jsNative
+
+ [<Import("getNav", "./src/api.js")>]
+ let getNav (token: string) (code: string) : JS.Promise<RawNavResponse> = jsNative
+
+ [<Import("refreshNav", "./src/api.js")>]
+ let refreshNav (token: string) (code: string) : JS.Promise<RawNavResponse> = jsNative
+
+ let decodeOptionalText (raw: obj) : string option =
+ if isNull raw then
+ None
+ else
+ let envelope = unbox<RawOptionalText> raw
+
+ if isNull (box envelope.fields) || envelope.fields.Length = 0 then
+ None
+ else
+ Some envelope.fields[0]
+
+ let decodeInstrument (raw: RawInstrument) : Instrument =
+ {
+ code = raw.code
+ name = raw.name
+ fundType = decodeOptionalText raw.fundType
+ }
+
+ let decodeSearch (raw: RawSearchResponse) : Instrument list =
+ raw.instruments |> Array.map decodeInstrument |> List.ofArray
+
+ let decodeObservation (raw: RawObservation) : NavObservation =
+ {
+ navDate = raw.navDate
+ nav = raw.nav
+ dailyReturn = decodeOptionalText raw.dailyReturn
+ }
+
+ let decodeNav (raw: RawNavResponse) : NavObservation list =
+ raw.observations |> Array.map decodeObservation |> List.ofArray
type Model =
{
- hasFund: bool
+ token: string
+ query: string
+ searchSeq: int
+ navSeq: int
+ searchResults: Instrument list
+ selected: Instrument option
+ observations: NavObservation list
+ searchInFlight: bool
+ navInFlight: bool
+ error: string option
}
type Msg =
- | CreateFundRequested
+ | TokenChanged of string
+ | QueryChanged of string
+ | SearchRequested
+ | SearchCompleted of requestId: int * instruments: Instrument list
+ | SearchFailed of requestId: int * message: string
+ | InstrumentSelected of Instrument
+ | LoadNavRequested
+ | RefreshNavRequested
+ | NavCompleted of requestId: int * observations: NavObservation list
+ | NavFailed of requestId: int * message: string
let init () =
- { hasFund = false }
+ {
+ token = ""
+ query = ""
+ searchSeq = 0
+ navSeq = 0
+ searchResults = []
+ selected = None
+ observations = []
+ searchInFlight = false
+ navInFlight = false
+ error = None
+ }
+
+let private errorText (error: exn) =
+ if String.IsNullOrWhiteSpace error.Message then
+ "请求失败"
+ else
+ error.Message
+
+let private searchCommand token query requestId =
+ Cmd.OfPromise.either
+ (fun () -> Api.searchInstruments token query)
+ ()
+ (fun raw -> SearchCompleted(requestId, Api.decodeSearch raw))
+ (fun error -> SearchFailed(requestId, errorText error))
+
+let private navCommand token code requestId =
+ Cmd.OfPromise.either
+ (fun () -> Api.getNav token code)
+ ()
+ (fun raw -> NavCompleted(requestId, Api.decodeNav raw))
+ (fun error -> NavFailed(requestId, errorText error))
+
+let private refreshCommand token code requestId =
+ Cmd.OfPromise.either
+ (fun () -> Api.refreshNav token code)
+ ()
+ (fun raw -> NavCompleted(requestId, Api.decodeNav raw))
+ (fun error -> NavFailed(requestId, errorText error))
let update message model =
match message with
- | CreateFundRequested -> model
+ | TokenChanged token ->
+ {
+ model with
+ token = token
+ searchSeq = model.searchSeq + 1
+ navSeq = model.navSeq + 1
+ searchResults = []
+ selected = None
+ observations = []
+ searchInFlight = false
+ navInFlight = false
+ error = None
+ },
+ Cmd.none
+ | QueryChanged query ->
+ { model with query = query; error = None }, Cmd.none
+ | SearchRequested ->
+ let query = model.query.Trim()
+
+ if String.IsNullOrWhiteSpace model.token then
+ { model with error = Some "请输入 API token" }, Cmd.none
+ elif String.IsNullOrWhiteSpace query then
+ { model with error = Some "请输入基金名称或六位代码" }, Cmd.none
+ else
+ let requestId = model.searchSeq + 1
+
+ {
+ model with
+ query = query
+ searchSeq = requestId
+ searchInFlight = true
+ error = None
+ },
+ searchCommand model.token query requestId
+ | SearchCompleted (requestId, instruments) ->
+ if requestId = model.searchSeq then
+ {
+ model with
+ searchResults = instruments
+ searchInFlight = false
+ error = None
+ },
+ Cmd.none
+ else
+ model, Cmd.none
+ | SearchFailed (requestId, message) ->
+ if requestId = model.searchSeq then
+ { model with searchInFlight = false; error = Some message }, Cmd.none
+ else
+ model, Cmd.none
+ | InstrumentSelected instrument ->
+ if String.IsNullOrWhiteSpace model.token then
+ { model with error = Some "请输入 API token" }, Cmd.none
+ else
+ let requestId = model.navSeq + 1
+
+ {
+ model with
+ selected = Some instrument
+ observations = []
+ navSeq = requestId
+ navInFlight = true
+ error = None
+ },
+ navCommand model.token instrument.code requestId
+ | LoadNavRequested ->
+ match model.selected with
+ | Some instrument when not (String.IsNullOrWhiteSpace model.token) ->
+ let requestId = model.navSeq + 1
+
+ {
+ model with
+ navSeq = requestId
+ navInFlight = true
+ error = None
+ },
+ navCommand model.token instrument.code requestId
+ | Some _ ->
+ { model with error = Some "请输入 API token" }, Cmd.none
+ | None ->
+ { model with error = Some "请先选择一个基金" }, Cmd.none
+ | RefreshNavRequested ->
+ match model.selected with
+ | Some instrument when not (String.IsNullOrWhiteSpace model.token) ->
+ let requestId = model.navSeq + 1
+
+ {
+ model with
+ navSeq = requestId
+ navInFlight = true
+ error = None
+ },
+ refreshCommand model.token instrument.code requestId
+ | Some _ ->
+ { model with error = Some "请输入 API token" }, Cmd.none
+ | None ->
+ { model with error = Some "请先选择一个基金" }, Cmd.none
+ | NavCompleted (requestId, observations) ->
+ if requestId = model.navSeq then
+ {
+ model with
+ observations = observations |> List.sortBy (fun observation -> observation.navDate)
+ navInFlight = false
+ error = None
+ },
+ Cmd.none
+ else
+ model, Cmd.none
+ | NavFailed (requestId, message) ->
+ if requestId = model.navSeq then
+ { model with navInFlight = false; error = Some message }, Cmd.none
+ else
+ model, Cmd.none
+
+let private navText (text: string) =
+ match Decimal.TryParse(text, NumberStyles.Float, CultureInfo.InvariantCulture) with
+ | true, value -> value.ToString("0.00000000", CultureInfo.InvariantCulture)
+ | false, _ -> text
+
+let private latestStats (observations: NavObservation list) =
+ let ordered: NavObservation list = observations |> List.sortBy (fun observation -> observation.navDate)
+
+ match ordered with
+ | [] -> None
+ | ordered ->
+ let first = List.head ordered
+ let latest = List.last ordered
+
+ Some(
+ navText latest.nav,
+ latest.dailyReturn |> Option.map (fun value -> value + "%"),
+ first.navDate,
+ latest.navDate
+ )
+
+let private chartView (observations: NavObservation list) =
+ let points = Chart.chartPoints observations
+
+ if List.isEmpty points then
+ Html.div [ prop.className "chart-empty"; prop.text "选择基金后加载历史净值" ]
+ else
+ let width = 960.0
+ let height = 320.0
+ let padding = 28.0
+ let chartWidth = width - padding * 2.0
+ let chartHeight = height - padding * 2.0
+
+ let coordinates =
+ points
+ |> List.map (fun point ->
+ padding + point.x * chartWidth,
+ padding + (1.0 - point.y) * chartHeight)
+
+ let gridLines =
+ [ 0 .. 4 ]
+ |> List.map (fun index ->
+ let y = padding + float index / 4.0 * chartHeight
+
+ Svg.line [
+ svg.x1 padding
+ svg.y1 y
+ svg.x2 (width - padding)
+ svg.y2 y
+ svg.stroke "#e2e8f0"
+ svg.strokeWidth 1
+ ])
+
+ let markers =
+ coordinates
+ |> List.mapi (fun index (x, y) ->
+ Svg.circle [
+ svg.cx x
+ svg.cy y
+ svg.r 3.5
+ svg.fill "#f59e0b"
+ ])
+
+ Html.div [
+ prop.className "chart-wrap"
+ prop.children [
+ Svg.svg [
+ svg.className "nav-chart"
+ svg.viewBox (0, 0, 960, 320)
+ svg.children [
+ yield! gridLines
+ Svg.polyline [
+ svg.points coordinates
+ svg.fill "none"
+ svg.stroke "#1e40af"
+ svg.strokeWidth 3
+ ]
+ yield! markers
+ ]
+ ]
+ Html.div [
+ prop.className "chart-axis"
+ prop.children [
+ Html.span [ prop.text (points |> List.head |> fun point -> point.navDate) ]
+ Html.span [ prop.text (points |> List.last |> fun point -> point.navDate) ]
+ ]
+ ]
+ ]
+ ]
+
+let private resultRow instrument dispatch =
+ Html.button [
+ prop.className "result-row"
+ prop.onClick (fun _ -> dispatch (InstrumentSelected instrument))
+ prop.children [
+ Html.span [ prop.className "result-code"; prop.text instrument.code ]
+ Html.span [ prop.className "result-name"; prop.text instrument.name ]
+ Html.span [ prop.className "result-type"; prop.text (instrument.fundType |> Option.defaultValue "基金") ]
+ ]
+ ]
+
+let private searchPanel model dispatch =
+ Html.section [
+ prop.className "panel search-panel"
+ prop.children [
+ Html.div [
+ prop.className "section-heading"
+ prop.children [
+ Html.div [
+ Html.p [ prop.className "eyebrow"; prop.text "01 / FIND" ]
+ Html.h2 "先锁定真实代码"
+ ]
+ Html.span [ prop.className "section-note"; prop.text "AKShare · exact match" ]
+ ]
+ ]
+ Html.div [
+ prop.className "search-row"
+ prop.children [
+ Html.input [
+ prop.className "text-input search-input"
+ prop.placeholder "输入基金名称或六位代码"
+ prop.value model.query
+ prop.onChange (fun value -> dispatch (QueryChanged value))
+ ]
+ Html.button [
+ prop.className "primary-action"
+ prop.disabled model.searchInFlight
+ prop.onClick (fun _ -> dispatch SearchRequested)
+ prop.text (if model.searchInFlight then "查询中..." else "搜索")
+ ]
+ ]
+ ]
+ if List.isEmpty model.searchResults then
+ Html.p [ prop.className "hint"; prop.text "搜索结果会保留来源与代码，避免名称歧义。" ]
+ else
+ Html.div [
+ prop.className "result-list"
+ prop.children (model.searchResults |> List.map (fun instrument -> resultRow instrument dispatch))
+ ]
+ ]
+ ]
+
+let private navPanel model dispatch =
+ let selectedName =
+ model.selected
+ |> Option.map (fun instrument -> instrument.name)
+ |> Option.defaultValue "尚未选择基金"
+
+ Html.section [
+ prop.className "panel nav-panel"
+ prop.children [
+ Html.div [
+ prop.className "section-heading"
+ prop.children [
+ Html.div [
+ Html.p [ prop.className "eyebrow"; prop.text "02 / TRACE" ]
+ Html.h2 selectedName
+ ]
+ match model.selected with
+ | Some instrument ->
+ Html.div [
+ prop.className "instrument-meta"
+ prop.children [
+ Html.span [ prop.className "code-chip"; prop.text instrument.code ]
+ Html.span [ prop.className "section-note"; prop.text (instrument.fundType |> Option.defaultValue "基金") ]
+ ]
+ ]
+ | None -> Html.none
+ ]
+ ]
+ match latestStats model.observations with
+ | None ->
+ Html.div [
+ prop.className "chart-placeholder"
+ prop.children [
+ Html.div [ prop.className "placeholder-line" ]
+ Html.p "历史净值会在这里形成一条可追溯的曲线"
+ Html.span "数据来自已持久化的日频观察值"
+ ]
+ ]
+ | Some(latestNav, dailyReturn, fromDate, toDate) ->
+ Html.div [
+ prop.className "nav-content"
+ prop.children [
+ Html.div [
+ prop.className "metric-strip"
+ prop.children [
+ Html.div [
+ prop.className "metric"
+ prop.children [
+ Html.span "最新单位净值"
+ Html.strong latestNav
+ ]
+ ]
+ Html.div [
+ prop.className "metric"
+ prop.children [
+ Html.span "最新日收益"
+ Html.strong (dailyReturn |> Option.defaultValue "暂无")
+ ]
+ ]
+ Html.div [
+ prop.className "metric"
+ prop.children [
+ Html.span "观察区间"
+ Html.strong (sprintf "%s — %s" fromDate toDate)
+ ]
+ ]
+ ]
+ ]
+ chartView model.observations
+ ]
+ ]
+ Html.div [
+ prop.className "panel-actions"
+ prop.children [
+ Html.button [
+ prop.className "secondary-action"
+ prop.disabled (model.navInFlight || model.selected.IsNone)
+ prop.onClick (fun _ -> dispatch LoadNavRequested)
+ prop.text "重新读取"
+ ]
+ Html.button [
+ prop.className "primary-action"
+ prop.disabled (model.navInFlight || model.selected.IsNone)
+ prop.onClick (fun _ -> dispatch RefreshNavRequested)
+ prop.text (if model.navInFlight then "同步中..." else "刷新 AKShare")
+ ]
+ ]
+ ]
+ ]
+ ]
let view model dispatch =
Html.main [
- prop.className "empty-state"
+ prop.className "app-shell"
prop.children [
- Html.p [ prop.className "eyebrow"; prop.text "FUND LAB" ]
- Html.h1 "尚未创建基金"
- Html.p "先创建一支人民币模拟基金，再选择基金代码和持仓金额。"
- Html.p (if model.hasFund then "已创建基金" else "尚未选择投资")
- Html.button [
- prop.className "primary-action"
- prop.text "创建基金"
- prop.onClick (fun _ -> dispatch CreateFundRequested)
+ Html.header [
+ prop.className "topbar"
+ prop.children [
+ Html.div [
+ prop.className "brand"
+ prop.children [
+ Html.span [ prop.className "brand-mark"; prop.text "F" ]
+ Html.span "FUND LAB"
+ ]
+ ]
+ Html.span [ prop.className "topbar-status"; prop.text "MARKET DATA / 3B" ]
+ ]
+ ]
+ Html.div [
+ prop.className "hero"
+ prop.children [
+ Html.div [
+ prop.className "hero-copy"
+ prop.children [
+ Html.p [ prop.className "eyebrow"; prop.text "人民币模拟基金 · 观察台" ]
+ Html.h1 "把净值曲线，先看清楚。"
+ Html.p "从真实基金代码开始，读取、校验并追踪每日单位净值。这里不下单，只保留可复核的数据。"
+ ]
+ ]
+ Html.div [
+ prop.className "token-card"
+ prop.children [
+ Html.label [
+ prop.className "field-label"
+ prop.children [
+ Html.span "API TOKEN"
+ Html.input [
+ prop.className "text-input token-input"
+ prop.type' "password"
+ prop.placeholder "仅保存在当前页面内存"
+ prop.value model.token
+ prop.onChange (fun value -> dispatch (TokenChanged value))
+ ]
+ ]
+ ]
+ Html.p [ prop.className "token-note"; prop.text "请求通过 Bearer header 发送，不写入构建产物。" ]
+ ]
+ ]
+ ]
]
+ match model.error with
+ | Some message -> Html.div [ prop.className "error-banner"; prop.text message ]
+ | None -> Html.none
+ searchPanel model dispatch
+ navPanel model dispatch
+ Html.footer [ prop.className "footer-note"; prop.text "SOURCE · AKShare / STORAGE · PostgreSQL / MODE · READ-ONLY" ]
]
]
let start () =
- Program.mkSimple init update view
+ Program.mkProgram (fun () -> init (), Cmd.none) update view
|> Program.withReactSynchronous "fund-lab-root"
|> Program.run
generated by cgit v1.2.3 (git 2.39.1) at 2026-10-04 15:01:26 +0000