Improve installer, extend tool

install/Makefile

@@ -0,0 +1,16 @@
+$(OHM)=ohm # The name of the 'ohm' tool to be invoked
+
+all: 
+	$(OHM) assets # Build all the assets, place them in '/_build' 
+	$(OHM) build  # Build the ocaml code found in '/ocaml', generates '/ocaml/main.byte'
+
+        #Copy the server binary over to the correct path
+	cp ocaml/main.byte www/server 
+	mv www/server www/server.real 
+
+        # Perform the deployment
+	www/server.real --put
+	www/server.real --reset
+
+clean: 
+	$(OHM) clean 

install/ocaml/_tags

@@ -0,0 +1,4 @@
+<*> or <**/*>: package(camlp4), syntax(camlp4o), custom-pp, package(curl), package(netcgi2), package(netclient), package(batteries), package(sha), package(netstring), package(xmlm)
+<*>: include
+<gen>: include
+<plugins/*>: include

install/ocaml/main.ml

@@ -0,0 +1,9 @@
+(* © 2012 RunOrg *) 
+
+open Ohm
+open BatPervasives
+
+module Main = Main.Make(O.Reset)
+let _ = Main.run (Some O.run_async)
+
+

install/ocaml/myocamlbuild.ml

@@ -0,0 +1,11 @@
+open Ocamlbuild_plugin
+
+let path_to_pp = "../ohm/pp.cmo"
+
+let _ = dispatch begin function
+  | After_rules ->
+    flag ["ocamldep"; "custom-pp"] (S[A"-ppopt";A path_to_pp]);
+    flag ["compile"; "custom-pp"] (S[A"-ppopt";A path_to_pp]);
+  | _ -> ()
+end
+

install/ocaml/o.ml

@@ -0,0 +1,76 @@
+(* Ohm is © 2012 Victor Nicollet *)
+
+open Ohm
+open Ohm.Universal
+open BatPervasives
+
+(* Environment and basic configuration ---------------------------------------------------------------------- *)
+
+let environment = `Dev 
+
+let env = match environment with 
+  | `Prod    -> "prod"
+  | `Dev     -> "dev"
+
+let () = 
+  Configure.set `Log begin match Ohm.Util.role with 
+    | `Put
+    | `Reset -> "-"
+    | `Bot
+    | `Web   -> "/var/log/ohm/" ^ env ^ ".log"
+  end
+
+(* Basic databases ------------------------------------------------------------------------------------------ *)
+
+let db name = Printf.sprintf "%s-%s" env name
+
+module ConfigDB = CouchDB.Convenience.Database(struct let db = db "config" end)
+module Reset    = Reset.Make(ConfigDB)
+
+(* Context management --------------------------------------------------------------------------------------- *)
+
+type i18n = Asset_AdLib.key
+
+class ctx adlib = object
+  inherit CouchDB.init_ctx
+  inherit Async.ctx
+  inherit [i18n] AdLib.ctx adlib
+end
+
+let ctx = function
+  | `FR -> new ctx Asset_AdLib.fr
+
+let put action = 
+  if Ohm.Util.role = `Put then 
+    ignore (Ohm.Run.eval (ctx `FR) action) 
+
+type 'a run = (ctx,'a) Run.t
+
+module AsyncDB = CouchDB.Convenience.Config(struct let db = db "async" end)
+module Async = Ohm.Async.Make(AsyncDB)
+
+let async : ctx Async.manager = new Async.manager
+
+let run_async () = 
+  async # run (fun () -> ctx `FR) 
+
+(* Action management ---------------------------------------------------------------------------------------- *)
+
+let domain = match environment with 
+  | `Prod -> "project.com"
+  | `Dev  -> "project.local"
+
+let cookies = "." ^ domain
+
+let core   = Action.Convenience.single_domain_server ~cookies domain
+
+let action f req res = 
+  Run.with_context (ctx `FR) (f req res)
+
+let register s u a body = 
+  Action.register s u a (action body)
+
+let declare s u a = 
+  let endpoint, define = Action.declare s u a in
+  endpoint, action |- define
+

run.ml

@@ -1,8 +1,28 @@
+(* Ohm is © 2012 Victor Nicollet *)
+
 let error fmt = Printf.ksprintf (fun s -> print_string "[FAIL] " ; print_endline s ; exit 1) fmt 
 
+let forward () = 
+
+  let rec find path = 
+    if (try Sys.is_directory (Filename.concat path ".ohm") with _ -> false) 
+    then path 
+    else if path = "/" then error "No project found ! Possible solution :
+ohm init <project-directory>
+cd <project-directory>
+ohm ..."  
+    else find (Filename.dirname path) 
+  in
+
+  let root = find (Sys.getcwd ()) in
+  Sys.chdir root ;
+  let tool = List.fold_left Filename.concat root [".ohm";"Ohm";"tool";"tool.byte"] in
+
+  match Array.to_list Sys.argv with [] -> error "Array.length Sys.argv = 0 ... what the hell ?" | _ :: args -> 
+    exit (Sys.command (String.concat " " (List.map Filename.quote (tool :: args))))
+
 let project, name = 
-  if Array.length Sys.argv <> 3 || Sys.argv.(1) <> "init" then
-    error "Usage : ohm init <project-directory>" ;
+  if Array.length Sys.argv <> 3 || Sys.argv.(1) <> "init" then forward () ;
   let path = Sys.argv.(2) in
   let name = String.uncapitalize (Filename.basename path) in 
   if Filename.is_relative path then 
@@ -104,8 +124,11 @@ let () = List.iter (fun (src,dest) -> Install.symlink src dest) [
 
 let () = List.iter (fun path -> Install.copy ([".ohm";"Ohm";"install"]@path) path) [
   [ "bot" ; "run" ] ;
-  [ "www" ; "public" ; "script.js" ] ;
-  [ "www" ; "public" ; "style.css" ] 
+  [ "Makefile" ] ;
+  [ "ocaml" ; "myocamlbuild.ml" ] ;
+  [ "ocaml" ; "_tags" ] ;
+  [ "ocaml" ; "o.ml" ];
+  [ "ocaml" ; "main.ml" ]
 ]
 
 (* Make files executable when appropriate *)

tool/tool.ml

@@ -17,11 +17,6 @@ let error reason explanation =
     (Sys.getcwd ())  ;
   exit (-1)
 
-let error_no_project_root () = 
-  error 
-    "Could not find project root."
-    "The project root is the directory that contains subdirectories 'www' and 'ocaml' (among others). ohm-tool should be executed at the project root, but it can sometimes find the project root on its own if executed in one of the project subdirectories." 
-
 let path_error title format path exn = 
   error title (Printf.sprintf format path (Printexc.to_string exn))  
 
@@ -31,14 +26,14 @@ let path2_error title format path1 path2 exn =
 let error_mkdir_failure = 
   path_error 
     "Could not create directory."
-    "ohm-tool needs to create directory %S, but Unix.mkdir raised an exception: '%s'"
+    "ohm needs to create directory %S, but Unix.mkdir raised an exception: '%s'"
 
 let mkdir path access = try Unix.mkdir path access with exn -> error_mkdir_failure path exn
 
 let error_is_dir = 
   path_error 
     "Could not explore directory."
-    "ohm-tool needs to make sure directory %S exists, but Sys.is_directory raised an exception: '%s'"
+    "ohm needs to make sure directory %S exists, but Sys.is_directory raised an exception: '%s'"
 
 let is_dir path = 
   try Sys.is_directory path with 
@@ -48,15 +43,15 @@ let is_dir path =
 let error_readdir = 
   path_error 
     "Could not read directory."
-    "ohm-tool needs to read the contents of directory %S, but Sys.readdir raised an exception: '%s'"
+    "ohm needs to read the contents of directory %S, but Sys.readdir raised an exception: '%s'"
 
 let readdir path = 
   try Array.to_list (Sys.readdir path) with exn -> error_readdir path exn 
 
 let error_readfile = 
   path_error
     "Could not read file."
-     "ohm-tool needs to read the contents of file %S, but open_in_bin raised an exception: '%s'"
+     "ohm needs to read the contents of file %S, but open_in_bin raised an exception: '%s'"
 
 let readfile path = 
   try let channel = Pervasives.open_in_bin path in 
@@ -78,7 +73,7 @@ let readfile_lexbuf path f =
 let error_writefile = 
   path_error
     "Could not write file."
-     "ohm-tool needs to write the contents of file %S, but open_out_bin raised an exception: '%s'"
+     "ohm needs to write the contents of file %S, but open_out_bin raised an exception: '%s'"
 
 let putfile path contents = 
 
@@ -87,11 +82,14 @@ let putfile path contents =
     with _ -> true
   in
 
-  if should then 
+  if should then begin
     try let channel = Pervasives.open_out_bin path in 
 	Pervasives.output_string channel contents ;
 	Pervasives.close_out channel 
-    with exn -> error_writefile path exn 
+    with exn -> error_writefile path exn ;
+  end ;
+
+  should
 
 let error_parse path = function
   | Asset.ParseError pos ->
@@ -104,7 +102,7 @@ let error_parse path = function
   | exn ->  
     path_error
       "Could not parse file."
-      "ohm-tool tried to parse file %S but encountered an error: '%s'"
+      "ohm tried to parse file %S but encountered an error: '%s'"
       path exn 
 
 let system command e = 
@@ -131,28 +129,22 @@ let symlink source dest =
   with exn ->
     path2_error 
       "Could not create symlink."
-      "ohm-tool tried to create link %S to path %S but Unix.symlink encountered an error: '%s'" 
+      "ohm tried to create link %S to path %S but Unix.symlink encountered an error: '%s'" 
       source dest exn
 
 (* Find out the root of the current project, and define relevant subdirectories ------------ *)
 
 module Path = struct
 
-  let root = 
-    let rec find path = 
-      if   is_dir (Filename.concat path "www") 
-	&& is_dir (Filename.concat path "ocaml") 
-      then path 
-      else if path = "/" then error_no_project_root () 
-      else find (Filename.dirname path) 
-    in
-    find (Sys.getcwd ())
+  let root = Sys.getcwd () 
 
   let () = Unix.chdir root
 
   let ocaml   = Filename.concat root  "ocaml"
   let plugins = Filename.concat ocaml "plugins"
+  let ohm     = Filename.concat ocaml "ohm"
   let www     = Filename.concat root  "www"
+  let gen     = Filename.concat ocaml "gen"
   let assets  = Filename.concat root  "assets" 
   let build   = Filename.concat root  "_build"
   let public  = Filename.concat www   "public"
@@ -180,18 +172,22 @@ let action = ref `LocateAssets
 
 let () = Arg.parse [
 
-  "-locate-assets", Arg.Unit (fun () -> action := `LocateAssets), 
+  "locate-assets", Arg.Unit (fun () -> action := `LocateAssets), 
     "Locate and list web application assets." ;
 
-  "-assets", Arg.Unit (fun () -> action := `CompileAssets), 
-    "Compile all web application assets."
+  "assets", Arg.Unit (fun () -> action := `CompileAssets), 
+    "Compile all web application assets." ;
 
-] ignore "ohm-tool: perform an operation on your ohm-powered web app."
+  "init", Arg.Unit ignore, 
+    "Initialize a new project directory" ;
 
-(* Ensure that the build subdirectory exists and, if it does not, create it ---------------- *)
+  "build", Arg.Unit (fun () -> action := `Build),
+    "Compile the application code" ;
+
+  "full-build", Arg.Unit (fun () -> action := `FullBuild),
+    "Equivalent to 'assets' followed by 'build'" ;
 
-let () = 
-  if not (is_dir Path.build) then mkdir Path.build 0o751
+] ignore "ohm: perform an operation on your ohm-powered web app."
 
 
 (* Listing assets (a common subroutine) ---------------------------------------------------- *)
@@ -338,7 +334,7 @@ let parsed_assets = lazy begin
   (* Generating the "assets" file *)
 
   let assets_file = 
-    "(* This file was generated by ohm-tool *)\n"
+    "(* This file was generated by ohm *)\n"
     ^ (Printf.sprintf "let css = %S\n" (Path.css_url ^ "?" ^ String.sub css_md5 0 8))
     ^ (Printf.sprintf "let js  = %S\n" (Path.js_url  ^ "?" ^ String.sub coffee_md5 0 8))
   in
@@ -348,8 +344,8 @@ let parsed_assets = lazy begin
   (* Generating all files *)
 
   List.iter (fun (path,contents) -> 
-    print_endline ("Generating " ^ path ^ " ...") ;
-    putfile path contents
+    if putfile path contents then
+      print_endline ("Generating " ^ path ^ " ...") ;
   ) generated ;
 
   if not (is_dir Path.public) then mkdir Path.public 0o751 ;
@@ -374,6 +370,22 @@ let locateAssets () =
 let compileAssets () = 
   ignore (Lazy.force parsed_assets)
 
+let build () = 
+  Sys.chdir Path.ocaml ;
+  system (String.concat " " [
+    "ocamlbuild" ;
+    "-Xs ohm" ;
+    "-use-ocamlfind" ;
+    "-lib ohm " ;
+    "-cflags -I," ^ Filename.quote Path.ohm ^ "," ^ Filename.quote Path.gen ;
+    "-lflags -I," ^ Filename.quote Path.ohm ^ "," ^ Filename.quote Path.gen ;
+    "main.byte"
+  ]) "Could not compile OCaml application" ;
+  Sys.chdir Path.root 
+
 match !action with 
   | `LocateAssets -> locateAssets () 
   | `CompileAssets -> compileAssets () 
+  | `Build -> build () 
+  | `FullBuild -> compileAssets () ; build ()
+