jsonxlsx (empty) → 0.1.0.0
raw patch · 4 files changed
+343/−0 lines, 4 filesdep +HUnitdep +aesondep +attoparsecsetup-changed
Dependencies added: HUnit, aeson, attoparsec, base, bytestring, containers, old-time, optparse-applicative, scientific, string-qq, text, time, unordered-containers, vector, xlsx
Files
- LICENSE +20/−0
- Main.hs +285/−0
- Setup.hs +2/−0
- jsonxlsx.cabal +36/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Daniel Choi++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Main.hs view
@@ -0,0 +1,285 @@+{-# LANGUAGE OverloadedStrings, QuasiQuotes, BangPatterns, ScopedTypeVariables #-}+module Main where+import Codec.Xlsx+import Data.Text (Text, take)+import Control.Applicative+import qualified Data.Map.Strict as M+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Lazy as BL hiding (map, intersperse, zip, concat)+import qualified Data.ByteString.Lazy.Char8 as L8 +import System.Time+import Data.Time.Clock.POSIX (getPOSIXTime)+import System.Environment (getArgs)+import Data.Aeson+import Data.Monoid+import Data.List (intersperse, zip)+import qualified Data.Attoparsec.Text as AT+import Data.Attoparsec.Lazy as Atto hiding (Result)+import Data.Attoparsec.ByteString.Char8 (endOfLine, sepBy)+import qualified Data.HashMap.Lazy as HM+import qualified Data.Vector as V+import Data.Scientific (Scientific, floatingOrInteger)+import qualified Data.Text as T+import qualified Data.Text.Lazy.IO as TL+import qualified Options.Applicative as O+import Control.Monad (when)+import System.Exit+import Data.String.QQ +import qualified Data.Text.Encoding as T (encodeUtf8, decodeUtf8)+import Test.HUnit++-- Hackage: https://hackage.haskell.org/package/xlsx+{-++ let+ sheet = def & cellValueAt (1,2) ?~ CellDouble 42.0+ & cellValueAt (3,2) ?~ CellText "foo"+ xlsx = def & atSheet "List1" ?~ sheet++-}+++data Options = Options { + arrayDelim :: String+ , jsonExpr :: String+ , outputFile :: String+ , debugKeyPaths :: Bool+ , maxStringLen :: Int+ } deriving Show++defaultMaxBytes :: Int+defaultMaxBytes = 32768++parseOpts :: O.Parser Options+parseOpts = Options + <$> O.strOption (O.metavar "DELIM" <> O.value "," <> O.short 'a' <> O.help "Concatentated array elem delimiter. Defaults to comma.")+ <*> O.argument O.str (O.metavar "FIELDS" <> O.help "JSON keypath expressions")+ <*> O.argument O.str (O.metavar "OUTFILE" <> O.help "Output file to write to. Use '-' to emit binary xlsx data to STDOUT.") + <*> O.switch (O.long "debug" <> O.help "Debug keypaths")+ <*> maxStrLen++opts = O.info (O.helper <*> parseOpts)+ (O.fullDesc + <> O.progDesc [s|Transform JSON object steam to XLSX. + On STDIN provide an input stream of newline-separated JSON objects. |]+ <> O.header "jsonxlsx"+ <> O.footer "See https://github.com/danchoi/jsonxlsx for more information.")++maxStrLen :: O.Parser Int+maxStrLen = O.option O.auto+ ( O.long "maxlen"+ <> O.short 'l'+ <> O.metavar "MAXLEN"+ <> O.value defaultMaxBytes+ <> O.help "Limit the length of strings (-1 for unlimited)" )++main = do+ Options arrayDelim expr outfile debugKeyPaths maxLen <- O.execParser opts+ x <- BL.getContents + ct <- getPOSIXTime+ let xs :: [Value]+ xs = decodeStream x+ ks = parseKeyPath $ T.pack expr+ ks' :: [[Key]]+ ks' = [k | KeyPath k _ <- ks]+ arrayDelim' = T.pack arrayDelim+ hs :: [Text] -- header labels+ hs = map keyPathToHeader ks+ -- extract JSON+ let xs' :: [[Value]]+ xs' = map (evalToValues arrayDelim' ks') xs+ headerCells = map mkHeaderCell hs+ headerIndexedCells :: [((Int,Int), Cell)]+ headerIndexedCells = zip [(1, x) | x <- [1..]] headerCells+ rows :: [[Cell]]+ rows = map (map (jsonToCell . truncateStr maxLen)) xs'+ rowsIndexedCells :: [[((Int,Int), Cell)]]+ rowsIndexedCells = map mkRowIndexedCells $ zip [2..] rows+ allCells = concat (headerIndexedCells:rowsIndexedCells)+ cellMap :: CellMap+ cellMap = M.fromList allCells++ when debugKeyPaths $ do+ Prelude.putStrLn $ "Key Paths: " ++ show ks+ print hs+ print headerCells+ print headerIndexedCells+ exitSuccess+ let ws = def { _wsCells = cellMap }+ let xlsx = def { _xlSheets = [("sheet1", ws)] }+ if outfile == "-"+ then L8.putStr $ fromXlsx ct xlsx+ else L.writeFile outfile $ fromXlsx ct xlsx++mkRowIndexedCells :: (Int, [Cell]) -> [((Int, Int), Cell)]+mkRowIndexedCells (rowNumber, cells) = zip [(rowNumber, x) | x <- [1..]] cells++mkHeaderCell :: Text -> Cell+mkHeaderCell x = def { _cellValue = Just (CellText x) }++truncateStr :: Int -> Value -> Value+truncateStr (-1) v = v+truncateStr maxlen (String xs) = + let ellipsis = ("..." :: Text)+ maxlen' = maxlen - (bytelen ellipsis)+ in if (bytelen xs) > maxlen+ then let s = truncateText maxlen' xs + in String $ s <> ellipsis+ else String xs+truncateStr _ v = v++-- This should get Text approximately under the byte limit, erring on the side of being+-- too aggressive.+truncateText :: Int -> Text -> Text+truncateText maxBytes s | bytelen s > maxBytes = + truncateText maxBytes . T.take (T.length s - d) $ s+ where d = bytelen s - maxBytes+truncateText _ s = s++bytelen :: Text -> Int+bytelen = B.length . T.encodeUtf8 ++jsonToCell :: Value -> Cell+jsonToCell (String x) = def { _cellValue = Just (CellText x) }+jsonToCell Null = def { _cellValue = Nothing }+jsonToCell (Number x) = def { _cellValue = Just (CellDouble $ scientificToDouble x) }+jsonToCell (Bool x) = def { _cellValue = Just (CellBool x) }+jsonToCell (Object _) = def { _cellValue = Just (CellText "[Object]") }+jsonToCell (Array _) = def { _cellValue = Just (CellText "[Array]") }++scientificToDouble :: Scientific -> Double+scientificToDouble x = + case floatingOrInteger x of+ Left float -> float+ Right int -> fromIntegral int++------------------------------------------------------------------------+-- decode JSON object stream++decodeStream :: (FromJSON a) => BL.ByteString -> [a]+decodeStream bs = case decodeWith json bs of+ (Just x, xs) | xs == mempty -> [x]+ (Just x, xs) -> x:(decodeStream xs)+ (Nothing, _) -> []++decodeWith :: (FromJSON a) => Atto.Parser Value -> BL.ByteString -> (Maybe a, BL.ByteString)+decodeWith p s =+ case Atto.parse p s of+ Atto.Done r v -> f v r+ Atto.Fail _ _ _ -> (Nothing, mempty)+ where f v' r = (\x -> case x of + Success a -> (Just a, r)+ _ -> (Nothing, r)) $ fromJSON v'++------------------------------------------------------------------------+-- JSON parsing and data extraction++-- | KeyPath may have an alias for the header output+data KeyPath = KeyPath [Key] (Maybe Text) deriving Show++data Key = Key Text | Index Int deriving (Eq, Show)++parseKeyPath :: Text -> [KeyPath]+parseKeyPath s = case AT.parseOnly pKeyPaths s of+ Left err -> error $ "Parse error " ++ err + Right res -> res++keyPathToHeader :: KeyPath -> Text+keyPathToHeader (KeyPath _ (Just alias)) = alias+keyPathToHeader (KeyPath ks Nothing) = + mconcat $ intersperse "." $ [x | Key x <- ks] -- exclude Index keys++spaces = many1 AT.space++pKeyPaths :: AT.Parser [KeyPath]+pKeyPaths = pKeyPath `AT.sepBy` spaces++pKeyPath :: AT.Parser KeyPath+pKeyPath = KeyPath + <$> (AT.sepBy1 pKeyOrIndex (AT.takeWhile1 $ AT.inClass ".["))+ <*> (pAlias <|> pure Nothing)++------------------------------------------------------------------------+-- | A column header alias is designated by : followed by alphanum string after keypath+-- The alias string may be quoted with double quotes if it contains strings.++pAlias :: AT.Parser (Maybe Text)+pAlias = do+ AT.char ':'+ alias <- (AT.takeWhile1 (AT.inClass "a-zA-Z0-9_-")) <|> quotedString + return . Just $ alias++quotedString = AT.char '"' *> (AT.takeWhile1 (AT.notInClass "\"")) <* AT.char '"'+------------------------------------------------------------------------++pKeyOrIndex :: AT.Parser Key+pKeyOrIndex = pIndex <|> pKey++pKey = Key <$> AT.takeWhile1 (AT.notInClass " .[:")++pIndex = Index <$> AT.decimal <* AT.char ']'++evalToValues :: Text -> [[Key]] -> Value -> [Value]+evalToValues arrayDelim ks v = map (evalToValue arrayDelim v) ks++type ArrayDelimiter = Text++evalToValue :: ArrayDelimiter -> Value -> [Key] -> Value+evalToValue d v k = evalKeyPath d k v++evalToText :: ArrayDelimiter -> [Key] -> Value -> Text+evalToText d k v = valToText $ evalKeyPath d k v++-- evaluates the a JS key path against a Value context to a leaf Value+evalKeyPath :: ArrayDelimiter -> [Key] -> Value -> Value+evalKeyPath d [] x@(String _) = x+evalKeyPath d [] x@Null = x+evalKeyPath d [] x@(Number _) = x+evalKeyPath d [] x@(Bool _) = x+evalKeyPath d [] x@(Object _) = x+evalKeyPath d [] x@(Array v) | V.null v = Null+evalKeyPath d [] x@(Array v) = + let vs = V.toList v+ xs = intersperse d $ map (evalToText d []) vs+ in String . mconcat $ xs+evalKeyPath d (Key key:ks) (Object s) = + case (HM.lookup key s) of+ Just x -> evalKeyPath d ks x+ Nothing -> Null+evalKeyPath d (Index idx:ks) (Array v) = + let e = (V.!?) v idx+ in case e of + Just e' -> evalKeyPath d ks e'+ Nothing -> Null+-- traverse array elements with additional keys+evalKeyPath d ks@(Key key:_) (Array v) | V.null v = Null+evalKeyPath d ks@(Key key:_) (Array v) = + let vs = V.toList v+ in String . mconcat . intersperse d $ map (evalToText d ks) vs+evalKeyPath _ ((Index _):_) _ = Null+evalKeyPath _ _ _ = Null++valToText :: Value -> Text+valToText (String x) = x+valToText Null = "null"+valToText (Bool True) = "t"+valToText (Bool False) = "f"+valToText (Number x) = + case floatingOrInteger x of+ Left float -> T.pack . show $ float+ Right int -> T.pack . show $ int+valToText (Object _) = "[Object]"++++t = runTestTT tests++str1 = "1234567890"++tests = test [+ "no truncation, under limit " ~: str1 @=? truncateStr 10 str1+ , "truncation" ~: "12345..." @=? truncateStr 8 str1+ , "John Smith bytelength" ~: 10 @=? bytelen "John Smith"+ , "John Smith" ~: "John Smith" @=? truncateStr 10 "John Smith"+ ]
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ jsonxlsx.cabal view
@@ -0,0 +1,36 @@+name: jsonxlsx+version: 0.1.0.0+synopsis: json to xlsx converter+description: json to xlsx converter+license: MIT+license-file: LICENSE+author: Daniel Choi+maintainer: librarymaintainer@mackeycorp.com+-- copyright: +category: Text+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++source-repository head+ type: git+ location: git://github.com/mackeyrms/jsonxlsx.git++executable jsonxlsx+ main-is: Main.hs+ build-depends: base >=4.6 && < 5+ , xlsx == 0.4.1+ , containers+ , old-time+ , time+ , bytestring+ , aeson >= 0.8.0.1+ , attoparsec+ , unordered-containers+ , string-qq+ , optparse-applicative+ , vector+ , scientific >= 0.3.3+ , HUnit+ , text+ default-language: Haskell2010