1 {-# LANGUAGE NoImplicitPrelude
3 , NondecreasingIndentation
5 {-# OPTIONS_GHC -funbox-strict-fields #-}
7 -----------------------------------------------------------------------------
9 -- Module : GHC.IO.Encoding.Latin1
10 -- Copyright : (c) The University of Glasgow, 2009
11 -- License : see libraries/base/LICENSE
13 -- Maintainer : libraries@haskell.org
14 -- Stability : internal
15 -- Portability : non-portable
17 -- UTF-32 Codecs for the IO library
19 -- Portions Copyright : (c) Tom Harper 2008-2009,
20 -- (c) Bryan O'Sullivan 2009,
21 -- (c) Duncan Coutts 2009
23 -----------------------------------------------------------------------------
25 module GHC.IO.Encoding.Latin1 (
30 latin1_checked_encode,
37 import GHC.IO.Exception
39 import GHC.IO.Encoding.Types
42 -- -----------------------------------------------------------------------------
45 latin1 :: TextEncoding
46 latin1 = TextEncoding { textEncodingName = "ISO8859-1",
47 mkTextDecoder = latin1_DF,
48 mkTextEncoder = latin1_EF }
50 latin1_DF :: IO (TextDecoder ())
53 encode = latin1_decode,
56 setState = const $ return ()
59 latin1_EF :: IO (TextEncoder ())
62 encode = latin1_encode,
65 setState = const $ return ()
68 latin1_checked :: TextEncoding
69 latin1_checked = TextEncoding { textEncodingName = "ISO8859-1(checked)",
70 mkTextDecoder = latin1_DF,
71 mkTextEncoder = latin1_checked_EF }
73 latin1_checked_EF :: IO (TextEncoder ())
76 encode = latin1_checked_encode,
79 setState = const $ return ()
83 latin1_decode :: DecodeBuffer
85 input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }
86 output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }
89 | ow >= os || ir >= iw = done ir ow
91 c0 <- readWord8Buf iraw ir
92 ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0))
95 -- lambda-lifted, to avoid thunks being built in the inner-loop:
96 done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }
97 else input{ bufL=ir },
102 latin1_encode :: EncodeBuffer
104 input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }
105 output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }
107 done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }
108 else input{ bufL=ir },
111 | ow >= os || ir >= iw = done ir ow
113 (c,ir') <- readCharBuf iraw ir
114 writeWord8Buf oraw ow (fromIntegral (ord c))
119 latin1_checked_encode :: EncodeBuffer
120 latin1_checked_encode
121 input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }
122 output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }
124 done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }
125 else input{ bufL=ir },
128 | ow >= os || ir >= iw = done ir ow
130 (c,ir') <- readCharBuf iraw ir
131 if ord c > 0xff then invalid else do
132 writeWord8Buf oraw ow (fromIntegral (ord c))
135 invalid = if ir > ir0 then done ir ow else ioe_encodingError
139 ioe_encodingError :: IO a
140 ioe_encodingError = ioException
141 (IOError Nothing InvalidArgument "latin1_checked_encode"
142 "character is out of range for this encoding" Nothing Nothing)