Merge branch 'html-report'

bistro.opam

@@ -9,6 +9,7 @@ bug-reports: "https://github.com/pveber/bistro/issues"
 license: "GPL"
 build: ["jbuilder" "build" "-p" name "-j" jobs]
 depends: [
+  "base64"
   "bos"
   "jbuilder" {build & >= "1.0+beta8"}
   "core" {>= "0.11.0"}

examples/zhou2011.ml

@@ -73,7 +73,23 @@ let chipqc =
   in
   ChIPQC.run samples
 
+let report =
+  let open Bistro_utils.Html_report in
+  make
+    ~title:"Integrated approaches reveal determinants of genome-wide binding and function of the transcription factor Pho4."
+    [
+      text {|
+        This is an attempt at reproducing a paper by Zhou and O'Shea on why
+        transcription factors with similar binding sequences are not bound
+        to the same genomic sites.
+      |} ;
+      section "Inferred motifs" ;
+      png (Meme_suite.meme_logo (meme `ChIP_Pho4_noPi) 1) ;
+    ]
+  |> render
+
 let repo = Repo.[
+    item [ "report.html" ] report ;
     item [ "macs2" ; "Pho4" ; "noPi" ] (tf_peaks `ChIP_Pho4_noPi) ;
     item [ "meme" ; "Pho4" ; "noPi" ] (meme `ChIP_Pho4_noPi) ;
     item [ "meme_chip" ; "Pho4" ; "noPi" ] (meme_chip `ChIP_Pho4_noPi) ;

lib/bioinfo/bistro_bioinfo.ml

@@ -1698,11 +1698,6 @@ module Meme_suite = struct
 
   let img = [ docker_image ~account:"pveber" ~name:"meme" ~tag:"4.11.2" () ]
 
-  class type meme_output = object
-    inherit text_file
-    method format : [`meme_output]
-  end
-
   let meme_chip ?meme_nmotifs ?meme_minw ?meme_maxw (* ?np:threads *) fa =
     Workflow.shell ~descr:"meme-chip" (* ?np:threads *) [
       cmd "meme-chip" ~img [
@@ -1738,6 +1733,9 @@ module Meme_suite = struct
       ]
     ]
 
+  let meme_logo dir ?(rc = false) n =
+    Workflow.select dir [ sprintf "logo%s%d.png" (if rc then "" else "_rc") n ]
+
   let fimo
       ?alpha ?bgfile ?max_stored_scores ?max_strand ?motif ?motif_pseudo
       ?no_qvalue ?norc ?parse_genomic_coord ?prior_dist ?psp

lib/bioinfo/bistro_bioinfo.mli

@@ -1257,11 +1257,6 @@ module Idr : sig
 end
 
 module Meme_suite : sig
-  class type meme_output = object
-    inherit text_file
-    method format : [`meme_output]
-  end
-
   val meme :
     ?nmotifs:int ->
     ?minw:int ->
@@ -1271,15 +1266,21 @@ module Meme_suite : sig
     ?alphabet:[`dna | `rna | `protein] ->
     (* ?threads:int -> *)
     fasta pworkflow ->
-    directory pworkflow
+    [`meme] dworkflow
+
+  val meme_logo :
+    [`meme] dworkflow ->
+    ?rc:bool ->
+    int ->
+    png pworkflow
 
   val meme_chip :
     ?meme_nmotifs:int ->
     ?meme_minw:int ->
     ?meme_maxw:int ->
     (* ?np:int -> *)
     fasta pworkflow ->
-    [`meme_chip_output] dworkflow
+    [`meme_chip] dworkflow
 
   (** http://meme-suite.org/doc/fimo.html?man_type=web *)
   val fimo :
@@ -1296,7 +1297,7 @@ module Meme_suite : sig
     ?psp:text_file pworkflow ->
     ?qv_thresh:bool ->
     ?thresh: float ->
-    meme_output pworkflow ->
+    [`meme] dworkflow ->
     fasta pworkflow ->
     directory pworkflow
 end

lib/utils/dune

@@ -1,5 +1,5 @@
 (library
   (name bistro_utils)
   (public_name bistro.utils)
-  (libraries bistro.engine ocamlgraph tyxml)
+  (libraries base64 bistro.engine ocamlgraph tyxml)
   (preprocess (pps ppx_bistro)))

lib/utils/html_report.ml

@@ -0,0 +1,75 @@
+open Core
+open Bistro
+
+module H = Tyxml.Html
+
+type cell =
+  | Text of string
+  | Section of string
+  | Subsection of string
+  | Pdf of pdf pworkflow
+  | Svg of svg pworkflow
+  | Png of png pworkflow
+
+type t = {
+  title : string ;
+  cells : cell list ;
+}
+
+let make ~title cells = { title ; cells }
+
+let text s = Text s
+
+let pdf x = Pdf x
+let svg x = Svg x
+let png x = Png x
+let section x = Section x
+let subsection x = Subsection x
+
+let svg_of_pdf (pdf : pdf pworkflow) : svg pworkflow =
+  Workflow.shell ~descr:"notebook.convert" Shell_dsl.[
+    cmd "convert" [
+      string "-append" ;
+      seq ~sep:":" [string "pdf" ; dep pdf] ;
+      seq ~sep:":" [string "svg" ; dest] ;
+    ]
+  ]
+
+let picture  ?(alt = "") format path =
+  let format = match format with
+    | `svg -> "svg+xml"
+    | `png -> "png"
+  in
+  let contents =
+    In_channel.read_all path
+    |> Base64.encode_exn
+  in
+  H.img
+    ~src:(Printf.sprintf "data:image/%s;base64,%s" format contents)
+    ~alt ()
+
+let render_cell = function
+  | Text str -> [%workflow H.p [ H.txt [%param str] ]]
+  | Pdf w -> [%workflow picture `svg [%path svg_of_pdf w] ]
+  | Svg w -> [%workflow picture `svg [%path w] ]
+  | Png w -> [%workflow picture `png [%path w] ]
+  | Section s -> [%workflow H.h2 [ H.txt [%param s] ]]
+  | Subsection s -> [%workflow H.h3 [ H.txt [%param s] ]]
+
+let%pworkflow render nb =
+  let cells = [%eval Workflow.list @@ List.map nb.cells ~f:render_cell] in
+  let head_contents = [
+    H.link ~rel:[`Stylesheet] ~href:"https://unpkg.com/marx-css/css/marx.min.css" () ;
+    H.meta ~a:[H.a_name "viewport" ; H.a_content "width=device-width, initial-scale=1"] () ;
+  ]
+  in
+  let body_contents = [
+    H.main (
+      H.h1 [ H.txt nb.title ] :: H.hr () :: cells
+    ) ;
+  ]
+  in
+  let doc = H.html (H.head (H.title (H.txt nb.title)) head_contents) (H.body body_contents) in
+  Out_channel.with_file [%dest] ~f:(fun oc ->
+      Tyxml_html.pp () (Format.formatter_of_out_channel oc) doc
+    )

lib/utils/html_report.mli

@@ -0,0 +1,18 @@
+open Bistro
+
+type t
+type cell
+
+val section : string -> cell
+val subsection : string -> cell
+val text : string -> cell
+val pdf : pdf pworkflow -> cell
+val svg : svg pworkflow -> cell
+val png : png pworkflow -> cell
+
+val make :
+  title:string ->
+  cell list ->
+  t
+
+val render : t -> html pworkflow