Chiron experiments

Playing with Chiron for JSON storage.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
77:

open Chiron
open Chiron.Operators

type Suit with
    static member ToJson (suit : Suit) =
        match suit with
        | Punch -> ToJsonDefaults.ToJson "punch"
        | Kick -> ToJsonDefaults.ToJson "kick"
        | Throw -> ToJsonDefaults.ToJson "throw"
        | Defend -> ToJsonDefaults.ToJson "defend"
    static member FromJson (_ : Suit) : Json<Suit> =
        fun json ->
            match json with
            | String "punch" -> Value Punch, json
            | String "kick" -> Value Kick, json
            | String "throw" -> Value Throw, json
            | String "defend" -> Value Defend, json
            | s -> Error (sprintf "Expected suit, found %A" s), json

type Card with
    static member private createMega name speed damage =
        MegaAttack (name, speed, damage)

    static member private createBasic suit value =
        Basic (suit, value)

    static member ToJson (card : Card) =
        match card with
        | KnockDown ->
            Json.write "type" "knockdown"
        | Combo (speed, extra) -> 
            Json.write "type" "combo"
            *> Json.write "speed" speed
            *> Json.write "extra" extra
        | MegaAttack (name, speed, damage) ->
            Json.write "type" "mega"
            *> Json.write "name" name
            *> Json.write "speed" speed
            *> Json.write "damage" damage
        | Basic (suit, v) ->
            Json.write "type" "basic"
            *> Json.write "suit" suit
            *> Json.write "value" v
    static member FromJson (_ : Card) =
        json {
            let! t = Json.read "type"

            return!
                match t with
                | "knockdown" -> Json.init KnockDown
                | "combo" ->
                        fun spd ext -> Combo(spd, ext)
                    <!> (Json.read "speed") <*> (Json.read "extra")
                | "mega" ->
                        fun name spd dam -> MegaAttack (name, spd, dam)
                    <!> (Json.read "name") <*> (Json.read "speed") <*> (Json.read "damage")
                | "basic" -> Card.createBasic <!> (Json.read "suit") <*> (Json.read "value")
                | _ -> Json.error (sprintf "Expected card")
        }

type PlayerName with
    static member ToJson (PlayerName p) =
        ToJsonDefaults.ToJson p
    static member FromJson (_ : PlayerName) : Json<PlayerName> =
        fun json ->
            match json with
            | String s -> Value <| PlayerName s, json
            | x -> Error (sprintf "Expected player name, found %A" x), json

type DeckName with
    static member ToJson (DeckName d) =
        ToJsonDefaults.ToJson d
    static member FromJson (_ : DeckName) =
        fun json ->
            match json with
            | String s -> Value <| DeckName s, json
            | x -> Error (sprintf "Expected deck name, found %A" x), json

module Chiron

module Operators

from Chiron

Multiple items
union case ToJsonDefaults.ToJsonDefaults: ToJsonDefaults

