OSM ocaml parser

For handling OSM data in ocaml (good starting point to write converters and/or renderers). The code in this page is licensed under the WTFPL license. It does not deal with relations (indeed it chokes on relation tags)

Osm.ml is simple internal form (supports only basic stuff: time-stamps, user and visible attributes are ignored). It also conatins a function to laod from som xml format.

type id = string
 
module StringMap = Map.Make(String)
 
type tags = string StringMap.t
 
type node = {n_id:id;n_tags: tags; n_lat_long:float*float}
 
type way = {w_id: id; w_tags: tags; w_nodes: id list; }
 
 
type nodes = node StringMap.t
type ways = way StringMap.t
 
type osm = {o_nodes:nodes;o_ways:ways} 
let empty_world = {o_nodes=StringMap.empty; o_ways=StringMap.empty}
 
let add_tag k v tag_map = StringMap.add k v tag_map
let no_tag = StringMap.empty
 
let new_node id tags ll =  {n_id=id;n_tags=tags;n_lat_long=ll}
let register_node n osm = {osm with o_nodes= StringMap.add n.n_id n osm.o_nodes}
 
let new_way id tags nodes =  {w_id=id;w_tags=tags;w_nodes=nodes}
let register_way w osm = {osm with o_ways= StringMap.add w.w_id w osm.o_ways}
 
(* access *)
 
let get_node osm id = StringMap.find id osm.o_nodes
let get_way osm id = StringMap.find id osm.o_ways
 
let way_nodes osm w =
  List.map (fun n_id -> get_node osm n_id) w.w_nodes

let fold_ways func osm acc =
  StringMap.fold func osm.o_ways acc
 
let get_ways p osm = 
  List.rev (fold_ways (fun _ w res -> if p w then w::res else res) osm [])

let get_tag tags k = StringMap.find k tags
let has_tag tags k = StringMap.mem k tags
let way_tag w k = get_tag w.w_tags k
let way_has_tag w k = has_tag w.w_tags k
let way_has_tag_in w k_list =
  List.exists (way_has_tag w) k_list

let way_has_tag_value w k v = 
  try
    get_tag w.w_tags k = v
  with
    | Not_found -> false
 
(* layer management helpers *)
 
type 'a layers = 'a list StringMap.t
let empty_layers = StringMap.empty
 
 
let add_elem_to_layer se layer_id layers =
  let new_layer = se::
    (try StringMap.find layer_id layers
     with Not_found -> [])
  in
    StringMap.add layer_id new_layer layers

let map_layers f layers = 
  List.rev (StringMap.fold (fun lid elems res -> f lid elems:: res) layers [])


(* Xml load *)

open Xml
let parse_tag tag_map = function
  | Element("tag",["k",key;"v",value],[]) 
  | Element("tag",["v",value;"k",key],[]) -> add_tag key value tag_map
  | _ -> tag_map
 
let parse_tags xml= 
    List.fold_left parse_tag no_tag xml
 
let parse_node atts children =
  let r_id = ref "" in
  let r_lat = ref 0. in
  let r_long = ref 0. in
  List.iter (function
    |("id",id) -> r_id := id
    |("lat",lat) -> r_lat := float_of_string lat
    |("lon",long) -> r_long := float_of_string long
    |_ -> ()
  ) atts;
    new_node !r_id (parse_tags children) ( !r_lat , !r_long)
 
  
 
let parse_way atts children =
  let r_id = ref "" in
    List.iter (function
                 |("id",id) -> r_id := id
                 |_ -> ()
              ) atts;
    let r_nodes = ref [] in
      List.iter (function
	                 |Element("nd",["ref",id],[]) -> r_nodes := id:: !r_nodes
	                 |Element("seg",_,_) -> failwith "bad tag format"
	                 |_ -> ()
                ) children;
      new_way !r_id (parse_tags children) !r_nodes
        
        
let parse_osm world= function
  |Element("node",atts, children) -> 
     let n = parse_node atts children in
       register_node n world
  |Element("way",atts, children) ->
     let w = parse_way atts children in
       register_way w world
  |Element("bound",_,_) -> world
  |Element(e,_,_) -> failwith ("unknown tag "^e)
  |PCData s ->failwith ("unexpected PCDdata "^s)
let parse fname=
  match parse_file fname with
    |Element("osm",_,children) -> List.fold_left parse_osm empty_world children
    | _ -> failwith "bad osm format"