1-- |
2-- Module      : Basement.String.Encoding.UTF32
3-- License     : BSD-style
4-- Maintainer  : Foundation
5-- Stability   : experimental
6-- Portability : portable
7--
8{-# LANGUAGE MagicHash #-}
9module Basement.String.Encoding.UTF32
10    ( UTF32(..)
11    , UTF32_Invalid
12    ) where
13
14import GHC.Prim
15import GHC.Word
16import GHC.Types
17import Basement.Compat.Base
18import Basement.Types.OffsetSize
19import Basement.Monad
20import Basement.Numerical.Additive
21import Basement.UArray
22import Basement.UArray.Mutable (MUArray)
23import Basement.MutableBuilder
24
25import Basement.String.Encoding.Encoding
26
27data UTF32 = UTF32
28
29data UTF32_Invalid = UTF32_Invalid
30  deriving (Typeable, Show, Eq, Ord, Enum, Bounded)
31instance Exception UTF32_Invalid
32
33instance Encoding UTF32 where
34    type Unit UTF32 = Word32
35    type Error UTF32 = UTF32_Invalid
36    encodingNext  _ = next
37    encodingWrite _ = write
38
39next :: (Offset Word32 -> Word32)
40     -> Offset Word32
41     -> Either UTF32_Invalid (Char, Offset Word32)
42next getter off = Right (char, off + Offset 1)
43  where
44    !(W32# hh) = getter off
45    char :: Char
46    char = C# (chr# (word2Int# hh))
47
48write :: (PrimMonad st, Monad st)
49      => Char
50      -> Builder (UArray Word32) (MUArray Word32) Word32 st err ()
51write c = builderAppend w32
52  where
53    !(C# ch) = c
54    w32 :: Word32
55    w32 = W32# (int2Word# (ord# ch))
56