diff --git a/property-list.cabal b/property-list.cabal --- a/property-list.cabal +++ b/property-list.cabal @@ -1,5 +1,5 @@ name: property-list -version: 0.0.1.0 +version: 0.0.3 stability: experimental license: PublicDomain @@ -16,14 +16,7 @@ flag HaXml_1_13 default: False - 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. + description: Compile against HaXml 1.13 rather than the latest. Library hs-source-dirs: src @@ -40,16 +33,20 @@ build-depends: base >= 4 && <5, bytestring, bytestring-class, - category-extras, containers, + comonad-transformers >= 1.8, dataenc, + free >= 1.8, mtl, old-locale, + pointed >= 1.8, pretty, + recursion-schemes >= 1.8, syb, template-haskell, time, - th-fold + th-fold, + void if flag(HaXml_1_13) other-modules: Data.PropertyList.Xml.Dtd_1_13 diff --git a/src/Data/PropertyList.hs b/src/Data/PropertyList.hs --- a/src/Data/PropertyList.hs +++ b/src/Data/PropertyList.hs @@ -97,9 +97,9 @@ -- -- (returns @Just True@) -- - -- > getItemAtKeyPath ["subDict"] (Just myPlist) :: M.Map String String + -- > getItemAtKeyPath ["subDict"] (Just myPlist) :: Maybe (M.Map String String) -- - -- (returns @M.fromList [(\"item 1\", \"This is item 1!\"), (\"item B\", \"YES\")]@. + -- (returns @Just (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.) @@ -107,8 +107,9 @@ -- > 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\")])])]@ + -- @plDict $ M.fromList [(\"omg\", + -- plDict $ M.fromList [(\"lolwut\", + -- plString \"roflcopter\")])]@ -- added to the root dictionary) -- -- > setItemAtKeyPath ["foo"] Nothing (Just myPlist) diff --git a/src/Data/PropertyList/PropertyListItem.hs b/src/Data/PropertyList/PropertyListItem.hs --- a/src/Data/PropertyList/PropertyListItem.hs +++ b/src/Data/PropertyList/PropertyListItem.hs @@ -48,11 +48,6 @@ (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 @@ -62,7 +57,7 @@ -- -- 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 +-- 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 @@ -212,10 +207,9 @@ typeWithVars = foldl appT (conT typeName) tyVars #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 612 - preds = [classP ''PropertyListItem [tyVar] | tyVar <- tyVars] - context = cxt preds + context = cxt [classP ''PropertyListItem [tyVar] | tyVar <- tyVars] #else - context = mapM (appT (conT ''PropertyListItem)) tyVars + context = cxt [appT (conT ''PropertyListItem) tyVar | tyVar <- tyVars] #endif inst = appT (conT ''PropertyListItem) typeWithVars diff --git a/src/Data/PropertyList/Types.hs b/src/Data/PropertyList/Types.hs --- a/src/Data/PropertyList/Types.hs +++ b/src/Data/PropertyList/Types.hs @@ -8,30 +8,42 @@ -- 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 +module Data.PropertyList.Types + ( -- * The 'PropertyList' data type + -- (the universal algebra/coalgebra for the unlifted signature) + + PropertyList + + -- * The 'PartialPropertyList' data type + -- (the universal algebra/coalgebra for the signature extended by + -- introducing new constructors) + , PartialPropertyList + + -- * Convenient functions for converting from 'PartialPropertyList' to + -- 'PropertyList'. + , completePropertyList + , completePropertyListBy + , completePropertyListByM + ) 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 -} +import Control.Applicative (Applicative(..)) +import Data.Functor.Foldable (Fix(..)) +import Data.Pointed (Pointed(..)) +import Data.Copointed (Copointed(..)) +import Control.Monad (liftM) +import Control.Monad.Free (Free(..)) +import Control.Monad.Identity (Identity(..)) +import Data.Foldable (Foldable) +import Data.Traversable (Traversable(traverse), mapM) +import Data.Void (Void, absurd) --- * The 'PropertyList' data type --- (the universal algebra/coalgebra for the unlifted signature) +import Unsafe.Coerce (unsafeCoerce) {- used _only_ to eliminate fmap traversals for newtype constructors -} -- |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 +newtype PropertyList = PL { unPL :: Fix PropertyListS } + deriving (Eq, Ord) {-# RULES -- don't traverse with no-ops! @@ -41,7 +53,7 @@ instance Show PropertyList where show pl = showsPrec 0 pl " :: PropertyList" - showsPrec p (PL x) = showParen (p > 10) $ case outF x of + showsPrec p (PL (Fix x)) = showParen (p > 10) $ case 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 @@ -51,69 +63,45 @@ PLString str -> showString "plString " . showsPrec 11 str PLBool bool -> showString "plBool " . showsPrec 11 bool -instance Copointed f => PListAlgebra f PropertyList where +instance (Functor f, Copointed f) => PListAlgebra f PropertyList where {-# SPECIALIZE instance PListAlgebra Identity PropertyList #-} - plistAlgebra = PL . InF . fmap unPL . extract + plistAlgebra = PL . Fix . fmap unPL . copoint 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 +instance (Functor f, Pointed f) => PListCoalgebra f PropertyList where {-# SPECIALIZE instance PListCoalgebra Identity PropertyList #-} plistCoalgebra = point . fmap PL . outF . unPL + where outF (Fix x) = x 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) + deriving (Eq, Ord, Functor, Applicative, Monad, Foldable, Traversable) {-# 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 Pointed PartialPropertyList where + point = PPL . Pure -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 () +-- | [internal] 'Free' constructor specialized to 'PartialPropertyList'. +-- 'point'/'pure'/'return' is the corresponding 'Pure' constructor. +inPPL :: PropertyListS (PartialPropertyList a) -> PartialPropertyList a +inPPL = PPL . Free . fmap unPPL 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 + showsPrec p (PPL x) = showParen (p > 10) $ case x of + Pure a -> showString "return " . showsPrec 11 a + Free 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 @@ -129,32 +117,29 @@ -- 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 +instance (Functor f, Copointed f) => PListAlgebra f (PartialPropertyList a) where {-# SPECIALIZE instance PListAlgebra Identity (PartialPropertyList a) #-} - plistAlgebra = inFree . extract + plistAlgebra = inPPL . copoint instance PListAlgebra Maybe (PartialPropertyList ()) where - plistAlgebra Nothing = return () - plistAlgebra (Just x) = inFree x + plistAlgebra Nothing = point () + plistAlgebra (Just x) = inPPL x instance PListAlgebra (Either a) (PartialPropertyList a) where - plistAlgebra (Left x) = return x - plistAlgebra (Right x) = inFree x + plistAlgebra (Left x) = point x + plistAlgebra (Right x) = inPPL x instance InitialPList (Either a) (PartialPropertyList a) where instance PListCoalgebra (Either a) (PartialPropertyList a) where - plistCoalgebra (PPL xf) = fmap (fmap PPL) (runFree xf) + plistCoalgebra (PPL (Pure a)) = Left a + plistCoalgebra (PPL (Free a)) = Right (fmap PPL a) 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'. + plistCoalgebra (PPL (Pure _)) = Nothing + plistCoalgebra (PPL (Free x)) = Just (fmap PPL x) -- |Take a 'PartialPropertyList' that has been expunged of all incomplete -- elements (as witnessed by the 'PListCoalgebra' 'Identity' @a@ context, which @@ -164,7 +149,8 @@ -- This is just a convenient synonym for 'fromPlist' with the types -- explicitly specialized. completePropertyList :: PListCoalgebra Identity a => PartialPropertyList a -> PropertyList -completePropertyList = fromPlist +completePropertyList = foldPList + (plistAlgebra :: PListCoalgebra Identity a => Either a (PropertyListS PropertyList) -> PropertyList) -- |Like 'completePropertyList' but also accepting a function that \"attempts\" -- to complete any incomplete value in the 'PartialPropertyList'. @@ -191,8 +177,8 @@ -- '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) +completePropertyListByM f = liftM completePropertyList . Data.Traversable.mapM f -- instance for Void to allow it to be used as @a@ in 'completePropertyList': instance Functor f => PListCoalgebra f Void where - plistCoalgebra = void + plistCoalgebra = absurd diff --git a/src/Data/PropertyList/Xml.hs b/src/Data/PropertyList/Xml.hs --- a/src/Data/PropertyList/Xml.hs +++ b/src/Data/PropertyList/Xml.hs @@ -19,6 +19,7 @@ ) where +import Data.Copointed import Data.PropertyList.Algebra import Data.PropertyList.Types import Data.PropertyList.Xml.Parse @@ -66,8 +67,11 @@ -- |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 +showXmlPropertyList :: (InitialPList f pl, Functor f, Copointed f) => pl -> String +showXmlPropertyList + = showXmlPlist + . plistItemToPlist + . fromPlist -- * Reading and writing XML 'PartialPropertyList's and 'PropertyList's from files @@ -96,7 +100,7 @@ -- initial propertylist type (which includes 'PropertyList', @'PartialPropertyList' -- 'UnparsedPlistItem'@, and @'PartialPropertyList' 'PlistItem'@). writeXmlPropertyListToFile - :: (InitialPList f pl, PListAlgebra f PlistItem) => + :: (InitialPList f pl, Functor f, Copointed f) => FilePath -> pl -> IO () writeXmlPropertyListToFile file plist = do writeXmlPlistToFile file (plistItemToPlist (fromPlist plist)) diff --git a/src/Data/PropertyList/Xml/Parse.hs b/src/Data/PropertyList/Xml/Parse.hs --- a/src/Data/PropertyList/Xml/Parse.hs +++ b/src/Data/PropertyList/Xml/Parse.hs @@ -19,7 +19,7 @@ import Data.PropertyList.Algebra import Data.PropertyList.Xml.Types -import Control.Functor.Pointed +import Data.Copointed import Control.Arrow ((+++)) import Control.Monad.Identity import qualified Data.Map as M @@ -51,7 +51,7 @@ instance PListAlgebra f PlistItem => PListAlgebra f Plist where plistAlgebra = plistItemToPlist . plistAlgebra . fmap (fmap plistToPlistItem) -instance Copointed f => PListAlgebra f PlistItem where +instance (Functor f, Copointed f) => PListAlgebra f PlistItem where {-# SPECIALIZE instance PListAlgebra Identity PlistItem #-} plistAlgebra = foldPropertyListS (\x -> OneOf9 (Array x) @@ -62,7 +62,7 @@ ) (\x -> SixOf9 (AInteger (show x)) ) (\x -> SevenOf9 (AString x) ) (\x -> if x then EightOf9 X.True else NineOf9 X.False - ) . extract + ) . copoint instance PListAlgebra (Either UnparsedPlistItem) PlistItem where plistAlgebra (Left unparsed) = unparsedPlistItemToPlistItem unparsed