property-list 0.0.0.7 → 0.0.1.0

raw patch · 14 files changed

+1206/−590 lines, 14 filesdep +category-extrasdep +sybdep −data-objectdep −utf8-stringdep ~basedep ~bytestringdep ~bytestring-classPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: category-extras, syb

Dependencies removed: data-object, utf8-string

Dependency ranges changed: base, bytestring, bytestring-class, template-haskell

API changes (from Hackage documentation)

Files

• property-list.cabal +22/−64
• src/Data/PropertyList.hs +140/−11
• src/Data/PropertyList/Algebra.hs +265/−0
• src/Data/PropertyList/KeyPath.hs +155/−0
• src/Data/PropertyList/Object.hs +0/−41
• src/Data/PropertyList/Parse.hs +0/−99
• src/Data/PropertyList/PropertyListItem.hs +94/−177
• src/Data/PropertyList/Type.hs +0/−114
• src/Data/PropertyList/Types.hs +198/−0
• src/Data/PropertyList/Xml.hs +84/−84
• src/Data/PropertyList/Xml/Dtd.hs +5/−0
• src/Data/PropertyList/Xml/Dtd_1_13.hs +5/−0
• src/Data/PropertyList/Xml/Parse.hs +122/−0
• src/Data/PropertyList/Xml/Types.hs +116/−0

@@ -1,5 +1,5 @@ name:                   property-list-version:                0.0.0.7+version:                0.0.1.0 stability:              experimental license:                PublicDomain @@ -13,90 +13,48 @@ 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)-                        Which has a "generic object" type in place of the simpler-                        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.-                        +  description:          The Hackage website builder used to be very finicky+                        and the bytestring-0.9.1.5 update frustrated me,+                        because several versions of this package failed to+                        build because of it.  HaXml 1.13 support was added as+                        part of a hack to make it build on the hackage build+                        server.  Hopefully the ghc-6.12 changeover will have+                        fixed things, so I'm eliminating the build hack that+                        was used before.  HaXml-1.13 support remains, though.  Library   hs-source-dirs:       src+  ghc-options:          -fwarn-unused-binds -fwarn-unused-imports   exposed-modules:      Data.PropertyList-  other-modules:        Data.PropertyList.Xml-                        Data.PropertyList.Type-                        Data.PropertyList.Parse+                        Data.PropertyList.Algebra+                        Data.PropertyList.Xml+                        +  other-modules:        Data.PropertyList.Types                         Data.PropertyList.PropertyListItem-                        Data.PropertyList.Object-  build-depends:        base >= 3 && <5,+                        Data.PropertyList.KeyPath+                        Data.PropertyList.Xml.Parse+                        Data.PropertyList.Xml.Types+  build-depends:        base >= 4 && <5,                         bytestring,                         bytestring-class,+                        category-extras,                         containers,                          dataenc,                         mtl,                         old-locale,                         pretty,+                        syb,+                        template-haskell,                         time,                         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)+    build-depends:      HaXml >= 1.13 && <1.14                            else     other-modules:      Data.PropertyList.Xml.Dtd

@@ -1,25 +1,154 @@ module Data.PropertyList-    ( PropertyList-    , PropertyList_+    ( -- * The basic property list types+      -- |Property lists have several supported representations, but the main+      -- one most end users will care about is 'PropertyList'.  This is a basic+      -- algebraic representation of property lists which can be constructed+      -- using the polymorphic constructors described below and pattern-matched+      -- using the polymorphic destructors (designed for convenient usage with+      -- the ViewPatterns extension)+      --+      -- Also provided is the 'PartialPropertyList' representation, which is +      -- a property list that is extended by adding a new constructor containing+      -- some arbitrary type chosen by the user.  It is mostly used as an+      -- intermediate represenation for property lists that have been parsed+      -- into their overall shape but not all elements have been parsed into+      -- their final format.+      -- +      -- The 'UnparsedPlistItem' type is the type most often used with+      -- 'PartialPropertyList', and that is really its only purpose - to+      -- represent unparseable items from an XML plist during intermediate+      -- stages of translation.+      PropertyList+    , PartialPropertyList+    , PropertyListS(..)     , UnparsedPlistItem(..)+      +    -- * Constructors and destructors for property lists+    -- |The \"pl*\" operations construct 'PropertyList's, 'PartialPropertyList's, +    -- or any other types defining an unlifted algebra for the 'PropertyListS'+    -- signature.+    --+    -- The \"fromPl*\" operations are ViewPattern matching operations for+    -- 'PropertyList', 'PartialPropertyList', or any other type defining+    -- a 'Maybe'-lifted coalgebra for 'PropertyListS'.+    --+    -- The generality of these operations means that they can also be used+    -- to directly generate or analyze \"external\" formats such as the XML+    -- 'Plist' representation.+    , plArray,   fromPlArray+    , plData,    fromPlData+    , plDate,    fromPlDate+    , plDict,    fromPlDict+    , plReal,    fromPlReal+    , plInt,     fromPlInt+    , plString,  fromPlString+    , plBool,    fromPlBool+    +    -- * The internal algebraic model for property lists+    -- | Internally, conversions between various property list representations +    -- are all defined in terms of universal algebra, which is basically just+    -- fancy math-talk for \"very general interfaces that let you convert between +    -- certain kinds of representations easily and efficiently\".  +    -- +    -- Most users do not need to understand this stuff - the class names are+    -- only exported because they appear in the types of the constructors and+    -- destructors.  For more detailed info, see "Data.PropertyList.Algebra".+    , PListAlgebra, PListCoalgebra+    , InitialPList, TerminalPList++    -- * Parsing and formatting property lists using any supported format+    , readPropertyList+    , showPropertyList+         , readPropertyListFromFile     , writePropertyListToFile     +    -- * Parsing and formatting property lists using the XML format+    , readXmlPropertyList+    , showXmlPropertyList+    +    , readXmlPropertyListFromFile+    , writeXmlPropertyListToFile+    +    -- * Manipulating property lists+    -- +    -- |This module exports a class ('PropertyListItem') and several functions+    -- used to manipulate 'PropertyList's and their contents at a high level,+    -- viewing and manipulating the data in the tree through ad-hoc +    -- transformations.+    -- +    -- For example, consider the following property list:+    --+    -- > myPlist = plDict $ M.fromList+    -- >    [ ("foo", plInt 4)+    -- >    , ("bar", plString "qux")+    -- >    , ("subDict", plDict $ M.fromList+    -- >         [ ("item 1", plString "This is item 1!")+    -- >         , ("item B", plBool True)+    -- >         ])+    -- >    ] :: PropertyList+    -- +    -- Some typical actions you might do with a plist like this (Note that+    -- in many cases a 'Just' is added - this is because the key-path operations+    -- are defined in terms of 'Maybe' so that operations like 'setItemAtKeyPath'+    -- or 'alterItemAtKeyPath' can create new items where none already exist):+    -- +    -- > getItemAtKeyPath ["subDict", "item B"] (Just myPlist) :: Maybe Bool+    -- +    --      (returns @Just True@)+    -- +    -- > getItemAtKeyPath ["subDict"] (Just myPlist) :: M.Map String String+    -- +    --      (returns @M.fromList [(\"item 1\", \"This is item 1!\"), (\"item B\", \"YES\")]@.  +    --       Note the stringification of non-string items.  In general, 'PropertyListItem'+    --       instances are expected to do \"reasonable\" conversions to try and make sense+    --       of what the user is asking the system to do.)+    -- +    -- > setItemAtKeyPath ["omg", "lolwut"] (Just "roflcopter") (Just myPlist)+    -- +    --      (returns a modified version of @myPlist@ with +    --      @plDict $ M.fromList [(\"omg\", plDict $ M.fromList [(\"omg\", +    --       plDict $ M.fromList [(\"lolwut\", plString \"roflcopter\")])])]@+    --       added to the root dictionary)+    --+    -- > setItemAtKeyPath ["foo"] Nothing (Just myPlist)+    -- +    --      (returns a modified version of @myPlist@ with the \"foo\" entry in the+    --       root dictionary deleted)+    -- +    -- > setItemAtKeyPath ["foo", "bar", "baz"] (Just "qux") Nothing+    -- +    --      (returns a new dictionary with @plString \"qux\"@ at the key path foo.bar.baz)+    --+     , module Data.PropertyList.PropertyListItem+    , module Data.PropertyList.KeyPath     ) where -import Data.PropertyList.Type-import Data.PropertyList.Parse+import Data.PropertyList.Algebra+import Data.PropertyList.Types import Data.PropertyList.Xml-import Data.PropertyList.Object ({- ToObject instances -})  import Data.PropertyList.PropertyListItem+import Data.PropertyList.KeyPath -readPropertyListFromFile :: FilePath -> IO (Either String PropertyList)-readPropertyListFromFile file = do-        x <- readPlistFromFile file-        return (fmap plistToPropertyList x)+-- | Read a property list from a 'String', trying all supported property list formats.+-- Presently, only the \"XML1\" format is supported.  See also 'readXmlPropertyList'.+readPropertyList :: String -> Either String PropertyList+readPropertyList = readXmlPropertyList +-- | Write a property list to a 'String', using a \"preferred\" property list format.+-- Presently, that is the \"XML1\" format.  See also 'showXmlPropertyList'.+showPropertyList :: PropertyList -> String+showPropertyList = showXmlPropertyList++-- | Read a property list from a file, trying all supported property list formats.+-- Presently, only the \"XML1\" format is supported.  See also+-- 'readXmlPropertyListFromFile'.+readPropertyListFromFile :: FilePath -> IO PropertyList+readPropertyListFromFile = readXmlPropertyListFromFile++-- | Write a property list to a file, using a \"preferred\" property list format.+-- Presently, that is the \"XML1\" format.  See also 'writeXmlPropertyListToFile'. writePropertyListToFile :: FilePath -> PropertyList -> IO ()-writePropertyListToFile file plist = do-        writePlistToFile file (propertyListToPlist unparsedPlistItemToPlistItem plist)+writePropertyListToFile = writeXmlPropertyListToFile

@@ -0,0 +1,265 @@+{-# LANGUAGE +    MultiParamTypeClasses, FunctionalDependencies,+    TemplateHaskell,+    FlexibleContexts+  #-}++-- |The internal \"algebraic\" interface for working with property-list-like+-- things.  The classes defined here are the basis for a very general system+-- supporting transformations between many property-list representations,+-- including both internal and external formats.  The transformations are+-- based on algebra and are very well-behaved mathematically.  It is possible+-- to \"fuse\" operations so that, for example, reading from XML and writing+-- to a text plist can be done without creating any intermediate +-- representations other than those used by the XML parser and the text +-- renderer.  Or, expressions using the \"smart constructors\" can be+-- evaluated to directly synthesize XML-formatted plists, or the view-pattern+-- destructors can be used to directly analyze them.+-- +-- The interface defined in this module is very heavily influenced by +-- category-theoretical constructions.  In particular, F-algebras and +-- F-coalgebras, initiality, and terminality.  For those not familiar with+-- these concepts, this will probably be quite incomprehensible.  Sorry+-- about that.  The basic idea, though, is the use of the 'PropertyListS' +-- type as a sort of a central junction point through which all conversions+-- between property-list-like types and property-list-item types are routed.+-- The classes defined here are chosen to minimize the inderdependence of+-- these types and hence maximize the flexibility of the system as a whole.+--+-- More simply stated, these weird math thingies make the design+-- as flexible as possible (in a well-defined and useful sense).+module Data.PropertyList.Algebra where++import Control.Applicative+import Control.Monad.Identity+import Data.Foldable (Foldable(foldMap))+import Data.Traversable (Traversable(..))+import Data.Monoid++import Language.Haskell.TH.Fold (fold)++import qualified Data.Map as M+import Data.ByteString as B hiding (map)+import Data.Time++-- * The signature type ('PropertyListS')++-- |The signature of the base property list algebra.  This algebra is +-- \"lifted\" in various ways to support several different but similar+-- representations of property lists as well as projections and+-- injections.  All the different representations are 'connected' through+-- this signature.+-- +-- For example, 'PropertyList' is a fixed-point of this signature - that+-- is, a recursive version where @a@ is instantiated as @'PropertyListS' a@.+-- That gives the \"expected\" structure of a basic property list.  It is both+-- initial and terminal for this signature in its 'un-lifted' form - which+-- is to say, any other type with an algebra for this signature (such as an +-- XML representation) can be made from a 'PropertyList', and any type with+-- a coalgebra for this signature (such as a 'String', an 'Integer', etc.)+-- can be converted directly to a 'PropertyList'.  This also means that any+-- transformation or series of transformations involving the 'PropertyList'+-- type can be fused to \"skip\" generating intermediate property lists, +-- although there are currently no rewrite rules set up to do so.+--+-- Similarly, 'PartialPropertyList' is a fixed point of an arbitrarily-+-- augmented version of this signature (also known as the free monad +-- generated by the signature).  Depending on its type parameter, +-- 'PartialPropertyList' can be terminal among many simple extensions to +-- the signature.  Thus many types with a coalgebra for an extension of +-- this signature (such as XML given an appropriate tree destructor, or +-- the 'PropertyList' type itself)  can be trivially converted to a +-- 'PartialPropertyList'.+data PropertyListS a+    = PLArray [a]+    | PLData ByteString+    | PLDate UTCTime+    | PLDict  (M.Map String a)+    | PLReal Double+    | PLInt Integer+    | PLString String+    | PLBool Bool+    deriving (Eq, Ord, Show, Read)++-- |Construct a basic non-recursive algebra of property list items.+-- This is equivalent to pattern matching on 'PropertyListS'.+foldPropertyListS :: ([a] -> t)+                  -> (ByteString -> t)+                  -> (UTCTime -> t)+                  -> (M.Map String a -> t)+                  -> (Double -> t)+                  -> (Integer -> t)+                  -> (String -> t)+                  -> (Bool -> t) +                  -> PropertyListS a -> t+foldPropertyListS = $(fold ''PropertyListS)++instance Functor PropertyListS where+    fmap f = foldPropertyListS (PLArray . fmap f) PLData PLDate (PLDict . fmap f) PLReal PLInt PLString PLBool++instance Foldable PropertyListS where+    foldMap f = foldPropertyListS (foldMap f) mempty mempty (foldMap f) mempty mempty mempty mempty++instance Traversable PropertyListS where+    sequenceA = foldPropertyListS (fmap PLArray . sequenceA) (pure . PLData) (pure . PLDate) (fmap PLDict . sequenceA) (pure . PLReal) (pure . PLInt) (pure . PLString) (pure . PLBool)++-- * The algebra and coalgebra classes++-- |A class for types which can be constructed algebraically from the+-- 'PropertyListS' signature (lifted by @f@) - in other words, types which+-- you can put property lists into.+-- +-- The @f@-lifting is provided to support extending the algebra.  The algebra+-- is defined in a class rather than passing around functions because most of+-- the time for any given type there is only one algebra you care about.+--+-- Typically a renderer for an output format will be implemented as a type+-- with an @instance 'PListAlgebra' 'Identity'@.  For example, the XML +-- output system is implemented in the @instance 'PListAlgebra' 'Identity' +-- 'Data.PropertyList.Xml.Types.Plist'@.+class Functor f => PListAlgebra f a where+    -- |Build a value of type @a@ from a piece of a property list (using+    -- the 'PropertyListS' signature augmented by the \"lifting\" @f@).+    plistAlgebra :: f (PropertyListS a) -> a++-- |An identification of the fact that the type @a@ has an initial plist algebra+-- (under some lifting @f@).  Functional dependencies are in use - for any +-- type, only one of its initial algebras (if multiple apply, which they may+-- because the same type may be initial for multiple distinct liftings)+-- can be chosen, and for any lifting only one type's algebra may be chosen.+-- This is to make types decidable in the not-so-uncommon case where the+-- lifting is encapsulated (eg, any time 'foldPList' is partially applied+-- - for example, see the signature of 'fromPlist').+-- +-- For cases where the lifting either needs to be chosen or needs to be+-- transformed to another lifting, 'fromPlistWith' is provided.  It is based+-- on the same definition as the default implementation of 'foldPList' but+-- also inserts a chosen transformation of the lifting.+-- +-- Question for self: Is the PListCoalgebra context reasonable here?  +-- Some rough calculations suggest that in the presence of fixed point +-- type operators, it is possible to construct a PListCoalgebra for any +-- InitialPList, which essentially is defined as pattern matching.  So, +-- I'm not totally sure but I think this is reasonable - at least, for+-- finitary signatures, which we're using as long as @f@ doesn't go crazy.+class (PListAlgebra f a, PListCoalgebra f a) => InitialPList f a | f -> a, a -> f where+    -- |Using some other plist algebra, compute the unique transformation from+    -- the type @a@ to that algebra.+    -- +    -- The default implementation is:+    --+    -- > foldPList f = go+    -- >    where+    -- >        go = f . fmap (fmap go) . plistCoalgebra+    --+    foldPList :: (f (PropertyListS t) -> t) -> a -> t+    foldPList f = go+        where+            go = f . fmap (fmap go) . plistCoalgebra++-- |Convert from an initial plist to any other plist with the same lifted algebra.+fromPlist :: (InitialPList f pl, PListAlgebra f t) => pl -> t+fromPlist = foldPList plistAlgebra++-- If the transformation is natural, this is equivalent to 'toPlistWith'.  I think.+fromPlistWith :: (PListCoalgebra f pl, PListAlgebra g t) => (f (PropertyListS t) -> g (PropertyListS t)) -> pl -> t+fromPlistWith lift = fold+    where+        fold = plistAlgebra . lift . fmap (fmap fold) . plistCoalgebra++-- |A class for types which can be dissected (pattern-matched) into the+-- 'PropertyListS' signature (lifted by @f@) - in other words, types which+-- you can take property lists out of.+--+-- Typically a property list parser will be implemented as a type with a+-- 'PListCoalgebra' instance, where @f@ is either 'Identity' in the case where+-- the parser guarantees to return a fully well-formed property list +-- (assuming it returns anything at all) or 'Either' @something@ when the +-- parser only guarantees that the structure is sound (but that some elements+-- might be defective, in which case a value of type @something@ would be +-- substituted).  The XML parser, for example, is based on the latter +-- approach, where @something@ is 'UnparsedPlistItem'.+class Functor f => PListCoalgebra f a where+    -- |Analyze a value of type @a@ by matching it to a constructor in the+    -- (lifted by @f@) 'PropertyListS' signature.+    plistCoalgebra :: a -> f (PropertyListS a)++-- |Chosen terminal coalgebra for the given lifting, and chosen lifting+-- for the given type.  See also 'InitialPList'.+class (PListCoalgebra f a, PListAlgebra f a) => TerminalPList f a | f -> a, a -> f where+    -- |Given some coalgebra for the chosen lifted plist signature, compute+    -- the unique extraction/unfolding of that coalgebra into the type @a@.+    -- +    -- The default implementation is:+    -- +    -- > unfoldPList f = go+    -- >     where+    -- >         go = plistAlgebra . fmap (fmap go) . f+    -- +    unfoldPList :: (t -> f (PropertyListS t)) -> t -> a+    unfoldPList f = go+        where+            go = plistAlgebra . fmap (fmap go) . f++-- |Convert from any plist-like thing to a plist which is terminal for a some lifted algebra.+toPlist :: (PListCoalgebra f t, TerminalPList f pl) => t -> pl+toPlist = unfoldPList plistCoalgebra++-- If the transformation is natural, this is equivalent to 'fromPlistWith'.  I think.+toPlistWith :: (PListCoalgebra f t, PListAlgebra g pl) => (f (PropertyListS t) -> g (PropertyListS t)) -> t -> pl+toPlistWith lift = unfold+    where+        unfold = plistAlgebra . fmap (fmap unfold) . lift . plistCoalgebra+        ++-- * \"Smart\" constructors for any 'PListAlgebra'.++plArray :: (PListAlgebra Identity a) => [a] -> a+plArray     x   = plistAlgebra (Identity $ PLArray  x)++plData :: (PListAlgebra Identity a) => ByteString -> a+plData      x   = plistAlgebra (Identity $ PLData   x)++plDate :: (PListAlgebra Identity a) => UTCTime -> a+plDate      x   = plistAlgebra (Identity $ PLDate   x)++plDict :: (PListAlgebra Identity a) => M.Map String a -> a+plDict      x   = plistAlgebra (Identity $ PLDict   x)++plReal :: (PListAlgebra Identity a) => Double -> a+plReal      x   = plistAlgebra (Identity $ PLReal   x)++plInt :: (PListAlgebra Identity a) => Integer -> a+plInt       x   = plistAlgebra (Identity $ PLInt    x)++plString :: (PListAlgebra Identity a) => String -> a+plString    x   = plistAlgebra (Identity $ PLString x)++plBool :: (PListAlgebra Identity a) => Bool -> a+plBool      x   = plistAlgebra (Identity $ PLBool   x)++-- * \"View pattern\" destructors for any 'PListCoalgebra'.++fromPlArray :: PListCoalgebra Maybe a => a -> Maybe [a]+fromPlArray pl = do PLArray a <- plistCoalgebra pl; return a++fromPlData :: PListCoalgebra Maybe a => a -> Maybe ByteString+fromPlData pl = do PLData a <- plistCoalgebra pl; return a++fromPlDate :: PListCoalgebra Maybe a => a -> Maybe UTCTime+fromPlDate pl = do PLDate a <- plistCoalgebra pl; return a++fromPlDict :: PListCoalgebra Maybe a => a -> Maybe (M.Map String a)+fromPlDict pl = do PLDict a <- plistCoalgebra pl; return a++fromPlReal :: PListCoalgebra Maybe a => a -> Maybe Double+fromPlReal pl = do PLReal a <- plistCoalgebra pl; return a++fromPlInt :: PListCoalgebra Maybe a => a -> Maybe Integer+fromPlInt pl = do PLInt a <- plistCoalgebra pl; return a++fromPlString :: PListCoalgebra Maybe a => a -> Maybe String+fromPlString pl = do PLString a <- plistCoalgebra pl; return a++fromPlBool :: PListCoalgebra Maybe a => a -> Maybe Bool+fromPlBool pl = do PLBool a <- plistCoalgebra pl; return a

@@ -0,0 +1,155 @@+{-# LANGUAGE+        ViewPatterns+  #-}+module Data.PropertyList.KeyPath +    ( alterItemAtKeyPathM, alterItemAtKeyPath+    , getItemAtKeyPath, setItemAtKeyPath+    ) where++import Data.PropertyList.Algebra+import Data.PropertyList.Types (PropertyList)+import Data.PropertyList.PropertyListItem++import qualified Data.Map as M++import Control.Monad.Identity+import Control.Monad.State++-- |Alter a @'Maybe' 'PropertyList'@, viewing it as an instance of 'PropertyListItem'+-- and re-synthesizing it from a (possibly different) instance of 'PropertyListItem'.+-- Input and output are lifted by 'Maybe' in order to support adding or deleting of+-- items (as this function is used inside the key-path based versions)+--+-- Actually only needs 'Functor', not 'Monad' but since it's not exported+-- and is only used in 'Monad' contexts, I'm using 'Monad' to avoid needing+-- to add 'Functor' to those other contexts.+{-# INLINE alterPropertyListM #-}+alterPropertyListM ::+     (Monad m, PropertyListItem i, PropertyListItem i') +     => (Maybe i -> m (Maybe i'))+     -> Maybe PropertyList -> m (Maybe PropertyList)+alterPropertyListM f = liftM (fmap toPropertyList) . f . (>>= fromPropertyList)++-- |Alter the contents of a dictionary (represented as a M.Map String), +-- viewing its values through the 'PropertyListItem' class.+--+-- If the result of the alteration is 'Nothing', and the resulting dictionary+-- is empty, the result of the whole operation is 'Nothing' (causing cascading+-- deletion of empty key paths in 'alterDictionaryEntryM' et al.)+{-# INLINE alterDictionaryEntryM #-}+alterDictionaryEntryM ::+    (Monad m, PropertyListItem i, PropertyListItem i') +    => String -> (Maybe i -> m (Maybe i'))+    -> Maybe (M.Map String PropertyList) -> m (Maybe (M.Map String PropertyList))+alterDictionaryEntryM k f Nothing = do+    i' <- f Nothing+    return (fmap (M.singleton k . toPropertyList) i')+alterDictionaryEntryM k f (Just dict) = do+    let (dict', i) = case M.splitLookup k dict of+            (pre, v, post) -> (M.union pre post, fromPropertyList =<< v)+    +    i' <- f i+    return $ case i' of+        Nothing+            | M.null dict'  -> Nothing+            | otherwise     -> Just dict'+        Just i'' -> Just (M.insert k (toPropertyList i'') dict)++-- |Attempt to view a 'PropertyList' as a 'M.Map String' and, if successful,+-- modify an entry of the dictionary (by calling 'alterDictionaryEntryM').+-- If not possible, 'fail's.+--+-- If the result of the alteration is 'Nothing', and the resulting dictionary+-- is empty, that dictionary is deleted in the result.+{-# SPECIALIZE tryAlterDictionaryEntryM :: (PropertyListItem i, PropertyListItem i')+                                        => String +                                        -> (Maybe i -> Identity (Maybe i'))+                                        -> Maybe PropertyList -> Identity (Maybe PropertyList)+  #-}+{-# SPECIALIZE tryAlterDictionaryEntryM :: (PropertyListItem i)+                                        => String +                                        -> (Maybe i -> StateT (Maybe i) Maybe (Maybe i))+                                        -> Maybe PropertyList -> StateT (Maybe i) Maybe (Maybe PropertyList)+  #-}+tryAlterDictionaryEntryM ::+    (Monad m, PropertyListItem i, PropertyListItem i') +    => String -> (Maybe i -> m (Maybe i'))+    -> Maybe PropertyList -> m (Maybe PropertyList)+tryAlterDictionaryEntryM k f Nothing = do+    d' <- alterDictionaryEntryM k f Nothing+    return (fmap plDict d')+tryAlterDictionaryEntryM k f (Just (fromPlDict -> Just d)) = do+    d' <- alterDictionaryEntryM k f (Just d)+    return (fmap plDict d')+tryAlterDictionaryEntryM k f other = fail "Key path tries to pass through non-dictionary thing."++-- |@alterItemAtKeyPathM path f@ applies the function @f@ deep inside the +-- 'PropertyList' on the property list item at the given key-path @path@+-- (if possible).  This is the same notion of key path as is used in the +-- Apple plist APIs - each component of the path indicates descending +-- into a dictionary by selecting the element with that key (if any).  If a +-- key is not found, it is created.  If a key is found but is not a +-- dictionary, the operation fails (with 'fail' from the 'Monad' class).+-- +-- If the result of @f@ is 'Nothing', and the resulting dictionary is empty,+-- that dictionary is deleted in the result (and any empty parent dictionaries).+-- If this is not the behavior you want, you should alter the parent dictionary +-- itself and return an empty one.+{-# SPECIALIZE alterItemAtKeyPathM :: (PropertyListItem i, PropertyListItem i')+                                   => [String] +                                   -> (Maybe i -> Identity (Maybe i'))+                                   -> Maybe PropertyList -> Identity (Maybe PropertyList)+  #-}+{-# SPECIALIZE alterItemAtKeyPathM :: (PropertyListItem i)+                                   => [String] +                                   -> (Maybe i -> StateT (Maybe i) Maybe (Maybe i))+                                   -> Maybe PropertyList -> StateT (Maybe i) Maybe (Maybe PropertyList)+  #-}+alterItemAtKeyPathM ::+    (Monad m, PropertyListItem i, PropertyListItem i')+    => [String] -> (Maybe i -> m (Maybe i'))+    -> Maybe PropertyList -> m (Maybe PropertyList)+alterItemAtKeyPathM [] f = alterPropertyListM f+alterItemAtKeyPathM (k:ks) f = tryAlterDictionaryEntryM k (alterItemAtKeyPathM ks f)++-- |@alterItemAtKeyPath path f@ applies the function @f@ deep inside the +-- 'PropertyList' on the property list item at the given key-path @path@+-- (if possible).  This is the same notion of key path as is used in the +-- Apple plist APIs - namely, each component of the path indicates descending +-- into a dictionary by selecting the element with that key (if any).  If a +-- key is not found, it is created.  If a key is found but is not a +-- dictionary, the operation fails (with 'error').+-- +-- If the result of @f@ is 'Nothing', and the resulting dictionary is empty,+-- that dictionary is deleted in the result (and any empty parent dictionaries).+-- If this is not the behavior you want, you should alter the parent dictionary +-- itself and return an empty one.+alterItemAtKeyPath :: +    (PropertyListItem i, PropertyListItem i')+    => [String] -> (Maybe i -> Maybe i')+    -> Maybe PropertyList -> Maybe PropertyList+alterItemAtKeyPath path f = runIdentity . alterItemAtKeyPathM path (Identity . f)++-- |Gets the item, if any (and if convertible to the required type), +-- at a given key path.  If the key path passes through something that +-- is not a dictionary, the operation returns 'Nothing'.+getItemAtKeyPath :: PropertyListItem i =>+    [String] -> Maybe PropertyList -> Maybe i+    -- works by running a StateT (Maybe i) Maybe operation at the keypath.+    -- The operation captures the value it is passed and 'put's it into the+    -- state.  The result is the final state of the operation 'join'ed to+    -- the success/failure in the underlying 'Maybe' monad (which is why+    -- we use 'StateT' instead of just 'State' - the latter would cause+    -- failure by 'error' since it's equivalent to @'StateT' s 'Identity'@).+getItemAtKeyPath path plist = join $ execStateT +    (alterItemAtKeyPathM path (\e -> put e >> return e) plist)+    Nothing++-- |Sets the item at a given key-path.  If the key path does not exist, it is+-- created.  If it exists but passes through something that is not a dictionary,+-- the operation fails (with 'error')+setItemAtKeyPath :: PropertyListItem i =>+    [String] -> Maybe i -> Maybe PropertyList -> Maybe PropertyList+setItemAtKeyPath path value plist = alterItemAtKeyPath path +    (\e -> value `asTypeOf` e) plist+

@@ -1,41 +0,0 @@-{-# LANGUAGE -        FlexibleContexts, UndecidableInstances-  #-}-module Data.PropertyList.Object ({- instances only -}) where--import Data.Object-import Data.PropertyList.Type-import Data.PropertyList.Parse-import Data.PropertyList.Xml-import qualified Data.Map as M-import Control.Monad-import Control.Monad-import Control.Monad.Error--instance ToScalar UnparsedPlistItem where-    toScalar = toScalar . showXml . plistItemToPlist . unparsedPlistItemToPlistItem-instance ToObject UnparsedPlistItem where-    toObject = Scalar . toScalar--instance (ToObject (l a), ToObject (m a)) => ToObject (PropertyListS l m a) where-    toObject (PLArray a)    = toObject a-    toObject (PLData bs)    = toObject bs-    toObject (PLDate d)     = showToObject d-    toObject (PLDict d)     = toObject d-    toObject (PLReal d)     = showToObject d-    toObject (PLInt i)      = showToObject i-    toObject (PLString s)   = toObject s-    toObject (PLBool b)     = showToObject b--instance (ToObject (f (M f a)), ToObject a) => ToObject (M f a) where-    toObject (S x) = toObject x-    toObject (V a) = toObject a--instance (ToScalar k, ToObject v) => ToObject (M.Map k v) where-    toObject = toObject . M.assocs--showToObject :: Show a => a -> Object-showToObject = toObject . show--test :: Object-test = toObject (undefined :: PropertyList)

@@ -1,99 +0,0 @@-{-# LANGUAGE -    TemplateHaskell, CPP-  #-}--module Data.PropertyList.Parse where--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--import qualified Data.Map as M-import Data.ByteString as B hiding (map)-import Data.Time-import System.Locale-import Codec.Binary.Base64 as B64--import Text.XML.HaXml.OneOfN---- |run an incremental parser - a function which takes--- a token type and returns either a subterm (possibly still--- containing unparsed tokens) or an unparseable token (possibly--- a new token, maybe even of a new type).  This interpretation--- of the action of this function is based on a term-algebra--- view of the monad in question, where the 'variable' sort--- consists of unparsed fragments of the source data.-parseT :: Monad t => (a -> Either (t a) b) -> a -> t b-parseT f = parse-        where parse token =-                either (>>= parse) return (f token)--unparsedPlistItemToPlistItem :: UnparsedPlistItem -> PlistItem-unparsedPlistItemToPlistItem = $(fold ''UnparsedPlistItem)-        (TwoOf9   . Data    )-        (ThreeOf9 . Date    )-        (SixOf9   . AInteger)-        (FiveOf9  . AReal   )--plistToPropertyList :: Plist -> PropertyList-plistToPropertyList = parseT parsePlistItem . plistToPlistItem--plistItemToPropertyList :: PlistItem -> PropertyList-plistItemToPropertyList = plistToPropertyList . plistItemToPlist--parsePlistItem :: PlistItem -> Either (PropertyList_ PlistItem) UnparsedPlistItem-parsePlistItem item = case item of-        OneOf9   (Array x   )   -> accept plArray (map return x)-        TwoOf9   (Data x    )   -> case decode x of -                Just d                  -> accept plData (pack d)-                Nothing                 -> reject UnparsedData x-        ThreeOf9 (Date x    )   -> case parseTime defaultTimeLocale dateFormat x of-                Just t                  -> accept plDate t-                Nothing                 -> reject UnparsedDate x-        FourOf9  (Dict x    )   -> accept plDict (M.fromList [ (k, return v) | Dict_ (Key k) v <- x])-        FiveOf9  (AReal x   )   -> tryRead plReal UnparsedReal x-        SixOf9   (AInteger x)   -> tryRead plInt  UnparsedInt x-        SevenOf9 (AString  x)   -> accept plString x-        EightOf9 (X.True    )   -> accept plBool P.True-        NineOf9  (X.False   )   -> accept plBool P.False-        -        where-                accept :: (a -> b) -> a -> Either b c-                accept con = Left  . con-                -                reject :: (a -> c) -> a -> Either b c-                reject con = Right . con-                -                tryRead :: Read a => (a -> b) -> (String -> c) -> String -> Either b c-                tryRead onGood onBad str =-                        case reads str of-                                ((result, ""):_) -> accept onGood result-                                _                -> reject onBad  str-                       -               -dateFormat :: String-dateFormat = "%FT%TZ"--propertyListToPlist :: (a -> PlistItem) -> PropertyList_ a -> Plist-propertyListToPlist fromOther = plistItemToPlist . propertyListToPlistItem fromOther--propertyListToPlistItem :: (a -> PlistItem) -> PropertyList_ a -> PlistItem-propertyListToPlistItem fromOther = foldPropertyList-          (\x -> OneOf9 (Array x)-        ) (\x -> TwoOf9 (Data (encode (unpack x)))-        ) (\x -> ThreeOf9 (Date (formatTime defaultTimeLocale dateFormat x))-        ) (\x -> FourOf9 (Dict [Dict_ (Key k) v | (k,v) <- M.toList x])-        ) (\x -> FiveOf9 (AReal (show x))-        ) (\x -> SixOf9 (AInteger (show x))-        ) (\x -> SevenOf9 (AString x)-        ) (\x -> if x then EightOf9 X.True else NineOf9 X.False-        ) fromOther

@@ -1,37 +1,75 @@ {-# LANGUAGE+    MultiParamTypeClasses,     TypeSynonymInstances,     FlexibleInstances,-    GeneralizedNewtypeDeriving,-    TemplateHaskell, CPP+    TemplateHaskell, CPP,+    ViewPatterns   #-} -module Data.PropertyList.PropertyListItem where+module Data.PropertyList.PropertyListItem+    (PropertyListItem(..)) where  import Language.Haskell.TH import Language.Haskell.TH.Syntax import Language.Haskell.TH.Fold -import Data.PropertyList.Type+import Data.PropertyList.Algebra+import Data.PropertyList.Types  import qualified Data.Map as M import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as Lazy (ByteString)-import Data.ByteString.Lazy.Char8 (pack, unpack) import Data.ByteString.Class import Data.Time import Data.Char+import Data.Int+import Data.Word  import Text.XML.HaXml.OneOfN  import Control.Monad-import Control.Monad.State+import Control.Monad.Identity+import qualified Data.Traversable as Traversable+import Data.Generics -import Data.Object+-- * some local utility functions --- |A class for items which can be converted to and from property lists+-- try to read a string to some other format using the Read instance+-- and failing gracefully+tryRead :: Read a => String -> Maybe a+tryRead s = case reads s of+    [(d, "")] -> Just d+    _ -> Nothing++-- try to convert a fractional type to an integral type without loss of precision.+-- in case of loss of precision, the conversion fails.+tryToIntegral :: (RealFrac a, Integral b) => a -> Maybe b+tryToIntegral d = case properFraction d of+    (i, 0) -> Just i+    _ -> Nothing++--+--fmapM f m = fmap M.fromList $ +--    sequence [ do { v <- f v; return (k, v)}+--             | (k, v) <- M.toList m ]++-- |A class for items which can be converted to and from property lists.  This+-- is more general than 'PListAlgebra' and 'PListCoalgebra', in that it allows+-- for transformations that are not primitive-recursive.  This relaxation is+-- necessary and desirable in the 'PropertyListItem' situation because we are +-- more interested in composable injection/projection operations on than in+-- universal maps.+--+-- The algebraic interface also cannot work for arrays or dictionaries,+-- because it only allows primitive (co-)recursion - the conversions can only+-- operate on one "layer" of 'PropertyListS' at a time.  This could be +-- handled by enlarging the types (from [t] to Either t [t], for example)+-- or by encoding in-band (by taking a singleton list to be an element +-- instead of a list, for example), but both of those \"solutions\" create+-- headaches of their own, and in any case the algebraic interface is probably+-- too bizarre for most users. class PropertyListItem i where-    -- |Convert the item to a property list, usually by simply wrapping the-    -- value with the appropriate 'PropertyList_' constructor+    -- |Construct a 'PropertyList' from the item.     toPropertyList :: i -> PropertyList          -- |Convert a property list to a property list item if its contents@@ -50,224 +88,103 @@     listToPropertyList      = plArray . map toPropertyList          listFromPropertyList :: PropertyList -> Maybe [i]-    listFromPropertyList (S (PLArray x))    = mapM fromPropertyList x-    listFromPropertyList _ = Nothing+    listFromPropertyList (fromPlArray -> Just x)    = mapM fromPropertyList x+    listFromPropertyList _                          = Nothing  instance PropertyListItem a => PropertyListItem [a] where     toPropertyList = listToPropertyList     fromPropertyList = listFromPropertyList -{-# SPECIALIZE alterPropertyListM :: Monad m => (Maybe (M.Map String PropertyList) -> m (Maybe (M.Map String PropertyList)))-                    -> Maybe PropertyList -> m (Maybe PropertyList) #-}-alterPropertyListM ::-    (Monad m, PropertyListItem i, PropertyListItem i') -    => (Maybe i -> m (Maybe i'))-    -> Maybe PropertyList -> m (Maybe PropertyList)-alterPropertyListM f plist = do-    i' <- f (plist >>= fromPropertyList)-    return (fmap toPropertyList i')--{-# SPECIALIZE alterDictionaryEntryM :: Monad m => String -> (Maybe PropertyList -> m (Maybe PropertyList))-                    -> Maybe (M.Map String PropertyList) -> m (Maybe (M.Map String PropertyList)) #-}-alterDictionaryEntryM ::-    (Monad m, PropertyListItem i, PropertyListItem i') -    => String -> (Maybe i -> m (Maybe i'))-    -> Maybe (M.Map String PropertyList) -> m (Maybe (M.Map String PropertyList))-alterDictionaryEntryM k f Nothing = do-    i' <- f Nothing-    return (fmap (M.singleton k . toPropertyList) i')-alterDictionaryEntryM k f (Just dict) = do-    let (dict', i) = case M.splitLookup k dict of-            (pre, v, post) -> (M.union pre post, fromPropertyList =<< v)-    -    i' <- f i-    return $ case i' of-        Nothing-            | M.null dict'  -> Nothing-            | otherwise     -> Just dict'-        Just i' -> Just (M.insert k (toPropertyList i') dict)-        -tryAlterDictionaryEntryM ::-    (Monad m, PropertyListItem i, PropertyListItem i') -    => String -> (Maybe i -> m (Maybe i'))-    -> Maybe PropertyList -> m (Maybe PropertyList)-tryAlterDictionaryEntryM k f Nothing = do-    d' <- alterDictionaryEntryM k f Nothing-    return (fmap plDict d')-tryAlterDictionaryEntryM k f (Just (S (PLDict d))) = do-    d' <- alterDictionaryEntryM k f (Just d)-    return (fmap plDict d')-tryAlterDictionaryEntryM k f other = fail "Key path tries to pass through non-dictionary thing."--alterItemAtKeyPathM ::-    (Monad m, PropertyListItem i, PropertyListItem i')-    => [String] -> (Maybe i -> m (Maybe i'))-    -> Maybe PropertyList -> m (Maybe PropertyList)-alterItemAtKeyPathM [] f = alterPropertyListM f-alterItemAtKeyPathM (k:ks) f = tryAlterDictionaryEntryM k (alterItemAtKeyPathM ks f)--alterPropertyList ::-    (PropertyListItem i, PropertyListItem i') -    => (Maybe i -> Maybe i')-    -> Maybe PropertyList -> Maybe PropertyList-alterPropertyList f plist = fmap toPropertyList (f (fromPropertyList =<< plist))--alterDictionaryEntry ::-    (PropertyListItem i, PropertyListItem i') -    => String -> (Maybe i -> Maybe i')-    -> Maybe (M.Map String PropertyList) -> Maybe (M.Map String PropertyList)-alterDictionaryEntry k f Nothing = fmap (M.singleton k . toPropertyList) (f Nothing)-alterDictionaryEntry k f (Just dict) = case i' of-    Nothing-        | M.null dict'  -> Nothing-        | otherwise     -> Just dict'-    Just i' -> Just (M.insert k (toPropertyList i') dict)-    -    where-        (dict', i) = case M.splitLookup k dict of-            (pre, v, post) -> (M.union pre post, fromPropertyList =<< v)-        i' = f i--tryAlterDictionaryEntry ::-    (PropertyListItem i, PropertyListItem i') -    => String -> (Maybe i -> Maybe i')-    -> Maybe PropertyList -> (Maybe PropertyList, Bool)-tryAlterDictionaryEntry k f Nothing           = (fmap plDict (alterDictionaryEntry k f Nothing), True)-tryAlterDictionaryEntry k f (Just (S (PLDict d))) = (fmap plDict (alterDictionaryEntry k f (Just d)), True)-tryAlterDictionaryEntry k f other = (other, False)---- |TODO: capture the success/failure of the operation?--- (can fail if key path tries to enter something that isn't a dictionary)-alterItemAtKeyPath :: -    (PropertyListItem i, PropertyListItem i')-    => [String] -> (Maybe i -> Maybe i')-    -> Maybe PropertyList -> Maybe PropertyList-alterItemAtKeyPath  []    f plist= alterPropertyList f plist-alterItemAtKeyPath (k:ks) f plist = case tryAlterDictionaryEntry k (alterItemAtKeyPath ks f) plist of-    (_, False) -> error "Key path tries to pass through non-dictionary thing."-    (plist, True) -> plist--getItemAtKeyPath :: PropertyListItem i =>-    [String] -> Maybe PropertyList -> Maybe i-getItemAtKeyPath path plist = execState -    (alterItemAtKeyPathM path (\e -> put e >> return e) plist)-    Nothing--setItemAtKeyPath :: PropertyListItem i =>-    [String] -> Maybe i -> Maybe PropertyList -> Maybe PropertyList-setItemAtKeyPath path value plist = alterItemAtKeyPath path -    (\e -> value `asTypeOf` e) plist- instance PropertyListItem PropertyList where     toPropertyList = id     fromPropertyList = Just  instance PropertyListItem ByteString where     toPropertyList = plData-    fromPropertyList (S (PLData x))   = Just x-    fromPropertyList (S (PLString x)) = Just (toStrictByteString x)+    fromPropertyList (fromPlData    -> Just x) = Just x+    fromPropertyList (fromPlString  -> Just x) = Just (toStrictByteString x)     fromPropertyList _ = Nothing  instance PropertyListItem Lazy.ByteString where     toPropertyList = plData . toStrictByteString-    fromPropertyList (S (PLData   x)) = Just (toLazyByteString x)-    fromPropertyList (S (PLString x)) = Just (toLazyByteString x)+    fromPropertyList (fromPlData    -> Just x) = Just (toLazyByteString x)+    fromPropertyList (fromPlString  -> Just x) = Just (toLazyByteString x)     fromPropertyList _ = Nothing  instance PropertyListItem UTCTime where     toPropertyList = plDate-    fromPropertyList (S (PLDate x)) = Just x+    fromPropertyList (fromPlDate -> Just x) = Just x     fromPropertyList _ = Nothing  instance PropertyListItem a => PropertyListItem (M.Map String a) where     {-# SPECIALIZE instance PropertyListItem (M.Map String PropertyList) #-}          toPropertyList = plDict . fmap toPropertyList-    fromPropertyList (S (PLDict x)) = fmapM fromPropertyList x-        where fmapM f m = fmap M.fromList $ -                            sequence [ do { v <- f v; return (k, v)}-                                     | (k, v) <- M.toList m ]+    fromPropertyList (fromPlDict -> Just x) = Traversable.mapM fromPropertyList x     fromPropertyList _ = Nothing  instance PropertyListItem Double where     toPropertyList = plReal-    fromPropertyList (S (PLInt i)) =  Just (fromInteger i)-    fromPropertyList (S (PLReal d)) = Just d-    fromPropertyList (S (PLString s)) = case reads s of-        [(d, "")] -> Just d-        _ -> Nothing+    fromPropertyList (fromPlInt    -> Just i) = Just (fromInteger i)+    fromPropertyList (fromPlReal   -> Just d) = Just d+    fromPropertyList (fromPlString -> Just s) = tryRead s     fromPropertyList _ = Nothing  instance PropertyListItem Float where     toPropertyList = toPropertyList . (realToFrac :: Float -> Double)     fromPropertyList = fmap (realToFrac :: Double -> Float) . fromPropertyList -instance PropertyListItem Integer where-    toPropertyList = plInt-    fromPropertyList (S (PLInt i)) = Just i-    fromPropertyList (S (PLReal d)) = case properFraction d of-        (i, 0) -> Just i-        _ -> Nothing-    fromPropertyList (S (PLString s)) = case reads s of-        [(i, "")] -> Just i-        _ -> Nothing-    fromPropertyList _ = Nothing--instance PropertyListItem Int where-    toPropertyList = toPropertyList . toInteger-    fromPropertyList = fmap fromInteger . fromPropertyList+-- this little bit of Template Haskell replicates the embedded instance+-- to many other integral types (by using SYB generics to replace every+-- occurrence of ''Integer in the declarations' template-haskell representation+-- with each other type's name)+$( do+    decls <- [d|+            instance PropertyListItem Integer where+                toPropertyList = plInt . fromIntegral+                fromPropertyList pl = case runIdentity (plistCoalgebra pl) of +                    PLInt  i    -> Just (fromIntegral i)+                    PLReal d    -> tryToIntegral d+                    PLString s  -> tryRead s+                    _           -> Nothing+        |]+    sequence+        [ everywhereM (mkM (return . replace)) dec+        | t <-  [''Integer, ''Int,+                 ''Int8,  ''Int16,  ''Int32,  ''Int64, +                 ''Word8, ''Word16, ''Word32, ''Word64]+        , dec <- decls+        , let replace name+                | name  == ''Integer    = t+                | otherwise             = name+        ]+ )  -- this instance doesnt make much sense by itself, but must be here to support strings instance PropertyListItem Char where     toPropertyList c = plString [c]-    fromPropertyList (S (PLString [c])) = Just c+    fromPropertyList (fromPlString -> Just  [c]) = Just c     fromPropertyList _ = Nothing          listToPropertyList = plString-    listFromPropertyList (S (PLString x)) = Just x-    listFromPropertyList (S (PLData x))   = Just (fromStrictByteString x)-    listFromPropertyList (S (PLBool True)) = Just "YES"-    listFromPropertyList (S (PLBool False)) = Just "NO"-    listFromPropertyList (S (PLInt i)) = Just (show i)-    listFromPropertyList (S (PLReal d)) = Just (show d)+    listFromPropertyList (fromPlString -> Just x)     = Just x+    listFromPropertyList (fromPlData   -> Just x)     = Just (fromStrictByteString x)+    listFromPropertyList (fromPlBool   -> Just True)  = Just "YES"+    listFromPropertyList (fromPlBool   -> Just False) = Just "NO"+    listFromPropertyList (fromPlInt    -> Just i)     = Just (show i)+    listFromPropertyList (fromPlReal   -> Just d)     = Just (show d)     listFromPropertyList other = Nothing  instance PropertyListItem Bool where     toPropertyList = plBool-    fromPropertyList (S (PLBool d)) = Just d-    fromPropertyList (S (PLString b))+    fromPropertyList (fromPlBool   -> Just d) = Just d+    fromPropertyList (fromPlString -> Just b)         | map toLower b `elem` ["yes", "true"]         = Just True         | map toLower b `elem` ["no", "false"]         = Just False     fromPropertyList _ = Nothing -instance PropertyListItem UnparsedPlistItem where-    toPropertyList = plVar-    fromPropertyList (V d) = Just d-    fromPropertyList _ = Nothing---- |Note that due to 'Object''s use of 'Lazy.ByteString's, scalars become data, not strings.--- Using @GenObject key String@ instead of 'Object' will cause scalars to be encoded as plist strings.-#ifdef NEW_DATA_OBJECT-instance (PropertyListItem val, LazyByteString key) => PropertyListItem (GenObject key val) where-#else-instance PropertyListItem Object where-#endif-    toPropertyList (Mapping  m) = toPropertyList (M.fromList [(toStr k, v) | (k,v) <- m])-        where toStr = unpack . toLazyByteString-    toPropertyList (Sequence s) = toPropertyList s-    toPropertyList (Scalar   s) = toPropertyList s-    -    fromPropertyList plist = msum-        [ do-            m <- fromPropertyList plist-            let fromStr = fromLazyByteString . pack-            return (Mapping [(fromStr k, v) | (k,v) <- M.assocs m])-        , fmap Sequence (fromPropertyList plist)-        , fmap Scalar   (fromPropertyList plist)-        ]- -- The following TH generates, for Either and for all OneOfN types --  (N in [2..20]), an instance of the form: -- @@ -294,7 +211,7 @@                 tyVars = map varT tyVarNames                 typeWithVars = foldl appT (conT typeName) tyVars                 -#ifdef NEW_TEMPLATE_HASKELL+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 612                 preds = [classP ''PropertyListItem [tyVar] | tyVar <- tyVars]                 context = cxt preds #else

@@ -1,114 +0,0 @@-{-# LANGUAGE -    TemplateHaskell,-    FlexibleContexts, UndecidableInstances,-    TypeSynonymInstances, RelaxedPolyRec-  #-}--module Data.PropertyList.Type where--import Language.Haskell.TH.Fold--import qualified Data.Map as M-import Data.ByteString as B hiding (map)-import Data.Time---- |A property list possibly containing unparsed items (only when items fail --- to parse or the user puts them there)-type PropertyList = PropertyList_ UnparsedPlistItem--data PropertyListS l m a-        = PLArray (l a)-        | PLData ByteString-        | PLDate UTCTime-        | PLDict  (m a)-        | PLReal Double-        | PLInt Integer-        | PLString String-        | PLBool Bool-        deriving (Eq, Ord, Show, Read)--foldPropertyListS :: (l a -> t)-                  -> (ByteString -> t)-                  -> (UTCTime -> t)-                  -> (m a -> t)-                  -> (Double -> t)-                  -> (Integer -> t)-                  -> (String -> t)-                  -> (Bool -> t) -                  -> PropertyListS l m a -> t-foldPropertyListS = $(fold ''PropertyListS)--instance (Functor l, Functor m) => Functor (PropertyListS l m) where-    fmap f = foldPropertyListS (PLArray . fmap f) PLData PLDate (PLDict . fmap f) PLReal PLInt PLString PLBool--data M f a-    = S (f (M f a))-    | V a--foldM :: (f (M f a) -> t) -> (a -> t) -> M f a -> t-foldM = $(fold ''M)--instance (Eq (f (M f a)),  Eq a) => Eq (M f a) where-    S x == S y  = (x == y)-    V a == V b  = (a == b)-    _ == _ = False-instance (Ord (f (M f a)),  Ord a) => Ord (M f a) where-    S x `compare` S y  = x `compare` y-    V a `compare` V b  = a `compare` b-    S _ `compare` V _  = LT-    V _ `compare` S _  = GT-    -instance (Show (f (M f a)), Show a) => Show (M f a) where-    showsPrec p (S x) = showParen (p > 10) (showString "S " . showsPrec 11 x)-    showsPrec p (V x) = showParen (p > 10) (showString "V " . showsPrec 11 x)---- instance Read...---- |The property-list term algebra type itself, parameterized over the type of--- \"structural holes\" in the terms.-type PropertyList_ = M (PropertyListS [] (M.Map String))--plArray     x   = S (PLArray  x)-plData      x   = S (PLData   x)-plDate      x   = S (PLDate   x)-plDict      x   = S (PLDict   x)-plReal      x   = S (PLReal   x)-plInt       x   = S (PLInt    x)-plString    x   = S (PLString x)-plBool      x   = S (PLBool   x)-plVar       x   = V x--data UnparsedPlistItem-        = UnparsedData String-        | UnparsedDate String-        | UnparsedInt  String-        | UnparsedReal String-        deriving (Eq, Ord, Show, Read)--instance Functor f => Functor (M f) where-    fmap f (S x) = S (fmap (fmap f) x)-    fmap f (V x) = V (f x)--instance Functor f => Monad (M f) where-    return = V-    (S x) >>= f = S (fmap (>>= f) x)-    (V x) >>= f = f x--foldPropertyList :: (Functor list, Functor map)-                 => (list a -> a)-                 -> (ByteString -> a)-                 -> (UTCTime -> a)-                 -> (map a -> a)-                 -> (Double -> a)-                 -> (Integer -> a)-                 -> (String -> a)-                 -> (Bool -> a)-                 -> (t -> a)-                 -> M (PropertyListS list map) t -> a-foldPropertyList foldList a b foldMap c d e f g = foldIt-        where-                foldIt = foldM foldS g-                foldS = foldPropertyListS foldArray a b foldDict c d e f-                -                foldArray branches = foldList (fmap foldIt branches)-                foldDict dict = foldMap (fmap foldIt dict)

@@ -0,0 +1,198 @@+{-# LANGUAGE +    MultiParamTypeClasses,+    FlexibleContexts, FlexibleInstances, IncoherentInstances,+    GeneralizedNewtypeDeriving+  #-}++-- |This module implements the 'PropertyList' and 'PartialPropertyList' types+-- and their algebras/coalgebras.  These types are the core of the property-list+-- implementation, representing either complete or partial propertylists, +-- respectively, in the most \"universal\" form possible.+module Data.PropertyList.Types where++import Data.PropertyList.Algebra++import Control.Functor.Pointed+import Control.Functor.Fix+import Control.Applicative+import Control.Monad.Identity+import Control.Monad.Free+import Data.Foldable (Foldable(foldMap))+import Data.Traversable (Traversable(..))+import Data.Void++import Unsafe.Coerce (unsafeCoerce) {- used _only_ to eliminate fmap traversals for newtype constructors -}++-- * The 'PropertyList' data type+-- (the universal algebra/coalgebra for the unlifted signature)++-- |A fully-parsed property list.+newtype PropertyList = PL { unPL :: FixF PropertyListS }+instance Eq PropertyList where+    PL (InF x) == PL (InF y) = fmap PL x == fmap PL y+instance Ord PropertyList where+    PL (InF x) `compare` PL (InF y) = fmap PL x `compare` fmap PL y++{-# RULES+    -- don't traverse with no-ops!+"fmap PL   -> unsafeCoerce"     fmap PL   = unsafeCoerce+"fmap unPl -> unsafeCoerce"     fmap unPL = unsafeCoerce+  #-}++instance Show PropertyList where+    show pl = showsPrec 0 pl " :: PropertyList"+    showsPrec p (PL x) = showParen (p > 10) $ case outF x of+        PLArray  arr  -> showString "plArray "  . showsPrec 11 (fmap PL arr)+        PLData   bs   -> showString "plData "   . showsPrec 11 bs  +        PLDate   time -> showString "plDate "   . showsPrec 11 time+        PLDict   dict -> showString "plDict "   . showsPrec 11 (fmap PL dict)+        PLReal   dbl  -> showString "plReal "   . showsPrec 11 dbl +        PLInt    int  -> showString "plInt "    . showsPrec 11 int +        PLString str  -> showString "plString " . showsPrec 11 str +        PLBool   bool -> showString "plBool "   . showsPrec 11 bool++instance Copointed f => PListAlgebra f PropertyList where+    {-# SPECIALIZE instance PListAlgebra Identity PropertyList #-}+    plistAlgebra = PL . InF . fmap unPL . extract++instance PListCoalgebra Identity a => PListAlgebra (Either a) PropertyList where+    plistAlgebra = either toPlist (plistAlgebra . Identity)++instance InitialPList Identity PropertyList++instance Pointed f => PListCoalgebra f PropertyList where+    {-# SPECIALIZE instance PListCoalgebra Identity PropertyList #-}+    plistCoalgebra = point . fmap PL . outF . unPL++instance TerminalPList Identity PropertyList++foldPropertyList f (PL pl) = fold pl+    where fold (InF x) = f (fmap fold x)++-- * The 'PartialPropertyList' data type+-- (the universal algebra/coalgebra for the signature extended by +--  introducing new constructors)++-- |A partially-parsed property-list term algebra, parameterized over the type of+-- \"structural holes\" in the terms.+newtype PartialPropertyList a = PPL {unPPL :: Free PropertyListS a}+    deriving (Pointed, Functor, Monad, MonadFree PropertyListS)+{-# RULES+    -- don't traverse with no-ops!+"fmap PPL   -> unsafeCoerce"     fmap PPL   = unsafeCoerce+"fmap unPPl -> unsafeCoerce"     fmap unPPL = unsafeCoerce+  #-}++instance Applicative PartialPropertyList where+    pure = return+    (<*>) = ap++instance Foldable PartialPropertyList where+    foldMap f (PPL x) = case runFree x of+        Left  x -> f x+        Right x -> foldMap (foldMap f . PPL) x++instance Traversable PartialPropertyList where+    traverse f (PPL x) = case runFree x of+        Left x  -> return <$> f x+        Right x -> inFree <$> traverse (traverse f . PPL) x++instance Eq a => Eq (PartialPropertyList a) where+    PPL x == PPL y = case (runFree x, runFree y) of+        (Left a,  Left  b) -> a == b+        (Right a, Right b) -> fmap PPL a == fmap PPL b+        _                  -> False++instance Ord a => Ord (PartialPropertyList a) where+    PPL x `compare` PPL y = case (runFree x, runFree y) of+        (Left a,  Left  b) -> a `compare` b+        (Left _,  Right _) -> Left () `compare` Right ()+        (Right a, Right b) -> fmap PPL a `compare` fmap PPL b+        (Right _, Left  _) -> Right () `compare` Left ()++instance Show a => Show (PartialPropertyList a) where+    showsPrec p (PPL x) = showParen (p > 10) $ case runFree x of+        Left a ->  showString "return " . showsPrec 11 a+        Right x -> case x of+            PLArray  arr  -> showString "plArray "  . showsPrec 11 (fmap PPL arr)+            PLData   bs   -> showString "plData "   . showsPrec 11 bs  +            PLDate   time -> showString "plDate "   . showsPrec 11 time+            PLDict   dict -> showString "plDict "   . showsPrec 11 (fmap PPL dict)+            PLReal   dbl  -> showString "plReal "   . showsPrec 11 dbl +            PLInt    int  -> showString "plInt "    . showsPrec 11 int +            PLString str  -> showString "plString " . showsPrec 11 str +            PLBool   bool -> showString "plBool "   . showsPrec 11 bool++-- instance Read...+++-- this instance overlaps (with incoherence allowed) with all +-- others for PartialPropertyList: ensure that you don't define +-- an explicit instance for any 'Copointed' functor!+instance Copointed f => PListAlgebra f (PartialPropertyList a) where+    {-# SPECIALIZE instance PListAlgebra Identity (PartialPropertyList a) #-}+    plistAlgebra = inFree . extract++instance PListAlgebra Maybe (PartialPropertyList ()) where+    plistAlgebra Nothing  = return ()+    plistAlgebra (Just x) = inFree x++instance PListAlgebra (Either a) (PartialPropertyList a) where+    plistAlgebra (Left  x) = return x+    plistAlgebra (Right x) = inFree x++instance InitialPList (Either a) (PartialPropertyList a) where++instance PListCoalgebra (Either a) (PartialPropertyList a) where+    plistCoalgebra (PPL xf) = fmap (fmap PPL) (runFree xf)++instance TerminalPList (Either a) (PartialPropertyList a) where++instance PListCoalgebra Maybe (PartialPropertyList a) where+    plistCoalgebra (PPL xf) = case runFree xf of+        Left  _ -> Nothing+        Right x -> Just (fmap PPL x)++-- * Convenient functions for converting from 'PartialPropertyList' to+-- 'PropertyList'.++-- |Take a 'PartialPropertyList' that has been expunged of all incomplete+-- elements (as witnessed by the 'PListCoalgebra' 'Identity' @a@ context, which+-- states that any value of type @a@ can be unfolded to a complete 'PropertyList')+-- and convert it to a 'PropertyList'.+--+-- This is just a convenient synonym for 'fromPlist' with the types+-- explicitly specialized.+completePropertyList :: PListCoalgebra Identity a => PartialPropertyList a -> PropertyList+completePropertyList = fromPlist++-- |Like 'completePropertyList' but also accepting a function that \"attempts\"+-- to complete any incomplete value in the 'PartialPropertyList'.+-- +-- Note that there is a potential type-inference trap here - the @b@ parameter+-- needs to be inferrable from the function used.  For example:+-- +-- > completePropertyListBy (\_ -> fail "parse error")+-- +-- will be rejected by the compiler because it doesn't know what @b@ is.+--+-- Instead, say:+--+-- > completePropertyListBy (\_ -> fail "parse error" :: IO PropertyList)+-- +-- (@b@ ~ 'Void' works too, or any other choice of @b@ satisfying the type +-- context)+completePropertyListBy :: (Applicative f, PListCoalgebra Identity b)+    => (a -> f b) -> PartialPropertyList a -> f PropertyList+completePropertyListBy f = fmap completePropertyList . traverse f++-- |Exactly the same as 'completePropertyListBy', except using 'Monad' in+-- place of 'Applicative' (for situations where a 'Monad' is missing an+-- 'Applicative' instance and you'd rather not add an orphan, etc.)+completePropertyListByM :: (Monad m, PListCoalgebra Identity b)+    => (a -> m b) -> PartialPropertyList a -> m PropertyList+completePropertyListByM f = liftM completePropertyList . unwrapMonad . traverse (WrapMonad . f)++-- instance for Void to allow it to be used as @a@ in 'completePropertyList':+instance Functor f => PListCoalgebra f Void where+    plistCoalgebra = void

@@ -1,102 +1,102 @@ {-# LANGUAGE-        TemplateHaskell, CPP+        FlexibleContexts   #-}--module Data.PropertyList.Xml where--import Prelude as P--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)-import Text.XML.HaXml.Types+module Data.PropertyList.Xml+    ( Plist+    , readXmlPlist, showXmlPlist+    , readXmlPlistFromFile, writeXmlPlistToFile+    +    , PlistItem+    , plistToPlistItem, plistItemToPlist+    +    , UnparsedPlistItem(..)+    , unparsedPlistItemToPlistItem+    +    , readXmlPropertyList, readXmlPropertyListFromFile+    +    , readXmlPartialPropertyList, showXmlPropertyList+    , readXmlPartialPropertyListFromFile, writeXmlPropertyListToFile+    +    ) where -import Language.Haskell.TH.Fold+import Data.PropertyList.Algebra+import Data.PropertyList.Types+import Data.PropertyList.Xml.Parse+import Data.PropertyList.Xml.Types -type PlistItem = OneOf9 Array Data Date Dict AReal AInteger AString X.True X.False+import Control.Monad.Error ({- instance Monad (Either String) -}) -readPlist :: String -> Either String Plist-readPlist = readXml+-- * Reading and writing XML 'Plist's from files -readPlistFromFile :: FilePath -> IO (Either String Plist)-readPlistFromFile path = do+-- |Try to parse a 'Plist' from an XML property-list file.+readXmlPlistFromFile :: FilePath -> IO (Either String Plist)+readXmlPlistFromFile path = do         contents <- readFile path-        return (readXml contents)+        return (readXmlPlist contents) -writePlistToFile :: FilePath -> Plist -> IO ()-writePlistToFile path plist = do-        writeFile path (showXml plist)+-- |Try to write a 'Plist' to an XML property-list file.+writeXmlPlistToFile :: FilePath -> Plist -> IO ()+writeXmlPlistToFile path plist = do+        writeFile path (showXmlPlist 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+-- * Reading and writing XML 'PartialPropertyList's and 'PropertyList's from 'String's -showXml :: Plist -> String-showXml = X2H.showXml+-- |Read an XML propertylist from a 'String' in the xml1 plist format to a+-- propertylist type which is terminal for the liftings supported by+-- 'PlistItem'  (such as @'PartialPropertyList' 'UnparsedPlistItem'@+-- or @'PartialPropertyList' 'PlistItem'@).+readXmlPartialPropertyList :: (PListCoalgebra f PlistItem, TerminalPList f pl) => String -> Either String pl+readXmlPartialPropertyList = fmap (toPlist . plistToPlistItem) . readXmlPlist -toXml :: Plist -> Document-toXml value =-    Document (Prolog (Just (XMLDecl "1.0" Nothing Nothing)) [] Nothing [])-             emptyST-             ( case (toElem value) of-                 [CElem e] -> e-                 )-             []+-- |Read a property list from a 'String' in the xml1 format.  If parsing+-- fails, returns a description of the problem in the 'Left' result.+readXmlPropertyList :: FilePath -> Either String PropertyList+readXmlPropertyList str = do+    x <- readXmlPartialPropertyList str :: Either String (PartialPropertyList UnparsedPlistItem)+    completePropertyListByM (\unparsed -> Left ("Unparseable item found: " ++ show unparsed) :: Either String PropertyList) x -#else+--readXmlPropertyList :: String -> PropertyList+--readXmlPropertyList+--    = runIdentity+--    . completePropertyListByM (\_ -> fail "parse error" :: Identity PropertyList)+--    . either error id+--    . (readXmlPartialPropertyList :: String -> Either String (PartialPropertyList UnparsedPlistItem)) --- | Convert a fully-typed XML document to a string (without DTD).-showXml :: Plist -> String-showXml x =-    case toContents x of-      [CElem _ _] -> (render . document . toXml) x-      _ -> ""+-- |Render a propertylist to a 'String' in the xml1 plist format from any+-- initial propertylist type  (which includes 'PropertyList', @'PartialPropertyList'+-- 'UnparsedPlistItem'@, and @'PartialPropertyList' 'PlistItem'@).+showXmlPropertyList :: (InitialPList f pl, PListAlgebra f PlistItem) => pl -> String+showXmlPropertyList = showXmlPlist . plistItemToPlist . fromPlist -toXml :: Plist -> Document ()-toXml value =-    Document (Prolog (Just (XMLDecl "1.0" Nothing Nothing)) [] Nothing [])-             emptyST-             ( case (toContents value) of-                 [CElem e ()] -> e-                 )-             [] -#endif+-- * Reading and writing XML 'PartialPropertyList's and 'PropertyList's from files -plistToPlistItem :: Plist -> PlistItem-plistToPlistItem = $(fold ''Plist)-        (\attr -> OneOf9  )-        (\attr -> TwoOf9  )-        (\attr -> ThreeOf9)-        (\attr -> FourOf9 )-        (\attr -> FiveOf9 )-        (\attr -> SixOf9  )-        (\attr -> SevenOf9)-        (\attr -> EightOf9)-        (\attr -> NineOf9 )+-- |Read an XML propertylist from a file in the xml1 plist format to a+-- propertylist type which is terminal for the liftings supported by+-- 'PlistItem'  (such as @'PartialPropertyList' 'UnparsedPlistItem'@+-- or @'PartialPropertyList' 'PlistItem'@).+readXmlPartialPropertyListFromFile+  :: (PListCoalgebra f PlistItem, TerminalPList f pl) =>+     FilePath -> IO (Either String pl)+readXmlPartialPropertyListFromFile file = do+        x <- readXmlPlistFromFile file+        return (fmap (toPlist . plistToPlistItem) x) -plistItemToPlist = $(fold ''OneOf9)-        (PlistArray    attr)-        (PlistData     attr)-        (PlistDate     attr)-        (PlistDict     attr)-        (PlistAReal    attr)-        (PlistAInteger attr)-        (PlistAString  attr)-        (PlistTrue     attr)-        (PlistFalse    attr)-        where attr = fromAttrs []+-- |Read a property list from a file in the xml1 format.  If parsing fails,+-- calls 'fail'.+readXmlPropertyListFromFile :: FilePath -> IO PropertyList+readXmlPropertyListFromFile file = do+    x <- readXmlPartialPropertyListFromFile file :: IO (Either String (PartialPropertyList UnparsedPlistItem))+    y <- either fail return x+    completePropertyListByM (\unparsed -> fail ("Unparseable item found: " ++ show unparsed) :: IO PropertyList) y+    ++-- |Output a propertylist to a file in the xml1 plist format from any+-- initial propertylist type  (which includes 'PropertyList', @'PartialPropertyList'+-- 'UnparsedPlistItem'@, and @'PartialPropertyList' 'PlistItem'@).+writeXmlPropertyListToFile+  :: (InitialPList f pl, PListAlgebra f PlistItem) =>+     FilePath -> pl -> IO ()+writeXmlPropertyListToFile file plist = do+        writeXmlPlistToFile file (plistItemToPlist (fromPlist plist))

@@ -12,6 +12,11 @@  {-Type decls-} +-- |DtdToHaskell-generated type representing XML trees that match the PropertyList-1.0 dtd.+-- This is an opaque representation of a structurally-sound property list+-- which might still contain invalid data.  End users should never need to+-- use this type, but if they do, it can be manipulated with the constructors+-- and deconstructors in "Data.PropertyList.Algebra". data Plist = PlistArray Plist_Attrs Array            | PlistData Plist_Attrs Data            | PlistDate Plist_Attrs Date

@@ -14,6 +14,11 @@  {-Type decls-} +-- |DtdToHaskell-generated type representing XML trees that match the PropertyList-1.0 dtd.+-- This is an opaque representation of a structurally-sound property list+-- which might still contain invalid data.  End users should never need to+-- use this type, but if they do, it can be manipulated with the constructors+-- and deconstructors in "Data.PropertyList.Algebra". data Plist = PlistArray Plist_Attrs Array            | PlistData Plist_Attrs Data            | PlistDate Plist_Attrs Date

@@ -0,0 +1,122 @@+{-# LANGUAGE +    TemplateHaskell, CPP,+    MultiParamTypeClasses,+    FlexibleContexts, FlexibleInstances, TypeSynonymInstances,+    UndecidableInstances, OverlappingInstances, IncoherentInstances+  #-}++module Data.PropertyList.Xml.Parse where++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+#endif++import Data.PropertyList.Algebra+import Data.PropertyList.Xml.Types++import Control.Functor.Pointed+import Control.Arrow ((+++))+import Control.Monad.Identity+import qualified Data.Map as M+import Data.ByteString as B hiding (map)+import Data.Time+import System.Locale+import Codec.Binary.Base64 as B64++import Text.XML.HaXml.OneOfN++-- |A representation of values that were structurally sound in the +-- property list file but the contents of which couldn't be interpreted+-- as what they claimed to be.  The result of the initial parse phase will+-- typically be a @PartialPropertyList UnparsedPlistItem@, and if+-- the whole plist was parsed properly will contain no actual values +-- of this type.+data UnparsedPlistItem+    = UnparsedData String+    | UnparsedDate String+    | UnparsedInt  String+    | UnparsedReal String+    deriving (Eq, Ord, Show, Read)++dateFormat :: String+dateFormat = "%FT%TZ"++-- This instance is not efficient, and should really only be used as a convenience+-- to allow direct construction of 'Plist's using the \"smart constructors\"+instance PListAlgebra f PlistItem => PListAlgebra f Plist where+    plistAlgebra = plistItemToPlist . plistAlgebra . fmap (fmap plistToPlistItem)++instance Copointed f => PListAlgebra f PlistItem where+    {-# SPECIALIZE instance PListAlgebra Identity PlistItem #-}+    plistAlgebra = foldPropertyListS+          (\x -> OneOf9 (Array x)+        ) (\x -> TwoOf9 (Data (encode (unpack x)))+        ) (\x -> ThreeOf9 (Date (formatTime defaultTimeLocale dateFormat x))+        ) (\x -> FourOf9 (Dict [Dict_ (Key k) v | (k,v) <- M.toList x])+        ) (\x -> FiveOf9 (AReal (show x))+        ) (\x -> SixOf9 (AInteger (show x))+        ) (\x -> SevenOf9 (AString x)+        ) (\x -> if x then EightOf9 X.True else NineOf9 X.False+        ) . extract++instance PListAlgebra   (Either UnparsedPlistItem) PlistItem where+    plistAlgebra (Left unparsed) = unparsedPlistItemToPlistItem unparsed+    plistAlgebra (Right parsed) = plistAlgebra (Identity parsed)++instance PListAlgebra   (Either PlistItem) PlistItem where+    plistAlgebra (Left unparsed) = unparsed+    plistAlgebra (Right parsed) = plistAlgebra (Identity parsed)++instance PListCoalgebra (Either UnparsedPlistItem) PlistItem where+    plistCoalgebra item = case item of+        OneOf9   (Array x   )   -> accept PLArray x+        TwoOf9   (Data x    )   -> case decode x of +                Just d                  -> accept PLData (pack d)+                Nothing                 -> reject UnparsedData x+        ThreeOf9 (Date x    )   -> case parseTime defaultTimeLocale dateFormat x of+                Just t                  -> accept PLDate t+                Nothing                 -> reject UnparsedDate x+        FourOf9  (Dict x    )   -> accept PLDict (M.fromList [ (k, v) | Dict_ (Key k) v <- x])+        FiveOf9  (AReal x   )   -> tryRead PLReal UnparsedReal x+        SixOf9   (AInteger x)   -> tryRead PLInt  UnparsedInt x+        SevenOf9 (AString  x)   -> accept PLString x+        EightOf9 (X.True    )   -> accept PLBool P.True+        NineOf9  (X.False   )   -> accept PLBool P.False+        +        where+                accept :: (a -> c) -> a -> Either b c+                accept con = Right . con+                +                reject :: (a -> b) -> a -> Either b c+                reject con = Left  . con+                +                tryRead :: Read a => (a -> c) -> (String -> b) -> String -> Either b c+                tryRead onGood onBad str =+                        case reads str of+                                ((result, ""):_) -> accept onGood result+                                _                -> reject onBad  str++instance PListCoalgebra (Either PlistItem) PlistItem where+    plistCoalgebra = (unparsedPlistItemToPlistItem +++ id) . plistCoalgebra++instance PListCoalgebra Maybe PlistItem where+    plistCoalgebra = either (const Nothing) Just . (plistCoalgebra :: PlistItem -> Either PlistItem (PropertyListS PlistItem))++-- This instance is not efficient, and should really only be used as a convenience+-- to allow direct deconstruction of 'Plist's using the \"view deconstructors\"+instance PListCoalgebra f PlistItem => PListCoalgebra f Plist where+    plistCoalgebra = fmap (fmap plistItemToPlist) . plistCoalgebra . plistToPlistItem++-- |Take the unparsed data from an 'UnparsedPlistItem' and wrap it in+-- the appropriate 'PlistItem' constructor.+unparsedPlistItemToPlistItem :: UnparsedPlistItem -> PlistItem+unparsedPlistItemToPlistItem = $(fold ''UnparsedPlistItem)+        (TwoOf9   . Data    )+        (ThreeOf9 . Date    )+        (SixOf9   . AInteger)+        (FiveOf9  . AReal   )

@@ -0,0 +1,116 @@+{-# LANGUAGE+        TemplateHaskell, CPP+  #-}++module Data.PropertyList.Xml.Types+    ( Plist, PlistItem+    , plistItemToPlist, plistToPlistItem+    , readXmlPlist, showXmlPlist+    ) where++import Prelude as P++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)+import Text.XML.HaXml.Types++import Language.Haskell.TH.Fold++-- * The 'PlistItem' type: Xml-parser-independent view of an xml plist+-- |'PlistItem' is nearly equivalent to 'Plist' - the difference is that it discards+-- information about where in the tree the item is (a 'Plist' represents the whole+-- XML tree starting from the root).  This is a \"slightly-less-opaque\" type,+-- but still isn't really intended for consumption by end users.+type PlistItem = OneOf9 Array Data Date Dict AReal AInteger AString X.True X.False++-- |Convert a 'Plist' to a 'PlistItem', discarding the root element and any +-- attributes that element may have had.+plistToPlistItem :: Plist -> PlistItem+plistToPlistItem = $(fold ''Plist)+        (\attr -> OneOf9  )+        (\attr -> TwoOf9  )+        (\attr -> ThreeOf9)+        (\attr -> FourOf9 )+        (\attr -> FiveOf9 )+        (\attr -> SixOf9  )+        (\attr -> SevenOf9)+        (\attr -> EightOf9)+        (\attr -> NineOf9 )++-- |Convert a 'PlistItem' to a 'Plist', giving it a root element with no +-- attributes.+plistItemToPlist :: PlistItem -> Plist+plistItemToPlist = $(fold ''OneOf9)+        (PlistArray    attr)+        (PlistData     attr)+        (PlistDate     attr)+        (PlistDict     attr)+        (PlistAReal    attr)+        (PlistAInteger attr)+        (PlistAString  attr)+        (PlistTrue     attr)+        (PlistFalse    attr)+        where attr = fromAttrs []++-- * Parsing and rendering XML 'Plist's from/to 'String's++#ifdef HaXml_1_13++-- |Try to parse a string as an XML property list.+readXmlPlist :: String -> Either String Plist+readXmlPlist xml = case X2H.readXml xml of+    Nothing     -> Left "readXml: parse failed"+    Just plist  -> Right plist++-- |Render a 'Plist' to a 'String' as an XML property list.+showXmlPlist :: Plist -> String+showXmlPlist = X2H.showXml++-- |Render a 'Plist' as a 'Document' (HaXml's internal DOM representation, I+-- think)+toXml :: Plist -> Document+toXml value =+    Document (Prolog (Just (XMLDecl "1.0" Nothing Nothing)) [] Nothing [])+             emptyST+             ( case (toElem value) of+                 [CElem e] -> e+                 )+             []++#else++-- |Try to parse a string as an XML property list.+readXmlPlist :: String -> Either String Plist+readXmlPlist = readXml++-- |Render a 'Plist' to a 'String' as an XML property list.+showXmlPlist :: Plist -> String+showXmlPlist x =+    case toContents x of+      [CElem _ _] -> (render . document . toXml) x+      _ -> ""++-- |Render a 'Plist' as a 'Document' (HaXml's internal DOM representation, I+-- think)+toXml :: Plist -> Document ()+toXml value =+    Document (Prolog (Just (XMLDecl "1.0" Nothing Nothing)) [] Nothing [])+             emptyST+             ( case (toContents value) of+                 [CElem e ()] -> e+                 )+             []++#endif