xml-to-json 0.1.1.0 → 0.1.2.0
raw patch · 5 files changed
+257/−197 lines, 5 filesdep +curldep +hashabledep +regex-posixdep ~base
Dependencies added: curl, hashable, regex-posix, xml-to-json
Dependency ranges changed: base
Files
- README.md +22/−17
- src-exec/Main.hs +53/−0
- src/XmlToJson.hs +158/−0
- src/xml-to-json.hs +0/−166
- xml-to-json.cabal +24/−14
README.md view
@@ -1,6 +1,6 @@ # xml-to-json -Fast & easy command line tool for converting XML files to JSON.+Fast & easy library & command line tool for converting XML files to JSON. ## Contents@@ -15,17 +15,17 @@ 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/).+Currently the xml-to-json 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/). ### Implementation Notes -xml-to-json is implemented in [Haskell](http://www.haskell.org). Currently the implementation is minimal - for example, the core translation functionality is not exported as a library. If you want to use it as a library, open an issue on this project (or better yet - do it and submit a pull request).+xml-to-json is implemented in [Haskell](http://www.haskell.org). 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. ## Installation -**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.+**Note for Windows users**: Only local files, not URLs, are supported as command line arguments. This is because **curl** doesn't compile on my (windows + cygwin) machine out-of-the-box. 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: @@ -58,17 +58,18 @@ ``` 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+ -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=PATTERN For elements with tag matching regex PATTERN only:+ 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@@ -81,6 +82,7 @@ <Tests> <Test Name="The First Test"> <SomeText>Some simple text</SomeText>+ <SomeMoreText>More text</SomeMoreText> <Description Format="FooFormat"> Just a dummy <!-- comment -->@@ -104,6 +106,7 @@ "Test":[ { "Name":"The First Test",+ "SomeMoreText":"More text", "SomeText":"Some simple text", "Description":{ "Format":"FooFormat",@@ -118,12 +121,14 @@ } ``` +Note that currently xml-to-json does not retain the order of elements / attributes.+ 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.+* Whether or not to collapse simple string elements, such as the <SomeText> element in the example, into a simple string property (you can specify a regular expression pattern to decide which nodes to collapse)+* And more... Use the `--help` option to see a full list of options.
+ src-exec/Main.hs view
@@ -0,0 +1,53 @@+module Main(main) where + +import System.Environment (getArgs) +import Control.Monad (when) +import System.Console.GetOpt (ArgDescr (NoArg, ReqArg), + ArgOrder (Permute), OptDescr (..), + getOpt, usageInfo) +import System.Exit (ExitCode (ExitFailure), exitWith) +import System.IO (hPutStrLn, stderr) +import XmlToJson + +main :: IO () +main = do + args <- getArgs + (flags, inputFiles) <- parseOptions args + + when (elem ShowHelp flags || (null flags && null inputFiles)) . + die $ usageInfo usageHeader options + + xmlToJson flags inputFiles + +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 "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"] (ReqArg NoCollapseText "PATTERN") ("For elements with tag matching regex PATTERN only (use '.*' or '' to match all elements):\n" + ++ "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 = + 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..." + +die :: String -> IO a +die msg = do + hPutStrLn stderr msg + exitWith (ExitFailure 1) + + +
+ src/XmlToJson.hs view
@@ -0,0 +1,158 @@+module XmlToJson(xmlToJson, Flag(..)) where++import Control.Applicative ((*>), (<*))+import Control.Arrow (first, (&&&), (***), (>>>))+import Control.Arrow.ArrowTree (ArrowTree)+import Control.Category (id)+import Control.Monad (forM_)+import Data.Maybe (catMaybes)+import Data.Tree.NTree.TypeDefs+import Data.Tree.Class (Tree)+import Prelude hiding (id)+import Text.Regex.Posix ((=~))+import Text.XML.HXT.Core (ArrowXml, XNode (..), XmlTree,+ deep, getAttrl, getChildren,+ getName, getText, hasName, isElem,+ localPart, no, readDocument, runLA,+ runX, withValidate)++#ifdef UseCurl +import Text.XML.HXT.Curl -- use libcurl for HTTP access, only necessary when reading http://...+#endif++import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Lazy.Char8 as BS+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+import Text.XML.HXT.Expat (withExpat)+++data Flag = Input String | StartFrom String | Multiline | SkipRoots | NoIgnoreNulls | WrapArray | NoCollapseText String | ShowHelp+ deriving (Show, Eq)++getStartNodes :: ArrowXml cat => [Flag] -> cat (NTree XNode) XmlTree+getStartNodes flags =+ case [x | StartFrom x <- flags] of+ [] -> getChildren >>> isElem+ [x] -> deep (isElem >>> hasName x)+ _ -> error "Expecting at most one --tag-name (-t) option"++getCollapseTextRegex :: [Flag] -> Maybe String+getCollapseTextRegex flags = singleOrNothing "Expecting at most one --no-collapse-text option" [x | NoCollapseText x <- flags]++wrapAction :: [Flag] -> IO a -> IO a+wrapAction flags act+ | WrapArray `elem` flags = putStr "[" *> act <* putStr "]"+ | otherwise = act++multiline :: [Flag] -> [BS.ByteString] -> BS.ByteString+multiline flags = case (WrapArray `elem` flags, Multiline `elem` flags) of+ (False, _) -> BS.intercalate (BS.pack "\n")+ (True, False) -> BS.intercalate (BS.pack ",")+ (True, True) -> BS.intercalate (BS.pack ",\n")++ignoreNulls :: [Flag] -> [Aeson.Value] -> [Aeson.Value]+ignoreNulls flags+ | NoIgnoreNulls `notElem` flags =+ filter (/= Aeson.Null)+ | otherwise = id++nodesFilter :: (Data.Tree.Class.Tree t, Control.Arrow.ArrowTree.ArrowTree a) => [Flag] -> a (t b) (t b)+nodesFilter flags+ | SkipRoots `elem` flags = getChildren+ | otherwise = id++xmlToJson :: [Flag] -> [String] -> IO ()+xmlToJson flags inputFiles =+ forM_ inputFiles $ \src -> do+ rootElems <-+ runX $+ readDocument+ [ withValidate no+ , withExpat True+#ifdef UseCurl + , withCurl []+#endif + ]+ src+ >>> getStartNodes flags+ >>> nodesFilter flags+ -- TODO: de-uglify and optimize the following+ wrapAction flags+ . BS.putStr . multiline flags+ . map Aeson.encode+ . ignoreNulls flags+ . map (wrapRoot . xmlTreeToJSON (getCollapseTextRegex flags))+ $ rootElems++ +data JSValueName = Text | Tag String | Attr String+ deriving (Eq, Ord, Show)++concatMapValues :: (Ord k) => [M.Map k v] -> M.Map k [v]+concatMapValues = M.unionsWith (++) . (fmap . fmap) (: [])++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++wrapRoot :: Maybe (JSValueName, Aeson.Value) -> Aeson.Value+wrapRoot Nothing = Aeson.Null+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,+-- in which case the value produced is a json string+tagMapToJSValue :: Bool -> M.Map JSValueName Aeson.Value -> Aeson.Value+tagMapToJSValue collapseTextRegex m = case (collapseTextRegex, M.toList m) of+ (True, [(Text, val)]) -> val+ _ ->+ Aeson.Object . HashMap.fromList . (map . first) packJSValueName $ M.toList m++xmlTreeToJSON :: Maybe String -> XmlTree -> Maybe (JSValueName, Aeson.Value)+xmlTreeToJSON collapseTextRegex node@(NTree (XTag qName _) children)+ = Just (Tag (localPart qName),+ tagMapToJSValue shouldCollapseText 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 collapseTextRegex) children -- convert xml nodes to Maybe (QName, Aeson.Value) pairs++ attrVals =+ map (Attr *** Aeson.String . T.pack) $ getAttrVals node++ shouldCollapseText = case collapseTextRegex of+ Nothing -> True+ Just "" -> False+ Just pattern -> not $ localPart qName =~ pattern++xmlTreeToJSON _ (NTree (XText str) _)+ | T.null text = Nothing+ | otherwise = Just (Text, Aeson.String text)+ where+ text = T.strip $ T.pack str++xmlTreeToJSON _ _ = Nothing++singleOrNothing :: String -> [a] -> Maybe a+singleOrNothing _ [] = Nothing+singleOrNothing _ [x] = Just x+singleOrNothing msg _ = error msg++
− src/xml-to-json.hs
@@ -1,166 +0,0 @@-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.ByteString.Lazy.Char8 as BS-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 | NoIgnoreNulls | WrapArray | NoCollapseText | ShowHelp- deriving (Show, Eq)--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 "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 =- 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 [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-- when (elem ShowHelp flags || (null flags && null inputFiles)) .- die $ usageInfo usageHeader options-- 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")-- ignoreNulls- | NoIgnoreNulls `notElem` flags =- filter (/= Aeson.Null)- | otherwise = id-- nodesFilter- | skipRoots = getChildren- | otherwise = id-- 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--data JSValueName = Text | Tag String | Attr String- deriving (Eq, Ord, Show)--concatMapValues :: (Ord k) => [M.Map k v] -> M.Map k [v]-concatMapValues = M.unionsWith (++) . (fmap . fmap) (: [])--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--wrapRoot :: Maybe (JSValueName, Aeson.Value) -> Aeson.Value-wrapRoot Nothing = Aeson.Null-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,--- in which case the value produced is a json string-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 :: 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-- 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--xmlTreeToJSON _ _ = Nothing--die :: String -> IO a-die msg = do- hPutStrLn stderr msg- exitWith (ExitFailure 1)
xml-to-json.cabal view
@@ -1,32 +1,42 @@ name: xml-to-json-version: 0.1.1.0-synopsis: Simple command line tool for converting XML files to json+version: 0.1.2.0+synopsis: Library and 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. - The main purpose is to convert legacy XML-based data into a format that can be imported into JSON databases such as CouchDB and MongoDB.- .- See <https://github.com/sinelaw/xml-to-json#readme> for details and usage.+ This library converts XMLs to json format, gaining readability while losing information such as comments, attribute ordering, and such. + The package also includes an executable to directly invoke the library on files (or urls on non-windows platforms).+ The main purpose is to convert legacy XML-based data into a format that can be imported into JSON databases such as CouchDB and MongoDB.+ .+ See <https://github.com/sinelaw/xml-to-json#readme> for details and usage. license: GPL-3 license-file: LICENSE author: Noam Lewis maintainer: jones.noamle@gmail.com homepage: https://github.com/sinelaw/xml-to-json bug-reports: https://github.com/sinelaw/xml-to-json/issues-copyright: Copyright Noam Lewis, 2012+copyright: Copyright Noam Lewis, 2014 category: Web, XML build-type: Simple cabal-version: >=1.8 Extra-Source-Files: README.md - source-repository head type: git location: https://github.com/sinelaw/xml-to-json.git-+ +library+ exposed-modules: XmlToJson+ extensions: CPP+ hs-source-dirs: src+ build-depends: base >= 4.5.0 && < 4.7, hxt, aeson, text, unordered-containers, hashable, vector, bytestring, hxt-tagsoup, hxt-expat, containers, regex-posix+ if (!os(windows))+ build-depends: hxt-curl, curl+ cpp-options: -DUseCurl+ ghc-options: -Wall+ executable xml-to-json- main-is: src/xml-to-json.hs - -- other-modules: - build-depends: base ==4.5.*, hxt, hxt-curl, aeson, text,- containers, unordered-containers, vector, bytestring, hxt-tagsoup, hxt-expat- ghc-options: -Wall -O2+ main-is: Main.hs + hs-source-dirs: src-exec+ extensions: CPP+ build-depends: base >= 4.5.0 && < 4.7, xml-to-json+ ghc-options: -Wall