diff --git a/System/UTF8IO.hs b/System/UTF8IO.hs --- a/System/UTF8IO.hs +++ b/System/UTF8IO.hs @@ -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 diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -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) + + diff --git a/UTF8Prelude.hs b/UTF8Prelude.hs --- a/UTF8Prelude.hs +++ b/UTF8Prelude.hs @@ -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 diff --git a/utf8-prelude.cabal b/utf8-prelude.cabal --- a/utf8-prelude.cabal +++ b/utf8-prelude.cabal @@ -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: