property-list 0.0.0.1.1 → 0.0.0.3

raw patch · 7 files changed

+512/−155 lines, 7 filesdep +mtldep +template-haskellPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: mtl, template-haskell

API changes (from Hackage documentation)

Files

• property-list.cabal +7/−1
• src/Data/PropertyList.hs +14/−150
• src/Data/PropertyList/Parse.hs +93/−0
• src/Data/PropertyList/PropertyListItem.hs +282/−0
• src/Data/PropertyList/Type.hs +116/−0
• src/Data/PropertyList/Xml.hs +0/−3
• src/Data/PropertyList/Xml/Dtd.hs +0/−1

@@ -1,5 +1,5 @@ name:                   property-list-version:                0.0.0.1.1+version:                0.0.0.3 stability:              experimental license:                PublicDomain @@ -19,12 +19,18 @@   exposed-modules:      Data.PropertyList   other-modules:        Data.PropertyList.Xml                         Data.PropertyList.Xml.Dtd+                        Data.PropertyList.Type+                        Data.PropertyList.Parse+                        Data.PropertyList.PropertyListItem   build-depends:        base >= 3 && <5,                         bytestring,                         containers,                          dataenc,                         HaXml >= 1.19,+                        mtl,                         old-locale,                         pretty,                         time,+                        +                        template-haskell,                         th-fold

@@ -1,160 +1,24 @@-{-- -      ``Data/PropertyList''- -      rough cut type/reader/writer for Apple Property List format- -}-{-# LANGUAGE-        TemplateHaskell-  #-}--module Data.PropertyList where+module Data.PropertyList+    ( PropertyList+    , PropertyList_+    , UnparsedPlistItem(..)+    , readPropertyListFromFile+    , writePropertyListToFile+    +    , module Data.PropertyList.PropertyListItem+    ) where -import Prelude as P-import Data.PropertyList.Xml.Dtd as X+import Data.PropertyList.Type+import Data.PropertyList.Parse import Data.PropertyList.Xml -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-import Language.Haskell.TH.Fold--import Text.XML.HaXml.XmlContent+import Data.PropertyList.PropertyListItem -readPropertyListFromFile :: FilePath -> IO (Either String (PropertyList UnparsedPlistItem))+readPropertyListFromFile :: FilePath -> IO (Either String PropertyList) readPropertyListFromFile file = do         x <- readPlistFromFile file         return (fmap plistToPropertyList x) -writePropertyListToFile :: FilePath -> PropertyList UnparsedPlistItem -> IO ()+writePropertyListToFile :: FilePath -> PropertyList -> IO () writePropertyListToFile file plist = do         writePlistToFile file (propertyListToPlist unparsedPlistItemToPlistItem plist)--data PropertyList a-        = PLArray [PropertyList a]-        | PLData ByteString-        | PLDate UTCTime-        | PLDict  (M.Map String (PropertyList a))-        | PLReal Double-        | PLInt Integer-        | PLString String-        | PLBool Bool-        -        | PLVar a-        deriving (Eq, Ord, Show, Read)--instance Functor PropertyList where-        fmap f x = x >>= (return . f)--instance Monad PropertyList where-        return = PLVar-        x >>= f = foldPropertyList-                PLArray-                PLData-                PLDate-                PLDict-                PLReal-                PLInt-                PLString-                PLBool-                f x---- TODO: if possible, make 'fold' in th-utils detect the Functor instances for--- [] and Map k and automagically generate the call to fmap here-foldPropertyList :: ([a] -> a)-                 -> (ByteString -> a)-                 -> (UTCTime -> a)-                 -> (M.Map String a -> a)-                 -> (Double -> a)-                 -> (Integer -> a)-                 -> (String -> a)-                 -> (Bool -> a)-                 -> (t -> a)-                 -> PropertyList t -> a-foldPropertyList foldList a b foldMap c d e f g = foldIt-        where-                foldIt = $(fold ''PropertyList) foldArray a b foldDict c d e f g-                -                foldArray branches = foldList (fmap foldIt branches)-                foldDict dict = foldMap (fmap foldIt dict)--data UnparsedPlistItem-        = UnparsedData String-        | UnparsedDate String-        | UnparsedInt  String-        | UnparsedReal String-        deriving (Eq, Ord, Show, Read)--unparsedPlistItemToPlistItem :: UnparsedPlistItem -> PlistItem-unparsedPlistItemToPlistItem = $(fold ''UnparsedPlistItem)-        (TwoOf9   . Data    )-        (ThreeOf9 . Date    )-        (SixOf9   . AInteger)-        (FiveOf9  . AReal   )---- run an incremental parser - a function which takes--- a token type and returns either a subterm (possibly still--- containing unparsed tokens) or an unparsed 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.-parseT :: Monad t => (a -> Either (t a) b) -> a -> t b-parseT f = parse-        where parse token =-                either (>>= parse) return (f token)--plistToPropertyList :: Plist -> PropertyList UnparsedPlistItem-plistToPropertyList = parseT parsePlistItem . plistToPlistItem--plistItemToPropertyList :: PlistItem -> PropertyList UnparsedPlistItem-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

@@ -0,0 +1,93 @@+{-# LANGUAGE +    TemplateHaskell+  #-}++module Data.PropertyList.Parse where++import Language.Haskell.TH.Fold++import Prelude as P+import Data.PropertyList.Xml.Dtd as X+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+import Text.XML.HaXml.XmlContent++-- |run an incremental parser - a function which takes+-- a token type and returns either a subterm (possibly still+-- containing unparsed tokens) or an unparsed 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.+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

@@ -0,0 +1,282 @@+{-# LANGUAGE+    TypeSynonymInstances,+    FlexibleInstances,+    GeneralizedNewtypeDeriving,+    TemplateHaskell+  #-}++module Data.PropertyList.PropertyListItem where++import Language.Haskell.TH+import Language.Haskell.TH.Syntax+import Language.Haskell.TH.Fold++import Data.PropertyList.Type++import qualified Data.Map as M+import Data.ByteString (ByteString)+import Data.Time+import Data.Char++import Text.XML.HaXml.OneOfN++import Control.Monad+import Control.Monad.State++-- |A class for items which can be converted to and from property lists+class PropertyListItem i where+    -- |Convert the item to a property list, usually by simply wrapping the+    -- value with the appropriate 'PropertyList_' constructor+    toPropertyList :: i -> PropertyList+    +    -- |Convert a property list to a property list item if its contents+    -- _exactly_ fit the target type.  Note that when using types+    -- such as 'M.Map' 'String' 'Int' (as opposed to 'M.Map' 'String'+    -- 'PropertyList') this will mean that a single element of the +    -- dictionary of a non-'Int' type will cause the entire conversion to+    -- fail.+    fromPropertyList :: PropertyList -> Maybe i+    +    -- |In order to support a general instance for lists without breaking+    -- String, we use the same trick as the Prelude uses for Show.+    -- Generally, the list methods should not be overridden, and maybe+    -- they shouldn't even be exported.+    listToPropertyList :: [i] -> PropertyList+    listToPropertyList      = plArray . map toPropertyList+    +    listFromPropertyList :: PropertyList -> Maybe [i]+    listFromPropertyList (S (PLArray 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 _ = Nothing++instance PropertyListItem UTCTime where+    toPropertyList = plDate+    fromPropertyList (S (PLDate 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 _ = 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 _ = 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 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 _ = Nothing+    +    listToPropertyList = plString+    listFromPropertyList (S (PLString x)) = Just 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 other = Nothing++instance PropertyListItem Bool where+    toPropertyList = plBool+    fromPropertyList (S (PLBool d)) = Just d+    fromPropertyList (S (PLString 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++-- The following TH generates, for Either and for all OneOfN types+--  (N in [2..20]), an instance of the form:+-- +-- instance (PropertyListItem a, PropertyListItem b, PropertyListItem c) => PropertyListItem (OneOf3 a b c) where+--     toPropertyList = $(fold ''OneOf3) toPropertyList toPropertyList toPropertyList+--     fromPropertyList pl = msum [ fmap OneOf3 (fromPropertyList pl)+--                                , fmap TwoOf3 (fromPropertyList pl)+--                                , fmap ThreeOf3 (fromPropertyList pl)+--                                ]++$(  let types = ''Either : [mkTcName ("OneOf" ++ show n) | n <- [2..20]]+        -- mkTcName ensures we have the type constructor and not the data constructor+        -- by assembling it with its 'flavour' explicitly set to match that of a known+        -- type constructor.+        mkTcName n = Name (mkOccName n) nameFlavour+            where Name _ nameFlavour = ''OneOf2+        +        mkInstance typeName = do+            TyConI (DataD _ _ _ cons _) <- reify typeName+            let conNames = [name | NormalC name _ <- cons]+            +            let tyVarNames = zipWith (\con n -> mkName ("a" ++ show n)) conNames [1..]+                +                tyVars = map varT tyVarNames+                typeWithVars = foldl appT (conT typeName) tyVars+                +                cxt = mapM (appT (conT ''PropertyListItem)) tyVars+                inst = appT (conT ''PropertyListItem) typeWithVars+                +                pl = mkName "pl"+                +                whre = +                    [ funD 'toPropertyList   [clause []        (normalB toPLbody  ) []]+                    , funD 'fromPropertyList [clause [varP pl] (normalB fromPLbody) []]+                    ]+                +                toPLbody = appsE (fold typeName : map (const (varE 'toPropertyList)) conNames)+                fromPLbody = appE (varE 'msum) $ listE+                    [ [| fmap $(conE con) (fromPropertyList $(varE pl)) |]+                    | con <- conNames+                    ]+        +            instanceD cxt inst whre+    in+    mapM mkInstance types+ )

@@ -0,0 +1,116 @@+{-# 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++-- TODO: if possible, make 'fold' in th-utils detect the Functor instances for+-- [] and Map k and automagically generate the call to fmap here+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)

@@ -1,6 +1,3 @@-{-- -      ``Data/PropertyList/Xml''- -} {-# LANGUAGE         TemplateHaskell   #-}

@@ -1,5 +1,4 @@ {-- -      ``Data/PropertyList/Xml/Dtd''  -      generated by DtdToHaskell (from HaXml 1.19.4)  -      altered to fix ambiguities (added explicit Prelude imports)  -}