Permalink
Browse files

[feature] opages: Updating opages code to new apis

  • Loading branch information...
1 parent 508b9b5 commit 4ac7ca104a6f181438b04eebb6496756d333b2ac Anthonin Bonnefoy committed Jul 8, 2011
Showing with 117 additions and 56 deletions.
  1. +89 −24 OPAges/src/main.opa
  2. +28 −32 OPAges/src/template_demo.opa
View
@@ -1,4 +1,5 @@
import opages
+import stdlib.web.template
import stdlib.components.applicationframe
/**
@@ -22,26 +23,93 @@ import stdlib.components.applicationframe
@TODO: remove CApplicationFrame !! */
/** A path to store template content. */
-db /opages : stringmap(Page.stored)
+db /opages/pages : stringmap(Page.stored)
+db /opages/pages[_] = Page.empty
+db /opages/pages_rev : stringmap(Page.published)
+db /opages/pages_rev[_] = Page.not_published
-db /opages[_] full
-db /opages[_] = Page.empty
+database opages = @meta
/** */
-demo_engine = Template.combine(TemplateDemo.engine, Template.default)
+demo_engine = Template.combine(TemplateDemo.engine, Template.default)
-demo_access = {
- set = key, page -> /opages[key] <- page
- get = key -> ?/opages[key]
- rm = key -> Db.remove(@/opages[key])
- ls = -> StringMap.rev_fold(key, _, acc -> key +> acc, /opages, [] )
- date = key -> Db.modification_time(@/opages[key])
-}
+Access = {{
-demo_not_found =
- Resource.error_page("Page not found", <h1>Page not found</h1>, {wrong_address})
+ rec val cache = Cache.make(
+ Cache.Negociator.always_necessary(cached),
+ Cache.default_options
+ )
+ cached(key) = select(key)
+ select =
+ | {last = key} ->
+ do Log.warning("OpalangPage","Database access : last {key}")
+ Option.map(page -> {rev = nb_rev(key) ~page}, ?/opages/pages[key])
+ | ~{key rev} ->
+ do Log.warning("OpalangPage","Database access : {rev} {key}")
+ match Db.history(@/opages/pages[key], rev, 1)
+ | [] -> do Log.error("OpalangPage", "Revision {rev} at {key} not found") none
+ | [page] -> some(~{page rev})
+ | _ -> do Log.error("OpalangPage", "Inconsistent result : Revision {rev} at {key} not found") none
+ end
+ | {published = key} ->
+ do Log.warning("OpalangPage","Database access : published {key}")
+ match ?/opages/pages_rev[key]
+ | {none} -> cache.get({last = key})
+ | {some=p} ->
+ rev = Page.rev_of_published(p)
+ cache.get(~{key rev})
+ nb_rev(key) = List.length(Db.history(@/opages/pages[key], 1, 0))
+
+ reset_cache() =
+ lst = access.ls()
+ List.iter((key, _) -> do cache.invalidate({last = key}) do cache.invalidate({published = key}) void, lst)
+ fill_cache() =
+ lst = access.ls()
+ List.iter((key, _) -> ignore(access.select({published = key})), lst)
+
+ access = {
+
+ select = cache.get(_)
+
+ save =
+ | ~{key page} ->
+ rec aux() = match Db.transaction(opages,
+ -> do /opages/pages[key] <- page
+ nb_rev(key)
+ ) with
+ | {none} ->
+ do Log.error("OpalangPage", "Save transaction failed, retry") aux()
+ | {some = rev} ->
+ do cache.invalidate({last = key})
+ rev
+ end
+ aux()
+ | ~{key publish} ->
+ do /opages/pages_rev[key] <- publish
+ do cache.invalidate({published = key})
+ Page.rev_of_published(publish)
+
+ published(key) = ?/opages/pages_rev[key]
+
+ rm(key) =
+ do Db.remove(@/opages/pages[key])
+ do Db.remove(@/opages/pages_rev[key])
+ do cache.invalidate({last = key})
+ do cache.invalidate({published = key})
+ void
+ ls() = StringMap.rev_fold(key, _, acc -> (key, ?/opages/pages_rev[key]) +> acc,
+ /opages/pages,
+ [])
+ history(key) = Db.history(@/opages/pages[key], 1, 0)
-page_demo = Page.make({access = demo_access engine = demo_engine not_found = demo_not_found} : Page.config)
+ }
+}}
+
+page_demo = Page.make(
+ {
+ access = Access.access
+ engine(_env)= demo_engine
+ } : Page.config)
/** Init admin is does not exists or if needed on command line. */
admin_init =
@@ -94,17 +162,14 @@ server =
build_html(url, embedded)
| ~{resource} ->
/* Page return directly a resource. */
- Resource.secure(resource)
+ Server.public(_ -> resource)
/* Secured service */
- secure = Server.secure(Server.ssl_default_params, url_dispatcher)
- { secure with
- /* Record extension will give us a record, i.e. a closed sum so, open it
- to make it compatible with type [Server.encryption]. */
- encryption = {Server.ssl_default_params with
- certificate="./main.crt"
- private_key="./main.key"} <: Server.encryption
- server_name = "https"
- }
+ ssl_params = { Server.ssl_default_params with
+ certificate="opages.crt"
+ private_key="opages.key"
+ } <: Server.encryption
+ { Server.secure(ssl_params, url_dispatcher) with server_name = "https" }
+
/** CSS used for administration pages for moment all services share
css. */
@@ -27,6 +27,10 @@ type TemplateDemo.content('a) = Template.content(either(TemplateDemo.tags('a), '
TemplateDemo = {{
+ namespace = "http://opalang.org/schema/demo.xsd"
+
+ dom_err(msg) = {failure = {dom_error = msg}}
+
@private TDate = {{
@private default_date_format = "%d/%m/%y"
@@ -36,7 +40,7 @@ TemplateDemo = {{
| {some = { ~value ... } } -> { date_format=value }
| { none } -> { date_format=default_date_format }
- export(~{date_format}, _child) = match Date.try_generate_printer(date_format) with
+ export(~{date_format}, _exporter) = match Date.try_generate_printer(date_format) with
| { success=date_printer } -> <>{Date.to_formatted_string(date_printer, Date.now())}</>
| { ~failure } -> <>Incorrect date format {failure}</>
}}
@@ -45,57 +49,49 @@ TemplateDemo = {{
build({args=_ children=_}) = {random}
- export({random}, _child) = <>Random : {Random.int(515)}</>
+ export({random}, _exporter) = <>Random : {Random.int(515)}</>
}}
- namespace = Uri.of_string("http://opalang.org/schema/demo.xsd") |> Option.get
-
- @private parse(_config, ~{ns tag args children }:Template.import_arg(TemplateDemo.tags('a), 'b)) : outcome(Template.content(either(TemplateDemo.tags('a), 'b)), Template.failure) =
- if ns == namespace then
+ @private parse(_config, ~{xmlns xmlns_parser}:Template.import_arg(TemplateDemo.tags('a), 'b)) : outcome(Template.content(either(TemplateDemo.tags('a), 'b)), Template.failure) =
+ match xmlns with
+ | { ~tag; namespace="http://opalang.org/schema/demo.xsd"; ~args; specific_attributes=_; ~content } ->
+ children = Outcome.get(Template.parse_list_xmlns(content, xmlns_parser))
build = match tag
| "random" -> some(TRandom.build)
| "date" -> some(TDate.build)
| "scope" -> some({args=_ ~children} -> {scope = children} )
| _ -> none
Option.switch((build -> {success = Template.to_extension(build(~{args children}))}),
- {failure = {unsupported_tag ~ns ~tag}},
+ {failure = {unsupported_tag ns=namespace ~tag}},
build)
- else {failure = {namespace_not_supported_by_engine =
- "Engine({namespace}) vs Namespace({ns})"}}
+ | _ -> { failure = { unsupported_node=xmlns } }
- @private export(content, child) =
- e = Template.from_extension(content)
- match e
+ @private export(content, exporter) =
+ match Template.from_extension(content)
| {none} -> {failure = {unknown_tag="Expected extension"}}
| {some = e} ->
{success = match e
- | {random} as e -> TRandom.export(e, child)
- | {date_format=_} as e -> TDate.export(e, child)
- | {scope=_} -> child}
+ | {random} as e -> TRandom.export(e, exporter)
+ | {date_format=_} as e -> TDate.export(e, exporter)
+ | {~scope} -> Outcome.get(exporter(scope) ) }
- @private source(content, child, xmlns_binding, printer) =
- binding = StringMap.get(Uri.to_string(namespace), xmlns_binding)
+ @private source(content, exporter, xmlns_binding, printer, depth) =
+ binding = StringMap.get(namespace, xmlns_binding)
|> Option.default("opa", _)
- create_tag(tag_name, may_attribute, autoclose) =
- begin, after ->
- attr = Option.default("", may_attribute)
- if autoclose
- then "{begin}<{binding}:{tag_name}{attr} />"
- else "{begin}<{binding}:{tag_name}{attr}> {child} {after}</{binding}:{tag_name}>"
+ create_tag(tag_name, may_attribute, autoclose, may_child) =
+ may_child = Option.map(child -> Outcome.get(exporter(child) ), may_child)
+ Template.print_tag(tag_name, some(binding), Option.default("", may_attribute), autoclose, true, may_child)
+
match Template.from_extension(content) with
| { none } -> { failure = { unknown_tag = "Expected extension" } }
- | { some=tag } -> { success = printer(
+ | { some=tag } -> { success = printer(depth)(
match tag
- | { random } -> create_tag("version", none, true)
- | ~{ date_format } -> create_tag("date", some(" format=\"{date_format}\""), true)
- | { scope=_ } -> create_tag("scope", none, false)
+ | { random } -> create_tag("version", none, true, none)
+ | ~{ date_format } -> create_tag("date", some(" format=\"{date_format}\""), true, none)
+ | { ~scope } -> create_tag("scope", none, false, some(scope))
)}
- @private extract_children(content) = match Template.from_extension(content)
- | {some = ~{scope}} -> [scope]
- | _ -> []
-
- engine = ~{Template.empty with parse export source extract_children}
+ engine = ~{Template.empty with parse export source }
}}

0 comments on commit 4ac7ca1

Please sign in to comment.