module Language.LaTeX.Builder.QQ
(
frQQ,frQQFile,str,strFile,istr,tex,texFile,texm,texmFile,qm,qmFile,qp,qpFile,
keys,keysFile,
mkQQ, mkQQnoIndent, mkQQgen, mkQQFile, indent, noIndent,
stripIndentQQ,
frTop, frAntiq,
) where
import Data.List
import Data.Char
import Data.Functor
import Language.Haskell.TH (Q, Exp, Name, appE, varE, stringE, litP, stringL, valD,
varP, sigD, mkName, normalB, conE)
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax (Lift(..))
import Language.LaTeX.Types (Key(..))
import Language.LaTeX.Builder.Internal (rawTex, rawPreamble, rawMath)
import Language.LaTeX.Builder.Math (mstring)
import Language.LaTeX.Builder (hstring)
frTop :: a -> a
frTop = id
frAntiq :: a -> a
frAntiq = id
frQQ,frQQFile,str,strFile,istr,tex,texFile,qm,qmFile,qp,qpFile,
keys, keysFile :: QuasiQuoter
quasiQuoter :: String -> QuasiQuoter
quasiQuoter qqName =
QuasiQuoter (err "expressions") (err "patterns")
(err "types") (err "declarations")
where err kind _ = fail $ qqName ++ ": not available in " ++ kind
stripIndentQQ :: String -> Q String
stripIndentQQ = fmap unlines' . skipFirst (mapM dropBar . dropLastWhen null . map (dropWhile isSpace)) . lines
where unlines' = intercalate "\n"
skipFirst _ [] = return []
skipFirst f (x:xs) = (x :) <$> f xs
dropLastWhen _ [] = []
dropLastWhen p (x:xs) | null xs && p x = []
| otherwise = x:dropLastWhen p xs
dropBar ('|':xs) = return xs
dropBar [] = fail "stripIndentQQ: syntax error '|' expected after spaces (unexpected empty string)"
dropBar (c:_) = fail $ "stripIndentQQ: syntax error '|' expected after spaces (unexpected "++show c++")"
str = (quasiQuoter "str"){ quoteExp = stringE
, quotePat = litP . stringL }
strFile = quoteFile str
mkQQgen :: (String -> Q Exp) -> String -> Name -> QuasiQuoter
mkQQgen pre qqName qqFun = (quasiQuoter qqName){ quoteExp = appE (varE qqFun) . pre }
mkQQ :: String -> Name -> QuasiQuoter
mkQQ = mkQQgen indent
mkQQnoIndent :: String -> Name -> QuasiQuoter
mkQQnoIndent = mkQQgen lift
mkQQFile :: (String -> Q Exp) -> String -> Name -> (QuasiQuoter, QuasiQuoter)
mkQQFile pre qqName qqFun = (mkQQgen pre qqName qqFun , quoteFile (mkQQgen lift qqName qqFun))
indent, noIndent :: String -> Q Exp
indent = (lift =<<) . stripIndentQQ
noIndent = lift
istr = (quasiQuoter "istr"){ quoteExp = (stringE =<<) . stripIndentQQ }
texm, texmFile :: QuasiQuoter
(frQQ, frQQFile) = mkQQFile noIndent "frQQ" 'hstring
(tex, texFile) = mkQQFile indent "tex" 'rawTex
(texm, texmFile) = mkQQFile indent "texm" 'rawMath
(qm, qmFile) = mkQQFile indent "qm" 'mstring
(qp, qpFile) = mkQQFile indent "qp" 'rawPreamble
keys = (quasiQuoter "keys"){ quoteDec = fs } where
fs = sequence . concatMap f . words
clean = filter isAlphaNum
f x = [sigD n [t|Key|]
,valD (varP n)
(normalB (appE (conE 'MkKey) $ stringE x))
[]
]
where n = mkName (clean x)
keysFile = quoteFile keys