Skip to content

Instantly share code, notes, and snippets.

@dsyme

dsyme/Model.fs

Last active October 16, 2019 00:35
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save dsyme/d25a1cadfc3934d79351b89546955f61 to your computer and use it in GitHub Desktop.
Save dsyme/d25a1cadfc3934d79351b89546955f61 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
Model.fs
namespace KitchenSink
open Aardvark.Base
open Aardvark.Base.Incremental
[<DomainType>]
type DropdownModel =
{
selected : Option<int>
}
[<DomainType>]
type KitchenSinkModel =
{
elements : IndexList<DropdownModel>
text : string
dummy : bool
active : Set<string>
selected : ImmutableHashSet<int>
users : ImmutableHashSet<string>
value : float
}
Raw
Update.fs
open Aardvark.Base
open Aardvark.Base.Incremental
open Aardvark.UI
open Aardvark.UI.Generic
open Aardvark.Import.SemanticUI
open Aardvark.SemanticUI
type Message =
| Update of Index * Option<int>
| Clear
| SetText of string
| SetDummy of bool
| SetActive of Set<string>
| SetSelected of ImmutableHashSet<int>
| SetUsers of ImmutableHashSet<string>
| ModalResult of string
| SetValue of float
let initial =
{
users = HSet.ofList ["John"; "Alice"]
selected = HSet.ofList [1;3;5]
active = Set.empty
text = "hi"
dummy = true
elements = [1;2;3;4;5] |> List.map (fun i -> { selected = Some i }) |> PList.ofList
value = 0.5
}
let update (env : Environment<Message>) (model : KitchenSinkModel) (msg : Message) =
Log.line "message: %A" msg
match msg with
| SetValue v ->
if model.dummy then
{ model with value = v }
else
model
| SetText t ->
{ model with text = t }
| Update(index, v) ->
{ model with elements = PList.set index { selected = v } model.elements }
| Clear ->
initial
| SetDummy v ->
{ model with dummy = v }
| SetActive a ->
{ model with active = a }
| SetSelected s ->
{ model with selected = s }
| SetUsers u ->
{ model with users = u }
| ModalResult i ->
{ model with users = HSet.add i model.users }
Raw
View.fs
module KitchenSink.View
open Aardvark.Base
open Aardvark.Base.Incremental
open Aardvark.UI
open Aardvark.UI.Generic
open Aardvark.Import.SemanticUI
open Aardvark.SemanticUI
let view (m : MKitchenSinkModel) =
let firstIndex = m.elements |> AList.toMod |> Mod.map (fun l -> l.MinIndex)
let firstElement = m.elements |> AList.toMod |> Mod.bind (fun l -> (Seq.head l).selected)
div [ clazz "ui inverted segment"; style "margin: 20px" ] [
div [ style "position: fixed; top: 40px; right: 40px; z-index: 1000;" ] [
div [ clazz "ui large buttons" ] [
button [
Button.Attributes [ clazz "ui inverted button" ]
Button.Click [Clear]
Button.Content "Reset"
]
button [
Button.Attributes [ clazz "ui inverted red icon button" ]
Button.Click [Clear]
Button.Icon "trash alternate"
]
]
]
div [ clazz "ui inverted segment"] [
Generic.h1 [] "Kitchen Sink"
]
div [ clazz "ui inverted segment"] [
Generic.h2 [] "Dropdowns"
Incremental.div AttributeMap.empty (
m.elements |> AList.mapi (fun i v ->
dropdown [
Dropdown.Attributes [clazz "ui inverted selection dropdown"]
Dropdown.Options([1..20], string >> text)
Dropdown.Update (fun s -> [Update(i, s)])
Dropdown.Selected v.selected
Dropdown.Name "v"
Dropdown.Settings [
Dropdown.On "hover"
//Dropdown.Duration 100.0
]
]
)
)
]
div [ clazz "ui raised inverted segment"] [
Generic.h2 [] "Multiselect Dropdown"
dropdown [
Dropdown.Attributes [clazz "ui fluid inverted multiple selection dropdown"]
Dropdown.Options([1..20], string >> text)
Dropdown.Update (fun s -> [SetSelected s])
Dropdown.Selected m.selected
Dropdown.Name "Multiselect"
Dropdown.Settings [Dropdown.Clearable true]
]
dropdownInput [
DropdownInput.Attributes [clazz "ui fluid inverted multiple selection dropdown"]
DropdownInput.Options ["Vanessa Cooke"; "Dale Hurst"; "Devyn Pitts"; "Vaughn Powell"; "Amari Massey"; "Tiffany Branch"; "Jazmin Jacobson"; "Eva Koch"; "Grayson Savage"; "Mathew Burgess"; "Karissa Sutton"; "Maddox Giles"; "Kyler Patrick"; "Leonard Church"; "Griffin Bowman"; "Mariam Potts"; "Chance Schultz"; "Kash Bray"; "Matteo Williams"; "Amelia Sims" ]
DropdownInput.Update (fun s -> [SetUsers s])
DropdownInput.Selected m.users
DropdownInput.Name "Friends"
DropdownInput.Settings [Dropdown.Clearable true]
]
]
Generic.div [ clazz "ui inverted segment"] [
Generic.h2 [] "Input with labels/maxlength/etc."
input [
Input.Attributes [clazz "ui huge fluid inverted input"]
Input.Text m.text
Input.Update (SetText >> Seq.singleton)
Input.Name "text"
Input.MaxLength 20
Input.LeftLabel "http://"
Input.Enabled m.dummy
Input.RightLabel (
dropdown [
Dropdown.Attributes [clazz "ui inverted dropdown right label"]
Dropdown.Options([".com"; ".net"; ".org"], text)
Dropdown.Name ".com"
Dropdown.IconSide true
Dropdown.Enabled (m.text |> Mod.map (fun s -> s.Length > 0))
]
)
]
]
Generic.div [ clazz "ui inverted segment"] [
Generic.h2 [] "Checkboxes / Radio buttons"
table [
Table.Attributes [clazz "ui striped celled inverted table"]
Table.Header [ "Kind"; "Checkbox" ]
Table.Content [
[
Generic.td [ clazz "collapsing" ] "toggle box"
checkbox [
Checkbox.Attributes [ clazz "ui inverted toggle checkbox" ]
Checkbox.Label (div [] [text "i are png label"; img [style "max-height: 2em"; "src", String "pin.png"]]) //"i are toggle box"
Checkbox.State m.dummy
Checkbox.Update (fun v -> [ SetDummy v])
Checkbox.Settings [
Checkbox.BeforeChecked (fun _ -> Log.warn "before check"; true)
]
]
]
[
Generic.td [ clazz "collapsing" ] "regular"
checkbox [
Checkbox.Attributes [clazz "ui inverted checkbox" ]
Checkbox.State m.dummy
Checkbox.Update (fun v -> [ SetDummy v])
]
]
[
Generic.td [ clazz "collapsing" ] "regular with label"
checkbox [
Checkbox.Attributes [clazz "ui inverted checkbox" ]
Checkbox.State m.dummy
Checkbox.Update (fun v -> [ SetDummy v])
Checkbox.Label "i are label"
]
]
[
Generic.td [ clazz "collapsing" ] "radio linked with first dropdown"
radio [
Radio.Enabled m.dummy
Radio.Attributes [clazz "ui inverted form"]
Radio.ElementAttributes [clazz "ui inverted radio checkbox"]
Radio.State firstElement
//Radio.Label "radio"
Radio.Options([1..5], sprintf "Option %d" >> text)
Radio.Update (fun v -> [Update(Mod.force firstIndex, v)])
]
]
]
]
]
Generic.div [ clazz "ui inverted segment"] [
Generic.h2 [] "Accordions"
table [
Table.Attributes [clazz "ui striped celled inverted table"]
Table.Header [
"Non exclusive Accordion with clearable state"
"Exclusive Accordion with pure client-state"
]
Table.Content [
[
accordion [
Accordion.Attributes [clazz "ui inverted styled accordion"; style "width: 100%"]
Accordion.Update (SetActive >> Seq.singleton)
Accordion.State m.active
Accordion.Settings [Accordion.Exclusive false]
Accordion.Content [
"A", "a is the first letter in the latin alphabet"
"B", "b is the second letter in the latin alphabet"
"C", "c is the third letter in the latin alphabet"
]
]
accordion [
Accordion.Attributes [clazz "ui inverted styled accordion"; style "width: 100%"]
Accordion.Content [
"A",
"a is the first letter in the latin alphabet"
"B",
"b is the second letter in the latin alphabet"
"C",
"c is the third letter in the latin alphabet"
]
]
]
[
Incremental.text (m.active |> Mod.map (fun s -> s.Count |> sprintf "opened: %d"))
div [] []
]
]
]
]
div [ clazz "ui inverted segment"] [
Generic.h2 [] "Forms"
form [
Form.Attributes [clazz "ui inverted styled form"]
Form.Content [
FormField.Header "Person"
FormField.Fields [
1, FormField.Field(
"Title",
input [
Input.Attributes [clazz "ui input"]
Input.Text m.text
Input.Update (SetText >> Seq.singleton)
Input.Name "Title"
]
)
3, FormField.Field(
"First Name",
input [
Input.Attributes [clazz "ui input"]
Input.Text m.text
Input.Update (SetText >> Seq.singleton)
Input.Name "First Name"
]
)
3, FormField.Field(
"Middle Name",
input [
Input.Attributes [clazz "ui input"]
Input.Text m.text
Input.Update (SetText >> Seq.singleton)
Input.Name "Middle Name"
]
)
3, FormField.Field(
"Last Name",
input [
Input.Attributes [clazz "ui input"]
Input.Text m.text
Input.Update (SetText >> Seq.singleton)
Input.Name "Last Name"
]
)
]
FormField.Header "Bla"
FormField.Field(
"Address",
input [
Input.Attributes [clazz "ui input"]
Input.Text m.text
Input.Update (SetText >> Seq.singleton)
Input.Name "Address"
]
)
]
]
]
div [ clazz "ui inverted segment"] [
Generic.h2 [] "Menu"
menu [
Menu.Attributes [clazz "ui inverted menu"]
Menu.Items [
MenuItem.Item("Item 1", fun () -> Update(Mod.force firstIndex, Some 1) |> msg.single)
MenuItem.Item("Item 2", fun () -> Update(Mod.force firstIndex, Some 2) |> msg.single)
MenuItem.Items(
"Submenu",
[
MenuItem.Item("Item 3", fun () -> Update(Mod.force firstIndex, Some 3) |> msg.single)
MenuItem.Item("Item 4", fun () -> Update(Mod.force firstIndex, Some 4) |> msg.single)
MenuItem.Item("Item 5", fun () -> Update(Mod.force firstIndex, Some 5) |> msg.single)
MenuItem.Items(
"Submenu 2",
[
MenuItem.Item("Item 6", fun () -> Update(Mod.force firstIndex, Some 6) |> msg.single)
MenuItem.Item("Item 7", fun () -> Update(Mod.force firstIndex, Some 7) |> msg.single)
MenuItem.Item("Item 8", fun () -> Update(Mod.force firstIndex, Some 8) |> msg.single)
MenuItem.Item(div [click (fun _ -> SetSelected HSet.empty |> msg.single)] [i [ clazz "rocket icon"] [] ])
]
)
]
)
]
]
menu [
Menu.Attributes [clazz "ui vertical inverted menu"]
Menu.Items [
MenuItem.Item("Item 1", fun () -> Update(Mod.force firstIndex, Some 1) |> msg.single)
MenuItem.Item("Item 2", fun () -> Update(Mod.force firstIndex, Some 2) |> msg.single)
MenuItem.Items(
"Submenu",
[
MenuItem.Item("Item 3", fun () -> Update(Mod.force firstIndex, Some 3) |> msg.single)
MenuItem.Item("Item 4", fun () -> Update(Mod.force firstIndex, Some 4) |> msg.single)
MenuItem.Item("Item 5", fun () -> Update(Mod.force firstIndex, Some 5) |> msg.single)
MenuItem.Items(
"Submenu 2",
[
MenuItem.Item("Item 6", fun () -> Update(Mod.force firstIndex, Some 6) |> msg.single)
MenuItem.Item("Item 7", fun () -> Update(Mod.force firstIndex, Some 7) |> msg.single)
MenuItem.Item("Item 8", fun () -> Update(Mod.force firstIndex, Some 8) |> msg.single)
MenuItem.Item(div [click (fun _ -> SetSelected HSet.empty |> msg.single)] [i [ clazz "rocket icon"] [] ])
]
)
]
)
]
]
]
div [ clazz "ui inverted segment" ] [
let run (cc : string) _e =
Modal.modal [
Modal.Header "Select or enter a friend"
Modal.Attributes [clazz ("ui modal " + cc)]
Modal.Settings [ Modal.Autofocus false ]
Modal.Simple(
"Mariam Potts",
(fun _ m -> m),
(fun v ->
dropdownInput [
DropdownInput.Attributes [clazz "ui inverted selection dropdown"]
DropdownInput.Selected (Mod.map Some v)
DropdownInput.Name "Friend"
DropdownInput.Update (function Some v -> Some v | None -> None)
DropdownInput.Options ["Vanessa Cooke"; "Dale Hurst"; "Devyn Pitts"; "Vaughn Powell"; "Amari Massey"; "Tiffany Branch"; "Jazmin Jacobson"; "Eva Koch"; "Grayson Savage"; "Mathew Burgess"; "Karissa Sutton"; "Maddox Giles"; "Kyler Patrick"; "Leonard Church"; "Griffin Bowman"; "Mariam Potts"; "Chance Schultz"; "Kash Bray"; "Matteo Williams"; "Amelia Sims" ]
]
),
(fun v a ->
if a = ModalResult.Approve then msg.single (ModalResult v)
elif a = ModalResult.Deny then msg.single (SetSelected(HSet.ofList [1;3;5;7;11]))
else msg.empty
)
)
]
yield Generic.h2 [] "Modal"
yield
button [
Button.Content "Show Modal"
Button.Attributes [clazz "ui inverted green button"]
Button.Click (run "inverted")
]
yield
button [
Button.Content "Show Tiny Modal"
Button.Attributes [clazz "ui inverted green button"]
Button.Click (run "inverted tiny")
]
yield
button [
Button.Content "Show Mini Modal"
Button.Attributes [clazz "ui inverted green button"]
Button.Click (run "inverted mini")
]
yield
button [
Button.Content "Show Basic Modal"
Button.Attributes [clazz "ui inverted green button"]
Button.Click (run "basic mini")
]
]
div [ clazz "ui inverted segment"] [
Generic.h2 [] "Slider"
table [
Table.Attributes [clazz "ui basic table"]
Table.Content [[
td [ clazz "collapsing"] [
input [
Input.Attributes [ clazz "ui inverted input"; style "display: inline-block"]
Input.UpdateOnInput false
Input.Update (fun str ->
match System.Double.TryParse str with
| (true, v) -> [ SetValue v ]
| _ -> []
)
Input.Text (m.value |> Mod.map (sprintf "%.4f"))
]
]
slider [
Slider.Enabled m.dummy
Slider.Attributes [clazz "ui inverted red slider"]
Slider.Range(0.0, 1.0)
Slider.Value m.value
Slider.Update (fun v -> [SetValue v])
Slider.UpdateWhileDragging true
Slider.Settings [
Slider.PageMultiplier 100.0
Slider.Step 0.001
]
]
]]
]
]
]
let app =
{
initial = initial
update = update
view = view
unpersist = Unpersist.instance
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment