diff --git a/property-list.cabal b/property-list.cabal --- a/property-list.cabal +++ b/property-list.cabal @@ -1,5 +1,5 @@ name: property-list -version: 0.0.0.6 +version: 0.0.0.7 stability: experimental license: PublicDomain @@ -10,9 +10,17 @@ maintainer: James Cook homepage: http://code.haskell.org/~mokus/property-list -category: Data, Parsing +category: Data, Parsing, XML synopsis: XML property list parser description: Parser, data type and formatter for Apple's XML property list 1.0 format. + + The bytestring-0.9.1.5 update on hackage seems to have + cratered the build for many packages, including the last + several versions of this one, so this version will + probably not build properly on the hackage site. + As far as I know, though, that is the only reason + it fails. This version includes a hack to try to make + it build on the site, triggered by the HaXml_1_13 build flag. flag new-data-object description: Use the new version of the data-object package (>= 0.0.2) @@ -20,11 +28,35 @@ Object type in previous versions. default: True +flag new-template-haskell + description: Template Haskell 2.4 seems to have made the + generated @PropertyListItem OneOfN@ instances break. + So, detect it and deal with it. + +flag HaXml_1_13 + default: False + description: The Hackage website builder is currently very finicky + and the bytestring-0.9.1.5 update has made me very + frustrated, because the last several versions of this + package have failed to build because of it. + The "preferred-versions" fallback fails too, because + the additional HaXml constraint combined with the + one here becomes unsatisfiable. So, I'm gonna make + this thing work with HaXml 1.13 now. + + And, as an additional hack to make sure it works, + this flag will also trigger dependencies on specific + versions of packages known to have been built against + bytestring-0.9.1.4 on the hackage server. + + Once ghc-6.12 is released, this should no longer be + a problem and I can clean up the mess I've made here. + + Library hs-source-dirs: src exposed-modules: Data.PropertyList other-modules: Data.PropertyList.Xml - Data.PropertyList.Xml.Dtd Data.PropertyList.Type Data.PropertyList.Parse Data.PropertyList.PropertyListItem @@ -34,18 +66,38 @@ bytestring-class, containers, dataenc, - HaXml >= 1.19, mtl, old-locale, pretty, time, - - template-haskell, th-fold + if flag(new-template-haskell) + -- wild guess - template-haskell seems to follow the "even-minors" convention, + -- so put 2.6 as upper version bound. + build-depends: template-haskell >=2.4 && <2.6 + cpp-options: -DNEW_TEMPLATE_HASKELL + else + build-depends: template-haskell <2.4 + + if flag(new-data-object) build-depends: data-object >= 0.0.2 cpp-options: -DNEW_DATA_OBJECT else build-depends: data-object < 0.0.2 - + + if flag(HaXml_1_13) + other-modules: Data.PropertyList.Xml.Dtd_1_13 + cpp-options: -DHaXml_1_13 + build-depends: HaXml >= 1.13 && <1.14, + bytestring == 0.9.1.4, + bytestring-class == 0.0.0, + data-object == 0.0.2, + + utf8-string == 0.3.5 + -- (transitive dependency brought in by bytestring-class) + + else + other-modules: Data.PropertyList.Xml.Dtd + build-depends: HaXml >= 1.19 diff --git a/src/Data/PropertyList/Parse.hs b/src/Data/PropertyList/Parse.hs --- a/src/Data/PropertyList/Parse.hs +++ b/src/Data/PropertyList/Parse.hs @@ -1,5 +1,5 @@ {-# LANGUAGE - TemplateHaskell + TemplateHaskell, CPP #-} module Data.PropertyList.Parse where @@ -7,7 +7,13 @@ import Language.Haskell.TH.Fold import Prelude as P +#ifdef HaXml_1_13 +import Data.PropertyList.Xml.Dtd_1_13 as X +#else import Data.PropertyList.Xml.Dtd as X +import Text.XML.HaXml.XmlContent +#endif + import Data.PropertyList.Xml import Data.PropertyList.Type @@ -18,7 +24,6 @@ import Codec.Binary.Base64 as B64 import Text.XML.HaXml.OneOfN -import Text.XML.HaXml.XmlContent -- |run an incremental parser - a function which takes -- a token type and returns either a subterm (possibly still diff --git a/src/Data/PropertyList/PropertyListItem.hs b/src/Data/PropertyList/PropertyListItem.hs --- a/src/Data/PropertyList/PropertyListItem.hs +++ b/src/Data/PropertyList/PropertyListItem.hs @@ -294,7 +294,12 @@ tyVars = map varT tyVarNames typeWithVars = foldl appT (conT typeName) tyVars - cxt = mapM (appT (conT ''PropertyListItem)) tyVars +#ifdef NEW_TEMPLATE_HASKELL + preds = [classP ''PropertyListItem [tyVar] | tyVar <- tyVars] + context = cxt preds +#else + context = mapM (appT (conT ''PropertyListItem)) tyVars +#endif inst = appT (conT ''PropertyListItem) typeWithVars pl = mkName "pl" @@ -310,7 +315,7 @@ | con <- conNames ] - instanceD cxt inst whre + instanceD context inst whre in mapM mkInstance types ) diff --git a/src/Data/PropertyList/Type.hs b/src/Data/PropertyList/Type.hs --- a/src/Data/PropertyList/Type.hs +++ b/src/Data/PropertyList/Type.hs @@ -65,7 +65,7 @@ -- instance Read... -- |The property-list term algebra type itself, parameterized over the type of --- "structural holes" in the terms. +-- \"structural holes\" in the terms. type PropertyList_ = M (PropertyListS [] (M.Map String)) plArray x = S (PLArray x) diff --git a/src/Data/PropertyList/Xml.hs b/src/Data/PropertyList/Xml.hs --- a/src/Data/PropertyList/Xml.hs +++ b/src/Data/PropertyList/Xml.hs @@ -1,16 +1,22 @@ {-# LANGUAGE - TemplateHaskell + TemplateHaskell, CPP #-} module Data.PropertyList.Xml where import Prelude as P -import Data.PropertyList.Xml.Dtd as X import Text.XML.HaXml.OneOfN +#ifdef HaXml_1_13 +import Data.PropertyList.Xml.Dtd_1_13 as X +import Text.XML.HaXml.Xml2Haskell hiding (showXml, readXml) +import qualified Text.XML.HaXml.Xml2Haskell as X2H +#else +import Data.PropertyList.Xml.Dtd as X import Text.XML.HaXml.XmlContent hiding (showXml, toXml) +#endif import Text.PrettyPrint.HughesPJ (render) import Text.XML.HaXml.Pretty (document) @@ -32,6 +38,27 @@ writePlistToFile path plist = do writeFile path (showXml plist) +#ifdef HaXml_1_13 + +readXml :: String -> Either String Plist +readXml xml = case X2H.readXml xml of + Nothing -> Left "readXml: parse failed" + Just plist -> Right plist + +showXml :: Plist -> String +showXml = X2H.showXml + +toXml :: Plist -> Document +toXml value = + Document (Prolog (Just (XMLDecl "1.0" Nothing Nothing)) [] Nothing []) + emptyST + ( case (toElem value) of + [CElem e] -> e + ) + [] + +#else + -- | Convert a fully-typed XML document to a string (without DTD). showXml :: Plist -> String showXml x = @@ -39,7 +66,6 @@ [CElem _ _] -> (render . document . toXml) x _ -> "" - toXml :: Plist -> Document () toXml value = Document (Prolog (Just (XMLDecl "1.0" Nothing Nothing)) [] Nothing []) @@ -48,6 +74,8 @@ [CElem e ()] -> e ) [] + +#endif plistToPlistItem :: Plist -> PlistItem plistToPlistItem = $(fold ''Plist) diff --git a/src/Data/PropertyList/Xml/Dtd_1_13.hs b/src/Data/PropertyList/Xml/Dtd_1_13.hs new file mode 100644 --- /dev/null +++ b/src/Data/PropertyList/Xml/Dtd_1_13.hs @@ -0,0 +1,207 @@ +{- + - generated by DtdToHaskell (from HaXml 1.13.3) + - altered to fix ambiguities and build errors + - (why is this the "preferred" HaXml version, anyway?) + -} + +module Data.PropertyList.Xml.Dtd_1_13 where + +import Text.XML.HaXml.Xml2Haskell +import Text.XML.HaXml.OneOfN +import Data.Char (isSpace) + +import Prelude (Eq, Show, String, Maybe(..), all, concatMap, (++)) + +{-Type decls-} + +data Plist = PlistArray Plist_Attrs Array + | PlistData Plist_Attrs Data + | PlistDate Plist_Attrs Date + | PlistDict Plist_Attrs Dict + | PlistAReal Plist_Attrs AReal + | PlistAInteger Plist_Attrs AInteger + | PlistAString Plist_Attrs AString + | PlistTrue Plist_Attrs True + | PlistFalse Plist_Attrs False + deriving (Eq,Show) +data Plist_Attrs = Plist_Attrs + { plistVersion :: (Defaultable String) + } deriving (Eq,Show) +newtype Array = Array [(OneOf9 Array Data Date Dict AReal AInteger AString True False)] deriving (Eq,Show) +newtype Dict = Dict [Dict_] deriving (Eq,Show) +data Dict_ = Dict_ Key + (OneOf9 Array Data Date Dict AReal AInteger AString True False) + deriving (Eq,Show) +newtype Key = Key String deriving (Eq,Show) +newtype AString = AString String deriving (Eq,Show) +newtype Data = Data String deriving (Eq,Show) +newtype Date = Date String deriving (Eq,Show) +data True = True deriving (Eq,Show) +data False = False deriving (Eq,Show) +newtype AReal = AReal String deriving (Eq,Show) +newtype AInteger = AInteger String deriving (Eq,Show) + + +{-Instance decls-} + +instance XmlContent Plist where + fromElem (CElem (Elem "plist" as c0):rest) = + case (fromElem c0) of + (Just a,_) -> (Just (PlistArray (fromAttrs as) a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,_) -> (Just (PlistData (fromAttrs as) a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,_) -> (Just (PlistDate (fromAttrs as) a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,_) -> (Just (PlistDict (fromAttrs as) a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,_) -> (Just (PlistAReal (fromAttrs as) a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,_) -> (Just (PlistAInteger (fromAttrs as) a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,_) -> (Just (PlistAString (fromAttrs as) a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,_) -> (Just (PlistTrue (fromAttrs as) a), rest) + (_,_) -> + case (fromElem c0) of + (Just a,_) -> (Just (PlistFalse (fromAttrs as) a), rest) + (_,_) -> + (Nothing, c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (PlistArray as a) = [CElem (Elem "plist" (toAttrs as) (toElem a) )] + toElem (PlistData as a) = [CElem (Elem "plist" (toAttrs as) (toElem a) )] + toElem (PlistDate as a) = [CElem (Elem "plist" (toAttrs as) (toElem a) )] + toElem (PlistDict as a) = [CElem (Elem "plist" (toAttrs as) (toElem a) )] + toElem (PlistAReal as a) = [CElem (Elem "plist" (toAttrs as) (toElem a) )] + toElem (PlistAInteger as a) = [CElem (Elem "plist" (toAttrs as) (toElem a) )] + toElem (PlistAString as a) = [CElem (Elem "plist" (toAttrs as) (toElem a) )] + toElem (PlistTrue as a) = [CElem (Elem "plist" (toAttrs as) (toElem a) )] + toElem (PlistFalse as a) = [CElem (Elem "plist" (toAttrs as) (toElem a) )] +instance XmlAttributes Plist_Attrs where + fromAttrs as = + Plist_Attrs + { plistVersion = defaultA fromAttrToStr "1.0" "version" as + } + toAttrs v = catMaybes + [ defaultToAttr toAttrFrStr "version" (plistVersion v) + ] +instance XmlContent Array where + fromElem (CElem (Elem "array" [] c0):rest) = + (\(a,ca)-> + (Just (Array a), rest)) + (many fromElem c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (Array a) = + [CElem (Elem "array" [] (concatMap toElem a))] +instance XmlContent Dict where + fromElem (CElem (Elem "dict" [] c0):rest) = + (\(a,ca)-> + (Just (Dict a), rest)) + (many fromElem c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (Dict a) = + [CElem (Elem "dict" [] (concatMap toElem a))] +instance XmlContent Dict_ where + fromElem c0 = + case (\(a,ca)-> + (\(b,cb)-> + (a,b,cb)) + (fromElem ca)) + (fromElem c0) of + (Just a,Just b,rest) -> (Just (Dict_ a b), rest) + (_,_,_) -> + (Nothing, c0) + toElem (Dict_ a b) = + (toElem a ++ toElem b) +instance XmlContent Key where + fromElem (CElem (Elem "key" [] c0):rest) = + (\(a,ca)-> + (Just (Key a), rest)) + (definite fromText "text" "key" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (Key a) = + [CElem (Elem "key" [] (toText a))] +instance XmlContent AString where + fromElem (CElem (Elem "string" [] c0):rest) = + (\(a,ca)-> + (Just (AString a), rest)) + (definite fromText "text" "string" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (AString a) = + [CElem (Elem "string" [] (toText a))] +instance XmlContent Data where + fromElem (CElem (Elem "data" [] c0):rest) = + (\(a,ca)-> + (Just (Data a), rest)) + (definite fromText "text" "data" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (Data a) = + [CElem (Elem "data" [] (toText a))] +instance XmlContent Date where + fromElem (CElem (Elem "date" [] c0):rest) = + (\(a,ca)-> + (Just (Date a), rest)) + (definite fromText "text" "date" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (Date a) = + [CElem (Elem "date" [] (toText a))] +instance XmlContent True where + fromElem (CElem (Elem "true" [] []):rest) = + (Just True, rest) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem True = + [CElem (Elem "true" [] [])] +instance XmlContent False where + fromElem (CElem (Elem "false" [] []):rest) = + (Just False, rest) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem False = + [CElem (Elem "false" [] [])] +instance XmlContent AReal where + fromElem (CElem (Elem "real" [] c0):rest) = + (\(a,ca)-> + (Just (AReal a), rest)) + (definite fromText "text" "real" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (AReal a) = + [CElem (Elem "real" [] (toText a))] +instance XmlContent AInteger where + fromElem (CElem (Elem "integer" [] c0):rest) = + (\(a,ca)-> + (Just (AInteger a), rest)) + (definite fromText "text" "integer" c0) + fromElem (CMisc _:rest) = fromElem rest + fromElem (CString _ s:rest) | all isSpace s = fromElem rest + fromElem rest = (Nothing, rest) + toElem (AInteger a) = + [CElem (Elem "integer" [] (toText a))] + + +{-Done-}