diff --git a/Data/Encoding.hs b/Data/Encoding.hs --- a/Data/Encoding.hs +++ b/Data/Encoding.hs @@ -19,6 +19,7 @@ ,decodeStrictByteString ,decodeStrictByteStringExplicit ,encodingFromString + ,encodingFromStringExplicit ) where @@ -125,8 +126,8 @@ decodeStrictByteStringExplicit e str = evalStateT (decode e) str -- | Like 'encodingFromString' but returns 'Nothing' instead of throwing an error -encodingFromStringMaybe :: String -> Maybe DynEncoding -encodingFromStringMaybe codeName = case (normalizeEncoding codeName) of +encodingFromStringExplicit :: String -> Maybe DynEncoding +encodingFromStringExplicit codeName = case (normalizeEncoding codeName) of -- ASCII "ascii" -> Just $ DynEncoding ASCII "646" -> Just $ DynEncoding ASCII @@ -321,4 +322,4 @@ encodingFromString str = maybe (error $ "Data.Encoding.encodingFromString: Unknown encoding: "++show str) id - (encodingFromStringMaybe str) + (encodingFromStringExplicit str) diff --git a/Data/Encoding/Helper/Template.hs b/Data/Encoding/Helper/Template.hs --- a/Data/Encoding/Helper/Template.hs +++ b/Data/Encoding/Helper/Template.hs @@ -1,33 +1,40 @@ {-# LANGUAGE TemplateHaskell #-} -module Data.Encoding.Helper.Template where +module Data.Encoding.Helper.Template + (makeISOInstance + ,makeJISInstance) + where import Data.Encoding.Base import Data.Bits import Data.Char import Data.Maybe (mapMaybe) -import Data.Map as Map (fromList,lookup) +import Data.Map as Map (Map,fromList,lookup) import Data.Array.Unboxed import Data.Typeable +import Data.Word (Word8) import Language.Haskell.TH makeISOInstance :: String -> FilePath -> Q [Dec] makeISOInstance name file = do trans <- runIO (readTranslation 0 id file) - mp <- encodingMap (validTranslations trans) - arr <- decodingArray (fillTranslations 0 255 trans) - return $ encodingInstance 'encodeWithMap 'decodeWithArray 'encodeableWithMap name mp arr + let mp = encodingMap (validTranslations trans) + let arr = decodingArray (fillTranslations 0 255 trans) + return $ encodingInstance (ConT ''Word8) 'encodeWithMap 'decodeWithArray 'encodeableWithMap name mp arr makeJISInstance :: Int -> String -> FilePath -> Q [Dec] makeJISInstance offset name file = do trans <- runIO (readTranslation offset (\src -> (src `shiftR` 8,src .&. 0xFF)) file) - mp <- encodingMap2 (validTranslations trans) - arr <- decodingArray2 (fillTranslations (0x21,0x21) (0x7E,0x7E) trans) - return $ encodingInstance 'encodeWithMap2 'decodeWithArray2 'encodeableWithMap name mp arr + let mp = encodingMap2 (validTranslations trans) + let arr = decodingArray2 (fillTranslations (0x21,0x21) (0x7E,0x7E) trans) + return $ encodingInstance ((TupleT 2) `AppT` (ConT ''Word8) `AppT` (ConT ''Word8)) 'encodeWithMap2 'decodeWithArray2 'encodeableWithMap name mp arr -encodingInstance :: Name -> Name -> Name -> String -> Exp -> Exp -> [Dec] -encodingInstance enc dec able name mp arr +encodingInstance :: Type -> Name -> Name -> Name -> String -> Exp -> Exp -> [Dec] +encodingInstance tp enc dec able name mp arr = [ DataD [] rname [] [NormalC rname []] [''Show,''Eq,''Typeable] + , SigD rmp (((ConT ''Map.Map) `AppT` (ConT ''Char)) `AppT` tp) , ValD (VarP rmp) (NormalB mp) [] + , SigD rarr ((ConT ''UArray) `AppT` tp `AppT` (ConT ''Int)) + , ValD (VarP rarr) (NormalB arr) [] , InstanceD [] (AppT (ConT ''Encoding) (ConT rname)) [FunD 'encodeChar [Clause [WildP] (NormalB $ AppE (VarE enc) (VarE rmp)) @@ -35,7 +42,7 @@ ] ,FunD 'decodeChar [Clause [WildP] (NormalB $ AppE (VarE dec) (VarE rarr)) - [ValD (VarP rarr) (NormalB arr) []] + [] ] ,FunD 'encodeable [Clause [WildP] (NormalB $ AppE (VarE able) (VarE rmp)) @@ -45,15 +52,15 @@ ] where rname = mkName name - rarr = mkName "arr" + rarr = mkName ("encoding_arr_"++name) rmp = mkName ("decoding_map_"++name) -createCharArray :: [(Integer,Maybe Char)] -> Integer -> Integer -> Q Exp +createCharArray :: [(Integer,Maybe Char)] -> Integer -> Integer -> Exp createCharArray lst f t = createArray (map (\(x,y) -> (LitE $ IntegerL x,mbCharToExp y) ) lst) (LitE $ IntegerL f) (LitE $ IntegerL t) -createCharArray2 :: [((Integer,Integer),Maybe Char)] -> (Integer,Integer) -> (Integer,Integer) -> Q Exp +createCharArray2 :: [((Integer,Integer),Maybe Char)] -> (Integer,Integer) -> (Integer,Integer) -> Exp createCharArray2 lst (f1,f2) (t1,t2) = createArray (map (\((x1,x2),y) -> (TupE [integerExp x1,integerExp x2],mbCharToExp y) @@ -61,35 +68,35 @@ (TupE [integerExp f1,integerExp f2]) (TupE [integerExp t1,integerExp t2]) -integerExp :: Integer -> Exp -integerExp i = LitE $ IntegerL i - mbCharToExp :: Maybe Char -> Exp mbCharToExp Nothing = LitE (IntegerL (-1)) mbCharToExp (Just c) = LitE (IntegerL $ fromIntegral $ ord c) -createArray :: [(Exp,Exp)] -> Exp -> Exp -> Q Exp +integerExp :: Integer -> Exp +integerExp i = LitE $ IntegerL i + +createArray :: [(Exp,Exp)] -> Exp -> Exp -> Exp createArray lst from to - = return $ AppE + = AppE (AppE (VarE 'array) (TupE [from,to])) (ListE [TupE [x,y] | (x,y) <- lst]) -decodingArray :: [(Integer,Maybe Char)] -> Q Exp +decodingArray :: [(Integer,Maybe Char)] -> Exp decodingArray trans = createCharArray trans 0 255 -decodingArray2 :: [((Integer,Integer),Maybe Char)] -> Q Exp +decodingArray2 :: [((Integer,Integer),Maybe Char)] -> Exp decodingArray2 trans = createCharArray2 trans (0x21,0x21) (0x7E,0x7E) -encodingMap :: [(Integer,Char)] -> Q Exp -encodingMap trans = return $ AppE +encodingMap :: [(Integer,Char)] -> Exp +encodingMap trans = AppE (VarE 'fromList) (ListE [ TupE [LitE $ CharL to,LitE $ IntegerL from] | (from,to) <- trans]) -encodingMap2 :: [((Integer,Integer),Char)] -> Q Exp -encodingMap2 trans = return $ AppE +encodingMap2 :: [((Integer,Integer),Char)] -> Exp +encodingMap2 trans = AppE (VarE 'fromList) (ListE [ TupE [LitE $ CharL to,TupE [integerExp f1,integerExp f2]] | ((f1,f2),to) <- trans]) diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,3 +1,7 @@ +Changes from 0.5 to 0.5.2 +------------------------- + +* Export function encodingFromStringExplicit Changes from 0.4 to 0.5 ----------------------- diff --git a/encoding.cabal b/encoding.cabal --- a/encoding.cabal +++ b/encoding.cabal @@ -1,5 +1,5 @@ Name: encoding -Version: 0.5.1 +Version: 0.5.2 Author: Henning Günther Maintainer: h.guenther@tu-bs.de License: BSD3 @@ -47,7 +47,7 @@ Library if flag(splitBase) - Build-Depends: bytestring, base >= 3, binary, mtl, containers, extensible-exceptions, array, template-haskell, regex-compat + Build-Depends: bytestring, base >= 3 && < 5, binary, mtl, containers, extensible-exceptions, array, template-haskell, regex-compat else Build-Depends: base < 3, binary, extensible-exceptions, template-haskell