--------------------
type ToJsonDefaults =
  | ToJsonDefaults
  static member ToJson : ('a0 * 'a1 * 'a2) -> Json<unit> (requires member ToJson and member ToJson and member ToJson)
  static member ToJson : ('a0 * 'a1) -> Json<unit> (requires member ToJson and member ToJson)
  static member ToJson : x:Set<'a> -> Json<unit> (requires comparison and member ToJson)
  static member ToJson : x:'a option -> Json<unit> (requires member ToJson)
  static member ToJson : x:Map<string,'a> -> Json<unit> (requires member ToJson)
  static member ToJson : x:'a list -> Json<unit> (requires member ToJson)
  static member ToJson : x:'a array -> Json<unit> (requires member ToJson)
  static member ToJson : x:Json -> Json<unit>
  static member ToJson : x:Guid -> Json<unit>
  static member ToJson : x:DateTimeOffset -> Json<unit>
  static member ToJson : x:DateTime -> Json<unit>
  static member ToJson : x:uint64 -> Json<unit>
  static member ToJson : x:uint32 -> Json<unit>
  static member ToJson : x:uint16 -> Json<unit>
  static member ToJson : x:string -> Json<unit>
  static member ToJson : x:single -> Json<unit>
  static member ToJson : x:int64 -> Json<unit>
  static member ToJson : x:int16 -> Json<unit>
  static member ToJson : x:int -> Json<unit>
  static member ToJson : x:float -> Json<unit>
  static member ToJson : x:decimal -> Json<unit>
  static member ToJson : x:bool -> Json<unit>

Full name: Chiron.Mapping.ToJsonDefaults

static member ToJsonDefaults.ToJson : ('a0 * 'a1 * 'a2) -> Json<unit> (requires member ToJson and member ToJson and member ToJson)
   (+0 other overloads)
static member ToJsonDefaults.ToJson : ('a0 * 'a1) -> Json<unit> (requires member ToJson and member ToJson)
   (+0 other overloads)
static member ToJsonDefaults.ToJson : x:Set<'a> -> Json<unit> (requires comparison and member ToJson)
   (+0 other overloads)
static member ToJsonDefaults.ToJson : x:'a option -> Json<unit> (requires member ToJson)
   (+0 other overloads)
static member ToJsonDefaults.ToJson : x:Map<string,'a> -> Json<unit> (requires member ToJson)
   (+0 other overloads)
static member ToJsonDefaults.ToJson : x:'a list -> Json<unit> (requires member ToJson)
   (+0 other overloads)
static member ToJsonDefaults.ToJson : x:'a array -> Json<unit> (requires member ToJson)
   (+0 other overloads)
static member ToJsonDefaults.ToJson : x:Json -> Json<unit>
   (+0 other overloads)
static member ToJsonDefaults.ToJson : x:System.Guid -> Json<unit>
   (+0 other overloads)
static member ToJsonDefaults.ToJson : x:System.DateTimeOffset -> Json<unit>
   (+0 other overloads)

Multiple items
module Json

from Chiron.Mapping

--------------------
module Json

from Chiron.Formatting

--------------------
module Json

from Chiron.Parsing

--------------------
module Json

from Chiron.Optics

--------------------
module Json

from Chiron.Functional

--------------------
type Json =
  | Array of Json list
  | Bool of bool
  | Null of unit
  | Number of decimal
  | Object of Map<string,Json>
  | String of string
  static member Array_ : Prism<Json,Json list>
  static member private Array__ : (Json -> Json list option) * (Json list -> Json)
  static member Bool_ : Prism<Json,bool>
  static member private Bool__ : (Json -> bool option) * (bool -> Json)
  static member Null_ : Prism<Json,unit>
  static member private Null__ : (Json -> unit option) * (unit -> Json)
  static member Number_ : Prism<Json,decimal>
  static member private Number__ : (Json -> decimal option) * (decimal -> Json)
  static member Object_ : Prism<Json,Map<string,Json>>
  static member private Object__ : (Json -> Map<string,Json> option) * (Map<string,Json> -> Json)
  static member String_ : Prism<Json,string>
  static member private String__ : (Json -> string option) * (string -> Json)

Full name: Chiron.Json

--------------------
type Json<'a> = Json -> JsonResult<'a> * Json

Full name: Chiron.Functional.Json<_>

val json : JsonBuilder

Full name: Chiron.Builder.json

Multiple items
union case Json.String: string -> Json

--------------------
module String

from Microsoft.FSharp.Core

union case JsonResult.Value: 'a -> JsonResult<'a>

union case JsonResult.Error: string -> JsonResult<'a>

val sprintf : format:Printf.StringFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.sprintf

val write : key:string -> value:'a -> Json<unit> (requires member ToJson)

Full name: Chiron.Mapping.Json.write

val read : key:string -> Json<'a> (requires member FromJson)

Full name: Chiron.Mapping.Json.read

val init : a:'a -> json:Json -> JsonResult<'a> * Json

Full name: Chiron.Functional.Json.init

val error : e:string -> json:Json -> JsonResult<'a> * Json

Full name: Chiron.Functional.Json.error

Raw view Test code New version

More information

Link:	http://fssnip.net/q8
Posted:	9 years ago
Author:	mavnn
Tags:	chiron