diff --git a/Data/Encoding/Base.hs b/Data/Encoding/Base.hs index 98934b2..f4318aa 100644 --- a/Data/Encoding/Base.hs +++ b/Data/Encoding/Base.hs @@ -6,7 +6,7 @@ import Data.Encoding.ByteSource import Data.Encoding.ByteSink import Control.Throws -import Data.Array as Array +import Data.Array.Unboxed as Array import Data.Map as Map hiding ((!)) import Data.Word import Data.Char @@ -64,17 +64,19 @@ encodeWithMap2 mp c = case Map.lookup c mp of encodeableWithMap :: Map Char a -> Char -> Bool encodeableWithMap = flip Map.member -decodeWithArray :: ByteSource m => Array Word8 (Maybe Char) -> m Char +decodeWithArray :: ByteSource m => UArray Word8 Int -> m Char decodeWithArray arr = do w <- fetchWord8 - case arr!w of - Nothing -> throwException $ IllegalCharacter w - Just c -> return c + let res = arr!w + if res < 0 + then throwException $ IllegalCharacter w + else return $ chr res -decodeWithArray2 :: ByteSource m => Array (Word8,Word8) (Maybe Char) -> m Char +decodeWithArray2 :: ByteSource m => UArray (Word8,Word8) Int -> m Char decodeWithArray2 arr = do w1 <- fetchWord8 w2 <- fetchWord8 - case arr!(w1,w2) of - Nothing -> throwException $ IllegalCharacter w1 - Just c -> return c \ No newline at end of file + let res = arr!(w1,w2) + if res < 0 + then throwException $ IllegalCharacter w1 + else return $ chr res \ No newline at end of file diff --git a/Data/Encoding/Helper/Template.hs b/Data/Encoding/Helper/Template.hs index d1619b5..60ff9f2 100644 --- a/Data/Encoding/Helper/Template.hs +++ b/Data/Encoding/Helper/Template.hs @@ -6,7 +6,7 @@ import Data.Bits import Data.Char import Data.Maybe (mapMaybe) import Data.Map as Map (fromList,lookup) -import Data.Array +import Data.Array.Unboxed import Data.Typeable import Language.Haskell.TH @@ -27,10 +27,11 @@ makeJISInstance name file = do encodingInstance :: Name -> Name -> Name -> String -> Exp -> Exp -> [Dec] encodingInstance enc dec able name mp arr = [ DataD [] rname [] [NormalC rname []] [''Show,''Eq,''Typeable] + , ValD (VarP rmp) (NormalB mp) [] , InstanceD [] (AppT (ConT ''Encoding) (ConT rname)) [FunD 'encodeChar [Clause [WildP] (NormalB $ AppE (VarE enc) (VarE rmp)) - [ValD (VarP rmp) (NormalB mp) []] + [] ] ,FunD 'decodeChar [Clause [WildP] (NormalB $ AppE (VarE dec) (VarE rarr)) @@ -38,14 +39,14 @@ encodingInstance enc dec able name mp arr ] ,FunD 'encodeable [Clause [WildP] (NormalB $ AppE (VarE able) (VarE rmp)) - [ValD (VarP rmp) (NormalB mp) []] + [] ] ] ] where rname = mkName name rarr = mkName "arr" - rmp = mkName "mp" + rmp = mkName ("decoding_map_"++name) createCharArray :: [(Integer,Maybe Char)] -> Integer -> Integer -> Q Exp createCharArray lst f t = createArray (map (\(x,y) -> @@ -64,8 +65,8 @@ integerExp :: Integer -> Exp integerExp i = LitE $ IntegerL i mbCharToExp :: Maybe Char -> Exp -mbCharToExp Nothing = ConE 'Nothing -mbCharToExp (Just c) = AppE (ConE 'Just) (LitE $ CharL c) +mbCharToExp Nothing = LitE (IntegerL (-1)) +mbCharToExp (Just c) = LitE (IntegerL $ fromIntegral $ ord c) createArray :: [(Exp,Exp)] -> Exp -> Exp -> Q Exp createArray lst from to