Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Provide more information about the current page view

  • Loading branch information...
commit 8386c5c4b9724bd64076b9cf5c0ae080b3848116 1 parent c064820
@VictorNicollet authored
Showing with 97 additions and 34 deletions.
  1. +44 −10 ohmStatic/ohmStatic.ml
  2. +53 −24 ohmStatic/ohmStatic.mli
View
54 ohmStatic/ohmStatic.ml
@@ -17,7 +17,22 @@ type page = <
title : string option ;
json : renaming -> (string * Json.t) list ;
>
-type pageinfo = <
+type item = [ `Page of page | `File of string ]
+type site = (string,item) BatPMap.t
+
+module Exported = struct
+
+ type 'server t = {
+ rename : renaming ;
+ url : 'server -> key -> string option
+ }
+
+ let rename site = site.rename
+ let url site = site.url
+
+end
+
+type 'server pageinfo = <
body : Ohm.Html.writer ;
css : string list ;
js : string list ;
@@ -26,11 +41,12 @@ type pageinfo = <
title : string ;
key : key ;
url : string ;
- json : (string * Json.t) list
+ json : (string * Json.t) list ;
+ req : ('server, unit) Action.request ;
+ site : 'server Exported.t
>
-type 'ctx renderer = pageinfo -> ('ctx, JsCode.t -> string) Run.t
-type item = [ `Page of page | `File of string ]
-type site = (string,item) BatPMap.t
+
+type ('s,'ctx) renderer = 's pageinfo -> ('ctx, JsCode.t -> string) Run.t
let ends s t = BatString.ends_with s t
@@ -50,7 +66,7 @@ let canonical = function
| s when ends s ".md" -> clip ".md" s
| s -> s
-let generic_render ?writer (page:Html.renderer) (info:pageinfo) =
+let generic_render ?writer (page:Html.renderer) (info:'s pageinfo) =
let writer = BatOption.default (info # body) writer
and css = info # css
@@ -70,6 +86,10 @@ let wrap ?(page=O.page) template info =
let! writer = ohm (template (info # body)) in
generic_render ~writer page info
+let extend ?(page=O.page) template info =
+ let! writer = ohm (template info) in
+ generic_render ~writer page info
+
let prefixed_render ~default list info =
let key = info # key in
let page =
@@ -99,10 +119,16 @@ let export ?(rename=canonical) ?(render=default_render) ?(public="/") ~server ~t
in
let url server key =
- try Action.url (BatPMap.find key endpoints) server ()
+ try Some (Action.url (BatPMap.find key endpoints) server ())
with Not_found ->
- try public ^ BatPMap.find key files
- with Not_found -> public ^ key
+ try Some (public ^ BatPMap.find key files)
+ with Not_found -> None
+ in
+
+ let exported = { Exported.rename ; Exported.url } in
+
+ let url server key =
+ match url server key with Some url -> url | None -> public ^ key
in
List.iter begin fun (define,page,key) ->
@@ -140,11 +166,19 @@ let export ?(rename=canonical) ?(render=default_render) ?(public="/") ~server ~t
val json = lazy (page # json rename)
method json = Lazy.force json
+ val req = req
+ method req = req
+
+ val site = exported
+ method site = site
+
end in
let! page = ohm (render info) in
return $ Action.page page res
end
- end definitions
+ end definitions ;
+
+ exported
View
77 ohmStatic/ohmStatic.mli
@@ -36,10 +36,39 @@ type page = <
title : string option ;
json : renaming -> (string * Ohm.Json.t) list ;
>
+
+(** The type of a static. This is either a bit of HTML, or a standalone file that
+ can become downloadable.
+*)
+type item = [ `Page of page | `File of string ]
+
+(** The type of a static site - it maps the key (which is the relative path of an
+ item within the /static directory) to its contents.
+*)
+type site = (string,item) BatPMap.t
+
+(** A module for working on exported sites. *)
+module Exported : sig
+
+ (** The type of an exported site. Since a site is exported on a server, the
+ server parameter is also a parameter of the exported site. *)
+ type 'server t
-(** Information about a page. Provided to renderers.
+ (** The internal renamer function used to export this site. *)
+ val rename : 'any t -> renaming
+
+ (** Generate the url based on a key and the server parameter. This may
+ return [None] if the key does not match a defined (and public)
+ page or file.
+ *)
+ val url : 'server t -> 'server -> key -> string option
+
+end
+
+(** Information about a page. Provided to renderers.
+ This includes the received HTTP request.
*)
-type pageinfo = <
+type 'server pageinfo = <
body : Ohm.Html.writer ;
css : string list ;
js : string list ;
@@ -48,54 +77,54 @@ type pageinfo = <
title : string ;
key : key ;
url : string ;
- json : (string * Ohm.Json.t) list
+ json : (string * Ohm.Json.t) list ;
+ req : ('server, unit) Ohm.Action.request ;
+ site : 'server Exported.t
>
-
-(** The type of a static. This is either a bit of HTML, or a standalone file that
- can become downloadable.
-*)
-type item = [ `Page of page | `File of string ]
-(** The type of a static site - it maps the key (which is the relative path of an
- item within the /static directory) to its contents.
-*)
-type site = (string,item) BatPMap.t
+(** A page renderer. Behaves like an [Ohm.Html.ctxrenderer], but is provided with
+ all its arguments as a single {!type:pageinfo}. *)
+type ('serv,'ctx) renderer = 'serv pageinfo -> ('ctx, Ohm.JsCode.t -> string) Ohm.Run.t
(** Canonical transformation of an URL : remove [.md], [.htm] and [.html] extensions,
then turn [foo/index] into [foo] (and ["index"] into [""]).
*)
val canonical : key -> string
-(** A page renderer. Behaves like an [Ohm.Html.ctxrenderer], but is provided with
- all its arguments as a single {!type:pageinfo}. *)
-type 'ctx renderer = pageinfo -> ('ctx, Ohm.JsCode.t -> string) Ohm.Run.t
-
(** Create a renderer from a custom page renderer. This simply uses the selected
page renderer instead of [O.page].
*)
-val custom_render : Ohm.Html.renderer -> 'ctx renderer
+val custom_render : Ohm.Html.renderer -> ('s,'ctx) renderer
(** Create a renderer from a wrapper template : the page contents are passed to the
wrapper template function, and then rendered with the vanilla [O.page]. *)
val wrap :
?page:Ohm.Html.renderer
-> (Ohm.Html.writer -> ('ctx, Ohm.Html.writer) Ohm.Run.t)
- -> 'ctx renderer
+ -> ('serv,'ctx) renderer
+
+(** Create a renderer from a wrapper template that is also provided with the full
+ pageinfo for the page being rendered.
+*)
+val extend :
+ ?page:Ohm.Html.renderer
+ -> ('serv pageinfo -> ('ctx, Ohm.Html.writer) Ohm.Run.t)
+ -> ('serv,'ctx) renderer
(** Combine multiple renderers : select which renderer to use based on the prefix
of the key of the page being rendered. The first matching prefix wins.
*)
val prefixed_render :
- default:'ctx renderer
- -> (string * 'ctx renderer) list
- -> 'ctx renderer
+ default:('serv,'ctx) renderer
+ -> (string * ('serv,'ctx) renderer) list
+ -> ('serv,'ctx) renderer
(** Provide a context for rendering. This turns a renderer with an arbitrary
context into a unit-context renderer as expected by the {!val:export}
function. You are expected to provide a function that returns the context
(so that the exporter can generate a new context on demand).
*)
-val with_context : ('arg -> 'ctx) -> 'arg -> 'ctx renderer -> unit renderer
+val with_context : ('arg -> 'ctx) -> 'arg -> ('s,'ctx) renderer -> ('s,unit) renderer
(** Export a static site.
@param rename A function that provides the path of each item. By default,
@@ -109,9 +138,9 @@ val with_context : ('arg -> 'ctx) -> 'arg -> 'ctx renderer -> unit renderer
*)
val export :
?rename:renaming
- -> ?render:unit renderer
+ -> ?render:('s,unit) renderer
-> ?public:string
-> server:('s Ohm.Action.server)
-> title:string
-> site
- -> unit
+ -> 's Exported.t
Please sign in to comment.
Something went wrong with that request. Please try again.