frquotes 0.1.0 → 0.2.1
raw patch · 4 files changed
+108/−37 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- LICENSE +1/−1
- Text/FrQuotes.hs +87/−19
- frquotes.cabal +1/−1
- frquotes.hs +19/−16
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2010, Nicolas Pouillard+Copyright (c) 2010-2011, Nicolas Pouillard All rights reserved. Redistribution and use in source and binary forms, with or without
Text/FrQuotes.hs view
@@ -1,21 +1,46 @@+-- 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,- openFrQ, closeFrQ, openBr, closeBr :: String+ openBr, closeBr :: String frTop = "(frTop ("-openFrQQ' = "[$frQQ|"+openFrQQ' = "[" ++ qq67 ++ "frQQ|" closeFrQQ' = "|]" openFrQQ = frTop ++ openFrQQ' closeFrQQ = closeFrQQ' ++ "))"-openFrQ = "\xc2\xab"-closeFrQ = "\xc2\xbb"+-- 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|...|])+-- Substitutes UTF8 french quotes «...» for (frTop [frQQ|...|]) -- Antiquotations are supported via braces {...} and are -- substituted for frAntiq, blocks are catenated with mappend.--- Here String is used as UTF-8 code points. frQuotes :: String -> String frQuotes = h -- All these functions follow the same style,@@ -29,30 +54,70 @@ -- haskell context -- the h function don't needs a continuation parameter where h "" = ""- h ('\xc2':'\xab':'{':xs) = frTop ++ "( frAntiq (" ++ b ((closeBr++) . f ((closeFrQQ++) . (')':) . h)) xs -- avoid an empty [$frQQ||]- h ('\xc2':'\xab':xs) = openFrQQ ++ f ((closeFrQQ++) . h) xs+ 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) = '[' : '$' : startq 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 `\xc2\xbb')"+ f _ "" = error "unterminated french quotes (expecting `»')" 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 ('{':'«':'}':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 ('\xc2':'\xab':xs) = openFrQQ ++ f ((closeFrQQ++) . b k) xs- b _ ('\xc2':'\xbb':_) = error "unexpected closing french quote"+ 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@@ -79,7 +144,10 @@ 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++ -- 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)
frquotes.cabal view
@@ -1,6 +1,6 @@ Name: frquotes Cabal-Version: >= 1.2-Version: 0.1.0+Version: 0.2.1 Copyright: (c) Nicolas Pouillard Author: Nicolas Pouillard Maintainer: Nicolas Pouillard <nicolas.pouillard@gmail.com>
frquotes.hs view
@@ -2,27 +2,30 @@ import System.IO import Text.FrQuotes (frQuotes) --- | The 'readBinaryFile' function reads a binary file and--- returns the contents of the file as a string.--- The file is read lazily, on demand, as with 'getContents'.--readBinaryFile :: FilePath -> IO String-readBinaryFile name = openBinaryFile name ReadMode >>= hGetContents+readFileEnc :: TextEncoding -> FilePath -> IO String+readFileEnc enc fp = do+ fh <- openFile fp ReadMode+ hSetEncoding fh enc+ hGetContents fh --- | The computation 'writeBinaryFile' @file str@ function writes the string @str@,--- to the file @file@.-writeBinaryFile :: FilePath -> String -> IO ()-writeBinaryFile f txt = withBinaryFile f WriteMode (\ hdl -> hPutStr hdl txt)+writeFileEnc :: TextEncoding -> FilePath -> String -> IO ()+writeFileEnc enc fp s =+ withFile fp WriteMode $ \fh ->+ hSetEncoding fh enc >>+ hPutStr fh s -interact' :: (String -> String) -> IO ()-interact' f = do+interact' :: TextEncoding -> (String -> String) -> IO ()+interact' enc f = do args <- getArgs case args of- [] -> interact f+ [] -> do+ hSetEncoding stdin enc+ hSetEncoding stdout enc+ interact f [in1,inp,outp] ->- writeBinaryFile outp . g . f =<< readBinaryFile inp- where g = (("{-# LINE 2 \""++in1++"\" #-}\n")++)+ writeFileEnc enc outp . g . f =<< readFileEnc enc inp+ where g = (("{-# LINE 1 \""++in1++"\" #-}\n")++) _ -> fail "Usage: frquotes [<orig> <input> <output>]" main :: IO ()-main = interact' frQuotes+main = interact' utf8 frQuotes