[Haskell-cafe] Compile-time here document facility

[Dave Bayer]

I couldn't find a compile-time here document facility, so I wrote one  
using Template Haskell:

> module HereDocs(hereDocs) where
>
> import Control.Exception
> import Language.Haskell.TH.Syntax
>
> getDoc :: String -> [String] -> (String,[String])
> getDoc eof txt =
>     let (doc,rest) = break (== eof) txt
>     in  (unlines doc, drop 1 rest)
>
> makeVal :: String -> String -> [Dec]
> makeVal var doc = let name = mkName var in
>     [SigD name (ConT (mkName "String")),
>     ValD (VarP name) (NormalB (LitE (StringL doc))) []]
>
> scanSrc :: [Dec] -> [String] -> Q [Dec]
> scanSrc vals [] = return vals
> scanSrc vals (x:xs) = case words x of
>     [var, "=", ('<':'<':eof)] ->
>         let (doc,rest) = getDoc eof xs
>             val = makeVal var doc
>         in  scanSrc (vals ++ val) rest
>     _ -> scanSrc vals xs
>
> hereDocs :: FilePath -> Q [Dec]
> hereDocs src =
>     let fin = catchJust assertions (evaluate src) (return.takeWhile  
> (/= ':'))
>     in  runIO (fin >>= readFile >>= return . lines) >>= scanSrc []

One binds here documents embedded in comments by writing

> import HereDocs
> $(hereDocs "Main.hs")

As an idiom, one can refer to the current file as follows; the first  
thing hereDocs does is catch assert errors in order to learn the file  
name:

> import HereDocs
> $(hereDocs $ assert False "")

Here is an example use:

> {-# OPTIONS_GHC -fth -Wall -Werror #-}
>
> module Main where
>
> import System
> import Control.Exception
>
> import HereDocs
> $(hereDocs $ assert False "")
>
> {-
> ruby = <<RUBY
> #!/usr/bin/env ruby
> hello = <<EOF
> Ruby is not
>    an acceptable Lisp
> EOF
> puts hello
> RUBY
>
> lisp = <<LISP
> #!/usr/bin/env mzscheme -qr
> (display #<<EOF
> Lisp is not
>    an acceptable Haskell
> EOF
> )
> (newline)
> LISP
> -}
>
> exec :: FilePath -> String -> IO ExitCode
> exec fout str = do
>    writeFile fout str
>    system ("chmod +x " ++ fout ++ "; ./" ++ fout)
>
> main :: IO ExitCode
> main = do
>    exec "hello.rb" ruby
>    exec "hello.scm" lisp