-- The syntax is in the README.md file.
module Text.FrQuotes (frQuotes) where
import Data.Char (isLetter)
{-
import Test.QuickCheck

breakWithSpec :: (a -> Bool) -> ([a] -> [a]) -> [a] -> [a]
breakWithSpec p k xs = takeWhile p xs ++ k (dropWhile p xs)

breakWith_prop x y xs = breakWithSpec p k xs == breakWith p k xs
  where p = (==x)
        k = map (+y)
-}

--breakWith :: (a -> Bool) -> (a -> [a] -> [a]) -> [a] -> [a]

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
-- GHC7
qq67 = ""
-- GHC6
-- qq67 = "$"

frTop, openFrQQ', closeFrQQ', openFrQQ, closeFrQQ,
  openBr, closeBr :: String
frTop = "(frTop ("
openFrQQ'  = "[" ++ qq67 ++ "frQQ|"
closeFrQQ' = "|]"
openFrQQ  = frTop ++ openFrQQ'
closeFrQQ = closeFrQQ' ++ "))"
-- one could generate a list and mconcat it instead of these mappend
openBr    = closeFrQQ' ++ " `mappend` frAntiq ("
closeBr   = ") `mappend` " ++ openFrQQ'

-- Substitutes UTF8 french quotes «...» for (frTop [frQQ|...|])
-- Antiquotations are supported via braces {...} and are
-- substituted for frAntiq, blocks are catenated with mappend.
frQuotes :: String -> String
frQuotes = h
        -- All these functions follow the same style,
        -- the first argument 'k' is the continuation, i.e. what to do next.
        -- Each function search for a different closing token, if the closing
        -- token is found the continuation is called with the remaining char
        -- stream, if some opening token is found the continuation is stacked
        -- as the continuation of a new function call that have to find this
        -- new token first.

        -- haskell context
        -- the h function don't needs a continuation parameter
  where h ""                   = ""
        h ('«':'{':xs) | noesc xs = frTop ++ "( frAntiq (" ++ bOq "" ((closeBr++) . f ((closeFrQQ++) . (')':) . h)) xs -- avoids an empty [frQQ||]
        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

        -- maybe a one line comment
        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

        -- french quotes context
        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

        -- brace hole OR quasi-quotation
        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)

        -- brace quasi-quotation {qq|...|}
        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

        -- braces (haskell) context
        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

        -- haskell (nested) comments
        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

        -- haskell strings literal
        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

        -- haskell char literal (a bit lenient)
        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

        -- haskell quasi-quotation
        -- is there nested QQ?
        q _ ""                 = error "unterminated haskell quasi-quotation (expecting `|]')"
        q k ('|':']':xs)       = '|' : ']' : k xs
        q k (x:xs)             = x : q k xs

        -- We've seen a `[' is it an Haskell list or a quasi-quotation
        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)