utf8-prelude 0.1.2 → 0.1.3
raw patch · 4 files changed
+149/−7 lines, 4 files
Files
- System/UTF8IO.hs +105/−0
- Test.hs +29/−2
- UTF8Prelude.hs +13/−3
- utf8-prelude.cabal +2/−2
System/UTF8IO.hs view
@@ -15,8 +15,19 @@ module System.UTF8IO ( module System.IO , module System.IO.UTF8+ -- * Functions not defined in "System.IO.UTF8"+ , putChar+ , getChar+ , hPutChar+ , hGetChar+ , hLookAhead+ , hPrint ) where +import Codec.Binary.UTF8.String (decodeString)++import Data.Bits ((.&.))+ import System.IO.UTF8 import System.IO hiding @@ -29,12 +40,106 @@ , writeFile , appendFile , getContents+ , putChar+ , getChar , hGetLine , hGetContents , hPutStr , hPutStrLn+ , hPutChar+ , hGetChar+ , hLookAhead+ , hPrint ) +import qualified System.IO +import Prelude hiding+ ( print+ , putStr+ , putStrLn+ , getLine+ , readLn+ , readFile+ , writeFile+ , appendFile+ , getContents+ , putChar+ , getChar+ ) +-- | Computation 'hPutChar' @hdl ch@ writes the character @ch@ to the file or channel managed by @hdl@. +-- Characters may be buffered if buffering is enabled for @hdl@. +--+-- Note: The implementation of 'hPutChar' is not efficient.++hPutChar :: Handle -> Char -> IO ()+hPutChar h c = hPutStr h [c]++-- | Computation 'hGetChar' @hdl@ reads a character from the file or channel +-- managed by 'hdl', blocking until a character is available.+--+-- Note: The implementation of 'hGetChar' is not efficient.++hGetChar :: Handle -> IO Char+hGetChar h = do + c <- System.IO.hGetChar h+ s <- getBytes [c] (estimated_size c)+ return $ head $ decodeString $ reverse s -- may have faster implementation+ where+ estimated_size c+ | c < toEnum 0xc0 = 0+ | c < toEnum 0xe0 = 1+ | c < toEnum 0xf0 = 2+ | c < toEnum 0xf8 = 3+ | c < toEnum 0xfc = 4+ | c < toEnum 0xfe = 5+ | otherwise = 0++ getBytes :: String -> Int -> IO String+ getBytes acc 0 = return acc+ getBytes acc n = do+ eof <- hIsEOF h+ if eof + then return acc+ else do+ c <- System.IO.hLookAhead h+ if fromEnum c .&. 0xc0 == 0x80+ then do+ System.IO.hGetChar h+ getBytes (c: acc) (n-1)+ else return acc++-- | Computation 'hLookAhead' @hdl@ returns the next character from the handle +-- without removing it from the input buffer, blocking until a character is available.+--+-- Note: 'hLookAhead' is not implemented; it halts with a run-time error.++hLookAhead :: Handle -> IO Char+hLookAhead = error "System.UTF8IO.hLookAhead: Not implemented"++-- | Write a character to the standard output device+-- (same as 'hPutChar' 'stdout').+--+-- Note: The implementation of 'putChar' is not efficient.++putChar :: Char -> IO ()+putChar c = hPutChar stdout c++-- | Read a character from the standard input device+-- (same as 'hGetChar' 'stdin').+--+-- Note: The implementation of 'getChar' is not efficient.++getChar :: IO Char+getChar = hGetChar stdin++-- | Computation 'hPrint' @hdl t@ writes the UTF8 string representation of @t@+-- to the file or channel managed by @hdl@ and appends a newline+-- (same as 'hPutStrLn' @hdl .@ 'show' @t@).+--+-- Note: 'hPrint' has the same behaviour as @System.IO.hPrint@ because 'show' always produces an ASCII string.++hPrint :: Show a => Handle -> a -> IO ()+hPrint hdl = hPutStrLn hdl . show
Test.hs view
@@ -3,6 +3,8 @@ import Data.Maybe +import System.UTF8IO+ import Prelude() import UTF8Prelude @@ -24,15 +26,28 @@ do writeFile writeFile_test s s' <- readFile writeFile_test - let diffs = filter (\(a,b) -> a /= b) $ zip s s'- assert (null diffs) "writeFile" $ "First 10 different charcodes: " ++ show (take 10 diffs)+ assert (s == s') "writeFile" $ showDiff s s' + do+ withFile writeFile_test WriteMode (\h -> mapM_ (hPutChar h) s)+ s' <- readFile writeFile_test + assert (s == s') "hPutChar" $ showDiff s s'++ do+ s' <- withFile writeFile_test ReadMode readFile'+ assert (s == s') "hGetChar" $ showDiff s s'+ do putStrLn "Basic putStrLn test:" putStrLn_test <- getDataFileName "putStrLn_test.txt" s <- readFile putStrLn_test mapM_ putStrLn $ map (" " ++) $ lines s +showDiff :: String -> String -> String+showDiff a b = "Strings from position " ++ show n ++ ": " ++ show (take 10 $ drop n a) ++ " /= " ++ show (take 10 $ drop n b)+ where+ n = max 0 (n' - 4)+ n' = length $ takeWhile (uncurry (==)) $ zip a b checkLine :: String -> Maybe String checkLine s = case reads s of@@ -49,5 +64,17 @@ make_readFile_test :: IO () make_readFile_test = writeFile "readFile_test.txt" $ unlines [show i ++ " " ++ [toEnum i] | i<-[33,132..55000]] -- it fails with [33,132..65535]!++readFile' :: Handle -> IO String+readFile' h = do+ b <- hIsEOF h+ if b+ then return []+ else do+ c <- hGetChar h+ cs <- readFile' h+ return (c:cs)++
UTF8Prelude.hs view
@@ -26,21 +26,29 @@ -- > import qualified Prelude -- > import UTF8Prelude ----- "UTF8Prelude" re-exports "System.IO.UTF8" but hides the definitions not defined in "Prelude".+-- "UTF8Prelude" re-exports "System.UTF8IO" but hides the definitions not defined in "Prelude". module UTF8Prelude ( module Prelude- , module System.IO.UTF8+ , module System.UTF8IO , error ) where import Codec.Binary.UTF8.String (encodeString) -import System.IO.UTF8 hiding+import System.UTF8IO hiding ( hGetLine , hGetContents , hPutStr , hPutStrLn+ , hPutChar+ , hGetChar+ , hLookAhead+ , hPrint+ , interact+ , readIO+ , IO+ , FilePath ) import Prelude hiding @@ -54,6 +62,8 @@ , writeFile , appendFile , getContents+ , putChar+ , getChar ) import qualified Prelude
utf8-prelude.cabal view
@@ -1,5 +1,5 @@ name: utf8-prelude-version: 0.1.2+version: 0.1.3 synopsis: Prelude and System.IO with UTF8 text I/O description: utf8-prelude provides variants of "Prelude" and "System.IO" using UTF8 text I/O operations, making @@ -14,7 +14,7 @@ * In all modules replace every occurrence of "System.IO" with "System.UTF8IO". . utf8-prelude also provides a basic testing tool:- utf8-test tests the functions readFile, writeFile and putStrLn.+ utf8-test tests several functions regarding UTF8 text I/O. Note: utf8-test creates a file named writeFile_test.txt in the current working directory. . utf8-prelude is based on utf8-string: