1(*  Title:      Pure/Tools/ghc.ML
2    Author:     Makarius
3
4Support for GHC: Glasgow Haskell Compiler.
5*)
6
7signature GHC =
8sig
9  val print_codepoint: UTF8.codepoint -> string
10  val print_symbol: Symbol.symbol -> string
11  val print_string: string -> string
12  val project_template: {depends: string list, modules: string list} -> string
13  val new_project: Path.T -> {name: string, depends: string list, modules: string list} -> unit
14end;
15
16structure GHC: GHC =
17struct
18
19(** string literals **)
20
21fun print_codepoint c =
22  (case c of
23    34 => "\\\""
24  | 39 => "\\'"
25  | 92 => "\\\\"
26  | 7 => "\\a"
27  | 8 => "\\b"
28  | 9 => "\\t"
29  | 10 => "\\n"
30  | 11 => "\\v"
31  | 12 => "\\f"
32  | 13 => "\\r"
33  | c =>
34      if c >= 32 andalso c < 127 then chr c
35      else "\\" ^ string_of_int c ^ "\\&");
36
37fun print_symbol sym =
38  (case Symbol.decode sym of
39    Symbol.Char s => print_codepoint (ord s)
40  | Symbol.UTF8 s => UTF8.decode_permissive s |> map print_codepoint |> implode
41  | Symbol.Sym s => "\\092<" ^ s ^ ">"
42  | Symbol.Control s => "\\092<^" ^ s ^ ">"
43  | _ => translate_string (print_codepoint o ord) sym);
44
45val print_string = quote o implode o map print_symbol o Symbol.explode;
46
47
48
49(** project setup **)
50
51fun project_template {depends, modules} =
52  \<^verbatim>\<open>{-# START_FILE {{name}}.cabal #-}
53name:                {{name}}
54version:             0.1.0.0
55homepage:            default
56license:             BSD3
57author:              default
58maintainer:          default
59category:            default
60build-type:          Simple
61cabal-version:       >=1.10
62
63executable {{name}}
64  hs-source-dirs:      src
65  main-is:             Main.hs
66  default-language:    Haskell2010
67  build-depends:       \<close> ^ commas ("base >= 4.7 && < 5" :: depends) ^
68  \<^verbatim>\<open>
69  other-modules:       \<close> ^ commas modules ^
70  \<^verbatim>\<open>
71{-# START_FILE Setup.hs #-}
72import Distribution.Simple
73main = defaultMain
74
75{-# START_FILE src/Main.hs #-}
76module Main where
77
78main :: IO ()
79main = return ()
80\<close>;
81
82fun new_project dir {name, depends, modules} =
83  let
84    val template_path = Path.append dir (Path.basic name |> Path.ext "hsfiles");
85    val _ = File.write template_path (project_template {depends = depends, modules = modules});
86    val {rc, err, ...} =
87      Bash.process ("cd " ^ File.bash_path dir ^ "; isabelle ghc_stack new " ^ Bash.string name ^
88        " --bare " ^ Bash.string (File.platform_path template_path));
89  in if rc = 0 then () else error err end;
90
91end;
92