module Text.FrQuotes (frQuotes) where
import Data.Char (isLetter)
breakWith :: (a -> Bool) -> ([a] -> [a]) -> [a] -> [a]
breakWith _ k []
= k []
breakWith p k (x:xs)
| p x = x : breakWith p k xs
| otherwise = k (x:xs)
qq67 :: String
qq67 = ""
frTop, openFrQQ', closeFrQQ', openFrQQ, closeFrQQ,
openBr, closeBr :: String
frTop = "(frTop ("
openFrQQ' = "[" ++ qq67 ++ "frQQ|"
closeFrQQ' = "|]"
openFrQQ = frTop ++ openFrQQ'
closeFrQQ = closeFrQQ' ++ "))"
openBr = closeFrQQ' ++ " `mappend` frAntiq ("
closeBr = ") `mappend` " ++ openFrQQ'
frQuotes :: String -> String
frQuotes = h
where h "" = ""
h ('«':'{':xs) | noesc xs = frTop ++ "( frAntiq (" ++ bOq "" ((closeBr++) . f ((closeFrQQ++) . (')':) . h)) xs
h ('«':xs) = openFrQQ ++ f ((closeFrQQ++) . h) xs
h ('{':'-':xs) = "{-" ++ c (("-}"++) . h) xs
h ('"':xs) = '"' : s (('"':) . h) xs
h ('\'':xs) = '\'' : a h xs
h ('[':'$':xs) = '[' : hOq "" h xs
h ('[':xs) = '[' : hOq "" h xs
h ('-':'-':xs) = "--" ++ mc h xs
h (x:'-':'-':xs) | x == ':' || isAscSymb x = x : '-' : '-' : breakWith (=='-') h xs
h (x:xs) = x : h xs
noesc ('«':'}':_) = False
noesc ('»':'}':_) = False
noesc _ = True
isAscSymb = (`elem` "!#$%&*+./<=>?@\\^|~")
isSymb x = x == '-' || x == ':' || isAscSymb x
mc k "" = k ""
mc k ('-':xs) = '-' : mc k xs
mc k ('\n':xs) = '\n' : k xs
mc k (x:xs) | isAscSymb x = x : breakWith isSymb k xs
| otherwise = x : breakWith (/='\n') k xs
f _ "" = error "unterminated french quotes (expecting `»')"
f _ ('}':_) = error "unexpected closing brace `}'"
f k ('{':'«':'}':xs) = '«' : f k xs
f k ('{':'»':'}':xs) = '»' : f k xs
f k ('«':'}':'»':xs) = '}' : f k xs
f k ('«':'{':'»':xs) = '{' : f k xs
f k ('»':xs) = k xs
f k ('{':xs) = openBr ++ bOq "" ((closeBr++) . f k) xs
f k (x:xs) = x : f k xs
qName "" = "defaultQQ"
qName xs = reverse xs
bOq qn k "" = k (reverse qn)
bOq qn k ('|':xs) = "[" ++ qq67 ++ qName qn ++ '|' : bq k xs
bOq qn k (x:xs)
| isLetter x = bOq (x:qn) k xs
| otherwise = b k (reverse qn++x:xs)
bq _ "" = error "unterminated haskell quasi-quotation using curly braces in french quotes (expecting `|}')"
bq k ('|':'}':xs) = '|' : ']' : k xs
bq k (x:xs) = x : bq k xs
b _ "" = error "unterminated quotes hole using curly braces (expecting `}')"
b k ('«':xs) = openFrQQ ++ f ((closeFrQQ++) . b k) xs
b _ ('»':_) = error "unexpected closing french quote"
b k ('{':'-':xs) = "{-" ++ c (("-}"++) . b k) xs
b k ('{':xs) = '{' : b (('}':) . b k) xs
b _ ('|':'}':_) = error "unexpected `|}' (end of braced quasi-quotation) in a braced hole context"
b k ('}':xs) = k xs
b k ('[':'$':xs) = '[' : hOq "" (b k) xs
b k ('[':xs) = '[' : hOq "" (b k) xs
b k ('"':xs) = '"' : s (('"':) . b k) xs
b _ ('-':'-':xs) = mc (\_-> error "unexpected one line haskell comment (as in \"-- foo\") in curly braces") xs
b k (x:'-':'-':xs) | x == ':' || isAscSymb x = x : '-' : '-' : breakWith (=='-') 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
hOq qn k "" = k (reverse qn)
hOq qn k ('|':xs) = qq67 ++ qName qn ++ '|' : q k xs
hOq qn k (x:xs)
| isLetter x = hOq (x:qn) k xs
| otherwise = k (reverse qn++x:xs)