module Text.FrQuotes (frQuotes) where
frTop, openFrQQ', closeFrQQ', openFrQQ, closeFrQQ,
openFrQ, closeFrQ, openBr, closeBr :: String
frTop = "(frTop ("
openFrQQ' = "[$frQQ|"
closeFrQQ' = "|]"
openFrQQ = frTop ++ openFrQQ'
closeFrQQ = closeFrQQ' ++ "))"
openFrQ = "\xc2\xab"
closeFrQ = "\xc2\xbb"
openBr = closeFrQQ' ++ " `mappend` frAntiq ("
closeBr = ") `mappend` " ++ openFrQQ'
frQuotes :: String -> String
frQuotes = h
where h "" = ""
h ('\xc2':'\xab':'{':xs) = frTop ++ "( frAntiq (" ++ b ((closeBr++) . f ((closeFrQQ++) . (')':) . h)) xs
h ('\xc2':'\xab':xs) = openFrQQ ++ f ((closeFrQQ++) . h) xs
h ('{':'-':xs) = "{-" ++ c (("-}"++) . h) xs
h ('"':xs) = '"' : s (('"':) . h) xs
h ('\'':xs) = '\'' : a h xs
h ('[':'$':xs) = '[' : '$' : startq h xs
h (x:xs) = x : h xs
f _ "" = error "unterminated french quotes (expecting `\xc2\xbb')"
f _ ('}':_) = error "unexpected closing brace `}'"
f k ('{':xs) = openBr ++ b ((closeBr++) . f k) xs
f k ('\xc2':'\xab':xs) = openFrQ ++ f ((closeFrQ++) . f k) xs
f k ('\xc2':'\xbb':xs) = k xs
f k (x:xs) = x : f k xs
b _ "" = error "unterminated quotes hole using curly braces (expecting `}')"
b k ('\xc2':'\xab':xs) = openFrQQ ++ f ((closeFrQQ++) . b k) xs
b _ ('\xc2':'\xbb':_) = error "unexpected closing french quote"
b k ('{':'-':xs) = "{-" ++ c (("-}"++) . b k) xs
b k ('{':xs) = '{' : b (('}':) . b k) xs
b k ('}':xs) = k xs
b k ('"':xs) = '"' : s (('"':) . b k) xs
b k (x:xs) = x : b k xs
c _ "" = error "unterminated haskell comment (expecting `-}')"
c k ('{':'-':xs) = "{-" ++ c (("-}"++) . c k) xs
c k ('-':'}':xs) = k xs
c k (x:xs) = x : c k xs
s _ "" = error "unterminated haskell string (expecting `\"')"
s k ('\\':x:xs) = '\\' : x : s k xs
s k ('"':xs) = k xs
s k (x:xs) = x : s k xs
a _ "" = error "unterminated haskell character (expecting `'')"
a k ('\\':x:xs) = '\\' : x : a k xs
a k (x:'\'':xs)
| x /= '\'' = x : '\'' : k xs
a k xs = k xs
q _ "" = error "unterminated haskell quasi-quotation (expecting `|]')"
q k ('|':']':xs) = '|' : ']' : k xs
q k (x:xs) = x : q k xs
startq k xs = ys ++ '|' : q k zs'
where (ys,zs) = break (=='|') xs
zs' | null zs = error "unrecognized haskell quasi-quotation (expecting `|`)"
| otherwise = drop 1 zs