haskell/encoding
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

changes for GHC-7 and HaXml-1.22 compatibility

Browse Source 
Ignore-this: c517f25bda6021abca5d16cf9d7d88dd

darcs-hash:20120420205714-76d51-a665d650004e98cad59fa489b97b81496848bc3b
This commit is contained in:
Daniel Wagner 2012-04-20 13:57:14 -07:00
parent 44f3f083aa
commit a95a1e298b
4 changed files with 44 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Data/Encoding/ByteSource.hs
View File

@ -178,10 +178,6 @@ instance ByteSource (ReaderT Handle IO) where
res <- act res <- act
liftIO $ hSetPosn pos liftIO $ hSetPosn pos
return res return res
sourcePos = do
h <- ask
p <- liftIO $ hTell h
return $ Just p
{- {-
instance Throws DecodingException (State st) => Throws DecodingException (State (Integer,st)) where instance Throws DecodingException (State st) => Throws DecodingException (State (Integer,st)) where

75
Data/Encoding/Preprocessor/XMLMapping.hs
View File

@ -8,6 +8,7 @@ import Data.List (find)
import Data.Char import Data.Char
import Text.XML.HaXml.XmlContent import Text.XML.HaXml.XmlContent
import Text.XML.HaXml.OneOfN import Text.XML.HaXml.OneOfN
import Text.XML.HaXml.Types
testFile :: FilePath -> IO CharacterMapping testFile :: FilePath -> IO CharacterMapping
testFile fp = fReadXml fp testFile fp = fReadXml fp
@ -130,7 +131,7 @@ instance HTypeable CharacterMapping where
toHType x = Defined "characterMapping" [] [] toHType x = Defined "characterMapping" [] []
instance XmlContent CharacterMapping where instance XmlContent CharacterMapping where
toContents (CharacterMapping as a b c) = toContents (CharacterMapping as a b c) =
[CElem (Elem "characterMapping" (toAttrs as) (maybe [] toContents a [CElem (Elem (N "characterMapping") (toAttrs as) (maybe [] toContents a
++ toContents b ++ toContents b
++ toContents c)) ()] ++ toContents c)) ()]
parseContents = do parseContents = do
@ -167,29 +168,29 @@ instance XmlAttributes CharacterMapping_Attrs where
instance XmlAttrType CharacterMapping_bidiOrder where instance XmlAttrType CharacterMapping_bidiOrder where
fromAttrToTyp n (n',v) fromAttrToTyp n (n',v)
| n==n' = translate (attr2str v) | N n==n' = translate (attr2str v)
| otherwise = Nothing | otherwise = Nothing
where translate "logical" = Just CharacterMapping_bidiOrder_logical where translate "logical" = Just CharacterMapping_bidiOrder_logical
translate "RTL" = Just CharacterMapping_bidiOrder_RTL translate "RTL" = Just CharacterMapping_bidiOrder_RTL
translate "LTR" = Just CharacterMapping_bidiOrder_LTR translate "LTR" = Just CharacterMapping_bidiOrder_LTR
translate _ = Nothing translate _ = Nothing
toAttrFrTyp n CharacterMapping_bidiOrder_logical = Just (n, str2attr "logical") toAttrFrTyp n CharacterMapping_bidiOrder_logical = Just (N n, str2attr "logical")
toAttrFrTyp n CharacterMapping_bidiOrder_RTL = Just (n, str2attr "RTL") toAttrFrTyp n CharacterMapping_bidiOrder_RTL = Just (N n, str2attr "RTL")
toAttrFrTyp n CharacterMapping_bidiOrder_LTR = Just (n, str2attr "LTR") toAttrFrTyp n CharacterMapping_bidiOrder_LTR = Just (N n, str2attr "LTR")
instance XmlAttrType CharacterMapping_combiningOrder where instance XmlAttrType CharacterMapping_combiningOrder where
fromAttrToTyp n (n',v) fromAttrToTyp n (n',v)
| n==n' = translate (attr2str v) | N n==n' = translate (attr2str v)
| otherwise = Nothing | otherwise = Nothing
where translate "before" = Just CharacterMapping_combiningOrder_before where translate "before" = Just CharacterMapping_combiningOrder_before
translate "after" = Just CharacterMapping_combiningOrder_after translate "after" = Just CharacterMapping_combiningOrder_after
translate _ = Nothing translate _ = Nothing
toAttrFrTyp n CharacterMapping_combiningOrder_before = Just (n, str2attr "before") toAttrFrTyp n CharacterMapping_combiningOrder_before = Just (N n, str2attr "before")
toAttrFrTyp n CharacterMapping_combiningOrder_after = Just (n, str2attr "after") toAttrFrTyp n CharacterMapping_combiningOrder_after = Just (N n, str2attr "after")
instance XmlAttrType CharacterMapping_normalization where instance XmlAttrType CharacterMapping_normalization where
fromAttrToTyp n (n',v) fromAttrToTyp n (n',v)
| n==n' = translate (attr2str v) | N n==n' = translate (attr2str v)
| otherwise = Nothing | otherwise = Nothing
where translate "undetermined" = Just CharacterMapping_normalization_undetermined where translate "undetermined" = Just CharacterMapping_normalization_undetermined
translate "neither" = Just CharacterMapping_normalization_neither translate "neither" = Just CharacterMapping_normalization_neither
@ -197,17 +198,17 @@ instance XmlAttrType CharacterMapping_normalization where
translate "NFD" = Just CharacterMapping_normalization_NFD translate "NFD" = Just CharacterMapping_normalization_NFD
translate "NFC_NFD" = Just CharacterMapping_normalization_NFC_NFD translate "NFC_NFD" = Just CharacterMapping_normalization_NFC_NFD
translate _ = Nothing translate _ = Nothing
toAttrFrTyp n CharacterMapping_normalization_undetermined = Just (n, str2attr "undetermined") toAttrFrTyp n CharacterMapping_normalization_undetermined = Just (N n, str2attr "undetermined")
toAttrFrTyp n CharacterMapping_normalization_neither = Just (n, str2attr "neither") toAttrFrTyp n CharacterMapping_normalization_neither = Just (N n, str2attr "neither")
toAttrFrTyp n CharacterMapping_normalization_NFC = Just (n, str2attr "NFC") toAttrFrTyp n CharacterMapping_normalization_NFC = Just (N n, str2attr "NFC")
toAttrFrTyp n CharacterMapping_normalization_NFD = Just (n, str2attr "NFD") toAttrFrTyp n CharacterMapping_normalization_NFD = Just (N n, str2attr "NFD")
toAttrFrTyp n CharacterMapping_normalization_NFC_NFD = Just (n, str2attr "NFC_NFD") toAttrFrTyp n CharacterMapping_normalization_NFC_NFD = Just (N n, str2attr "NFC_NFD")
instance XmlAttrType ByteSequence where instance XmlAttrType ByteSequence where
fromAttrToTyp n (n',v) fromAttrToTyp n (n',v)
| n==n' = parseByteSequence (attr2str v) | N n==n' = parseByteSequence (attr2str v)
| otherwise = Nothing | otherwise = Nothing
toAttrFrTyp n bs = Just (n, str2attr $ show bs) toAttrFrTyp n bs = Just (N n, str2attr $ show bs)
parseByteSequence :: String -> Maybe ByteSequence parseByteSequence :: String -> Maybe ByteSequence
parseByteSequence str = do parseByteSequence str = do
@ -222,9 +223,9 @@ instance Show ByteSequence where
instance XmlAttrType CodePoints where instance XmlAttrType CodePoints where
fromAttrToTyp n (n',v) fromAttrToTyp n (n',v)
| n==n' = parseCodePoints (attr2str v) | N n==n' = parseCodePoints (attr2str v)
| otherwise = Nothing | otherwise = Nothing
toAttrFrTyp n bs = Just (n, str2attr $ show bs) toAttrFrTyp n bs = Just (N n, str2attr $ show bs)
parseCodePoints :: String -> Maybe CodePoints parseCodePoints :: String -> Maybe CodePoints
parseCodePoints str = do parseCodePoints str = do
@ -241,7 +242,7 @@ instance HTypeable Stateful_siso where
toHType x = Defined "stateful_siso" [] [] toHType x = Defined "stateful_siso" [] []
instance XmlContent Stateful_siso where instance XmlContent Stateful_siso where
toContents (Stateful_siso a b) = toContents (Stateful_siso a b) =
[CElem (Elem "stateful_siso" [] (toContents a ++ toContents b)) ()] [CElem (Elem (N "stateful_siso") [] (toContents a ++ toContents b)) ()]
parseContents = do parseContents = do
{ e@(Elem _ [] _) <- element ["stateful_siso"] { e@(Elem _ [] _) <- element ["stateful_siso"]
; interior e $ return (Stateful_siso) `apply` parseContents ; interior e $ return (Stateful_siso) `apply` parseContents
@ -252,7 +253,7 @@ instance HTypeable History where
toHType x = Defined "history" [] [] toHType x = Defined "history" [] []
instance XmlContent History where instance XmlContent History where
toContents (History a) = toContents (History a) =
[CElem (Elem "history" [] (toContents a)) ()] [CElem (Elem (N "history") [] (toContents a)) ()]
parseContents = do parseContents = do
{ e@(Elem _ [] _) <- element ["history"] { e@(Elem _ [] _) <- element ["history"]
; interior e $ return (History) `apply` parseContents ; interior e $ return (History) `apply` parseContents
@ -262,7 +263,7 @@ instance HTypeable Modified where
toHType x = Defined "modified" [] [] toHType x = Defined "modified" [] []
instance XmlContent Modified where instance XmlContent Modified where
toContents (Modified as a) = toContents (Modified as a) =
[CElem (Elem "modified" (toAttrs as) (toText a)) ()] [CElem (Elem (N "modified") (toAttrs as) (toText a)) ()]
parseContents = do parseContents = do
{ e@(Elem _ as _) <- element ["modified"] { e@(Elem _ as _) <- element ["modified"]
; interior e $ return (Modified (fromAttrs as)) ; interior e $ return (Modified (fromAttrs as))
@ -283,7 +284,7 @@ instance HTypeable Validity where
toHType x = Defined "validity" [] [] toHType x = Defined "validity" [] []
instance XmlContent Validity where instance XmlContent Validity where
toContents (Validity a) = toContents (Validity a) =
[CElem (Elem "validity" [] (toContents a)) ()] [CElem (Elem (N "validity") [] (toContents a)) ()]
parseContents = do parseContents = do
{ e@(Elem _ [] _) <- element ["validity"] { e@(Elem _ [] _) <- element ["validity"]
; interior e $ return (Validity) `apply` parseContents ; interior e $ return (Validity) `apply` parseContents
@ -293,7 +294,7 @@ instance HTypeable State where
toHType x = Defined "state" [] [] toHType x = Defined "state" [] []
instance XmlContent State where instance XmlContent State where
toContents as = toContents as =
[CElem (Elem "state" (toAttrs as) []) ()] [CElem (Elem (N "state") (toAttrs as) []) ()]
parseContents = do parseContents = do
{ (Elem _ as []) <- element ["state"] { (Elem _ as []) <- element ["state"]
; return (fromAttrs as) ; return (fromAttrs as)
@ -319,7 +320,7 @@ instance HTypeable Assignments where
toHType x = Defined "assignments" [] [] toHType x = Defined "assignments" [] []
instance XmlContent Assignments where instance XmlContent Assignments where
toContents (Assignments as a b c d e) = toContents (Assignments as a b c d e) =
[CElem (Elem "assignments" (toAttrs as) (concatMap toContents a ++ [CElem (Elem (N "assignments") (toAttrs as) (concatMap toContents a ++
concatMap toContents b ++ concatMap toContents c ++ concatMap toContents b ++ concatMap toContents c ++
concatMap toContents d ++ concatMap toContents d ++
concatMap toContents e)) ()] concatMap toContents e)) ()]
@ -345,7 +346,7 @@ instance HTypeable A where
toHType x = Defined "a" [] [] toHType x = Defined "a" [] []
instance XmlContent A where instance XmlContent A where
toContents as = toContents as =
[CElem (Elem "a" (toAttrs as) []) ()] [CElem (Elem (N "a") (toAttrs as) []) ()]
parseContents = do parseContents = do
{ (Elem _ as []) <- element ["a"] { (Elem _ as []) <- element ["a"]
; return (fromAttrs as) ; return (fromAttrs as)
@ -368,7 +369,7 @@ instance HTypeable Fub where
toHType x = Defined "fub" [] [] toHType x = Defined "fub" [] []
instance XmlContent Fub where instance XmlContent Fub where
toContents as = toContents as =
[CElem (Elem "fub" (toAttrs as) []) ()] [CElem (Elem (N "fub") (toAttrs as) []) ()]
parseContents = do parseContents = do
{ (Elem _ as []) <- element ["fub"] { (Elem _ as []) <- element ["fub"]
; return (fromAttrs as) ; return (fromAttrs as)
@ -396,7 +397,7 @@ instance HTypeable Fbu where
toHType x = Defined "fbu" [] [] toHType x = Defined "fbu" [] []
instance XmlContent Fbu where instance XmlContent Fbu where
toContents as = toContents as =
[CElem (Elem "fbu" (toAttrs as) []) ()] [CElem (Elem (N "fbu") (toAttrs as) []) ()]
parseContents = do parseContents = do
{ (Elem _ as []) <- element ["fbu"] { (Elem _ as []) <- element ["fbu"]
; return (fromAttrs as) ; return (fromAttrs as)
@ -418,7 +419,7 @@ instance HTypeable Sub1 where
toHType x = Defined "sub1" [] [] toHType x = Defined "sub1" [] []
instance XmlContent Sub1 where instance XmlContent Sub1 where
toContents as = toContents as =
[CElem (Elem "sub1" (toAttrs as) []) ()] [CElem (Elem (N "sub1") (toAttrs as) []) ()]
parseContents = do parseContents = do
{ (Elem _ as []) <- element ["sub1"] { (Elem _ as []) <- element ["sub1"]
; return (fromAttrs as) ; return (fromAttrs as)
@ -440,7 +441,7 @@ instance HTypeable Range where
toHType x = Defined "range" [] [] toHType x = Defined "range" [] []
instance XmlContent Range where instance XmlContent Range where
toContents as = toContents as =
[CElem (Elem "range" (toAttrs as) []) ()] [CElem (Elem (N "range") (toAttrs as) []) ()]
parseContents = do parseContents = do
{ (Elem _ as []) <- element ["range"] { (Elem _ as []) <- element ["range"]
; return (fromAttrs as) ; return (fromAttrs as)
@ -470,7 +471,7 @@ instance HTypeable Iso2022 where
toHType x = Defined "iso2022" [] [] toHType x = Defined "iso2022" [] []
instance XmlContent Iso2022 where instance XmlContent Iso2022 where
toContents (Iso2022 a b) = toContents (Iso2022 a b) =
[CElem (Elem "iso2022" [] (maybe [] toContents a ++ [CElem (Elem (N "iso2022") [] (maybe [] toContents a ++
toContents b)) ()] toContents b)) ()]
parseContents = do parseContents = do
{ e@(Elem _ [] _) <- element ["iso2022"] { e@(Elem _ [] _) <- element ["iso2022"]
@ -482,7 +483,7 @@ instance HTypeable Default2022 where
toHType x = Defined "default2022" [] [] toHType x = Defined "default2022" [] []
instance XmlContent Default2022 where instance XmlContent Default2022 where
toContents as = toContents as =
[CElem (Elem "default2022" (toAttrs as) []) ()] [CElem (Elem (N "default2022") (toAttrs as) []) ()]
parseContents = do parseContents = do
{ (Elem _ as []) <- element ["default2022"] { (Elem _ as []) <- element ["default2022"]
; return (fromAttrs as) ; return (fromAttrs as)
@ -500,7 +501,7 @@ instance HTypeable Escape where
toHType x = Defined "escape" [] [] toHType x = Defined "escape" [] []
instance XmlContent Escape where instance XmlContent Escape where
toContents as = toContents as =
[CElem (Elem "escape" (toAttrs as) []) ()] [CElem (Elem (N "escape") (toAttrs as) []) ()]
parseContents = do parseContents = do
{ (Elem _ as []) <- element ["escape"] { (Elem _ as []) <- element ["escape"]
; return (fromAttrs as) ; return (fromAttrs as)
@ -520,7 +521,7 @@ instance HTypeable Si where
toHType x = Defined "si" [] [] toHType x = Defined "si" [] []
instance XmlContent Si where instance XmlContent Si where
toContents (Si a) = toContents (Si a) =
[CElem (Elem "si" [] (toContents a)) ()] [CElem (Elem (N "si") [] (toContents a)) ()]
parseContents = do parseContents = do
{ e@(Elem _ [] _) <- element ["si"] { e@(Elem _ [] _) <- element ["si"]
; interior e $ return (Si) `apply` parseContents ; interior e $ return (Si) `apply` parseContents
@ -530,7 +531,7 @@ instance HTypeable So where
toHType x = Defined "so" [] [] toHType x = Defined "so" [] []
instance XmlContent So where instance XmlContent So where
toContents (So a) = toContents (So a) =
[CElem (Elem "so" [] (toContents a)) ()] [CElem (Elem (N "so") [] (toContents a)) ()]
parseContents = do parseContents = do
{ e@(Elem _ [] _) <- element ["so"] { e@(Elem _ [] _) <- element ["so"]
; interior e $ return (So) `apply` parseContents ; interior e $ return (So) `apply` parseContents
@ -540,7 +541,7 @@ instance HTypeable Ss2 where
toHType x = Defined "ss2" [] [] toHType x = Defined "ss2" [] []
instance XmlContent Ss2 where instance XmlContent Ss2 where
toContents (Ss2 a) = toContents (Ss2 a) =
[CElem (Elem "ss2" [] (toContents a)) ()] [CElem (Elem (N "ss2") [] (toContents a)) ()]
parseContents = do parseContents = do
{ e@(Elem _ [] _) <- element ["ss2"] { e@(Elem _ [] _) <- element ["ss2"]
; interior e $ return (Ss2) `apply` parseContents ; interior e $ return (Ss2) `apply` parseContents
@ -550,7 +551,7 @@ instance HTypeable Ss3 where
toHType x = Defined "ss3" [] [] toHType x = Defined "ss3" [] []
instance XmlContent Ss3 where instance XmlContent Ss3 where
toContents (Ss3 a) = toContents (Ss3 a) =
[CElem (Elem "ss3" [] (toContents a)) ()] [CElem (Elem (N "ss3") [] (toContents a)) ()]
parseContents = do parseContents = do
{ e@(Elem _ [] _) <- element ["ss3"] { e@(Elem _ [] _) <- element ["ss3"]
; interior e $ return (Ss3) `apply` parseContents ; interior e $ return (Ss3) `apply` parseContents
@ -560,7 +561,7 @@ instance HTypeable Designator where
toHType x = Defined "designator" [] [] toHType x = Defined "designator" [] []
instance XmlContent Designator where instance XmlContent Designator where
toContents as = toContents as =
[CElem (Elem "designator" (toAttrs as) []) ()] [CElem (Elem (N "designator") (toAttrs as) []) ()]
parseContents = do parseContents = do
{ (Elem _ as []) <- element ["designator"] { (Elem _ as []) <- element ["designator"]
; return (fromAttrs as) ; return (fromAttrs as)

2
Data/Static.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE MagicHash,FlexibleInstances #-} {-# LANGUAGE MagicHash,FlexibleInstances,BangPatterns #-}
module Data.Static where module Data.Static where
import GHC.Exts import GHC.Exts

8
encoding.cabal
View File

@ -25,13 +25,15 @@ Flag newGHC
description: Use ghc version > 6.10 description: Use ghc version > 6.10
Library Library
Build-Depends: binary, extensible-exceptions, HaXml >= 1.22 && < 1.24
if flag(splitBase) if flag(splitBase)
Build-Depends: bytestring, base >= 3 && < 5, mtl, containers, array, regex-compat
if flag(newGHC) if flag(newGHC)
Build-Depends: bytestring, base >= 3 && < 5, binary, mtl, containers, extensible-exceptions, array, regex-compat, ghc-prim, ghc >= 6.10, HaXml >= 1.19 Build-Depends: ghc-prim, ghc >= 6.10
else else
Build-Depends: bytestring, base >= 3 && < 5, binary, mtl, containers, extensible-exceptions, array, regex-compat, ghc < 6.10, HaXml >= 1.19 Build-Depends: ghc < 6.10
else else
Build-Depends: base < 3, binary, extensible-exceptions, HaXml >= 1.19 Build-Depends: base < 3
Exposed-Modules: Exposed-Modules:
Data.Encoding Data.Encoding