Antiquote.hs

module RlangQQ.Antiquote (extractAntiquotes) where

import Language.Haskell.Meta
import Language.Haskell.TH
import Text.Trifecta
import Control.Applicative

extractAntiquotes :: Parser [Either Exp String]
extractAntiquotes = do
    a <- Right <$> many (noneOf "$")
    bc <- do
        string "$"
        b <- try (Left <$> antiquote) <|> pure (Right "$")
        c <- extractAntiquotes
        return (b:c)
      <|> ([] <$ eof)
    return (a:bc)

antiquote = do
    string "("
    firstExp ""

-- | repeatedly try 'parseExp' on input ending (not including) @)@, until the first success.
firstExp prev = do
    c <- many (noneOf ")")
    string ")"
    let cs = prev ++ c -- appending is the least of efficiency concerns here
                       -- chances are that you only have a couple ')' characters
                       -- inside the $(  ) at most.
    case parseExp cs of
        Right x -> return x
        _ -> firstExp (cs ++ ")")