Skip to content
This repository
Browse code

[enhance] packages: mv OPAges in packages/experimental and add framework

  • Loading branch information...
commit 3c79d47a62ab542c83626c5fdb25bf4d63efb3eb 1 parent 336be65
Hugo Heuzard authored
0  OPAges/Makefile → packages/experimental/OPAges/Makefile
File renamed without changes
0  OPAges/Makefile.common → packages/experimental/OPAges/Makefile.common
File renamed without changes
0  OPAges/README → packages/experimental/OPAges/README
File renamed without changes
0  OPAges/opace/Makefile → packages/experimental/OPAges/opace/Makefile
File renamed without changes
0  OPAges/opace/Makefile.common → packages/experimental/OPAges/opace/Makefile.common
File renamed without changes
0  OPAges/opace/ace.opa → packages/experimental/OPAges/opace/ace.opa
File renamed without changes
0  OPAges/opace/plugin/ace/LICENSE → ...ages/experimental/OPAges/opace/plugin/ace/LICENSE
File renamed without changes
0  OPAges/opace/plugin/ace/Makefile → ...ges/experimental/OPAges/opace/plugin/ace/Makefile
File renamed without changes
0  OPAges/opace/plugin/ace/external_ACE.js → ...erimental/OPAges/opace/plugin/ace/external_ACE.js
File renamed without changes
0  OPAges/opace/plugin/ace/myconf.jsconf → ...xperimental/OPAges/opace/plugin/ace/myconf.jsconf
File renamed without changes
0  OPAges/opace/plugin/ace/plugin_ACE.js → ...xperimental/OPAges/opace/plugin/ace/plugin_ACE.js
File renamed without changes
0  OPAges/src/main.opa → packages/experimental/OPAges/src/main.opa
File renamed without changes
0  OPAges/src/page.opa → packages/experimental/OPAges/src/page.opa
File renamed without changes
0  OPAges/src/template_demo.opa → packages/experimental/OPAges/src/template_demo.opa
File renamed without changes
0  OPAges/src/users.opa → packages/experimental/OPAges/src/users.opa
File renamed without changes
0  OPAges/static-include/admin/style.css → ...xperimental/OPAges/static-include/admin/style.css
File renamed without changes
487 packages/experimental/framework/application.opa
... ... @@ -0,0 +1,487 @@
  1 +/*
  2 + Copyright © 2011 MLstate
  3 +
  4 + This file is part of OPA.
  5 +
  6 + OPA is free software: you can redistribute it and/or modify it under the
  7 + terms of the GNU Affero General Public License, version 3, as published by
  8 + the Free Software Foundation.
  9 +
  10 + OPA is distributed in the hope that it will be useful, but WITHOUT ANY
  11 + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  12 + FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
  13 + more details.
  14 +
  15 + You should have received a copy of the GNU Affero General Public License
  16 + along with OPA. If not, see <http://www.gnu.org/licenses/>.
  17 +*/
  18 +/*
  19 + @authors Hugo Heuzard
  20 +**/
  21 +
  22 +/**
  23 + * Framework
  24 + */
  25 +
  26 +package framework
  27 +
  28 +/**
  29 + * @author Hugo Heuzard
  30 + *
  31 + * {1 About this package}
  32 + *
  33 + * This package aims to provide a small framework that handle pages' creation,
  34 + * navigations throw pages, pages' access credentials, ...
  35 + *
  36 + * {1 Where should I start?}
  37 + *
  38 + * First : Create an application.
  39 + * Second : Declare all your entry point ("Page.Handler.t") with or without parameters.
  40 + * Third : Create your pages ("Page.Content")
  41 + * Finaly : Connect your pages to corresponding entry points.
  42 + *
  43 + * {1 What if I need more?}
  44 + *
  45 +**/
  46 +
  47 +
  48 +// TODO
  49 +// Cache client
  50 +// Action
  51 +// block system
  52 +// on_leave
  53 +
  54 +/**
  55 + * {1 Types defined in this module}
  56 + */
  57 +@private
  58 +type Application.State.msg =
  59 + {register path:string page:Page.Private.page}
  60 +/ {create path:string}
  61 +/ {get}
  62 +/ {check}
  63 +
  64 +/**
  65 + * The name of an application. This is mostly use for information purpose.
  66 +**/
  67 +type Application.name = string
  68 +
  69 +@private
  70 +type Application.State.result =
  71 + option(stringmap(Page.Private.page))
  72 +
  73 +/**
  74 + * Internal private state of an application.
  75 +**/
  76 +@abstract
  77 +type Application.State.t = Cell.cell(Application.State.msg, Application.State.result)
  78 +
  79 +/**
  80 + * Frame Maker type.
  81 +**/
  82 +type Application.frame_maker('state, 'cred) = Application.t('state, 'cred),xhtml,string -> xhtml
  83 +
  84 +/**
  85 + * Type of function that generate the top bar title
  86 +**/
  87 +type Application.title = string -> string
  88 +
  89 +/**
  90 + * The application type
  91 +**/
  92 +type Application.t('state, 'cred) = {
  93 + frame_maker : Application.frame_maker('state, 'cred)
  94 + title : Application.title
  95 + pages : Application.State.t
  96 + option : Application.option('state, 'cred)
  97 + id : string
  98 + state : 'state
  99 + get_cred : 'state -> 'cred
  100 + name : Application.name
  101 +}
  102 +
  103 +/**
  104 + * The application's options
  105 +**/
  106 +type Application.option('state, 'cred) = {
  107 + /** Page to serve when no page's found. The string argument is the last part of the url. **/
  108 + not_found : Page.Content.t('state, 'cred, string)
  109 + /** Page to serve when credential are missing. The string argument is the last part of the url. **/
  110 + unauthorized : Page.Content.t('state, 'cred, string)
  111 + /** true if you want to use anchor to change page. **/
  112 + single_page : bool
  113 + /** List of style sheet to include in the header. **/
  114 + css_uris : list(string)
  115 + /** List of javascript file to include in the header. **/
  116 + js_uris : list(string)
  117 + /** List of custom headers. **/
  118 + headers : list(xhtml)
  119 + /** Advance option, to precompile xhtml on server side. **/
  120 + precompile_xhtml : bool
  121 +}
  122 +
  123 +import stdlib.web.client
  124 +
  125 +Application = {{
  126 + @server @private
  127 + State = {{
  128 + get(appl) = Option.get(Cell.call(appl.pages, {get}))
  129 + register(appl,handler,page) =
  130 + black_page = {
  131 + title=page.title
  132 + content_parser = parser state=handler.param_parser -> page.content(appl,appl.get_cred(appl.state),state)
  133 + }
  134 + ignore(Cell.call(appl.pages, {register path=handler.path page=black_page}))
  135 + create(appl,handler) = ignore(Cell.call(appl.pages, {create path=handler.path}))
  136 + check(appl) = ignore(Cell.call(appl.pages, {check}))
  137 + msg_handler(state,msg) = match msg with
  138 + | {get} -> {return=some(Map.filter_map(x -> x,state)) instruction={unchanged}}
  139 + | {register ~path ~page} -> {return=none instruction={set=
  140 + match Map.get(path, state) with
  141 + | {some={none}}
  142 + | {none} -> Map.add(path,{some=page},state)
  143 + | {some=_} ->
  144 + do Log.warning("Application.register", "Page already registered ({path})")
  145 + state
  146 + }}
  147 + | {create ~path} -> {return={none} instruction={set=Map.add(path,{none},state) }}
  148 + | {check} ->
  149 + check(k,v) = if Option.is_none(v) then Log.warning("Application.register", "Page handler not registered ({k})")
  150 + do Map.iter(check,state)
  151 + {return={none} instruction={unchanged}}
  152 + }}
  153 +
  154 + /** Defautl application option. **/
  155 + default_option : Application.option('state,'cred) = {
  156 + not_found = {title=->"not found" content=_,_,_ -> {xhtml=Xhtml.precompile(<>Not Found</>)} }
  157 + unauthorized = {title=->"unauthorized" content=_,_,_ -> {xhtml=Xhtml.precompile(<>unauthorized</>)} }
  158 + single_page = true
  159 + precompile_xhtml = false
  160 + css_uris = []
  161 + js_uris = []
  162 + headers = []
  163 + }
  164 +
  165 + /**
  166 + * Make an application.
  167 + * name : The name of your application
  168 + * title : function that generate a top bar title for each pages
  169 + * frame_maker : function that generate a common frame for your pages
  170 + * state : a state for application.
  171 + * get_cred : a function to extract credentials from state
  172 + **/
  173 + @server
  174 + make(name : string, title : Application.title, frame_maker : Application.frame_maker, state, get_cred) : Application.t =
  175 + make_with(name, title, frame_maker, default_option, state, get_cred)
  176 +
  177 + /**
  178 + * Make an application with custom options. See [make]
  179 + **/
  180 + @server
  181 + make_with(name : string, title : Application.title, frame_maker : Application.frame_maker,
  182 + option : Application.option, state ,get_cred) : Application.t =
  183 + id = Random.string(10)
  184 + frame_maker =
  185 + if option.single_page
  186 + then
  187 + fm(appl, x : xhtml,id : string) = <div onready={_ ->
  188 + get_page_async(s) = get_page_async(appl,s)
  189 + f(s) = get_page_async(s)
  190 + do ignore(Client.Anchor.add_handler(f))
  191 + anchor = Client.Anchor.get_anchor()
  192 + s = if (String.length(anchor)>=1 && String.get(0,anchor)=="#")
  193 + then String.drop_left(1,anchor)
  194 + else if (String.length(anchor)>=3 && (String.get_prefix(3,anchor)?"")=="%23")
  195 + then String.drop_left(3,anchor)
  196 + else anchor
  197 + f(s)}>{frame_maker(appl, x, id)}</div>
  198 + fm
  199 + else frame_maker
  200 + {~frame_maker ~title pages=Cell.make(Map.empty,State.msg_handler)
  201 + option={option with not_found.title=->title(option.not_found.title())} ~id ~state ~get_cred ~name}
  202 +
  203 + /**
  204 + * Register a page
  205 + **/
  206 + @server
  207 + register(appl : Application.t('state, 'cred), handler : Page.Handler.t('param), page : Page.Content.t('state, 'cred, 'param)) =
  208 + do State.register(appl,handler,page)
  209 + do Page.Handler.State.register(appl.name, handler)
  210 + void
  211 +
  212 + /**
  213 + * Register a page with credential checks
  214 + **/
  215 + @server
  216 + register_secure_with(appl : Application.t, handler : Page.Handler.t('param), page : Page.Content.t('state, 'cred, 'param), check : ('cred -> bool)) =
  217 + page = {
  218 + title=page.title
  219 + content(appl,cred,param)=
  220 + if check(cred)
  221 + then page.content(appl,cred,param)
  222 + else appl.option.unauthorized.content(appl,cred,"")
  223 + }
  224 + register(appl, handler, page)
  225 +
  226 + @server @private
  227 + get_parser(appl : Application.t) =
  228 + parser page={Rule.of_map(State.get(appl))} content=page.content_parser ->
  229 + ~{content page}
  230 +
  231 + @server @private
  232 + get_page(appl : Application.t, path) : {title : string content : 'a } =
  233 + cred = appl.get_cred(appl.state)
  234 + match Parser.try_parse(get_parser(appl), path) with
  235 + | {some={~page ~content}} ->
  236 + do Log.info("Application.get_page","Got page {page.title()}")
  237 + content=match content with
  238 + | {xhtml=content} ->
  239 + if appl.option.precompile_xhtml
  240 + then {xhtml=Xhtml.precompile(content)}
  241 + else {xhtml=content}
  242 + | x -> x
  243 + end
  244 + {title=appl.title(page.title()) ~content}
  245 + | {none} -> {title = appl.title(appl.option.not_found.title())
  246 + content=appl.option.not_found.content(appl,cred,path)}
  247 +
  248 + @private @server @publish @async
  249 + get_page_async(appl : Application.t, path) =
  250 + page = get_page(appl, path)
  251 + update_dom(appl.id,page)
  252 +
  253 + @server @private
  254 + make_header(appl)=
  255 + <>
  256 + {appl.option.headers}
  257 + {List.map(s -> <link rel="stylesheet" type="text/css" media="all" href="{s}" />, appl.option.css_uris)}
  258 + {List.map(s -> <script type="text/javascript" src="{s}" />, appl.option.js_uris)}
  259 + </>
  260 +
  261 + /** Generate the parser of an application **/
  262 + @server
  263 + make_parser(appl : Application.t) =
  264 + page(content : Page.Content.return,title : ->string) = (_ ->
  265 + match content with
  266 + | {xhtml=content} ->
  267 + Resource.full_page(appl.title(title()), appl.frame_maker(appl,content,appl.id), make_header(appl), {success}, [])
  268 + | {redirection=s} ->
  269 + Resource.redirection_page(title(), <></>, {address_moved}, 0, s)
  270 + end)
  271 + if appl.option.single_page
  272 + then parser "/" -> page({xhtml=<></>},->"")
  273 + else parser "/" x={get_parser(appl)} -> page(x.content,x.page.title)
  274 +
  275 + /** Generate the server of an application **/
  276 + @server
  277 + make_server(appl : Application.t) =
  278 + Server.make(make_parser(appl))
  279 +
  280 + @private
  281 + make_path_with(handler : Page.Handler.t('param), param : 'param) : string =
  282 + "{handler.path}{handler.param_serializer(param)}"
  283 +
  284 + @client @private
  285 + update_dom(id,page) =
  286 + do Client.setTitle(page.title)
  287 + match page.content with
  288 + | {xhtml=content} -> Dom.transform([#{id} <- content])
  289 + | {redirection=redirect} -> Client.goto(redirect)
  290 + end
  291 +
  292 + /** Client side function to refresh the current page **/
  293 + @client
  294 + refresh(appl : Application.t) =
  295 + anchor = Client.Anchor.get_anchor()
  296 + s =
  297 + if (String.length(anchor)>=1)
  298 + then String.drop_left(1,anchor)
  299 + else ""
  300 + if appl.option.single_page
  301 + then get_page_async(appl,s)
  302 + else Client.reload()
  303 +
  304 + @client
  305 + is_page(appl : Application.t ,handler : Page.Handler.t) =
  306 + s = if appl.option.single_page
  307 + then
  308 + anchor = Client.Anchor.get_anchor()
  309 + if (String.length(anchor)>=1)
  310 + then String.drop_left(1,anchor)
  311 + else ""
  312 + else Client.get_location().pathname
  313 + p=parser {Rule.of_string(handler.path)} handler.param_parser -> true
  314 + Parser.try_parse(p,s) ? false
  315 +
  316 + /** Client side function to go to a page with default arguments. **/
  317 + @client
  318 + goto(appl : Application.t, handler : Page.Handler.t) : void=
  319 + goto_with(appl, handler, handler.default_param)
  320 +
  321 + /** Client side function to go a page with custom arguments. **/
  322 + @client
  323 + goto_with(appl : Application.t, handler : Page.Handler.t('param), param : 'param) : void =
  324 + path = make_path_with(handler, param)
  325 + if appl.option.single_page
  326 + then Client.Anchor.set_anchor(path)
  327 + else Client.goto(path)
  328 +
  329 + /** Generate an uri of a page. To be use in href. **/
  330 + make_uri(appl : Application.t, handler : Page.Handler.t) : string =
  331 + make_uri_with(appl, handler, handler.default_param)
  332 +
  333 + /** Generate an uri of a page with custom arguments. **/
  334 + make_uri_with(appl : Application.t, handler : Page.Handler.t('param) , param : 'param) : string =
  335 + uri = make_path_with(handler, param)
  336 + if appl.option.single_page then "#{uri}" else uri
  337 +
  338 + /** Check that all Page.Handler.t have a Page.Content.t registered to it.
  339 + * It prints logs if error
  340 + **/
  341 + check_one(appl : Application.t) : void = Page.Handler.State.check([appl.name])
  342 + check_several(appls : list(Application.t)) : void = Page.Handler.State.check(List.map(a -> a.name, appls))
  343 +}}
  344 +
  345 +/**
  346 + * The page handler type.
  347 +**/
  348 +
  349 +type Page.Handler.t('param) = {
  350 + name_prefix : string
  351 + path : string
  352 + param_parser : Parser.general_parser('param)
  353 + param_serializer : 'param -> string
  354 + default_param : 'param
  355 +}
  356 +
  357 +@private
  358 +type Page.Private.page =
  359 + {content_parser : Parser.general_parser(Page.Content.return) title : ->string }
  360 +
  361 +/**
  362 + * The type of a page content
  363 + */
  364 +type Page.Content.return =
  365 + {xhtml : xhtml}
  366 +/ {redirection : string}
  367 +
  368 +/**
  369 + * The type of a page.
  370 + */
  371 +type Page.Content.t('state, 'credential,'param) = {
  372 + content : Application.t('state, 'credential), 'credential, 'param -> Page.Content.return
  373 + title : -> string
  374 +}
  375 +
  376 +@private
  377 +type Page.Handler.State.msg =
  378 + {register path:string appl:Application.name}
  379 +/ {create path:string}
  380 +/ {check appls:list(Application.name)}
  381 +
  382 +// type Page.Block('param) = {
  383 +// id : string
  384 +// default_param : 'param
  385 +// create : 'param -> xhtml
  386 +// update : 'param -> void
  387 +// }
  388 +
  389 +@private
  390 +type Page.Handler.State.result = void
  391 +
  392 +Page = {{
  393 + Handler = {{
  394 + @server @package
  395 + State = {{
  396 + @private
  397 + state = Cell.make(Map.empty,(state,msg ->
  398 + match msg : Page.Handler.State.msg with
  399 + | {create ~path} ->
  400 + if(Map.mem(path,state))
  401 + then
  402 + do Log.warning("Application.register", "Page already created ({path})")
  403 + {return=void instruction={unchanged}}
  404 + else {return=void instruction={set=Map.add(path,[],state) }}
  405 + | {register ~appl ~path} ->
  406 + match Map.get(path,state) with
  407 + | {none} ->
  408 + do Log.warning("Application.register", "Page handler not created ({path})")
  409 + {return=void instruction={unchanged}}
  410 + | {some=l} ->
  411 + if List.mem(appl, l)
  412 + then
  413 + //do Log.warning("Application.register", "Page already registered ({path})")
  414 + {return=void instruction={unchanged}}
  415 + else
  416 + {return=void instruction={set=Map.add(path,[appl|l],state)}}
  417 + end
  418 + | {check ~appls} ->
  419 + check(k,l) =
  420 + List.iter(a ->
  421 + ok = List.mem(a,l)
  422 + if not(ok)
  423 + then _ = k void // Log.warning("Application.register", "Page handler not registered ({a}{k})")
  424 + ,appls)
  425 + do Map.iter(check,state)
  426 + {return=void instruction={unchanged}}
  427 +
  428 + )) : Cell.cell(Page.Handler.State.msg,Page.Handler.State.result)
  429 +
  430 + create(h : Page.Handler.t('a)) : void =
  431 + Cell.call(state, {create path="{h.name_prefix}:{h.path}"})
  432 +
  433 + register(name, h : Page.Handler.t('a)) : void =
  434 + Cell.call(state, {register appl=name path="{h.name_prefix}:{h.path}"})
  435 +
  436 + check(appls) : void= Cell.call(state, {check ~appls})
  437 +
  438 + }}
  439 + /** Make a page handler **/
  440 + make(path : list(string)) : Page.Handler.t(void) =
  441 + void_parser = parser "" -> void
  442 + void_serializer(_) = ""
  443 + make_with( path, void_parser, void_serializer, void)
  444 +
  445 + /** Make a page handler that handle arguments **/
  446 + make_with(path : list(string), param_parser, param_serializer, default_param : 'param) : Page.Handler.t('param) =
  447 + path=String.concat("/",path)
  448 + handler = ~{name_prefix="" path default_param param_serializer param_parser}
  449 + do State.create(handler)
  450 + handler
  451 +
  452 + // combine(path, h1 : Page.Handler.t('param1), h2 : Page.Handler.t('param2)) : Page.Handler.t(('param1,'param2)) =
  453 + // p = parser p1=h1.param_parser p2=h2.param_parser -> (p1,p2)
  454 + // s((p1,p2)) = "{h1.param_serializer(p1)}{h2.param_serializer(p2)}"
  455 + // d = (h1.default_param,h2.default_param)
  456 + // make_with( path, p, s, d)
  457 +
  458 + // copy( path, h) =
  459 + // make_with( path, h.param_parser, h.param_serializer, h.default_param)
  460 + }}
  461 +
  462 + Content = {{
  463 + /** Make a page that take arguments and return xhtml **/
  464 + @server
  465 + make_with(title : -> string, content : (Application.t('state,'cred),'cred,'param -> xhtml)) : Page.Content.t('state,'cred,'param) =
  466 + ~{title content=(a,cred,p -> {xhtml=content(a,cred,p)}) }
  467 + /** Make a page that return xhtml **/
  468 + @server
  469 + make(title :-> string, content : (Application.t('state,'cred),'cred -> xhtml)) : Page.Content.t('state,'cred, void) =
  470 + make_with(title, (appl,cred,{} -> content(appl,cred)))
  471 + /** Make a page that return xhtml or redirect to another page **/
  472 + @server
  473 + make_or_redir(title :-> string, content : (Application.t('state,'cred),'cred -> Page.Content.return)) : Page.Content.t('state,'cred,void) =
  474 + make_or_redir_with(title, (appl,cred,{} -> content(appl,cred)))
  475 + /** Make a page that take arguments and return xhtml or redirect to another page */
  476 + @server
  477 + make_or_redir_with(title :-> string, content : (Application.t('state,'cred),'cred,'param -> Page.Content.return)) : Page.Content.t('state,'cred, 'param) =
  478 + ~{title content}
  479 + /** Return xhtml content **/
  480 + @server
  481 + return(xhtml : xhtml) : Page.Content.return = {~xhtml}
  482 + /** Redirect to a page **/
  483 + @server
  484 + redirect(redirection : string) : Page.Content.return = {~redirection}
  485 + }}
  486 +}}
  487 +

0 comments on commit 3c79d47

Please sign in to comment.
Something went wrong with that request. Please try again.