diff --git a/src-exec/StreamingMain.hs b/src-exec/StreamingMain.hs deleted file mode 100644 --- a/src-exec/StreamingMain.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Main where - -import Control.Exception -import Control.Monad -import Data.List -import System.Cmd -import System.Directory -import System.Exit -import System.IO -import System.Environment (getArgs) -import Text.XML.JSON.StreamingXmlToJson(xmlStreamToJSON) - -openItem :: String -> IO String -openItem url | not $ "http://" `isPrefixOf` url = readFile url -openItem url = bracket - (openTempFile "." "tagsoup.tmp") - (\(file,_) -> removeFile file) - $ \(file,hndl) -> do - hClose hndl - putStrLn $ "Downloading: " ++ url - res <- system $ "wget " ++ url ++ " -O " ++ file - when (res /= ExitSuccess) $ error $ "Failed to download using wget: " ++ url - src <- readFile file - return src - -main :: IO () -main = do - args <- getArgs - fileData <- openItem . head $ args - forM_ (xmlStreamToJSON fileData) putStrLn diff --git a/src/Text/XML/JSON/StreamingXmlToJson.hs b/src/Text/XML/JSON/StreamingXmlToJson.hs deleted file mode 100644 --- a/src/Text/XML/JSON/StreamingXmlToJson.hs +++ /dev/null @@ -1,88 +0,0 @@ -module Text.XML.JSON.StreamingXmlToJson -where - -import Text.HTML.TagSoup -import qualified Data.Text.Lazy as T -import Data.List (intercalate) -import qualified Data.Foldable - - - -xmlStreamToJSON :: String -> [String] -xmlStreamToJSON fileData = map toText linesWithLevels - where xmlData = parseTags fileData - jsonData = map getEncodedJSON . parseXML $ xmlData - linesWithLevels = Data.Foldable.toList jsonData - -parseXML :: [Tag String] -> [State] -parseXML d = scanl convertTag (State Empty []) d - -type Attrs = [(String, String)] -type Name = String -type Elem = (Name, Attrs, Int) -data State = State { getEncodedJSON :: EncodedJSON, getParents :: [Int] } - -data EncodedJSON = StartObject Name Attrs Bool | EndObject | Text String Bool | Empty - -quoteT :: String -quoteT = "\"" - -toText :: EncodedJSON -> String -toText Empty = "" -toText (Text t hasLeadingComma) = concat [leadingComma, quoteT, encodeStr t, quoteT] - where leadingComma = if hasLeadingComma then ", " else "" -toText EndObject = "]}\n" -toText (StartObject name attrs hasLeadingComma) = concat [ leadingComma - , "{\"name\": \"" - , name - , "\", " - , toTextAttrs attrs - , "\"items\": [ " - ] - where leadingComma = if hasLeadingComma then ", " else "" - -toTextAttrs :: Attrs -> String -toTextAttrs [] = "" -toTextAttrs as = concat [ "\"attrs\": { " - , intercalate (", ") . map toTextKV $ as - , " }, " - ] - -toTextKV :: (String, String) -> String -toTextKV (k,v) = concat [quoteT, k, "\": \"", v, quoteT] - --- TODO: use a faster method for quotation escaping. Consider implementing the encoding function using String (or ByteString) -encodeStr :: String -> String -encodeStr t = concat . map (\c -> if c == '"' - then "\\\"" - else [c]) - $ t - -convertTag :: State -> Tag String -> State -convertTag (State _ (curCount:parents)) (TagOpen name attrs) - = State startObj (0 : (curCount + 1) : parents) - where startObj = createStartObject name attrs (curCount > 0) -convertTag (State _ []) (TagOpen name attrs) - = State startObj [0] - where startObj = createStartObject name attrs False -convertTag (State _ ( _:ancestors)) (TagClose _) - = State EndObject ancestors -convertTag (State _ []) t@(TagClose _) - = error $ "Malformed XML, unexpected close tag: " ++ (show t) -convertTag (State _ parents) (TagText text) - = if stripped == "" - then State Empty parents - else State (Text stripped comma) newParents - where stripped = T.unpack . T.strip . T.pack $ text - (comma, newParents) = case parents of - [] -> (False, []) - count:ps -> (count > 0, (count + 1):ps) -convertTag (State _ parents) _ = (State Empty parents) - -createStartObject :: String -> Attrs -> Bool -> EncodedJSON -createStartObject name attrs hasLeadingComma - = case head name of - '!' -> Empty - '?' -> Empty - _ -> StartObject name attrs hasLeadingComma - diff --git a/xml-to-json.cabal b/xml-to-json.cabal --- a/xml-to-json.cabal +++ b/xml-to-json.cabal @@ -1,12 +1,16 @@ name: xml-to-json -version: 1.0.1 +version: 2.0.0 synopsis: Library and command line tool for converting XML files to json description: - 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 for details and usage. + The xml-to-json executable (and library) converts XMLs to json format, gaining readability while losing information such as comments, attribute ordering, and such. + . + For files that are slow to process, please use 'xml-to-json-fast' which (starting with version 2.0.0) resides in its own package. + . + The original purpose was to convert legacy XML-based data into a format that can be imported into JSON databases such as CouchDB and MongoDB. + . + The package also includes an executable to directly invoke the library on files (or urls on non-windows platforms). + . + See for details and usage. license: MIT license-file: LICENSE author: Noam Lewis @@ -25,10 +29,10 @@ location: https://github.com/sinelaw/xml-to-json.git library - exposed-modules: Text.XML.JSON.XmlToJson, Text.XML.JSON.StreamingXmlToJson + exposed-modules: Text.XML.JSON.XmlToJson extensions: CPP hs-source-dirs: src - build-depends: base >= 4.5.0 && < 4.8, hxt, aeson < 0.7, text, unordered-containers, hashable, vector, bytestring, hxt-tagsoup, hxt-expat, containers, regex-posix, tagsoup + build-depends: base >= 4.5.0, hxt, aeson, text, unordered-containers, hashable, vector, bytestring, hxt-tagsoup, hxt-expat, containers, regex-posix, tagsoup if (!os(windows)) build-depends: hxt-curl, curl cpp-options: -DUseCurl @@ -43,10 +47,3 @@ ghc-options: -Wall -rtsopts Ghc-Prof-Options: -prof -auto-all -caf-all -executable xml-to-json-fast - main-is: StreamingMain.hs - hs-source-dirs: src-exec - extensions: CPP - build-depends: base >= 4.5.0 && < 4.8, tagsoup, text, directory, process, aeson < 0.7, bytestring, vector, containers, xml-to-json - ghc-options: -Wall -rtsopts - Ghc-Prof-Options: -prof -auto-all -caf-all