A bank test

open System

type Scene = | Welcome
             | Deposit of string
             | Withdraw of string
             | Exit
type Cash = float
type State = State of Scene * Cash

type SceneEvent = State -> State

let readLine = Console.ReadLine
let readChar () = Console.ReadKey().KeyChar
let printFormat form =
    form
    |> Printf.TextWriterFormat<_>
    |> printfn

let (|Float|_|) str =
    match Double.TryParse str with
    | true, x -> Some x
    | false, _ -> None

let setSceneMessage message =
    function
    | Deposit _ -> Deposit message
    | Withdraw _ -> Withdraw message
    | x -> x

let noEvent x = x
let addCash amount (State (scene, cash)) =
    State (scene, cash+amount)
let setScene scene (State (_, cash)) =
    State (scene, cash)
let setMessage msg (State (scene, cash)) =
    State (setSceneMessage msg scene, cash)

let screen text action message cash =
    Console.Clear()
    if message <> ""
    then printFormat (text + "\n" + message) cash
    else printFormat text cash
    action cash

let welcomeText = """Welcome! Your account has balance of %.2f.
  (d)eposit   Deposit funds.
  (w)ithdraw  Withdraw funds.
  (q)uit      Quit the program."""

let welcomeLogic cash =
    match readChar() with
    | 'd' -> setScene (Deposit "")
    | 'w' -> setScene (Withdraw "")
    | 'q' -> setScene Exit
    | _ -> noEvent

let depositText = """Your account has balance of %.2f.
How much would you like to deposit? (0 to cancel)"""

let depositNegativeText = "You can't deposit a negative amount!"

let depositLogic cash =
    match readLine() with
    | Float amount when amount >= 0.0 ->
        addCash amount >> setScene Welcome
    | Float amount when amount < 0.0 ->
        setMessage depositNegativeText
    | _ -> noEvent

let withdrawText = """Your account has balance of %.2f.
How much would you like to withdraw? (0 to cancel)"""

let withdrawOverText = "You can't withdraw more than you own!"
let withdrawNegativeText = "You can't withdraw a negative amount!"

let withdrawLogic cash =
    match readLine() with
    | Float amount when amount >= 0.0 && amount <= cash ->
        addCash -amount >> setScene Welcome
    | Float amount when amount >= 0.0 && amount > cash ->
        setMessage withdrawOverText
    | Float amount when amount < 0.0 ->
        setMessage withdrawNegativeText
    | _ -> noEvent

let welcomeScreen = screen welcomeText welcomeLogic
let depositScreen = screen depositText depositLogic
let withdrawScreen = screen withdrawText withdrawLogic

let showScreen (State (scene, cash)) =
    match scene with
    | Welcome -> welcomeScreen "" cash
    | Deposit msg -> depositScreen msg cash
    | Withdraw msg -> withdrawScreen msg cash
    | Exit -> noEvent

let applyTo x f = f x

let update state =
    state
    |> showScreen
    |> applyTo state

let rec updateLoop state =
    match update state with
    | State (Exit, _) -> 0
    | newState -> updateLoop newState

[<EntryPoint>]
let main argv =
    State (Welcome, 0.0) |> updateLoop