diff --git a/README b/README --- a/README +++ b/README @@ -7,12 +7,19 @@ binary1 fromat support is TODO. I don't know reference implementation of ISO 8601 in Haskell, so date is not validated and is pepresented as String + * Install cabal configure cabal build cabal install -Yuras Shumovich -shumovichy@gmail.com +* Author +Yuras Shumovich + + +* Contributors + +Yuras Shumovich +Michael Tolly diff --git a/plist.cabal b/plist.cabal --- a/plist.cabal +++ b/plist.cabal @@ -1,53 +1,35 @@ -name: plist -version: 0.0.2.1 -cabal-version: -any -build-type: Simple -license: BSD3 -license-file: LICENSE -copyright: (c) 2009, Yuras Shumovich -maintainer: shumovichy@gmail.com -build-depends: base >=3 && < 5, dataenc -any, hxt >= 8.3.0 && < 9.0 -stability: experimental -homepage: -package-url: -bug-reports: -synopsis: Generate and parse Mac OX property list format -description: Simple helper to generate and parse Mac OS X plist format. - Currently it supports only 'xml1' format. - It is based on Haskell XML Toolbox. - . - See - - for details about plist format. -category: XML -author: Yuras Shumovich -tested-with: -data-files: LICENSE README -data-dir: "" -extra-source-files: -extra-tmp-files: -exposed-modules: Text.XML.Plist Text.XML.Plist.PlObject - Text.XML.Plist.Write Text.XML.Plist.Read -exposed: True -buildable: True -build-tools: -cpp-options: -cc-options: -ld-options: -pkgconfig-depends: -frameworks: -c-sources: -extensions: -extra-libraries: -extra-lib-dirs: -includes: -install-includes: -include-dirs: -hs-source-dirs: src -other-modules: -ghc-prof-options: -ghc-shared-options: -ghc-options: -Wall -hugs-options: -nhc98-options: -jhc-options: +name: plist +version: 0.0.3 +license: BSD3 +license-file: LICENSE +author: Yuras Shumovich , + Michael Tolly +maintainer: Yuras Shumovich +copyright: (c) 2009, 2012 Yuras Shumovich +category: XML +build-type: Simple +cabal-version: >= 1.6 +synopsis: Generate and parse Mac OX property list format +description: Simple helper to generate and parse Mac OS X plist format. + Currently it supports only 'xml1' format. + It is based on Haskell XML Toolbox. + . + See + + for details about plist format. +data-files: LICENSE README + +source-repository head + type: git + location: http://github.com/Yuras/plist.git + +library + hs-source-dirs: src + build-depends: base >= 4.3 && < 5, + dataenc -any, + hxt >= 9 && < 10 + exposed-modules: Text.XML.Plist + Text.XML.Plist.PlObject + Text.XML.Plist.Write + Text.XML.Plist.Read + ghc-options: -Wall diff --git a/src/Text/XML/Plist.hs b/src/Text/XML/Plist.hs --- a/src/Text/XML/Plist.hs +++ b/src/Text/XML/Plist.hs @@ -1,14 +1,14 @@ ----------------------------------------------------------------------------- -- -- Module : Text.XML.Plist --- Copyright : (c) Yuras Shumovich 2009 +-- Copyright : (c) Yuras Shumovich 2009, Michael Tolly 2012 -- License : BSD3 -- -- Maintainer : shumovichy@gmail.com -- Stability : experimental -- Portability : portable -- --- |Library for generation and parsing Mac OS X plist format +-- | Library for generation and parsing Mac OS X plist format -- ----------------------------------------------------------------------------- diff --git a/src/Text/XML/Plist/PlObject.hs b/src/Text/XML/Plist/PlObject.hs --- a/src/Text/XML/Plist/PlObject.hs +++ b/src/Text/XML/Plist/PlObject.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- -- Module : Text.XML.Plist.PlObject --- Copyright : (c) Yuras Shumovich 2009 +-- Copyright : (c) Yuras Shumovich 2009, Michael Tolly 2012 -- License : BSD3 -- -- Maintainer : shumovichy@gmail.com @@ -26,25 +26,17 @@ import Data.Word --- |Data type that represents plist object -data PlObject = - -- |string - PlString String | - -- |bool - PlBool Bool | - -- |integer - PlInteger Int | - -- |real - PlReal Double | - -- |array - PlArray [PlObject] | - -- |dictionary - PlDict [(String, PlObject)] | - -- |raw data - PlData [Word8] | - -- |date (ISO 8601, but currently it is not validated) - PlDate String - deriving Show +-- | Data type that represents plist object +data PlObject + = PlString String -- ^ string + | PlBool Bool -- ^ bool + | PlInteger Int -- ^ integer + | PlReal Double -- ^ real + | PlArray [PlObject] -- ^ array + | PlDict [(String, PlObject)] -- ^ dictionary + | PlData [Word8] -- ^ raw data + | PlDate String -- ^ date (ISO 8601, but currently it is not validated) + deriving (Eq, Ord, Show, Read) fromPlString :: Monad m => PlObject -> m String fromPlString (PlString str) = return str diff --git a/src/Text/XML/Plist/Read.hs b/src/Text/XML/Plist/Read.hs --- a/src/Text/XML/Plist/Read.hs +++ b/src/Text/XML/Plist/Read.hs @@ -1,14 +1,14 @@ ----------------------------------------------------------------------------- -- -- Module : Text.XML.Plist.Read --- Copyright : (c) Yuras Shumovich 2009 +-- Copyright : (c) Yuras Shumovich 2009, 2012, Michael Tolly 2012 -- License : BSD3 -- -- Maintainer : shumovichy@gmail.com -- Stability : experimental -- Portability : portable -- --- |Parsing property list format +-- | Parsing property list format -- ----------------------------------------------------------------------------- @@ -21,72 +21,62 @@ ) where import Text.XML.Plist.PlObject -import Text.XML.HXT.Arrow +import Text.XML.HXT.Arrow.ReadDocument +import Text.XML.HXT.Arrow.XmlArrow +import Text.XML.HXT.Arrow.XmlState +import Control.Arrow +import Control.Arrow.ArrowList +import Control.Arrow.ArrowTree +import Text.XML.HXT.DOM.TypeDefs +import Control.Arrow.ArrowIf import Codec.Binary.Base64 import Data.Maybe --- |Read 'PlObject' from file. -readPlistFromFile :: String -> IO PlObject -readPlistFromFile fileName = - do - res <- runX ( - readDocument [] fileName >>> - plistToObject - ) - if null res - then fail $ "can't parse " ++ fileName - else return $ head res +-- | Read 'PlObject' from file. +readPlistFromFile :: SysConfigList -> String -> IO PlObject +readPlistFromFile opts fileName = do + res <- runX $ readDocument opts fileName >>> plistToObject + case res of + [] -> fail $ "can't parse " ++ fileName + (x:_) -> return x --- |Arrow that converts xml tree to 'PlObject'. +-- | Arrow that converts XML tree to 'PlObject'. -- Tree should contain at list one \"plist\" element. plistToObject :: ArrowXml a => a XmlTree PlObject -plistToObject = - deep (hasName "plist") >>> - getChildren >>> - xmlToObject +plistToObject = deep (hasName "plist") >>> getChildren >>> xmlToObject --- |Arrow that converts xml element to 'PlObject'. --- Element should be \"string\", \"array\", \"dict\", etc. +-- | Arrow that converts XML element to 'PlObject'. +-- Element should be \"string\", \"array\", \"dict\", etc. xmlToObject :: ArrowXml a => a XmlTree PlObject -xmlToObject = choiceA [ - hasName "string" :-> (innerText >>> arr PlString), - hasName "true" :-> constA (PlBool True), - hasName "false" :-> constA (PlBool False), - hasName "integer" :-> (innerText >>> arr (PlInteger . read)), - hasName "real" :-> (innerText >>> arr (PlReal . read)), - hasName "array" :-> (listA readArray >>> arr PlArray), - hasName "dict" :-> (readDict >>> arr PlDict), - hasName "data" :-> ( - innerText >>> - arr (decode . unchop . lines) >>> - isA isJust >>> - arr fromJust >>> - arr PlData - ), - hasName "date" :-> (innerText >>> arr PlDate) - ] +xmlToObject = choiceA + [ hasName "string" :-> (innerText >>> arr PlString) + , hasName "true" :-> constA (PlBool True) + , hasName "false" :-> constA (PlBool False) + , hasName "integer" :-> (innerText >>> arr (PlInteger . read)) + , hasName "real" :-> (innerText >>> arr (PlReal . read)) + , hasName "array" :-> (listA readArray >>> arr PlArray) + , hasName "dict" :-> (readDict >>> arr PlDict) + , hasName "data" :-> ( + innerText >>> + arr (decode . unchop . lines) >>> + isA isJust >>> + arr fromJust >>> + arr PlData + ) + , hasName "date" :-> (innerText >>> arr PlDate) ] readDict :: ArrowXml a => a XmlTree [(String, PlObject)] -readDict = listA $ - readDict' $< listA (getChildren >>> isElem) +readDict = listA $ readDict' $< listA (getChildren >>> isElem) readDict' :: ArrowXml a => [XmlTree] -> a b (String, PlObject) -readDict' [] = none -readDict' [_] = none readDict' (key : val : xs) = - ((constA key >>> hasName "key" >>> innerText) &&& - (constA val >>> xmlToObject)) <+> - readDict' xs + ((constA key >>> hasName "key" >>> innerText) &&& + (constA val >>> xmlToObject)) <+> + readDict' xs +readDict' _ = none readArray :: ArrowXml a => a XmlTree PlObject -readArray = - getChildren >>> - xmlToObject +readArray = getChildren >>> xmlToObject innerText :: ArrowXml a => a XmlTree String -innerText = withDefault (single ( - getChildren >>> - isText >>> - getText - )) "" - +innerText = withDefault (single (getChildren >>> isText >>> getText)) "" diff --git a/src/Text/XML/Plist/Write.hs b/src/Text/XML/Plist/Write.hs --- a/src/Text/XML/Plist/Write.hs +++ b/src/Text/XML/Plist/Write.hs @@ -1,14 +1,14 @@ ----------------------------------------------------------------------------- -- -- Module : Text.XML.Plist.Write --- Copyright : (c) Yuras Shumovich 2009 +-- Copyright : (c) Yuras Shumovich 2009, Michael Tolly 2012 -- License : BSD3 -- -- Maintainer : shumovichy@gmail.com -- Stability : experimental -- Portability : portable -- --- |Generating property list format +-- | Generating property list format -- ----------------------------------------------------------------------------- @@ -21,39 +21,48 @@ ) where import Text.XML.Plist.PlObject -import Text.XML.HXT.Arrow +import Text.XML.HXT.Arrow.XmlState import Codec.Binary.Base64 +import Control.Monad (void) --- |Write 'PlObject' to file +import Control.Arrow.IOStateListArrow +import Text.XML.HXT.Arrow.WriteDocument +import Text.XML.HXT.Arrow.XmlArrow +import Text.XML.HXT.Arrow.XmlOptions +import Control.Arrow +import Control.Arrow.ArrowList +import Text.XML.HXT.DOM.TypeDefs +import Text.XML.HXT.Arrow.XmlState.TypeDefs + +-- | Write 'PlObject' to file writePlistToFile :: String -> PlObject -> IO () -writePlistToFile fileName object = runX (constA object >>> writePlist fileName) >> return () +writePlistToFile fileName object = + void $ runX (constA object >>> writePlist fileName) writePlist :: String -> IOSLA (XIOState s) PlObject XmlTree -writePlist fileName = - objectToPlist >>> - writeDocument [(a_indent, "1"), (a_add_default_dtd, "1")] fileName +writePlist fileName = objectToPlist >>> + writeDocument [setS theAttrList attrs] fileName + where attrs = [(a_indent, "1"), (a_add_default_dtd, "1")] --- |Arrow to convert 'PlObject' to plist with root element and DTD declaration. +-- | Arrow to convert 'PlObject' to plist with root element and DTD declaration. objectToPlist :: ArrowDTD a => a PlObject XmlTree -objectToPlist = root [ - sattr "doctype-name" "plist", - sattr "doctype-SYSTEM" "http://www.apple.com/DTDs/PropertyList-1.0.dtd", - sattr "doctype-PUBLIC" "-//Apple Computer//DTD PLIST 1.0//EN" - ] [mkelem "plist" [sattr "version" "1.0"] [objectToXml $< this]] +objectToPlist = root + [ sattr "doctype-name" "plist" + , sattr "doctype-SYSTEM" "http://www.apple.com/DTDs/PropertyList-1.0.dtd" + , sattr "doctype-PUBLIC" "-//Apple Computer//DTD PLIST 1.0//EN" + ] [mkelem "plist" [sattr "version" "1.0"] [objectToXml $< this]] --- |Arrow to convert 'PlObject' to xml. It produces 'XmlTree' without root element. +-- | Arrow to convert 'PlObject' to XML. It produces 'XmlTree' without root +-- element. objectToXml :: ArrowXml a => PlObject -> a b XmlTree objectToXml (PlString str) = selem "string" [txt str] objectToXml (PlBool bool) = eelem $ if bool then "true" else "false" objectToXml (PlInteger int) = selem "integer" [txt $ show int] objectToXml (PlReal real) = selem "real" [txt $ show real] objectToXml (PlArray objects) = selem "array" $ map objectToXml objects -objectToXml (PlDict objects) = selem "dict" elems - where - elems = concatMap toXml objects - toXml (key, val) = [selem "key" [txt key], objectToXml val] -objectToXml (PlData dat) = selem "data" [txt $ enc dat] - where - enc = (++ "\n") . foldr ((++) . ("\n" ++)) "" . chop 20 . encode +objectToXml (PlDict objects) = selem "dict" elems where + elems = concatMap toXml objects + toXml (key, val) = [selem "key" [txt key], objectToXml val] +objectToXml (PlData dat) = selem "data" [txt $ enc dat] where + enc = (++ "\n") . foldr ((++) . ("\n" ++)) "" . chop 20 . encode objectToXml (PlDate date) = selem "date" [txt date] -