play project with ocaml

Makefile

run:
	ocamlbuild -use-ocamlfind -package batteries world_common.native
	ocamlbuild -use-ocamlfind -package batteries world.native && _build/world.native | tee results.txt

upload:
	gist -u https://gist.github.com/mboeh/c45e477a8f737a9157e0 world.ml world_common.ml world_common.mli Makefile results.txt

results.txt

== Tick 0 ==
Randou, age 23 (Quirk: none)
Youngsman, age 19 (Quirk: Benjamin button disease)
Oldsman, age 127 (Quirk: Accelerated aging)

== Tick 4 ==
Randou, age 23 (Quirk: none)
Youngsman, age 15 (Quirk: Benjamin button disease)
Oldsman, age 131 (Quirk: Accelerated aging)

world.ml

open World_common
open Batteries

module Character_state = struct
  open Character
  open BatPrintf

  type wrapped = Character.t
  type t = { character : wrapped ; quirk: Quirk.t }

  let make chr = { character = chr ; quirk = Quirk.none }
  let create ~name ~age = Character.make ~name ~age |> make
  let quirked qk st = { st with quirk = qk }

  let tick wld st = { st with character = Quirk.run st.quirk st.character Start_of_turn }
  let display st = sprintf "%s (Quirk: %s)" (Character.display st.character) (Quirk.display st.quirk) 
end

module Effects = struct
  open Effect
  open Character

  let aging = Effect.make 
                ~name:"Accelerated aging"
                ~context:Start_of_turn
                ~action:(fun (c : Character.t) -> { c with age = (Age.change 1 c.age) })
  let deaging = Effect.make 
                  ~name:"Benjamin button disease"
                  ~context:Start_of_turn
                  ~action:(fun (c : Character.t) -> { c with age = (Age.change (-1) c.age) })

end

(* Represents all the entities in the game world. *)
module World = struct
  (* This is a stab at having a polymorphic world entity type. *)
  module type World_state = sig
    type t
    val tick : 'a -> t -> t
    val display : t -> string
  end
  (* I am almost entirely convinced there's some way I can use the type system
   * to automatically map Entry.tick to Character_state.tick when t is a Char_entry... *)
  module Entry = struct
    type t = Char_entry of Character_state.t
    let tick wld ent =
      match ent with Char_entry ent -> Char_entry (Character_state.tick wld ent)
    let display ent =
      match ent with Char_entry ent -> Character_state.display ent
  end

  type t = { entries : Entry.t list ; ticks : int }

  (* Create a new world. *)
  let make = { entries = [] ; ticks = 0 }
  let add wld character = { wld with entries = (Entry.Char_entry character) :: wld.entries }
  let make_filled =
    let wld = make in
    List.fold_left (fun wld st -> add wld st) wld

  let tick wld = 
    let nextworld = (BatList.enum wld.entries) |> Enum.map (Entry.tick wld.entries) |> BatList.of_enum in
    { entries = nextworld ; ticks = wld.ticks+1 } 
  let iter wld f = List.iter f wld.entries

  let print wld =
    BatPrintf.printf "== Tick %d ==\n" wld.ticks;
    iter wld (fun chr ->
      Entry.display chr |> print_string;
      print_string "\n"
    );
    BatPrintf.printf "\n"
end

let mainloop wld =
  World.print wld;
  World.tick (World.tick (World.tick (World.tick wld)))

let main () =
  let characters =
    Character_state.([
      create ~name:"Oldsman" ~age:127 |> quirked (Quirk.of_effect Effects.aging)
    ; create ~name:"Youngsman" ~age:19 |> quirked (Quirk.of_effect Effects.deaging)
    ; create ~name:"Randou"  ~age:23  
    ]) in
  let wld = 
    World.make_filled characters in
  let final_world = 
    mainloop wld in
  World.print final_world

let () = main ()

world_common.ml

module Name = struct
  type t = string

  let of_string str = str
end

module Age = struct
  type t = int

  let of_int i = i
  let change i age = age + i 
end

type effect_context = Start_of_turn | End_of_turn

module Effect = struct
  type 'a t = { name: Name.t ; context: effect_context ; action: 'a -> 'a }
  type 'a action_f = 'a -> 'a

  let make ~name ~context ~action = { name ; context ; action }
  let run_for_sure eff tgt = eff.action tgt
  let run eff tgt ctx = if eff.context = ctx then run_for_sure eff tgt else tgt
end

module Character = struct
  open Printf

  type t = { name : Name.t ; age : Age.t }

  let make ~name ~age = { name ; age }

  let display chr = sprintf "%s, age %d" chr.name chr.age
end

module Quirk = struct
  open Effect
  open Printf

  type qkt = { name : Name.t ; effect : Character.t Effect.t }
  type t = qkt option

  let none = None
  
  let run qk chr ctx = match qk with Some qk -> Effect.run qk.effect chr ctx | None -> chr

  let of_effect (eff : Character.t Effect.t) = Some { name = eff.name ; effect = eff }
  
  let name = function Some qk -> qk.name | None -> "none"

  let display qk = sprintf "%s" (name qk)
end

world_common.mli

module Name :
  sig 
    type t 
    
    val of_string : string -> t
  end

module Age : 
  sig 
    type t
    
    val of_int : int -> t
    val change : int -> t -> t
  end

type effect_context = Start_of_turn | End_of_turn

module Effect :
  sig
    type 'a t
    type 'a action_f = 'a -> 'a

    val make : name:string -> context:effect_context -> action:('a action_f) -> 'a t
    val run : 'a t -> 'a -> effect_context -> 'a
  end

module Character :
  sig
    type t = { name : Name.t ; age : Age.t }
    
    val make : name:string -> age:int -> t
    val display : t -> string
  end

module Quirk :
  sig
    type t
    
    val none : t 
    val run : t -> Character.t -> effect_context -> Character.t
    val of_effect : Character.t Effect.t -> t 
    val name : t -> string 
    val display : t -> string
  end