module Text.TDoc.QQ (
frQQ, frTop, frAntiq) where
import qualified Language.Haskell.TH as TH
import Language.Haskell.TH.Quote
import Text.TDoc (spanDoc, Star, Span, SpanTag(..), ToChildren(..), ChildOf(..))
import Data.Char (isSpace)
frTop :: SpanTag t => Star t Span
frTop = spanDoc
frAntiq :: ToChildren a t father => a -> [ChildOf t father]
frAntiq = toChildren
expandingQQExpr :: String -> TH.ExpQ
expandingQQExpr = chunk . stripIndents
where
chunk x | null x = TH.varE 'mempty
| otherwise = TH.varE 'toChildren `TH.appE` TH.stringE x
stripIndents :: String -> String
stripIndents = go
where go (x:xs) | isSpace x = ' ' : go (dropWhile isSpace xs)
| otherwise = x:go xs
go "" = ""
quasiQuoter :: String -> QuasiQuoter
quasiQuoter qqName =
QuasiQuoter (err "expressions") (err "patterns")
(err "types") (err "declarations")
where err kind _ = error $ qqName ++ ": not available in " ++ kind
frQQ :: QuasiQuoter
frQQ = (quasiQuoter "Text.TDoc.QQ.frQQ"){quoteExp = expandingQQExpr }