1 {-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}
2 {-# LANGUAGE BangPatterns #-}
3 -----------------------------------------------------------------------------
5 -- Module : GHC.IO.Encoding.Latin1
6 -- Copyright : (c) The University of Glasgow, 2009
7 -- License : see libraries/base/LICENSE
9 -- Maintainer : libraries@haskell.org
10 -- Stability : internal
11 -- Portability : non-portable
13 -- UTF-32 Codecs for the IO library
15 -- Portions Copyright : (c) Tom Harper 2008-2009,
16 -- (c) Bryan O'Sullivan 2009,
17 -- (c) Duncan Coutts 2009
19 -----------------------------------------------------------------------------
21 module GHC.IO.Encoding.Latin1 (
26 latin1_checked_encode,
33 import GHC.IO.Exception
35 import GHC.IO.Encoding.Types
38 -- -----------------------------------------------------------------------------
41 latin1 :: TextEncoding
42 latin1 = TextEncoding { textEncodingName = "ISO8859-1",
43 mkTextDecoder = latin1_DF,
44 mkTextEncoder = latin1_EF }
46 latin1_DF :: IO (TextDecoder ())
49 encode = latin1_decode,
52 setState = const $ return ()
55 latin1_EF :: IO (TextEncoder ())
58 encode = latin1_encode,
61 setState = const $ return ()
64 latin1_checked :: TextEncoding
65 latin1_checked = TextEncoding { textEncodingName = "ISO8859-1(checked)",
66 mkTextDecoder = latin1_DF,
67 mkTextEncoder = latin1_checked_EF }
69 latin1_checked_EF :: IO (TextEncoder ())
72 encode = latin1_checked_encode,
75 setState = const $ return ()
79 latin1_decode :: DecodeBuffer
81 input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }
82 output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }
85 | ow >= os || ir >= iw = done ir ow
87 c0 <- readWord8Buf iraw ir
88 ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0))
91 -- lambda-lifted, to avoid thunks being built in the inner-loop:
92 done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }
93 else input{ bufL=ir },
98 latin1_encode :: EncodeBuffer
100 input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }
101 output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }
103 done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }
104 else input{ bufL=ir },
107 | ow >= os || ir >= iw = done ir ow
109 (c,ir') <- readCharBuf iraw ir
110 writeWord8Buf oraw ow (fromIntegral (ord c))
115 latin1_checked_encode :: EncodeBuffer
116 latin1_checked_encode
117 input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }
118 output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }
120 done !ir !ow = return (if ir == iw then input{ bufL=0, bufR=0 }
121 else input{ bufL=ir },
124 | ow >= os || ir >= iw = done ir ow
126 (c,ir') <- readCharBuf iraw ir
127 if ord c > 0xff then invalid else do
128 writeWord8Buf oraw ow (fromIntegral (ord c))
131 invalid = if ir > ir0 then done ir ow else ioe_encodingError
135 ioe_encodingError :: IO a
136 ioe_encodingError = ioException
137 (IOError Nothing InvalidArgument "latin1_checked_encode"
138 "character is out of range for this encoding" Nothing Nothing)