xml-to-json 0.1.0.0 → 0.1.1.0
raw patch · 3 files changed
+205/−175 lines, 3 filesdep +containersdep −hashable
Dependencies added: containers
Dependencies removed: hashable
Files
- README.md +72/−26
- src/xml-to-json.hs +128/−145
- xml-to-json.cabal +5/−4
README.md view
@@ -2,6 +2,17 @@ Fast & easy command line tool for converting XML files to JSON. ++## Contents+* [Overview](#overview)+* [Installation](#installation)+* [Usage](#usage)+* [Example output](#example-output)+* [Performance](#performance)+++## Overview+ The output is designed to be easy to store and process using JSON-based databases, such as [mongoDB](http://www.mongodb.org/) and [CouchDB](http://couchdb.apache.org/). In fact, the original motivation for xml-to-json was to store and query a large (~10GB) XML-based dataset, using an off-the-shelf scalable JSON database. Currently the tool processes XMLs according to lossy rules designed to produce sensibly minimal output. If you need to convert without losing information at all consider something like the XSLT offered by the [jsonml project](http://www.jsonml.org/). Unlike jsonml, this tool - xml-to-json - produces json output similar (but not identical) to the [xml2json-xslt project](http://code.google.com/p/xml2json-xslt/).@@ -12,12 +23,24 @@ As of this writing, xml-to-json uses [hxt](http://hackage.haskell.org/package/hxt) with the [expat](http://expat.sourceforge.net/)-based [hxt-expat](http://hackage.haskell.org/package/hxt-expat) parser. The pure Haskell parsers for hxt [all seem to have memory issues](http://stackoverflow.com/q/2292729/562906) which hxt-expat doesn't. -## Contents+## Installation -* [Usage](#usage)-* [Example output](#example-output)-* [Performance](#performance)+**Note for Windows users**: [Download pre-built exe here](https://github.com/downloads/sinelaw/xml-to-json/xml-to-json.zip). I managed to compile using [cygwin](http://www.cygwin.org). Use the [xml-to-json branch for cygwin](https://github.com/sinelaw/xml-to-json/tree/cygwin) if you're trying to build for windows. The main difference is lack of curl support. +To install the **release version**: Since xml-to-json is implemented in Haskell, "all you need to do" is install the latest [Haskell platform](http://www.haskell.org/platform/) for your system, and then run:++```+cabal update+cabal install xml-to-json+```++To install **from source**: Clone this repository locally, and then (assuming you have [Haskell platform](http://www.haskell.org/platform/) installed) run `cabal install`:++```+cd xml-to-json+cabal install+```+ ## Usage ### Basic usage@@ -34,14 +57,18 @@ Here's a (possibly outdated) snapshot of the `--help` output: ```-Usage: xml-to-json [OPTION...] files...- -h --help Show this help- -t TAG --tag-name=TAG Start conversion with nodes named TAG (ignoring all parent nodes)- -s --skip-roots Ignore the selected nodes, and start converting from their children- (can be combined with the 'start-tag' option to process only children of the matching nodes)- -m --multiline Output each of the top-level converted json objects on a seperate line- -n --ignore-nulls Ignore nulls (do not output them) in the top-level output objects- -a --as-array Output the resulting objects in a top-level JSON array+Usage: <program> [OPTION...] files...+ -h --help Show this help+ -t TAG --tag-name=TAG Start conversion with nodes named TAG (ignoring all parent nodes)+ -s --skip-roots Ignore the selected nodes, and start converting from their children+ (can be combined with the 'start-tag' option to process only children of the matching nodes)+ -a --as-array Output the resulting objects in a top-level JSON array+ -m --multiline When using 'as-array' output, print each of top-level json object on a seperate line.+ (If not using 'as-array', this option will be on regardless, and output is always line-seperated.)+ --no-collapse-text Don't collapse elements that only contain text into a simple string property.+ Instead, always emit '.value' properties for text nodes, even if an element contains only text.+ (Output 'schema' will be more stable.)+ --no-ignore-nulls Don't ignore nulls (and do output them) in the top level of output objects ``` ## Example output@@ -53,6 +80,7 @@ <!DOCTYPE Test> <Tests> <Test Name="The First Test">+ <SomeText>Some simple text</SomeText> <Description Format="FooFormat"> Just a dummy <!-- comment -->@@ -63,31 +91,49 @@ </Tests> ``` -JSON output (formatted for readability - actual output a single line):+JSON output using default settings:+```+{"Tests":{"Test":[{"Name":"The First Test","SomeText":"Some simple text","Description":{"Format":"FooFormat","value":"Just a dummy\n\nXml file."}},{"Name":"Second"}]}}+``` +Formatted for readability (not the actual output):+ ``` {- "Tests" : { - "Test" : [- { "Name" : "The First Test", - "Description" : {- "Format" : "FooFormat",- "value" : "Just a dummy\n\nXml file."- }- },- { "Name" : "Second" }- ]- }+ "Tests":{+ "Test":[+ {+ "Name":"The First Test",+ "SomeText":"Some simple text",+ "Description":{+ "Format":"FooFormat",+ "value":"Just a dummy\n\nXml file."+ }+ },+ {+ "Name":"Second"+ }+ ]+ } } ``` +Using the various options you can control various aspects of the output such as: +* At which top-level nodes the conversion starts to work (-t)+* Whether to wrap the output in a top-level JSON array,+* Whether or not to collapse simple string elements, such as the <SomeText> element in the example, into a simple string property+* And more. +Use the `--help` option to see a full list of options. ## Performance -The speed on a core-i5 machine is about 1.8MB of xml / sec, with a 100MB XML file resulting in a 56MB json output.+For large XML files, the speed on a core-i5 machine is about 2MB of xml / sec, with a 100MB XML file resulting in a 56MB json output. It took about 10 minutes to process 1GB of xml data. The main performance limit is memory - only one single-threaded process was running since every single large file (tens of megabytes) consumes a lot of memory - about 50 times the size of the file. A few simple tests have shown this to be at least twice as fast as [jsonml's xlst-based converter](http://www.jsonml.org/xml/) (however, the outputs are not similar, as stated above).- ++Currently the program processes files serially. If run in parallel on many small XML files (<5MB) the performance becomes cpu-bound and processing may be *much* faster, depending on the architecture. A simple test showed performance of about 5MB / sec (on the same core-i5).++
src/xml-to-json.hs view
@@ -1,183 +1,166 @@-module Main-where- -import System.IO -import System.Exit -import System.Console.GetOpt -import Text.XML.HXT.Core ((>>>), (&&&), readDocument, getChildren, getText, isElem, - XmlTree, XNode(..), deep, getName, localPart, hasName, - ArrowXml, runLA, getAttrl, runX, withValidate, no, yes)-import Text.XML.HXT.Expat-import Text.XML.HXT.Curl -- use libcurl for HTTP access- -- only necessary when reading http://...+module Main(main) where++import Control.Category (id)+import Control.Applicative ((<*), (*>))+import Control.Arrow (first, (>>>), (&&&), (***))+import Control.Monad (when, forM_)+import Data.Maybe (catMaybes)+import Data.Tree.NTree.TypeDefs+import Prelude hiding (id)+import System.Console.GetOpt (OptDescr(..), ArgDescr(NoArg, ReqArg), ArgOrder(Permute), usageInfo, getOpt)+import System.Environment (getArgs)+import System.Exit (ExitCode(ExitFailure), exitWith)+import System.IO (hPutStrLn, stderr)+import Text.XML.HXT.Core (readDocument, getChildren, getText, isElem, XmlTree, XNode(..), deep, getName, localPart, hasName, ArrowXml, runLA, getAttrl, runX, withValidate, no)+import Text.XML.HXT.Curl -- use libcurl for HTTP access, only necessary when reading http://...+import Text.XML.HXT.Expat (withExpat) import qualified Data.Aeson as Aeson-import qualified Data.HashMap.Strict as M-import Data.Hashable (Hashable, hash)-import Data.Tree.NTree.TypeDefs -import System.Environment-import qualified Data.Vector as Vector-import Data.Maybe (isJust, fromJust, fromMaybe)-import qualified Data.Text as T import qualified Data.ByteString.Lazy.Char8 as BS-import Control.Monad (when, forM_)- +import qualified Data.HashMap.Strict as HashMap+import qualified Data.Map as M+import qualified Data.Text as T+import qualified Data.Vector as Vector -data Flag = Input String | StartFrom String | Multiline | SkipRoots | IgnoreNulls | WrapArray | ShowHelp+data Flag = Input String | StartFrom String | Multiline | SkipRoots | NoIgnoreNulls | WrapArray | NoCollapseText | ShowHelp deriving (Show, Eq) -inp :: Maybe String -> Flag-inp = Input . fromMaybe ""- options :: [OptDescr Flag] options =- [ Option ['h'] ["help"] (NoArg ShowHelp) "Show this help" - , Option ['t'] ["tag-name"] (ReqArg StartFrom "TAG") "Start conversion with nodes named TAG (ignoring all parent nodes)"- , Option ['s'] ["skip-roots"] (NoArg SkipRoots) ("Ignore the selected nodes, and start converting from their children\n" - ++ "(can be combined with the 'start-tag' option to process only children of the matching nodes)")- , Option ['m'] ["multiline"] (NoArg Multiline) "Output each of the top-level converted json objects on a seperate line"- , Option ['n'] ["ignore-nulls"] (NoArg IgnoreNulls) "Ignore nulls (do not output them) in the top-level output objects"- , Option ['a'] ["as-array"] (NoArg WrapArray) "Output the resulting objects in a top-level JSON array"- ]+ [ Option "h" ["help"] (NoArg ShowHelp) "Show this help"+ , Option "t" ["tag-name"] (ReqArg StartFrom "TAG") "Start conversion with nodes named TAG (ignoring all parent nodes)"+ , Option "s" ["skip-roots"] (NoArg SkipRoots) ("Ignore the selected nodes, and start converting from their children\n"+ ++ "(can be combined with the 'start-tag' option to process only children of the matching nodes)")+ , Option "a" ["as-array"] (NoArg WrapArray) "Output the resulting objects in a top-level JSON array"+ , Option "m" ["multiline"] (NoArg Multiline) ("When using 'as-array' output, print each of top-level json object on a seperate line.\n" + ++ "(If not using 'as-array', this option will be on regardless, and output is always line-seperated.)")+ , Option "" ["no-collapse-text"] (NoArg NoCollapseText) ("Don't collapse elements that only contain text into a simple string property.\n"+ ++ "Instead, always emit '.value' properties for text nodes, even if an element contains only text.\n"+ ++ "(Output 'schema' will be more stable.)")+ , Option "" ["no-ignore-nulls"] (NoArg NoIgnoreNulls) "Don't ignore nulls (and do output them) in the top level of output objects"+ ] parseOptions :: [String] -> IO ([Flag], [String])-parseOptions argv = +parseOptions argv = case getOpt Permute options argv of (o,n,[] ) -> return (o,n) (_,_,errs) -> ioError (userError (concat errs ++ usageInfo usageHeader options))- + usageHeader :: String usageHeader = "Usage: <program> [OPTION...] files..."- + getStartNodes :: ArrowXml cat => [Flag] -> cat (NTree XNode) XmlTree-getStartNodes flags = case (filter f' flags) of- [] -> getChildren >>> isElem- [StartFrom x] -> deep (isElem >>> hasName x) - _ -> error "Expecting at most one 'start-tag' option"- where f' (StartFrom _) = True- f' _ = False- +getStartNodes flags =+ case [x | StartFrom x <- flags] of+ [] -> getChildren >>> isElem+ [x] -> deep (isElem >>> hasName x)+ _ -> error "Expecting at most one --tag-name (-t) option"+ main :: IO () main = do- args <- getArgs- (flags, inputFiles) <- parseOptions args- - case (elem ShowHelp flags || (null flags && null inputFiles)) of - True -> die $ usageInfo usageHeader options- False -> return ()- - let startNodesFilter = getStartNodes flags- wrapArray = elem WrapArray flags- skipRoots = elem SkipRoots flags- multiline = case (elem Multiline flags, wrapArray) of- (False, False) -> BS.concat- (False, True) -> BS.intercalate (BS.pack ",") - (True, False) -> BS.intercalate (BS.pack "\n") - (True, True) -> BS.intercalate (BS.pack ",\n") - - ignoreNulls = case (elem IgnoreNulls flags) of- False -> const True- True -> (/= Aeson.Null)- - nodesFilter = case skipRoots of- False -> startNodesFilter- True -> startNodesFilter >>> getChildren- - forM_ inputFiles $ \src -> do - rootElems <- runX ( readDocument [withValidate no- ,withExpat True- ,withCurl []- ] src- >>> nodesFilter )- -- TODO: de-uglify and optimize the following- when wrapArray $ putStr "["- BS.putStr $ multiline- . map Aeson.encode - . filter ignoreNulls - . map (wrapRoot . xmlTreeToJSON)- $ rootElems- when wrapArray $ putStr "]"- return ()- - return ()+ args <- getArgs+ (flags, inputFiles) <- parseOptions args + when (elem ShowHelp flags || (null flags && null inputFiles)) .+ die $ usageInfo usageHeader options -data JSValueName = Text | Tag String | Attr String- deriving (Eq, Ord, Show)+ let+ skipRoots = SkipRoots `elem` flags+ wrapArray = WrapArray `elem` flags+ collapseText = NoCollapseText `notElem` flags+ wrapAction act+ | wrapArray = putStr "[" *> act <* putStr "]"+ | otherwise = act+ multiline = case (wrapArray, Multiline `elem` flags) of+ (False, _) -> BS.intercalate (BS.pack "\n")+ (True, False) -> BS.intercalate (BS.pack ",")+ (True, True) -> BS.intercalate (BS.pack ",\n") -instance Hashable JSValueName where- hash Text = 0- hash (Tag s) = hash s- hash (Attr s) = hash s- -concatMapValues :: (Eq k, Hashable k) => [M.HashMap k v] -> M.HashMap k [v] -concatMapValues = foldr (M.unionWith (++) . M.map (:[])) M.empty + ignoreNulls+ | NoIgnoreNulls `notElem` flags =+ filter (/= Aeson.Null)+ | otherwise = id -fromObject :: Aeson.Value -> Maybe Aeson.Object-fromObject (Aeson.Object objMap) = Just objMap-fromObject _ = Nothing+ nodesFilter+ | skipRoots = getChildren+ | otherwise = id -getAttrVals :: XmlTree -> [(String, String)]-getAttrVals node = runLA (getAttrl >>> getName &&& (getChildren >>> getText)) node+ forM_ inputFiles $ \src -> do+ rootElems <-+ runX $+ readDocument+ [ withValidate no+ , withExpat True+ , withCurl []+ ]+ src+ >>> getStartNodes flags+ >>> nodesFilter+ -- TODO: de-uglify and optimize the following+ wrapAction+ . BS.putStr . multiline+ . map Aeson.encode+ . ignoreNulls+ . map (wrapRoot . xmlTreeToJSON collapseText)+ $ rootElems -arrayValuesToJSONArrays :: (Eq k, Hashable k) => M.HashMap k [Aeson.Value] -> M.HashMap k Aeson.Value-arrayValuesToJSONArrays = M.map fromJust- . M.filter isJust- . M.map (\v -> case v of - [] -> Nothing -- will be discarded- [x] -> Just x -- don't store as array, just a single value- xss -> Just $ Aeson.Array . Vector.fromList $ xss) -- arrays with more than one element are kept+data JSValueName = Text | Tag String | Attr String+ deriving (Eq, Ord, Show) --- apply on object internal maps, ignore non-object json values (don't apply on arrays)-fmapObj :: (Aeson.Object -> Aeson.Object) -> Aeson.Value -> Aeson.Value-fmapObj f (Aeson.Object objMap) = Aeson.Object (f objMap)-fmapObj _ val = val +concatMapValues :: (Ord k) => [M.Map k v] -> M.Map k [v]+concatMapValues = M.unionsWith (++) . (fmap . fmap) (: []) -packJSValueName :: JSValueName -> T.Text +getAttrVals :: XmlTree -> [(String, String)]+getAttrVals = runLA (getAttrl >>> getName &&& (getChildren >>> getText))++arrayValuesToJSONArrays :: (Ord k) => M.Map k [Aeson.Value] -> M.Map k Aeson.Value+arrayValuesToJSONArrays = M.mapMaybe f+ where+ f [] = Nothing -- will be discarded+ f [x] = Just x -- don't store as array, just a single value+ f xss = Just $ Aeson.Array . Vector.fromList $ xss -- arrays with more than one element are kept++packJSValueName :: JSValueName -> T.Text packJSValueName Text = T.pack "value" packJSValueName (Attr x) = T.pack x packJSValueName (Tag x) = T.pack x -mapKeys :: (Eq k1, Eq k2, Hashable k1, Hashable k2) => (k1 -> k2) -> M.HashMap k1 v -> M.HashMap k2 v-mapKeys f = M.foldrWithKey (\k v -> M.insert (f k) v) M.empty- wrapRoot :: Maybe (JSValueName, Aeson.Value) -> Aeson.Value wrapRoot Nothing = Aeson.Null-wrapRoot (Just (a, b)) = Aeson.object [(packJSValueName a, b)] +wrapRoot (Just (a, b)) = Aeson.object [(packJSValueName a, b)] --- converts a map to a json value, usually resulting in a json object unless the map contains ONLY a single Text entry, +-- converts a map to a json value, usually resulting in a json object unless the map contains ONLY a single Text entry, -- in which case the value produced is a json string-tagMapToJSValue :: M.HashMap JSValueName Aeson.Value -> Aeson.Value-tagMapToJSValue m = case (M.toList m) of- [(Text, val)] -> val- _ -> Aeson.Object . mapKeys packJSValueName $ m- -xmlTreeToJSON :: XmlTree -> Maybe (JSValueName, Aeson.Value)-xmlTreeToJSON node@(NTree (XTag qName _) children) - = Just (Tag (localPart qName), - tagMapToJSValue objMap)- where objMap = arrayValuesToJSONArrays -- unify into a single map,- . concatMapValues -- grouping into arrays by pair name- . map (uncurry M.singleton) -- convert pairs to maps- . (++) attrVals - . map fromJust -- unpack the Just values- . filter isJust -- filter out the empty values (unconvertable nodes)- $ map xmlTreeToJSON children -- convert xml nodes to Maybe (QName, Aeson.Value) pairs- - attrVals = map (\(name, val) -> (Attr name, Aeson.String (T.pack val))) $ getAttrVals node +tagMapToJSValue :: Bool -> M.Map JSValueName Aeson.Value -> Aeson.Value+tagMapToJSValue collapseText m = case (collapseText, M.toList m) of+ (True, [(Text, val)]) -> val+ _ ->+ Aeson.Object . HashMap.fromList . (map . first) packJSValueName $ M.toList m -xmlTreeToJSON (NTree (XText str) _) = if (T.empty == text) - then Nothing- else Just $ (Text, Aeson.String text)- where text = T.strip . T.pack $ str+xmlTreeToJSON :: Bool -> XmlTree -> Maybe (JSValueName, Aeson.Value)+xmlTreeToJSON collapseText node@(NTree (XTag qName _) children)+ = Just (Tag (localPart qName),+ tagMapToJSValue collapseText objMap)+ where+ objMap =+ arrayValuesToJSONArrays -- unify into a single map,+ . concatMapValues -- grouping into arrays by pair name+ . map (uncurry M.singleton) -- convert pairs to maps+ . (++) attrVals+ . catMaybes -- filter out the empty values (unconvertable nodes)+ $ map (xmlTreeToJSON collapseText) children -- convert xml nodes to Maybe (QName, Aeson.Value) pairs -xmlTreeToJSON _ = Nothing - + attrVals =+ map (Attr *** Aeson.String . T.pack) $ getAttrVals node +xmlTreeToJSON _ (NTree (XText str) _)+ | T.null text = Nothing+ | otherwise = Just (Text, Aeson.String text)+ where+ text = T.strip $ T.pack str -die :: String -> IO a-die msg = do putErrLn (msg)- exitWith (ExitFailure 1)- +xmlTreeToJSON _ _ = Nothing -putErrLn :: String -> IO ()-putErrLn = hPutStrLn stderr+die :: String -> IO a+die msg = do+ hPutStrLn stderr msg+ exitWith (ExitFailure 1)
xml-to-json.cabal view
@@ -1,5 +1,5 @@ name: xml-to-json-version: 0.1.0.0+version: 0.1.1.0 synopsis: Simple command line tool for converting XML files to json description: This simple tool converts XMLs to json format, gaining readability while losing information such as comments, attribute ordering, and such. @@ -22,10 +22,11 @@ source-repository head type: git- location: https://github.com/sinelaw/xml-to-json+ location: https://github.com/sinelaw/xml-to-json.git executable xml-to-json main-is: src/xml-to-json.hs -- other-modules: - build-depends: base ==4.5.*, hxt, hxt-curl, aeson, text, unordered-containers, hashable, vector, bytestring, hxt-tagsoup, hxt-expat- ghc-options: -Wall -O2 + build-depends: base ==4.5.*, hxt, hxt-curl, aeson, text,+ containers, unordered-containers, vector, bytestring, hxt-tagsoup, hxt-expat+ ghc-options: -Wall -O2