Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 5ec15fd38e
Fetching contributors…

Cannot retrieve contributors at this time

file 212 lines (167 sloc) 6.351 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212
(* 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 ->
      let command = String.concat " " (List.map Filename.quote (tool :: args)) in
      exit (Sys.command command)

let project, name =
  if Array.length Sys.argv <> 3 || Sys.argv.(1) <> "init" then forward () ;
  let path = Sys.argv.(2) in
  let cwd = Sys.getcwd () in
  let path =
    if path = ".." then Filename.dirname cwd else
      if path = "." then cwd else
if Filename.is_relative path then Filename.concat cwd path else path
  in
  let name = String.uncapitalize (Filename.basename path) in
  path, name

let path seq = List.fold_left Filename.concat project seq

let readdir p =
  let path = path p in
  try Array.to_list (Sys.readdir path)
  with exn -> error "Could not read directory %S : %s" path (Printexc.to_string exn)

module Install = struct

  let prefix = ref ""

  let in_dir p f =
    let old_path = Sys.getcwd () in
    let old_prefix = !prefix in
    Sys.chdir (path p) ;
    prefix := (!prefix) ^ " " ;
    Printf.printf "%s>> in %s :\n" old_prefix (path p) ;
    ( try f () with _ -> () ) ;
    Sys.chdir old_path ;
    prefix := old_prefix

  let run fmt =
    Printf.ksprintf (fun command ->
      print_string (!prefix) ;
      print_endline command ;
      let code = Sys.command command in
      if code <> 0 then error "%S returned error code %d" command code
    ) fmt

  let mkdir p =
    let _ =
      List.fold_left (fun current seg ->
let p = current @ [seg] in
try
if Sys.is_directory (path p) then p else
error "Expected `%s` to be a directory !" (path p)
with _ ->
run "mkdir %s" (Filename.quote (path p)) ;
p
      ) [] p
    in ()

  let clone p src =
    let exists = try Sys.is_directory (path (p @ [".git"])) with _ -> false in
    if exists then
      in_dir p (fun () -> run "git pull --quiet")
    else
      run "git clone --quiet %s %s" (Filename.quote src) (Filename.quote (path p))

  let symlink src dest =
    if not (Sys.file_exists (path src)) then
      run "ln -s %s %s" (Filename.quote (path dest)) (Filename.quote (path src))

  let copy src dest =
    if not (Sys.file_exists (path dest)) then (
      run "cp %s %s" (Filename.quote (path src)) (Filename.quote (path dest))
    )

  let mkexec p =
    run "chmod u+x %s" (Filename.quote (path p))

  let config () =
    let path = path [ "ocaml" ; "configProject.ml" ] in
    if not (Sys.file_exists path) then
      try let chan = open_out path in
try let name = Printf.sprintf "let name = %S\nlet lname = %S\n"
name (String.lowercase name) in
output_string chan name ;
close_out chan
with _ -> close_out chan
      with _ -> error "Could not write project config file %s" path

  let make fresh =
    in_dir [] (fun () ->
      if not fresh then run "make clean" ;
      run "make"
    )

  let touch p =
    run "touch %s" (Filename.quote (path p))

  let make_plugin plugin =
    let p = [ ".ohm" ; "Ohm-Plugins" ; plugin ; "tool" ] in
    let exists = try Sys.is_directory (path p) with _ -> false in
    if exists then
      run "make -C %s" (Filename.quote (path p))

end

(* Fresh install means there have been no directories or files
created so far. Just check whether the .install file has been created. *)

let fresh = not (Sys.file_exists (path [".install"]))

(* Create the entire directory structure for the Ohm project. These operations
are all idempotent and respect data that was already created. *)

let () = List.iter Install.mkdir [
  [ "" ] ;
  [ ".ohm" ] ;
  [ "ocaml" ; "plugins" ] ;
  [ "_build" ] ;
  [ "bot" ] ;
  [ "www" ; "public" ]
]

let () = if fresh then List.iter Install.mkdir [
  [ "assets" ; "common" ] ;
  [ "assets" ; "errorPage" ];
]

(* Load (or update) the two parts of the Ohm framework (core and plugins) from
the github repository. *)

let () = List.iter (fun (path,src) -> Install.clone path src) [
  [ ".ohm" ; "Ohm" ], "git://github.com/VictorNicollet/Ohm.git" ;
  [ ".ohm" ; "Ohm-Plugins" ], "git://github.com/VictorNicollet/Ohm-Plugins.git" ;
]

(* Build the framework *)

let () = Install.run "make --quiet -C %s" (Filename.quote (path [".ohm" ; "Ohm"]))

(* Build the plugins that need building. *)

let () = List.iter Install.make_plugin (readdir [".ohm" ; "Ohm-Plugins"])

(* Create the relevant symlinks *)

let () = List.iter (fun (src,dest) -> Install.symlink src dest) [
  [ "ocaml" ; "gen" ], [ "_build" ] ;
  [ "ocaml" ; "ohm" ], [ ".ohm" ; "Ohm" ] ;
]

(* Copy over files *)

let () = if fresh then List.iter
    (fun path -> Install.copy ([".ohm";"Ohm";"install"]@path) path) [
      [ "bot" ; "run" ] ;
      [ "Makefile" ] ;
      [ "ocaml" ; "myocamlbuild.ml" ] ;
      [ "ocaml" ; "_tags" ] ;
      [ "ocaml" ; "o.ml" ];
      [ "ocaml" ; "main.ml" ] ;
      [ "ocaml" ; "cErrorPage.mli" ] ;
      [ "ocaml" ; "cErrorPage.ml" ] ;
      [ "ocaml" ; "configProject.mli" ] ;
      [ "assets" ; "common" ; "def.adlib.ml" ] ;
      [ "assets" ; "common" ; "en.adlib.ml" ] ;
      [ "assets" ; "common" ; "style.css" ] ;
      [ "assets" ; "errorPage" ; "error404.htm" ] ;
      [ "assets" ; "errorPage" ; "style.css" ] ;
      [ "assets" ; "errorPage" ; "def.adlib.ml" ] ;
      [ "assets" ; "errorPage" ; "en.adlib.ml" ] ;
      [ "www" ; "500.htm" ]
    ]
    
(* Install the configuration file *)

let () = if fresh then Install.config ()

(* Make files executable when appropriate *)

let () = List.iter Install.mkexec [
  [ "bot" ; "run" ]
]

(* Touch the "installed" file to avoid fresh installs from now on. *)

let () = if fresh then Install.touch [".install"]

(* Finish install by compiling the software. *)
  
let () = Install.make fresh
Something went wrong with that request. Please try again.