module haskell
imports libstrategolib signatures/- signature/TYPE util analysis
rules
  /* Approach:
     A) We will define a local transformation taking a term with value strings
        at each child to a value string for the node.
     B) We will append IO actions needed to set up for the value progressively
        to a Preactions rule (mapping () to the list of actions). There will
        be a utility `add-preaction` to append a new clause to value of this
        rule.
     C) We will use bottomup-para to traverse the full AST with the
        transformation from A so that we have access to the original expression
        (and can get the Statix-associated type when we need to).
        Hence the transformation in (A) must actually take a pair of
        an (original) term and a term with value strings at each child,
        and be certain to return a value string.

     Finally, at the toplevel we emit the result of <Preactions>() before
     returning the final value.
   */

  hs: (_, TopLevel(val)) -> $[-- Preamble from fostr
  import System.IO
  data IOStream = StdIO

  gets :: Show b => a -> b -> IO a
  gets s d = do
    putStr(show d)
    return s

  getsStr :: a -> String -> IO a
  getsStr s d = do
    putStr(d)
    return s

  main = do
    [<Preactions>()]return [val]]

  hs: (_, Stream())     -> "StdIO"
  hs: (_, Int(x))       -> x
  hs: (_, LitString(x)) -> <haskLitString>x
  hs: (_, EscString(x)) -> x
  hs: (_, Sum(x, y))    -> $[([x] + [y])]

  hs: (Gets(_, xn), Gets(s, x)) -> v
    with v := <newname>"_fostr_get"
       ; <add-preactions>[$[[v] <- [<hs_gets>(s, xn, x)]]]
  hs: (To(xn, _), To(x, s))     -> v
    with v := <newname>"_fostr_to"
       ; <add-preactions>[$[let [v] = [x]], <hs_gets>(s, xn, v)]

  hs_gets: (s, xn, x ) -> $[[s] [<hs_getOp>xn] [x]]
  hs_getOp = get-type; (?STRING() < !"`getsStr`" + !"`gets`")

  hs: (_, Terminate(x)) -> $[[x];;]
  hs: (_, Sequence(l))  -> <last>l
  /* One drawback of using paramorphism is we have to handle lists
     explicitly:
   */
  hs: (_, []) -> []
  hs: (_, [x | xs]) -> [x | xs]

  /* Another drawback of using paramorphism is at the very leaves we have
     to undouble the tuple:
   */
  hs: (x, x) -> x where <is-string>x

  /* Characters we need to escape in Haskell string constants */
  Hascape: ['\t' | cs ] -> ['\', 't'  | cs ]
  /* I think I can just use ASCII constants for characters... */
  Hascape: [ 0   | cs ] -> ['\', '0'  | cs ]
  Hascape: [ 7   | cs ] -> ['\', 'a'  | cs ] // Alert
  Hascape: [ 8   | cs ] -> ['\', 'b'  | cs ] // Backspace
  Hascape: [ 11  | cs ] -> ['\', 'v'  | cs ] // Vertical tab
  Hascape: [ 12  | cs ] -> ['\', 'f'  | cs ] // Form feed

strategies
  haskLitString = un-single-quote
                ; string-as-chars(escape-chars(Escape <+ Hascape))
                ; double-quote

  haskell = rules(Preactions: () -> ""); bottomup-para(try(hs))

  /* See "Approach" at top of file */
  add-preactions = newp := <conc-strings>(<Preactions>(), <lines>)
                 ; rules(Preactions: () -> newp)

  // Interface haskell code generation with editor services and file system
  to-haskell: (selected, _, _, path, project-path) -> (filename, result)
    with filename := <guarantee-extension(|"hs")> path
       ; result   := <haskell> selected