module HereDocs (hereDocs) where

import Control.Exception (Exception(PatternMatchFail),catchJust,evaluate)

import Language.Haskell.TH.Syntax
    (Q,Dec(..),Exp(..),Type(..),Body(..),Lit(..),Pat(..),runIO,mkName)

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:xt) = case words x of
    [var, "=", ('<':'<':eof)] ->
        let (doc,rest) = getDoc eof xt
            val = makeVal var doc
        in  scanSrc (vals ++ val) rest
    _ -> scanSrc vals xt

patterns :: Exception -> Maybe String
patterns (PatternMatchFail e) = Just e
patterns _ = Nothing

hereDocs :: FilePath -> Q [Dec]
hereDocs src =
    let fin = catchJust patterns (evaluate src) (return.takeWhile (/= ':'))
    in  runIO (fin >>= readFile >>= return . lines) >>= scanSrc []